adegraphics/0000755000176200001440000000000014774713152012537 5ustar liggesusersadegraphics/tests/0000755000176200001440000000000014511210167013664 5ustar liggesusersadegraphics/tests/s1d.match.R0000644000176200001440000000027113742303021015566 0ustar liggesuserslibrary(adegraphics) pdf("s1d.match.pdf") g1 <- s1d.match(-5:5, 2 * (-5:5)) g2 <- s1d.match(rnorm(10), runif(10), p1d.hor = FALSE) g3 <- s1d.match(1:5, 7:11, p1d.hor = F, p1d.rev = T) adegraphics/tests/s1d.hist.R0000644000176200001440000000565613742303021015455 0ustar liggesuserslibrary(ade4) library(adegraphics) pdf("s1d.hist.pdf") set.seed(40) x1 <- rnorm(1000) g11 <- s1d.hist(x1) g12 <- s1d.hist(x1, col = 1:10) g13 <- s1d.hist(x1, col = FALSE, ppoly.col = 1:10) g14 <- s1d.hist(x1, col = TRUE, ppoly.col = "blue") set.seed(50) x1 <- rnorm(1000) g21 <- s1d.hist(x1) # p1d.hori = TRUE and p1d.reverse = FALSE by default # g22 <- s1d.hist(x1, p1d.hori = TRUE, p1d.rev = TRUE) g23 <- s1d.hist(x1, p1d.hori = FALSE, p1d.rev = FALSE) # g24 <- s1d.hist(x1, p1d.hori = FALSE, p1d.rev = TRUE) # randtest.pcaiv data(rpjdl, package = "ade4") millog <- log(rpjdl$mil + 1) coa1 <- dudi.coa(rpjdl$fau, scann = FALSE) caiv1 <- pcaiv(coa1, millog, scan = FALSE) set.seed(50) rd11 <- randtest(caiv1) plot(rd11) set.seed(50) rd12 <- randtest(caiv1, output = "full") plot(rd12, nclass = 15) # must be the same output as rd11 set.seed(50) rd13 <- randtest(caiv1, output = "full") plot(rd13, nclass = 8) plot(rd13, nclass = 8, plines.col = "red") plot(rd13, nclass = 8, obs.plines.col = "red") plot(rd13, nclass = 8, sim.plines.col = "red") # randtest.dpcoa data(humDNAm, package = "ade4") dpcoahum <- dpcoa(data.frame(t(humDNAm$samples)), sqrt(humDNAm$distances), scan = FALSE, nf = 2) set.seed(50) rd21 <- randtest(dpcoahum) plot(rd21) rd22 <- randtest(dpcoahum, output = "full") plot(rd22) # randtest.amova (plot.krandtest) amovahum <- amova(humDNAm$samples, sqrt(humDNAm$distances), humDNAm$structures) set.seed(50) rd31 <- randtest(amovahum, 49) plot(rd31) plot(rd31, plines.col = "red") plot(rd31, g1.plines.col = "red") set.seed(50) rd32 <- randtest(amovahum, 49, output = "full") plot(rd32) plot(rd32, plines.col = "red") plot(rd32, g1.plines.col = "red") plot(rd32, nclass = 30, g2.pback.col = "lightblue") # randtest.coinertia data(doubs, package = "ade4") dudi1 <- dudi.pca(doubs$env, scale = TRUE, scan = FALSE, nf = 3) dudi2 <- dudi.pca(doubs$fish, scale = FALSE, scan = FALSE, nf = 2) coin1 <- coinertia(dudi1,dudi2, scan = FALSE, nf = 2) set.seed(50) rd4 <- randtest(coin1) plot(rd4) # randtest.pcaivortho data(rpjdl, package = "ade4") millog <- log(rpjdl$mil + 1) coa1 <- dudi.coa(rpjdl$fau, scann = FALSE) caiv1 <- pcaiv(coa1, millog, scan = FALSE) set.seed(50) rd5 <- randtest(caiv1) plot(rd5) # randtest.rlq (plot.krandtest) data(aviurba, package = "ade4") coa1 <- dudi.coa(aviurba$fau, scannf = FALSE, nf = 2) dudimil <- dudi.hillsmith(aviurba$mil, scannf = FALSE, nf = 2, row.w = coa1$lw) duditrait <- dudi.hillsmith(aviurba$traits, scannf = FALSE, nf = 2, row.w = coa1$cw) rlq1 <- rlq(dudimil, coa1, duditrait, scannf = FALSE, nf = 2) set.seed(50) rd6 <- randtest(rlq1) plot(rd6) # randtest.between data(meaudret, package = "ade4") pca1 <- dudi.pca(meaudret$env, scan = FALSE, nf = 3) set.seed(50) rd7 <- randtest(bca(pca1, meaudret$design$season, scan = FALSE), 99) plot(rd7, main = "Monte-Carlo test") # randtest.discrimin set.seed(50) rd8 <- randtest(discrimin(pca1, meaudret$design$season, scan = FALSE), 99) plot(rd8, main = "Monte-Carlo test") adegraphics/tests/adegraphics.R0000644000176200001440000000256513742303021016266 0ustar liggesuserslibrary(adegraphics) pdf("adegraphics.pdf") xy <- cbind.data.frame(runif(7), runif(7)) g1 <- s.label(xy) data(olympic, package = "ade4") pca <- ade4::dudi.pca(olympic$tab, scan = FALSE) g2 <- s.corcircle(pca$co, lab = names(olympic$tab)) g3 <- ADEgS(list(g1, g2), rbind(c(0, 0, 0.5, 1), c(0.5, 0, 1, 1))) g4 <- ADEgS(list(g1, g2), layout = c(1, 2)) ## the same as g3 g4b <- ADEgS(list(g1, g2)) ## the same as g3 g5 <- s.label(xy, plabels.cex = 0, paxes.draw = TRUE, ppoints.col = "red") g6 <- superpose(g1, g5, plot = TRUE) g6b <- s.density(xy) g7 <- superpose(s.density(xy), g5, plot = TRUE) g8 <- superpose(s.label(xy, plabels.boxes.col = "orange", plot = FALSE), s.label(xy, plabels.cex = 0, paxes.draw = TRUE, ppoints.col = "red", plot = FALSE), plot = TRUE) g9 <- g8[1, drop = TRUE] class(g9) g10 <- g8[1, drop = FALSE] class(g10) g11 <- ADEgS(list(g8, g3), positions = rbind(c(0, 0, 0.5, 1), c(0.5, 0, 1, 1))) ## cbindADEgS - rbindADEgS g12 <- cbindADEg(g1, g2, plot = TRUE) ## the same as g3 g13 <- cbindADEg(g8, g3, plot = TRUE) ## the same as g11 g14 <- rbindADEg(g8, g3, plot = TRUE) data(banque, package = "ade4") banque.acm <- ade4::dudi.acm(banque, scann = FALSE, nf = 3) g15 <- score(banque.acm, which = which(banque.acm$cr[, 1] > 0.2), plot = FALSE) g15 <- g15[[1]] cbindADEg(g15[[1]], g15[[2]], plot = TRUE) ## work on trellis object adegraphics/tests/s.class.R0000644000176200001440000000241013742303021015347 0ustar liggesuserslibrary(adegraphics) pdf("s.class.pdf") xy0 <- cbind.data.frame(x = runif(20, -1, 1), y = runif(20, -1, 6)) basic <- s.class(xy0, fac = factor(rep(c("A", "B"), le = 20)), chull = 0, star = 0) xy1 <- cbind.data.frame(x = runif(200, -1, 1), y = runif(200, -1, 6)) fac1 <- factor(xy1$x > 0) : factor(xy1$y > 0) g1 <- s.class(xy1, fac = fac1, storeData = F, col = 1:4, pbackground.box = T, pbackground.col = grey(0.85), paxes.draw = T, ell = 0) ## multiaxis xy2 <- cbind.data.frame(x = runif(200, -1, 1), y = runif(200, -2, 2), y2 = runif(200, -0.5, .5)) fac2 <- factor(xy2$x > 0) g2 <- s.class(xy2, fac = fac2, xax = 1, yax = 2:3, storeData = F, plot = F) print(g2) ## insertion print(ADEgS(list(g1, g2), posi = rbind(c(0, 0, 1, 1), c(0.7, 0.5, 1, 0.9)))) ## color test g3 <- s.class(xy1, fac = fac2, psub.text = "Graphic 3", "ppoints.col" = 1:5, plabels.boxes = list(col = "white", alpha = 0.8), pellipses.col = 1:5, col = 1:5) ## test convex hull and parameters xy4 <- cbind.data.frame(x = runif(200, -1, 1), y = runif(200, -1, 1)) fac4 <- factor(xy4$x > 0) : factor(xy4$y > 0) col <- c("black", "red", "green", "blue") g4 <- s.class(xy4, fac4, ppoints.cex = 1.5, chull = T, ellipseSize = 0, starSize = 0, ppolygon = list(border = 4:1, col = 1:4, lty = 1:4, lwd = 2, alpha = 0.4)) adegraphics/tests/s.corcircle.R0000644000176200001440000000067013742303021016215 0ustar liggesuserslibrary(adegraphics) pdf("s.corcircle.pdf") data(olympic, package = "ade4") dudi1 <- ade4::dudi.pca(olympic$tab, scan = FALSE) # a normed PCA g1 <- s.corcircle(dudi1$co, lab = names(olympic$tab)) g2 <- s.corcircle(dudi1$co, lab = names(olympic$tab), fullcircle = T) g3 <- s.corcircle(dudi1$co, lab = names(olympic$tab), fullcircle = FALSE) g4 <- s.corcircle(dudi1$co, lab = names(olympic$tab), pback.col = "red", pbackground.box = FALSE) adegraphics/tests/s.match.R0000644000176200001440000000072713742303021015347 0ustar liggesuserslibrary(adegraphics) pdf("s.match.pdf") X <- data.frame(x = runif(50, -1, 2), y = runif(50, -1, 2)) Y <- X + rnorm(100, sd = 0.3) g1 <- s.match(X, Y, ppoints.cex = 0, col = c("blue", "red")) g2 <- s.match(X, Y, arr = FALSE, ppoints.cex = 2, ppoints.col = c("blue", "green")) g3 <- s.match(X, Y, arr = FALSE) g4 <- s.match(X, Y, arrows = TRUE, plabels = list(alpha = 1, col = "black", cex = 1), plines = list(col = "red"), panel.background = list(col = "antiquewhite")) adegraphics/tests/s1d.boxplot.R0000644000176200001440000000216113742303021016161 0ustar liggesuserslibrary(adegraphics) pdf("s1d.boxplot.pdf") ## ex1 x <- c(rnorm(10), rnorm(10)) fact <- factor(rep(c("A", "B"), 10)) g11 <- s1d.boxplot(x, fact) g12 <- s1d.boxplot(x, fact, col = TRUE) g12 <- s1d.boxplot(x, fact, col = 2:3) g12 <- s1d.boxplot(x, fact, col = TRUE, plines.col = "black") g2 <- s1d.boxplot(x, fact, ppolygon.border = c("red", "blue"), box.rectangle = list(alpha = 1, fill = "green")) ## ex2 w1 <- rnorm(100, -1) w2 <- rnorm(100) w3 <- rnorm(100, 1) f1 <- gl(3, 100) f2 <- gl(30, 10) g3 <- s1d.boxplot(c(w1, w2, w3), f1) g4 <- s1d.boxplot(c(w1, w2, w3), f2) g5 <- s1d.boxplot(c(w1, w2, w3), f2, p1d.rug.draw = FALSE) mat <- matrix(0, ncol = 1, nrow = 8) mat[c(2), ] <- 1 mat[c(3:8), ] <- 2 mat[1, ] <- 3 g6 <- ADEgS(c(g3, g4, s1d.label(c(w1, w2, w3), p1d = list(rug = list(tck = 0.8), rev = TRUE), ppoints.cex = 0, plabels.cex = 0, plot = F, pgrid.draw = F)), layout = matrix((rev(mat)), ncol = 1)) g7 <- s1d.boxplot(c(w1, w2, w3), data.frame(f1, f2)) ## ex3 data(banque, package = "ade4") banque.acm <- ade4::dudi.acm(banque, scan = FALSE, nf = 4) s1d.boxplot(banque.acm$l1[, 1], banque[, 1:7], plabels.cex = 1.8) adegraphics/tests/s.logo.R0000644000176200001440000000141613742303021015207 0ustar liggesuserslibrary(adegraphics) pdf("s.logo.pdf") ## ex1 data(ggtortoises, package = "ade4") ico <- ggtortoises$ico[as.character(ggtortoises$pop$carap)] g1 <- s.logo(ggtortoises$pop, ico, pori.incl = FALSE) g2 <- s.label(ggtortoises$pop, add = TRUE, plabels = list(boxes = list(alpha = 0.4, border = "transparent"))) ## ex2 data(capitales, package = "ade4") index <- unlist(lapply(1:15, function(i) which(names(capitales$logo) == tolower(rownames(capitales$xy)[i]))), use.names = FALSE) g3 <- s.logo(capitales$xy, capitales$logo[index]) x <- c(0, max(capitales$area$x)) y <- c(0, max(capitales$area$y)) #g4 <- s.image(cbind(x, y), z = c(1, 2), outsideLimits = capitales$area, grid = 500, regions = list(col = "yellow", alpha = 0.9)) #s.logo(capitales$xy, capitales$logo[index], add = TRUE) adegraphics/tests/s1d.density.R0000644000176200001440000000264213742303021016155 0ustar liggesuserslibrary(adegraphics) pdf("s1d.density.pdf") set.seed(40) x1 <- rnorm(1000) g11 <- s1d.density(x1) g12 <- s1d.density(x1, col = FALSE, ppoly.col = "blue", p1d.rev = TRUE) g13 <- s1d.density(x1, col = TRUE, ppoly.col = "blue", p1d.hori = FALSE) g14 <- s1d.density(x1, col = TRUE, p1d.hori = FALSE, p1d.rev = TRUE) update(g11, ppolygons.border = "red") update(g11, col = FALSE, ppolygons.col = "black") update(g11, ppolygons.lwd = 3, ppolygons.lty = 3, ppolygons.alpha = 1) update(g11, ylim = c(-0.04, 0.5)) set.seed(50) x2 <- c(rnorm(1000, mean = -0.5, sd = 0.5), rnorm(1000, mean = 1)) fact <- rep(c("A", "B"), each = 1000) g21 <- s1d.density(x2, fact, col = c("red", "blue")) g22 <- s1d.density(x2, fact, col = FALSE, ppoly.col = 2:3) g23 <- s1d.density(x2, fact, col = FALSE, ppoly.col = 2:3, p1d.rev = TRUE) g24 <- s1d.density(x2, fact, col = FALSE, ppoly.col = 2:3, p1d.horizontal = FALSE) g25 <- s1d.density(x2, fact, col = FALSE, ppoly.col = 2:3, p1d.horizontal = FALSE, p1d.rev = TRUE) set.seed(60) x3 <- rnorm(1000) g31 <- s1d.density(x3) g32 <- s1d.density(x3, p1d.rug.draw = FALSE) g33 <- s1d.density(x3, p1d.rug.draw = FALSE, p1d.rev = TRUE) g34 <- s1d.density(x3, p1d.rug.draw = FALSE, p1d.hori = FALSE) g35 <- s1d.density(x3, p1d.rug.draw = FALSE, p1d.hori = FALSE, p1d.rev = TRUE) update(g31, p1d.rev = TRUE) update(g32, p1d.rev = TRUE) update(g33, p1d.rev = FALSE) update(g34, p1d.rev = TRUE) update(g35, p1d.rev = FALSE) adegraphics/tests/add.R0000644000176200001440000002231414413500612014537 0ustar liggesuserslibrary(adegraphics) pdf("add.pdf") set.seed(40) ########################### add.ADEg ############################## data(granulo, package = "ade4") df <- data.frame(t(apply(granulo$tab, 1, function(x) x / sum(x)))) pca <- ade4::dudi.pca(df, scal = FALSE, scan = FALSE) g1 <- s.arrow(ade4::dudi.pca(data.frame(df), scan = F, nf = 2)$co) g2 <- s.label(pca$li, plabels.cex = 0.5, plabels.col = "blue", plot = F) g3 <- add.ADEg(g2) g4 <- s.label(pca$c1, plabels.col = "red", add = T) g5 <- s.arrow(pca$c1, plabels.cex = 1.5, plot = FALSE) g6 <- ADEgS(list(g1 = g1, g5 = g5), layout = c(1, 2)) update(g6, pback.col = "lightblue", g1.plabels.cex = 2, g5.plabels.col = "red") ############################## addhist ############################## dfxy1 <- matrix(rnorm(200), ncol = 2) gh1 <- s.label(dfxy1) gh2 <- addhist(gh1) dfxy2 <- dfxy1 dfxy2[, 2] <- dfxy2[, 2] + rnorm(100, 2) gh3 <- s.label(dfxy2) gh4 <- addhist(gh3, plot.polygon = list(col = "red")) data(rpjdl, package = "ade4") coa1 <- ade4::dudi.coa(rpjdl$fau, scannf = FALSE, nf = 4) gh5 <- s.label(coa1$li) gh6 <- addhist(gh5) ############################## addtext ############################## # on a ADEg addtext(g1, -1, 1, "Data Granulo", plabels.cex = 1.5, plabels.col = "red") addtext(g1, -1, 1, c("Data", "Granulo"), plabels.cex = 1.5, plabels.col = c("red", "blue")) # the two labels are superposed addtext(g1, -1, 1, c("Data", "Granulo"), plabels.cex = 1.5, plabels.col = "red") # the two labels are superposed addtext(g1, c(-1, -0.5), 1, "Data Granulo", plabels.cex = 1.5, plabels.col = c("red", "blue")) addtext(g1, c(-1, -0.5), 1, c("Data", "Granulo"), plabels.cex = 1.5, plabels.col = c("red", "blue")) addtext(g1, -1, c(1, 0.9), c("Data", "Granulo"), plabels.cex = 1.5, plabels.col = "red") addtext(g1, -1, c(1, 0.9), c("Data", "Granulo"), plabels.cex = c(1.5, 2), plabels.col = "red") data(dunedata, package = "ade4") afc1 <- ade4::dudi.coa(dunedata$veg, scannf = FALSE) g7 <- table.value(dunedata$veg, symbol = "circle", ppoints.cex = 0.5, plot = FALSE) addtext(g7, 1, 20, "A", plabels.srt = 45, plabels.boxes.draw = FALSE) # on a ADEgS: juxtaposition addtext(g6, 0.5, 0.5, "Text added", plabels.col = "blue", which = 1) addtext(g6, 0.5, 0.5, "Text added", plabels.col = c("blue", "green"), which = 2) addtext(g6, 0.5, 0.5, "Text added", plabels.col = c("green4", "blue"), which = 2) addtext(g6, 0.5, 0.5, "Text added", plabels.col = "blue", which = 1:2) addtext(g6, 0.5, 0.5, "Text added", plabels.col = c("green4", "blue")) addtext(g6, c(0.7, -0.5), c(0.2, -0.4), "Text added", plabels.col = "blue", plabels.cex = 1.2, which = 1:2) addtext(g6, c(0.7, -0.5), c(0.2, -0.4), "Text added", plabels.cex = c(0.5, 1.5), plabels.col = c("blue", "green4")) xy2 <- cbind.data.frame(x = runif(200, -1, 1), y = runif(200, -2, 2), y2 = runif(200, -0.5, 0.5)) fac2 <- factor(xy2$x > 0) g9 <- s.class(xy2, fac = fac2, xax = 1, yax = 2:3, plot = FALSE) addtext(g9, 0, 0, "A", plabels.col = "red", plabels.cex = 2) addtext(g9, c(-2.1, -1.07), c(2, 1), c("A", "B"), plabels.col ="red", plabels.cex = 2, which = 1:2) addtext(g9, c(-2.1, -1.07), c(2, 1), c("A", "B"), plabels.col = c("green4", "red"), plabels.cex = c(3, 2), which = 1:2) # on a ADEgS: facets xy <- cbind.data.frame(x = runif(200, -1, 1), y = runif(200, -1, 1)) posi <- factor(xy$x > 0) : factor(xy$y > 0) g10 <- s.class(xy, fac = posi, facets = posi, pellipses.col = 1:4, plabels.cex = 0, plegend.drawKey = FALSE, psub.cex = 0, plot = FALSE) addtext(g10, c(0.5, 0.5, -0.5, -0.5), c(0.5, -0.5), levels(posi), plabels.cex = 2, plabels.col = 1:4) ############################## addline ############################## # on a 2D plot g11 <- s.label(cbind(rnorm(100), rnorm(100)), plot = FALSE) addline(g11, 0, 1, plines = list(col = "red", lwd = 2, lty = 2)) addline(g11, h = 1, plines.col = "chartreuse4", plines.lwd = 3) addline(g11, v = c(-1, 1), plines.col = "cadetblue", plines.lwd = 3) # on a 1D plot g12 <- s1d.label(rnorm(10), plot = FALSE) addline(g12, v = 1, plines.col = "chartreuse4", plines.lwd = 3) # on a ADEgS: juxtaposition g13 <- ADEgS(c(g11, g11), plot = FALSE) addline(g13, 0, 1, which = 1, plines.col = "red") addline(g13, 0, 1, which = 2, plines.col = "red") addline(g13, 0, 1, which = 1:2, plines.col = "red") addline(g13, 0, 1, plines.col = "red") addline(g13, h = 1, plines.col = "red") addline(g13, h = c(1, -1), plines.col = "red") addline(g13, v = c(-1, 1), plines.col = "red") addline(g13, v = c(-1, 1), plines.col = 2:3) addline(g13, c(0.7, -0.5), c(0.2, -0.4), which = 1:2, plines.col = "red") addline(g13, c(0.7, -0.5), c(0.2, -0.4), which = 1, plines.col = "red") addline(g13, 0.7, 0.2, which = 1, plines.col = "red") addline(g13, 0.7, -0.5, which = 1, plines.col = "red") xy2 <- cbind.data.frame(x = runif(200, -1, 1), y = runif(200, -2, 2), y2 = runif(200, -0.5, 0.5)) fac2 <- factor(xy2$x > 0) g9 <- s.class(xy2, fac = fac2, xax = 1, yax = 2:3, plot = FALSE) addline(g9, 1, 0, "A", plines.col = "red", plabels.cex = 2) addline(g9, c(-2.1, -1.07), c(2, 1), plines.col ="red", which = 1:2) addline(g9, c(-2.1, -1.07), c(2, 1), plines.col = c("green4", "red")) # on a ADEgS: facets xy <- cbind.data.frame(x = runif(200, -1, 1), y = runif(200, -1, 1)) posi <- factor(xy$x > 0) : factor(xy$y > 0) g10 <- s.class(xy, fac = posi, facets = posi, pellipses.col = 1:4, plabels.cex = 0, plegend.drawKey = FALSE, psub.cex = 0, plot = FALSE) addline(g10, 0, c(0.5, -0.5), plines.col = 1:4) ############################## addpoint ############################## # on a 2D plot g11 <- s.label(cbind(rnorm(100), rnorm(100)), ylab = "y axis label", paxes.draw = TRUE, plot = FALSE) addpoint(g11, 2, 2, ppoints.col = "coral", ppoints.pch = "*", ppoints.cex = 4) addpoint(g11, c(1, 2), c(1, 2), ppoints.col = "brown2") addpoint(g11, 1, c(1, 2), ppoints.col = "cyan3") # on a 1D plot g12 <- s1d.density(rnorm(1000), paxes.draw = TRUE, plot = FALSE) addpoint(g12, 2, 0, ppoints.col = "brown4", ppoints.cex = 3) g12 <- s1d.density(rnorm(1000), plot = FALSE, ylab = "y axis label") addpoint(g12, 2, 0, ppoints.col = "brown4", ppoints.cex = 3) # on a ADEgS: juxtaposition g13 <- ADEgS(c(g11, g11), plot = FALSE) addpoint(g13, 2, 2, which = 1, ppoints.col = "cyan3") addpoint(g13, 2, 2, which = 2, ppoints.col = "cyan3") addpoint(g13, 2, 2, which = 1:2, ppoints.col = "cyan3") addpoint(g13, 2, 2, ppoints.col = "cyan3") addpoint(g13, c(1, 2), 2, ppoints.col = "cyan3") addpoint(g13, 2, c(1, 2), ppoints.col = "cyan3") xy2 <- cbind.data.frame(x = runif(200, -1, 1), y = runif(200, -2, 2), y2 = runif(200, -0.5, 0.5)) fac2 <- factor(xy2$x > 0) g9 <- s.class(xy2, fac = fac2, xax = 1, yax = 2:3, plot = FALSE) addpoint(g9, 1, 0, ppoints.col = "red", ppoints.cex = 2) addpoint(g9, c(1, -1), 0, ppoints.col = "red", ppoints.cex = 2) addpoint(g9, 0, c(1, -1), ppoints.col = "red", ppoints.cex = 2) # on a ADEgS: facets xy <- cbind.data.frame(x = runif(200, -1, 1), y = runif(200, -1, 1)) posi <- factor(xy$x > 0) : factor(xy$y > 0) g10 <- s.class(xy, fac = posi, facets = posi, pellipses.col = 1:4, plabels.cex = 0, plegend.drawKey = FALSE, psub.cex = 0, plot = FALSE) addpoint(g10, 0, c(0.5, -0.5), ppoints.col = 1:4, ppoints.cex = 3) ############################## addsegment ############################## # on a 2D plot g11 <- s.label(cbind(rnorm(100), rnorm(100)), paxes.draw = TRUE, plot = FALSE) addsegment(g11, 0, 2, 0, -2, plines = list(col = "brown2", lwd = 3, lty = 2)) addsegment(g11, c(0, 1), 2, 0, -2, plines = list(col = "brown2", lwd = 3, lty = 2)) addsegment(g11, c(0, 1), 2, c(0, 1), -2, plines = list(col = c("cyan3", "brown2"), lwd = 3, lty = 2)) addsegment(g11, -2, -2, 2, 2, plines = list(col = "brown2", lwd = 3, lty = 2)) addsegment(g11, -2, 2, 2, -2, plines = list(col = "cyan3", lwd = 3, lty = 2)) g12 <- s.label(cbind(rnorm(100), rnorm(100)), ylab = "y axis label", plot = FALSE) addsegment(g12, 0, 2, 0, -2, plines = list(col = "brown2", lwd = 3, lty = 2)) addsegment(g12, -2, -2, 2, 2, plines = list(col = "brown2", lwd = 3, lty = 2)) addsegment(g12, -2, 2, 2, -2, plines = list(col = "cyan3", lwd = 3, lty = 2)) # on a 1D plot g13 <- s1d.density(rnorm(1000), paxes.draw = TRUE, ylab = "ylab", plot = FALSE) addsegment(g13, 2, 0, 2, 0.2, plines.col = 1, plines.lwd = 3) # on a ADEgS: juxtaposition g14 <- ADEgS(c(g11, g11), plot = FALSE) addsegment(g14, 1, 2, 1, -2, which = 1, plines.col = "brown2") addsegment(g14, 1, 2, 1, -2, which = 2, plines.col = "brown2") addsegment(g14, c(0, 1), 2, c(0, 1), -2, which = 1:2, plines.col = "brown2") addsegment(g14, 1, 2, c(0, 1), -2, which = 1:2, plines.col = "brown2") addsegment(g14, 1, 2, 1, -2, plines.col = "brown2") xy2 <- cbind.data.frame(x = runif(200, -1, 1), y = runif(200, -2, 2), y2 = runif(200, -0.5, 0.5)) fac2 <- factor(xy2$x > 0) g9 <- s.class(xy2, fac = fac2, xax = 1, yax = 2:3, plot = FALSE) addsegment(g9, 1, 0, 1, 0.5, plines.col = "red", plines.lwd = 2) addsegment(g9, 1, -1, 0, 1, plines.col = "red", plines.lwd = 2) addsegment(g9, 0, 1, -1, 1, plines.col = "red", plines.lwd = 2) # on a ADEgS: facets xy <- cbind.data.frame(x = runif(200, -1, 1), y = runif(200, -1, 1)) posi <- factor(xy$x > 0) : factor(xy$y > 0) g10 <- s.class(xy, fac = posi, facets = posi, pellipses.col = 1:4, plabels.cex = 0, plegend.drawKey = FALSE, psub.cex = 0, plot = FALSE) addsegment(g10, c(-0.5, 0.5), c(0.5, -0.5), c(-0.5, 0.5), 1, plines.col = 1:4, plines.lwd = 3) adegraphics/tests/s.distri.R0000644000176200001440000000351313742303021015545 0ustar liggesuserslibrary(adegraphics) pdf("s.distri.pdf") xy5 <- cbind.data.frame(x = runif(200, -1, 1), y = runif(200, -1, 1)) w1 <- as.numeric((xy5$x > 0) & (xy5$y > 0)) w2 <- ((xy5$x > 0) & (xy5$y < 0)) * (1 - xy5$y) * xy5$x w3 <- ((xy5$x < 0) & (xy5$y > 0)) * (1 - xy5$x) * xy5$y w4 <- ((xy5$x < 0) & (xy5$y < 0)) * xy5$y * xy5$x distri <- data.frame(a = w1 / sum(w1), b = w2 / sum(w2), c = w3 / sum(w3), d = w4 / sum(w4)) g5 <- s.distri(xy5, distri, plabels.boxes = list(col = "white", alpha = 1), plabels.cex = 2, plabels.col = 1:5) data(rpjdl, package = "ade4") xy6 <- ade4::dudi.coa(rpjdl$fau, scan = FALSE)$li + 3 g6 <- s.distri(xy6, rpjdl$fau[, 5], ellipseSize = 1.5, psub = list(text = rpjdl$frlab[5], cex = 2, pos = c(0.2, 0.1))) g7 <- s.distri(xy6, rpjdl$fau[, 5], ellipseSize = 1.5, psub = list(text = rpjdl$frlab[5], cex = 2, pos = c(0.2, 0.1)), porigin = list(include = FALSE), pellipses.axes.col = "blue") ## test add g8 <- s.distri(xy6, rpjdl$fau[, 5], ellipseSize = 1.5, psub = list(text = rpjdl$frlab[5], cex = 2, pos = c(0.2, 0.1)), porigin.include = FALSE, pellipses = list(col = "blue")) g9 <- s.distri(xy6, rpjdl$fau[, 12], ellipseSize = 1.5, psub = list(text = rpjdl$frlab[5], cex = 2, pos = c(0.2, 0.1)), porigin.include = FALSE, pellipses = list(col = "red"), add = TRUE) show(g9) ## g8 is a superposition, an ADEgS object ## add index <- c(1, 5, 8, 20, 21, 23, 26, 33, 36, 44, 47, 49) col <- colorRampPalette(c("blue", "red", "orange"))(49) s.distri(xy6, rpjdl$fau[, 1], ellipseSize = 1, starSize = 0, porigin.include = FALSE, pellipses = list(col = col[1], alpha = 0.3)) for(i in index[-1]) s.distri(xy6, rpjdl$fau[, i], ellipseSize = 1, starSize = 0, porigin.include = FALSE, pellipses = list(col = col[i], alpha = 0.3), add = TRUE) current <- get("currentadeg", env = adegraphics:::.ADEgEnv) print(current[[6]]) length(current) == length(index)adegraphics/tests/s.density.R0000644000176200001440000000211013742303021015716 0ustar liggesuserslibrary(adegraphics) pdf("s.density.pdf") xx1 <- rnorm(1000, 1, 2) yy1 <- rnorm(1000, 1, 2) g1 <- s.density(cbind(xx1, yy1), paxes.draw = T, gridsize = c(40, 40)) g2 <- s.density(cbind(xx1, yy1), paxes.draw = T, gridsize = c(80, 80), col = colorRampPalette(c("red", "blue"))(58), storeData = FALSE, region = TRUE) g3 <- s.density(cbind(yy1 + 3, xx1 + 3), gridsize = c(400, 400)) g4 <- s.density(cbind(xx1, yy1), paxes.draw = T, gridsize = c(200, 200), add = TRUE) g5 <- s.density(cbind(c(rnorm(50000, 1, 1), rnorm(50000, -1, 1)), c(rnorm(50000, -1, 0.5), rnorm(50000, 1, 0.5))), paxes.draw = T, gridsize = c(200, 200), region = TRUE, contour = TRUE, plabels.cex = 1, plabels.srt = "vertial") g6 <- s.density(cbind(rnorm(300, 3, 0.3), rnorm(300, -2, 0.5)), gridsize = c(500, 500), thres = 0.01, nr = 10, regions = list(alpha = 0.5), col = colorRampPalette(c("red", "blue"))(108)) g7 <- s.density(cbind(c(rnorm(50000, 1, 1), rnorm(50000, -1, 1)), c(rnorm(50000, -1, 0.5), rnorm(50000, 1, 0.5))), paxes.draw = T, gridsize = c(100, 100), region = TRUE, contour = TRUE, plabels.cex = 1, nclass = 5) adegraphics/tests/s.traject.R0000644000176200001440000000101313742303021015674 0ustar liggesuserslibrary(adegraphics) pdf("s.traject.pdf") rw <- function(a){ x <- 0 for(i in 1:49) x <- c(x, x[length(x)] + runif(1, -1, 1)) x } x <- unlist(lapply(1:5, rw), use.names = FALSE) y <- unlist(lapply(1:5, rw), use.names = FALSE) z <- gl(5, 50) g1 <- s.traject(data.frame(x, y), z, ppoints.pch = 19:23, plines.col = rainbow(5)) x <- unlist(lapply(1:2, rw), use.names = FALSE) y <- unlist(lapply(1:2, rw), use.names = FALSE) z <- gl(2, 50) g2 <- s.traject(data.frame(x, y), z, ppoints.pch = 21:20, plines.col = 1:2) adegraphics/tests/s1d.class.R0000644000176200001440000000246113742303021015602 0ustar liggesuserslibrary(adegraphics) pdf("s1d.class.pdf") data(meau, package = "ade4") ## ex1 envpca <- ade4::dudi.pca(meau$env, scannf = FALSE) g1 <- s1d.class(envpca$li[, 1], poslab = "value", meau$design$season, col = 1:6) update(g1, p1d.horizontal = FALSE) update(g1, p1d.reverse = TRUE) g2 <- s1d.class(envpca$li[, 1], meau$design$season, col = 1:6, p1d.reverse = TRUE) g3 <- s1d.class(envpca$li[, 1], meau$design$season, col = 1:6, p1d.hori = F) ## ex2 set.seed(0) score1 <- c(rnorm(3, mean = 0, sd = 0.5), rnorm(3, mean = 1, sd = 0.5), rnorm(5, mean = 2, sd = 0.5)) factor1 <- factor(rep(LETTERS[1:3], times = c(3, 3, 5))) g41 <- s1d.class(score1, factor1) g42 <- s1d.class(score1, factor1, col = 1:3) g43 <- s1d.class(score1, factor1, col = TRUE) g44 <- s1d.class(score1, factor1, col = FALSE) g45 <- s1d.class(score1, factor1, plines.col = "grey") g46 <- s1d.class(score1, factor1, plines.col = "grey", col = TRUE) ## ex3 score2 <- c(rnorm(10, mean = 0, sd = 0.5), rnorm(15, mean = -1, sd = 0.2), rnorm(10, mean = 2, sd = 0.5)) factor2 <- factor(rep(c(1, 3, 2), times = c(10, 15, 10))) levels(factor2) <- c("mean0", "mean2", "mean-1") g5 <- s1d.class(score2, factor2, col = 1:3) update(g5, posla = "value") indx <- rank(rnorm(35)) factor2 <- factor2[rank(indx)] s1d.class(score2[indx], factor2[indx], col = 1:3, posla = "regular") adegraphics/tests/panelSpatial.R0000644000176200001440000001026314516703533016437 0ustar liggesuserslibrary(ade4) library(adegraphics) library(sp) pdf("panelSpatial.pdf") ## ex1 data(mafragh, package = "ade4") dfxy1 <- coordinates(mafragh$Spatial) g1 <- s.label(dfxy1, Sp = mafragh$Spatial, pSp.col = colorRampPalette(c("yellow", "blue"))(97), pgrid.draw = FALSE, plabels.cex = 0) ## ex2 data(meuse, package = "sp") coordinates(meuse) <- ~ x + y data(meuse.grid, package = "sp") m <- SpatialPixelsDataFrame(points = meuse.grid[c("x", "y")], data = meuse.grid) data(meuse.riv) meuse.sr <- SpatialPolygons(list(Polygons(list(Polygon(meuse.riv)), "meuse.riv"))) scale1 <- list("SpatialPolygonsRescale", offset = c(179900, 329600), scale = 500, fill = c("transparent", "black"), layout.scale.bar()) text11 <- list("sp.text", c(179900, 329700), "0") text21 <- list("sp.text", c(180400, 329700), "500 m") arrow1 <- list("SpatialPolygonsRescale", offset = c(178750, 332500), scale = 400, layout.north.arrow()) river <- list("sp.polygons", meuse.sr, fill = "lightblue") dfxy2 <- as.data.frame(coordinates(meuse)) g2 <- s.value(dfxy2, z = meuse[, 1]$cadmium, sp.layout = list(scale1, text11, text21, arrow1, river), Sp = m) fac <- meuse@data$ffreq levels(fac)[1] <- "1 in 2 years" levels(fac)[2] <- "1 in 10 years" levels(fac)[3] <- "1 in 50 years" arrow2 <- list("SpatialPolygonsRescale", layout.north.arrow(), offset = c(181750, 330000), scale = 400) scale2 <- list("SpatialPolygonsRescale", layout.scale.bar(), offset = c(178050, 333600), scale = 500, fill = c("transparent", "black")) text12 <- list("sp.text", c(178050, 333700), "0") text22 <- list("sp.text", c(178550, 333700), "500 m") g3 <- s.class(dfxy2, fac = fac, sp.layout = list(scale2, text12, text22, arrow2, river), starSize = 1, col = c(1, 2, 4), pellipses.col = c(1, 2, 4), pellipses.alpha = 0.7, plines.lty = 3, psub.text = "Flooding frequency \n near the Meuse river", psub.pos = c(0.2, 0.88), pgrid.text.cex = 0, porigin.include = FALSE, Sp = meuse.sr) ## ex3 if(require(Guerry)) { data(gfrance85) dfxy4 <- coordinates(gfrance85) region.names <- data.frame(gfrance85)[, 5] col.region <- colors()[c(149, 254, 468, 552, 26)] g4 <- s.class(dfxy4, region.names, ellip = 0, star = 0, col = col.region, Sp = gfrance85, pSp.col = col.region[region.names], porig.inclu = F) } ## ex4 library(sp) library(lattice) data(elec88, package = "ade4") sp <- elec88$Spatial g5 <- xyplot(1 ~ 1, xlim = bbox(sp)[1, ], ylim = bbox(sp)[2, ], panel = function(...) {adeg.panel.Spatial(SpObject = sp, col = "black", border = "black")}) g6 <- xyplot(1 ~ 1, xlim = bbox(sp)[1, ], ylim = bbox(sp)[2, ], panel = function(...) {adeg.panel.Spatial(sp, col = 1:14, border = "black")}) g7 <- xyplot(1 ~ 1, xlim = bbox(sp)[1, ], ylim = bbox(sp)[2, ], aspect = "iso", panel = function(...) {sp.polygons(sp, col = "black", fill = 1:5)}) g8 <- xyplot(1 ~ 1, xlim = bbox(sp)[1, ], ylim = bbox(sp)[2, ], panel = function(...) {adeg.panel.Spatial(SpObject = sp, col = "black", border = "blue")}) g9 <- xyplot(1 ~ 1, xlim = bbox(sp)[1, ], ylim = bbox(sp)[2, ], panel = function(...) {adeg.panel.Spatial(SpObject = sp, col = "black", border = "blue")}) #g10 <- s.label(cbind(-80, 35), Sp = nc) #g11 <- s.label(cbind(-80, 35), Sp = sp) ## ex5 data(jv73, package = "ade4") g12 <- s.label(jv73$xy, Sp = jv73$Spatial) g13 <- s.label(jv73$xy, Sp = jv73$Spatial, pSp.col = "red") spoints <- SpatialPoints(jv73$xy) g14 <- s.label(jv73$xy, Sp = spoints, plab.cex = 0, ppoin.cex = 0, pSp.col = 1) sgrid <- SpatialGrid(GridTopology(c(0, 0), c(1, 1), c(3, 5))) xyplot(0:5 ~ 0:3, panel = function(...) sp.grid(sgrid, col = 1:2)) nc <- SpatialGridDataFrame(getGridTopology(sgrid), data = data.frame(matrix(1:15, ncol = 1))) xyplot(0:5 ~ 0:3, panel = function(...) sp.grid(nc, col = 1, at = pretty(rnorm(15), 2), col.region = 2:3)) xyplot(0:5 ~ 0:3, panel = function(...) adeg.panel.Spatial(nc, col = 1:3)) xyplot(0:5 ~ 0:3, panel = function(...) adeg.panel.Spatial(nc, col = 1:2)) ## ex6 mysp <- SpatialPointsDataFrame(matrix(rnorm(20), 10), data.frame(matrix(rnorm(20), 10))) s.Spatial(mysp) s.Spatial(mysp, col = c("red", "blue")) s.Spatial(mysp, ppoints.cex = 2) s.Spatial(mysp, ppoints.alpha = 0.5) s.Spatial(mysp, symbol = "circle") s.Spatial(mysp, method = "color", ppalette.quanti = colorRampPalette(c("red", "white", "blue")))adegraphics/tests/s.value.R0000644000176200001440000000357513742303021015373 0ustar liggesuserslibrary(adegraphics) pdf("s.value.pdf") ## ex1 xy <- cbind.data.frame(x = runif(50, -1, 1), y = runif(50, 0, 2)) z <- rnorm(50) z <- sapply(z, function(X) max(X, -3)) z <- sapply(z, function(X) min(X, 3)) val1 <- s.value(xy, z, method = "size", symbol = "square", plot = F) val2 <- s.value(xy, z, method = "color", symbol = "square", plot = F) val3 <- s.value(xy, z, method = "size", symbol = "circle", plot = F) val4 <- s.value(xy, z, method = "color", symbol = "circle", plot = F) g1 <- ADEgS(c(val1, val2, val3, val4), positions = layout2position(matrix(c(1, 2, 3, 4), 2, 2)), add = matrix(0, ncol = 4, nrow = 4)) g2 <- s.value(xy, z, method = "color", symbol = "square", breaks = c(-3, -1, -0.5, 0, 0.5, 1, 3)) g3 <- s.value(xy, z, method = "color", col = colorRampPalette(c("yellow", "blue"))(6)) g4 <- s.value(xy, z, method = "size", symbol = "circle", paxes.draw = FALSE) ## ex2 xx <- runif(100) * 100 yy <- 1:100 zz <- 1:100 breaks <- c(0, 25, 50, 75, 100) g5 <- s.value(data.frame(xx, yy), zz, breaks = breaks, method = "color", paxes.draw = TRUE, porigin.include = FALSE) g6 <- s.value(data.frame(xx, yy), cbind(zz, rev(zz)), breaks = breaks, method = "color", col = c("blue", "red", "green", "yellow"), paxes.draw = TRUE) g7 <- s.value(data.frame(xx, yy), cbind(zz, rev(zz)), nclass = c(2, 6), method = "color", col = c("blue", "red", "pink", "green", "yellow"), paxes.draw = TRUE) ## ex3 data(rpjdl, package = "ade4") fau.coa <- ade4::dudi.coa(rpjdl$fau, scan = FALSE, nf = 3) val5 <- s.value(fau.coa$li, fau.coa$li[,3], plot = FALSE) val6 <- s.value(fau.coa$li, fau.coa$li[, 3], center = 0, method = "size", symbol = "circle", col = c("yellow", "red"), plot = FALSE) g8 <- ADEgS(c(val5, val6), positions = layout2position(matrix(c(1, 2), 1, 2)), add = matrix(0, ncol = 2, nrow = 2)) ## ex3 data(doubs, package = "ade4") g9 <- s.value(doubs$xy, doubs$env[, 1:2]) g10 <- s.value(doubs$xy, doubs$env) adegraphics/tests/s1d.barchart.R0000644000176200001440000000175613742303021016271 0ustar liggesuserslibrary(ade4) library(adegraphics) pdf("s1d.barchart.pdf") ## 1 : reverse and horizontal set.seed(40) x1 <- rnorm(10) g11 <- s1d.barchart(x1) g12 <- s1d.barchart(x1, ppoly.col = "blue") g21 <- s1d.barchart(x1, p1d.hori = FALSE, p1d.rev = TRUE) g23 <- s1d.barchart(x1, p1d.hori = FALSE, p1d.rev = FALSE) g24 <- s1d.barchart(x1, p1d.hori = TRUE, p1d.rev = TRUE) g24 <- s1d.barchart(x1, p1d.hori = TRUE, p1d.rev = FALSE) ## 2 : at and sort data(rpjdl, package = "ade4") rpjdl.coa <- ade4::dudi.coa(rpjdl$fau, scannf = FALSE, nf = 4) nam <- rownames(rpjdl.coa$co) gg1 <- s1d.barchart(rpjdl.coa$co[, 1]) gg2 <- s1d.barchart(rpjdl.coa$co[, 1], labels = nam, at = 51:1) gg3 <- s1d.barchart(rpjdl.coa$co[, 1], labels = nam, sort = TRUE) gg4 <- s1d.barchart(rpjdl.coa$co[, 1], labels = nam, sort = TRUE, at = 51:1) # 'at' is ignored gg5 <- s1d.barchart(rpjdl.coa$co, labels = nam, sort = TRUE) gg6 <- s1d.barchart(rpjdl.coa$co, labels = nam, sort = FALSE) stopifnot(gg6[[1]]@data$labels == gg6[[2]]@data$labels) adegraphics/tests/s.image.R0000644000176200001440000000172213742303021015331 0ustar liggesuserslibrary(adegraphics) library(sp) pdf("s.image.pdf") ## ex1 xy <- data.frame(expand.grid(-3:3, -3:3)) names(xy) <- c("x", "y") z <- (1 / sqrt(2)) * exp(-(xy$x ^ 2 + xy$y ^ 2) / 2) s.image(xy, z) s.image(xy, z, grid = 20) s.image(xy, z, grid = 500) ## ex2 Sr1 <- Polygon(cbind(c(0, 1, 2, 1, 2, 0 , -2, -1, -2, -1, 0), c(2.5, 1.5, 2, 0, -2, -1, -2, 0, 2, 1.5, 2.5))) Srs1 <- Polygons(list(Sr1), ID = "stars") SPp1 <- SpatialPolygons(list(Srs1)) xy1 <- cbind(rnorm(100, 0, 1), rnorm(100, 0, 1.5)) g1 <- s.image(xy1, runif(100), outsideLimits = SPp1) ## ex3 Sr2 <- Polygon(cbind(c(-0.5, 0.5, 0.5, -0.5, -0.5), c(0, 0, 1 ,1, 0)), hole = TRUE) Srs2 <- Polygons(list(Sr1, Sr2), ID = "hole") SPp2 <- SpatialPolygons(list(Srs2)) xy2 <- cbind(c(rnorm(2000, 1, 0.25), rnorm(3000, -1, 1.5)), c(rnorm(2000, 1, 0.5), rnorm(3000, -1, 3))) z <- c(rnorm(2000, 12, 1), rnorm(3000, 1, 2)) g2 <- s.image(xy2, z, outsideLimits = SPp2, grid = 500, xlim = c(-2.5, 2.5), ylim = c(-2, 3)) adegraphics/tests/s.arrow.R0000644000176200001440000000222613742303021015401 0ustar liggesuserslibrary(adegraphics) pdf("s.arrow.pdf") ## ex1 : from tdr641 data(doubs, package = "ade4") dudi1 <- ade4::dudi.pca(doubs$env, scale = T, scan = F, nf = 3) dudi2 <- ade4::dudi.pca(doubs$fish, scale = T, scan = F, nf = 2) coin1 <- ade4::coinertia(dudi1, dudi2, scan = F, nf = 2) g1 <- s.arrow(coin1$l1, plabels.cex = 0.87) g2 <- s.arrow(coin1$c1, plabels.cex = 1) ## ex2 : from bs81 data(granulo, package = "ade4") w <- data.frame(t(apply(granulo$tab, 1, function(x) x / sum(x)))) g3 <- s.arrow(ade4::dudi.pca(data.frame(w), scan = F, nf = 2)$co) wtr <- data.frame(t(w)) wmoy <- data.frame(matrix(apply(wtr, 1, mean), 1)) dudi3 <- ade4::dudi.pca(w, scal = FALSE, scan = FALSE) wmoy <- ade4::suprow(dudi3, wmoy)$lisup g4 <- s.arrow(dudi3$c1, plabels.cex = 1.5) g4 <- s.distri(dudi3$c1, wtr, starSize = 0.33, ellipseSize = 0, add = TRUE, plabels.cex = 1) g4 <- s.label(wmoy, ppoint.cex = 5, plabels.cex = 0, add = TRUE) ## ex3 data(deug, package = "ade4") pca1 <- ade4::dudi.pca(deug$tab, scal = FALSE, center = deug$cent, scan = FALSE) g5 <- s.arrow(40 * pca1$c1) ## ex4 xy <- cbind(rnorm(50), rnorm(50)) g6 <- s.arrow(xy, plabels.cex = 0.9, parrows = list(angle = 20)) adegraphics/tests/s.label.R0000644000176200001440000000173213742303021015327 0ustar liggesuserslibrary(adegraphics) library(grid) pdf("s.label.pdf") x0 <- runif(50, -2, 2) y0 <- runif(50, -2, 2) z <- x0 ^ 2 + y0 ^ 2 dfxy1 <- data.frame(x0, y0) g1 <- s.label(dfxy1, label = as.character(z < 1), paxes.draw = TRUE, axis.text = list(col = "grey")) g2 <- s.label(dfxy1[1, ]) g3 <- s.label(dfxy1[1, ], pori.incl = FALSE) g4 <- s.label(dfxy1, labels = c("", "MM", "", NA, "ooo"), plabels.optim = TRUE) g5 <- s.label(dfxy1, labels = as.character(z < 1), psub = list(text = "Subtitle", col = "blue", position = "topleft"), plabels.col = 1:5, pgrid.text.pos = c(unit(0.95, "npc"), unit(0.94, "npc"))) dfxy2 <- cbind(dfxy1, runif(50, -5, 5)) g6 <- s.label(dfxy2, xax = 1, yax = 2:3, paxes.draw = TRUE, paxes.aspectratio = 1.5, plabels.cex = 0.8) l <- ls() x1 <- runif(length(l)) x2 <- runif(100) y1 <- runif(length(l)) y2 <- runif(100) g7 <- s.label(cbind(x2, y2), labels = as.character((x2 * x2 + y2 * y2) < 1)) g8 <- s.label(cbind(x1, y1), labels = l, add = TRUE, plabels.col = "blue") adegraphics/tests/s1d.gauss.R0000644000176200001440000000243013742303021015613 0ustar liggesuserslibrary(adegraphics) pdf("s1d.gauss.pdf") data(meau, package= "ade4") envpca <- ade4::dudi.pca(meau$env, scannf = FALSE) dffac <- cbind.data.frame(meau$design$season, meau$design$site) g11 <- s1d.gauss(envpca$li[, 1], dffac[, 1]) g12 <- s1d.gauss(envpca$li[, 1], dffac[, 1], p1d.rev = TRUE) g13 <- s1d.gauss(envpca$li[, 1], dffac[, 1], p1d.hori = FALSE) g14 <- s1d.gauss(envpca$li[, 1], dffac[, 1], p1d.hori = FALSE, p1d.rev = TRUE) g2 <- s1d.gauss(envpca$li[, 1], dffac[, 1], ppoly.col = 1:4, fill = TRUE, plines.col = 1:4, col = FALSE) g31 <- s1d.gauss(envpca$li[, 1], dffac[, 2], ppoly.col = 1:4, paxes.draw = TRUE, ylim = c(0, 2), fill = TRUE, p1d.hori = FALSE) g32 <- s1d.gauss(envpca$li[, 1], dffac[, 2], ppoly.col = 1:4, paxes.draw = TRUE, fill = TRUE, p1d.hori = FALSE) g4 <- s1d.gauss(envpca$li[, 1], fac = dffac, fill = TRUE, col = 1:5) g5 <- s1d.gauss(envpca$li[, 1], fac = dffac, fill = TRUE, col = FALSE, ppoly.col = 1:6) g6 <- s1d.gauss(envpca$li[, 1], fac = dffac[, 1], fill = TRUE, col = 1:6, ppoly.col = 1:6) g7 <- s1d.gauss(envpca$li[, 1], fac = dffac, fill = TRUE, col = 1:6, ppoly.col = 1:6, steps = 10) g8 <- s1d.gauss(envpca$li[, 1], dffac[, 2]) update(g11, p1d.reverse = TRUE) update(g12, p1d.reverse = FALSE) update(g13, p1d.reverse = TRUE) update(g14, p1d.reverse = FALSE) adegraphics/tests/s1d.distri.R0000644000176200001440000000127413742303021015774 0ustar liggesuserslibrary(adegraphics) pdf("s1d.distri.pdf") ## ex1 score <- rnorm(10) df <- data.frame(matrix(rep(c(1, 2), 10), ncol = 2)) g1 <- s1d.distri(score, df) ## ex2 set.seed(1) w <- seq(-1, 1, le = 200) distri <- data.frame(lapply(1:50, function(x) sample(200:1) * ((w >= (- x / 50)) & (w <= x / 50)))) names(distri) <- paste("w", 1:50, sep = "") g2 <- s1d.distri(w, distri) g3 <- s1d.distri(w, distri, yrank = TRUE, sdS = 1.5) g4 <- s1d.distri(w, distri, p1d.rug.draw = FALSE) g5 <- s1d.distri(w, distri, p1d.reverse = TRUE) g6 <- s1d.distri(w, distri, p1d.hori = FALSE) g7 <- s1d.distri(w, distri, p1d.hori = FALSE, p1d.reverse = TRUE) update(g2, p1d.rug.draw = FALSE) update(g5, p1d.rug.draw = FALSE) adegraphics/tests/nbgraph.R0000644000176200001440000000067414511210167015437 0ustar liggesuserslibrary(ade4) library(adegraphics) library(sp) library(lattice) pdf("nbgraph.pdf") if(require(spdep)) { data(elec88, package = "ade4") coords <- sp::coordinates(elec88$Spatial) xyplot(coords[, 2] ~ coords[, 1], panel = function(...) {adeg.panel.nb(elec88$nb, coords)}) g1 <- s.label(coords, nb = elec88$nb, porigin.include = F, plabels.cex = 0.7, ppoints.cex = 2, Sp = elec88$Spatial, pSp.col = "red", pSp.alpha = 0.5) }adegraphics/tests/triangle.R0000644000176200001440000000373613742303021015622 0ustar liggesuserslibrary(adegraphics) pdf("triangle.pdf") ## ex1 data(euro123, package = "ade4") dfxyz1 <- rbind.data.frame(euro123$in78, euro123$in86, euro123$in97) row.names(dfxyz1) <- paste(row.names(euro123$in78), rep(c(1, 2, 3), rep(12, 3)), sep = "") g1 <- triangle.label(dfxyz1, label = row.names(dfxyz1)) g2 <- triangle.label(euro123$in86, label = row.names(euro123$in78), plab.cex = 0.8) g3 <- triangle.match(euro123$in78, euro123$in86) g4 <- triangle.label(rbind.data.frame(euro123$in78, euro123$in86), plab.cex = 1, addaxes = TRUE, psub = list(text = "Principal axis", cex = 2, pos = "topright")) g5 <- triangle.label(euro123[[1]], min3 = c(0, 0.2, 0.3), max3 = c(0.5, 0.7, 0.8), plabels.cex = 1, label = row.names(euro123[[1]]), addax = TRUE) g6 <- triangle.label(euro123[[2]], min3 = c(0, 0.2, 0.3), max3 = c(0.5, 0.7, 0.8), label = row.names(euro123[[1]]), addax = TRUE) g7 <- triangle.label(euro123[[3]], min3 = c(0, 0.2, 0.3), max3 = c(0.5, 0.7, 0.8), label = row.names(euro123[[1]]), addax = TRUE) g8 <- triangle.label(rbind.data.frame(euro123[[1]], euro123[[2]], euro123[[3]])) ## ex2 dfxyz2 <- cbind.data.frame(a = runif(100), b = runif(100), c = runif(100, 4, 5)) g9 <- triangle.label(dfxyz2) ## ex3 g10 <- triangle.label(dfxyz1) g11 <- triangle.class(dfxyz1, as.factor(rep("G", 36)), star = 0.5, ellips = 1) g12 <- triangle.class(dfxyz1, euro123$plan$an) g13 <- triangle.class(dfxyz1, euro123$plan$pays) g14 <- triangle.class(dfxyz1, euro123$plan$an, elli = 1, pell.axe.draw = TRUE) g15 <- triangle.class(dfxyz1, euro123$plan$an, elli = 0, sta = 0, col = c("red", "green", "blue"), pell.axe.draw = TRUE, plab.cex = 2, ppoi.cex = 2, pell.axe.draw = TRUE) g16 <- triangle.class(dfxyz1, euro123$plan$an, ell = 2, sta = 0.5, pell.axe.draw = TRUE, plab.cex = 1.5) g17 <- triangle.class(dfxyz1, euro123$plan$an, ell = 0, sta = 1, adjust = FALSE) g18 <- triangle.class(dfxyz1, euro123$plan$an, ell = 0, sta = 1, chull =c(0.2, 0.25, 0.5, 0.75, 1), adjust = TRUE, showposi = TRUE, col = 10:13, pgrid.draw = FALSE) adegraphics/tests/table.image.R0000644000176200001440000000161413742303021016156 0ustar liggesuserslibrary(adegraphics) pdf("table.image.pdf") ## ex1 x <- 1:4 y <- 1:4 df <- data.frame(as.matrix(cbind(x, y))) g1 <- table.image(df, col = 2:4) update(g1, plegend.drawColorKey = TRUE) ## ex2 df <- matrix(0, 10, 10) df[1:3, 1:3] <- 5 g2 <- table.image(df) g3 <- table.image(df, breaks = c(5, 2, 0)) ## ex3 data(rpjdl, package = "ade4") X <- data.frame(t(rpjdl$fau)) Y <- data.frame(t(rpjdl$mil)) coa1 <- ade4::dudi.coa(X, scan = FALSE) x <- rank(coa1$co[, 1]) y <- rank(coa1$li[, 1]) g4 <- table.image(Y, coordsx = x, coordsy = 1:8, axis.text = list(alpha = 0), pgrid.col = "black", pgrid.lwd = 0.8, col = c("white", "black"), plegend.drawKey = FALSE) g5 <- table.image(X, coordsx = x, coordsy = y, ptable = list(x = list(tck = 0), y = list(tck = 4)), pleg.drawKey = FALSE, labelsy = paste(" ", row.names(X), sep = "")) g6 <- ADEgS(list(g4, g5), positions = rbind(c(0, 0, 1, 0.3), c(0, 0.4, 1, 1))) adegraphics/tests/s1d.label.R0000644000176200001440000000104613742303021015552 0ustar liggesuserslibrary(adegraphics) pdf("s1d.label.pdf") data(meau, package= "ade4") envpca <- ade4::dudi.pca(meau$env, scannf = FALSE) g1 <- s1d.label(envpca$l1[, 1], row.names(envpca$l1)) g2 <- s1d.label(envpca$l1[, 1], row.names(envpca$l1), p1d.hori = F) g3 <- s1d.label(envpca$l1[, 1], row.names(envpca$l1), plabels.boxes.draw = FALSE, plab.srt = 45, plabel.boxes = list(draw = FALSE)) g4 <- s1d.label(envpca$co[, 1], row.names(envpca$co), p1d.reverse = TRUE, poslabel = "value") g5 <- s1d.label(envpca$l1[, 1], row.names(envpca$l1), at = 0, plabel.cex = 0) adegraphics/tests/parameter.R0000644000176200001440000001135613742303021015772 0ustar liggesuserslibrary(ade4) library(adegraphics) pdf("parameter.pdf") adegparold <- adegpar() b1 <- length(adegraphics:::separation(plines = list(col = "blue"), plab.bo.dra = FALSE, plab = list(orien = F))$rest) == 0 b2 <- length(adegraphics:::separation(plines = list(col = "blue", lwd = c(1:5)), parr.end = NA, plab.boxes.dr = FALSE)$rest) == 0 b3 <- length(adegraphics:::separation(plot.li = list(col = "blue", lwd = c(1:5)), par.end = NA, pl.boxes.draw = FALSE, pattern = 1)$rest) == 2 b4 <- length(adegraphics:::separation(plot.li = list(col = "blue", lwd = c(1:5)), par.end = NA, pl.boxes.draw = FALSE, pattern = 0)$rest) == 2 b5 <- length(adegraphics:::separation()) == 2 b6 <- length(adegraphics:::separation(par.sub.text = list("lineheight" = 5), pattern = 1)$rest) == 0 b7 <- names(adegraphics:::separation(toto = "rienavoir!")$rest) == "toto" b8 <- names(adegraphics:::separation(toto = "rienavoir!", pattern = 1)$rest) == "toto" l1 <- list(parrow = list(col = "blue", lwd = c(1:5), end = NA), plboxes.draw = FALSE, pattern = 1) sep1 <- adegraphics:::separation(l1) ## no recognition of "pattern" in a list l2 <- list("parrow.lwd", "plboxes.draw") sep2 <- adegraphics:::separation(l2) sep3 <- adegraphics:::separation("plboxes" = list("draw" = FALSE, "col")) sep4 <- adegraphics:::separation("plboxes" = list("draw" = FALSE, "col" = 2)) sep5 <- adegraphics:::separation(pla.box = list(col = 1:5)) sep6 <- adegraphics:::separation(pla.box.col = c(1:5)) sep7 <- adegraphics:::separation(pla = list(box.col = 1:5)) ## don't match ## adegpar test ad1 <- adegpar() ad2 <- adegpar("paxes.draw") ad3 <- adegpar("paxes.draw", "psub.cex") ad4 <- adegpar("psub.cex" = 5) ad5 <- adegpar("psub.cex" = 5, paxes.draw = FALSE) ad6 <- adegpar("psub") ad7 <- adegpar("psub.cex", "plabe.boxes") ad8 <- adegpar(ppoints = list(col = "yellow"), pgrid.space = 4, plines = list(lwd = c(1:5))) ad9 <- adegpar(ppoints = list(col = "red"), pgrid = list(nint = 12), plines = list(lwd = c(1:5))) ad10 <- adegpar("ppoints.col", "pgrid.nint", "plines") ad11 <- adegpar(paxes = list("x"), pgrid = list("nint", "col")) ad12 <- adegpar(list(pellip = list(col = "red"), grid.nint = 8, plines = list(lwd = c(1:5)))) ad13 <- adegpar(paxes = list("x"), pgrid = list("nint", "col"), "plines", "pellipse") ad14 <- adegpar(plegend.drawKey = FALSE) ad15 <- adegpar(list(paxes = list(col = "white"), pgrid.nint = 6, plines = list(lwd = c(1:5)))) ad16 <- adegpar(paxes = list(x = list(draw = TRUE))) adegpar(adegparold) ## merging list l3 <- list(plabels = list(boxes = list(col = "white", alpha = 1)), plabels = list(cex = 2), plabels = list(col = "red")) adegraphics:::.mergingList(l3) adegraphics:::.mergingList(list(plabels = list(cex = 3))) ## update parameters in graphics cha <- rep(LETTERS, length.out = 100) xy <- cbind.data.frame(runif(length(cha)), runif(length(cha))) g1 <- s.label(xy, labels = cha, paxes.draw = TRUE, plabels.cex = runif(length(cha), 0.5, 1.5)) update(g1, paxes = list(aspect = "fill", draw = TRUE, x = list(draw = FALSE)), pgrid = list(col = "black", lwd = 2, lty = 5), plabels = list(col = 1:4, alpha = 0.5, cex = 2, boxes = list(border = "blue", col = "antiquewhite", alpha = 0.2, lwd = 2.5, lty = 5))) g2 <- s.label(xy, labels = cha) update(g2, paxes.draw = FALSE, pgrid = list(col = "blue", lwd = 2, lty = 5, text = list(pos = "bottomright", cex = 2, col = "green"))) update(g2, porigin = list(alpha = 0.5, col = "red", lty = 5 , lwd = 2, origin = c(0.6, 0.1)), pgrid.lwd = 0.5) update(g2, psub = list(text = "parameters", cex = 2, col = "red", position = "topright")) update(g2, plabels.cex = 0, ppoints = list(alpha = 0.4, cex = 2, col = "red", fill = "blue", pch = 21)) ## from tdr641 data(doubs, package = "ade4") dudi1 <- ade4::dudi.pca(doubs$env, scale = T, scannf = F, nf = 3) dudi2 <- ade4::dudi.pca(doubs$fish, scale = T, scannf = F, nf = 2) coin1 <- ade4::coinertia(dudi1, dudi2, scannf = F, nf = 2) g3 <- s.arrow(coin1$l1, plabels.cex = .87) update(g3, plines = list(col = "blue", lwd = 2, lty = 3), parr.end = "both", parr = list(angle = 25, length = 0.5)) ## with spatial object data(elec88, package = "ade4") g4 <- s.label(elec88$xy, label = as.character(1:nrow(elec88$xy)), porigin.include = FALSE, Sp = elec88$Spatial, pSp.col = colorRampPalette(c("yellow", "blue"))(5), pgrid.draw = TRUE) update(g4, pSp = list(col = "yellow", border = "blue", lwd = 2, lty = 5, alpha = 0.01)) ## don't match : to solve ## plabels parameter data(tortues, package = "ade4") pturtles <- tortues names(pturtles) <- c("length", "width", "height", "sex") sex <- pturtles$sex sexcol <- ifelse(sex == "M", "blue", "red") measures <- pturtles[, 1:3] pca1 <- ade4::dudi.pca(measures, scann = FALSE, nf = 3) g5 <- scatter(pca1, row.plabel.cex = 0, col.plabel.cex = c(1, 2, 3), posieig = "none", col.plabel.col = c("red", "blue", "green")) adegraphics/tests/ade4-functions.R0000644000176200001440000001110714520214453016634 0ustar liggesusers## delete/remove this file when 'scatter' functions will be removed in ade4 library(adegraphics) pdf("ade4-functions.pdf") ##################### scatter.dudi data(deug, package = "ade4") dd1 <- ade4::dudi.pca(deug$tab, scannf = FALSE, nf = 4) scatter(dd1, posieig = "bottomright") scatter(dd1, posieig = "bottomright", plot = T, prop = TRUE) scatter(dd1, posieig = "none", plot = T) scatter(dd1, posieig = "bottomleft", plot = T) scatter(dd1, posieig = "topright", plot = T) scatter(dd1, posieig = "topleft", plot = T, eig.col = c("white", "blue", "red")) data(rhone, package = "ade4") dd1 <- ade4::dudi.pca(rhone$tab, nf = 4, scannf = FALSE) g1 <- scatter(dd1, sub = "Principal component analysis", row = list(plabels.optim = TRUE), col.pla.boxes.alpha = 0.5) g1[2, drop = TRUE] scatter(dd1, row = list(sub = "Principal component analysis", plabels.optim = TRUE), col.pla.boxes.alpha = 0.5) scatter(dd1, prop = TRUE, ppoints.cex = 0.2, density.plot = TRUE, row = list(threshold = 0.01)) scatter(dd1, posieig = "none") scatter(dd1, posieig = "bottomright") scatter(dd1, posieig = c(0.5, 0.5)) scatter(dd1, posieig = c(0.5, 0.5, 1, 1)) ##################### scatter.coa data(housetasks, package = "ade4") par(mfrow = c(2, 2)) dd2 <- ade4::dudi.coa(housetasks, scan = FALSE) ade4::scatter(dd2, method = 1, sub = "1 / Standard", posieig = "none") ade4::scatter(dd2, method = 2, sub = "2 / Columns -> averaging -> Rows", posieig = "none") ade4::scatter(dd2, method = 3, sub = "3 / Rows -> averaging -> Columns ", posieig = "none") par(mfrow = c(1, 1)) g1 <- scatter(dd2, method = 1, row.sub = "1 / Standard", posieig = "none", plot = FALSE) g2 <- scatter(dd2, method = 2, col.sub = "2 / Columns -> averaging -> Rows", posieig = "none", plot = FALSE) g3 <- scatter(dd2, method = 3, row.sub = "3 / Rows -> averaging -> Columns ", posieig = "none", plot = FALSE) G <- ADEgS(list(g1, g2, g3), layout = c(2, 2), plot = TRUE) scatter(dd2, posieig = "none") scatter(dd2, posieig = "bottomright") scatter(dd2, posieig = c(0.5, 0.5)) scatter(dd2, posieig = c(0.5, 0.5, 1, 1)) ##################### scatter.pco data(yanomama, package = "ade4") gen <- ade4::quasieuclid(as.dist(yanomama$gen)) gen1 <- ade4::dudi.pco(gen, scann = FALSE, nf = 3) scatter(gen1, posieig = "none") scatter(gen1, posieig = "bottomri") scatter(gen1, posieig = c(0.5, 0.5)) scatter(gen1, posieig = c(0.5, 0.5, 1, 1)) ##################### scatter.nipals data(doubs, package = "ade4") acp1 <- ade4::dudi.pca(doubs$env, scannf = FALSE, nf = 2) nip1 <- ade4::nipals(doubs$env) scatter(nip1, posieig = "none") scatter(nip1, posieig = "bottomri") scatter(nip1, posieig = c(0.5, 0.5)) scatter(nip1, posieig = c(0.5, 0.5, 1, 1)) ##################### score.inertia - plot.inertia data(housetasks, package = "ade4") coa2 <- ade4::dudi.coa(housetasks, scann = FALSE) res21 <- ade4::inertia(coa2, row = TRUE, col = FALSE) plot(res21, posieig = "none") plot(res21, posieig = "bottomri") plot(res21, posieig = c(0.5,0.5)) plot(res21, posieig = c(0.5, 0.5, 1, 1)) score(res21, posieig = "none") score(res21, posieig = "bottomri") score(res21, posieig = c(0.5, 0.5)) score(res21, posieig = c(0.5, 0.5, 1, 1)) res22 <- ade4::inertia(coa2, row = FALSE, col = TRUE) plot(res22, posieig = "none") plot(res22, posieig = "bottomri") plot(res22, posieig = c(0.5, 0.5)) plot(res22, posieig = c(0.5, 0.5, 1, 1)) score(res22, posieig = "none") score(res22, posieig = "bottomri") score(res22, posieig = c(0.5, 0.5)) score(res22, posieig = c(0.5, 0.5, 1, 1)) res23 <- ade4::inertia(coa2, row = TRUE, col = TRUE) plot(res23, posieig = "none") plot(res23, posieig = "bottomri") plot(res23, posieig = c(0.5, 0.5)) plot(res23, posieig = c(0.5, 0.5, 1, 1)) score(res23, posieig = "none") score(res23, posieig = "bottomri") score(res23, posieig = c(0.5, 0.5)) score(res23, posieig = c(0.5, 0.5, 2, 2)) data(doubs, package = "ade4") afc <- ade4::dudi.coa(doubs$fish, scannf = FALSE, nf = 5) ic <- ade4::inertia.dudi(afc, row.inertia=TRUE, col.inertia=TRUE) plot(ic, contrib = "abs", threshold = 0.1, type = "label") plot(ic, contrib="abs", threshold = 0.1, type = "label", xax = 3, yax = 4) ##################### plot.acm data(lascaux, package = "ade4") acm1 <- ade4::dudi.acm(lascaux$ornem, sca = FALSE) p1 <- proc.time() ade4::scatter(acm1) Tade4 <- proc.time() - p1 p2 <- proc.time() plot(acm1, ppoints.cex = 0.3, plot = T) Tadegraphics <- proc.time() - p2 ## faster calculus, longest display than for ade4 ##################### plot.fca data(coleo, package = "ade4") coleo.fuzzy <- ade4::prep.fuzzy.var(coleo$tab, coleo$col.blocks) fca1 <- ade4::dudi.fca(coleo.fuzzy, scannf = FALSE, nf = 3) ade4::scatter(fca1) plot(fca1) adegraphics/tests/table.value.R0000644000176200001440000000551413742303021016213 0ustar liggesuserslibrary(adegraphics) pdf("table.value.pdf") ## ex1 data(olympic, package = "ade4") tab1 <- data.frame(scale(olympic$tab)) pca <- ade4::dudi.pca(tab1, scann = FALSE) g1 <- table.value(tab1, axis.line = list(col = "blue"), axis.text = list(col = "grey")) g2 <- table.value(tab1, coordsx = c(1:5, 10:6)) g3 <- table.value(tab1, coordsx = c(1:5, 10:8)) g4 <- table.value(tab1, coordsy = rank(pca$li[, 1]), coordsx = rank(pca$co[, 1]), method = "color") g5 <- table.value(tab1, coordsy = pca$li[, 1], coordsx = pca$co[, 1], ptable = list(x = list(srt = 90))) ## ex2 data(eurodist) g61 <- table.value(eurodist) g62 <- table.value(eurodist, store = TRUE, symbol = "circle") g63 <- table.value(eurodist, store = FALSE, psub.text = "eurodist", psub.position = c(0, -0.04)) g64 <- table.value(eurodist, ptable.margin = list(b = 17, t = 17, l = 17, r = 17)) g65 <- table.value(eurodist, ptable.x = list(pos = "bottom"), ptable.margin = list(b = 17, t = 17, l = 17, r = 17)) ## ex3 data("doubs", package = "ade4") tab2 <- as.table(as.matrix(doubs$fish)) g8 <- table.value(tab2) ## ex4 data(chats, package = "ade4") tab3 <- as.table(as.matrix(data.frame(t(chats)))) coa1 <- ade4::dudi.coa(data.frame(t(chats)), scann = FALSE) adegparold <- adegpar() adegpar(ptable = list(x = list(pos = "bottom", srt = 0), y = list(pos = "left")), plegend.drawKey = FALSE) g9 <- table.value(tab3, meanX = TRUE, ablineX = TRUE) g10 <- table.value(tab3, meanY = TRUE, ablineY = TRUE) g11 <- table.value(tab3, coordsx = coa1$c1[, 1], coordsy = coa1$l1[, 1], meanX = TRUE, ablineX = TRUE) g12 <- table.value(tab3, coordsx = coa1$c1[, 1], coordsy = coa1$l1[, 1], meanY = TRUE, ablineY = TRUE) g13 <- ADEgS(list(g9, g10, g11, g12), pos = rbind(c(0, 0.5, 0.5, 1), c(0.5, 0.5, 1, 1), c(0, 0, 0.5, 0.5), c(0.5, 0, 1, 0.5))) adegpar(adegparold) ## ex5 data(rpjdl, package = "ade4") tab4 <- data.frame(t(rpjdl$fau)) coa2 <- ade4::dudi.coa(tab4, scann = FALSE) g14 <- table.value(tab4, coordsx = coa2$c1[, 1], coordsy = rank(coa2$l1[, 1]), axis.text = list(cex = 0), labelsy = rpjdl$lalab, plot = F) ## ex6 tab5 <- as.table(matrix(rep(0, 100), 10)) tab5[1:5, 1:5] <- 10 ade4::table.cont(tab5, abmean.x = T, y = 10:1) g15 <- table.value(tab5, coordsy = 10:1, meanX = T) g16 <- table.value(tab5, coordsy = 10:1, meanX = T, meanY = TRUE, ablineX = TRUE, ablineY = TRUE) ## ex7 tab6 <- matrix(rep(0, 100), 10) tab6[1:5, 1:5] <- 20 colnames(tab6) <- LETTERS[1:10] rownames(tab6) <- LETTERS[1:10] ade4::table.value(tab6, x = 1:10, y = 10:1) g17 <- table.value(tab6, coordsx = 1:10, coordsy = 10:1) g18 <- table.value(tab6, coordsx = 1:10, coordsy = c(1, 2, 5, 6, 8, 9, 10, 3, 4, 7)) ## ex8 d <- as.dist(matrix(rep(1:5, 5), 5), upper = TRUE) attr(d, "Labels") <- c ("A", "B", "C", "D", "E") g4 <- table.value(d) ## ex9 data(irishdata, package = "ade4") d.geo <- dist(irishdata$xy.utm) g5 <- table.value(d.geo) adegraphics/MD50000644000176200001440000002456114774713152013057 0ustar liggesuserse0670df238e6c4e4f77769832fe4b779 *DESCRIPTION 7a2bb639515e90741a3b754f4dfb53c5 *NAMESPACE 6f74ca1d6869610883364261fdb3a85b *R/ADEg.C1.R f9398e5cc9c57c5c4b6835dde14f7bc5 *R/ADEg.R b0d456702948c478289e233bb2d6821c *R/ADEg.S1.R 522e9e371f20c1de07a07d43e8c1c17c *R/ADEg.S2.R 2545695c9bb86d7dff7813f355bb224d *R/ADEg.T.R b4a31e4d6d66b198dfca50fbb945cdeb *R/ADEg.Tr.R b79114f2aa3977da3b2c05d4b08129ff *R/ADEgS.R d6f0c6730a3f5be15659bfe2ce2fb462 *R/C1.barchart.R 1f4103b624811d0b729c057dc6867bc7 *R/C1.curve.R 76136e17a4e5d68fe309c19edc1be83d *R/C1.curves.R 913e0d087fe9131efd6334a8863f17ad *R/C1.density.R f798f96b582b953940858322f83d8b7e *R/C1.dotplot.R 06da697087e69fb8e9b534408441364c *R/C1.gauss.R e9057d5301f4fa57dbdaf86117517f71 *R/C1.hist.R 1ca0f312a9aa8ae5be1e1e0845820d87 *R/C1.interval.R e9fb52648a715b8569c875be01d80fd4 *R/S1.boxplot.R 735ea8ac922bb40b8bda34361b778457 *R/S1.class.R b7188f7d92e5986ec6c987188978d26d *R/S1.distri.R 49299eab6e71fa09994fc724ded2052f *R/S1.label.R 003a1a9798720cffd544741a9dcab3ec *R/S1.match.R d2158ec7e703b4b23d779c9b66ef8b07 *R/S2.arrow.R c9c37b88bee570cb17ddc2d8dfc17b8e *R/S2.class.R 6342c5bb617412bf649c8eaa0a74feda *R/S2.corcircle.R 75fd05b0a8651d3e7afe32b2457d926c *R/S2.density.R 0ae00589ce3d17c1fadfc7dcb154be51 *R/S2.distri.R 483a6225905acc06feea74922668e798 *R/S2.image.R 52ced134bad7a2203ef4e538821080d7 *R/S2.label.R bdc79dbb85c026ddbaf264e646d4543c *R/S2.logo.R 5fdf0105d4cb987efd8a82d8845d48b6 *R/S2.match.R 1e27841e9bb7f69d78a4e8c7bf95cdb2 *R/S2.traject.R 81d93764f3b498c5b57e185594d58f7e *R/S2.value.R 0e8d0ea82221d74f6b162321d2828f4d *R/T.cont.R d7c25fac44f6a5db9c083953ee638183 *R/T.image.R 3292aa8a605cc7308c4bb25ce42dbe44 *R/T.value.R 6fcbbe6e3ceb352e806c7d9a06dbcb62 *R/Tr.class.R a6d51db01e3ba0f57781bb3e37b5c552 *R/Tr.label.R 7a87a5a2046fd344048cbf8314d6c168 *R/Tr.match.R 112a6887d82d2dbaa411cccebf8faccc *R/Tr.traject.R 42a21c2bf26aa6affeefe0625ab711c9 *R/addhist.R de228249670c7f1395b72653b4549fdc *R/addline.R 89e1632bb6abd57f62906e81ab970a9f *R/addpoint.R 00678a7575a2e72f0949c933b17429dc *R/addsegment.R 22a8e97c6a914d21a231235acc7a92ab *R/addtext.R 39123987eed917bacc4398a6ea9ae0de *R/ade4-kplot.R c318be0c908e76fbc02879877fa322cb *R/ade4-plot.R 3785c6a0be3039dce3d32a98cb2a4c86 *R/ade4-scatter.R f33d5c8934cd430652bdb93f2951b2ee *R/ade4-score.R 970d295db2936d608f06cbd2ece30b50 *R/adeGsenv.R a2a46c68ed91b8cc76b2b9064b76bd82 *R/genericMethod.R 79a5cfbcf1f12f4227465b71ac2fd520 *R/multiplot.R bfb8ee7f5fa4bd14054bd0606af7b7c8 *R/panelfunctions.R 7277d5d04a6d8fc214c6bb0a754e233f *R/parameter.R e21a4cb7e6359e8d2d27405328ba61eb *R/s.Spatial.R 758d59e8318503e39061a5cd31fac71f *R/utils.R 0fed2f0f01d422b356f9e4a410f92a6a *R/utilsADEgS.R cadc907d6b204acff6fd94143b178b4c *R/utilsclass.R 486605c9cd6485291c4e3c7c486b518e *R/utilskey.R bf8d58f56fec3d532e6611ee839eb1b6 *R/utilstriangle.R e68e3dad2560bc4e2d8f6a4d36907618 *build/vignette.rds 3f94c9abdede35f61e9df43ddbea1165 *inst/CITATION 5855859bbd73de5bdae1026303d8be3d *inst/doc/FAQ.R 81511e923fe1556c2a022a2fd7362762 *inst/doc/FAQ.Rmd 3683cdd98a65df1bb9b709c1f7dcb33b *inst/doc/FAQ.html 59317f0473bf21768f71e3e98bc44976 *inst/doc/adegraphics.R 67f684730aa8611f93fd01a38a6bb911 *inst/doc/adegraphics.Rmd 300b068e1ee6344a09161328db6d94d2 *inst/doc/adegraphics.html 5598610d87d39c76f4655ded0eb71939 *man/ADEg-class.Rd 04d2d39bbab2e82a441b1dbb4f996e29 *man/ADEg.C1-class.Rd fe42debb511ab4a929b9029778b4fdac *man/ADEg.S1-class.Rd fbdf0df2c03ed9297d5e812eef1e68a0 *man/ADEg.S2-class.Rd 911ffe3a951cab8e45199dfb7b3a8e63 *man/ADEg.T-class.Rd fefb3b817bcb32d08afb0d4d8fc9494c *man/ADEg.Tr-class.Rd 0baa08dcf2af5cb4f5907e6ddf959ac7 *man/ADEgS-class.Rd ff24343f2c2fe48dee8142b6bbd5b605 *man/ADEgS.Rd 88800e779ad8c04ad63382833233677b *man/C1.barchart-class.Rd 1250e8ac88f1739a8cbf1274e6298467 *man/C1.curve-class.Rd 06cc64ed333d3fc5cdde3ba14f26c559 *man/C1.density-class.Rd b438e7afdb9592d106ab927d94e1e014 *man/C1.dotplot-class.Rd 3061b29846f210d2aca0e6152d5aca11 *man/C1.gauss-class.Rd d216ddb2c2b58a05d8f0f72349559ea9 *man/C1.hist-class.Rd 2d6d101a398b8c5e1bd33aaef5df6415 *man/C1.interval-class.Rd 7ae1eadd9adf1ab229886b554d8e698b *man/S1.boxplot-class.Rd de5f6476be1f6a9ab016c88b91c9bbf7 *man/S1.class-class.Rd dcdd8a493382df52d7bebf25adc2bdcf *man/S1.distri-class.Rd ccdf3bc2fe1fa928c01b3e3eb6a1fe77 *man/S1.label-class.Rd 9233128a5129ec98a5b0ffb768d99ec8 *man/S1.match-class.Rd 4fb52e7b683616c6a717ee66d9cb12b4 *man/S2.arrow-class.Rd 6d7135823f31d606678757c428ae0bca *man/S2.class-class.Rd 50c3549ba79a734cf55f0431860ed0db *man/S2.corcircle-class.Rd 64fea9fc12633cfaa5e19d570d60bf2f *man/S2.density-class.Rd 821f8156feee060b07e5031cb4fe4a13 *man/S2.distri-class.Rd 04520e2cf701a51b9af7a8a9e055a7b1 *man/S2.image-class.Rd 425d1128f82830cf8c9e065c21218608 *man/S2.label-class.Rd 5b7cf8c2ceb2e019abcbe8680401630f *man/S2.logo-class.Rd 425abe8b71bbeea2b60618fb6345cf78 *man/S2.match-class.Rd b55f15033357545e498bd2916eda4a28 *man/S2.traject-class.Rd 99ee1dac269f87545d9d4531bd7892c1 *man/S2.value-class.Rd 8c8e2e372dd37cb0c4993d6c39f90d9f *man/T.cont-class.Rd 1c62778fdcab3fb8c2bbc44979a4b83f *man/T.image-class.Rd 4d9d77163bb26e7bd695048caca831ce *man/T.value-class.Rd 4f00222ee88ee4ee93cf7a98c59723fb *man/Tr.class-class.Rd eebd649933116bbd0a3d157103e3893c *man/Tr.label-class.Rd 271d927c3968008b8b842a69cd2dd731 *man/Tr.match-class.Rd 5ae2ceb127ac94164bccb3028ad122a5 *man/Tr.traject-class.Rd 0c7b0685e07ffcc4b795eebd2cb3db38 *man/add.ADEg.Rd 1fc0b2b157d5b97948a8e93e31769f5d *man/addhist.Rd 95a74bd74a3336f1d826fc85a78f7007 *man/addline.Rd 8d5f5a7796f7b116d46e1eaaf04ae107 *man/addpoint.Rd bd3a4ec328c07829413dbf36b60da536 *man/addsegment.Rd 98bf035a866432768e1523cc6d0cca7e *man/addtext.Rd 7663b968ca32d6da4e170a0499a66d4b *man/adeg.panel.Spatial.Rd dedf78380758f45ca0e207941931bf5d *man/adeg.panel.hist.Rd 9332cd504eb2ceb5dedf28a26e5acc05 *man/adeg.panel.join.Rd e7c451559023d096b2fc822785bb2527 *man/adeg.panel.label.Rd 73bde03d6c00c0e4244c938172589d5a *man/adeg.panel.nb.Rd 9c0d74adc122976f8d165cf94525a267 *man/adeg.panel.values.Rd 4f71081c62ce518b3f8ce82f6f57ed32 *man/adegpar.Rd b236f2fcf939e84c32c2f12947a6d646 *man/adegraphics-internal.Rd 882c5772f313893fe395b6b898e969be *man/adegraphics-package.Rd f67375b3996b3c8475123c129aa99ff8 *man/cbindADEg.Rd 3ff9c210f3c3ff6f1fb07a0824bf8359 *man/changelatticetheme.Rd 3685372b4e0b9847d9cc4c002d245eb4 *man/getcall-methods.Rd 6369ae7778afbed77354e019c2704c3e *man/insert.Rd 349c1d1984cfd9297fc1cd48c1658b7a *man/layout2position.Rd 54125b8cd7e930803ed18aae6196b54a *man/panel-methods.Rd a1f9efa0f1116423c63e019aef6707b3 *man/plot.Rd 08a95671d2021341fed7f0b41e7db784 *man/plot.inertia.Rd 22f22e39e74120ce0473c5bae267d26d *man/plotEig.Rd 8c1d6460e342bf764802ea0a1b4377e9 *man/prepare-methods.Rd 2968dddcfcfa4d4f42a658b2cbdf7bc1 *man/s.Spatial.Rd 6c34d9ac54550d66665c875b40a09010 *man/s.arrow.Rd 405755d59de8e046df922cde0ed6494c *man/s.class.Rd 62611638daec8c5448a6ce369a715107 *man/s.corcircle.Rd 0d743ad4bc59be66347c21a0a08f24e1 *man/s.density.Rd 4f4b13b10306a004ee688befecb9fe46 *man/s.distri.Rd f4b7815ef4bcff9c5e014b2e2177e69f *man/s.image.Rd 3bdcb6cb1b937b09c9a5e6ec183b90a1 *man/s.label.Rd 835971ca2fcd623bfca4cb020cd7fc4f *man/s.logo.Rd 7b61953336ea5ce084586e689eb9bce3 *man/s.match.Rd d27b943fe8bae0ce295e5fd72587dffc *man/s.traject.Rd de5a2b09ca7820b23ce4fdc372600217 *man/s.value.Rd 198a63b4910c5286868756fc0b943918 *man/s1d.barchart.Rd 9a7a01eed3541b4f8bb4067dd94934f4 *man/s1d.boxplot.Rd b395fc2c44c262fa62e52fe3a3ec1897 *man/s1d.class.Rd 1e2078d044e58c8ae36ffedd79f751d5 *man/s1d.curve.Rd 0b1b30396480f8d75ba2e7ba972f1dac *man/s1d.curves.Rd 5693ead2c63677e67f0a71ad2d1c6194 *man/s1d.density.Rd 5a837a311c574253054b7852c14569d6 *man/s1d.distri.Rd b6d20f9b0fec290688e53237f4897d50 *man/s1d.dotplot.Rd 387567a96db26a70afdc6dc84bbb8e6a *man/s1d.gauss.Rd f978ad297d26ea7934c1b502c6446690 *man/s1d.hist.Rd 06bc6632401967ed221f319f9e087aed *man/s1d.interval.Rd 0f6faa4348634061d0e6fcd5b562ecec *man/s1d.label.Rd 1eb668e640b0ef5f01803e7b054756a7 *man/s1d.match.Rd 62a318294a166b0efca13ab3723763ba *man/setlimits1D.Rd d521408a977531b8d58c7c7e29ea8f1b *man/sortparamADEg.Rd e0f5a596dd873f9a49f36532fffef83b *man/superpose.Rd 1b2d4e5770016736118a9cbde8ecde89 *man/table.image.Rd 84885822abf9dd54add96dbff22e64ce *man/table.value.Rd 94b4c00b0ecf6a885f37360e5a363c51 *man/triangle.class.Rd b3da4bd4af2cd0052020122b32f54463 *man/triangle.label.Rd f7ac2a54fc22d3d9ea646a5376c8bf9b *man/triangle.match.Rd 1b77d1c084b2bccb1571f651b06212df *man/triangle.traject.Rd c3afe7c260dd4eca59f03ca2097fafec *man/zoom.Rd 115debefa2f321aaf1696a757e9a4b83 *tests/add.R 48e7d303484712161d4cf18335b7b49b *tests/ade4-functions.R 5e517dea83edac5c1a447f6ed495010a *tests/adegraphics.R 202913bcd9c77982320e544fd8cdc835 *tests/nbgraph.R 4a4ea3813dbbc3e37f037b380b62103f *tests/panelSpatial.R f89edc95fba7af6ec5f90920e55512a2 *tests/parameter.R 6ffcf224c4cca0787627c920998a151d *tests/s.arrow.R b44718dd5dfa2320a0e92aa441b579c0 *tests/s.class.R f9fe8c009eef52db351eac53d520b582 *tests/s.corcircle.R b887dabc7bbb48a8fccb910d8cb9dea9 *tests/s.density.R 77c9be0b3f529e52718a7fbb892fa7cd *tests/s.distri.R 3aab860f9c8f20cd3126f4f195752a41 *tests/s.image.R a9bcd29036d786df49807a88d0d63547 *tests/s.label.R 86caf8017c8526619fa999d63e383903 *tests/s.logo.R 89481fdbb48f7152a0a3c8287e0df518 *tests/s.match.R b11418f95ee8fc6ad79d617175c91efc *tests/s.traject.R 2391641d0049c4e52f28f7fb306400e1 *tests/s.value.R e4165bdc3aec92cb9308ef825604afdc *tests/s1d.barchart.R 0249418d2c4dd0f0de9d3fac737f65e7 *tests/s1d.boxplot.R 2a99ba9860010454a83d309c30cce4c9 *tests/s1d.class.R a01a1e74736e70b7c97f7a1f32e5fc57 *tests/s1d.density.R d923871e6c60ba04e736bb5e5dc9a4bd *tests/s1d.distri.R cd1ee4bb8abc725fe9eb029172392749 *tests/s1d.gauss.R de8d985d9eff6b46497e9fb748ffb6fd *tests/s1d.hist.R 8e45493f980b7849afe935d58c240a50 *tests/s1d.label.R c3348687040f2feb1b3eebeda243807d *tests/s1d.match.R 68cbc8ecd439a481b06c94cdd41cb5e3 *tests/table.image.R 3611ca9b2b3a27ee07755316d98d4e7c *tests/table.value.R 22e0c33678322769bdbd349bdd157368 *tests/triangle.R 81511e923fe1556c2a022a2fd7362762 *vignettes/FAQ.Rmd 67f684730aa8611f93fd01a38a6bb911 *vignettes/adegraphics.Rmd d9fc6c74dd6f5f6e1d474a1e9d0550fb *vignettes/adegraphics.bib 94e2c4c89709af434aea77d06cae63a7 *vignettes/classes.png 1d77c7392af1b74694a1a360391faf63 *vignettes/gargsVSclass.R 8f602c5d25cda55f1dec6ed200823ab2 *vignettes/gargsVSclass.csv f2678b6a3b44dfed82563a378d98d086 *vignettes/paramVSfunction.R 2b0090986571a97a477ad4154b503786 *vignettes/paramVSparam.R f6179df0e8e9082cd6ca1c6b2aa42a3e *vignettes/tableparamVSfunction.csv adegraphics/R/0000755000176200001440000000000014572567407012746 5ustar liggesusersadegraphics/R/ade4-scatter.R0000644000176200001440000002335213742303021015330 0ustar liggesusers"scatter.dudi" <- function(x, xax = 1, yax = 2, permute = FALSE, posieig = "topleft", prop = FALSE, density.plot = ifelse(permute, ncol(x$tab) > 1000, nrow(x$tab) > 1000), plot = TRUE, storeData = TRUE, pos = -1, ...) { if(!inherits(x, "dudi")) stop("Object of class 'dudi' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") position <- .getposition(posieig[1:min(2, length(posieig))]) ## sort parameters for each graph graphsnames <- c("row", "col", "eig") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## parameters management params <- list() params$row <- list(plabels = list(cex = 0.75)) params$col <- list() params$eig <- list(pbackground = list(box = TRUE), psub = list(text = "Eigenvalues")) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) if(prop) { id <- inertia.dudi(x, col.inertia = TRUE) if(is.null(sortparameters[[2]]$plabels$cex)) { sortparameters$col$plabels$cex <- id$col.cum[, 2] / (max(id$col.cum[, 2]) / 1.5) } else { sortparameters$col$plabels$cex <- sortparameters$col$plabels$cex * id$col.cum[, 2] / (max(id$col.cum[, 2]) / 1.5) } } ## prepare and create g1 if(permute) df1 <- substitute(x$co) else df1 <- substitute(x$li) g1 <- do.call(ifelse(density.plot, "s.density", "s.label"), c(list(dfxy = df1, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$row)) ## prepare and create g2 if(permute) { colss <- x$l1 } else { colss <- x$c1 } knormali <- c(min(colss[, xax]), max(colss[, xax]), min(colss[, yax]), max(colss[, yax])) / c(g1@g.args$xlim, g1@g.args$ylim) csts <- 0.9 / max(knormali) if(permute) { df2 <- substitute(x$l1 * csts) } else { df2 <- substitute(x$c1 * csts) } g2 <- do.call("s.arrow", c(list(dfxy = df2, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$col)) ## create the final ADEgS object <- do.call("superpose", list(g1, g2)) object@Call <- call("superpose", g1@Call, g2@Call) if(!is.null(position)) { g3 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$eig)) object <- do.call("insert", list(g3@Call, object@Call, posi = position, plot = FALSE, ratio = 0.25)) } names(object) <- graphsnames[1:length(object)] object@Call <- match.call() if(plot) print(object) invisible(object) } "scatter.coa" <- function(x, xax = 1, yax = 2, method = 1:3, posieig = "topleft", pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "dudi")) stop("Object of class 'dudi' expected") if(!inherits(x, "coa")) stop("Object of class 'coa' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") position <- .getposition(posieig[1:min(2, length(posieig))]) method <- method[1] ## limits management if(method == 1) x.global <- rbind(as.matrix(x$li), as.matrix(x$co)) else if(method == 2) x.global <- rbind(as.matrix(x$c1), as.matrix(x$li)) else if(method == 3) x.global <- rbind(as.matrix(x$l1), as.matrix(x$co)) adegtot <- adegpar() lim.global <- setlimits2D(minX = min(x.global[, xax]), maxX = max(x.global[, xax]), minY = min(x.global[, yax]), maxY = max(x.global[, yax]), origin = adegtot$porigin$origin, aspect.ratio = adegtot$paxes$aspectratio, includeOr = adegtot$porigin$include) ## sort parameters for each graph graphsnames <- c("row", "col", "eig") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## parameters management params <- list() params$row <- list(plabels = list(cex = 0.75), xlim = lim.global$xlim, ylim = lim.global$ylim) params$col <- list(xlim = lim.global$xlim, ylim = lim.global$ylim) params$eig <- list(pbackground = list(box = TRUE), psub = list(text = "Eigenvalues")) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg and of the final ADEgS if(method == 1) { g1 <- do.call("s.label", c(list(dfxy = substitute(x$li), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$row)) g2 <- do.call("s.label", c(list(dfxy = substitute(x$co), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$col)) } else if(method == 2) { g1 <- do.call("s.label", c(list(dfxy = substitute(x$c1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$col)) g2 <- do.call("s.label", c(list(dfxy = substitute(x$li), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$row)) } else if(method == 3) { g1 <- do.call("s.label", c(list(dfxy = substitute(x$l1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$row)) g2 <- do.call("s.label", c(list(dfxy = substitute(x$co), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$col)) } object <- do.call("superpose", list(g1, g2)) object@Call <- call("superpose", g1@Call, g2@Call) if(!is.null(position)) { g3 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$eig)) object <- do.call("insert", list(g3@Call, object@Call, posi = position, plot = FALSE, ratio = 0.25)) } object@Call <- match.call() names(object) <- graphsnames[1:length(object)] if(plot) print(object) invisible(object) } "scatter.pco" <- function(x, xax = 1, yax = 2, posieig = "topleft", pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "dudi")) stop("Object of class 'dudi' expected") if(!inherits(x, "pco")) stop("Object of class 'pco' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") position <- .getposition(posieig[1:min(2, length(posieig))]) ## sort parameters for each graph graphsnames <- c("row", "eig") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## parameters management params <- list() params$row <- list() params$eig <- list(pbackground = list(box = TRUE), psub = list(text = "Eigenvalues")) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg and of the final ADEgS object <- do.call("s.label", c(list(dfxy = substitute(x$li), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$row)) if(!is.null(position)) { g2 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$eig)) object <- do.call("insert", list(g2@Call, object@Call, posi = position, plot = FALSE, ratio = 0.25)) names(object) <- graphsnames[1:length(object)] } object@Call <- match.call() if(plot) print(object) invisible(object) } "scatter.nipals" <- function(x, xax = 1, yax = 2, posieig = "topleft", pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "nipals")) stop("Object of class 'nipals' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") position <- .getposition(posieig[1:min(2, length(posieig))]) ## sort parameters for each graph graphsnames <- c("row", "col", "eig") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## parameters management params <- list() params$row <- list(plabels = list(cex = 0.75)) params$col <- list() params$eig <- list(pbackground = list(box = TRUE), psub = list(text = "Eigenvalues")) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## prepare and create g1 g1 <- do.call("s.label", c(list(dfxy = substitute(x$li), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$row)) ## prepare and create g2 knormali <- c(min(x$c1[, xax]), max(x$c1[, xax]), min(x$c1[, yax]), max(x$c1[, yax])) / c(g1@g.args$xlim, g1@g.args$ylim) csts <- 0.8 / max(knormali) df2 <- substitute(x$c1 * csts) g2 <- do.call("s.arrow", c(list(dfxy = df2, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$col)) ## creation of each individual ADEg and of the final ADEgS object <- do.call("superpose", list(g1, g2)) object@Call <- call("superpose", g1@Call, g2@Call) if(!is.null(position)) { g3 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$eig)) object <- do.call("insert", list(g3@Call, object@Call, posi = position, plot = FALSE, ratio = 0.25)) } names(object) <- graphsnames[1:length(object)] object@Call <- match.call() if(plot) print(object) invisible(object) } adegraphics/R/T.value.R0000644000176200001440000001703213742303021014364 0ustar liggesuserssetClass( Class = "T.value", contains = "ADEg.T" ) setMethod( f = "prepare", signature = "T.value", definition = function(object) { name_obj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) if(object@data$storeData) { z <- as.vector(as.matrix(object@data$dftab)) dftab <- object@data$dftab labelsx <- object@data$labelsx labelsy <- object@data$labelsy } else { z <- as.vector(as.matrix(eval(object@data$dftab, envir = sys.frame(object@data$frame)))) dftab <- eval(object@data$dftab, envir = sys.frame(object@data$frame)) labelsx <- eval(object@data$labelsx, envir = sys.frame(object@data$frame)) labelsy <- eval(object@data$labelsy, envir = sys.frame(object@data$frame)) } if(is.null(object@g.args$breaks)) object@s.misc$breaks.update <- pretty(z, object@g.args$nclass) else object@s.misc$breaks.update <- object@g.args$breaks object@s.misc$breaks.update <- breakstest(object@s.misc$breaks.update, z, n = length(object@s.misc$breaks.update)) n <- length(object@s.misc$breaks.update) if(is.null(object@adeg.par$ppoints$cex)) adegtot$ppoints$cex <- 1 if(is.null(object@adeg.par$ppoints$alpha)) adegtot$ppoints$alpha <- 1 if(is.null(labelsx)) adegtot$ptable$x$tck <- 0 if(is.null(labelsy)) adegtot$ptable$y$tck <- 0 ## symbols for z = center if(!is.null(object@g.args$centerpar)) { default <- list(pch = 4, cex = 1, col = "black") if(is.list(object@g.args$centerpar)) object@g.args$centerpar <- modifyList(default, object@g.args$centerpar, keep.null = TRUE) else object@g.args$centerpar <- default } ## setting colors if(!is.null(object@g.args$col)) { switch(object@g.args$method, size = { if(length(object@g.args$col) != 2 & !inherits(dftab, "table") & !inherits(dftab, "dist")) stop("if method size choosen, col vector should be size 2", call. = FALSE) adegtot$ppoints$col <- object@g.args$col ## color given by the user }, color = { if(length(object@g.args$col) < (n - 1)) stop(paste("not enough colors defined for method color, at least ", (n - 1), " colors expected", sep = "") , call. = FALSE) adegtot$ppoints$fill <- object@g.args$col[1:(n - 1)] ## color given by the user }) } else { if(object@g.args$method == "color") adegtot$ppoints$fill <- adegtot$ppalette$quanti(n - 1) else if(inherits(dftab, "table") | inherits(dftab, "dist")) { adegtot$ppoints$col <- adegtot$ppalette$quanti(2) } else adegtot$ppoints$col <- adegtot$ppalette$quanti(2) } ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "T.value", definition = function(object, x, y) { if(object@data$storeData) dftab <- as.matrix(object@data$dftab) else dftab <- as.matrix(eval(object@data$dftab, envir = sys.frame(object@data$frame))) adeg.panel.values(x = x[col(dftab)], y = y[row(dftab)], z = as.vector(dftab), center = object@g.args$center, method = object@g.args$method, symbol = object@g.args$symbol, ppoints = object@adeg.par$ppoints, breaks = object@s.misc$breaks.update, centerpar = object@g.args$centerpar) }) table.value <- function(dftab, coordsx = 1:ncol(as.matrix(dftab)), coordsy = nrow(as.matrix(dftab)):1, labelsx, labelsy, breaks = NULL, method = c("size", "color"), symbol = c("square", "circle", "diamond", "uptriangle", "downtriangle"), col = NULL, nclass = 3, center = 0, centerpar = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## 4 different types can be used as tab : ## distance matrix (dist), contingency table (table), data.frame or matrix ## evaluation of some parameters thecall <- .expand.call(match.call()) thecall$method <- match.arg(method) thecall$symbol <- match.arg(symbol) dftab <- eval(thecall$dftab, envir = sys.frame(sys.nframe() + pos)) if(any(is.na(dftab))) stop("NA entries not accepted") if(inherits(dftab, "dist")) { if(missing(labelsx)){ thecall$labelsx <- labelsx <- NULL if(!is.null(attr(dftab, "Labels"))) if(storeData) labelsx <- attr(dftab, "Labels") else thecall$labelsx <- call("attr", thecall$dftab, "Labels") } if(missing(labelsy)) { thecall$labelsy <- labelsy <- NULL if(!is.null(attr(dftab, "Labels"))) if(storeData) labelsy <- attr(dftab, "Labels") else thecall$labelsy <- call("attr", thecall$dftab, "Labels") } ## coordsx and coordsy should be identical for dist objects (symmetric) thecall$coordsx <- call(":", 1, call("attr", thecall$dftab, "Size")) thecall$coordsy <- call(":", call("attr", thecall$dftab, "Size"), 1) } else { ## data.frame, matrix, table if(missing(labelsy)) { thecall$labelsy <- labelsy <- NULL if(!is.null(rownames(dftab))) if(storeData) labelsy <- rownames(dftab) else thecall$labelsy <- call("rownames", thecall$dftab) } if(missing(labelsx)) { thecall$labelsx <- labelsx <- NULL if(!is.null(colnames(dftab))) if(storeData) labelsx <- colnames(dftab) else thecall$labelsx <- call("colnames", thecall$dftab) } } ## parameters sorted sortparameters <- sortparamADEg(...) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(breaks = breaks, method = thecall$method, symbol = thecall$symbol, center = thecall$center, col = col, nclass = nclass, centerpar = centerpar)) if(storeData) tmp_data <- list(dftab = dftab, coordsx = coordsx, coordsy = coordsy, labelsx = labelsx, labelsy = labelsy, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(dftab = thecall$dftab, coordsx = thecall$coordsx, coordsy = thecall$coordsy, labelsx = thecall$labelsx, labelsy = thecall$labelsy, frame = sys.nframe() + pos, storeData = storeData) if(inherits(dftab, "table")) { condres <- pmatch(c("ablineX", "ablineY", "meanX", "meanY"), names(sortparameters$rest)) if(any(!is.na(condres))) { tmplist <- sortparameters$rest[condres[!is.na(condres)]] names(tmplist) <- c("ablineX", "ablineY", "meanX", "meanY")[which(!is.na(condres))] sortparameters$rest <- sortparameters$rest[-condres[(!is.na(condres))]] g.args <- c(g.args, tmplist) } g.args[c("ablineX", "ablineY", "meanX", "meanY")[which(is.na(condres))]] <- FALSE object <- new(Class = "T.cont", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = match.call()) } else object <- new(Class = "T.value", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = match.call()) if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## preparation of the graph prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) else if(plot) print(object) invisible(object) } adegraphics/R/ADEg.R0000644000176200001440000002720514572567273013640 0ustar liggesusers############################################## ## general class ## ############################################## setClass( Class = "ADEg", contains = "VIRTUAL", slots = c( trellis.par = "list", adeg.par = "list", lattice.call = "list", g.args = "list", stats = "list", s.misc = "list", Call = "call") ## validity ## validity = function(object){return(TRUE)} ) ############################################## ## initialize ## ############################################## setMethod( f = "initialize", signature = "ADEg", definition = function(.Object, trellis.par = list(), adeg.par = list(), lattice.call = list(), g.args = list(), stats = list(), s.misc = list(), Call = call("emptycall"), ...) { .Object@trellis.par <- trellis.par .Object@adeg.par <- adeg.par .Object@lattice.call <- lattice.call .Object@g.args <- g.args .Object@stats <- stats .Object@s.misc <- s.misc .Object@Call <- Call return(.Object) }) setOldClass("trellis") setClassUnion(name = "ADEgORtrellis", members = c("ADEg", "trellis")) setMethod( f = "panelbase", signature = "ADEg", definition = function(object, x, y) { whichpanel <- packet.number() sub <- lapply(object@adeg.par$psub, FUN = function(x) {rep(x, length.out = max(whichpanel, 2))}) ## repeat at least twice for position coordinates if(is.numeric(object@adeg.par$psub$position)) num <- 1 else num <- 0 if(sub$cex[whichpanel] && (sub$text[whichpanel] != "")) { if(!num) posit <- .setposition(sub$position[whichpanel]) else posit <- .setposition(sub$position[(2 * whichpanel - 1):(2 * whichpanel)]) text <- textGrob(label = sub$text[whichpanel], x = posit$posi[1], y = posit$posi[2], gp = gpar(cex = sub$cex[whichpanel], col = sub$col[whichpanel]), just = posit$just, name = paste("subtitle_", whichpanel, sep = "")) grid.rect(x = posit$posi[1], y = posit$posi[2], width = grobWidth(text), height = grobHeight(text), just = posit$just, gp = gpar(fill = ifelse(class(object) == "S2.corcircle" | inherits(object, "ADEg.Tr"), "transparent", object@adeg.par$pbackground$col), alpha = 1, col = "transparent")) grid.draw(text) } }) ############################################## ## Get elements/information ## ############################################## setMethod( f = "getparameters", signature = "ADEg", definition = function(object, number = 0) { if(number == 0) return(list(trellis.par = object@trellis.par, adeg.par = object@adeg.par, g.args = object@g.args)) if(number == 1) return(object@trellis.par) if(number == 2) return(object@adeg.par) stop("wrong number for getparameters") }) setMethod( f = "getlatticecall", signature = "ADEg", definition = function(object) { return(object@lattice.call) }) setMethod( f = "getcall", signature = "ADEg", definition = function(object) { return(object@Call) }) setMethod( f = "getstats", signature = "ADEg", definition = function(object) { return(object@stats) }) ############################################## ## superposition ## ############################################## ## g1 superpose on refg ## settings about margin limits ect... taken from refg ## modified object only displayed (not save), original limits ect are kept setMethod( f = "printSuperpose", signature = c("ADEgORtrellis", "ADEgORtrellis"), definition = function(g1, refg) { ## to respect axis, limits, etc., we work directly on the trellis objects. if(inherits(refg, "ADEg")) { trelref <- gettrellis(refg) if(inherits(g1, "ADEg")) { g1@adeg.par$pgrid$draw <- FALSE g1@g.args$xlim <- refg@g.args$xlim g1@g.args$ylim <- refg@g.args$ylim g1@adeg.par$paxes$draw <- refg@adeg.par$paxes$draw g1@adeg.par$pbackground$col <- "transparent" ## useful for S2.corcircle g1@adeg.par$porigin$draw <- FALSE g1@s.misc$scales <- refg@s.misc$scales if(inherits(g1, "ADEg.Tr") & inherits(refg, "ADEg.Tr")) { g1@g.args$min3d <- refg@g.args$min3d g1@g.args$max3d <- refg@g.args$max3d g1@adeg.par$pgrid$text$cex <- 0 ## no text corner for g1 g1@lattice.call$arguments$par.settings$axis.text$cex <- 0 } setlatticecall(g1) trel1 <- gettrellis(g1) } else { trel1 <- g1 } } else { ## refg is a trellis trelref <- refg if(inherits(g1, "ADEg")) { g1@adeg.par$pgrid$draw <- FALSE g1@g.args$xlim <- refg$x.limits g1@g.args$ylim <- refg$y.limits g1@adeg.par$paxes$draw <- refg$x.scales$draw * refg$y.scales$draw g1@adeg.par$porigin$draw <- FALSE g1@g.args$xlab <- "" g1@g.args$ylab <- "" setlatticecall(g1) trel1 <- gettrellis(g1) } else { trel1 <- g1 } } trel1$par.settings$panel.background$col <- "transparent" trel1$par.settings$axis.text$alpha <- 0 trel1$par.settings$axis.line$col <- "transparent" names <- c("x.scales", "y.scales", "xlab", "ylab", "main", "sub", "x.between", "y.between", "as.table", "x.limits", "y.limits", "aspect.ratio") for(i in names) trel1[[i]] <- trelref[[i]] print(trel1, newpage = FALSE) }) setMethod( f = "superpose", signature = c("ADEgORtrellis", "ADEgORtrellis", "ANY", "ANY"), definition = function(g1, g2, which, plot) { addi <- matrix(0, 2, 2) addi[1, 2] <- 1 obj <- new(Class = "ADEgS", ADEglist = list(g1, g2), positions = matrix(rep(c(0, 1), each = 4), 2, 4), add = addi, Call = match.call()) if(plot) print(obj) invisible(obj) }) ############################################## ## insertion ## ############################################## setMethod( f = "insert", signature = c("ADEgORtrellis", "missing"), definition = function(graphics, oldgraphics, posi, ratio, inset, plot, which) { positions <- .getposition(posi, w = ratio, h = ratio) + inset currentgraphic <- get("currentadeg", envir = .ADEgEnv) if(!(length(currentgraphic))) stop("no existing graphics") else newADEgS <- insert(graphics = graphics, oldgraphics = currentgraphic, posi = posi, ratio = ratio, inset = inset, plot = plot, which = which) if(plot) print(newADEgS[length(newADEgS)], closeViewport = FALSE) assign("currentadeg", newADEgS, envir = .ADEgEnv) invisible(newADEgS) }) setMethod( f = "insert", signature = c("ADEgORtrellis", "ADEg"), definition = function(graphics, oldgraphics, posi, ratio, inset, plot) { positions <- .getposition(posi, w = ratio, h = ratio) + inset thecall <- call("insert", graphics@Call, oldgraphics@Call) newADEgS <- new(Class = "ADEgS", ADEglist = list(oldgraphics, graphics), positions = rbind(c(0, 0, 1, 1), positions), add = matrix(0, ncol = 2, nrow = 2), Call = thecall) if(plot) print(newADEgS) assign("currentadeg", newADEgS, envir = .ADEgEnv) invisible(newADEgS) }) ############################################## ## Add ## ############################################## setMethod( f = "+", signature = c("ADEg", "ADEg"), definition = function(e1, e2) { newobj <- superpose(e1, e2) newobj@Call <- match.call() return(newobj) }) setMethod( f = "add.ADEg", signature = c("ADEg"), definition = function(object) { previous <- get("currentadeg", envir = .ADEgEnv) if(!(length(previous))) stop("no graph to add to") objects <- superpose(previous, object) if(inherits(previous, "ADEg")) printSuperpose(object, previous, position = c(0, 0, 1, 1)) else if(inherits(previous, "ADEgS")) printSuperpose(object, previous[[length(previous)]], position = previous@positions[length(previous), ]) # lattice:::lattice.setStatus(print.more = FALSE) assign("currentadeg", objects, envir = .ADEgEnv) invisible(objects) }) ############################################## ## Update ## ############################################## ## update the modified parameters setMethod( f = "update", signature = "ADEg", definition = function(object, ..., plot = TRUE) { nameobj <- deparse(substitute(object, env = parent.frame(n = 1))) ## object is in parent.frame() because 'update' method pattern is different with 'update' generic method pattern ## see https://stat.ethz.ch/pipermail/r-help/2008-January/152296.html ## extract specific slots used in function call pattern <- names(object@g.args) lpattern <- as.list(rep("", length(pattern))) names(lpattern) <- pattern ## sort parameters sep <- separation(..., pattern = lpattern) selection <- sortparamADEg(sep[[2]]) selection$g.args <- c(selection$g.args, sep[[1]]) if(length(selection$rest)) warning(c("Unused parameters: ", paste(unique(names(selection$rest)), " ", sep = "")), call. = FALSE) object@adeg.par <- modifyList(object@adeg.par, selection$adepar, keep.null = TRUE) object@trellis.par <- modifyList(object@trellis.par, selection$trellis, keep.null = TRUE) object@g.args <- modifyList(object@g.args, selection$g.args, keep.null = TRUE) prepare(object) setlatticecall(object) if(plot) print(object) assign(nameobj, object, envir = parent.frame(n = 2)) ## see also https://stat.ethz.ch/pipermail/r-help/2008-January/152296.html assign("currentadeg", object, envir = .ADEgEnv) }) ############################################## ## Display ## ############################################## setMethod( f = "show", signature = "ADEg", definition = function(object) { print(object) }) setMethod( f = "plot", signature = c("ADEg", "ANY"), definition = function(x, y, adjust = FALSE) { print(x, adjust = adjust) }) setMethod( f = "print", signature = c("ADEg"), definition = function(x, adjust = FALSE, newpage = TRUE) { ## if adjust, graphic limits are readjust according to the device size. ## for now it is only available if only an ADEg is drawn (not in ADEgS) if(adjust) { aspp <- dev.size() ## device size (in inches) ratid <- aspp[1] / aspp[2] oxlim <- x@lattice.call$arguments$xlim ## old xlim oylim <- x@lattice.call$arguments$ylim ratig <- diff(oxlim) / diff(oylim) ## if not mandatory ...? if((ratid / ratig) > 1) { ## width device bigger (relative) than width graphic centerx <- oxlim[1] + diff(oxlim) / 2 nxlim <- rep(centerx, 2) + c(-1, 1) * ((ratid * diff(oylim)) / 2) nylim <- oylim } else if((ratid / ratig) < 1) { ## then relative device height bigger than relative graphic height centery <- oylim[1] + diff(oylim) / 2 nylim <- rep(centery, 2) + c(-1, 1) * (1 / ratid * diff(oxlim)) / 2 nxlim <- oxlim } x@s.misc$backgrid <- .getgrid(xlim = nxlim, ylim = nylim, x@adeg.par$pgrid$nint, rep(x@adeg.par$porigin$origin, le = 2), asp = x@adeg.par$paxes$aspectratio) setlatticecall(x) ## passing backgrid ## changing limits x@lattice.call$arguments$xlim <- nxlim x@lattice.call$arguments$ylim <- nylim } object <- x if(!length(object@lattice.call)) stop("no graphics instruction") else { tmp_object <- gettrellis(x) print(tmp_object, newpage = newpage) assign("currentadeg", x, envir = .ADEgEnv) } }) adegraphics/R/S2.density.R0000644000176200001440000001525714354572626015042 0ustar liggesusers########################################################################## ## s.density ## ########################################################################## setClass( Class = "S2.density", contains = "ADEg.S2" ) ## no initialize function (use ADEg.S2 by inheritance) setMethod( f = "prepare", signature = "S2.density", definition = function(object) { name_obj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) if(object@data$storeData) dfxy <- object@data$dfxy else dfxy <- eval(object@data$dfxy, envir = sys.frame(object@data$frame)) if(is.null(object@adeg.par$plabels)) adegtot$plabels$cex <- 0 if(is.null(object@adeg.par$porigin$include) & (any(names(object@g.args) %in% c("Sp", "nbobject")))) adegtot$porigin$include <- FALSE ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph ## compute density using bkde2D (KernSmooth package) ## bandwidth and gridsize can be provided by user. range.x allows computation for all the panel (even with no points) if(is.null(object@g.args$bandwidth)) object@g.args$bandwidth <- diff(apply(dfxy[, c(object@data$xax, object@data$yax)], 2, quantile, probs = c(0.05, 0.95), na.rm = TRUE)) / 25 if(min(object@g.args$bandwidth) <= 0) stop("'bandwidth' must be strictly positive") object@g.args$threshold <- min(max(0, object@g.args$threshold), 1) object@stats$densit <- bkde2D(dfxy[, c(object@data$xax[1], object@data$yax[1])], bandwidth = object@g.args$bandwidth, gridsize = rep(object@g.args$gridsize, length.out = 2)) ## TODO: as in s.image, remove points (only) where density is null ## use expand.grid... ## never optimized labels for s.density object@adeg.par$plabels$optim <- FALSE assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "S2.density", definition = function(object, x, y) { densit <- object@stats$densit if(is.null(object@g.args$col)) col <- object@adeg.par$ppalette$quanti(255) else col <- object@g.args$col transformation <- function(x) x densityy <- array(transformation(densit$fhat), dim = dim(densit$fhat)) if(object@g.args$region) panel.levelplot(x = rep(densit$x1, length(densit$x2)), y = rep(densit$x2, each = length(densit$x1)), z = densityy, at = c(-.Machine$double.eps, seq(from = max(densit$fhat) * object@g.args$threshold + .Machine$double.eps, to = 1.01 * max(densit$fhat), length = length(col) + 2)), col.regions = c("transparent", col), subscripts = TRUE) if(object@g.args$contour) panel.levelplot(x = rep(densit$x1, length(densit$x2)), y = rep(densit$x2, each = length(densit$x1)), z = densityy, labels = object@adeg.par$plabels, label.style = if(object@adeg.par$plabels$srt == "horizontal") "flat" else "align", ## also exist "mixed" not used here at = c(-.Machine$double.eps, seq(from = max(densit$fhat) * object@g.args$threshold + .Machine$double.eps, to = 1.01 * max(densit$fhat), length = object@g.args$nclass + 1)), col.regions = c("transparent", col), subscripts = TRUE, region = FALSE, contour = TRUE) ## show nrpoints outilers if(object@g.args$nrpoints > 0) { ## copy of panel.smoothScatter ixm <- round((x - densit$x1[1]) / (densit$x1[length(densit$x1)] - densit$x1[1]) * (length(densit$x1) - 1)) iym <- round((y - densit$x2[1]) / (densit$x2[length(densit$x2)] - densit$x2[1]) * (length(densit$x2) - 1)) idens <- densityy[1 + iym * length(densit$x1) + ixm] nrpoints <- min(nrow(x), ceiling(object@g.args$nrpoints)) sel <- order(idens, decreasing = FALSE)[1:nrpoints] panel.points(x[sel], y[sel], pch = object@adeg.par$ppoints$pch, cex = object@adeg.par$ppoints$cex, col = object@adeg.par$ppoints$col, fill = object@adeg.par$ppoints$fill) } }) s.density <- function(dfxy, xax = 1, yax = 2, bandwidth = NULL, gridsize = c(450L, 450L), nrpoints = 300, threshold = 0.1, col = NULL, contour = FALSE, region = !contour, nclass = 8, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters thecall <- .expand.call(match.call()) df <- try(as.data.frame(eval(thecall$dfxy, envir = sys.frame(sys.nframe() + pos))), silent = TRUE) if(inherits(df, "try-error") | is.null(thecall$dfxy)) ## non convenient dfxy argument stop("non convenient selection for dfxy (can not be converted to dataframe)") ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if((length(xax) == 1 & length(yax) == 1)) object <- multi.facets.S2(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple xax/yax") } ## multiple axes else if((length(xax) > 1 | length(yax) > 1)) { object <- multi.ax.S2(thecall) } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(bandwidth = bandwidth, gridsize = gridsize, threshold = threshold, col = col, nrpoints = nrpoints, contour = contour, region = region, nclass = nclass)) if(storeData) tmp_data <- list(dfxy = dfxy, xax = xax, yax = yax, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(dfxy = thecall$dfxy, xax = xax, yax = yax, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "S2.density", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = as.call(thecall)) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/addtext.R0000644000176200001440000001156613742303021014511 0ustar liggesuserssetMethod( f = "addtext", signature = "ADEg", definition = function(object, xcoord, ycoord, label, plot = TRUE, ...) { # iterate coordinates and/or labels if necessary size <- max(length(xcoord), length(ycoord), length(label)) xcoord <- rep_len(xcoord, length.out = size) ycoord <- rep_len(ycoord, length.out = size) labels <- rep_len(label, length.out = size) # collect limits xlim <- object@g.args$xlim ylim <- object@g.args$ylim aspect <- object@adeg.par$paxes$aspectratio ## sorting parameters sortparameters <- sortparamADEg(...)$adepar params <- adegpar() sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) params <- sortparameters$plabels # create the lattice object textadded <- xyplot(ycoord ~ xcoord, xlim = xlim, ylim = ylim, xlab = NULL, ylab = NULL, aspect = aspect, panel = function(x, y, ...) adeg.panel.label(x, y, labels, plabels = params), plot = FALSE) textadded$call <- call("xyplot", ycoord ~ xcoord, xlim = substitute(xlim), ylim = substitute(ylim), xlab = NULL, ylab = NULL, aspect = substitute(aspect), labels = substitute(labels), panel = function(x, y, labels, ...) adeg.panel.label(x, y, labels = labels, plabels = params)) # superposition obj <- superpose(object, textadded, plot = FALSE) nn <- all.names(substitute(object)) names(obj) <- c(ifelse(is.na(nn[2]), nn[1], nn[2]), "textadded") if(plot) print(obj) invisible(obj) }) setMethod( f = "addtext", signature = "trellis", definition = function(object, xcoord, ycoord, label, plot = TRUE, ...) { # iterate coordinates and/or labels if necessary size <- max(length(xcoord), length(ycoord), length(label)) xcoord <- rep_len(xcoord, length.out = size) ycoord <- rep_len(ycoord, length.out = size) labels <- rep_len(label, length.out = size) # collect limits xlim <- c(0,1) ylim <- c(0,1) if (is.numeric(object$x.limits)) xlim <- object$x.limits if (is.numeric(object$y.limits)) ylim <- object$y.limits aspect <- object$aspect.ratio ## sorting parameters sortparameters <- sortparamADEg(...)$adepar params <- adegpar() sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) params <- sortparameters$plabels # create the lattice object textadded <- xyplot(ycoord ~ xcoord, xlim = xlim, ylim = ylim, xlab = NULL, ylab = NULL, aspect = aspect, panel = function(x, y, ...) adeg.panel.label(x, y, labels, plabels = params), plot = FALSE) textadded$call <- call("xyplot", ycoord ~ xcoord, xlim = substitute(xlim), ylim = substitute(ylim), xlab = NULL, ylab = NULL, aspect = substitute(aspect), labels = substitute(labels), panel = function(x, y, labels, ...) adeg.panel.label(x, y, labels = labels, plabels = params)) # superposition obj <- superpose(object, textadded, plot = FALSE) nn <- all.names(substitute(object)) names(obj) <- c(ifelse(is.na(nn[2]), nn[1], nn[2]), "textadded") if(plot) print(obj) invisible(obj) }) setMethod( f = "addtext", signature = "ADEgS", definition = function(object, xcoord, ycoord, label, plot = TRUE, which = 1:length(object), ...) { ngraph <- length(object) if(max(which) > ngraph) stop("Values in 'which' should be lower than the length of object") if(length(which) == 1) { # if only one subgraph is selected, all the labels are displayed on this unique subgraph size <- max(length(xcoord), length(ycoord), length(label)) xcoord <- rep_len(xcoord, length.out = size) ycoord <- rep_len(ycoord, length.out = size) labels <- rep_len(label, length.out = size) object[[which]] <- addtext(object[[which]], xcoord, ycoord, labels, ..., plot = FALSE) } else { # if several subgraphs are selected, each label is displayed on one subgraph; there is only one label by subgraph if(sum(object@add) != 0) stop("The 'addtext' function is not available for superposed objects.", call. = FALSE) ## sorting parameters sortparameters <- sortparamADEg(...)$adepar params <- adegpar() sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) params <- sortparameters$plabels params <- rapply(params, function(X) rep(X, length.out = length(which)), how = "list") xcoord <- rep_len(xcoord, length.out = length(which)) ycoord <- rep_len(ycoord, length.out = length(which)) labels <- rep_len(label, length.out = length(which)) for (i in which) object[[i]] <- addtext(object[[i]], xcoord[i], ycoord[i], labels[i], which = 1, plot = FALSE, plabels = lapply(params, function(X) X[i])) } obj <- object if(plot) print(obj) invisible(obj) })adegraphics/R/utilsADEgS.R0000644000176200001440000002507413742303021015017 0ustar liggesusersplotEig <- function(eigvalue, nf, xax = 1, yax = 2, col.plot = "black", col.kept = "grey", col = "white", facets = NULL, plot = TRUE, storeData = FALSE, pos = -1, ...) { ## prepare col <- rep(col, length(eigvalue)) col[nf] <- col.kept col[c(xax, yax)] <- col.plot ## parameters management sortparameters <- sortparamADEg(...) params <- list() params$adepar <- list(ppolygons = list(col = col), p1d = list(horizontal = FALSE), psub = list(position = "topright"), pgrid = list(draw = FALSE), pbackground = list(box = FALSE)) sortparameters$adepar <- modifyList(params$adepar, sortparameters$adepar, keep.null = TRUE) if(is.null(facets) || isTRUE(sortparameters$g.args$samelimits)) { lim <- c(0, ifelse(is.null(facets), length(eigvalue), max(table(facets)))) + 0.5 if(isTRUE(sortparameters$adepar$p1d$horizontal)) params$g.args <- list(ylim = lim) else params$g.args <- list(xlim = lim) lim.val <- range(eigvalue) if(lim.val[1] >= 0) { lim.val <- c(0, lim.val[2] + diff(c(lim.val[1], lim.val[2])) / 10) if(isTRUE(sortparameters$adepar$p1d$horizontal)) params$g.args <- list(xlim = lim.val, ylim = params$g.args$ylim) else params$g.args <- list(xlim = params$g.args$xlim, ylim = lim.val) } at <- 1:length(eigvalue) } else { params$g.args <- list(xlim = NULL, ylim = NULL) at <- unlist(sapply(tabulate(facets), seq_len)) } sortparameters$g.args <- modifyList(params$g.args, sortparameters$g.args, keep.null = TRUE) do.call("s1d.barchart", c(list(score = substitute(eigvalue), at = at, pos = pos - 2, plot = plot, facets = facets, storeData = storeData), sortparameters$adepar, sortparameters$trellis, sortparameters$g.args, sortparameters$stats, sortparameters$s.misc, sortparameters$rest)) } "plotRandTest" <- function(hist, nclass, obs, pos = -1, storeData = TRUE, plot = TRUE, params) { graphsnames <- c("sim", "obs") sortparameters <- sortparamADEgS(params, graphsnames = graphsnames) ## creation of each individual ADEg g1 <- do.call("s1d.hist", c(list(score = hist, nclass = nclass, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("addsegment", c(list(g1, x0 = obs, x1 = obs, y0 = 0, y1 = max(hist$counts) / 2, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("addpoint", c(list(g1, xcoord = obs, ycoord = max(hist$counts) / 2, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g4 <- g2$segmentadded + g3$pointadded ## ADEgS creation object <- superpose(g1, g4) names(object) <- graphsnames return(object) } ## si ADEgS contenu dans un plus petit espace; ## oldposition: matrice de position: nrow:number of graphs, col: x0, y0, x1, y1 ## newposition: vector, length 4: x0, y0, x1, y1 ## Calcul: toute les oldpositions: dans newposition. ## renvoie d'une matrice, 4col, nrow(oldposition) rows. ## cette indique les nouvelles positions des graphiques dans le reférentiel de refposition ## test: ## oldpos <- t(rbind(rep(c(0, 1 / 3, 2 / 3), 2), c(rep(0.5, 3), rep(0, 3)), rep(c(1 / 3, 2 / 3, 1), 2), c(rep(1, 3), rep(0.5, 3)))) ## newpos <- c(0.5, 0.5, 1, 1) ## .updateadegsposition(oldpos, refpositions) .updateADEgSposition <- function(oldposition, refposition) { ## test arguments if(NCOL(oldposition) > 4) stop("wrong position, only 4columns expected") if(any(oldposition[, 1] >= oldposition[, 3])) stop("wrong position given, x0>=x1 cannot work") if(any(oldposition[, 2] >= oldposition[, 4])) stop("wrong position given, y0>=y1 cannot work") if(NCOL(refposition) != 1) stop("error in .updateADEgSposition, several containing graphs given, only one possible") ## ne devrait jamais jamais arriver! ## formula: ## xnewi <- xoldi * wnew + x0new ## ynewi <- yoldi * hnew + y0new x0o <- oldposition[, 1] x1o <- oldposition[, 3] y0o <- oldposition[, 2] y1o <- oldposition[, 4] wnew <- refposition[3] - refposition[1] hnew <- refposition[4] - refposition[2] ## peut mieux faire (optimisation) calcNew <- function(old, new, wh) {return(old * wh + new)} return(cbind(calcNew(x0o, refposition[1], wnew), calcNew(y0o, refposition[2], hnew), calcNew(x1o, refposition[1], wnew), calcNew(y1o, refposition[2], hnew))) } ## .getposition: mainly for placing eigen plot. ## gives coordinates according to string position and width, height wanted .getposition <- function(position, w = 0.25, h = 0.25) { if(is.numeric(position) && length(position) == 4) posnum <- position else if(is.numeric(position) && length(position) == 2) posnum <- c(position[1], position[2], position[1] + w, position[2] + h) else if(is.character(position)) { position <- match.arg(position[1], choices = c("bottomleft", "bottomright", "topleft", "topright", "none"), several.ok = FALSE) if(position == "bottomleft") posnum <- c(0.0, 0.0, w, h) else if(position == "bottomright") posnum <- c(1 - w, 0.0, 1, h) else if(position == "topleft") posnum <- c(0.0, 1 - h, w, 1) else if(position == "topright") posnum <- c(1 - w, 1 - h, 1, 1) else if(position == "none") posnum <- NULL else stop("Wrong indication of position") } else stop("Wrong indication of position") return(posnum) } ## pour adeGs, on doit etre capable de separer facilement les parametres pour pouvoir avoir un adressage specifique pour chaque graphique (ie pas la meme chose poru le sarrow et le slabel dans un scatterdudi) ## selon les graphiques adeGs nous aurons des pattern differents: ## ex pour scatter.dudi, nous pouvons imager 'col', 'row', 'eigen' pour distinguer les paramètres spécifiques au graph .partoadeg <- function(..., pattern = NULL) { if(is.null(pattern)) stop("error in .partoadeg, pattern should be filled") if(try(is.list(...), silent = TRUE) == TRUE) dots <- as.list(...) else dots <- list(...) result <- vector("list", length = length(pattern)) result <- lapply(result, as.list) names(result) <- pattern ## si deja indique en list if(length(dots)) { whichG <- c() then <- c() ## pour ceux indiquer avec des . splitgrp <- sapply(names(dots), FUN = function(x) {strsplit(x, ".", fixed=TRUE)}) for(i in 1:length(splitgrp)) { ## premier niveaux quel graph whichG <- c(whichG, splitgrp[[i]][1]) ## deuxieme niveau si il y a le nom suivant (qui etait colle avec un .) if(length(splitgrp[[i]]) > 1) { ## un second element then <- c(then, paste(splitgrp[[i]][2:length(splitgrp[[i]])], collapse = ".")) } else then <- c(then, NA) } indix <- pmatch(whichG, pattern, duplicates.ok = TRUE) notna <- which(!is.na(indix)) ## ne garder que les non na arena <- which(is.na(indix)) ## position dans indix des NA ie: ceux qui n'ont pas de match for(i in 1:length(result)) { sublist <- result[[i]] ## sous list deja trouve... a priori list if(any(indix[notna] == i)) { ## si un indix vaut i=> a mettre dans result ## soit dire une liste soiton a dans then toselect <- which(indix == i) for(have2 in 1:length(toselect)) if(!is.na(then[toselect[have2]])) { ## a ete renseigne avec un point ensuite newlist <- c(list(), dots[toselect[have2]]) names(newlist) <- then[toselect[have2]] sublist <- c(sublist, newlist) } else ## c un na na donc ensuite on avait une liste sublist <- c(sublist, dots[[toselect[have2]]]) } if(length(arena)) ## on a en plus des na, donc des parameteres pour tous selectNa <- indix[arena] sublist <- c(sublist, dots[arena]) if(!is.null(sublist)) result[[i]] <- sublist }} return(result) } .n2mfrow <- function(nr.plots) { ## inspired by n2mfrow but we change the default when the number of graphs is <6 if (nr.plots <= 3) c(1, nr.plots) else if (nr.plots <= 6) c(2, (nr.plots + 1) %/% 2) else if (nr.plots <= 9) c((nr.plots + 2) %/% 3, 3) else if (nr.plots <= 12) c((nr.plots + 3) %/% 4, 4) else c(nrow <- ceiling(sqrt(nr.plots)), ceiling(nr.plots / nrow)) } ## Get positions matrix for ADEgs according a given layout ## strongly inspired by the layout function ## ng: number of positions to get layout2position <- function(mat, widths = rep(1, NCOL(mat)), heights = rep(1, NROW(mat)), ng, square = FALSE) { if(is.vector(mat)) { if(missing(ng)) ng <- mat[1] * mat[2] mat <- matrix(c(1:ng, rep(0, length.out = ((mat[1] * mat[2]) - ng))), nrow = mat[1], byrow = TRUE) if(missing(widths)) widths <- rep(1, ncol(mat)) if(missing(heights)) heights <- rep(1, nrow(mat)) } if(NROW(mat) != length(heights)) stop("wrong number of heigths given", call. = FALSE) if(NCOL(mat) != length(widths)) stop("wrong number of widths given", call. = FALSE) nbgraph <- max(mat) ## get xi position and yi position xi <- c(0) yi <- c(0) ## here, width given such as proportional colums. ## so the sum(width)/length(widths) == 1 ## more units to take in account" if(square == TRUE) { wi <- widths / max(length(widths), length(heights)) hi <- heights / max(length(widths), length(heights)) } else { wi <- widths / sum(widths) hi <- heights / sum(heights) } ## layout from left to right, up to bottom for(i in 1:length(wi)) xi <- c(xi, xi[i] + wi[i]) for(i in 1:length(hi)) yi <- c(yi, yi[i] + hi[i]) yi <- rev(yi) pos <- c() for(i in 1:nbgraph) { ## for each graph, get the positions as x0, y0, x1, y1 indx <- which(mat == i, arr.ind = TRUE) if(length(indx) == 0) { ## just in case warning(paste("in layout2position, a graph position is missing, no graph", i, "defined", sep = " "), call. = FALSE) pos <- rbind(pos, rep(0, 4)) } else pos <- rbind(pos, c(xi[min(indx[, 2])], yi[(max(indx[, 1]) + 1)], xi[(max(indx[, 2]) + 1)], yi[min(indx[, 1])])) } return(pos) } ## For analysis plot (ADEgS creation) sortparamADEgS <- function(..., graphsnames, nbsubgraphs = rep(1, length(graphsnames))) { seppara <- .partoadeg(..., pattern = graphsnames) sortparameters <- lapply(seppara, FUN = sortparamADEg) alist <- function(x) { aa <- list() for(i in 1:length(x)) aa <- c(aa, x[[i]]) aa } tomerge <- lapply(sortparameters, alist) oki <- lapply(tomerge, .mergingList) if(!all(nbsubgraphs == rep(1, length(graphsnames)))) for (i in 1:length(nbsubgraphs)) oki[[i]] <- repList(oki[[i]], nbsubgraphs[i]) return(oki) } adegraphics/R/adeGsenv.R0000644000176200001440000000761713742303021014612 0ustar liggesusers## At the loading of the package, creation of an environment .ADEgEnv to store: ## - the list of graphical parameters ## - the theme adeg ## - the last plotted graphics .ADEgEnv <- new.env() .onLoad <- function(libname, pkgname) { assign("padegraphic", list(p1d = list(horizontal = TRUE, reverse = FALSE, rug = list(draw = TRUE, tck = 0.5, margin = 0.07, line = TRUE)), parrows = list(angle = 15, ends = "last", length = 0.1), paxes = list(aspectratio = "iso", draw = FALSE, x = list(draw = TRUE), y = list(draw = TRUE)), pbackground = list(col = "white", box = TRUE), pellipses = list(alpha = 0.5, axes = list(draw = TRUE, col = "black", lty = 4, lwd = 1), border = "black", col = "transparent", lty = 1, lwd = 1), pgrid = list(col = "grey", draw = TRUE, lty = 1, lwd = 1, nint = 5, text = list(cex = 1, col = "black", pos = "topright")), plabels = list(alpha = 1, cex = 1, col = "black", srt = "horizontal", optim = FALSE, boxes = list(alpha = 1, border = "black", col = "white", draw = TRUE, lwd = 1, lty = 1)), plegend = list(drawKey = TRUE, drawColorKey = FALSE, size = 1), plines = list(col = "black", lty = 1, lwd = 1), pnb = list(edge = list(col = "black", lwd = 1, lty = 1), node = list(pch = 20, cex = 1, col = "black", alpha = 1)), porigin = list(alpha = 1, col = "black", draw = TRUE, include = TRUE, lty = 1, lwd = 1, origin = c(0, 0)), ppalette = list(quanti = colorRampPalette(c("white", "black")), quali = function(n, name = "Set1") { if(n > 9) return(rainbow(n)) else if(n > 2) return(brewer.pal(n, name)) else return(brewer.pal(n + 2, name)[1:n]) }), ## see http://colorbrewer2.org/ ppoints = list(alpha = 1, cex = 1, col = "black", pch = 20, fill = "black"), ppolygons = list(border = "black", col = "grey", lty = 1, lwd = 1, alpha = 0.4), pSp = list(col = "grey", border = "black", lwd = 1, lty = 1, alpha = 1, cex = 3, pch = 20), psub = list(cex = 1, col = "black", position = "bottomleft", text = ""), ptable = list(x = list(srt = 0, pos = "top", tck = 5, adj = NA), y = list(srt = 90, pos = "right", tck = 5, adj = NA), margin = list(bottom = 5, left = 5, top = 5, right = 5)) ), envir = .ADEgEnv) assign("adegtheme", list(layout.heights = list( top.padding = 0, main.key.padding = 0, key.axis.padding = 0, axis.xlab.padding = 0, xlab.key.padding = 0, key.sub.padding = 0, bottom.padding = 0), layout.widths = list(left.padding = 0, key.ylab.padding = 0, ylab.axis.padding = 0, axis.key.padding = 0, right.padding = 0), background = list(col = "transparent", alpha = 1), plot.polygon = list(col = "#F2F2F2"), plot.line = list(col = "#000000"), add.line = list(col = "#000000", lty = 2), ## clipping allows drawing to go outside panel (i.e : drawings) limits as.table = TRUE ), envir = .ADEgEnv ) changelatticetheme(get("adegtheme", envir = .ADEgEnv)) assign("currentadeg", list(), envir = .ADEgEnv) } adegraphics/R/C1.barchart.R0000644000176200001440000001406613742303021015102 0ustar liggesuserssetClass( Class = "C1.barchart", contains = "ADEg.C1" ) setMethod( f = "initialize", signature = "C1.barchart", definition = function(.Object, data = list(score = NULL, labels = NULL, at = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.C1 initialize .Object@data$labels <- data$labels .Object@data$at <- data$at validObject(.Object) return(.Object) }) setMethod( f = "prepare", signature = "C1.barchart", definition = function(object) { nameobj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) if(object@data$storeData) { score <- object@data$score at <- object@data$at } else { score <- eval(object@data$score, envir = sys.frame(object@data$frame)) at <- eval(object@data$at, envir = sys.frame(object@data$frame)) } score <- as.matrix(score)[, 1] ## to manage 'score' when it is a data.frame with only one column ## change default for some parameters if(adegtot$p1d$horizontal && is.null(object@adeg.par$plabels$srt)) adegtot$plabels$srt <- 0 else if(!adegtot$p1d$horizontal && is.null(object@adeg.par$plabels$srt)) adegtot$plabels$srt <- 90 if(is.null(object@adeg.par$plabels$boxes$draw)) adegtot$plabels$boxes$draw <- FALSE adegtot$p1d$rug$draw <- FALSE ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph if(object@adeg.par$p1d$horizontal && is.null(object@g.args$ylim)) object@g.args$ylim <- setlimits1D(min(at), max(at), 0, FALSE) if(!object@adeg.par$p1d$horizontal && is.null(object@g.args$xlim)) object@g.args$xlim <- setlimits1D(min(at), max(at), 0, FALSE) assign(nameobj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "C1.barchart", definition = function(object, x, y) { ## Drawing barchart ## x is the index ## y is the score ## get some parameters pscore <- object@adeg.par$p1d ppoly <- lapply(object@adeg.par$ppolygons, FUN = function(x) {rep(x, length.out = length(x))}) plabels <- lapply(object@adeg.par$plabels, FUN = function(x) {rep(x, length.out = length(x))}) if(object@data$storeData) labels <- object@data$labels else labels <- eval(object@data$labels, envir = sys.frame(object@data$frame)) ## manage string rotation srt <- 0 if(is.numeric(plabels$srt[1])) srt <- plabels$srt[1] else { if(plabels$srt[1] == "horizontal") srt <- 0 else if(plabels$srt[1] == "vertical") srt <- 90 } ## reorder values and labels y <- y[order(x)] labels <- labels[order(x)] x <- sort(x) ## Starts the display ## depends on the parametres horizontal ## reverse and rug.draw are always considered as FALSE if(pscore$horizontal) { x.tmp <- y y.tmp <- x } else { x.tmp <- x y.tmp <- y } panel.barchart(x = x.tmp, y = y.tmp, horizontal = pscore$horizontal, box.width = 0.9, origin = 0, reference = FALSE, border = ppoly$border, col = ppoly$col, lty = ppoly$lty, lwd = ppoly$lwd, alpha = ppoly$alpha) ## panel.text(x.tmp, y.tmp, labels) if(!is.null(labels)) { if(abs(sin(srt)) > sin(45)) { ## almost vertical labels if(pscore$horizontal) width <- stringWidth("h") else width <- stringWidth(labels) + stringWidth("h") width <- rep(plabels$cex, length.out = length(labels)) * convertUnit(width, "native", typeFrom = "dimension", axisFrom = "x", axisTo = "y", valueOnly = TRUE) / 2 } else { ## almost horizont labels if(pscore$horizontal) width <- stringWidth(labels) + stringWidth("h") else width <- stringWidth("h") width <- rep(plabels$cex, length.out = length(labels)) * convertUnit(width, "native", typeFrom = "dimension", axisFrom = "x", valueOnly = TRUE) / 2 } if(pscore$horizontal) adeg.panel.label(x = x.tmp + width * sign(x.tmp), y = y.tmp, labels = labels, plabels = plabels) else adeg.panel.label(x = x.tmp, y = y.tmp + width * sign(y.tmp), labels = labels, plabels = plabels) } }) s1d.barchart <- function(score, labels = NULL, at = 1:NROW(score), sort = FALSE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters thecall <- .expand.call(match.call()) score <- eval(thecall$score, envir = sys.frame(sys.nframe() + pos)) ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if(NCOL(score) == 1) object <- multi.facets.C1(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple scores") } ## multiple scores else if(NCOL(score) > 1) { object <- multi.score.C1(thecall) } ## simple ADEg graphic else { # if score is sorted if(sort) at <- rank(score) if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(sort = sort)) if(storeData) tmp_data <- list(score = score, labels = labels, at = at, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(score = thecall$score, labels = thecall$labels, at = thecall$at, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "C1.barchart", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = sortparameters$g.args, Call = match.call()) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/S1.boxplot.R0000644000176200001440000002172413742303021015022 0ustar liggesusers########################################################### ## s1d.boxplot ## ########################################################### setClass( Class = "S1.boxplot", contains = "ADEg.S1" ) setMethod( f = "initialize", signature = "S1.boxplot", definition = function(.Object, data = list(score = NULL, fac = NULL, at = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.S1 initialize .Object@data$fac <- data$fac return(.Object) }) setMethod( f = "prepare", signature = "S1.boxplot", definition = function(object) { name_obj <- deparse(substitute(object)) if(object@data$storeData) fac <- as.factor(object@data$fac) else fac <- as.factor(eval(object@data$fac, envir = sys.frame(object@data$frame))) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) ## change default for some parameters if(adegtot$p1d$horizontal & is.null(object@adeg.par$plabels$srt)) adegtot$plabels$srt <- 0 else if(!adegtot$p1d$horizontal & is.null(object@adeg.par$plabels$srt)) adegtot$plabels$srt <- 90 ## setting colors paramsToColor <- list(ppoints = list(col = object@adeg.par$ppoints$col, fill = object@adeg.par$ppoints$fill), plabels = list(col = object@adeg.par$plabels$col, boxes = list(border = object@adeg.par$plabels$boxes$border)), plines = list(col = object@adeg.par$plines$col), ppolygons = list(border = object@adeg.par$ppolygons$border, col = object@adeg.par$ppolygons$col)) if(!(is.null(object@g.args$col) || (is.logical(object@g.args$col) && !object@g.args$col))) adegtot <- modifyList(adegtot, col2adepar(ccol = object@g.args$col, pparamsToColor = paramsToColor, nnlev = nlevels(fac))) ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "S1.boxplot", definition = function(object, x, y) { if(object@data$storeData) { fac <- object@data$fac at <- object@data$at } else { fac <- eval(object@data$fac, envir = sys.frame(object@data$frame)) at <- eval(object@data$at, envir = sys.frame(object@data$frame)) } fac <- as.factor(fac) nlev <- nlevels(fac) labels <- levels(fac) lims <- current.panel.limits(unit = "native") pscore <- object@adeg.par$p1d plabels <- object@adeg.par$plabels ## repeat graphical parameters (one for each level) ppoints <- lapply(object@adeg.par$ppoints, FUN = function(x) x <- rep(x, length.out = nlev)) ppoints <- lapply(ppoints, FUN = function(x) x <- x[1:nlev]) plines <- lapply(object@adeg.par$plines, FUN = function(x) x <- rep(x, length.out = nlev)) plines <- lapply(plines, FUN = function(x) x <- x[1:nlev]) ppolygons <- lapply(object@adeg.par$ppolygons, FUN = function(x) x <- rep(x, length.out = nlev)) ppolygons <- lapply(ppolygons, FUN = function(x) x <- x[1:nlev]) ## manage trellis parameters oldcolsymbol <- trellis.par.get("plot.symbol")$col oldcolumbrella <- trellis.par.get("box.umbrella")$col oldcolrectangle <- trellis.par.get("box.rectangle")$col trellis.par.set(list("plot.symbol" = list("col" = "black"), "box.umbrella" = list("col" = plines$col), "box.rectangle" = list("col" = ppolygons$border))) on.exit(trellis.par.set(list("plot.symbol" = list("col" = oldcolsymbol), "box.umbrella" = list("col" = oldcolumbrella), "box.rectangle" = list("col" = oldcolrectangle)))) ## manage string rotation srt <- 0 if(is.numeric(plabels$srt[1])) srt <- plabels$srt[1] else { if(plabels$srt[1] == "horizontal") srt <- 0 else if(plabels$srt[1] == "vertical") srt <- 90 } gettextpos <- function(x, lim) { if(length(x) != 2) { ## if no data in the given level return(c(NA, NA)) } else { if(abs(lim[2] - x[2]) > abs(lim[1] - x[1])) return(c(x[2], 1)) else return(c(x[1], -1)) } } if(pscore$horizontal) { ## horizontal plot ylab <- at if(length(ylab) > 1) bwid <- diff(range(ylab)) / (nlev + 1) else bwid <- 1 / 10 ## panel.bwplot do.call("panel.bwplot", list(x = y, y = ylab[fac], box.ratio = bwid, coef = 1.5, pch = "|", horizontal = TRUE)) ## add means do.call("panel.points", c(list(x = (tapply(y, fac, mean)), y = ylab), ppoints)) minmax <- tapply(y, fac, range) etis <- sapply(minmax, gettextpos, lim = lims$xlim) } else { ## vertical plot xlab <- at if(length(xlab) > 1) bwid <- diff(range(xlab)) / (nlev + 1) else bwid <- 1 / 10 ## panel.bwplot do.call("panel.bwplot", list(x = xlab[fac], y = y, box.ratio = bwid, coef = 1.5, pch = "|", horizontal = FALSE)) ## add means do.call("panel.points", c(list(y = (tapply(y, fac , mean)), x = xlab), ppoints)) minmax <- tapply(y, fac, range) etis <- sapply(minmax, gettextpos, lim = lims$ylim) } ## draw labels if(abs(sin(srt)) > sin(45)) { ## almost vertical labels if(pscore$horizontal) width <- stringWidth("h") else width <- stringWidth(labels) + stringWidth("h") width <- rep(plabels$cex, length.out = length(labels)) * convertUnit(width, "native", typeFrom = "dimension", axisFrom = "x", axisTo = "y", valueOnly = TRUE) / 2 } else { ## almost horizontal labels if(pscore$horizontal) width <- stringWidth(labels) + stringWidth("h") else width <- stringWidth("h") width <- rep(plabels$cex, length.out = length(labels)) * convertUnit(width, "native", typeFrom = "dimension", axisFrom = "x", valueOnly = TRUE) / 2 } if(pscore$horizontal) adeg.panel.label(x = etis[1, ] + etis[2, ] * width, y = ylab, labels = labels, plabels = plabels) else adeg.panel.label(x = xlab, y = etis[1, ] + etis[2, ] * width, labels = labels, plabels = plabels) }) ## For boxplot, parameters can only be changed using par.settings arguments; setMethod( f = "setlatticecall", signature = "S1.boxplot", definition = function(object) { name_obj <- deparse(substitute(object)) callNextMethod() ppolygons <- object@adeg.par$ppolygons object@lattice.call$arguments$par.settings <- modifyList(list(box.rectangle = c(list(col = ppolygons$border, fill = ppolygons$col), ppolygons[-c(which(names(ppolygons) == "border" | (names(ppolygons) == "col")))]), box.umbrella = object@adeg.par$plines, plot.symbol = modifyList(list(col = "black", fill = "black"), object@adeg.par$ppoints)), object@lattice.call$arguments$par.settings, keep.null = TRUE) assign(name_obj, object, envir = parent.frame()) }) s1d.boxplot <- function(score, fac = gl(1, NROW(score)), at = 1:nlevels(fac), col = NULL, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters thecall <- .expand.call(match.call()) fac <- eval(thecall$fac, envir = sys.frame(sys.nframe() + pos)) score <- eval(thecall$score, envir = sys.frame(sys.nframe() + pos)) if(NROW(fac) != NROW(score)) stop("fac and score must have the same number of rows") ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if(NCOL(score) == 1 & NCOL(fac) == 1) object <- multi.facets.S1(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple scores or fac") } ## multiple scores else if(NCOL(score) > 1) { if(NCOL(fac) == 1) object <- multi.score.S1(thecall) else stop("Multiple scores are not allowed with multiple fac") } ## multiple fac else if(NCOL(fac) > 1) { object <- multi.variables.S1(thecall, "fac") } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(col = col)) if(storeData) tmp_data <- list(score = score, fac = fac, at = at, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(score = thecall$score, fac = fac, at = thecall$at, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "S1.boxplot", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = match.call()) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/utilsclass.R0000644000176200001440000000571313742303021015237 0ustar liggesusers #### revoir cette fonction #### .util.ellipse <- function(mx, my, vx, vy, cxy, coeff) { if(!is.finite(mx) | !is.finite(my)) ## levels with no individuals return(NULL) lig <- 100 epsi <- 1e-10 x <- 0 y <- 0 if(vx < 0) vx <- 0 if(vy < 0) vy <- 0 if(vx == 0 && vy == 0) return(NULL) delta <- (vx - vy) * (vx - vy) + 4 * cxy * cxy delta <- sqrt(delta) l1 <- (vx + vy + delta) / 2 l2 <- vx + vy - l1 if(l1 < 0) l1 <- 0 if(l2 < 0) l2 <- 0 l1 <- sqrt(l1) l2 <- sqrt(l2) test <- 0 if(vx == 0) { a0 <- 0 b0 <- 1 test <- 1 } if((vy == 0) && (test == 0)) { a0 <- 1 b0 <- 0 test <- 1 } if(((abs(cxy)) < epsi) && (test == 0)) { if(vx > vy){ a0 <- 1 b0 <- 0 } else { a0 <- 0 b0 <- 1 } test <- 1 } if(test == 0) { a0 <- 1 b0 <- (l1 * l1 - vx) / cxy norm <- sqrt(a0 * a0 + b0 * b0) a0 <- a0 / norm b0 <- b0 / norm } a1 <- 2 * pi / lig c11 <- coeff * a0 * l1 c12 <- (-coeff) * b0 * l2 c21 <- coeff * b0 * l1 c22 <- coeff * a0 * l2 angle <- 0 for (i in 1:lig) { cosinus <- cos(angle) sinus <- sin(angle) x[i] <- mx + c11 * cosinus + c12 * sinus y[i] <- my + c21 * cosinus + c22 * sinus if(is.null(mx + c11 * cosinus + c12 * sinus) || is.null(y[i] <- my + c21 * cosinus + c22 * sinus)) print("in util.ellipse x or y null") angle <- angle + a1 } return(list(x = x, y = y, seg1 = c(mx + c11, my + c21, mx - c11, my - c21), seg2 = c(mx + c12, my + c22, mx - c12, my - c22))) } ## Nouvelle version: ## principe: ## 1) calcul de distance entre les points appartenant a un groupe et le centroides du groupe ## 2) extraction du quantile correspondant a optchull (les % d les plus eloignes forment le polugfone ## x, y: points, mx, my: coordonnees des centroides, optchull: paramètre voulu pour lenvellope converxe, fac: facteur separeant les poitns .util.chull <- function(x, y, mx, my, fac, chullSize) { ## pour chaque groupe calcul des distances chulls <- list() for(i in 1:nlevels(fac)) { ## attention fac est passe en facteur! index <- which(fac == levels(fac)[i]) if(length(index) > 0) { x1 <- x[index] y1 <- y[index] dd <- sqrt((x1 - mx[i])^2 + (y1 - my[i])^2) ## distances chaque points a la moyenne tmp_quant <- list() for(quant in chullSize) { ## pour chaque envelope demandee selected <- which(dd <= quantile(dd, quant)) ## points en dessous du quant xin <- x1[selected] yin <- y1[selected] chullchoice <- chull(xin, yin) ## points formant la convex hull x2 <- xin[chullchoice] y2 <- yin[chullchoice] tmp_quant <- c(tmp_quant, list(cbind(x2, y2))) ## coord des points formant le polygone } names(tmp_quant) <- as.character(chullSize) } else tmp_quant <- NULL chulls <- c(chulls, list(tmp_quant)) } names(chulls) <- as.character(levels(fac)) return(chulls) } adegraphics/R/S2.arrow.R0000644000176200001440000001116414354572530014500 0ustar liggesusers########################################################################## ## s.arrow ## ########################################################################## setClass( Class = "S2.arrow", contains = "ADEg.S2" ) setMethod( f = "initialize", signature = "S2.arrow", definition = function(.Object, data = list(dfxy = NULL, xax = 1, yax = 2, labels = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.S2 initialize .Object@data$labels <- data$labels return(.Object) }) setMethod( f = "prepare", signature = "S2.arrow", definition = function(object) { name_obj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) ## change default for some parameters if(is.null(object@adeg.par$ppoints$cex)) adegtot$ppoints$cex <- 0 if(is.null(object@adeg.par$porigin$include) & (any(names(object@g.args) %in% c("Sp", "nbobject")))) adegtot$porigin$include <- FALSE ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph if(is.null(object@s.misc$lim.update)) { if(is.null(object@g.args$Sp)) { xdiff <- diff(object@g.args$xlim) ydiff <- diff(object@g.args$ylim) object@g.args$xlim <- object@g.args$xlim + c(-1, 1) * 0.05 * xdiff object@g.args$ylim <- object@g.args$ylim + c(-1, 1) * 0.05 * ydiff } object@s.misc$lim.update <- TRUE } ## never optimized labels for s.arrow object@adeg.par$plabels$optim <- FALSE assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "S2.arrow", definition = function(object, x, y) { ## draw arrows panel.arrows(x0 = object@adeg.par$porigin$origin[1], y0 = object@adeg.par$porigin$origin[2], y1 = y, x1 = x, angle = object@adeg.par$parrows$angle, length = object@adeg.par$parrows$length, ends = object@adeg.par$parrows$end, lwd = object@adeg.par$plines$lwd, col = object@adeg.par$plines$col, lty = object@adeg.par$plines$lty) ## draw labels ## positions plabels <- object@adeg.par$plabels if(object@data$storeData) arrownames <- object@data$labels else arrownames <- eval(object@data$labels, envir = sys.frame(object@data$frame)) if(!is.null(arrownames)) { pos <- .textpos(x, y, origin = c(0, 0)) test <- .textsize(arrownames, plabels) w <- test$w h <- test$h if(any(object@adeg.par$plabels$cex > 0)) adeg.panel.label(x + pos[1, ] * w / 2, y + pos[2, ] * h / 2 , arrownames, plabels) } }) s.arrow <- function(dfxy, xax = 1, yax = 2, labels = row.names(as.data.frame(dfxy)), facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters (required for multiplot) thecall <- .expand.call(match.call()) df <- try(as.data.frame(eval(thecall$dfxy, envir = sys.frame(sys.nframe() + pos))), silent = TRUE) if(inherits(df, "try-error") | is.null(thecall$dfxy)) ## non convenient dfxy argument stop("non convenient selection for dfxy (can not be converted to dataframe)") ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if((length(xax) == 1 & length(yax) == 1)) object <- multi.facets.S2(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple xax/yax") } ## multiple axes else if((length(xax) > 1 | length(yax) > 1)) { object <- multi.ax.S2(thecall) } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object if(storeData) tmp_data <- list(dfxy = dfxy, xax = xax, yax = yax, labels = labels, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(dfxy = thecall$dfxy, xax = xax, yax = yax, labels = thecall$labels, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "S2.arrow", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = sortparameters$g.args, Call = as.call(thecall)) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/S2.class.R0000644000176200001440000002506714354572556014472 0ustar liggesusers########################################################################## ## s.class ## ########################################################################## setClass( Class = "S2.class", contains = "ADEg.S2" ) setMethod( f = "initialize", signature = "S2.class", definition = function(.Object, data = list(dfxy = NULL, xax = 1, yax = 2, fac = NULL, wt = NULL, labels = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) .Object@data$fac <- data$fac .Object@data$wt <- data$wt .Object@data$labels <- data$labels return(.Object) }) setMethod( ## prepare computations for ellipses, stars and labels f = "prepare", signature = "S2.class", definition = function(object) { name_obj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) if(object@data$storeData) { fac <- as.factor(object@data$fac) dfxy <- object@data$dfxy wt <- object@data$wt } else { fac <- as.factor(eval(object@data$fac, envir = sys.frame(object@data$frame))) dfxy <- eval(object@data$dfxy, envir = sys.frame(object@data$frame)) wt <- eval(object@data$wt, envir = sys.frame(object@data$frame)) } ## change default for some parameters if(is.null(object@adeg.par$porigin$include) & (any(names(object@g.args) %in% c("Sp", "nbobject")))) adegtot$porigin$include <- FALSE if(any(adegtot$plabels$cex > 0) & is.null(object@adeg.par$plegend$drawKey)) ## if labels, no legend adegtot$plegend$drawKey <- FALSE ## setting colors paramsToColor <- list(ppoints = list(col = object@adeg.par$ppoints$col, fill = object@adeg.par$ppoints$fill), plabels = list(col = object@adeg.par$plabels$col, boxes = list(border = object@adeg.par$plabels$boxes$border)), plines = list(col = object@adeg.par$plines$col), pellipses = list(border = object@adeg.par$pellipses$border, col = object@adeg.par$pellipses$col), ppolygons = list(border = object@adeg.par$ppolygons$border, col = object@adeg.par$ppolygons$col)) if(!(is.null(object@g.args$col) || (is.logical(object@g.args$col) && !object@g.args$col))) adegtot <- modifyList(adegtot, col2adepar(ccol = object@g.args$col, pparamsToColor = paramsToColor, nnlev = nlevels(fac))) ## preliminary computations object@stats$means <- matrix(meanfacwt(dfxy[, c(object@data$xax, object@data$yax)], fac, wt), nrow = nlevels(fac)) ## for ellipse, covariance and variance needed if(object@g.args$ellipseSize) object@stats$covvar <- covfacwt(dfxy[, c(object@data$xax, object@data$yax)], fac, wt) ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph ## compute ellipses if(object@g.args$ellipseSize > 0) { object@s.misc$ellipses <- lapply(1:nlevels(fac), FUN = function(i) { .util.ellipse(object@stats$means[i, 1], object@stats$means[i, 2], vx = object@stats$covvar[[i]][1, 1], vy = object@stats$covvar[[i]][2, 2], cxy = object@stats$covvar[[i]][1, 2], coeff = object@g.args$ellipseSize) }) } ## compute convex hulls if(!is.null(object@g.args$chullSize)) if(any(object@g.args$chullSize > 0)) object@s.misc$chullcoord <- .util.chull(dfxy[, object@data$xax], dfxy[, object@data$yax], object@stats$means[, 1], object@stats$means[, 2], fac = fac, chullSize = object@g.args$chullSize) ## never optimized labels for s.class object@adeg.par$plabels$optim <- FALSE assign(name_obj, object, envir = parent.frame()) }) ## a changer: dessin level par level, setMethod( f = "panel", signature = "S2.class", definition = function(object, x, y) { if(object@data$storeData) { fac <- object@data$fac labels <- object@data$labels } else { fac <- eval(object@data$fac, envir = sys.frame(object@data$frame)) labels <- eval(object@data$labels, envir = sys.frame(object@data$frame)) } nlev <- nlevels(fac) ## convex hulls if(any(object@g.args$chullSize > 0)) { chullpo <- object@s.misc$chullcoord ppolygons <- lapply(object@adeg.par$ppolygons, FUN = function(x) {rep(x, length.out = length(chullpo))}) for(level in 1:nlev) if(!any(is.null(chullpo[[level]]))) { for(j in 1:length(chullpo[[level]])) panel.polygon( x = chullpo[[level]][[j]][, 1], y = chullpo[[level]][[j]][, 2], border = ppolygons$border[level], col = ppolygons$col[level], lty = ppolygons$lty[level], lwd = ppolygons$lwd[level], alpha = ppolygons$alpha[level]) } } ## ellipses if(object@g.args$ellipseSize > 0) { ellip <- object@s.misc$ellipses pellip <- object@adeg.par$pellipses pellip <- lapply(pellip, FUN = function(x) {if(is.list(x)) return(x) else rep(x, le = length(ellip))}) pellip$axes <- lapply(pellip$axes, FUN = function(x) {rep(x, length.out = length(ellip))}) for(level in 1:nlev) { ## for each group ell <- ellip[[level]] if(!(any(is.null(ell)))) if(!any(is.na(ell))) { panel.polygon(ell$x, ell$y, col = pellip$col[level], lwd = pellip$lwd[level], lty = pellip$lty[level], alpha = pellip$alpha[level], border = pellip$border[level]) if(pellip$axes$draw[level]) { ## axes drawing panel.segments(ell$seg1[1], ell$seg1[2], ell$seg1[3], ell$seg1[4], lwd = pellip$axes$lwd[level], lty = pellip$axes$lty[level], col = pellip$axes$col[level]) panel.segments(ell$seg2[1], ell$seg2[2], ell$seg2[3], ell$seg2[4], lwd = pellip$axes$lwd[level], lty = pellip$axes$lty[level], col = pellip$axes$col[level]) } } } } ## stars if(object@g.args$starSize > 0) { plines <- lapply(object@adeg.par$plines, FUN = function(x) {rep(x, length.out = nlev)}) for(level in 1:nlev) { if(all(is.finite(object@stats$means[level, ]))) { xbase <- object@stats$means[level, 1] ybase <- object@stats$means[level, 2] xlev <- x[fac == levels(fac)[level]] ylev <- y[fac == levels(fac)[level]] panel.segments( x0 = xbase, y0 = ybase, x1 = xbase + object@g.args$starSize * (xlev - xbase), y1 = ybase + object@g.args$starSize * (ylev - ybase), lty = plines$lty[level], lwd = plines$lwd[level], col = plines$col[level]) } } } ## plot points if(any(object@adeg.par$ppoints$cex > 0)) { ppoints <- object@adeg.par$ppoints if(nlev > 1) { ppoints <- lapply(object@adeg.par$ppoints, FUN = function(x, fac, nlev) { if(length(x) > nlev) return(x) else { xlev <- rep(x, length.out = nlev) xpar <- xlev[fac] return(xpar) } }, fac = fac, nlev = nlev) } if(any(is.na(ppoints$pch))) { indx <- 1:length(x) indx <- indx[- which(is.na(ppoints$pch))] panel.points(x = x[indx], y = y[indx], type = "p", pch = ppoints$pch[indx], cex = ppoints$cex[indx], col = ppoints$col[indx], alpha = ppoints$alpha[indx], fill = ppoints$fill[indx]) } else panel.points(x = x, y = y, type = "p", pch = ppoints$pch, cex = ppoints$cex, col = ppoints$col, alpha = ppoints$alpha, fill = ppoints$fill) } ## plot of labels if(any(object@adeg.par$plabels$cex > 0)) { labX <- object@stats$means[, 1] labY <- object@stats$means[, 2] adeg.panel.label(x = labX, y = labY, labels = labels, object@adeg.par$plabels) } }) s.class <- function(dfxy, fac, xax = 1, yax = 2, wt = rep(1, NROW(fac)), labels = levels(fac), ellipseSize = 1.5, starSize = 1, chullSize = NULL, col = NULL, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters (required for multiplot) thecall <- .expand.call(match.call()) labels <- eval(thecall$labels, envir = sys.frame(sys.nframe() + pos)) fac <- eval(thecall$fac, envir = sys.frame(sys.nframe() + pos)) df <- try(as.data.frame(eval(thecall$dfxy, envir = sys.frame(sys.nframe() + pos))), silent = TRUE) if(inherits(df, "try-error") | is.null(thecall$dfxy)) ## non convenient dfxy argument stop("non convenient selection for dfxy (can not be converted to dataframe)") if(missing(fac)) stop("no factor specified") if(NCOL(fac) == 1) { fac <- as.factor(fac) if(length(labels) != nlevels(fac)) stop("wrong number of labels") } ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if((length(xax) == 1 & length(yax) == 1) & NCOL(fac) == 1) object <- multi.facets.S2(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple xax/yax or multiple fac") } ## multiple axes else if((length(xax) > 1 | length(yax) > 1)) { if(NCOL(fac) == 1) object <- multi.ax.S2(thecall) else stop("Multiple xax/yax are not allowed with multiple fac") } ## multiple fac else if(NCOL(fac) > 1) { object <- multi.variables.S2(thecall, "fac") } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(ellipseSize = ellipseSize, starSize = starSize, chullSize = chullSize, col = col)) if(storeData) tmp_data <- list(dfxy = dfxy, fac = fac, xax = xax, yax = yax, wt = wt, labels = labels, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(dfxy = thecall$dfxy, fac = thecall$fac, xax = xax, yax = yax, wt = thecall$wt, labels = thecall$labels, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "S2.class", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = as.call(thecall)) ## preparation of the graph prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(! add & plot) print(object) invisible(object) } adegraphics/R/Tr.traject.R0000644000176200001440000001631114572276635015113 0ustar liggesusers###################################################### ## Tr.traject ### ###################################################### setClass( Class = "Tr.traject", contains = "ADEg.Tr" ) setMethod( f = "initialize", signature = "Tr.traject", definition = function(.Object, data = list(dfxyz = NULL, fac = NULL, labels = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) .Object@data$fac <- data$fac .Object@data$labels <- data$labels return(.Object) }) setMethod( f = "prepare", signature = "Tr.traject", definition = function(object) { name_obj <- deparse(substitute(object)) if(object@data$storeData) { df <- object@data$dfxyz fac <- as.factor(object@data$fac) } else { df <- eval(object@data$dfxyz, envir = sys.frame(object@data$frame)) fac <- as.factor(eval(object@data$fac, envir = sys.frame(object@data$frame))) } ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) ## setting colors paramsToColor <- list(ppoints = list(col = object@adeg.par$ppoints$col, fill = object@adeg.par$ppoints$fill), plabels = list(col = object@adeg.par$plabels$col, boxes = list(border = object@adeg.par$plabels$boxes$border)), plines = list(col = object@adeg.par$plines$col)) if(!(is.null(object@g.args$col) || (is.logical(object@g.args$col) && !object@g.args$col))) adegtot <- modifyList(adegtot, col2adepar(ccol = object@g.args$col, pparamsToColor = paramsToColor, nnlev = nlevels(fac))) ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph ## calculate 2D coordinates df <- sweep(df, 1, rowSums(df), "/") object@stats$coords2d <- .coordtotriangleM(df, mini3 = object@g.args$min3d, maxi3 = object@g.args$max3d)[, 2:3] ## never optimized labels for triangle.traject object@adeg.par$plabels$optim <- FALSE assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "Tr.traject", definition = function(object, x, y) { if(object@data$storeData) { fact <- object@data$fac labels <- object@data$labels } else { fact <- eval(object@data$fac, envir = sys.frame(object@data$frame)) labels <- eval(object@data$labels, envir = sys.frame(object@data$frame)) } todrawX <- split(object@stats$coords2d[, 1], fact) todrawY <- split(object@stats$coords2d[, 2], fact) sizelevels <- unlist(lapply(todrawX, length)) if(!is.null(object@g.args$order)) orderdraw <- split(order, fact) else orderdraw <- lapply(sizelevels, FUN = function(x) if(x > 0) 1:x else NULL) ## ordrerdraw is a list used to recycle graphical parameters setparam <- function(params, nblevel, sizelevels) { ## for param begin and end or repetition if(length(params) == nblevel) return(mapply(params, FUN = function(x, y) rep(x, length.out = y), sizelevels, SIMPLIFY = FALSE)) else return(mapply(sizelevels, FUN = function(x, y) rep(params, length.out = x), SIMPLIFY = FALSE)) } parrows <- lapply(object@adeg.par$parrows, setparam, nblevel = length(todrawX), sizelevels = sizelevels) plines <- lapply(object@adeg.par$plines, setparam, nblevel = length(todrawX), sizelevels = sizelevels) ppoints <- lapply(object@adeg.par$ppoints, setparam, nblevel = length(todrawX), sizelevels = sizelevels) for(i in 1:length(todrawX)) { if(length(todrawX[[i]]) > 0) panel.points(x = todrawX[[i]], y = todrawY[[i]], col = ppoints$col[[i]], cex = ppoints$cex[[i]], pch = ppoints$pch[[i]], fill = ppoints$fill[[i]]) } for(i in 1:length(todrawX)) { if(length(todrawX[[i]]) > 1) { suborder <- orderdraw[[i]] for(j in 1:(length(todrawX[[i]]) - 1)) { panel.arrows(x0 = todrawX[[i]][suborder[j]], y0 = todrawY[[i]][suborder[j]], x1 = todrawX[[i]][suborder[j + 1]], y1 = todrawY[[i]][suborder[j + 1]], angle = parrows$angle[[i]][suborder[j + 1]], length = parrows$length[[i]][suborder[j + 1]], ends = parrows$end[[i]][suborder[j + 1]], lwd = plines$lwd[[i]][suborder[j + 1]], col = plines$col[[i]][suborder[j + 1]], lty = plines$lty[[i]][suborder[j + 1]]) } } } if(any(object@adeg.par$plabels$cex > 0)) { ## draws labels in the middle part of the trajectory middl <- unlist(lapply(orderdraw, FUN = function(x) floor(length(x) / 2))) x <- y <- rep(NA, length(middl)) for(i in 1:length(middl)) { if(length(todrawX[[i]]) > 1) { x[i] <- (todrawX[[i]][suborder[middl[i]]] + todrawX[[i]][suborder[middl[i]+1]]) / 2 y[i] <- (todrawY[[i]][suborder[middl[i]]] + todrawY[[i]][suborder[middl[i]+1]]) / 2 } } adeg.panel.label(x, y, labels = labels, plabels = object@adeg.par$plabels) } }) triangle.traject <- function(dfxyz, fac = gl(1, nrow(dfxyz)), order, labels = levels(fac), col = NULL, adjust = TRUE, min3d = NULL, max3d = NULL, showposition = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## dfxyz: matrix/data.frame with 3 columns ## min3d, max3d: limits by default: c(0,0,0), c(1,1,1) thecall <- .expand.call(match.call()) ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if(NCOL(fac) == 1) object <- multi.facets.Tr(thecall, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed multiple fac") } ## multiple fac else if(NCOL(fac) > 1) { object <- multi.variables.Tr(thecall, "fac") } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(adjust = adjust, min3d = min3d, max3d = max3d, col = col, order = thecall$order)) if(storeData) tmp_data <- list(dfxyz = dfxyz, fac = fac, labels = labels, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(dfxyz = thecall$dfxyz, fac = thecall$fac, labels = thecall$labels, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "Tr.traject", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = match.call()) ## preparation prepare(object) setlatticecall(object) if(showposition & add) { print("cannot show position and add") ## can be done, but modifies the meaning of the superposition showposition <- FALSE } if(showposition) object <- new(Class = "ADEgS", ADEglist = list("triangle" = object, "positions" = .showpos(object)), positions = rbind(c(0, 0, 1, 1), c(0, 0.7, 0.3, 1)), add = matrix(0, ncol = 2, nrow = 2), Call = match.call()) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/addline.R0000644000176200001440000000551413742303021014450 0ustar liggesuserssetMethod( f = "addline", signature = "ADEg", definition = function(object, a = NULL, b = 0, h = NULL, v = NULL, plot = TRUE, ...) { # collect limits xlim <- object@g.args$xlim ylim <- object@g.args$ylim aspect <- object@adeg.par$paxes$aspectratio ## sorting parameters sortparameters <- sortparamADEg(...)$adepar params <- adegpar() sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) params <- sortparameters$plines lineadded <- xyplot(0 ~ 0, xlim = xlim, ylim = ylim, xlab = NULL, ylab = NULL, aspect = aspect, mya = a, myb = b, myh = h, myv = v, panel = function(x, y, ...) panel.abline(a = a, b = b, h = h, v = v, lwd = params$lwd, lty = params$lty, col = params$col), plot = FALSE) lineadded$call <- call("xyplot", 0 ~ 0, xlim = substitute(xlim), ylim = substitute(ylim), xlab = NULL, ylab = NULL, aspect = substitute(aspect), lwd = params$lwd, lty = params$lty, col = params$col, a = substitute(a), b = substitute(b), h = substitute(h), v = substitute(v), panel = function(x, y, ...) panel.abline(a = a, b = b, h = h, v = v)) # superposition obj <- superpose(object, lineadded, plot = FALSE) nn <- all.names(substitute(object)) names(obj) <- c(ifelse(is.na(nn[2]), nn[1], nn[2]), "lineadded") if(plot) print(obj) invisible(obj) }) setMethod( f = "addline", signature = "ADEgS", definition = function(object, a = NULL, b = 0, h = NULL, v = NULL, plot = TRUE, which = 1:length(object), ...) { ngraph <- length(object) if(max(which) > ngraph) stop("Values in 'which' should be lower than the length of object") if(length(which) == 1) { object[[which]] <- addline(object[[which]], a = a, b = b, h = h, v = v, ..., plot = FALSE) } else { if(sum(object@add) != 0) stop("The 'addline' function is not available for superposed objects.", call. = FALSE) ## sorting parameters sortparameters <- sortparamADEg(...)$adepar params <- adegpar() sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) params <- sortparameters$plines params <- rapply(params, function(X) rep(X, length.out = length(which)), how = "list") if(!is.null(a)) a <- rep_len(a, length.out = length(which)) b <- rep_len(b, length.out = length(which)) if(!is.null(h)) h <- rep_len(h, length.out = length(which)) if(!is.null(v)) v <- rep_len(v, length.out = length(which)) for (i in which) object[[i]] <- addline(object[[i]], a = a[i], b = b[i], h = h[i], v = v[i], which = 1, plot = FALSE, plines = lapply(params, function(X) X[i])) } obj <- object if(plot) print(obj) invisible(obj) })adegraphics/R/S1.distri.R0000644000176200001440000001553113742303021014630 0ustar liggesusers########################################################### ## s1d.distri ## ########################################################### setClass( Class = "S1.distri", contains = "ADEg.S1" ) setMethod( f = "initialize", signature = "S1.distri", definition = function(.Object, data = list(score = NULL, dfdistri = NULL, labels = NULL, at = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.S1 initialize .Object@data$dfdistri <- data$dfdistri .Object@data$labels <- data$labels return(.Object) }) setMethod( f = "prepare", signature = "S1.distri", definition = function(object) { name_obj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) if(object@data$storeData) { dfdistri <- object@data$dfdistri score <- object@data$score labels <- object@data$labels } else { dfdistri <- eval(object@data$dfdistri, envir = sys.frame(object@data$frame)) score <- eval(object@data$score, envir = sys.frame(object@data$frame)) labels <- eval(object@data$labels, envir = sys.frame(object@data$frame)) } score <- as.matrix(score)[, 1] ## to manage 'score' when it is a data.frame with only one column ## change default for some parameters if(adegtot$p1d$horizontal & is.null(object@adeg.par$plabels$srt)) adegtot$plabels$srt <- 0 else if(!adegtot$p1d$horizontal & is.null(object@adeg.par$plabels$srt)) adegtot$plabels$srt <- 90 ## statistics calculus object@stats$means <- sapply(dfdistri, function(x) weighted.mean(score, x)) names(object@stats$means) <- labels object@stats$sds <- sapply(dfdistri, function(x) sqrt(varwt(score, x))) ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "S1.distri", definition = function(object, x, y) { if(object@data$storeData) { labels <- object@data$labels at <- object@data$at } else { labels <- eval(object@data$labels, envir = sys.frame(object@data$frame)) at <- eval(object@data$at, envir = sys.frame(object@data$frame)) } lims <- current.panel.limits(unit = "native") pscore <- object@adeg.par$p1d ngroups <- length(object@stats$means) means <- object@stats$means sds <- object@stats$sds * object@g.args$sdSize plabels <- object@adeg.par$plabels lead <- ifelse(pscore$reverse, -1, 1) if(pscore$horizontal) { ## horizontal plot ylab <- at if(object@g.args$yrank) { idx <- order(means, decreasing = TRUE) means <- means[idx] sds <- sds[idx] labels <- labels[idx] } do.call("panel.segments", c(list(x0 = means - sds, y0 = ylab, x1 = means + sds, y1 = ylab), object@adeg.par$plines)) do.call("panel.points", c(list(x = means, y = ylab), object@adeg.par$ppoints)) etis <- ifelse(abs(lims$xlim[2] - (means + sds)) > abs(lims$xlim[1] - (means - sds)), 1, -1) } else { ## vertical plot xlab <- at if(object@g.args$yrank) { idx <- order(means, decreasing = TRUE) means <- means[idx] sds <- sds[idx] labels <- labels[idx] } do.call("panel.segments", c(list(x0 = xlab, y0 = means - sds, x1 = xlab, y1 = means + sds), object@adeg.par$plines)) do.call("panel.points", c(list(x = xlab, y = means), object@adeg.par$ppoints)) etis <- ifelse(abs(lims$ylim[2] - (means + sds)) > abs(lims$ylim[1] - (means - sds)), 1, -1) } ## manage string rotation srt <- 0 if(is.numeric(plabels$srt[1])) srt <- plabels$srt[1] else { if(plabels$srt[1] == "horizontal") srt <- 0 else if(plabels$srt[1] == "vertical") srt <- 90 } ## draw labels if(abs(sin(srt)) > sin(45)) { ## almost vertical labels if(pscore$horizontal) width <- stringWidth("h") else width <- stringWidth(labels) + stringWidth("h") width <- rep(plabels$cex, length.out = length(labels)) * convertUnit(width, "native", typeFrom = "dimension", axisFrom = "x", axisTo = "y", valueOnly = TRUE) / 2 } else { ## almost horizont labels if(pscore$horizontal) width <- stringWidth(labels) + stringWidth("h") else width <- stringWidth("h") width <- rep(plabels$cex, length.out = length(labels)) * convertUnit(width, "native", typeFrom = "dimension", axisFrom = "x", valueOnly = TRUE) / 2 } if(pscore$horizontal) adeg.panel.label(x = means + etis * (sds + width), y = ylab, labels = labels, plabels = plabels) else adeg.panel.label(x = xlab, y = means + etis * (sds + width), labels = labels, plabels = plabels) }) s1d.distri <- function(score, dfdistri, labels = colnames(dfdistri), at = 1:NCOL(dfdistri), yrank = TRUE, sdSize = 1, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters (required for multiplot) thecall <- .expand.call(match.call()) dfdistri <- eval(thecall$dfdistri, envir = sys.frame(sys.nframe() + pos)) score <- eval(thecall$score, envir = sys.frame(sys.nframe() + pos)) if(NROW(dfdistri) != NROW(score)) stop("dfdis and score must have the same number of rows") ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)){ if(NCOL(score) == 1) object <- multi.facets.S1(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple scores") } ## multiple scores else if(NCOL(score) > 1) { object <- multi.score.S1(thecall) } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(yrank = yrank, sdSize = sdSize)) if(storeData) tmp_data <- list(score = score, dfdistri = dfdistri, at = at, labels = labels, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(score = thecall$score, dfdistri = thecall$dfdistri, at = thecall$at, labels = labels, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "S1.distri", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = match.call()) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/ADEg.Tr.R0000644000176200001440000001750614572570030014210 0ustar liggesuserssetClass( Class = "ADEg.Tr", contains = c("ADEg", "VIRTUAL"), slots = c(data = "list") ) setMethod( f = "initialize", signature = "ADEg.Tr", definition = function(.Object, data = list(dfxyz = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, ...) ## ADEg initialize .Object@data <- data return(.Object) }) setMethod( f = "prepare", signature = "ADEg.Tr", definition = function(object) { name_obj <- deparse(substitute(object)) if(object@data$storeData) df <- object@data$dfxyz else df <- eval(object@data$dfxyz, envir = sys.frame(object@data$frame)) ## define limits if(is.null(object@g.args$xlim)) object@g.args$xlim <- c(-0.8, 0.8) if(is.null(object@g.args$ylim)) object@g.args$ylim <- c(-0.6, 1) ## grid computation if(is.null(object@g.args$max3d)) object@g.args$max3d <- .trranges(df = df, adjust = object@g.args$adjust)$maxi if(is.null(object@g.args$min3d)) object@g.args$min3d <- .trranges(df = df, adjust = object@g.args$adjust)$mini valuLim <- .trranges(df = df, adjust = object@g.args$adjust, min3 = object@g.args$min3d, max3 = object@g.args$max3d) ## coordinates for the triangle vertices A <- c(-1 / sqrt(2), -1 / sqrt(6)) B <- c(1 / sqrt(2), -1 / sqrt(6)) C <- c(0, 2 / sqrt(6)) object@s.misc$cornerp <- list(A = A, B = B, C = C) ## coordinates for grid and axes ng <- object@adeg.par$pgrid$nint + 1 ## number of grid lines pts1 <- pts2 <- pts3 <- c() vdivision <- mapply(FUN = function(min, max) seq(min, max, length.out = ng), min = valuLim$mini, max = valuLim$maxi) ## 3 columns: one per axes ## where to draw the division indented <- seq(0, 1, length.out = nrow(vdivision))[-c(1, nrow(vdivision))] ## axis 1 (A to B) pts1 <- matrix(rep(A, length(indented)), ncol = 2, byrow = TRUE) + indented * (matrix(rep(B, length(indented)), ncol = 2, byrow = TRUE) - matrix(rep(A, length(indented)), ncol = 2, byrow = TRUE)) ##axis 2 (A to C) pts2 <- matrix(rep(C, length(indented)), ncol = 2, byrow = TRUE) + indented * (matrix(rep(A, length(indented)), ncol = 2, byrow = TRUE) - matrix(rep(C, length(indented)), ncol = 2, byrow = TRUE)) ## axis 3 (B to C) pts3 <- matrix(rep(B, length(indented)), ncol = 2, byrow = TRUE) + indented * (matrix(rep(C, length(indented)), ncol = 2, byrow = TRUE) - matrix(rep(B, length(indented)), ncol = 2, byrow = TRUE)) object@s.misc$lgrid <- list(pts1 = pts1, pts2 = pts2, pts3 = pts3, posgrid = vdivision) assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panelbase", signature = "ADEg.Tr", definition = function(object, x, y) { callNextMethod() ## draw triangle (A -> B , B -> C, C -> A) ## small triangle: points distribution ## triangle vertices dfcorner <- rbind(object@s.misc$cornerp$A, object@s.misc$cornerp$B, object@s.misc$cornerp$C, object@s.misc$cornerp$A) panel.polygon(dfcorner, col = object@adeg.par$pbackground$col, border = if(object@adeg.par$pbackground$box) col = "#000000" else "transparent") ## not really useful (only for arguments consistency) ## size of the grid nn <- sapply(object@s.misc$lgrid, nrow)[-4] ## draw grid if(object@adeg.par$pgrid$draw) panel.segments(x0 = c(rep(object@s.misc$lgrid[[1L]][, 1], 2), object@s.misc$lgrid[[2L]][, 1]), x1 = c(rev(object@s.misc$lgrid[[2L]][, 1]), rep(rev(object@s.misc$lgrid[[3L]][, 1]), 2)), y0 = c(rep(object@s.misc$lgrid[[1L]][, 2], 2),object@s.misc$lgrid[[2L]][, 2]), y1 = c(rev(object@s.misc$lgrid[[2L]][, 2]), rep(rev(object@s.misc$lgrid[[3L]][, 2]), 2)), lwd = object@adeg.par$pgrid$lwd, col = object@adeg.par$pgrid$col, lty = object@adeg.par$pgrid$lty) ## draw axes axis.text <- modifyList(as.list(object@trellis.par$axis.text), trellis.par.get()$axis.text, keep.null = TRUE) axis.text2 <- list() axis.text2[c("cex", "col")] <- object@adeg.par$pgrid$text[c("cex", "col")] # never used: division <- object@s.misc$lgrid$posgrid[-c(1, length(object@s.misc$lgrid$posgrid))] pos <- c(1, 3, 3) srt <- c(0, 60, -60) ## get axes names if(object@data$storeData) axisN <- colnames(object@data$dfxyz)[c(2, 1, 3)] else axisN <- colnames(eval(object@data$dfxyz, envir = sys.frame(object@data$frame)))[c(2, 1, 3)] lab <- apply(object@s.misc$lgrid$posgrid, 2, as.character) labels <- lab[-c(1, nrow(lab)), ] ## without corner ## final limits for axes lcorners <- lab[c(1, nrow(lab)), ] ## corner lab (limits) orderCplot <- dfcorner[c(3, 1, 1, 2, 2, 3), ] ## ordre dessin label, selon row de dfcorner, a reprendre posCplot <- rep(c(2, 1, 4), each = 2) order_lab <- c(2, 1, 3) for(i in 1:3) { ## for the three axis ## ticks if(object@adeg.par$paxes$draw) do.call("panel.text", c(list(labels = labels[, order_lab[i]], x = object@s.misc$lgrid[[i]][, 1], y = object@s.misc$lgrid[[i]][, 2], pos = pos[i], srt = srt[i]), axis.text2)) ptlab <- object@s.misc$lgrid[[i]][1, ] + (object@s.misc$lgrid[[i]][nn[i], ] - object@s.misc$lgrid[[i]][1, ]) / 2 ## axis names if(axis.text$cex != 0) do.call("panel.text", args = c(list(labels = axisN[i], x = ptlab[1], y = ptlab[2], srt = srt[i], pos = pos[i]), axis.text)) } do.call("panel.text", c(list(x = orderCplot[, 1], y = orderCplot[, 2], lab = lcorners, pos = posCplot), axis.text2)) }) setMethod( f = "gettrellis", signature = "ADEg.Tr", definition = function(object) { tmp_trellis <- do.call(what = object@lattice.call$graphictype, args = c(formula(1 ~ 1), object@lattice.call$arguments, environment())) return(tmp_trellis) }) setMethod( f = "setlatticecall", signature = "ADEg.Tr", definition = function(object) { name_obj <- deparse(substitute(object)) ## background and box ## object@trellis.par$panel.background$col <- object@adeg.par$pbackground$col if(!object@adeg.par$pbackground$box) object@trellis.par$axis.line$col <- "transparent" else object@trellis.par$axis.line$col <- "black" arguments = list( par.settings = object@trellis.par, scales = if(!is.null(object@g.args$scales)) object@g.args$scales else list(draw = FALSE), key = createkey(object), aspect = object@adeg.par$paxes$aspectratio, panel = function(...) { panelbase(object, ...) panel(object, ...) }) object@lattice.call$arguments <- arguments object@lattice.call$graphictype <- "xyplot" ## get lattice arguments (set unspecified to NULL) argnames <- c("main", "sub", "xlab", "ylab") largs <- object@g.args[argnames] names(largs) <- argnames ## add xlim and ylim if not NULL if("xlim" %in% names(object@g.args)) largs["xlim"] <- object@g.args["xlim"] if("ylim" %in% names(object@g.args)) largs["ylim"] <- object@g.args["ylim"] object@lattice.call$arguments <- c(object@lattice.call$arguments, largs, list(strip = FALSE)) assign(name_obj, object, envir = parent.frame()) }) adegraphics/R/addpoint.R0000644000176200001440000000571713742303021014657 0ustar liggesuserssetMethod( f = "addpoint", signature = "ADEg", definition = function(object, xcoord, ycoord, plot = TRUE, ...) { # iterate coordinates if necessary size <- max(length(xcoord), length(ycoord)) xcoord <- rep_len(xcoord, length.out = size) ycoord <- rep_len(ycoord, length.out = size) # collect limits xlim <- object@g.args$xlim ylim <- object@g.args$ylim aspect <- object@adeg.par$paxes$aspectratio ## sorting parameters sortparameters <- sortparamADEg(...)$adepar params <- adegpar() sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) params <- sortparameters$ppoints # create the lattice object pointadded <- xyplot(ycoord ~ xcoord, xlim = xlim, ylim = ylim, xlab = NULL, ylab = NULL, aspect = aspect, panel = function(x, y, ...) panel.points(xcoord, ycoord, alpha = params$alpha, cex = params$cex, col = params$col, pch = params$pch, fill = params$fill), plot = FALSE) pointadded$call <- call("xyplot", ycoord ~ xcoord, xlim = substitute(xlim), ylim = substitute(ylim), xlab = NULL, ylab = NULL, aspect = substitute(aspect), alpha = params$alpha, cex = params$cex, col = params$col, pch = params$pch, fill = params$fill, panel = function(x, y, ...) panel.abline(x, y)) # superposition obj <- superpose(object, pointadded, plot = FALSE) nn <- all.names(substitute(object)) names(obj) <- c(ifelse(is.na(nn[2]), nn[1], nn[2]), "pointadded") if(plot) print(obj) invisible(obj) }) setMethod( f = "addpoint", signature = "ADEgS", definition = function(object, xcoord, ycoord, plot = TRUE, which = 1:length(object), ...) { ngraph <- length(object) if(max(which) > ngraph) stop("Values in 'which' should be lower than the length of object") if(length(which) == 1) { size <- max(length(xcoord), length(ycoord)) xcoord <- rep_len(xcoord, length.out = size) ycoord <- rep_len(ycoord, length.out = size) object[[which]] <- addpoint(object[[which]], xcoord, ycoord, ..., plot = FALSE) } else { if(sum(object@add) != 0) stop("The 'addpoint' function is not available for superposed objects.", call. = FALSE) ## sorting parameters sortparameters <- sortparamADEg(...)$adepar params <- adegpar() sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) params <- sortparameters$ppoints params <- rapply(params, function(X) rep(X, length.out = length(which)), how = "list") xcoord <- rep_len(xcoord, length.out = length(which)) ycoord <- rep_len(ycoord, length.out = length(which)) for (i in which) object[[i]] <- addpoint(object[[i]], xcoord[i], ycoord[i], which = 1, plot = FALSE, ppoints = lapply(params, function(X) X[i])) } obj <- object if(plot) print(obj) invisible(obj) })adegraphics/R/S1.match.R0000644000176200001440000001637713742303021014437 0ustar liggesusers########################################################### ## s1d.match ## ########################################################### setClass( Class = "S1.match", contains = "ADEg.S1" ) setMethod( f = "initialize", signature = "S1.match", definition = function(.Object, data = list(score = NULL, labels = NULL, at = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.S1 initialize .Object@data$labels <- data$labels return(.Object) }) setMethod( f = "prepare", signature = "S1.match", definition = function(object) { name_obj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) ## change default for some parameters if(adegtot$p1d$horizontal & is.null(object@adeg.par$plabels$srt)) adegtot$plabels$srt <- 90 else if(!adegtot$p1d$horizontal & is.null(object@adeg.par$plabels$srt)) adegtot$plabels$srt <- 0 adegtot$p1d$rug$tck <- 0 if(adegtot$p1d$horizontal & is.null(object@g.args$ylim)) object@g.args$ylim <- c(0, 1) if(!adegtot$p1d$horizontal & is.null(object@g.args$xlim)) object@g.args$xlim <- c(0, 1) ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph assign(name_obj, object, envir = parent.frame()) }) setMethod( f= "panel", signature = "S1.match", definition = function(object, x, y) { if(object@data$storeData) { labels <- object@data$labels at <- object@data$at } else { labels <- eval(object@data$labels, envir = sys.frame(object@data$frame)) at <- eval(object@data$at, envir = sys.frame(object@data$frame)) } lims <- current.panel.limits(unit = "native") nval <- length(y) %/% 2 score2 <- y[(nval + 1):length(y)] score1 <- y[1 : nval] pscore <- object@adeg.par$p1d plabels <- object@adeg.par$plabels plboxes <- plabels$boxes porigin <- object@adeg.par$porigin if(!is.null(labels)) { ## get text sizes for boxes test <- .textsize(labels, plabels) w <- test$w h <- test$h } lead <- ifelse(pscore$reverse, -1, 1) if(pscore$horizontal) { ## horizontal plot ## get positions for labels spacelab <- diff(lims$xlim) / (nval + 1) xlab <- seq(from = lims$xlim[1] + spacelab, by = spacelab, length.out = nval)[rank(score1, ties.method = "first")] ylab <- rep(at, length.out = nval) ypoints <- rep(object@s.misc$rug, length.out = nval) ypoints2 <- rep(ypoints + lead * 0.05 * abs(diff(object@g.args$ylim)), length.out = nval) ## horizontal line if(pscore$rug$draw & pscore$rug$line) panel.abline(h = ypoints2, col = porigin$col, lwd = porigin$lwd, lty = porigin$lty, alpha = porigin$alpha) ## segments linking both scores do.call("panel.segments", c(list(x0 = score1, y0 = ypoints, x1 = score2, y1 = ypoints2), object@adeg.par$plines)) ## segments linking labels to second score do.call("panel.segments", c(list(x0 = score2, y0 = ypoints2, x1 = xlab, y1 = ylab), object@adeg.par$plines)) ## drawing labels if(!is.null(labels) & any(plabels$cex > 0)) adeg.panel.label(x = xlab , y = ylab + lead * h / 2, labels = labels, plabels = plabels) ## draw points if(any(object@adeg.par$ppoints$cex > 0)) panel.points(x = c(score1, score2), y = c(ypoints, ypoints2), pch = object@adeg.par$ppoints$pch, cex = object@adeg.par$ppoints$cex, col = object@adeg.par$ppoints$col, alpha = object@adeg.par$ppoints$alpha, fill = object@adeg.par$ppoints$fill) } else { ## vertical plot ## get positions for labels spacelab <- diff(lims$ylim) / (nval + 1) ylab <- seq(from = lims$ylim[1] + spacelab, by = spacelab, length.out = nval)[rank(score1, ties.method = "first")] xlab <- rep(at, length.out = nval) xpoints <- rep(object@s.misc$rug, length.out = nval) xpoints2 <- rep(xpoints + lead * 0.05 * abs(diff(object@g.args$xlim)), length.out = nval) ## vertical line if(pscore$rug$draw & pscore$rug$line) panel.abline(v = xpoints2, col = porigin$col, lwd = porigin$lwd, lty = porigin$lty, alpha = porigin$alpha) ## segments linking both scores do.call("panel.segments", c(list(x0 = xpoints, y0 = score1, x1 = xpoints2, y1 = score2), object@adeg.par$plines)) ## segments linking labels to second score do.call("panel.segments", c(list(x0 = xpoints2, y0 = score2, x1 = xlab, y1 = ylab), object@adeg.par$plines)) ## drawing labels if(!is.null(labels) & any(plabels$cex > 0)) adeg.panel.label(x = xlab + lead * w / 2 , y = ylab, labels = labels, plabels = plabels) ## draw points if(any(object@adeg.par$ppoints$cex > 0)) panel.points(x = c(xpoints, xpoints2), y = c(score1, score2), pch = object@adeg.par$ppoints$pch, cex = object@adeg.par$ppoints$cex, col = object@adeg.par$ppoints$col, alpha = object@adeg.par$ppoints$alpha, fill = object@adeg.par$ppoints$fill) } }) s1d.match <- function(score1, score2, labels = 1:NROW(score1), at = 0.5, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters thecall <- .expand.call(match.call()) score1 <- eval(thecall$score1, envir = sys.frame(sys.nframe() + pos)) score2 <- eval(thecall$score2, envir = sys.frame(sys.nframe() + pos)) if(NROW(score1) != NROW(score2)) stop("score1 and score2 should have the same length") if(NCOL(score1) != NCOL(score2)) stop("score1 and score2 should have the same number of columns") if((is.data.frame(score1) & NCOL(score1) == 1) | (is.data.frame(score2) & NCOL(score2) == 1)) stop("Not yet implemented for data.frame with only one column, please convert into vector") ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if(NCOL(score1) == 1) object <- multi.facets.S1(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple scores") } ## multiple scores else if(NCOL(score1) > 1) { object <- multi.score.S1(thecall) } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object if(storeData) tmp_data <- list(score = c(score1, score2), labels = labels, at = at, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(score = call("c", thecall$score1, thecall$score2), labels = thecall$labels, at = thecall$at, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "S1.match", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = sortparameters$g.args, Call = match.call()) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/T.cont.R0000644000176200001440000000431513742303021014213 0ustar liggesuserssetClass( Class = "T.cont", contains = "T.value" ) setMethod( f = "panel", signature = "T.cont", definition = function(object, x, y) { ## call panel for T.value object callNextMethod(object, x, y) if(object@data$storeData) { dftab <- object@data$dftab coordsx <- object@data$coordsx coordsy <- object@data$coordsy } else { dftab <- eval(object@data$dftab, envir = sys.frame(object@data$frame)) coordsx <- eval(object@data$coordsx, envir = sys.frame(object@data$frame)) coordsy <- eval(object@data$coordsy, envir = sys.frame(object@data$frame)) } dftab <- dftab / sum(dftab) f1 <- function(x, w) { w1 <- weighted.mean(w, x) w <- (w - w1)^2 w2 <- sqrt(weighted.mean(w, x)) return(c(w1, w2)) } if(object@g.args$meanX) { w <- t(apply(dftab, 2, f1, w = coordsy)) panel.points(x = coordsx, y = w[, 1], pch = 20, cex = 1.5, col = "black") panel.segments(coordsx, w[, 1] - w[, 2] , coordsx, w[, 1] + w[, 2], col = object@adeg.par$plines$col, lty = object@adeg.par$plines$lty, lwd = object@adeg.par$plines$lwd) } if(object@g.args$meanY) { w <- t(apply(dftab, 1, f1, w = coordsx)) panel.points(x = w[, 1], coordsy, pch = 20, cex = 1.5, col = "black") panel.segments(w[, 1] - w[, 2], coordsy, w[, 1] + w[, 2], coordsy, col = object@adeg.par$plines$col, lty = object@adeg.par$plines$lty, lwd = object@adeg.par$plines$lwd) } coordsx <- coordsx[col(as.matrix(dftab))] coordsy <- coordsy[row(as.matrix(dftab))] if(object@g.args$ablineX) panel.abline(reg = lm(coordsy ~ coordsx, weights = as.vector(as.matrix(dftab))), col = object@adeg.par$plines$col, lty = object@adeg.par$plines$lty, lwd = object@adeg.par$plines$lwd) if(object@g.args$ablineY) { w <- coefficients(lm(coordsx ~ coordsy, weights = as.vector(as.matrix(dftab)))) if(w[2] == 0) panel.abline(h = w[1], col = object@adeg.par$plines$col, lty = object@adeg.par$plines$lty, lwd = object@adeg.par$plines$lwd) else panel.abline(c(-w[1] / w[2], 1 / w[2]), col = object@adeg.par$plines$col, lty = object@adeg.par$plines$lty, lwd = object@adeg.par$plines$lwd) } }) adegraphics/R/genericMethod.R0000644000176200001440000000503713742303021015625 0ustar liggesusers################################################### ## definition of generic methods ### ################################################### setGeneric("getparameters", function(object, number) {standardGeneric("getparameters")}) setGeneric("getlatticecall", function(object, number) {standardGeneric("getlatticecall")}) setGeneric("gettrellis", function(object) {standardGeneric("gettrellis")}) setGeneric("getcall", function(object) {standardGeneric("getcall")}) setGeneric("getgraphics", function(object) {standardGeneric("getgraphics")}) setGeneric("add.ADEg", function(object) {standardGeneric("add.ADEg")}) setGeneric("panel", function(object, x, y, ...) {standardGeneric("panel")}) setGeneric("panelbase", function(object, x, y) {"panelbase"}) setGeneric("zoom", function(object, zoom, center) {standardGeneric("zoom")}) setGeneric("prepare", function(object) {standardGeneric("prepare")}) setGeneric("setlatticecall", function(object) {standardGeneric("setlatticecall")}) setGeneric("addhist", function(object, bandwidth, gridsize = 60, kernel = "normal", cbreaks = 2, storeData = TRUE, plot = TRUE, pos = -1, ...) {standardGeneric("addhist")}) setGeneric("addline", function(object, a = NULL, b = 0, h = NULL, v = NULL, plot = TRUE, ...) {standardGeneric("addline")}) setGeneric("addpoint", function(object, xcoord, ycoord, plot = TRUE, ...) {standardGeneric("addpoint")}) setGeneric("addsegment", function(object, x0 = NULL, y0 = NULL, x1, y1, plot = TRUE, ...) {standardGeneric("addsegment")}) setGeneric("addtext", function(object, xcoord, ycoord, label, plot = TRUE, ...) {standardGeneric("addtext")}) setGeneric("createkey", function(object) {standardGeneric("createkey")}) setGeneric("addkey", function(object) {standardGeneric("addkey")}) setGeneric("createcolorkey", function(object) {standardGeneric("createcolorkey")}) setGeneric("getpositions", function(object) {standardGeneric("getpositions")}) setGeneric("getstats", function(object) {standardGeneric("getstats")}) setGeneric("superpose", function(g1, g2, which, plot = FALSE) {standardGeneric("superpose")}) setGeneric("printSuperpose", function(g1, refg, position) {standardGeneric("printSuperpose")}) setGeneric("insert", function(graphics, oldgraphics, posi = c("bottomleft", "bottomright", "topleft", "topright"), ratio = 0.2, inset = 0.0, plot = TRUE, which, dispatch = FALSE) {standardGeneric("insert")}) setGeneric("cbindADEg", function(g1, g2, ..., plot = FALSE) {standardGeneric("cbindADEg")}) setGeneric("rbindADEg", function(g1, g2, ..., plot = FALSE) {standardGeneric("rbindADEg")}) adegraphics/R/panelfunctions.R0000644000176200001440000002707213742303021016103 0ustar liggesusers## Labels drawing ## TODO: labels' rotations. ## first, in no boxes, it is easy ## if boxes, at least do 90 degrees rotations ## finally, more than one rotation possible. adeg.panel.label <- function(x, y, labels, plabels, pos = NULL) { if(any(plabels$cex > 0)) { n <- length(x) plboxes <- plabels$boxes draw <- plabels$cex > 0 ## using .textsize funtion in utils.R textS <- .textsize(labels, plabels) srt <- textS$srt if(any(plboxes$draw) && !(srt %in% c(0, 90))) warning("Boxes only implemented for 0 or 90 degrees rotation", call. = FALSE) ldraw <- rep(draw, length.out = n) ## draw long enough ldraw[which(is.na(labels[1:n]) | labels[1:n] == "")] <- FALSE ## if no labels or null string don't bother width <- rep(textS$w, length.out = n)[ldraw] height <- rep(textS$h, lenght.out = n)[ldraw] lab <- rep(labels, length.out = n)[ldraw] ## no NA, removed using ldraw bdraw <- rep(plboxes$draw, length.out = length(ldraw)) ## no boxes if no labels bdraw <- (bdraw & ldraw) ## labels a dessiner optim <- plabels$optim[1] ## only one possibility newpos <- list(x = x[ldraw], y = y[ldraw]) if(optim) { ## calcul des nouvelles positions uniquement pour les labels qui seront dessines ## informations sur panel nativelim <- current.panel.limits(unit = "native") incheslim <- current.panel.limits(unit = "inches") ## calcul des nouvelles positions. if(any(is.na(width)) | any(is.na(height)) | any(is.na(newpos$y)) | any(is.na(newpos$x))) stop("NA restants revoir adeg.panel.label") newpos <- .pointLabel(x = newpos$x, y = newpos$y, labels = lab, width = width / diff(nativelim$xlim), height = height / diff(nativelim$ylim), limits = nativelim, xyAspect = diff(incheslim$xlim) / diff(incheslim$ylim), trace = FALSE) pos <- NULL } if(any(bdraw)) { ## dessins de chaque boite avec son label plboxes <- lapply(plboxes, FUN = function(x) {rep(x, length.out = length(ldraw))}) srt <- rep(srt, length.out = length(ldraw)) plabels <- lapply(plabels, FUN = function(x) {rep(x, length.out = n)[ldraw]}) for(i in 1:length(newpos$x)) { if(bdraw[ldraw][i]) { ## labels sizes panel.rect( x = unit(newpos$x[i], "native"), y = unit(newpos$y[i], "native"), width = width[i], height = height[i], col = plboxes$col[ldraw][i], alpha = plboxes$alpha[ldraw][i], border = plboxes$border[ldraw][i], lty = plboxes$lty[ldraw][i], lwd = plboxes$lwd[ldraw][i] ) } panel.text(labels = lab[i], x = unit(newpos$x[i], "native"), y = unit(newpos$y[i], "native"), col = plabels$col[i], cex = plabels$cex[i], alpha = plabels$alpha[i], srt = srt[i]) } } else { ## only text if(any(!ldraw)) ## obliger de repeter pour dessiner si un label doit etre ignorer panel.text(labels = lab, x = unit(newpos$x, "native"), y = unit(newpos$y, "native"), col = rep(plabels$col, length.out = length(ldraw))[ldraw], cex = rep(plabels$cex, length.out = length(ldraw))[ldraw], alpha = rep(plabels$alpha, length.out = length(ldraw))[ldraw], rep(srt, length.out = length(ldraw))[ldraw], pos = pos) else panel.text(labels = lab, x = unit(newpos$x, "native"), y = unit(newpos$y, "native"), col = plabels$col, cex = plabels$cex, alpha = plabels$alpha, srt = srt, pos = pos) } } } adeg.panel.nb <- function(nbobject, coords, col.edge = "black", lwd = 1, lty = 1, pch = 20, cex = 1, col.node = "black", alpha = 1) { if(inherits(nbobject, "listw")) nbobject <- nbobject$neighbours if(!inherits(nbobject, "nb")) stop("nb object is not class nb") ## prevoir dans les fonctions user une selection de l element neighbourght si object de type listw if(length(nbobject) != nrow(coords)) stop("error for nb object, not the same numbers of nodes and coordinates", call. = FALSE) edges <- cbind(rep(1:length(nbobject), lapply(nbobject, length)), unlist(nbobject)) edges <- edges[edges[,2] != 0, ] ## ici faire rep des parametres pour pouvoir ensuite modifier couleur adeg.panel.edges(edges, coords, col.edge, lwd, lty, pch, cex, col.node, alpha) } ## adeg.panel.edges.... ## col, lwd, lty etc peuvent varier selon poids des connexions adeg.panel.edges <- function(edges, coords, col.edge = "black", lwd = 1, lty = 1, pch = 20, cex = 1, col.node = "black", alpha = 1) { panel.segments(x0 = coords[edges[, 1], 1], y0 = coords[edges[, 1], 2], x1 = coords[edges[, 2], 1], y1 = coords[edges[, 2], 2], col = col.edge, lwd = lwd, lty = lty) panel.points(x = coords[, 1], y = coords[, 2], col = col.node, pch = pch, alpha = alpha, cex = cex) } ################## Panel.spatial ############################# ## spObject can be : ## SpatialGridDataFrame","SpatialLinesDataFrame","SpatialPixelsDataFrame","SpatialPointsDataFrame","SpatialPolygonsDataFrame" ## n : nombre intervales si data ## TODO: spObject pourrait etre une liste adeg.panel.Spatial <- function(SpObject, sp.layout = NULL, col = 1, border = 1, lwd = 1, lty = 1, alpha = 0.8, cex = 1, pch = 20, n = length(col), spIndex = 1, ...) { if(length(grep("DataFrame", class(SpObject))) > 0) { ## there is data in 'SpObject' (it is a SpatialPolygonsDataFrame). mapSp <- try(SpObject[names(SpObject)[spIndex]], silent = TRUE) ## only the first map (spIndex = 1) values <- try(mapSp@data[, 1], silent = TRUE) if(is.factor(values)) { ## qualitative values if(length(col) != nlevels(values)) { if(length(col) == 1) ## all values have the same color col <- rep(col, length.out = nlevels(values)) else col <- adegpar()$ppalette$quali(nlevels(values)) colvalue <- col[values] } else colvalue <- col } else { ## quantitative values breaks <- pretty(values, length(col)) if((length(breaks) - 1) != length(col)) { if(length(col) == 1) ## 'col' is not modified by the user col <- adegpar()$ppalette$quanti(length(breaks) - 1) else ## 'col' is modified but there is not enough color values col <- colorRampPalette(col)(length(breaks) - 1) } colvalue <- col[cut(values, breaks, include.lowest = TRUE)] } } else { ## there is no data in 'SpObject' mapSp <- SpObject colvalue <- col } if(!is.null(sp.layout)) sppanel(sp.layout) if(inherits(SpObject, what = "SpatialPoints")) { ## insert ppoints.parameters for pch and cex sp.points(mapSp, col = colvalue, pch = pch, cex = cex, alpha = alpha) } if(inherits(SpObject, what = "SpatialPolygons")) sp.polygons(mapSp, col = border, fill = colvalue, alpha = alpha, lty = lty, lwd = lwd) ## For spatialLine problems ; no various colors if(inherits(SpObject, what = "SpatialLines")) sp.lines(mapSp, col = colvalue, alpha = alpha, lty = lty, lwd = lwd) if(inherits(SpObject, what = "SpatialGrid")) sp.grid(mapSp, at = breaks, col = col) } adeg.panel.values <- function(x, y, z, method, symbol, ppoints, breaks, centerpar = NULL, center = 0) { if((length(x) != length(y)) | (length(y) != length(z))) stop("error in panel.values, not equal length for x, y, and z") maxsize <- max(abs(breaks)) ## biggest value z <- z - center if(!missing(center) & !is.null(centerpar)) { xnull <- x[abs(z) < sqrt(.Machine$double.eps)] ynull <- y[abs(z) < sqrt(.Machine$double.eps)] } if(method == "size"){ size <- .proportional_map(z, maxsize) * ppoints$cex[1] colfill <- ifelse(z < 0, ppoints$col[1], ppoints$col[2]) colborder <- ifelse(z < 0, ppoints$col[2], ppoints$col[1]) } else if(method == "color"){ size <- ppoints$cex[1] breaks <- sort(breaks) colfill <- ppoints$fill[as.numeric(cut(z, breaks, include.lowest = TRUE))] if(any(is.null(colfill)) | any(is.na(colfill))) stop("error in the definition of color symbol", call. = FALSE) colborder <- ppoints$col } cstnormal <- 5 ## same value in createkey panel.points(x = x, y = y, cex = size * cstnormal, pch = .symbol2pch(symbol), fill = colfill, col = colborder, alpha = ppoints$alpha) if(!missing(center) && !is.null(centerpar)) panel.points(x = xnull, y = ynull, pch = centerpar$pch, col = centerpar$col, cex = centerpar$cex) return(cstnormal) } adeg.panel.hist <- function(histValues, horizontal = TRUE, densi, drawLines, params = list(), identifier = "histogramADEg") { ## from panel.histogram of the lattice package plot.polygon <- modifyList(list(plot.polygon = trellis.par.get("plot.polygon")), params, keep.null = TRUE)[[1L]] ## hist params add.line <- modifyList(list(add.line = trellis.par.get("add.line")), params, keep.null = TRUE)[[1L]] ## backgroundlines plot.line <- modifyList(list(plot.line = trellis.par.get("plot.line")), params, keep.null = TRUE)[[1L]] ## density line h <- histValues breaks <- h$breaks heiBar <- h$counts nb <- length(breaks) ## counts lines if(horizontal) do.call("panel.abline", c(list(h = drawLines), add.line)) else do.call("panel.abline", c(list(v = drawLines), add.line)) ## warning : density lines re-scale to check contdensi <- (h$counts[h$density != 0 & h$counts != 0] / h$density[h$density != 0 & h$counts != 0])[1] if(horizontal) { if(nb > 1) { panel.rect(x = h$mids, y = 0, height = heiBar, width = diff(breaks), col = plot.polygon$col, alpha = plot.polygon$alpha, border = plot.polygon$border, lty = plot.polygon$lty, lwd = plot.polygon$lwd, just = c("center", "bottom"), identifier = identifier) } do.call("panel.lines", c(list(x = densi$x, y = densi$y * contdensi), plot.line)) } else { if(nb > 1) panel.rect(y = h$mids, x = 0, height = diff(breaks), width = heiBar, col = plot.polygon$col, alpha = plot.polygon$alpha, border = plot.polygon$border, lty = plot.polygon$lty, lwd = plot.polygon$lwd, just = c("left", "center"), identifier = identifier) do.call("panel.lines", c(list(y = densi$x, x = densi$y * contdensi), plot.line)) } } adeg.panel.join <- function(drawLines, params = list()) { ## circle from c(0,0)p, radius = drawLines plot.line <- modifyList(list(add.line = trellis.par.get("add.line")), params, keep.null = TRUE)[[1L]] ## density line ## number of seg = 200 plabels <- modifyList(adegpar("plabels"), params, keep.null = TRUE)[[1L]] scaleX <- c(current.panel.limits()$xlim, current.panel.limits()$ylim) xlines <- seq(from = min(scaleX) - 0.1 * min(scaleX), to = max(scaleX) * 1.1, length.out = 200) ylines <- lapply(drawLines, FUN = function(radius, x) { indx <- (x <= radius) ## x can be greated than radius return(c(sqrt(radius * radius - x[indx] * x[indx]), (- sqrt(abs(radius * radius - x[!indx] * x[!indx]))))) }, x = xlines) trash <- lapply(ylines, FUN = function(y, x) {do.call("panel.lines", c(list(x = x[1:length(y)], y = y[1:length(y)]), plot.line))}, x = xlines) adeg.panel.label(x = sqrt(0.5) * drawLines, y = sqrt(0.5) * drawLines, as.character(drawLines), plabels) } ## from http://rwiki.sciviews.org/doku.php?id=tips:graphics-grid:displaybitmap ## used in s.logo (rasterGrob) to handle pixmap objects as.raster.pixmapRGB <- function(x, ...) { nr <- nrow(x@red) r <- rgb((x@red), (x@green), (x@blue)) dim(r) <- x@size r } as.raster.pixmapGrey <- function(x, ...) { nr <- nrow(x@grey) r <- x@grey dim(r) <- x@size r } adegraphics/R/S1.label.R0000644000176200001440000001247213742303021014412 0ustar liggesusers########################################################### ## s1d.label ## ########################################################### setClass( Class = "S1.label", contains = "ADEg.S1" ) setMethod( f = "initialize", signature = "S1.label", definition = function(.Object, data = list(score = NULL, labels = NULL, at = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.C1 initialize .Object@data$labels <- data$labels return(.Object) }) setMethod( f = "prepare", signature = "S1.label", definition = function(object) { name_obj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) ## change default for some parameters if(adegtot$p1d$horizontal & is.null(object@adeg.par$plabels$srt)) adegtot$plabels$srt <- 90 else if(!adegtot$p1d$horizontal & is.null(object@adeg.par$plabels$srt)) adegtot$plabels$srt <- 0 if(adegtot$p1d$horizontal & is.null(object@g.args$ylim)) object@g.args$ylim <- c(0, 1) if(!adegtot$p1d$horizontal & is.null(object@g.args$xlim)) object@g.args$xlim <- c(0, 1) ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "S1.label", definition = function(object, x, y) { if(object@data$storeData) { labels <- object@data$labels at <- object@data$at } else { labels <- eval(object@data$labels, envir = sys.frame(object@data$frame)) at <- eval(object@data$at, envir = sys.frame(object@data$frame)) } lims <- current.panel.limits(unit = "native") pscore <- object@adeg.par$p1d plabels <- object@adeg.par$plabels plboxes <- plabels$boxes nval <- length(y) if(!is.null(labels)) { ## get text sizes for boxes test <- .textsize(labels, plabels) w <- test$w h <- test$h } lead <- ifelse(pscore$reverse, -1, 1) if(pscore$horizontal) { ## horizontal plot xpoints <- y ## draw labels if(object@g.args$poslabel == "regular") { spacelab <- diff(lims$xlim) / (nval + 1) xlab <- seq(from = lims$xlim[1] + spacelab, by = spacelab, length.out = nval)[rank(xpoints, ties.method = "first")] } else xlab <- xpoints if(!is.null(labels) & any(plabels$cex > 0)) adeg.panel.label(x = xlab , y = at + lead * h / 2, labels = labels, plabels = plabels) ## draw segments ypoints <- object@s.misc$rug do.call("panel.segments", c(list(x0 = xpoints, y0 = ypoints, x1 = xlab, y1 = at), object@adeg.par$plines)) } else { ## vertical plot ypoints <- y ## draw labels if(object@g.args$poslabel == "regular") { spacelab <- diff(lims$ylim) / (nval + 1) ylab <- seq(from = lims$ylim[1] + spacelab, by = spacelab, length.out = nval)[rank(ypoints, ties.method = "first")] } else ylab <- ypoints if(!is.null(labels) & any(plabels$cex > 0)) adeg.panel.label(x = at + lead * w / 2 , y = ylab, labels = labels, plabels = plabels) ## draw segments xpoints <- object@s.misc$rug do.call("panel.segments", c(list(x0 = xpoints, y0 = ypoints, x1 = at, y1 = ylab), object@adeg.par$plines)) } if(any(object@adeg.par$ppoints$cex > 0)) do.call("panel.points", c(list(x = xpoints, y = ypoints), object@adeg.par$ppoints)) }) s1d.label <- function(score, labels = 1:NROW(score), at = 0.5, poslabel = c("regular", "value"), facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters thecall <- .expand.call(match.call()) score <- eval(thecall$score, envir = sys.frame(sys.nframe() + pos)) ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if(NCOL(score) == 1) object <- multi.facets.S1(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple scores") } ## multiple scores else if(NCOL(score) > 1) { object <- multi.score.S1(thecall) } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(poslabel = match.arg(poslabel))) if(storeData) tmp_data <- list(score = score, labels = labels, at = at, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(score = thecall$score, labels = thecall$labels, at = thecall$at, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "S1.label", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = match.call()) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/ade4-score.R0000644000176200001440000006522013750030134014777 0ustar liggesusers"score.acm" <- function (x, xax = 1, which.var = NULL, type = c("points", "boxplot"), pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "acm")) stop("Object of class 'acm' expected") if(x$nf == 1) xax <- 1 if((xax < 1) || (xax > x$nf)) stop("non convenient axe number") ## prepare oritab <- as.list(x$call)[[2]] evTab <- eval.parent(oritab) if(is.null(which.var)) which.var <- 1:ncol(evTab) type <- match.arg(type) ## parameter management sortparameters <- sortparamADEg(...) params <- list() if(type == "boxplot") { ## parameter management params$adepar <- list(plabels = list(boxes = list(draw = FALSE)), p1d = list(rug = list(draw = TRUE)), paxes = list(draw = TRUE, y = list(draw = FALSE)), plegend = list(drawKey = FALSE), pgrid = list(text = list(cex = 0)), psub = list(position = "topleft")) params$g.args <- list(samelimits = FALSE) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## ADEgS creation ADEglist <- list() score <- x$l1[, xax] scorecall <- substitute(x$l1[, xax]) for(i in which.var) { ## data management fac <- evTab[, i] faccall <- call("[", oritab, 1:NROW(evTab), i) ADEglist[[i]] <- do.call("s1d.boxplot", c(list(score = scorecall, fac = faccall, plot = FALSE, storeData = storeData, pos = pos - 2), c(sortparameters$adepar, list(psub.text = paste0(colnames(evTab)[i], " (cr=", round(x$cr[i, xax], 2), ")"))), sortparameters$trellis, sortparameters$g.args, sortparameters$rest)) } ADEglist <- ADEglist[which.var] ## ADEgS creation posmatrix <- layout2position(.n2mfrow(length(which.var)), ng = length(which.var)) object <- new(Class = "ADEgS", ADEglist = ADEglist, positions = posmatrix, add = matrix(0, ncol = length(which.var), nrow = length(which.var)), Call = match.call()) } else if(type == "points") { ## parameter management params$adepar <- list(ppoints = list(pch = "|"), porigin = list(draw = FALSE), pgrid = list(draw = FALSE), psub = list(position = "topleft"), paxes = list(draw = TRUE), plabels = list(cex = 1.25)) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg ADEglist <- list() score <- x$l1[, xax] scorecall <- substitute(x$l1[, xax]) for(i in which.var) { ## data management fac <- evTab[, i] faccall <- call("[", oritab, 1:NROW(evTab), i) meangroup <- call("as.numeric", call("tapply", scorecall, faccall, mean)) dfxy <- call("cbind", scorecall, call("as.numeric", call("[", meangroup, faccall))) ## ADEg creation g1 <- do.call("s.class", c(list(dfxy = dfxy, fac = faccall, ellipseSize = 0, plot = FALSE, storeData = storeData, pos = pos - 2), c(sortparameters$adepar, list(psub.text = paste0(colnames(evTab)[i], " (cr=", round(x$cr[i, xax], 2), ")"))), sortparameters$trellis, sortparameters$g.args, sortparameters$rest)) xlimg1 <- g1@g.args$xlim ylimg1 <- g1@g.args$ylim g2 <- xyplot(score ~ fac, xlab = "", ylab = "", scales = list(x = list(tck = c(1, 0)), y = list(tck = c(1, 0))), xlim = xlimg1, ylim = ylimg1, aspect = g1@adeg.par$paxes$aspectratio, panel = function(x, y) {panel.abline(h = as.numeric(tapply(y, x, mean)), a = 0, b = 1, lty = 1)}) g2$call <- call("xyplot", substitute(scorecall ~ faccall), xlab = "", ylab = "", scales = list(x = list(tck = c(1, 0)), y = list(tck = c(1, 0))), xlim = substitute(xlimg1), ylim = substitute(ylimg1), aspect = g1@adeg.par$paxes$aspectratio, panel = function(x, y) {panel.abline(h = as.numeric(tapply(y, x, mean)), a = 0, b = 1, lty = 1)}) ADEglist[[i]] <- superpose(g2, g1, plot = FALSE) } ADEglist <- ADEglist[which.var] ## ADEgS creation posmatrix <- layout2position(.n2mfrow(length(which.var)), ng = length(which.var)) object <- new(Class = "ADEgS", ADEglist = ADEglist, positions = posmatrix, add = matrix(0, ncol = length(which.var), nrow = length(which.var)), Call = match.call()) } names(object) <- colnames(evTab)[which.var] object@Call <- match.call() if(plot) print(object) invisible(object) } "score.mix" <- function (x, xax = 1, which.var = NULL, type = c("points", "boxplot"), pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "mix")) stop("Object of class 'mix' expected") if(x$nf == 1) xax <- 1 if((xax < 1) || (xax > x$nf)) stop("non convenient axe number") ## internal function lm.pcaiv <- function(x, df, weights) { lm0 <- lm(as.formula(paste("reponse.generic ~ ", paste(names(df), collapse = "+"))), data = cbind.data.frame(x, df), weights = weights) return(predict(lm0)) } ## data management oritab <- as.list(x$call)[[2]] evTab <- eval.parent(oritab) if(is.null(which.var)) which.var <- 1:length(x$index) index <- as.character(x$index) score <- x$l1[, xax] scorecall <- substitute(x$l1[, xax]) ADEglist <- list() for (i in which.var) { ## parameters management sortparameters <- sortparamADEg(...) params <- list() ## data management type.var <- index[i] col.var <- which(x$assign == i) y <- x$tab[, col.var] ycall <- substitute(x$tab[, col.var]) ## type of variable : quantitative if(type.var == "q") { ## parameters management params$adepar <- list(psub = list(text = paste0(colnames(evTab)[i], " (r2=", round(x$cr[i, xax], 2), ")"), position = "topleft"), paxes = list(aspectratio = "fill", draw = TRUE), porigin = list(include = FALSE), pgrid = list(draw = FALSE), plabels = list(cex = 0)) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) if(length(col.var) == 1) { g1 <- do.call("s.label", c(list(dfxy = call("cbind", scorecall, ycall), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$adepar, sortparameters$trellis, sortparameters$g.args, sortparameters$rest)) g2 <- xyplot(y ~ score, panel = function(x, y) {panel.abline(lm(y ~ x), lty = 1)}) g2$call <- call("xyplot", substitute(ycall ~ scorecall), panel = function(x, y) {panel.abline(lm(y ~ x), lty = 1)}) ADEglist[[i]] <- superpose(g1, g2) } else { ## data management lm0 <- lm(as.formula(paste("reponse.generic ~ ", paste(names(y), collapse = "+"))), data = cbind.data.frame(reponse.generic = score, y), weights = rep(1, nrow(y))/nrow(y)) lm0call <- substitute(lm(as.formula(paste("reponse.generic ~ ", paste(names(ycall), collapse = "+"))), data = cbind.data.frame(reponse.generic = scorecall, ycall), weights = rep(1, nrow(ycall))/nrow(ycall))) score.est <- predict(lm0) score.estcall <- substitute(predict(lm0call)) ord0 <- order(y[, 1]) ord0call <- substitute(order(ycall[, 1])) y1call <- call("[", ycall, ord0call, 1) x1call <- call("[", score.estcall, ord0call) ## ADEgS creation g1 <- do.call("s.label", c(list(dfxy = call("cbind", scorecall, call("[", ycall, 1:NROW(y), 1)), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$adepar, sortparameters$trellis, sortparameters$g.args, sortparameters$rest)) g2 <- xyplot(y[ord0, 1] ~ score.est[ord0], panel = function(x, y) {panel.lines(x, y, lty = 1)}) g2$call <- call("xyplot", substitute(y1call ~ x1call), panel = function(x, y) {panel.lines(x, y, lty = 1)}) ADEglist[[i]] <- superpose(g1, g2) } } ## type of variable : factor else if(type.var == "f") { ## data management fac <- evTab[, i] faccall <- call("[", oritab, 1:NROW(evTab), i) meangroup <- call("as.numeric", call("tapply", scorecall, faccall, mean)) dfxy <- call("cbind", scorecall, call("as.numeric", call("[", meangroup, faccall))) type <- match.arg(type) params <- list() if(type == "boxplot") { ## parameter management params$adepar <- list(plabels = list(boxes = list(draw = FALSE)), p1d = list(rug = list(draw = TRUE)), paxes = list(draw = TRUE, y = list(draw = FALSE)), plegend = list(drawKey = FALSE), pgrid = list(text = list(cex = 0)), psub = list(text = paste0(colnames(evTab)[i], " (cr=", round(x$cr[i, xax], 2), ")"), position = "topleft")) params$g.args <- list(samelimits = FALSE) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## ADEgS creation ADEglist[[i]] <- do.call("s1d.boxplot", c(list(score = scorecall, fac = faccall, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$adepar, sortparameters$trellis, sortparameters$g.args, sortparameters$rest)) } else if(type == "points") { ## parameter management params$adepar <- list(ppoints = list(pch = "|"), porigin = list(draw = FALSE), paxes = list(aspectratio = "fill", draw = TRUE), pgrid = list(draw = FALSE), psub = list(text = paste0(colnames(evTab)[i], " (cr=", round(x$cr[i, xax], 2), ")"), position = "topleft")) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## ADEg creation g1 <- do.call("s.class", c(list(dfxy = dfxy, fac = faccall, ellipseSize = 0, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$adepar, sortparameters$trellis, sortparameters$g.args, sortparameters$rest)) xlimg1 <- g1@g.args$xlim ylimg1 <- g1@g.args$ylim g2 <- xyplot(score ~ fac, xlab = "", ylab = "", xlim = xlimg1, ylim = ylimg1, aspect = g1@adeg.par$paxes$aspectratio, panel = function(x, y) {panel.abline(h = as.numeric(tapply(y, x, mean)), a = 0, b = 1, lty = 1)}) g2$call <- call("xyplot", substitute(scorecall ~ faccall), xlab = "", ylab = "", xlim = substitute(xlimg1), ylim = substitute(ylimg1), aspect = g1@adeg.par$paxes$aspectratio, panel = function(x, y) {panel.abline(h = as.numeric(tapply(y, x, mean)), a = 0, b = 1, lty = 1)}) ADEglist[[i]] <- superpose(g2, g1, plot = FALSE) } } ## type of variable : ordered else if(type.var == "o") { ## parameters management params$adepar <- list(ppoints = list(pch = 20), paxes = list(aspectratio = "fill", draw = TRUE), porigin = list(draw = FALSE), pgrid = list(draw = FALSE), psub = list(text = paste0(colnames(evTab)[i], " (r2=", round(x$cr[i, xax], 2), ")"), position = "topleft")) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## data management lm0 <- lm(as.formula(paste("reponse.generic ~ ", paste(names(y), collapse = "+"))), data = cbind.data.frame(reponse.generic = score, y), weights = rep(1, nrow(y))/nrow(y)) lm0call <- substitute(lm(as.formula(paste("reponse.generic ~ ", paste(names(ycall), collapse = "+"))), data = cbind.data.frame(reponse.generic = scorecall, ycall), weights = rep(1, nrow(ycall))/nrow(ycall))) score.est <- predict(lm0) score.estcall <- substitute(predict(lm0call)) ord0 <- order(y[, 1]) ord0call <- substitute(order(ycall[, 1])) y1call <- call("[", ycall, ord0call, 1) x1call <- call("[", score.estcall, ord0call) ## ADEgS creation g1 <- do.call("s.label", c(list(dfxy = call("cbind", scorecall, call("[", ycall, 1:NROW(y), 1)), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$adepar, sortparameters$trellis, sortparameters$g.args, sortparameters$rest)) g2 <- xyplot(y[ord0, 1] ~ score.est[ord0], panel = function(x, y) {panel.lines(x, y)}) g2$call <- call("xyplot", substitute(y1call ~ x1call), panel = function(x, y) {panel.lines(x, y)}) ADEglist[[i]] <- superpose(g1, g2) } } ADEglist <- ADEglist[which.var] ## ADEgS creation posmatrix <- layout2position(.n2mfrow(length(which.var)), ng = length(which.var)) object <- new(Class = "ADEgS", ADEglist = ADEglist, positions = posmatrix, add = matrix(0, ncol = length(which.var), nrow = length(which.var)), Call = match.call()) names(object) <- colnames(evTab)[which.var] object@Call <- match.call() if(plot) print(object) invisible(object) } "score.pca" <- function (x, xax = 1, which.var = NULL, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "pca")) stop("Object of class 'pca' expected") if(x$nf == 1) xax <- 1 if((xax < 1) || (xax > x$nf)) stop("non convenient axe number") ## prepare oritab <- as.list(x$call)[[2]] type <- ade4::dudi.type(x$call) evTab <- eval.parent(oritab) if(is.null(which.var)) which.var <- 1:ncol(evTab) ## parameter management sortparameters <- sortparamADEg(...) params <- list() params$adepar <- list(paxes = list(aspectratio = "fill", draw = TRUE), porigin = list(include = FALSE), pgrid = list(draw = FALSE), plabels = list(cex = 0)) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg ADEglist <- list() for(i in which.var) { typedudi <- if(type == 3) {paste0(" (r=", round(x$co[i, xax], 2), ")")} else {""} dfxy <- call("cbind", substitute(x$l1[, xax]), call("[", oritab, 1:NROW(evTab), i)) g1 <- do.call("s.label", c(list(dfxy = dfxy, plot = FALSE, storeData = storeData, pos = pos - 2), c(sortparameters$adepar, list(psub.text = paste0(colnames(evTab)[i], typedudi))), sortparameters$trellis, sortparameters$g.args, sortparameters$rest)) g2 <- xyplot(eval(dfxy)[, 2] ~ eval(dfxy)[, 1], aspect = g1@adeg.par$paxes$aspectratio, panel = function(x, y) {panel.abline(lm(y ~ x))}) g2$call <- call("xyplot", substitute(dfxy[, 2] ~ dfxy[, 1]), aspect = g1@adeg.par$paxes$aspectratio, panel = function(x, y) {panel.abline(lm(y ~ x))}) ADEglist[[i]] <- superpose(g1, g2) } ADEglist <- ADEglist[which.var] ## ADEgS creation posmatrix <- layout2position(.n2mfrow(length(which.var)), ng = length(which.var)) object <- new(Class = "ADEgS", ADEglist = ADEglist, positions = posmatrix, add = matrix(0, ncol = length(which.var), nrow = length(which.var)), Call = match.call()) names(object) <- colnames(evTab)[which.var] object@Call <- match.call() if(plot) print(object) invisible(object) } "score.inertia" <- function(x, xax = 1, threshold = 0.1, contrib = c("abs", "rel"), posieig = "none", pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "inertia")) stop("Object of class 'inertia' expected") ## data management ori <- as.list(x$call) evTab <- eval.parent(ori[[2]]) if(length(xax) > 1) stop("Not implemented for multiple xax") if(xax > evTab$nf) stop("Non convenient xax") adegtot <- adegpar() position <- .getposition(posieig[1:min(2, length(posieig))]) contrib <- match.arg(contrib)[1] ## sort parameters for each graph graphsnames <- c("light_row", "heavy_row", "light_col", "heavy_col", "eig") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## parameters management adegtot <- adegpar() params <- list() params$light_row <- list(plabels = list(cex = 0), ppoints = list(col = "grey20", alpha = 0.45, cex = 1.2, pch = 19)) params$light_col <- list(plabels = list(cex = 0), ppoints = list(col = "grey20", alpha = 0.45, cex = 1.2, pch = 19)) params$heavy_row <- list(plabels = list(boxes = list(draw = TRUE), col = "red", srt = "horizontal"), ppoints = list(col = "red", cex = 1.2, pch = 19)) params$heavy_col <- list(plabels = list(boxes = list(draw = TRUE), col = "blue", srt = "horizontal"), ppoints = list(col = "blue", cex = 1.2, pch = 19)) params$eig <- list(pbackground = list(box = TRUE), psub = list(text = "Eigenvalues")) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) # never display points under contribution threshold sortparameters$light_row$plabels$cex <- 0 sortparameters$light_col$plabels$cex <- 0 ## management of the data and the parameters about the rows' contribution (individuals) on axes if(!is.null(x$row.rel)) { datacontrib <- x[[ifelse(contrib == "abs", "row.abs", "row.rel")]] inertrow <- abs(datacontrib[, xax]) / 100 lightrow <- subset(evTab$li[, xax], inertrow < threshold) heavyrow <- subset(evTab$li[, xax], inertrow >= threshold) if(length(heavyrow) == 0) stop("No points to draw, try lowering 'threshold'") heavy_inertrow <- subset(inertrow, inertrow >= threshold) names_heavyrow <- subset(rownames(datacontrib), inertrow >= threshold) limglobal <- setlimits1D(mini = min(c(heavyrow, lightrow)), maxi = max(c(heavyrow, lightrow)), origin = adegtot$porigin$origin, includeOr = adegtot$porigin$include) params <- list() params$light_row <- list(xlim = limglobal) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) } ## management of the data and the parameters about the columns' contribution (variables) on axes if(!is.null(x$col.rel)) { datacontrib <- x[[ifelse(contrib == "abs", "col.abs", "col.rel")]] inertcol <- abs(datacontrib[, xax]) / 100 lightcol <- subset(evTab$co[, xax], inertcol < threshold) heavycol <- subset(evTab$co[, xax], inertcol >= threshold) if(length(heavycol) == 0) stop("No points to draw, try lowering 'threshold'") heavy_inertcol <- subset(inertcol, inertcol >= threshold) names_heavycol <- subset(rownames(datacontrib), inertcol >= threshold) limglobal <- setlimits1D(mini = min(c(heavycol, lightcol)), maxi = max(c(heavycol, lightcol)), origin = adegtot$porigin$origin, includeOr = adegtot$porigin$include) params <- list() params$light_col <- list(xlim = limglobal) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) } ## displaying of the eigen values if(!is.null(position)) geig <- do.call("plotEig", c(list(eigvalue = call("$", ori[[2]], "eig"), nf = 1:evTab$nf, xax = xax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$eig)) ## function to create the graphics about the row' contribution (individuals) on axes f_row <- function(posi = NULL, pos){ graphnames <- c(if(length(lightrow) > 0) {"light_row"}, "heavy_row", "contribution", if(!is.null(posi)) {"eig"}) if(length(lightrow) > 0) { g1 <- do.call("s1d.label", c(list(score = lightrow, at = 0, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$light_row)) g2 <- do.call("s1d.label", c(list(score = heavyrow, at = heavy_inertrow, labels = names_heavyrow, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$heavy_row)) grow <- do.call("superpose", list(g1, g2)) grow@Call <- call("superpose", list(g1@Call, g2@Call)) } else { grow <- do.call("s1d.label", c(list(score = heavyrow, at = heavy_inertrow, labels = names_heavyrow, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$heavy_col)) } # add an horizontal line drawinf the contribution threshold gcont <- xyplot(0 ~ 0, panel = function(x, y) {panel.abline(h = threshold, lty = "dotted", col = "grey")}) grow <- do.call("superpose", list(grow, gcont)) grow@Call <- call("superpose", list(grow@Call, gcont$call)) if(!is.null(posi)) grow <- do.call("insert", list(geig, grow, posi = posi, plot = FALSE, ratio = 0.25)) names(grow) <- graphnames return(grow) } # function to create the graphics about the columns' contribution (variables) on axes f_col <- function(posi = NULL, pos) { graphnames <- c(if(length(lightcol) > 0) {"light_col"}, "heavy_col", "contribution", if(!is.null(posi)) {"eig"}) if(length(lightcol) > 0) { g3 <- do.call("s1d.label", c(list(score = lightcol, at = 0, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$light_col)) g4 <- do.call("s1d.label", c(list(score = heavycol, at = heavy_inertcol, labels = names_heavycol, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$heavy_col)) gcol <- do.call("superpose", list(g3, g4)) gcol@Call <- call("superpose", list(g3@Call, g4@Call)) } else { gcol <- do.call("s1d.label", c(list(score = heavycol, at = heavy_inertcol, labels = names_heavycol, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$heavy_col)) } # add an horizontal line drawinf the contribution threshold gcont <- xyplot(0 ~ 0, panel = function(x, y) {panel.abline(h = threshold, lty = "dotted", col = "grey")}) gcol <- do.call("superpose", list(gcol, gcont)) gcol@Call <- call("superpose", list(gcol@Call, gcont$call)) if(!is.null(posi)) gcol <- do.call("insert", list(geig, gcol, posi = posi, plot = FALSE, ratio = 0.25)) names(gcol) <- graphnames return(gcol) } ## function to create a layout of the graphics about the contribution of rows (individuals) and columns (variables) on axes f_both <- function(posi = NULL, pos) { object <- do.call("cbindADEg", c(list(f_row(posi = NULL, pos = pos - 1), f_col(posi = posi, pos = pos - 1)))) names(object) <- c("row", "col") return(object) } ## creation of the appropriate plot according to the input data if(!is.null(x$row.rel) & is.null(x$col.rel)) object <- f_row(posi = position, pos = pos) if(!is.null(x$col.rel) & is.null(x$row.rel)) object <- f_col(posi = position, pos = pos) if(!is.null(x$row.rel) & !is.null(x$col.rel)) object <- f_both(posi = position, pos = pos) if(is.null(x$row.rel) & is.null(x$col.rel)) stop(paste("No inertia was calculated in the ", substitute(x), " object", sep = "")) object@Call <- match.call() if(plot) print(object) invisible(object) } #"score.coa" <- function (x, xax = 1, dotchart = FALSE, pos = -1, storeData = TRUE, plot = TRUE, ...) { # # if(!inherits(x, "coa")) # stop("Object of class 'coa' expected") # if(x$nf == 1) # xax <- 1 # if((xax < 1) || (xax > x$nf)) # stop("non convenient axe number") # # if(dotchart) # stop("TRUE 'dotchart' not yet implemented") # # # # def.par <- par(mar = par("mar")) # on.exit(par(def.par)) # par(mar = c(0.1, 0.1, 0.1, 0.1)) # # sco.distri.class.2g <- function(score, fac1, fac2, weight, labels1 = as.character(levels(fac1)), labels2 = as.character(levels(fac2)), clab1, clab2, cpoi, cet) { # nvar1 <- nlevels(fac1) # nvar2 <- nlevels(fac2) # ymin <- scoreutil.base(y = score, xlim = NULL, grid = TRUE, cgrid = 0.75, include.origin = TRUE, origin = 0, sub = NULL, csub = 0) # ymax <- par("usr")[4] # ylabel <- strheight("A", cex = par("cex") * max(1, clab1, clab2)) * 1.4 # xmin <- par("usr")[1] # xmax <- par("usr")[2] # xaxp <- par("xaxp") # nline <- xaxp[3] + 1 # v0 <- seq(xaxp[1], xaxp[2], le = nline) # # ## dessine la grille # segments(v0, rep(ymin, nline), v0, rep(ymax, nline), col = gray(0.5), lty = 1) # # ## dessine le cadre # rect(xmin, ymin, xmax, ymax) # # # sum.col1 <- unlist(tapply(weight, fac1, sum)) # sum.col2 <- unlist(tapply(weight, fac2, sum)) # sum.col1[sum.col1 == 0] <- 1 # sum.col2[sum.col2 == 0] <- 1 # # weight1 <- weight/sum.col1[fac1] # weight2 <- weight/sum.col2[fac2] # # y.distri1 <- tapply(score * weight1, fac1, sum) # y.distri1 <- rank(y.distri1) # y.distri2 <- tapply(score * weight2, fac2, sum) # y.distri2 <- rank(y.distri2) + nvar1 + 2 # y.distri <- c(y.distri1, y.distri2) # # ylabel <- strheight("A", cex = par("cex") * max(1, clab1, clab2)) * 1.4 # y.distri1 <- (y.distri1 - min(y.distri))/(max(y.distri) - min(y.distri)) # y.distri1 <- ymin + ylabel + (ymax - ymin - 2 * ylabel) * y.distri1 # y.distri2 <- (y.distri2 - min(y.distri))/(max(y.distri) - min(y.distri)) # y.distri2 <- ymin + ylabel + (ymax - ymin - 2 * ylabel) * y.distri2 # # for (i in 1:nvar1) { # w <- weight1[fac1 == levels(fac1)[i]] # y0 <- y.distri1[i] # score0 <- score[fac1 == levels(fac1)[i]] # x.moy <- sum(w * score0) # x.et <- sqrt(sum(w * (score0 - x.moy)^2)) # x1 <- x.moy - cet * x.et # x2 <- x.moy + cet * x.et # etiagauche <- TRUE # if ((x1 - xmin) < (xmax - x2)) # etiagauche <- FALSE # segments(x1, y0, x2, y0) # if (clab1 > 0) { # cha <- labels1[i] # cex0 <- par("cex") * clab1 # xh <- strwidth(cha, cex = cex0) # xh <- xh + strwidth("x", cex = cex0) # yh <- strheight(cha, cex = cex0) * 5/6 # if (etiagauche) # x0 <- x1 - xh/2 # else x0 <- x2 + xh/2 # rect(x0 - xh/2, y0 - yh, x0 + xh/2, y0 + yh, col = "white", border = 1) # text(x0, y0, cha, cex = cex0) # } # points(x.moy, y0, pch = 20, cex = par("cex") * cpoi) # } # for (i in 1:nvar2) { # w <- weight2[fac2 == levels(fac2)[i]] # y0 <- y.distri2[i] # score0 <- score[fac2 == levels(fac2)[i]] # x.moy <- sum(w * score0) # x.et <- sqrt(sum(w * (score0 - x.moy)^2)) # x1 <- x.moy - cet * x.et # x2 <- x.moy + cet * x.et # etiagauche <- TRUE # if ((x1 - xmin) < (xmax - x2)) # etiagauche <- FALSE # segments(x1, y0, x2, y0) # if (clab2 > 0) { # cha <- labels2[i] # cex0 <- par("cex") * clab2 # xh <- strwidth(cha, cex = cex0) # xh <- xh + strwidth("x", cex = cex0) # yh <- strheight(cha, cex = cex0) * 5/6 # if (etiagauche) # x0 <- x1 - xh/2 # else x0 <- x2 + xh/2 # rect(x0 - xh/2, y0 - yh, x0 + xh/2, y0 + yh, col = "white", border = 1) # text(x0, y0, cha, cex = cex0) # } # points(x.moy, y0, pch = 20, cex = par("cex") * cpoi) # } # } # # if (inherits(x, "witwit")) { # y <- eval.parent(as.list(x$call)[[2]]) # oritab <- eval.parent(as.list(y$call)[[2]]) # } else # oritab <- eval.parent(as.list(x$call)[[2]]) # # l.names <- row.names(oritab) # c.names <- names(oritab) # oritab <- as.matrix(oritab) # a <- x$co[col(oritab), xax] # a <- a + x$li[row(oritab), xax] # a <- a/sqrt(2 * x$eig[xax] * (1 + sqrt(x$eig[xax]))) # a <- a[oritab > 0] # aco <- col(oritab)[oritab > 0] # aco <- factor(aco) # levels(aco) <- c.names # ali <- row(oritab)[oritab > 0] # ali <- factor(ali) # levels(ali) <- l.names # aw <- oritab[oritab > 0]/sum(oritab) # # sco.distri.class.2g(a, aco, ali, aw, clab1 = clab.c, clab2 = clab.r, cpoi = cpoi, cet = cet) # scatterutil.sub("Rows", csub = csub, possub = "topleft") # scatterutil.sub("Columns", csub = csub, possub = "bottomright") #}adegraphics/R/ADEg.S1.R0000644000176200001440000003275013742303021014074 0ustar liggesusers#################################################### ## Uni-dimensionnal plot ## #################################################### setClass( Class = "ADEg.S1", contains = c("ADEg", "VIRTUAL"), slots = c(data = "list") ) setMethod( f = "initialize", signature = "ADEg.S1", definition = function(.Object, data = list(score = NULL, at = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, ...) ## ADEg initialize .Object@data <- data return(.Object) }) ## prepare: grid calculations ## reset limits and sets axis information for lattice setMethod( f = "prepare", signature = "ADEg.S1", definition = function(object) { name_obj <- deparse(substitute(object)) if(object@data$storeData) { score <- object@data$score at <- object@data$at } else { score <- eval(object@data$score, envir = sys.frame(object@data$frame)) at <- eval(object@data$at, envir = sys.frame(object@data$frame)) } if(inherits(object, "S1.boxplot")){ if(object@data$storeData) { fac <- object@data$fac } else { fac <- eval(object@data$fac, envir = sys.frame(object@data$frame)) } } score <- as.matrix(score)[, 1] ## to manage 'score' when it is a data.frame with only one column ## limits and scale minX <- min(score) maxX <- max(score) if(object@adeg.par$p1d$horizontal & !is.null(object@g.args$xlim) & is.null(object@s.misc$hori.update)) { minX <- object@g.args$xlim[1] maxX <- object@g.args$xlim[2] } if(!object@adeg.par$p1d$horizontal & !is.null(object@g.args$ylim) & is.null(object@s.misc$hori.update)) { minX <- object@g.args$ylim[1] maxX <- object@g.args$ylim[2] } origin <- object@adeg.par$porigin lim <- setlimits1D(minX, maxX, origin = origin$origin[1], includeOr = origin$include) ## compute grid size tmp <- pretty(lim, n = object@adeg.par$pgrid$nint) if(!origin$include) origin$origin[1] <- tmp[1] cgrid <- diff(tmp)[1] if(is.na(cgrid)) stop("error while calculating grid") ## compute grid location v0 <- origin$origin[1] if((origin$origin[1] + cgrid) <= lim[2]) v0 <- c(v0, seq(origin$origin[1] + cgrid, lim[2], by = cgrid)) if((origin$origin[1] - cgrid >= lim[1])) v0 <- c(v0, seq(origin$origin[1] - cgrid, lim[1], by = -cgrid)) v0 <- sort(v0[v0 >= lim[1] & v0 <= lim[2]]) ## clean near-zero values delta <- diff(range(v0))/object@adeg.par$pgrid$nint if (any(small <- abs(v0) < 1e-14 * delta)) v0[small] <- 0 object@s.misc$backgrid <- list(x = v0, d = cgrid) ## object@adeg.par$paxes has priority over object@g.args$scales object@adeg.par$paxes$aspectratio <- "fill" scalesandlab <- modifyList(as.list(object@g.args$scales), object@adeg.par$paxes, keep.null = TRUE) if(!scalesandlab$draw) { scalesandlab$x$draw <- FALSE scalesandlab$y$draw <- FALSE } lead <- ifelse(object@adeg.par$p1d$reverse, 1 , -1) if(object@adeg.par$p1d$horizontal) { ## draw axes for horizontal plot if(is.null(scalesandlab$x$at)) scalesandlab$x$at <- object@s.misc$backgrid$x if(is.null(object@g.args$xlim) || !identical(object@s.misc$hori.update, object@adeg.par$p1d$horizontal)) object@g.args$xlim <- lim Ylim <- object@g.args$ylim if(is.null(object@s.misc$p1dReverse.update) || (object@adeg.par$p1d$reverse != object@s.misc$p1dReverse.update) || is.null(object@s.misc$Ylim.update) || any(Ylim != object@s.misc$Ylim.update)) { if(is.null(object@g.args$ylim)) Ylim <- setlimits1D(min(at), max(at), 0, FALSE) if(inherits(object, "S1.boxplot")) ## extend ylim for boxes Ylim <- Ylim + c(-1, 1) * abs(diff(range(at))) / (nlevels(fac) + 1) if(object@adeg.par$p1d$rug$draw) { ref <- ifelse(object@adeg.par$p1d$reverse, 2, 1) margin <- Ylim[ref] if(object@adeg.par$p1d$rug$draw) margin <- object@adeg.par$p1d$rug$margin * abs(diff(Ylim)) object@s.misc$rug <- Ylim[ref] Ylim[ref] <- Ylim[ref] + lead * margin } object@s.misc$Ylim.update <- Ylim object@s.misc$p1dReverse.update <- object@adeg.par$p1d$reverse } object@g.args$ylim <- Ylim } else { ## draw axes for vertical plot if(is.null(scalesandlab$y$at)) scalesandlab$y$at <- object@s.misc$backgrid$x if(is.null(object@g.args$ylim) || !identical(object@s.misc$hori.update, object@adeg.par$p1d$horizontal)) object@g.args$ylim <- lim Xlim <- object@g.args$xlim if(is.null(object@s.misc$p1dReverse.update) || (object@adeg.par$p1d$reverse != object@s.misc$p1dReverse.update) || is.null(object@s.misc$Xlim.update) || any(Xlim != object@s.misc$Xlim.update)) { if(is.null(object@g.args$xlim)) Xlim <- setlimits1D(min(at), max(at), 0, FALSE) if(inherits(object, "S1.boxplot")) ## extend xlim for boxes Xlim <- Xlim + c(-1, 1) * abs(diff(range(at))) / (nlevels(fac) + 1) if(object@adeg.par$p1d$rug$draw) { ref <- ifelse(object@adeg.par$p1d$reverse, 2, 1) margin <- Xlim[ref] if(object@adeg.par$p1d$rug$draw) margin <- object@adeg.par$p1d$rug$margin * abs(diff(Xlim)) object@s.misc$rug <- Xlim[ref] Xlim[ref] <- Xlim[ref] + lead * margin } object@s.misc$Xlim.update <- Xlim object@s.misc$p1dReverse.update <- object@adeg.par$p1d$reverse } object@g.args$xlim <- Xlim } object@g.args$scales <- scalesandlab object@s.misc$hori.update <- object@adeg.par$p1d$horizontal assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panelbase", signature = "ADEg.S1", definition = function(object, x, y) { ## Formula defined in gettrellis ## if horizontal, x is score and y is a vector with repetitions of origin ## if vertical, this is the inverse grid <- object@adeg.par$pgrid porigin <- object@adeg.par$porigin pscore <- object@adeg.par$p1d lims <- current.panel.limits(unit = "native") plines <- object@adeg.par$plines if(!is.null(object@data$fac)) { ## there is a factor in the data (e.g., S1.class) if(object@data$storeData) fac <- object@data$fac else fac <- as.factor(eval(object@data$fac, envir = sys.frame(object@data$frame))) plines <- lapply(plines, FUN = function(x) return(rep(x, length.out = nlevels(fac))[fac])) } lead <- ifelse(pscore$reverse, -1 , 1) if(pscore$horizontal) { ## horizontal plot ## draw grid if(grid$draw) panel.segments(x0 = object@s.misc$backgrid$x , x1 = object@s.misc$backgrid$x, y0 = lims$ylim[1], y1 = lims$ylim[2], col = grid$col, lty = grid$lty, lwd = grid$lwd) ## draw origin panel.abline( v = if(porigin$draw) porigin$origin else NULL, h = if(pscore$rug$draw & pscore$rug$line) object@s.misc$rug else NULL, col = porigin$col, lwd = porigin$lwd, lty = porigin$lty, alpha = porigin$alpha) ## draw rug if(pscore$rug$draw & (pscore$rug$tck != 0)) { ref <- ifelse(pscore$reverse, lims$ylim[2], lims$ylim[1]) ## tick end and starting points start <- object@s.misc$rug end <- start - pscore$rug$tck * lead * abs(start - ref) start <- convertUnit(unit(start, "native"), unitTo = "npc", axisFrom = "y", valueOnly = TRUE) end <- convertUnit(unit(end, "native"), unitTo = "npc", axisFrom = "y", valueOnly = TRUE) do.call("panel.rug", c(list(x = y, start = start, end = end), plines)) } } else { ## vertical plot ## draw grid if(grid$draw) panel.segments(y0 = object@s.misc$backgrid$x , y1 = object@s.misc$backgrid$x, x0 = lims$xlim[1], x1 = lims$xlim[2], col = grid$col, lty = grid$lty, lwd = grid$lwd) ## draw origin panel.abline( h = if(porigin$draw) porigin$origin else NULL, v = if(pscore$rug$draw & pscore$rug$line) object@s.misc$rug else NULL, col = porigin$col, lwd = porigin$lwd, lty = porigin$lty, alpha = porigin$alpha) ## draw rug if(pscore$rug$draw && (pscore$rug$tck != 0)) { ref <- ifelse(pscore$reverse, lims$xlim[2], lims$xlim[1]) ## tick end and starting points start <- object@s.misc$rug end <- start - pscore$rug$tck * lead * abs(start - ref) start <- convertUnit(unit(start, "native"), unitTo = "npc", axisFrom = "x", valueOnly = TRUE) end <- convertUnit(unit(end, "native"), unitTo = "npc", axisFrom = "x", valueOnly = TRUE) do.call("panel.rug", c(list(y = y, start = start, end = end), plines)) } } ## indicate grid size (d = **) if(grid$draw & (grid$text$cex > 0)) { text.pos <- .setposition(grid$text$pos) textgrid <- textGrob(label = paste("d =", object@s.misc$backgrid$d), x = text.pos$posi[1], y = text.pos$posi[2], gp = gpar(cex = grid$text$cex, col = grid$text$col), name = "gridtext") grid.rect(x = text.pos$posi[1], y = text.pos$posi[2], width = grobWidth(textgrid), height = grobHeight(textgrid), gp = gpar(fill= object@adeg.par$pbackground$col, alpha = 0.8, col = "transparent")) grid.draw(textgrid) } callNextMethod() }) setMethod( f = "setlatticecall", signature = "ADEg.S1", definition = function(object) { ## arguments recurrents de la liste, pas les limites car elles seront definis ensuite name_obj <- deparse(substitute(object)) ## grid background and box object@trellis.par$panel.background$col <- object@adeg.par$pbackground$col if(!object@adeg.par$pbackground$box) object@trellis.par$axis.line$col <- "transparent" else object@trellis.par$axis.line$col <- "black" arguments <- list( par.settings = object@trellis.par, scales = object@g.args$scales, aspect = object@adeg.par$paxes$aspectratio, key = createkey(object), axis = axis.L, ## see utils.R panel = function(...) { panelbase(object,...) ## grid, panel(object,...) ## call to S1.panel function, for slabel and ADEg.S1 class of graphs }) object@lattice.call$arguments <- arguments object@lattice.call$graphictype <- "xyplot" ## get lattice arguments (set unspecified to NULL) argnames <- c("main", "sub", "xlab", "ylab") largs <- object@g.args[argnames] names(largs) <- argnames ## add xlim and ylim if not NULL if("xlim" %in% names(object@g.args)) largs["xlim"] <- object@g.args["xlim"] if("ylim" %in% names(object@g.args)) largs["ylim"] <- object@g.args["ylim"] object@lattice.call$arguments <- c(object@lattice.call$arguments, largs, list(strip = FALSE)) assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "gettrellis", signature = "ADEg.S1", definition = function(object) { if(object@data$storeData) score <- object@data$score else score <- eval(object@data$score, envir = sys.frame(object@data$frame)) score <- as.matrix(score)[, 1] ## to manage 'score' when it is a data.frame with only one column xdata <- rep(1, length(score)) fml <- as.formula(score ~ xdata) tmptrellis <- do.call(what = object@lattice.call$graphictype, args = c(fml, object@lattice.call$arguments, environment())) return(tmptrellis) }) ## zoom without center setMethod( f = "zoom", signature = c("ADEg.S1", "numeric", "missing"), definition = function(object, zoom, center) { ## zoom in xlim p1d <- object@adeg.par$p1d nameobj <- deparse(substitute(object)) if(length(zoom) != 1) stop("zoom factor should be length 1") center <- ifelse(p1d$horizontal, mean(object@g.args$xlim), mean(object@g.args$ylim)) zoom(object, zoom, center) }) ## zoom with center setMethod( f = "zoom", signature = c("ADEg.S1", "numeric", "numeric"), definition = function(object, zoom, center) { nameobj <- deparse(substitute(object)) p1d <- object@adeg.par$p1d origin <- object@adeg.par$porigin if(length(center) != 1) stop("Center should be a numeric") if(length(zoom) != 1) stop("Zoom factor should be a numeric") if(p1d$horizontal) { diffx <- diff(object@g.args$xlim) / zoom minX <- center - diffx / 2 maxX <- center + diffx / 2 object@g.args$xlim <- c(minX, maxX) } else { diffx <- diff(object@g.args$ylim) / zoom minX <- center - diffx / 2 maxX <- center + diffx / 2 object@g.args$ylim <- c(minX, maxX) } lim <- setlimits1D(minX, maxX, origin = origin$origin[1], includeOr = origin$include) ## compute grid size tmp <- pretty(lim, n = object@adeg.par$pgrid$nint) if(!origin$include) origin$origin[1] <- tmp[1] cgrid <- diff(tmp)[1] if(is.na(cgrid)) stop("error while calculating grid") ## compute grid location v0 <- origin$origin[1] if((origin$origin[1] + cgrid) <= lim[2]) v0 <- c(v0, seq(origin$origin[1] + cgrid, lim[2], by = cgrid)) if((origin$origin[1] - cgrid >= lim[1])) v0 <- c(v0, seq(origin$origin[1] - cgrid, lim[1], by = -cgrid)) v0 <- sort(v0[v0 >= lim[1] & v0 <= lim[2]]) object@s.misc$backgrid <- list(x = v0, d = cgrid) setlatticecall(object) print(object) invisible(object) }) adegraphics/R/ADEgS.R0000644000176200001440000005741214354572335013757 0ustar liggesusers############################################## ## general class ## ############################################## setClass( Class = "ADEgS", slots = c( ADEglist = "list", positions = "matrix", add = "matrix", ## n*n, if xij = 1, j superposed to i Call = "call"), ## slots checking validity = function(object) { ng <- length(object@ADEglist) add <- object@add if (ncol(object@positions) != 4) stop("wrong positions matrix, only 4 columns expected (x0, y0, x1, y1)") if (nrow(object@positions) != ng) stop("not enough positions: rows number of the positions matrix should be equal to the number of graphics in the ADEglist") ## checking add: if ((NROW(add) != NCOL(add)) | (NCOL(add) != ng)) stop("add matrix dimensions are not equal to the number of graphics in ADEglist") if (any(add != 0 & add != 1)) stop("add matrix can only contain 0/1 values") for (i in 1:ng) { j <- 1:i if (any(add[i, j] != 0)) stop("upper diagonal matrix expected for add, only 0 are allowed for xij, when j > = i") } return(TRUE) }) ############################################## ## initialize ## ############################################## setMethod( f = "initialize", signature = "ADEgS", function(.Object, ADEglist, positions, add, Call) { ## add linking superpose <- list() ng <- length(ADEglist) for (i in 1:ng) { superpose <- c(superpose, list(which(add[, i] == 1))) ## where i is superposed to 1 if (length((superpose[[i]]))) { for (j in superpose[[i]]) { add[superpose[[j]], i] <- 1 superpose[[i]] <- c(superpose[[i]], superpose[[j]]) }}} .Object@add <- add ## check names of the list ADEglist if (is.null(names(ADEglist))) names(ADEglist) <- paste("g", lapply(1:length(ADEglist), function(i) i), sep = "") else names(ADEglist) <- make.names(names(ADEglist),unique = TRUE) ## assignation .Object@ADEglist <- ADEglist .Object@positions <- positions .Object@add <- add .Object@Call <- Call ## checking validations validObject(.Object) return(.Object) }) setClassUnion(name = "ADEgORADEgSORtrellis", members = c("ADEg", "ADEgS", "trellis")) ############################################## ## Get elements/information ## ############################################## setMethod( f = "getcall", signature = "ADEgS", definition = function(object) { return(object@Call) }) setMethod( f = "getgraphics", signature = "ADEgS", definition = function(object) { return(object@ADEglist) }) setMethod( f = "getpositions", signature = "ADEgS", definition = function(object) { return(object@positions) }) setMethod( f = "length", signature = "ADEgS", definition = function(x) { return(length(x@ADEglist)) }) setMethod( f = "names", signature = "ADEgS", definition = function(x) { return(names(x@ADEglist)) }) setMethod( f = "names<-", signature = c("ADEgS", "character"), definition = function(x, value) { nameobj <- deparse(substitute(x)) names(x@ADEglist) <- value x }) ############################################## ## Extract graphics ## ############################################## ## [: if drop =TRUE can return a ADEg or a length-1 ADEgS ## else return a ADEgS no manipulation is made on the positions setMethod( f = "[", signature = c("ADEgS", "numeric", "missing", "logical"), definition = function(x, i, j, drop = TRUE) { if (drop && length(i) == 1) return(x@ADEglist[[i]]) ## return(adeG) else return(new(Class = "ADEgS", ADEglist = x@ADEglist[i], positions = x@positions[i, , drop = drop], add = x@add[i, i, drop = drop], Call = match.call())) }) setMethod( f = "[", signature = c("ADEgS", "numeric", "missing", "missing"), definition = function(x, i, j, drop) { object <- x[i, drop = FALSE] object@Call <- match.call() return(object) }) setMethod( f = "$", signature = "ADEgS", definition = function(x, name) { invisible(x@ADEglist[[name]]) }) setMethod( f = "[[", signature = c("ADEgS", "numeric", "missing"), definition = function(x, i, j, ...) { invisible(x@ADEglist[[i]]) }) setMethod( f = "[[", signature = c("ADEgS", "character", "missing"), definition = function(x, i, j, ...) { invisible(x@ADEglist[[i]]) }) setMethod( f = "[[<-", signature = c("ADEgS", "numeric", "missing", "ADEg"), definition = function(x, i, j, ..., value) { x@ADEglist[[i]] <- value invisible(x) }) setMethod( f = "[[<-", signature = c("ADEgS", "numeric", "missing", "ADEgS"), definition = function(x, i, j, ..., value) { x@ADEglist[[i]] <- value invisible(x) }) ############################################## ## superposition ## ############################################## setMethod( f = "superpose", signature = c("ADEgS", "ADEgORtrellis", "numeric", "logical"), definition = function(g1, g2, which, plot) { ## new ADEgS ngraph <- length(g1) if (which > ngraph) stop("Values in 'which' should be lower than the length of g1") if (!inherits(g1[[which]], "ADEg")) stop("superposition is only available between two ADEg") addi <- cbind(rbind(g1@add, rep(0, ngraph)), rep(0, ngraph + 1)) addi[which, ngraph + 1] <- 1 ## new graph superpose to which ADEglist <- g1@ADEglist ADEglist[[ngraph + 1]] <- g2 ADEgS <- new(Class = "ADEgS", ADEglist = ADEglist, positions = rbind(g1@positions, g1@positions[which,]), add = addi, Call = match.call()) if (plot) print(ADEgS) invisible(ADEgS) }) setMethod( f = "superpose", signature = c("ADEgS", "ADEgORtrellis", "numeric", "ANY"), definition = function(g1, g2, which, plot) { objectnew <- superpose(g1, g2, which = which, plot = FALSE) objectnew@Call <- match.call() if (plot) print(objectnew) invisible(objectnew) }) setMethod( f = "superpose", signature = c("ADEgS", "ADEgORtrellis", "missing", "ANY"), definition = function(g1, g2, which, plot) { if (!inherits(g1[[length(g1)]], "ADEg")) stop("superposition is only available between two ADEg") objectnew <- superpose(g1, g2, which = length(g1), plot = FALSE) objectnew@Call <- match.call() if (plot) print(objectnew) invisible(objectnew) }) setMethod( f = "superpose", signature = c("ADEgS", "ADEgS", "missing", "ANY"), definition = function(g1, g2, which, plot) { ## superpose two ADEgS which have the same number of graphics and the same positions if (length(g1) != length(g2)) stop("The two ADEgS objects should contain the same number of graphics") if (!isTRUE(all.equal(g1@positions, g2@positions, check.attributes = FALSE))) stop("The two ADEgS objects should have the same 'positions' slot") f1 <- function(x, y) { if (inherits(x, "ADEg")) { addi <- matrix(0, 2, 2) addi[1,2] <- 1 thecall <- call("superpose", x@Call, y@Call) obj <- new(Class = "ADEgS", ADEglist = list(x, y), positions = matrix(rep(c(0, 1), each = 4), 2, 4), add = addi, Call = thecall) } else if (inherits(x, "ADEgS")) { addi <- x@add ng <- ncol(addi) posi <- x@positions ## check that positions in posi are all equal and one 1 in each column of addi (i.e. graphs are still superposed) checkadd <- all(colSums(addi[, -1, drop = FALSE]) > 0) checkpos <- isTRUE(all.equal(matrix(posi[1, ], nrow = nrow(posi), ncol = ncol(posi), byrow = TRUE), posi)) if (!checkpos | !checkadd) stop("ADEgS object should contain only superposition") ## superpose addi <- rbind(addi, rep(0, ng)) addi <- cbind(addi, rep(0, ng + 1)) addi[ng, ng + 1] <- 1 posi <- rbind(posi, posi[1,]) thecall <- call("superpose", x@Call, y@Call) obj <- new(Class = "ADEgS", ADEglist = c(x@ADEglist, list(y)), positions = posi, add = addi, Call = thecall) } invisible(obj) } res <- lapply(1:length(g1), FUN = function(i) {f1(g1[[i]], g2[[i]])}) obj <- new(Class = "ADEgS", ADEglist = res, positions = g1@positions, add = g1@add, Call = match.call()) if (plot) print(obj) invisible(obj) }) setMethod( f = "+", signature = c("ADEgS", "ADEg"), definition = function(e1, e2) { newobj <- superpose(e1, e2, plot = TRUE) newobj@Call <- match.call() return(newobj) }) setMethod( f = "+", signature = c("ADEg", "ADEgS"), definition = function(e1, e2) { newobj <- superpose(e2, e1, plot = TRUE) warning("the second graph is below the first one ; the reverse situation is not yet implemented", call. = FALSE) newobj@Call <- match.call() return(newobj) }) setMethod( f = "cbindADEg", signature = c("ADEgORADEgSORtrellis", "ADEgORADEgSORtrellis"), definition = function(g1, g2, ..., plot = FALSE) { if (try(is.list(...), silent = TRUE) == TRUE) glist <- as.list(c(g1, g2, ...)) else glist <- list(g1, g2, ...) nbg <- length(glist) obj <- ADEgS(adeglist = glist, layout = c(1, nbg), add = matrix(0, ncol = nbg, nrow = nbg), plot = FALSE) obj@Call <- match.call() if (plot) print(obj) invisible(obj) }) setMethod( f = "rbindADEg", signature = c("ADEgORADEgSORtrellis", "ADEgORADEgSORtrellis"), definition = function(g1, g2, ..., plot = FALSE) { if (try(is.list(...), silent = TRUE) == TRUE) glist <- as.list(c(g1, g2, ...)) else glist <- list(g1, g2, ...) nbg <- length(glist) obj <- ADEgS(adeglist = glist, layout = c(nbg, 1), add = matrix(0, ncol = nbg, nrow = nbg), plot = FALSE) obj@Call <- match.call() if (plot) print(obj) invisible(obj) }) ############################################## ## insertion ## ############################################## setMethod( f = "insert", signature = c("ADEgS", "missing"), definition = function(graphics, oldgraphics, posi, ratio, inset, plot, which, dispatch) { positions <- .getposition(posi, w = ratio, h = ratio) + inset currentgraphic <- get("currentadeg", envir = .ADEgEnv) if (!(length(currentgraphic))) stop("no existing graphics") else newADEgS <- insert(graphics = graphics, oldgraphics = currentgraphic, posi = posi, ratio = ratio, inset = inset, plot = plot, which = which, dispatch = dispatch) if (plot) print(newADEgS[length(newADEgS)], newpage = FALSE) assign("currentadeg", newADEgS, envir = .ADEgEnv) invisible(newADEgS) }) setMethod( f = "insert", signature = c("ADEgS", "ADEg"), definition = function(graphics, oldgraphics, posi, ratio, inset, plot) { positions <- .getposition(posi, w = ratio, h = ratio) + inset thecall <- call("insert", graphics@Call, oldgraphics@Call) newADEgS <- new(Class = "ADEgS", ADEglist = list(oldgraphics, graphics), positions = rbind(c(0, 0, 1, 1), positions), add = matrix(0, ncol = 2, nrow = 2), thecall) if (plot) print(newADEgS) assign("currentadeg", newADEgS, envir = .ADEgEnv) invisible(newADEgS) }) setMethod( f = "insert", signature = c("ADEgORtrellis", "ADEgS"), definition = function(graphics, oldgraphics, posi, ratio, inset, plot, which) { thecall <- call("insert", graphics@Call, oldgraphics@Call) if (missing(which)) { positions <- .getposition(posi, w = ratio, h = ratio) + inset newADEgS <- new(Class = "ADEgS", ADEglist = c(oldgraphics@ADEglist, list(graphics)), positions = rbind(oldgraphics@positions, positions), add = rbind(cbind(oldgraphics@add, rep(0, length.out = nrow(oldgraphics@add))), rep(0, length.out = ncol(oldgraphics@add) + 1)), Call = thecall) } else { l <- sapply(1:length(oldgraphics), FUN = function(i) {if (i %in% which) {insert(graphics, oldgraphics@ADEglist[[i]], posi = posi, ratio = ratio, inset = inset, plot = FALSE)} else oldgraphics@ADEglist[[i]]}) newADEgS <- new(Class = "ADEgS", ADEglist = l, positions = oldgraphics@positions, add = oldgraphics@add, Call = thecall) } if (plot) print(newADEgS) assign("currentadeg", newADEgS, envir = .ADEgEnv) invisible(newADEgS) }) setMethod( f = "insert", signature = c("ADEgS", "ADEgS"), definition = function(graphics, oldgraphics, posi, ratio, inset, plot, which, dispatch) { thecall <- call("insert", graphics@Call, oldgraphics@Call) if (!dispatch){ if (missing(which)) { positions <- .getposition(posi, w = ratio, h = ratio) + inset newADEgS <- new(Class = "ADEgS", ADEglist = c(oldgraphics@ADEglist, list(graphics)), positions = rbind(oldgraphics@positions, positions), add = rbind(cbind(oldgraphics@add, rep(0, length.out = nrow(oldgraphics@add))), rep(0, length.out = ncol(oldgraphics@add) + 1)), Call = thecall) } else { l <- sapply(1:length(oldgraphics), FUN = function(i) {if (i %in% which) {insert(graphics, oldgraphics@ADEglist[[i]], posi = posi, ratio = ratio, inset = inset, plot = FALSE)} else oldgraphics@ADEglist[[i]]}) newADEgS <- new(Class = "ADEgS", ADEglist = l, positions = oldgraphics@positions, add = oldgraphics@add, Call = thecall) } } else { if (length(graphics) != length(oldgraphics)) stop("dispatch option is not allowed with ADEgS object of different length") else { l <- sapply(1:length(oldgraphics), FUN = function(i) {insert(graphics@ADEglist[[i]], oldgraphics@ADEglist[[i]], posi = posi, ratio = ratio, inset = inset, plot = FALSE)}) newADEgS <- new(Class = "ADEgS", ADEglist = l, positions = oldgraphics@positions, add = oldgraphics@add, Call = thecall) } } if (plot) print(newADEgS) assign("currentadeg", newADEgS, envir = .ADEgEnv) invisible(newADEgS) }) ############################################## ## Update ## ############################################## ## update the modified parameters setMethod( f = "update", signature = "ADEgS", definition = function(object, ..., plot = TRUE) { nameobj <- deparse(substitute(object, env = parent.frame())) ## object is in parent.frame() because 'update' method pattern is different with 'update' generic method pattern ## see https://stat.ethz.ch/pipermail/r-help/2008-January/152296.html slots <- list() slots$names <- names(object) slots$positions <- object@positions ## extract specific slots used in function call pattern <- c("names", "positions") lpattern <- as.list(rep("", length(pattern))) names(lpattern) <- pattern ## sort parameters sep <- separation(..., pattern = lpattern) slots <- modifyList(slots, sep[[1]], keep.null = TRUE) sep[[2]] <- sortparamADEgS(sep[[2]], graphsnames = slots$names) ADEglist <- sapply(1:length(object@ADEglist), FUN = function(x) {if (inherits(object@ADEglist[[x]], "ADEg") | inherits(object@ADEglist[[x]], "ADEgS")) update(object@ADEglist[[x]], plot = FALSE, sep[[2]][[x]]) else do.call("update", c(list(object = object@ADEglist[[x]]), sep[[2]][[x]]))}) object <- new("ADEgS", ADEglist = ADEglist, positions = slots$positions, add = object@add, Call = match.call()) names(object) <- slots$names if (plot) print(object) assign(nameobj, object, envir = parent.frame(n = 2)) ## see also https://stat.ethz.ch/pipermail/r-help/2008-January/152296.html assign("currentadeg", object, envir = .ADEgEnv) }) ############################################## ## Display ## ############################################## setMethod( f = "show", signature = "ADEgS", definition = function(object) { print(object) }) setMethod( f = "plot", signature = c("ADEgS", "ANY"), definition = function(x, y) { print(x) }) setMethod( f = "print", signature = "ADEgS", definition = function(x, closeViewport = TRUE, square = NULL) { oldtextcex <- trellis.par.get("fontsize")$text oldpointcex <- trellis.par.get("fontsize")$points oldmarginH <- trellis.par.get("layout.heights") oldmarginW <- trellis.par.get("layout.widths") trellis.par.set(layout.heights = list(top.padding = .2 + oldmarginH$top.padding, bottom.padding = .2 + oldmarginH$bottom.padding), layout.widths = list(left.padding = .2 + oldmarginW$left.padding, right.padding = .2 + oldmarginW$right.padding)) on.exit(trellis.par.set(list("fontsize" = list("text" = oldtextcex, "points" = oldpointcex), "layout.widths" = list("left.padding" = oldmarginW$left.padding, "right.padding" = oldmarginW$right.padding), "layout.heights" = list("top.padding" = oldmarginH$top.padding, "bottom.padding" = oldmarginH$bottom.padding)))) gettextsize <- function(widG, heigG) { ## Adjust text size to viewport size if (widG < 1 / 2 || heigG < 1 / 2) return(0.66 / 1.25) if (widG == 1 / 2 && heigG == 1 / 2) return(0.83 / 1.25) if (widG == 1 && heigG == 1) return(1) else return(1 / 1.25) } getxscale <- function(object) { ## Obtain limits for x res <- c(0, 1) if (inherits(object, "ADEg")) object <- gettrellis(object) if (inherits(object, "trellis")) { if (is.numeric(object$x.limits)) res <- object$x.limits } return(res) } getyscale <- function(object) { ## Obtain limits for y res <- c(0, 1) if (inherits(object, "ADEg")) object <- gettrellis(object) if (inherits(object, "trellis")) { if (is.numeric(object$y.limits)) res <- object$y.limits } return(res) } printADEGs <- function(adegobject, closeViewport, square) { if (closeViewport) grid.newpage() positions <- adegobject@positions listG <- adegobject@ADEglist ## create the list of viewport and push it unit.vpL <- "npc" if (isTRUE(square)) unit.vpL <- "snpc" vpL <- do.call("vpList", lapply(1:length(listG), function(i) do.call("viewport", args = list(x = positions[i, 1], y = positions[i, 2], width = positions[i, 3] - positions[i, 1], height = positions[i, 4] - positions[i, 2], just = c(0, 0), name = names(listG)[i], xscale = getxscale(listG[[i]]), yscale = getyscale(listG[[i]]), default.units = unit.vpL)))) pushViewport(vpL) upViewport(0) width.root <- convertWidth(unit(1, unit.vpL), "inches", valueOnly = TRUE) height.root <- convertHeight(unit(1, unit.vpL), "inches", valueOnly = TRUE) for (i in 1:length(listG)) { object <- listG[[i]] seekViewport(names(listG)[i]) if (inherits(object, "ADEg") | inherits(object, "trellis")) { if (inherits(object, "ADEg")) trobject <- gettrellis(object) else trobject <- object square.i <- ifelse(is.null(square), !trobject$aspect.fill, square) unit.vpi <- "npc" if (isTRUE(square.i)) unit.vpi <- "snpc" vp <- viewport(x = 0, y = 0, width = 1, height = 1, just = c(0, 0), name = "current", xscale = getxscale(listG[[i]]), yscale = getyscale(listG[[i]]), default.units = unit.vpi) pushViewport(vp) width.current <- convertWidth(unit(1, unit.vpi), "inches", valueOnly = TRUE) height.current <- convertHeight(unit(1, unit.vpi), "inches", valueOnly = TRUE) ratio.width <- width.current / width.root ratio.height <- height.current / height.root cst <- gettextsize(ratio.width, ratio.height) sup <- adegobject@add[, i] trellis.par.set(list("fontsize" = list("text" = oldtextcex * cst, "points" = oldpointcex * cst))) if (any(sup == 1)) printSuperpose(g1 = object, refg = listG[[which(adegobject@add[, i] == 1)[1]]]) else print(object, newpage = FALSE) popViewport() } else if (inherits(object, "ADEgS")) { names(object) <- paste(names(listG)[i], names(object), sep = ".") printADEGs(object, closeViewport = FALSE, square = square) } else { stop(paste("Not implemented for class:", class(object), sep = " ")) } popViewport() } } printADEGs(x, closeViewport = closeViewport, square = square) assign("currentadeg", x, envir = .ADEgEnv) }) ############################################## ## Creation ## ############################################## ADEgS <- function(adeglist, positions, layout, add = NULL, plot = TRUE) { m <- matrix(0, length(adeglist), length(adeglist)) if (missing(layout) & (is.null(add) | identical(add, m)) & missing(positions)) layout <- .n2mfrow(length(adeglist)) if (missing(positions) & !missing(layout)) { if (is.list(layout)) ## in layout: width and heights informations, layout is a list positions <- do.call("layout2position", layout) else positions <- layout2position(layout, ng = length(adeglist)) } if (missing(positions)) positions <- matrix(rep(c(0, 0, 1, 1), length.out = length(adeglist) * 4), byrow = TRUE, ncol = 4) if (is.null(add)) add <- m ADEgObject <- new(Class = "ADEgS", ADEglist = adeglist, positions = positions, add = add, Call = match.call()) if (plot) print(ADEgObject) invisible(ADEgObject) } adegraphics/R/S2.label.R0000644000176200001440000000776414354572662014446 0ustar liggesusers######################################################### ### s.label ## ######################################################### setClass( Class = "S2.label", contains = "ADEg.S2" ) setMethod( f = "initialize", signature = "S2.label", definition = function(.Object, data = list(dfxy = NULL, labels = NULL, xax = 1, yax = 2, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.S2 initialize .Object@data$labels <- data$labels return(.Object) }) setMethod( f = "prepare", signature = "S2.label", definition = function(object) { name_obj <- deparse(substitute(object)) if(object@data$storeData) { labels <- object@data$labels } else { labels <- eval(object@data$labels, envir = sys.frame(object@data$frame)) } ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) ## change default for some parameters if((is.null(object@adeg.par$plabels$boxes$draw) & adegtot$plabels$optim) || (is.null(object@adeg.par$plabels$boxes$draw) & length(labels) > 1000)) adegtot$plabels$boxes$draw <- FALSE if(is.null(object@adeg.par$porigin$include) & (any(names(object@g.args) %in% c("Sp", "nbobject")))) adegtot$porigin$include <- FALSE ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "S2.label", definition = function(object, x, y) { ## draw labels if(any(object@adeg.par$ppoints$cex > 0)) panel.points(x, y, pch = object@adeg.par$ppoints$pch, cex = object@adeg.par$ppoints$cex, col = object@adeg.par$ppoints$col, alpha = object@adeg.par$ppoints$alpha, fill = object@adeg.par$ppoints$fill) if(object@data$storeData) labels <- object@data$labels else labels <- eval(object@data$labels, envir = sys.frame(object@data$frame)) if(any(object@adeg.par$plabels$cex > 0) & (!is.null(labels))) adeg.panel.label(x, y, labels, object@adeg.par$plabels) }) s.label <- function(dfxy, labels = rownames(dfxy), xax = 1, yax = 2, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters thecall <- .expand.call(match.call()) df <- try(as.data.frame(eval(thecall$dfxy, envir = sys.frame(sys.nframe() + pos))), silent = TRUE) if(inherits(df, "try-error") | is.null(thecall$dfxy)) ## non convenient dfxy argument stop("non convenient selection for dfxy (can not be converted to dataframe)") ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if((length(xax) == 1 & length(yax) == 1)) object <- multi.facets.S2(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple xax/yax") } ## multiple axes else if((length(xax) > 1 | length(yax) > 1)) { object <- multi.ax.S2(thecall) } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object if(storeData) tmp_data <- list(dfxy = dfxy, xax = xax, yax = yax, labels = labels, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(dfxy = thecall$dfxy, xax = xax, yax = yax, labels = thecall$labels, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "S2.label", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = sortparameters$g.args, Call = as.call(thecall)) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/S2.distri.R0000644000176200001440000002042014354572640014641 0ustar liggesusers########################################################################## ## s.distri ## ########################################################################## setClass( Class = "S2.distri", contains = "ADEg.S2" ) setMethod( f = "initialize", signature = "S2.distri", definition = function(.Object, data = list(dfxy = NULL, dfdistri = NULL, xax = 1, yax = 2, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) .Object@data$dfdistri <- data$dfdistri return(.Object) }) setMethod( ## prepare computations for ellipses, stars and labels f = "prepare", signature = "S2.distri", definition = function(object) { name_obj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) if(!object@data$storeData) { dfxy <- eval(object@data$dfxy, envir = sys.frame(object@data$frame)) dfdistri <- eval(object@data$dfdistri, envir = sys.frame(object@data$frame)) } else { dfxy <- object@data$dfxy dfdistri <- object@data$dfdistri } ## change default for some parameters if(is.null(colnames(dfdistri))) adegtot$plabels$cex <- 0 ## no labels if no colnames in original data if(is.null(object@adeg.par$porigin$include) & (any(names(object@g.args) %in% c("Sp", "nbobject")))) adegtot$porigin$include <- FALSE ## setting colors paramsToColor <- list(plabels = list(col = object@adeg.par$plabels$col, boxes = list(border = object@adeg.par$plabels$boxes$border)), plines = list(col = object@adeg.par$plines$col), pellipses = list(border = object@adeg.par$pellipses$border, col = object@adeg.par$pellipses$col)) if(!(is.null(object@g.args$col) || (is.logical(object@g.args$col) && !object@g.args$col))) adegtot <- modifyList(adegtot, col2adepar(ccol = object@g.args$col, pparamsToColor = paramsToColor, nnlev = NCOL(dfdistri))) ## statistics calculus object@stats$means <- t(apply(as.data.frame(dfdistri), 2, FUN = function(x) {apply(dfxy[, c(object@data$xax, object@data$yax)], 2, weighted.mean , w = x)})) if(object@g.args$ellipseSize) object@stats$covvar <- lapply(as.data.frame(dfdistri), FUN = function(x) {covwt(dfxy[, c(object@data$xax, object@data$yax)], wt = x)}) else object@stats$covvar <- NULL ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph ## compute ellipses if(object@g.args$ellipseSize > 0) { object@s.misc$ellipses <- lapply(1:nrow(object@stats$means), FUN = function(i) { .util.ellipse(object@stats$means[i, 1], object@stats$means[i, 2], vx = object@stats$covvar[[i]][1, 1], vy = object@stats$covvar[[i]][2, 2], cxy = object@stats$covvar[[i]][1, 2], coeff = object@g.args$ellipseSize) }) } ## never optimized labels for s.distri object@adeg.par$plabels$optim <- FALSE assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "S2.distri", definition = function(object, x, y) { if(object@data$storeData) dfdistri <- object@data$dfdistri else dfdistri <- eval(object@data$dfdistri, envir = sys.frame(object@data$frame)) ## ellipses if(object@g.args$ellipseSize > 0) { ellip <- object@s.misc$ellipses pellip <- object@adeg.par$pellipses pellip <- lapply(pellip, FUN = function(x) {if(is.list(x)) return(x) else rep(x, length.out = length(ellip))}) pellip$axes <- lapply(pellip$axes, FUN = function(x) {rep(x, length.out = length(ellip))}) for(group in 1:NCOL(dfdistri)) { ## for each group ell <- ellip[[group]] if(!(any(is.null(ell)))) if(!any(is.na(ell))) { panel.polygon(ell$x, ell$y, col = pellip$col[group], lwd = pellip$lwd[group], lty = pellip$lty[group], alpha = pellip$alpha[group], border = pellip$border[group]) if(pellip$axes$draw[group]) { ## axes drawing panel.segments(ell$seg1[1], ell$seg1[2], ell$seg1[3], ell$seg1[4], lwd = pellip$axes$lwd[group], lty = pellip$axes$lty[group], col = pellip$axes$col[group]) panel.segments(ell$seg2[1], ell$seg2[2], ell$seg2[3], ell$seg2[4], lwd = pellip$axes$lwd[group], lty = pellip$axes$lty[group], col = pellip$axes$col[group]) } } } } ## stars if(object@g.args$starSize > 0) { plines <- lapply(object@adeg.par$plines, FUN = function(x) {rep(x, length.out = NCOL(dfdistri))}) for(group in 1:NCOL(dfdistri)) { if(all(is.finite(object@stats$means[group, ]))) { xbase <- object@stats$means[group, 1] ybase <- object@stats$means[group, 2] xlev <- x[which(as.data.frame(dfdistri)[, group] > 0)] ylev <- y[which(as.data.frame(dfdistri)[, group] > 0)] panel.segments( x0 = xbase, y0 = ybase, x1 = xbase + object@g.args$starSize * (xlev - xbase), y1 = ybase + object@g.args$starSize * (ylev - ybase), lty = plines$lty[group], lwd = plines$lwd[group], col = plines$col[group]) } } } ## plot points if(any(object@adeg.par$ppoints$cex > 0)) { ppoints <- lapply(object@adeg.par$ppoints, function(x) rep(x, length.out = NROW(dfdistri))) if(any(is.na(ppoints$pch))) { indx <- 1:length(x) indx <- indx[- which(is.na(ppoints$pch))] panel.points(x = x[indx], y = y[indx], type = "p", pch = ppoints$pch[indx], cex = ppoints$cex[indx], col = ppoints$col[indx], alpha = ppoints$alpha[indx], fill = ppoints$fill[indx])} else panel.points(x = x, y = y, type = "p", pch = ppoints$pch, cex = ppoints$cex, col = ppoints$col, alpha = ppoints$alpha, fill = ppoints$fill) } ## plot of labels if(any(object@adeg.par$plabels$cex > 0)) { labX <- object@stats$means[, 1] labY <- object@stats$means[, 2] adeg.panel.label(x = labX, y = labY, labels = colnames(dfdistri), object@adeg.par$plabels) } }) s.distri <- function(dfxy, dfdistri, xax = 1, yax = 2, starSize = 1, ellipseSize = 1.5, col = NULL, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters (required for multiplot) thecall <- .expand.call(match.call()) df <- try(as.data.frame(eval(thecall$dfxy, envir = sys.frame(sys.nframe() + pos))), silent = TRUE) if(inherits(df, "try-error") | is.null(dfxy)) stop("dfxy, can not be converted as dataframe or is NULL") ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if((length(xax) == 1 & length(yax) == 1)) object <- multi.facets.S2(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple xax/yax") } ## multiple axes else if((length(xax) > 1 | length(yax) > 1)) { object <- multi.ax.S2(thecall) } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(ellipseSize = ellipseSize, starSize = starSize, col = col)) if(storeData) tmp_data <- list(dfxy = dfxy, dfdistri = dfdistri, xax = xax, yax = yax, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(dfxy = thecall$dfxy, dfdistri = thecall$dfdistri, xax = xax, yax = yax, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "S2.distri", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = as.call(thecall)) ## preparation of the graph prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(! add & plot) print(object) invisible(object) } adegraphics/R/ade4-kplot.R0000644000176200001440000005201613747033141015023 0ustar liggesusers"kplot.mcoa" <- function(object, xax = 1, yax = 2, which.tab = 1:nrow(object$cov2), option = c("points", "axis", "columns"), pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(object, "mcoa")) stop("Object of class 'mcoa' expected") if((xax == yax) || (object$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > object$nf) stop("Non convenient xax") if(yax > object$nf) stop("Non convenient yax") option <- match.arg(option) ## parameters management sortparameters <- sortparamADEg(...) if(option == "points") { params1 <- list() params1$adepar <- list(psub = list(text = "Reference"), plabels = list(cex = 1.25)) sortparameters1 <- modifyList(params1, sortparameters, keep.null = TRUE) ref <- do.call("s.label", c(list(dfxy = substitute(object$SynVar), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters1$adepar, sortparameters1$trellis, sortparameters1$g.args)) params2 <- list() params2$adepar <- list(plabels = list(cex = 0)) params2$g.args <- list(samelimits = FALSE) sortparameters2 <- modifyList(params2, sortparameters, keep.null = TRUE) facets1 <- substitute(object$TL[,1]) coolig <- call("as.data.frame", call("matrix", call("kronecker", rep(1,nrow(object$cov2)), substitute(as.matrix(object$SynVar))), nrow = nrow(object$Tl1), ncol = ncol(object$Tl1), dimnames = substitute(list(rownames(object$Tl1), colnames(object$Tl1))))) g1 <- do.call("s.match", c(list(dfxy1 = coolig, dfxy2 = substitute(object$Tl1), facets = facets1, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters2$adepar, sortparameters2$trellis, sortparameters2$g.args))[which.tab] ## ADEgS creation ADEglist <- c(list(ref), g1@ADEglist) nrow_lay <- floor(sqrt(length(ADEglist))) + 1 ncol_lay <- -floor(-(length(ADEglist)) / nrow_lay) lay <- matrix(c(seq(1, length(ADEglist)), rep(0, nrow_lay * ncol_lay - length(ADEglist))), nrow = nrow_lay, byrow = TRUE) obj <- new(Class = "ADEgS", ADEglist = ADEglist, positions = layout2position(lay), add = matrix(0, ncol = length(ADEglist), nrow = length(ADEglist)), Call = match.call()) names(obj) <- c("ref", names(g1)) } else if(option == "axis") { params <- list() params$adepar <- list(pbackground = list(box = FALSE), plabels = list(cex = 1.25)) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) facets2 <- substitute(object$T4[, 1]) obj <- do.call("s.corcircle", c(list(dfxy = substitute(object$Tax), facets = facets2, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$adepar, sortparameters$trellis, sortparameters$g.args))[which.tab] } else if(option == "columns") { params <- list() params$adepar <- list(plabels = list(cex = 1.25)) params$g.args <- list(samelimits = FALSE) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) facets3 <- substitute(object$TC[, 1]) obj <- do.call("s.arrow", c(list(dfxy = substitute(object$Tco), facets = facets3, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$adepar, sortparameters$trellis, sortparameters$g.args))[which.tab] } obj@Call <- match.call() if(plot) print(obj) invisible(obj) } "kplot.mfa" <- function(object, xax = 1, yax = 2, which.tab = 1:length(object$blo), traject = FALSE, permute = FALSE, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(object, "mfa")) stop("Object of class 'mfa' expected") if((xax == yax) || (object$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > object$nf) stop("Non convenient xax") if(yax > object$nf) stop("Non convenient yax") ## sort parameters for each graph graphsnames <- c("row", "col", "traj") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## parameters management params <- list() params$row <- list(plabels = list(cex = 0), ppoints = list(cex = 1.5), samelimits = FALSE) params$col <- list(psub = list(cex = 0), plabels = list(cex = 1.25)) params$traj <- list(plabels = list(cex = 0), psub = list(cex = 0)) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## prepare if(permute) { dfxy_row <- substitute(object$co) dfxy_col <- substitute(object$lisup) facets_row <- substitute(object$TC[,1]) facets_col <- substitute(object$TL[,1]) } else { dfxy_row <- substitute(object$lisup) dfxy_col <- substitute(object$co) facets_row <- substitute(object$TL[,1]) facets_col <- substitute(object$TC[,1]) } ## create g1 g1 <- do.call("s.label", c(list(dfxy = dfxy_row, facets = facets_row, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$row))[which.tab] ## prepare and create g2 if(permute) dcol <- object$lisup else dcol <- object$co k <- c(min(dcol[, xax]), max(dcol[, xax]), min(dcol[, yax]), max(dcol[, yax])) / c(g1[[1]]@g.args$xlim, g1[[1]]@g.args$ylim) dcol <- substitute(dfxy_col * 0.7 / max(k)) g2 <- do.call("s.arrow", c(list(dfxy = dcol, facets = facets_col, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$col))[which.tab] obj <- do.call("superpose", list(g1, g2)) obj@Call <- call("superpose", g1@Call, g2@Call) ## create g3 if(traject) { g3 <- do.call("s.traject", c(list(dfxy = dfxy_row, facets = facets_row, xax = xax, yax = yax, plot = FALSE, storeData = FALSE, pos = pos - 2), sortparameters$traj))[which.tab] obj <- do.call("superpose", list(obj, g3)) obj@Call <- call("superpose", obj@Call, g3@Call) } ## ADEgS creation names(obj) <- object$tab.names[which.tab] obj@Call <- match.call() if(plot) print(obj) invisible(obj) } "kplot.pta" <- function(object, xax = 1, yax = 2, which.tab = 1:nrow(object$RV), which.graph = 1:4, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(object, "pta")) stop("Object of class 'pta' expected") if((xax == yax) || (object$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(!is.numeric(which.graph) || any(which.graph < 1) || any(which.graph > 4)) stop("'which' must be in 1:4") if(xax > object$nf) stop("Non convenient xax") if(yax > object$nf) stop("Non convenient yax") ## sort parameters for each graph graphsnames <- c("axis", "row", "col", "components") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## parameters management params <- list() params$axis <- list(pbackground = list(box = FALSE), plabels = list(alpha = 1, cex = 1.25)) params$rows <- list(plabels = list(alpha = 1, cex = 1.25)) params$columns <- list(plabels = list(cex = 1.25)) params$components <- list(pbackground = list(box = FALSE), plabels = list(cex = 1.25)) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) g <- as.null() adeglist <- as.null() ## creation of each individual ADEg if(1 %in% which.graph) { facets1 <- substitute(object$T4[, 1]) g1 <- do.call("s.corcircle", c(list(dfxy = substitute(object$Tax), labels = substitute(object$T4[, 2]), facets = facets1, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$axis))[which.tab] names(g1) <- paste(graphsnames[1], "_", object$tab.names, sep = "")[which.tab] g <- c(g, g1) adeglist <- c(adeglist, g1@ADEglist) } if(2 %in% which.graph) { facets2 <- substitute(object$TL[, 1]) g2 <- do.call("s.label", c(list(dfxy = substitute(object$Tli), labels = substitute(object$TL[,2]), facets = facets2, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$rows))[which.tab] names(g2) <- paste(graphsnames[2], "_", object$tab.names, sep = "")[which.tab] g <- c(g, g2) adeglist <- c(adeglist, g2@ADEglist) } if(3 %in% which.graph) { facets3 <- substitute(object$TC[, 1]) g3 <- do.call("s.arrow", c(list(dfxy = substitute(object$Tco), labels = substitute(object$TC[,2]), facets = facets3, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$columns))[which.tab] names(g3) <- paste(graphsnames[3], "_", object$tab.names, sep = "")[which.tab] g <- c(g, g3) adeglist <- c(adeglist, g3@ADEglist) } if(4 %in% which.graph) { facets4 <- substitute(object$T4[, 1]) g4 <- do.call("s.corcircle", c(list(dfxy = substitute(object$Tcomp), labels = substitute(object$T4[, 2]), facets = facets4, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$components))[which.tab] names(g4) <- paste(graphsnames[4], "_", object$tab.names, sep = "")[which.tab] g <- c(g, g4) adeglist <- c(adeglist, g4@ADEglist) } ## ADEgS creation ng <- sum(sapply(g, function(x) length(x))) lay <- matrix(1:ng, ncol = length(which.graph)) obj <- new(Class = "ADEgS", ADEglist = c(adeglist), positions = layout2position(lay), add = matrix(0, ncol = ng, nrow = ng), Call = match.call()) if(plot) print(obj) invisible(obj) } "kplot.sepan" <- function(object, xax = 1, yax = 2, which.tab = 1:length(object$blo), permute = FALSE, traject = FALSE, posieig = "bottomleft", pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(object, "sepan")) stop("Object of class 'sepan' expected") if((xax == yax) || (length(object$Eig) == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > length(object$Eig)) stop("Non convenient xax") if(yax > length(object$Eig)) stop("Non convenient yax") ## prepare if(permute) { dfxy_row <- substitute(object$Co) dfxy_col <- substitute(object$Li) names_row <- substitute(object$TC[,2]) names_col <- substitute(object$TL[,2]) facets_row <- substitute(object$TC[,1]) facets_col <- substitute(object$TL[,1]) } else { dfxy_row <- substitute(object$Li) dfxy_col <- substitute(object$Co) names_row <- substitute(object$TL[,2]) names_col <- substitute(object$TC[,2]) facets_row <- substitute(object$TL[,1]) facets_col <- substitute(object$TC[,1]) } ## sort parameters for each graph graphsnames <- c("row", "col", "traj", "eig") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## parameters management params <- list() params$row <- list(psub = list(position = "bottomright"), samelimits = FALSE) params$traj <- list(psub = list(position = "bottomright"), plabels = list(cex = 0), samelimits = FALSE) params$col <- list(psub = list(cex = 0, position = "bottomright"), plabels = list(cex = 1.25)) params$eig <- list(psub = list(text = ""), pbackground = list(box = TRUE), samelimits = FALSE) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## create g1 if(!traject) g1 <- do.call("s.label", c(list(dfxy = dfxy_row, labels = names_row, facets = facets_row, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$row))[which.tab] else g1 <- do.call("s.traject", c(list(dfxy = dfxy_row, facets = facets_row, xax = xax, yax = yax, plot = FALSE, storeData = FALSE, pos = pos - 2), sortparameters$traj))[which.tab] ## prepare and create g2 if(permute) dcol <- object$Li else dcol <- object$Co k <- c(min(dcol[, xax]), max(dcol[, xax]), min(dcol[, yax]), max(dcol[, yax])) / c(g1[[1]]@g.args$xlim, g1[[1]]@g.args$ylim) dcol <- substitute(dfxy_col * 0.7 / max(k)) g2 <- do.call("s.arrow", c(list(dfxy = dcol, labels = names_col, facets = facets_col, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$col))[which.tab] obj <- do.call("superpose", list(g1, g2)) obj@Call <- call("superpose", g1@Call, g2@Call) ## prepare and create g3 facets_eig <- reorder(as.factor(rep(levels(object$TL[, 1]), object$rank)), rep(1:length(object$rank), object$rank)) if(!any(posieig == "none")) { g3 <- do.call("plotEig", c(list(eigvalue = substitute(object$Eig), nf = 1:ncol(object$Li), facets = facets_eig, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$eig))[which.tab] obj <- do.call("insert", list(g3, obj, posi = posieig, plot = FALSE, ratio = 0.2, inset = 0, dispatch = TRUE)) } ## ADEgS creation names(obj) <- object$tab.names[which.tab] obj@Call <- match.call() if(plot) print(obj) invisible(obj) } "kplotsepan.coa" <- function(object, xax = 1, yax = 2, which.tab = 1:length(object$blo), permute = FALSE, posieig = "bottomleft", pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(object, "sepan")) stop("Object of class 'sepan' expected") if((xax == yax) || (length(object$Eig) == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > length(object$Eig)) stop("Non convenient xax") if(yax > length(object$Eig)) stop("Non convenient yax") ## prepare if(permute) { dfxy_row <- substitute(object$C1) dfxy_col <- substitute(object$Li) names_row <- substitute(object$TC[,2]) names_col <- substitute(object$TL[,2]) facets_row <- substitute(object$TC[,1]) facets_col <- substitute(object$TL[,1]) } else { dfxy_row <- substitute(object$Li) dfxy_col <- substitute(object$C1) names_row <- substitute(object$TL[,2]) names_col <- substitute(object$TC[,2]) facets_row <- substitute(object$TL[,1]) facets_col <- substitute(object$TC[,1]) } ## sort parameters for each graph graphsnames <- c("row", "col", "eig") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## parameters management params <- list() params$col <- list(psub = list(position = "bottomright"), plabels = list(cex = 1.25), samelimits = FALSE) params$row <- list(psub = list(cex = 0, position = "bottomright")) params$eig <- list(psub = list(text = ""), pbackground = list(box = TRUE)) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation and create g1 and g2 g1 <- do.call("s.label", c(list(dfxy = dfxy_col, labels = names_col, facets = facets_col, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$col))[which.tab] g2 <- do.call("s.label", c(list(dfxy = dfxy_row, labels = names_row, facets = facets_row, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$row))[which.tab] obj <- do.call("superpose", c(list(g1, g2))) obj@Call <- call("superpose", g1@Call, g2@Call) ## prepare and create g3 facets_eig <- reorder(as.factor(rep(levels(object$TL[, 1]), object$rank)), rep(1:length(object$rank), object$rank)) if(!any(posieig == "none")) { g3 <- do.call("plotEig", c(list(eigvalue = substitute(object$Eig), nf = 1:ncol(object$Li), facets = facets_eig, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$eig))[which.tab] obj <- do.call("insert", list(g3, obj, posi = posieig, plot = FALSE, ratio = 0.2, inset = 0, dispatch = TRUE)) } ## ADEgS creation names(obj) <- object$tab.names[which.tab] obj@Call <- match.call() if(plot) print(obj) invisible(obj) } "kplot.statis" <- function(object, xax = 1, yax = 2, which.tab = 1:length(object$tab.names), traject = FALSE, arrow = TRUE, class = NULL, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(object, "statis")) stop("Object of class 'statis' expected") if((xax == yax) || (object$C.nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > object$C.nf) stop("Non convenient xax") if(yax > object$C.nf) stop("Non convenient yax") ## sort parameters for each graph graphsnames <- c("col", "traj", "class") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## parameters management params <- list() params$col <- list(plabels = list(cex = 1.25)) params$traj <- list(plabels = list(cex = 0), psub = list(cex = 0)) params$class <- list(plabels = list(cex = 1.5), ppoints = list(cex = 2), pellipses = list(alpha = 0, axes = list(draw = FALSE)), psub = list(cex = 0)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## prepare facets <- substitute(object$TC[, 1]) ## creation of each individual ADEg if(arrow) g1 <- do.call("s.arrow", c(list(dfxy = substitute(object$C.Co), facets = facets, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$col))[which.tab] else g1 <- do.call("s.label", c(list(dfxy = substitute(object$C.Co), xax = xax, yax = yax, facets = facets, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$col))[which.tab] if(traject) { g2 <- do.call("s.traject", c(list(dfxy = substitute(object$C.Co), xax = xax, yax = yax, facets = facets, plot = FALSE, storeData = FALSE, pos = pos - 2), sortparameters$traj))[which.tab] obj <- do.call("superpose", list(g1, g2)) obj@Call <- call("superpose", g1@Call, g2@Call) } else obj <- g1 if(!is.null(class)) { if(length(class) == 1) { if(class) g3 <- do.call("s.class", c(list(dfxy = substitute(object$C.Co), fac = object$TC[, 1], xax = xax, yax = yax, facets = facets, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$class))[which.tab] } else { if(length(class) == length(object$TC[, 1])) g3 <- do.call("s.class", c(list(dfxy = substitute(object$C.Co), fac = factor(class), xax = xax, yax = yax, facets = facets, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$class))[which.tab] } obj <- do.call("superpose", list(obj, g3)) obj@Call <- call("superpose", g3@Call, obj@Call) } ## ADEgS creation names(obj) <- object$tab.names[which.tab] obj@Call <- match.call() if(plot) print(obj) invisible(obj) } "kplot.foucart" <- function(object, xax = 1, yax = 2, which.tab = 1:length(object$blo), pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(object, "foucart")) stop("Object of class 'foucart' expected") if((xax == yax) || (object$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > object$nf) stop("Non convenient xax") if(yax > object$nf) stop("Non convenient yax") ## sort parameters for each graph graphsnames <- c("row", "col") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## limits calcul df <- rbind(as.matrix(object$li), as.matrix(object$Tli), as.matrix(object$Tco)) adegtot <- adegpar() lim.global <- setlimits2D(minX = min(df[, xax]), maxX = max(df[, xax]), minY = min(df[, yax]), maxY = max(df[, yax]), origin = adegtot$porigin$origin, aspect.ratio = adegtot$paxes$aspectratio, includeOr = adegtot$porigin$include) ## parameters management params <- list() params$row <- list(plabels = list(cex = 1), xlim = lim.global$xlim, ylim = lim.global$ylim, plabels = list(cex = 1.25)) params$col <- list(plabels = list(cex = 1.25), psub = list(text = ""), xlim = lim.global$xlim, ylim = lim.global$ylim, plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s.label", c(list(dfxy = substitute(object$Tli), facets = substitute(object$TL[, 1]), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$row))[which.tab] g2 <- do.call("s.label", c(list(dfxy = substitute(object$Tco), facets = substitute(object$TC[, 1]), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$col))[which.tab] ## ADEgS creation obj <- do.call("superpose", list(g1, g2)) names(obj) <- object$tab.names obj@Call <- match.call() if(plot) print(obj) invisible(obj) } "kplot.mbpcaiv" <- function(object, xax = 1, yax = 2, which.tab = 1:length(object$blo), pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(object, "mbpcaiv")) stop("Object of class 'mbpcaiv' expected") if((xax == yax) || (object$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > object$nf) stop("Non convenient xax") if(yax > object$nf) stop("Non convenient yax") sortparameters <- sortparamADEg(...) obj <- do.call("s.label", c(list(dfxy = substitute(object$Tli), xax = xax, yax = yax, facets = substitute(object$TL[, 1]), plot = plot, storeData = storeData, pos = pos - 2), adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = sortparameters$g.args))[which.tab] obj@Call <- match.call() if(plot) print(obj) invisible(obj) } adegraphics/R/C1.hist.R0000644000176200001440000001216713742303021014263 0ustar liggesuserssetClass( Class = "C1.hist", contains = "ADEg.C1" ) setMethod( f = "initialize", signature = "C1.hist", definition = function(.Object, data = list(score = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.C1 initialize validObject(.Object) return(.Object) }) setMethod( f = "prepare", signature = "C1.hist", definition = function(object) { nameobj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) ## check if the input data is an histogram or not isHist <- ifelse(inherits(object@data$score, "histogram"), TRUE, FALSE) if(object@data$storeData) score <- object@data$score else score <- eval(object@data$score, envir = sys.frame(object@data$frame)) if(isHist) { h <- object@data$score object@data$score <- runif(100, min = object@g.args$xlim[1], max = object@g.args$xlim[2]) } else { score <- as.matrix(score)[, 1] ## to manage 'score' when it is a data.frame with only one column } ## change default for some parameters adegtot$p1d$rug$draw <- FALSE ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph ## compute histogram if(!isHist) h <- hist(score, breaks = if(is.null(object@g.args$breaks)) object@g.args$nclass else object@g.args$breaks, right = object@g.args$right, plot = FALSE) y <- switch(object@g.args$type, count = h$counts, percent = 100 * h$counts / length(score), density = h$density) object@stats$heights <- y object@stats$breaks <- h$breaks if(object@adeg.par$p1d$horizontal && is.null(object@g.args$ylim)) object@g.args$ylim <- c(0, 1.1 * max(y)) if(!object@adeg.par$p1d$horizontal && is.null(object@g.args$xlim)) object@g.args$xlim <- c(0, 1.1 * max(y)) if(object@adeg.par$p1d$horizontal) object@g.args$scales$y$at <- pretty(object@g.args$ylim, n = 5) else object@g.args$scales$x$at <- pretty(object@g.args$xlim, n = 5) assign(nameobj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "C1.hist", definition = function(object, x, y) { ## Drawing hist ## y is the score ## get some parameters pscore <- object@adeg.par$p1d ppoly <- lapply(object@adeg.par$ppolygons, FUN = function(x) {rep(x, length.out = length(x))}) breaks <- object@stats$breaks heights <- object@stats$heights ## Starts the display ## depends on the parametres horizontal ## reverse and rug.draw are always considered as FALSE if(pscore$horizontal) { panel.rect(x = breaks[-length(breaks)], y = 0, height = heights, width = diff(breaks), col = ppoly$col, alpha = ppoly$alpha, border = ppoly$border, lty = ppoly$lty, lwd = ppoly$lwd, just = c("left", "bottom")) } else { panel.rect(x = 0, y = breaks[-length(breaks)], height = diff(breaks), width = heights, col = ppoly$col, alpha = ppoly$alpha, border = ppoly$border, lty = ppoly$lty, lwd = ppoly$lwd, just = c("left", "bottom")) } }) s1d.hist <- function(score, breaks = NULL, nclass = round(log2(length(score)) + 1), type = c("count", "density", "percent"), right = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters thecall <- .expand.call(match.call()) score <- eval(thecall$score, envir = sys.frame(sys.nframe() + pos)) ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if(!inherits(score, "histogram")) { if(NCOL(score) == 1) object <- multi.facets.C1(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple scores") } else { stop("Facets are not allowed with histogram data") } } ## multiple scores else if(NCOL(score) > 1) { if(!inherits(score, "histogram")) object <- multi.score.C1(thecall) else stop("Multiple scores are not allowed with histogram data") } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(type = match.arg(type), nclass = nclass, breaks = breaks, right = right)) if(storeData) tmp_data <- list(score = score, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(score = thecall$score, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "C1.hist", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = match.call()) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/S2.corcircle.R0000644000176200001440000001122214354572613015310 0ustar liggesusers########################################################################## ## s.corcircle ## ########################################################################## setClass( Class = "S2.corcircle", contains = "ADEg.S2" ) setMethod( f = "initialize", signature = "S2.corcircle", definition = function(.Object, data = list(dfxy = NULL, xax = 1, yax = 2, labels = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.S2 initialize .Object@data$labels <- data$labels return(.Object) }) setMethod( f = "prepare", signature = "S2.corcircle", definition = function(object) { name_obj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) ## prepare grid getgrid <- function(nbgrid = 10) { cgrid <- signif(2 / nbgrid, 2) h0 <- c(rev(seq(0, -1, by = -cgrid)), seq(0 + cgrid, 1, by = cgrid)) ## force that 0 is represented by the grid cgrid <- diff(h0)[1] coord <- rep(0, length(h0)) for(i in 1:length(h0)) coord[i] <- sqrt(1 - h0[i] * h0[i]) return(list(x0 = c(h0, -coord), x1 = c(h0, coord), y0 = c(-coord, h0), y1 = c(coord, h0), d = cgrid)) } ## change default for some parameters if(adegtot$pgrid$draw || adegtot$paxes$draw) object@s.misc$backgrid <- getgrid(adegtot$pgrid$nint) if(is.null(object@adeg.par$ppoints$cex)) adegtot$ppoints$cex <- 0 ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph ## never optimized labels for s.corcircle object@adeg.par$plabels$optim <- FALSE assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "S2.corcircle", definition = function(object, x, y) { panel.arrows(x0 = 0, y0 = 0, y1 = y, x1 = x, angle = object@adeg.par$parrows$angle, length = object@adeg.par$parrows$length, ends = object@adeg.par$parrows$end, lwd = object@adeg.par$plines$lwd, col = object@adeg.par$plines$col, lty = object@adeg.par$plines$lty) ## labels and boxes plabels <- object@adeg.par$plabels pos <- .textpos(x, y, origin = c(0, 0)) if(object@data$storeData) labels <- object@data$labels else labels <- eval(object@data$labels, envir = sys.frame(object@data$frame)) test <- .textsize(labels, plabels) w <- test$w h <- test$h adeg.panel.label(x = x + pos[1, ] * w / 2, y = y + pos[2, ] * h / 2, labels = labels, plabels = plabels) }) s.corcircle <- function(dfxy, xax = 1, yax = 2, labels = row.names(as.data.frame(dfxy)), fullcircle = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters (required for multiplot) thecall <- .expand.call(match.call()) df <- try(as.data.frame(eval(thecall$dfxy, envir = sys.frame(sys.nframe() + pos))), silent = TRUE) if(inherits(df, "try-error") | is.null(thecall$dfxy)) ## non convenient dfxy argument stop("non convenient selection for dfxy (can not be converted to dataframe)") ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if((length(xax) == 1 & length(yax) == 1)) object <- multi.facets.S2(thecall, sortparameters$adepar) else stop("Facets are not allowed with multiple xax/yax") } ## multiple axes else if((length(xax) > 1 | length(yax) > 1)) { object <- multi.ax.S2(thecall) } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(fullcircle = fullcircle)) if(storeData) tmp_data <- list(dfxy = dfxy, xax = xax, yax = yax, labels = labels, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(dfxy = thecall$dfxy, xax = xax, yax = yax, labels = thecall$labels, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "S2.corcircle", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = as.call(thecall)) ## preparation of the graph prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(! add & plot) print(object) invisible(object) } adegraphics/R/s.Spatial.R0000644000176200001440000001246713742303021014713 0ustar liggesuserss.Spatial <- function(spObj, col = TRUE, nclass = 5, scale = TRUE, plot = TRUE, storeData = TRUE, pos = -1, ...) { oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) sortparameters <- sortparamADEg(...) adegtot <- adegpar(sortparameters$adepar) xy.spObj <- coordinates(spObj)[, , drop = FALSE] ## to access 'coordinates' in the 'imports' environment of 'adegraphics' ## different cases (data or not, points or polygons) ## s.value is used for points with numeric data ## s.class is used for points with factor data ## s.label in other cases nvar <- 0 if(length(grep("DataFrame", class(spObj))) > 0) nvar <- ncol(spObj) points.or.poly <- ifelse(length(grep("Poly", class(spObj))) > 0, "poly", "points") ## default values for parameters defaultpar <- list(pgrid = list(draw = FALSE), porigin = list(include = FALSE), plegend = list(drawKey = ifelse(nvar == 1, TRUE, FALSE)), psub = list(position = "topleft")) sortparameters$adepar <- modifyList(defaultpar, sortparameters$adepar, keep.null = TRUE) ## limits management limsSp <- bbox(spObj) lim.global <- setlimits2D(minX = limsSp[1, 1], maxX = limsSp[1, 2], minY = limsSp[2, 1], maxY = limsSp[2, 2], includeOr = FALSE) if(is.null(sortparameters$g.args$xlim)) sortparameters$g.args$xlim <- lim.global$xlim if(is.null(sortparameters$g.args$ylim)) sortparameters$g.args$ylim <- lim.global$ylim if(nvar == 0){ if(is.logical(col)){ if(col) colnew <- adegtot$pSp$col else colnew <- "transparent" ## col == FALSE } else { colnew <- col } sortparameters$adepar$pSp$col <- colnew sortparameters$adepar$ppoint$cex <- 0 ## create map if(points.or.poly == "points") object <- do.call("s.label", c(list(dfxy = xy.spObj, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$adepar, sortparameters$trellis, sortparameters$g.args, sortparameters$rest)) else object <- do.call("s.label", c(list(dfxy = xy.spObj, Sp = substitute(spObj), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$adepar, sortparameters$trellis, sortparameters$g.args, sortparameters$rest)) } else if(nvar > 0) { listGraph <- list() for(i in 1:nvar) { defaultpar <- list(psub = list(text = names(spObj)[i]), plabels = list(cex = 0)) adepar.i <- modifyList(defaultpar, sortparameters$adepar, keep.null = TRUE) if(points.or.poly == "points" & is.numeric(spObj@data[, i])){ ## points and numeric -> s.value if(is.logical(col)) colnew <- NULL ## default in s.value else colnew <- col listGraph <- c(listGraph, do.call("s.value", c(list(dfxy = xy.spObj, z = if(scale) scale (spObj@data[, i]) else spObj@data[, i], plot = FALSE, col = colnew, storeData = storeData, pos = pos - 2), adepar.i, sortparameters$trellis, sortparameters$g.args, sortparameters$rest))) } else if(points.or.poly == "points" & is.factor(spObj@data[, i])) { if(is.logical(col)) colnew <- adegtot$ppalette$quali(nlevels(as.factor(spObj@data[, i]))) adepar.i <- modifyList(list(ppoints = list(cex = 2)), adepar.i , keep.null = TRUE) listGraph <- c(listGraph, do.call("s.class", c(list(dfxy = xy.spObj, starSize = 0, ellipseSize = 0, fac = spObj@data[, i], plot = FALSE, col = colnew, storeData = storeData, pos = pos - 2), adepar.i, sortparameters$trellis, sortparameters$g.args, sortparameters$rest))) } else { if(is.logical(col)) { if(col) { if(is.numeric(spObj@data[, i])) { nclasspretty <- length(pretty(spObj@data[, i], nclass)) - 1 nclasspretty <- length(pretty(spObj@data[, i], nclasspretty)) - 1 ## repeated in order to have always the same number of class colnew <- adegtot$ppalette$quanti(nclasspretty) } else colnew <- adegtot$ppalette$quali(nlevels(as.factor(spObj@data[, i])))[as.factor(spObj@data[, i])] } } else { colnew <- col } adepar.i$pSp$col <- colnew adepar.i$ppoint$cex <- 0 ## create map listGraph <- c(listGraph, do.call("s.label", c(list(dfxy = xy.spObj, Sp = substitute(spObj[,i]), plot = FALSE, storeData = storeData, pos = pos - 2), adepar.i, sortparameters$trellis, sortparameters$g.args, sortparameters$rest))) } } if(nvar == 1) object <- listGraph[[1]] else { names(listGraph) <- names(spObj) posmatrix <- layout2position(.n2mfrow(nvar), ng = nvar) object <- new(Class = "ADEgS", ADEglist = listGraph, positions = posmatrix, add = matrix(0, ncol = nvar, nrow = nvar), Call = match.call()) } } if(plot) print(object) invisible(object) } adegraphics/R/S2.match.R0000644000176200001440000001254614354572056014452 0ustar liggesusers######################################################### ### s.match ## ######################################################### ## in S2.match, the two data set are combined (using rbind) and kept as the same one... ## We know that the two data sets have the same row number, so we can easily retrieve and distinguish the two set (the first (nrow/2) rows are from dfxy1 the rest from dfxy2 setClass( Class = "S2.match", contains = "ADEg.S2" ) setMethod( f = "initialize", signature = "S2.match", definition = function(.Object, data = list(dfxy = NULL, xax = 1, yax = 2, labels = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.S2 initialize .Object@data$labels <- data$labels return(.Object) }) setMethod( f = "prepare", signature = "S2.match", definition = function(object) { name_obj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) ## change default for some parameters if(!object@g.args$arrows) adegtot$parrows$angle <- 0 else if(is.null(object@adeg.par$parrows$angle) || (object@adeg.par$parrows$angle == 0)) adegtot$parrows$angle <- oldparamadeg$parrows$angle if(is.null(object@adeg.par$porigin$include) & (any(names(object@g.args) %in% c("Sp", "nbobject")))) adegtot$porigin$include <- FALSE ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph ## never optimized labels for s.match object@adeg.par$plabels$optim <- FALSE assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "S2.match", definition = function(object, x, y) { n <- length(x) / 2 if(length(x) %% 2) ## x non multiple de 2 stop("error in spanel, not finding two datasets with equal row numbers please see with dev") ## arrows from dfxy to dfxy2 panel.arrows(x0 = x[1:n], y0 = y[1:n] , y1 = y[n + 1:(2 * n)], x1 = x[n + 1:(2 * n)], angle = object@adeg.par$parrows$angle, length = object@adeg.par$parrows$length, ends = object@adeg.par$parrows$end, lwd = object@adeg.par$plines$lwd, col = object@adeg.par$plines$col, lty = object@adeg.par$plines$lty) do.call("panel.points", c(list(x = x[1:n], y = y[1:n]), object@adeg.par$ppoints)) ## dessins labels if(any(object@adeg.par$plabels$cex > 0)) { xlab <- ((x[1:n] + x[(n + 1):(2 * n)]) / 2) ylab <- ((y[1:n] + y[(n + 1):(2 * n)]) / 2) if(object@data$storeData) labels <- object@data$labels else labels <- eval(object@data$labels, envir = sys.frame(object@data$frame)) adeg.panel.label(xlab, ylab ,labels, object@adeg.par$plabels) } }) ## if arrows= TRUE arrows are plotted, otherwise only the segments are drawn s.match <- function(dfxy1, dfxy2, xax = 1, yax = 2, labels = row.names(as.data.frame(dfxy1)), arrows = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters thecall <- .expand.call(match.call()) data1 <- try(as.data.frame(eval(thecall$dfxy1, envir = sys.frame(sys.nframe() + pos))), silent = TRUE) data2 <- try(as.data.frame(eval(thecall$dfxy2, envir = sys.frame(sys.nframe() + pos))), silent = TRUE) if(inherits(data1, "try-error") || inherits(data2, "try-error") || is.null(thecall$dfxy1) || is.null(thecall$dfxy2)) ## wrong conversion stop("non convenient selection for dfxy1 or dfxy2 (can not be converted to dataframe)") if(any(is.na(pmatch(colnames(data1), colnames(data2))))) stop("column names should be identical") if(any(is.na(data1))) stop("NA in first dataframe") ## TODO if(any(is.na(data2))) stop("NA in second dataframe") ## TODO if(nrow(data1) != nrow(data2)) stop("non equal row numbers") ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if((length(xax) == 1 & length(yax) == 1)) object <- multi.facets.S2(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple xax/yax") } ## multiple axes else if((length(xax) > 1 | length(yax) > 1)) { object <- multi.ax.S2(thecall) } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(arrows = arrows)) if(storeData) tmp_data <- list(dfxy = rbind(dfxy1, dfxy2), xax = xax, yax = yax, labels = labels, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(dfxy = call("rbind", thecall$dfxy1, thecall$dfxy2), xax = xax, yax = yax, labels = thecall$labels, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "S2.match", data = tmp_data , adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = as.call(thecall)) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/ade4-plot.R0000644000176200001440000031555214520213466014657 0ustar liggesusers"screeplot.dudi" <- function(x, col.kept = "grey", col = "white", pos = -1, plot = TRUE, ...) { if(!inherits(x, "dudi")) stop("Object of class 'dudi' expected") ## prepare nf <- 1:x$nf col <- rep(col, length(x$eig)) col[nf] <- col.kept ## default values for parameters sortparameters <- sortparamADEg(...) params <- list() params$adepar <- list(ppolygons = list(col = col), porigin = list(origin = c(0, 0)), pgrid = list(draw = FALSE), p1d = list(horizontal = FALSE), paxes = list(draw = TRUE, x = list(draw = FALSE))) params$g.args <- list(main = deparse(substitute(x)), xlab = "Axis", ylab = "Inertia", ylim = c(min(0, min(x$eig)), max(x$eig) * 1.1)) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## ADEg creation object <- do.call("s1d.barchart", c(list(score = substitute(x$eig), pos = pos - 2, plot = FALSE), sortparameters$adepar, sortparameters$trellis, sortparameters$g.args)) object@Call <- match.call() if(plot) print(object) invisible(object) } "biplot.dudi" <- function(x, pos = -1, plot = TRUE, ...) { if(!inherits(x, "dudi")) stop("Object of class 'dudi' expected") object <- do.call("scatter", c(list(substitute(x), pos = pos - 3, plot = FALSE, ...))) object@Call <- match.call() if(plot) print(object) invisible(object) } "plot.acm" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "dudi")) stop("Object of class 'dudi' expected") if(!inherits(x, "acm")) stop("Object of class 'acm' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") ## prepare oritab <- as.list(x$call)[[2]] ## parameter management sortparameters <- sortparamADEg(...) params <- list() params$g.args <- list(starSize = 0) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) object <- do.call("s.class", c(list(dfxy = substitute(x$li), fac = oritab, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$adepar, sortparameters$trellis, sortparameters$g.args, sortparameters$rest)) object@Call <- match.call() if(plot) print(object) invisible(object) } "plot.fca" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "dudi")) stop("Object of class 'dudi' expected") if(!inherits(x, "fca")) stop("Object of class 'fca' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") ## prepare oritab <- as.list(x$call)[[2]] evTab <- eval.parent(oritab) indica <- factor(rep(names(x$blo), x$blo)) ng <- length(levels(indica)) ## parameter management graphsnames <- as.character(levels(indica)) sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) params <- list() params <- lapply(1:length(graphsnames), function(i) {params[[i]] <- list(starSize = 0.5, ellipseSize = 0, plabels = list(cex = 1.25), psub = list(text = graphsnames[i]))}) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg l <- list() l <- sapply(1:length(levels(indica)), function(i) {do.call("s.distri", c(list(dfxy = substitute(x$l1, env = sys.frame(-3)), dfdistri = call("[", oritab, call(":", 1, nrow(evTab)), which(indica == levels(indica)[i])), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[i]]))}) ## ADEgS creation object <- new(Class = "ADEgS", ADEglist = l, positions = layout2position(.n2mfrow(ng), ng = ng), add = matrix(0, ncol = ng, nrow = ng), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.coinertia" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "coinertia")) stop("Object of class 'coinertia' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") ## sort parameters for each graph graphsnames <- c("Xax", "Yax", "eig", "XYmatch", "Yloadings", "Xloadings") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## default values for parameters params <- list() params[[1]] <- list(psub = list(text = "Unconstrained axes (X)"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[2]] <- list(psub = list(text = "Unconstrained axes (Y)"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[3]] <- list(psub = list(text = "Eigenvalues")) params[[4]] <- list(psub = list(text = "Row scores (X -> Y)")) params[[5]] <- list(psub = list(text = "Y loadings"), plabels = list(cex = 1.25)) params[[6]] <- list(psub = list(text = "X loadings"), plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## Creation of each individual ADEg g1 <- do.call("s.corcircle", c(list(dfxy = substitute(x$aX), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s.corcircle", c(list(dfxy = substitute(x$aY), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s.match", c(list(dfxy1 = substitute(x$mX), dfxy2 = substitute(x$mY), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) g5 <- do.call("s.arrow", c(list(dfxy = substitute(x$l1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[5]])) g6 <- do.call("s.arrow", c(list(dfxy = substitute(x$c1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[6]])) ## ADEgS creation lay <- matrix(c(1, 2, 3, 4, 4, 5, 4, 4, 6), 3, 3) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4, g5, g6), positions = layout2position(lay), add = matrix(0, ncol = 6, nrow = 6), Call = match.call() ) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.pcaiv" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "pcaiv")) stop("Object of class 'pcaiv' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") ## sort parameters for each graph graphsnames <- c("Xloadings", "Xcor", "eig", "XYmatch", "Yax", "Ycol") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## default values for parameters params <- list() params[[1]] <- list(psub = list(text = "X loadings"), plabels = list(cex = 1.25)) params[[2]] <- list(psub = list(text = "X correlation"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[3]] <- list(psub = list(text = "Eigenvalues")) params[[4]] <- list(psub = list(text = "Predictions (X) -> Scores (Y)")) params[[5]] <- list(psub = list(text = "Unconstrained axes (Y)"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[6]] <- list(psub = list(text = "Y columns"), plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## Creation of each individual ADEg g1 <- do.call("s.arrow", c(list(dfxy = substitute(na.omit(x$fa)), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s.corcircle", c(list(dfxy = substitute(na.omit(x$cor)), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s.match", c(list(dfxy1 = substitute(x$li), dfxy2 = substitute(x$ls), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]] )) g5 <- do.call("s.corcircle", c(list(dfxy = substitute(x$as), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[5]])) g6 <- do.call("s.arrow", c(list(dfxy = substitute(x$c1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[6]])) ## ADEgS creation lay <- matrix(c(1, 2, 3, 4, 4, 5, 4, 4, 6), 3, 3) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4, g5, g6), positions = layout2position(lay), add = matrix(0, ncol = 6, nrow = 6), Call = match.call() ) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.betcoi" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "betcoi")) stop("Object of class 'betcoi' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") appel <- as.list(x$call) fac <- eval.parent(appel$fac) ## sort parameters for each graph graphsnames <- c("Xax", "Yax", "eig", "XYmatch", "Yloadings", "Xloadings") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames, nbsubgraphs = c(1, 1, 1, 3, 1, 1)) ## compute limits for the ADEgS 'XYmatch' (two s.class and one s.match) mat <- rbind(x$msX, x$msY, x$mX) minmat <- apply(mat, 2, min) maxmat <- apply(mat, 2, max) limdefault <- setlimits2D(minmat[1], maxmat[1], minmat[2], maxmat[2], origin = c(0, 0), includeOr = TRUE) ## default values for parameters params <- list() params[[1]] <- list(psub = list(text = "Unconstrained axes (X)"), plabels = list(cex = 1.25)) params[[2]] <- list(psub = list(text = "Unconstrained axes (Y)"), plabels = list(cex = 1.25)) params[[3]] <- list(psub = list(text = "Eigenvalues")) params[[4]] <- list() params[[4]]$l1 <- list(psub = list(text = "Row scores (X -> Y)"), xlim = limdefault$xlim, ylim = limdefault$ylim, chullSize = 1, ppoints = list(pch = 16, cex = 0.5), plines = list(lwd = 1), plabels = list(alpha = 0, boxes = list(draw = FALSE)), ppolygon = list(lwd = 0.5, alpha = 0.2), pellipses = list(alpha = 0, axes = list(draw = FALSE)), col = adegpar()$ppalette$quali(nlevels(fac))) params[[4]]$l2 <- list(xlim = limdefault$xlim, ylim = limdefault$ylim, chullSize = 1, ppoints = list(pch = 15, cex = 0.5), plines = list(lwd = 1), plabels = list(alpha = 0, boxes = list(draw = FALSE)), ppolygon = list(lwd = 0.5, alpha = 0.2), pellipses = list(alpha = 0.0, axes = list(draw = FALSE)), col = adegpar()$ppalette$quali(nlevels(fac))) params[[4]]$l3 <- list(xlim = limdefault$xlim, ylim = limdefault$ylim, ppoints = list(cex = 0.7), plines = list(lwd = 2), plabels = list(alpha = 1, boxes = list(draw = TRUE), cex = 1.25)) params[[5]] <- list(psub = list(text = "Y loadings"), plabels = list(cex = 1.25)) params[[6]] <- list(psub = list(text = "X loadings"), plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s.arrow", c(list(dfxy = substitute(x$aX), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s.arrow", c(list(dfxy = substitute(x$aY), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g41 <- do.call("s.class", c(list(dfxy = substitute(x$msX), fac = appel$fac, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]][[1]])) g42 <- do.call("s.class", c(list(dfxy = substitute(x$msY), fac = appel$fac, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]][[2]])) g43 <- do.call("s.match", c(list(dfxy1 = substitute(x$mX), dfxy2 = substitute(x$mY), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]][[3]])) g4 <- do.call("superpose", list(g41, g42)) g4@Call <- call("superpose", g41@Call, g42@Call) g4 <- do.call("superpose", list(g4, g43)) g4@Call <- call("superpose", g4@Call, g43@Call) g5 <- do.call("s.arrow", c(list(dfxy = substitute(x$l1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[5]])) g6 <- do.call("s.arrow", c(list(dfxy = substitute(x$c1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[6]])) ## ADEgS creation lay <- matrix(c(1, 2, 3, 4, 4, 5, 4, 4, 6), 3, 3) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4, g5, g6), positions = layout2position(lay), add = matrix(0, ncol = 6, nrow = 6), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.betrlq" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "betrlq")) stop("Object of class 'betrlq' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") appel <- as.list(x$call) ## sort parameters for each graph graphsnames <- c("Rrow", "Qrow", "Rax", "Rloadings", "Qloadings", "Qax", "eig") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## default values for parameters params <- list() params[[1]] <- list(psub = list(text = "R row scores and classes"), plabels = list(cex = 1.25)) params[[2]] <- list(psub = list(text = "Q row scores"), plabels = list(cex = 1.25)) params[[3]] <- list(psub = list(text = "Unconstrained axes (R)"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[4]] <- list(psub = list(text = "R loadings"), plabels = list(cex = 1.25)) params[[5]] <- list(psub = list(text = "Q loadings"), plabels = list(cex = 1.25)) params[[6]] <- list(psub = list(text = "Unconstrained axes (Q)"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[7]] <- list(psub = list(text = "Eigenvalues")) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s.class", c(list(dfxy = substitute(x$lsR), fac = appel$fac, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s.label", c(list(dfxy = substitute(x$lQ), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("s.corcircle", c(list(dfxy = substitute(x$aR), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s.arrow", c(list(dfxy = substitute(x$l1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) g5 <- do.call("s.arrow", c(list(dfxy = substitute(x$c1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[6]])) g6 <- do.call("s.corcircle", c(list(dfxy = substitute(x$aQ), xax, yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[5]])) g7 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[7]])) ## ADEgS creation lay <- matrix(c(1, 1, 3, 1, 1, 4, 2, 2, 5, 2, 2, 6, 0, 0, 7), 3, 5) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4, g5, g6, g7), positions = layout2position(lay), add = matrix(0, ncol = 7, nrow = 7), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.between" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "between")) stop("Object of class 'between' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") appel <- as.list(x$call) ## sort parameters for each graph graphsnames <- c("loadings", "col", "eig", "row", "Xax", "class") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## default values for parameters params <- list() params[[1]] <- list(psub = list(text = "Loadings"), plabels = list(cex = 1.25)) params[[2]] <- list(psub = list(text = "Columns"), plabels = list(cex = 1.25)) params[[3]] <- list(psub = list(text = "Eigenvalues")) params[[4]] <- list(psub = list(text = "Row scores and classes"), plabels = list(cex = 1.25)) params[[5]] <- list(psub = list(text = "Unconstrained axes"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[6]] <- list(psub = list(text = "Classes"), plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s.arrow", c(list(dfxy = substitute(x$c1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s.arrow", c(list(dfxy = substitute(x$co), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s.class", c(list(dfxy = substitute(x$ls), wt = call("$", appel$x, "lw"), fac = appel$fac, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) g5 <- do.call("s.corcircle", c(list(dfxy = substitute(x$as), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[5]])) g6 <- do.call("s.label", c(list(dfxy = substitute(x$li), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[6]])) ## ADEgS creation lay <- matrix(c(1, 2, 3, 4, 4, 5, 4, 4, 6), 3, 3) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4, g5, g6), positions = layout2position(lay), add = matrix(0, ncol = 6, nrow = 6), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.discrimin" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "discrimin")) stop("Object of class 'discrimin' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") appel <- as.list(x$call) ## sort parameters for each graph graphsnames <- c("loadings", "col", "eig", "row", "Xax", "class") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## default values for parameters params <- list() params[[1]] <- list(psub = list(text = "Loadings"), plabels = list(cex = 1.25)) params[[2]] <- list(psub = list(text = "Columns"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[3]] <- list(psub = list(text = "Eigenvalues")) params[[4]] <- list(psub = list(text = "Row scores and classes"), plabels = list(cex = 1.25)) params[[5]] <- list(psub = list(text = "Unconstrained axes"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[6]] <- list(psub = list(text = "Classes scores"), plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s.arrow", c(list(dfxy = substitute(x$fa), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s.corcircle", c(list(dfxy = substitute(x$va), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s.class", c(list(dfxy = substitute(x$li), fac = appel$fac, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) g5 <- do.call("s.corcircle", c(list(dfxy = substitute(x$cp), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[5]])) g6 <- do.call("s.label", c(list(dfxy = substitute(x$gc), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[6]])) ## ADEgS creation lay <- matrix(c(1, 2, 3, 4, 4, 5, 4, 4, 6), 3, 3) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4, g5, g6), positions = layout2position(lay), add = matrix(0, ncol = 6, nrow = 6), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.within" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "within")) stop("Object of class 'within' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") appel <- as.list(x$call) ## sort parameters for each graph graphsnames <- c("loadings", "col", "eig", "row", "Xax", "ccrow") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## default values for parameters params <- list() params[[1]] <- list(psub = list(text = "Loadings"), plabels = list(cex = 1.25)) params[[2]] <- list(psub = list(text = "Columns"), plabels = list(cex = 1.25)) params[[3]] <- list(psub = list(text = "Eigenvalues")) params[[4]] <- list(psub = list(text = "Row scores and classes"), plabels = list(cex = 1.25)) params[[5]] <- list(psub = list(text = "Unconstrained axes"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[6]] <- list(psub = list(text = "Row scores (common centring)"), pellipses = list(axes = list(draw = FALSE)), plines = list(lwd = 0), plabels = list(alpha = 0, boxes = list(draw = FALSE), cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s.arrow", c(list(dfxy = substitute(x$c1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s.arrow", c(list(dfxy = substitute(x$co), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s.class", c(list(dfxy = substitute(x$ls), wt = substitute(x$lw), fac = appel$fac, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) g5 <- do.call("s.corcircle", c(list(dfxy = substitute(x$as), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[5]])) g6 <- do.call("s.class", c(list(dfxy = substitute(x$li), wt = substitute(x$lw), fac = appel$fac, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[6]])) ## ADEgS creation lay <- matrix(c(1, 2, 3, 4, 4, 5, 4, 4, 6), 3, 3) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4, g5, g6), positions = layout2position(lay), add = matrix(0, ncol = 6, nrow = 6), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.witcoi" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "witcoi")) stop("Object of class 'witcoi' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") appel <- as.list(x$call) fac <- eval.parent(appel$fac) ## sort parameters for each graph graphsnames <- c("Xax", "Yax", "eig", "XYmatch", "Yloadings", "Xloadings") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames, nbsubgraphs = c(1, 1, 1, 3, 1, 1)) ## compute limits for the ADEgS (two s.class and one s.match) mat <- rbind(x$msX, x$msY, x$mX) minmat <- apply(mat, 2, min) maxmat <- apply(mat, 2, max) limdefault <- setlimits2D(minmat[1], maxmat[1], minmat[2], maxmat[2], origin = c(0, 0), includeOr = TRUE) ## default values for parameters params <- list() params[[1]] <- list(psub = list(text = "Unconstrained axes (X)"), plabels = list(cex = 1.25)) params[[2]] <- list(psub = list(text = "Unconstrained axes (Y)"), plabels = list(cex = 1.25)) params[[3]] <- list(psub = list(text = "Eigenvalues")) params[[4]] <- list() params[[4]]$l1 <- list(psub = list(text = "Row scores (X -> Y)"), xlim = limdefault$xlim, ylim = limdefault$ylim, chullSize = 1, ppoints = list(pch = 16, cex = 0.5), plabels = list(alpha = 0, boxes = list(draw = FALSE)), ppolygon = list(lwd = 0.5, alpha = 0.2), pellipses = list(alpha = 0.0, axes = list(draw = FALSE)), col = adegpar()$ppalette$quali(nlevels(fac))) params[[4]]$l2 <- list(xlim = limdefault$xlim, ylim = limdefault$ylim, chullSize = 1, ppoints = list(pch = 15, cex = 0.5), plabels = list(alpha = 0, boxes = list(draw = FALSE)), ppolygon = list(lwd = 0.5, alpha = 0.2), pellipses = list(alpha = 0.0, axes = list(draw = FALSE)), col = adegpar()$ppalette$quali(nlevels(fac))) params[[4]]$l3 <- list(xlim = limdefault$xlim, ylim = limdefault$ylim, ppoints = list(cex = 0.7), plines = list(lwd = 2), plabels = list(alpha = 1, boxes = list(draw = TRUE), cex = 1.25)) params[[5]] <- list(psub = list(text = "Y loadings"), plabels = list(cex = 1.25)) params[[6]] <- list(psub = list(text = "X loadings"), plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s.arrow", c(list(dfxy = substitute(x$aX), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s.arrow", c(list(dfxy = substitute(x$aY), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g41 <- do.call("s.class", c(list(dfxy = substitute(x$msX), fac = appel$fac, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]][[1]])) g42 <- do.call("s.class", c(list(dfxy = substitute(x$msY), fac = appel$fac, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]][[2]])) g43 <- do.call("s.match", c(list(dfxy1 = g41@stats$means, dfxy2 = g42@stats$means, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]][[3]])) g4 <- do.call("superpose", list(g41, g42)) g4@Call <- call("superpose", g41@Call, g42@Call) g4 <- do.call("superpose", list(g4, g43)) g4@Call <- call("superpose", g4@Call, g43@Call) g5 <- do.call("s.arrow", c(list(dfxy = substitute(x$l1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[5]])) g6 <- do.call("s.arrow", c(list(dfxy = substitute(x$c1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[6]])) ## ADEgS creation lay <- matrix(c(1, 2, 3, 4, 4, 5, 4, 4, 6), 3, 3) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4, g5, g6), positions = layout2position(lay), add = matrix(0, ncol = 6, nrow = 6), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.witrlq" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "witrlq")) stop("Object of class 'witrlq' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") appel <- as.list(x$call) ## sort parameters for each graph graphsnames <- c("Rrow", "Qrow", "Rax", "Rloadings", "Qloadings", "Qax", "eig") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## default values for parameters params <- list() params[[1]] <- list(psub = list(text = "R row scores and classes"), plabels = list(cex = 1.25)) params[[2]] <- list(psub = list(text = "Q row scores"), plabels = list(cex = 1.25)) params[[3]] <- list(psub = list(text = "Unconstrained axes (R)"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[4]] <- list(psub = list(text = "R loadings"), plabels = list(cex = 1.25)) params[[5]] <- list(psub = list(text = "Q loadings"), plabels = list(cex = 1.25)) params[[6]] <- list(psub = list(text = "Unconstrained axes (Q)"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[7]] <- list(psub = list(text = "Eigenvalues")) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s.class", c(list(dfxy = substitute(x$lsR), fac = appel$fac, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s.label", c(list(dfxy = substitute(x$lQ), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("s.corcircle", c(list(dfxy = substitute(x$aR), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s.arrow", c(list(dfxy = substitute(x$l1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) g5 <- do.call("s.arrow", c(list(dfxy = substitute(x$c1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[6]])) g6 <- do.call("s.corcircle", c(list(dfxy = substitute(x$aQ), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[5]])) g7 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[7]])) ## ADEgS creation lay <- matrix(c(1, 1, 3, 1, 1, 4, 2, 2, 5, 2, 2, 6, 0, 0, 7), 3, 5) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4, g5, g6, g7), positions = layout2position(lay), add = matrix(0, ncol = 7, nrow = 7), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.dpcoa" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "dpcoa")) stop("Object of class 'dpcoa' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") appel <- as.list(x$call) dfX <- appel$df ## sort parameters for each graph graphsnames <- c("axes", "categories", "categcoll", "collections") vec <- c(2, 1, 1, 1) sortparameters <- sortparamADEgS(..., graphsnames = graphsnames, nbsubgraphs = vec) ## default values for parameters params <- list() params[[1]] <- list() params[[1]]$l1 <- list(psub = list(text = "Principal axes", position = "topleft"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[1]]$l2 <- list(psub = list(text = "Eigenvalues"), pbackground = list(box = TRUE)) params[[2]] <- list(psub = list(text = "Categories"), plabels = list(cex = 1.25)) params[[3]] <- list(psub = list(text = "Categories and collections"), ppoints = list(pch = 16, cex = 1.2), plines = list(col = "transparent"), pellipses = list(axes = list(draw = FALSE)), ellipseSize = 1, plabels = list(cex = 1.25)) if(!is.null(x$RaoDiv)) params[[4]] <- list(psub = list(text = "Rao Divcs", position = "topleft")) else params[[4]] <- list(psub = list(text = "Collections", position = "bottomleft")) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g11 <- do.call("s.corcircle", c(list(dfxy = substitute(x$c1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]][[1]])) g12 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]][[2]])) g1 <- do.call("insert", list(g12@Call, g11@Call, posi = "bottomleft", plot = FALSE, ratio = 0.25, inset = 0)) g2 <- do.call("s.label", c(list(dfxy = substitute(x$dls), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("s.distri", c(list(dfxy = substitute(x$dls), dfdistri = substitute(t(dfX)), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) if(!is.null(x$RaoDiv)) g4 <- do.call("s.value", c(list(dfxy = substitute(x$li), z = substitute(x$RaoDiv), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) else g4 <- do.call("s.label", c(list(dfxy = substitute(x$li), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) ## ADEgS creation object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4), positions = layout2position(matrix(c(1, 2, 3, 4), 2, 2)), add = matrix(0, ncol = 4, nrow = 4), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.betdpcoa" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!(inherits(x, "betdpcoa") | inherits(x, "betwitdpcoa"))) stop("Object of class 'betdpcoa' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") appel <- as.list(x$call) dfX <- as.list(eval.parent(appel$x)$call)$df ## sort parameters for each graph graphsnames <- c("axes", "class", "categories", "Xax") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames, nbsubgraphs = c(2, 1, 1, 1)) ## default values for parameters params <- list() params[[1]] <- list() params[[1]]$l1 <- list(psub = list(text = "Principal axes", position = "topleft"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[1]]$l2 <- list(psub = list(text = "Eigenvalues"), pbackground = list(box = TRUE)) params[[2]] <- list(psub = list(text = "Classes and collections"), plabels = list(cex = 1.25)) params[[3]] <- list(psub = list(text = "Categories and collections"), ppoints = list(pch = 16, cex = 1.2), plines = list(col = "transparent"), pellipses = list(axes = list(draw = FALSE)), ellipseSize = 1, plabels = list(cex = 1.25)) params[[4]] <- list(psub = list(text = "Unconstrained axes"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g11 <- do.call("s.corcircle", c(list(dfxy = substitute(x$c1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]][[1]])) g12 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]][[2]])) g1 <- do.call("insert", list(g12@Call, g11@Call, posi = "bottomleft", plot = FALSE, ratio = 0.25, inset = 0)) g2 <- do.call("s.class", c(list(dfxy = substitute(x$ls), fac = appel$fac, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("s.distri", c(list(dfxy = substitute(x$dls), dfdistri = substitute(t(dfX)), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s.corcircle", c(list(dfxy = substitute(x$as), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4), positions = layout2position(matrix(c(1, 2, 3, 4), 2, 2)), add = matrix(0, ncol = 4, nrow = 4), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.witdpcoa" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "witdpcoa")) stop("Object of class 'witdpcoa' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") appel <- as.list(x$call) dfX <- as.list(eval.parent(appel$x)$call)$df ## sort parameters for each graph graphsnames <- c("axes", "class", "categories", "Xax") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames, nbsubgraphs = c(2, 1, 1, 1)) ## default values for parameters params <- list() params[[1]] <- list() params[[1]]$l1 <- list(psub = list(text = "Principal axes", position = "topleft"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[1]]$l2 <- list(psub = list(text = "Eigenvalues"), pbackground = list(box = TRUE)) params[[2]] <- list(psub = list(text = "Classes and collections"), plabels = list(cex = 1.25)) params[[3]] <- list(psub = list(text = "Categories and collections"), ppoints = list(pch = 16, cex = 1.2), plines = list(col = "transparent"), pellipses = list(axes = list(draw = FALSE)), ellipseSize = 1, plabels = list(cex = 1.25)) params[[4]] <- list(psub = list(text = "Unconstrained axes"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g11 <- do.call("s.corcircle", c(list(dfxy = substitute(x$c1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]][[1]])) g12 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]][[2]])) g1 <- do.call("insert", list(g12@Call, g11@Call, posi = "bottomleft", plot = FALSE, ratio = 0.25, inset = 0)) g2 <- do.call("s.class", c(list(dfxy = substitute(x$ls), fac = appel$fac, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("s.distri", c(list(dfxy = substitute(x$dls), dfdistri = substitute(t(dfX)), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s.corcircle", c(list(dfxy = substitute(x$as), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4), positions = layout2position(matrix(c(1, 2, 3, 4), 2, 2)), add = matrix(0, ncol = 4, nrow = 4), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.betwitdpcoa" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "betwitdpcoa")) stop("Object of class 'betwitdpcoa' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") appel <- as.list(x$call) dfX <- as.list(eval.parent(appel$x)$call)$df ## sort parameters for each graph graphsnames <- c("axes", "class", "categories", "Xax") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames, nbsubgraphs = c(2, 1, 1, 1)) ## default values for parameters params <- list() params[[1]] <- list() params[[1]]$l1 <- list(psub = list(text = "Principal axes", position = "topleft"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[1]]$l2 <- list(psub = list(text = "Eigenvalues"), pbackground = list(box = TRUE)) params[[2]] <- list(psub = list(text = "Classes and collections"), plabels = list(cex = 1.25)) params[[3]] <- list(psub = list(text = "Categories and collections"), ppoints = list(pch = 16, cex = 1.2), plines = list(col = "transparent"), pellipses = list(axes = list(draw = FALSE)), ellipseSize = 1, plabels = list(cex = 1.25)) params[[4]] <- list(psub = list(text = "Unconstrained axes"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g11 <- do.call("s.corcircle", c(list(dfxy = substitute(x$c1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]][[1]])) g12 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]][[2]])) g1 <- do.call("insert", list(g12@Call, g11@Call, posi = "bottomleft", plot = FALSE, ratio = 0.25, inset = 0)) g2 <- do.call("s.class", c(list(dfxy = substitute(x$ls), fac = appel$fac, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("s.distri", c(list(dfxy = substitute(x$dls), dfdistri = substitute(t(dfX)), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s.corcircle", c(list(dfxy = substitute(x$as), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4), positions = layout2position(matrix(c(1, 2, 3, 4), 2, 2)), add = matrix(0, ncol = 4, nrow = 4), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.mcoa" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "mcoa")) stop("Object of class 'mcoa' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") ## prepare - TODO find better Call for rownames and colnames coolig <- call("as.data.frame", call("matrix", call("kronecker", rep(1, nrow(x$cov2)), substitute(as.matrix(x$SynVar))), nrow = nrow(x$Tl1), ncol = ncol(x$Tl1), dimnames = list(rownames(x$Tl1), colnames(x$Tl1)))) ## sort parameters for each graph graphsnames <- c("row", "axes", "col", "pseudoeig") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames, nbsubgraphs = c(2, 2, 1, 1)) ## default values for parameters params <- list() params[[1]] <- list() params[[1]]$l1 <- list(psub = list(text = "Rows"), parrows = list(angle = 0), plabels = list(alpha = 0, boxes = list(draw = FALSE))) params[[1]]$l2 <- list(plabels = list(cex = 1.25)) params[[2]] <- list() params[[2]]$l1 <- list(psub = list(text = "Axes (separate analyses)", position = "topleft"), pbackground = list(box = FALSE), fullcircle = FALSE, plabels = list(cex = 1.25)) params[[2]]$l2 <- list(psub = list(text = "Eigenvalues"), pbackground = list(box = TRUE)) params[[3]] <- list(psub = list(text = "Columns"), plabels = list(cex = 1.25)) params[[4]] <- list(porigin = list(include = FALSE), paxes = list(aspectratio = "fill", draw = TRUE), main = "Pseudo eigenvalues", xlab = "cov21", ylab = "cov22", plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g11 <- do.call("s.match", c(list(dfxy1 = substitute(x$Tl1), dfxy2 = coolig, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]][[1]])) g12 <- do.call("s.label", c(list(dfxy = substitute(x$SynVar), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]][[2]])) g1 <- do.call("superpose", list(g11, g12)) g1@Call <- call("superpose", g11@Call, g12@Call) g21 <- do.call("s.corcircle", c(list(dfxy = substitute(x$Tax[x$T4[, 2] == 1, ]), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]][[1]])) g22 <- do.call("plotEig", c(list(eigvalue = substitute(x$pseudoeig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]][[2]])) g2 <- do.call("insert", list(g22@Call, g21@Call, posi = "bottomleft", plot = FALSE, ratio = 0.25, inset = 0)) g3 <- do.call("s.arrow", c(list(dfxy = substitute(x$Tco), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s.label", c(list(dfxy = substitute(x$cov2), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) ## ADEgS creation lay <- matrix(c(1, 2, 3, 4), 2, 2) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4), positions = layout2position(lay), add = matrix(0, ncol = 4, nrow = 4), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.foucart" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "foucart")) stop("Object of class 'foucart' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") ## sort parameters for each graph graphsnames <- c("rowB", "colB", "row", "col") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## compute limits df <- rbind(as.matrix(x$li), as.matrix(x$co), as.matrix(x$Tli), as.matrix(x$Tco)) adegtot <- adegpar() lim.global <- setlimits2D(minX = min(df[, xax]), maxX = max(df[, xax]), minY = min(df[, yax]), maxY = max(df[, yax]), origin = adegtot$porigin$origin, aspect.ratio = adegtot$paxes$aspectratio, includeOr = adegtot$porigin$include) ## pdefault values for parameters params <- list() params[[1]] <- list(psub = list(text = "Rows (Base)"), xlim = lim.global$xlim, ylim = lim.global$ylim, plabels = list(cex = 1.25)) params[[2]] <- list(psub = list(text = "Columns (Base)"), xlim = lim.global$xlim, ylim = lim.global$ylim, plabels = list(cex = 1.25)) params[[3]] <- list(psub = list(text = "Rows"), xlim = lim.global$xlim, ylim = lim.global$ylim, pellipses = list(axes = list(draw = FALSE))) params[[4]] <- list(psub = list(text = "Columns"), xlim = lim.global$xlim, ylim = lim.global$ylim, pellipses = list(axes = list(draw = FALSE)), plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s.label", c(list(dfxy = substitute(x$li), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s.label", c(list(dfxy = substitute(x$co), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("s.class", c(list(dfxy = substitute(x$Tli), fac = substitute(x$TL[, 2]), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s.class", c(list(dfxy = substitute(x$Tco), fac = substitute(x$TC[, 2]), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) ## ADEgS creation lay <- matrix(c(1, 3, 2, 4), 2, 2) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4), positions = layout2position(lay), add = matrix(0, ncol = 4, nrow = 4), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.mfa" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "mfa")) stop("Object of class 'mfa' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") ## sort parameters for each graph graphsnames <- c("row", "comp", "col", "link") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames, nbsubgraphs = c(1, 2, 1, 1)) ## default values for parameters params <- list() params[[1]] <- list(psub = list(text = "Rows"), pellipses = list(alpha = 0, axes = list(draw = FALSE)), label = row.names(x$li), plabels = list(cex = 1.25)) params[[2]] <- list() params[[2]]$l1 <- list(psub = list(text = "Components (separate analyses)", position = "topleft"), pbackground = list(box = FALSE), fullcircle = FALSE, plabels = list(cex = 1.25)) params[[2]]$l2 <- list(psub = list(text = "Eigenvalues"), pbackground = list(box = TRUE)) params[[3]] <- list(psub = list(text = "Columns"), plabels = list(cex = 1.25)) params[[4]] <- list(porigin = list(include = FALSE), paxes = list(aspectratio = "fill", draw = TRUE), main = "Link", xlab = "Comp1", ylab = "Comp2", plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s.class", c(list(dfxy = substitute(x$lisup), fac = substitute(as.factor(x$TL[, 2])), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g21 <- do.call("s.corcircle", c(list(dfxy = substitute(x$T4comp[x$T4[, 2] == 1, ]), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]][[1]])) g22 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]][[2]])) g2 <- do.call("insert", list(g22@Call, g21@Call, posi = "bottomleft", plot = FALSE, inset = 0, ratio = 0.2)) g3 <- do.call("s.arrow", c(list(dfxy = substitute(x$co), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s.label", c(list(dfxy = substitute(x$link), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) ## ADEgS creation lay <- matrix(c(1, 2, 3, 4), 2, 2) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4), positions = layout2position(lay), add = matrix(0, ncol = 4, nrow = 4), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.multispati" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "multispati")) stop("Object of class 'multispati' expected") if((xax == yax) || ((x$nfposi + x$nfnega) == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > (x$nfposi + x$nfnega)) stop("Non convenient xax") if(yax > (x$nfposi + x$nfnega)) stop("Non convenient yax") ## sort parameters for each graph graphsnames <- c("row", "eig", "loadings", "Xax") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## default values for parameters params <- list() params[[1]] <- list(psub = list(text = "Scores and lag scores")) params[[2]] <- list(psub = list(text = "Eigenvalues"), paxes = list(draw = TRUE, x = list(draw = FALSE), y = list(draw = TRUE))) params[[3]] <- list(psub = list(text = "Loadings")) params[[4]] <- list(psub = list(text = "Unconstrained axes"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s.match", c(list(dfxy1 = substitute(x$li), dfxy2 = substitute(x$ls), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = c(1:x$nfposi, length(x$eig):(length(x$eig) - x$nfnega + 1)), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("s.arrow", c(list(dfxy = substitute(x$c1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s.corcircle",c(list(dfxy = substitute(x$as), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) ## ADEgS creation lay <- matrix(c(rep(0, 4), 2, 2, rep(1, 4), 2, 2, rep(1, 4), 3, 3, rep(1, 4), 3, 3, rep(1, 4), 4, 4, rep(0, 4), 4, 4), 6, 6) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4), positions = layout2position(lay), add = matrix(0, ncol = 4, nrow = 4), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.niche" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "niche")) stop("Object of class 'niche' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") ## sort parameters for each graph graphsnames <- c("Xax", "var", "eig", "species", "samples", "niches") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames, nbsubgraphs = c(1, 1, 1, 2, 1, 1)) ## default values for parameters params <- list() params[[1]] <- list(psub = list(text = "Unconstrained axes"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[2]] <- list(psub = list(text = "Variables"), plabels = list(cex = 1.25)) params[[3]] <- list(psub = list(text = "Eigenvalues")) params[[4]] <- list() params[[4]]$l1 <- list(psub = list(text = "Samples and Species"), plabels = list(alpha = 0, boxes = list(draw = FALSE))) params[[4]]$l2 <- list(plabels = list(cex = 1.25)) params[[5]] <- list(psub = list(text = "Samples")) params[[6]] <- list(psub = list(text = "Niches"), plines = list(col = "transparent"), pellipses = list(axes = list(draw = FALSE)), ellipseSize = 1, plabels = list(alpha = 0, boxes = list(draw = FALSE))) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s.corcircle", c(list(dfxy = substitute(x$as), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s.arrow", c(list(dfxy = substitute(x$c1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g41 <- do.call("s.label", c(list(dfxy = substitute(x$ls), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]][[1]])) g42 <- do.call("s.label", c(list(dfxy = substitute(x$li), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]][[2]])) g4 <- do.call("superpose", list(g41, g42)) g4@Call <- call("superpose", g41@Call, g42@Call) g5 <- do.call("s.label", c(list(dfxy = substitute(x$ls), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[5]])) g6 <- do.call("s.distri", c(list(dfxy = substitute(x$ls), dfdistri = as.list(x$call)[[3]], xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[6]])) ## ADEgS creation lay <- matrix(c(1, 2, 3, 4, 4, 5, 4, 4, 6), 3, 3) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4, g5, g6), positions = layout2position(lay), add = matrix(0, ncol = 6, nrow = 6), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.procuste" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "procuste")) stop("Object of class 'procuste' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") ## sort parameters for each graph graphsnames <- c("Xloadings", "Yloadings", "eig", "XYmatch", "Xrow", "Yrow") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## default values for parameters params <- list() params[[1]] <- list(psub = list(text = "X loadings"), plabels = list(cex = 1.25)) params[[2]] <- list(psub = list(text = "Y loadings"), plabels = list(cex = 1.25)) params[[3]] <- list(psub = list(text = "Eigenvalues")) params[[4]] <- list(psub = list(text = "Row scores (X -> Y)")) params[[5]] <- list(psub = list(text = "X row scores")) params[[6]] <- list(psub = list(text = "Y row scores")) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s.arrow", c(list(dfxy = substitute(x$loadX), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s.arrow", c(list(dfxy = substitute(x$loadY), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("plotEig", c(list(eigvalue = substitute(x$d^2), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s.match", c(list(dfxy1 = substitute(x$scorX), dfxy2 = substitute(x$scorY), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) g5 <- do.call("s.label", c(list(dfxy = substitute(x$scorX), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[5]])) g6 <- do.call("s.label", c(list(dfxy = substitute(x$scorY), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[6]])) ## ADEgS creation lay <- matrix(c(1, 2, 3, 4, 4, 5, 4, 4, 6), 3, 3) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4, g5, g6), positions = layout2position(lay), add = matrix(0, ncol = 6, nrow = 6), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.rlq" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "rlq")) stop("Object of class 'rlq' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") appel <- as.list(x$call) ## sort parameters for each graph graphsnames <- c("Rrow", "Qrow", "Rax", "Rloadings","Qloadings", "Qax", "eig") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## default values for parameters params <- list() params[[1]] <- list(psub = list(text = "R row scores"), plabels = list(cex = 1.25)) params[[2]] <- list(psub = list(text = "Q row scores"), plabels = list(cex = 1.25)) params[[3]] <- list(psub = list(text = "Unconstrained axes (R)"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[4]] <- list(psub = list(text = "R loadings")) params[[5]] <- list(psub = list(text = "Unconstrained axes (Q)"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[6]] <- list(psub = list(text = "Q loadings")) params[[7]] <- list(psub = list(text = "Eigenvalues")) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s.label", c(list(dfxy = substitute(x$lR), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s.label", c(list(dfxy = substitute(x$lQ), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("s.corcircle", c(list(dfxy = substitute(x$aR), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s.arrow", c(list(dfxy = substitute(x$l1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) g5 <- do.call("s.corcircle", c(list(dfxy = substitute(x$aQ), xax, yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[5]])) g6 <- do.call("s.arrow", c(list(dfxy = substitute(x$c1), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[6]])) g7 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[7]])) ## ADEgS creation lay <- matrix(c(1, 1, 3, 1, 1, 4, 2, 2, 5, 2, 2, 6, 0, 0, 7), 3, 5) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4, g6, g5, g7), positions = layout2position(lay), add = matrix(0, ncol = 7, nrow = 7), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.pta" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "pta")) stop("Object of class 'pta' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") ## prepare dfxy <- substitute(matrix(c(x$tabw, x$cos2), nrow = length(x$tabw), ncol = 2, dimnames = list(rownames(x$RV)))) ## sort parameters for each graph graphsnames <- c("inter", "col", "row", "typo") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames, nbsubgraphs = c(2, 1, 2, 1)) ## default values for parameters params <- list() params[[1]] <- list() params[[1]]$l1 <- list(psub = list(text = "Interstructure", position = "topleft"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[1]]$l2 <- list(psub = list(text = "Eigenvalues"), pbackground = list(box = TRUE), p1d = list(horizontal = FALSE)) params[[2]] <- list(psub = list(text = "Columns (compromise)", position = "topleft"), plabels = list(cex = 1.25)) params[[3]] <- list() params[[3]]$l1 <- list(psub = list(text = "Rows (compromise)", position = "topleft"), plabels = list(cex = 1.25)) params[[3]]$l2 <- list(psub = list(text = "Eigenvalues"), pbackground = list(box = TRUE), p1d = list(horizontal = FALSE)) params[[4]] <- list(porigin = list(include = FALSE), paxes = list(aspectratio = "fill", draw = TRUE), main = "Typological value", xlab = "Tables weights", ylab = "Cos 2", plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g11 <- do.call("s.corcircle", c(list(dfxy = substitute(x$RV.coo), xax = 1, yax = 2, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]]$l1)) g12 <- do.call("plotEig", c(list(eigvalue = substitute(x$RV.eig), nf = 1:length(x$RV.eig), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]]$l2)) g1 <- do.call("insert", list(g12@Call, g11@Call, posi = "bottomleft", plot = FALSE, ratio = 0.25, inset = 0)) g2 <- do.call("s.arrow", c(list(dfxy = substitute(x$co), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g31 <- do.call("s.label", c(list(dfxy = substitute(x$li), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]]$l1)) g32 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]]$l2)) g3 <- do.call("insert", list(g32@Call, g31@Call, posi = "bottomleft", plot = FALSE, ratio = 0.25, inset = 0)) g4 <- do.call("s.label", c(list(dfxy = dfxy, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) ## ADEgS creation lay <- matrix(c(1, 2, 3, 4), 2, 2) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4), positions = layout2position(lay), add = matrix(0, ncol = 4, nrow = 4), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.sepan" <- function(x, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "sepan")) stop("Object of class 'sepan' expected") ## prepare facets <- substitute(reorder(as.factor(rep(x$tab.names, x$rank)), rep(1:length(x$rank), x$rank))) ## default values for parameters sortparameters <- sortparamADEg(...) params <- list() params$adepar <- list(pbackground = list(box = TRUE), pgrid = list(draw = TRUE, text = list(cex = 0)), paxes = list(draw = TRUE, x = list(draw = FALSE))) if(isTRUE(sortparameters$adepar$p1d$horizontal)) params$g.args <- list(ylim = c(0, max(x$rank) + 1)) else params$g.args <- list(xlim = c(0, max(x$rank) + 1)) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## ADEgS creation object <- do.call("plotEig", c(list(eigvalue = substitute(x$Eig), nf = 1:ncol(x$Li), xax = 1, yax = 2, pos = pos, storeData = storeData, plot = FALSE, facets = facets), sortparameters$adepar, sortparameters$trellis, sortparameters$g.args)) object@Call <- match.call() if(plot) print(object) invisible(object) } "plot.statis" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "statis")) stop("Object of class 'statis' expected") if((xax == yax) || (x$C.nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$C.nf) stop("Non convenient xax") if(yax > x$C.nf) stop("Non convenient yax") ## prepare dfxy <- substitute(matrix(c(x$RV.tabw, x$cos2), nrow = length(x$RV.tabw), ncol = 2, dimnames = list(rownames(x$RV)))) ## sort parameters for each graph graphsnames <- c("inter", "typo", "row", "comp") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames, nbsubgraphs = c(1, 1, 2, 1)) ## default values for parameters params <- list() params[[1]] <- list(psub = list(text = "Interstructure", position = "topleft"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) params[[2]] <- list(porigin = list(include = FALSE), paxes = list(aspectratio = "fill", draw = TRUE), main = "Typological Value", xlab = "Tables Weights", ylab = "Cos 2", plabels = list(cex = 1.25)) params[[3]] <- list() params[[3]]$l1 <- list(psub = list(text = "Rows (compromise)", position = "topleft"), plabels = list(cex = 1.25)) params[[3]]$l2 <- list(psub = list(text = "Eigenvalues"), pbackground = list(box = TRUE)) params[[4]] <- list(psub = list(text = "Components (separate analyses)", position = "topleft"), pbackground = list(box = FALSE), plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s.corcircle", c(list(dfxy = substitute(x$RV.coo), xax = 1, yax = 2, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s.label", c(list(dfxy = dfxy, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g31 <- do.call("s.label", c(list(dfxy = substitute(x$C.li), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]][[1]])) g32 <- do.call("plotEig", c(list(eigvalue = substitute(x$C.eig), nf = 1:x$C.nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData), sortparameters[[3]][[2]])) g3 <- do.call("insert", list(g32@Call, g31@Call, posi = "bottomleft", plot = FALSE, ratio = 0.25, inset = 0)) g4 <- do.call("s.corcircle", c(list(dfxy = substitute(x$C.T4[x$T4[, 2] == 1, ]), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) ## ADEgS creation lay <- matrix(c(1, 2, 3, 4), 2, 2) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4), positions = layout2position(lay), add = matrix(0, ncol = 4, nrow = 4), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.multiblock" <- function(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "multiblock")) stop("Object of class 'multiblock' expected") if((xax == yax) || (x$nf == 1)) stop("One axis only : not yet implemented") if(length(xax) > 1 | length(yax) > 1) stop("Not implemented for multiple xax/yax") if(xax > x$nf) stop("Non convenient xax") if(yax > x$nf) stop("Non convenient yax") ## sort parameters for each graph graphsnames <- c("Xrow", "eig", "cov2", "Ycol", "Xloadings") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## default values for parameters params <- list() params[[1]]<- list(psub = list(text = "Row scores (X)"), plabels = list(cex = 1.25)) params[[2]]<- list(psub = list(text = "Eigenvalues")) params[[3]] <- list(psub = list(text = "Cov^2"), plabels = list(cex = 1.25)) params[[4]] <- list(psub = list(text = "Y columns"), plabels = list(cex = 1.25)) params[[5]] <- list(psub = list(text = "X loadings"), plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s.label", c(list(dfxy = substitute(x$lX), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("plotEig", c(list(eigvalue = substitute(x$eig), nf = 1:x$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("s.arrow", c(list(dfxy = substitute(x$cov2), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s.arrow", c(list(dfxy = substitute(x$Yco), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) g5 <- do.call("s.arrow", c(list(dfxy = substitute(x$faX), xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[5]])) ## ADEgS creation lay <- matrix(c(rep(c(0, 0, 2, 2, 3, 3), 2), rep(c(rep(1, 4), 4, 4), 2), rep(c(rep(1, 4), 5, 5), 2)), 6, 6) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4, g5), positions = layout2position(lay), add = matrix(0, ncol = 5, nrow = 5), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.randxval" <- function(x, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "randxval")) stop("Object of class 'randxval' expected") ## Plot results graphsnames <- c("RMSEcMean", "RMSEcQuantiles", "RMSEvMean", "RMSEvQuantiles") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## compute common limits lim <- range(x$stats) origin <- if(is.null(sortparameters[[1]]$porigin)) list(origin = 0, include = FALSE) else sortparameters[[1]]$porigin lim <- setlimits1D(lim[1], lim[2], origin = origin$origin[1], includeOr = origin$include) ## default values for parameters params <- list() params[[1]] <- list(plines = list(col = "red"), ppoints = list(col = "red", cex = 2), p1d = list(horizontal = FALSE), paxes = list(draw = TRUE), pgrid = list(text = list(cex = 0)), ylab = "Root Mean Square Error", ylim = lim, porigin = origin) params[[2]] <- list(plines = list(col = "red"), ppolygons = list(col = "red"), p1d = list(horizontal = FALSE), paxes = list(draw = TRUE), pgrid = list(text = list(cex = 0)), method = "bars") params[[3]] <- list(plines = list(col = "blue"), ppoints = list(col = "blue", cex = 2), p1d = list(horizontal = FALSE), paxes = list(draw = TRUE), pgrid = list(text = list(cex = 0))) params[[4]] <- list(plines = list(col = "blue"), ppolygons = list(col = "blue"), p1d = list(horizontal = FALSE), paxes = list(draw = TRUE), pgrid = list(text = list(cex = 0)), method = "bars") names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s1d.curve", c(list(score = substitute(x$stats[1, 1]), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s1d.interval", c(list(score1 = substitute(x$stats[1, 2]), score2 = substitute(x$stats[1, 3]), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("s1d.curve", c(list(score = substitute(x$stats[2, 1]), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s1d.interval", c(list(score1 = substitute(x$stats[2, 2]), score2 = substitute(x$stats[2, 3]), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) ## ADEgS creation add.mat <- matrix(0, nrow = 4, ncol = 4) add.mat[upper.tri(add.mat)] <- 1 object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4), positions = matrix(rep(c(0, 0, 1, 1), 4), nrow = 4, byrow = TRUE), add = add.mat, Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.krandxval" <- function(x, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "krandxval")) stop("Object of class 'krandxval' expected") ## Plot results graphsnames <- c("RMSEcMean", "RMSEcQuantiles", "RMSEvMean", "RMSEvQuantiles") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## compute common limits lim <- range(x$statsRMSEc[, -1], x$statsRMSEv[, -1]) origin <- if(is.null(sortparameters[[1]]$porigin)) list(origin = 0, include = FALSE) else sortparameters[[1]]$porigin lim <- setlimits1D(lim[1], lim[2], origin = origin$origin[1], includeOr = origin$include) ## default values for parameters params <- list() params[[1]] <- list(plines = list(col = "red"), ppoints = list(col = "red", cex = 2), p1d = list(horizontal = FALSE), paxes = list(draw = TRUE), pgrid = list(text = list(cex = 0)), ylab = "Root Mean Square Error", ylim = lim, porigin = origin) params[[2]] <- list(plines = list(col = "red"), ppolygons = list(col = "red"), p1d = list(horizontal = FALSE), paxes = list(draw = TRUE), pgrid = list(text = list(cex = 0)), method = "area") params[[3]] <- list(plines = list(col = "blue"), ppoints = list(col = "blue", cex = 2), p1d = list(horizontal = FALSE), paxes = list(draw = TRUE), pgrid = list(text = list(cex = 0))) params[[4]] <- list(plines = list(col = "blue"), ppolygons = list(col = "blue"), p1d = list(horizontal = FALSE), paxes = list(draw = TRUE), pgrid = list(text = list(cex = 0)), method = "area") names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s1d.curve", c(list(score = substitute(x$statsRMSEc[, 1]), key = list(corner = c(0,1), text = list(c("RMSEc", "RMSEv"), col = c(sortparameters[[1]]$plines$col, sortparameters[[3]]$plines$col))), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s1d.interval", c(list(score1 = substitute(x$statsRMSEc[, 2]), score2 = substitute(x$statsRMSEc[, 3]), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g3 <- do.call("s1d.curve", c(list(score = substitute(x$statsRMSEv[, 1]), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]])) g4 <- do.call("s1d.interval", c(list(score1 = substitute(x$statsRMSEv[, 2]), score2 = substitute(x$statsRMSEv[, 3]), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[4]])) ## ADEgS creation add.mat <- matrix(0, nrow = 4, ncol = 4) add.mat[upper.tri(add.mat)] <- 1 object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3, g4), positions = matrix(rep(c(0, 0, 1, 1), 4), nrow = 4, byrow = TRUE), add = add.mat, Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.randboot" <- function(x, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "randboot")) stop("Object of class 'randboot' expected") ## Plot results graphsnames <- c("obs", "quantiles") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## compute common limits lim <- range(c(x$obs, x$stats)) origin <- if(is.null(sortparameters[[1]]$porigin)) list(origin = 0, include = FALSE) else sortparameters[[1]]$porigin lim <- setlimits1D(lim[1], lim[2], origin = origin$origin[1], includeOr = origin$include) ## default values for parameters params <- list() params[[1]] <- list(p1d = list(horizontal = FALSE), paxes = list(draw = TRUE), pgrid = list(text = list(cex = 0)), ppoints = list(cex = 2), ylim = lim, porigin = origin) params[[2]] <- list(p1d = list(horizontal = FALSE), paxes = list(draw = TRUE), pgrid = list(text = list(cex = 0)), method = "bars") names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## creation of each individual ADEg g1 <- do.call("s1d.curve", c(list(score = substitute(x$obs), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s1d.interval", c(list(score1 = substitute(x$stats[1]), score2 = substitute(x$stats[2]), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) ## ADEgS creation object <- superpose(g1, g2) object@Call <- match.call() names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.krandboot" <- function(x, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "krandboot")) stop("Object of class 'krandboot' expected") ## Plot results graphsnames <- c("obs", "quantiles") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## compute common limits lim <- range(c(x$obs, range(x$stats))) origin <- if(is.null(sortparameters[[1]]$porigin)) list(origin = 0, include = FALSE) else sortparameters[[1]]$porigin lim <- setlimits1D(lim[1], lim[2], origin = origin$origin[1], includeOr = origin$include) ## default values for parameters params <- list() params[[1]] <- list(p1d = list(horizontal = FALSE), pgrid = list(text = list(cex = 0)), paxes = list(draw = TRUE), ppoints = list(cex = 2), ylim = lim, porigin = origin) params[[2]] <- list(p1d = list(horizontal = FALSE), pgrid = list(text = list(cex = 0)), paxes = list(draw = TRUE), method = "bars") names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) lab <- list(list(labels = rownames(x$stats), at = 1:length(rownames(x$stats)), rot = 90)) names(lab)[1] <- ifelse(sortparameters[[1]]$p1d$horizontal == FALSE, "x", "y") ## creation of each individual ADEg g1 <- do.call("s1d.curve", c(list(score = substitute(x$obs), scales = lab, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s1d.interval", c(list(score1 = substitute(x$stats[, 1]), score2 = substitute(x$stats[, 2]), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) ## ADEgS creation object <- superpose(g1, g2) object@Call <- match.call() names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.inertia" <- function(x, xax = 1, yax = 2, threshold = 0.1, contrib = c("abs", "rel"), type = c("label", "cross", "ellipse", "both"), ellipseSize = 1.5, posieig = "none", plot = TRUE, storeData = TRUE, pos = -1, ...) { if(!inherits(x, "inertia")) stop("Object of class 'inertia' expected") ## data management ori <- as.list(x$call) evTab <- eval.parent(ori[[2]]) if(length(xax) > 1) stop("Not implemented for multiple xax") if(xax > evTab$nf) stop("Non convenient xax") if(length(yax) > 1) stop("Not implemented for multiple yax") if(yax > evTab$nf) stop("Non convenient yax") adegtot <- adegpar() position <- .getposition(posieig[1:min(2, length(posieig))]) type <- match.arg(type)[1] contrib <- match.arg(contrib)[1] ## sort parameters for each graph graphsnames <- c("light_row", "heavy_row", "light_col", "heavy_col", "eig") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## parameters management adegtot <- adegpar() params <- list() params$light_row <- list(plabels = list(cex = 0), ppoints = list(col = "grey20", alpha = 0.45, cex = 1.2, pch = 19)) params$light_col <- list(plabels = list(cex = 0), ppoints = list(col = "grey20", alpha = 0.45, cex = 1.2, pch = 19)) if(type == "label") { params$heavy_row <- list(plabels = list(boxes = list(draw = FALSE), col = "red"), ppoints = list(cex = 0)) params$heavy_col <- list(plabels = list(boxes = list(draw = FALSE), col = "blue"), ppoints = list(cex = 0)) } else if(type == "cross") { params$heavy_row <- list(ellipseSize = ellipseSize, plabels = list(boxes = list(draw = FALSE), col = "red"), ppoints = list(cex = 0), pellipses = list(lwd = 0, axes = list(col = "red", lty = 1)), plines = list(lwd = 0), plegend = list(drawKey = FALSE)) params$heavy_col <- list(ellipseSize = ellipseSize, plabels = list(boxes = list(draw = FALSE), col = "blue"), ppoints = list(cex = 0), pellipses = list(lwd = 0, axes = list(col = "blue", lty = 1)), plines = list(lwd = 0), plegend = list(drawKey = FALSE)) } else if(type == "ellipse") { params$heavy_row <- list(ellipseSize = ellipseSize, plabels = list(boxes = list(draw = FALSE), col = "red"), ppoints = list(cex = 0), pellipses = list(border = "red", axes = list(lwd = 0)), plines = list(col = 0)) params$heavy_col <- list(ellipseSize = ellipseSize, plabels = list(boxes = list(draw = FALSE), col = "blue"), ppoints = list(cex = 0), pellipses = list(border = "blue", axes = list(lwd = 0)), plines = list(lwd = 0)) } else if(type == "both") { params$heavy_row <- list(ellipseSize = 1.5, plabels = list(boxes = list(draw = FALSE), col = "red"), ppoints = list(cex = 0), pellipses = list(border = "red", axes = list(col = "red", lty = 1)), plines = list(lwd = 0)) params$heavy_col <- list(ellipseSize = 1.5, plabels = list(boxes = list(draw = FALSE), col = "blue"), ppoints = list(cex = 0), pellipses = list(border = "blue", axes = list(col = "blue", lty = 1)), plines = list(lwd = 0)) } params$eig <- list(pbackground = list(box = TRUE), psub = list(text = "Eigenvalues")) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) # never display points under contribution threshold sortparameters$light_row$plabels$cex <- 0 sortparameters$light_col$plabels$cex <- 0 ## management of the data and the parameters about the rows' contribution (individuals) on axes if(!is.null(x$row.rel)) { datacontrib <- x[[ifelse(contrib == "abs", "row.abs", "row.rel")]] datacontrib <- datacontrib[, c(xax, yax)] if(type != "label") { inertrow <- abs(datacontrib) / 100 lightrow <- subset(evTab$li[, c(xax, yax)], inertrow[, 1] < threshold & inertrow[, 2] < threshold) heavyrow <- subset(evTab$li[, c(xax, yax)], inertrow[, 1] >= threshold | inertrow[, 2] >= threshold) if(nrow(heavyrow) == 0) stop("No points to draw, try lowering 'threshold'") heavy_inertrow <- subset(inertrow, inertrow[, 1] >= threshold | inertrow[, 2] >= threshold) limglobal <- setlimits2D(minX = min(c(heavyrow[, 1], lightrow[, 1])), maxX = max(c(heavyrow[, 1], lightrow[, 1])), minY = min(c(heavyrow[, 2], lightrow[, 2])), maxY = max(c(heavyrow[, 2], lightrow[, 2])), origin = adegtot$porigin$origin, aspect.ratio = adegtot$paxes$aspectratio, includeOr = adegtot$porigin$include) # if ellipses or crosses are drawn, the limits are re-calculated and the elipses size are normalized heavy_inertrowmax <- apply(heavy_inertrow, 2, max) heavy_inertrownorm <- matrix(NA, NROW(heavy_inertrow), 2) for (i in 1:2) {heavy_inertrownorm[, i] <- (heavy_inertrow[, i] / heavy_inertrowmax[i]) * (diff(limglobal[[i]]) / 10)} # TODO # add 0.00001 to the coordinates to avoid the bug in the '.util.ellipse' function (waiting to correct it) cont_row <- cbind(c(heavyrow[, 1] - heavy_inertrownorm[, 1]/2, heavyrow[, 1] + heavy_inertrownorm[, 1]/2, heavyrow[, 1], heavyrow[, 1] + 0.00001), c(heavyrow[, 2] + 0.00001, heavyrow[, 2], heavyrow[, 2] - heavy_inertrownorm[, 2]/2, heavyrow[, 2] + heavy_inertrownorm[, 2]/2)) fac_row <- as.factor(rep(rownames(heavyrow), 4)) limglobal <- setlimits2D(minX = min(c(cont_row[, 1], lightrow[, 1])), maxX = max(c(cont_row[, 1], lightrow[, 1])), minY = min(c(cont_row[, 2], lightrow[, 2])), maxY = max(c(cont_row[, 2], lightrow[, 2])), origin = adegtot$porigin$origin, aspect.ratio = adegtot$paxes$aspectratio, includeOr = adegtot$porigin$include) } else { if(contrib == "abs") { temp <- sweep(datacontrib, 2, x$tot.inertia$inertia[c(xax, yax)], "*") / 100 tempsum <- apply(temp, 1, sum) lambdasum <- sum(x$tot.inertia$inertia[c(xax, yax)]) inertrow_cumul <- tempsum / lambdasum } else { inertrow <- abs(datacontrib) / 100 inertrow_cumul <- apply(inertrow, 1, sum) } lightrow <- subset(evTab$li[, c(xax, yax)], inertrow_cumul < threshold) heavyrow <- subset(evTab$li[, c(xax, yax)], inertrow_cumul >= threshold) heavy_inertrow <- subset(inertrow_cumul, inertrow_cumul >= threshold) if(nrow(heavyrow) == 0) stop("No points to draw, try lowering 'threshold'") if(is.null(sortparameters$heavy_row$plabels$cex)) { sortparameters$heavy_row$plabels$cex <- heavy_inertrow / (max(heavy_inertrow) / 2) } else { sortparameters$heavy_row$plabels$cex <- sortparameters$heavy_row$plabels$cex * heavy_inertrow / (max(heavy_inertrow) / 2) } limglobal <- setlimits2D(minX = min(c(heavyrow[, 1], lightrow[, 1])), maxX = max(c(heavyrow[, 1], lightrow[, 1])), minY = min(c(heavyrow[, 2], lightrow[, 2])), maxY = max(c(heavyrow[, 2], lightrow[, 2])), origin = adegtot$porigin$origin, aspect.ratio = adegtot$paxes$aspectratio, includeOr = adegtot$porigin$include) } params <- list() params$light_row <- list(xlim = limglobal$xlim, ylim = limglobal$ylim) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) } ## management of the data and the parameters about the columns' contribution (variables) on axes if(!is.null(x$col.rel)) { datacontrib <- x[[ifelse(contrib == "abs", "col.abs", "col.rel")]] datacontrib <- datacontrib[, c(xax, yax)] if(type != "label") { inertcol <- abs(datacontrib) / 100 lightcol <- subset(evTab$co[, c(xax, yax)], inertcol[, 1] < threshold & inertcol[, 2] < threshold) heavycol <- subset(evTab$co[, c(xax, yax)], inertcol[, 1] >= threshold | inertcol[, 2] >= threshold) if(nrow(heavycol) == 0) stop("No points to draw, try lowering 'threshold'") heavy_inertcol <- subset(inertcol, inertcol[, 1] >= threshold | inertcol[, 2] >= threshold) limglobal <- setlimits2D(minX = min(c(heavycol[, 1], lightcol[, 1])), maxX = max(c(heavycol[, 1], lightcol[, 1])), minY = min(c(heavycol[, 2], lightcol[, 2])), maxY = max(c(heavycol[, 2], lightcol[, 2])), origin = adegtot$porigin$origin, aspect.ratio = adegtot$paxes$aspectratio, includeOr = adegtot$porigin$include) # if ellipses or crosses are drawn, the limits are re-calculated and the ellipse size are normalized heavy_inertcolmax <- apply(heavy_inertcol, 2, max) heavy_inertcolnorm <- matrix(NA, NROW(heavy_inertcol), 2) for (i in 1:2) {heavy_inertcolnorm[, i] <- (heavy_inertcol[, i] / heavy_inertcolmax[i]) * (diff(limglobal[[i]]) / 10)} # TODO # add 0.00001 to the coordinates to avoid the bug in the '.util.ellipse' function (waiting to correct it) cont_col <- cbind(c(heavycol[, 1] - heavy_inertcolnorm[, 1]/2, heavycol[, 1] + heavy_inertcolnorm[, 1]/2, heavycol[, 1], heavycol[, 1] + 0.00001), c(heavycol[, 2] + 0.00001, heavycol[, 2], heavycol[, 2] - heavy_inertcolnorm[, 2]/2, heavycol[, 2] + heavy_inertcolnorm[, 2]/2)) fac_col <- as.factor(rep(rownames(heavycol), 4)) limglobal <- setlimits2D(minX = min(c(cont_col[, 1], lightcol[, 1])), maxX = max(c(cont_col[, 1], lightcol[, 1])), minY = min(c(cont_col[, 2], lightcol[, 2])), maxY = max(c(cont_col[, 2], lightcol[, 2])), origin = adegtot$porigin$origin, aspect.ratio = adegtot$paxes$aspectratio, includeOr = adegtot$porigin$include) } else { if(contrib == "abs") { temp <- sweep(datacontrib, 2, x$tot.inertia$inertia[c(xax, yax)], "*") / 100 tempsum <- apply(temp, 1, sum) lambdasum <- sum(x$tot.inertia$inertia[c(xax, yax)]) inertcol_cumul <- tempsum / lambdasum } else { inertcol <- abs(datacontrib) / 100 inertcol_cumul <- apply(inertcol, 1, sum) } lightcol <- subset(evTab$co[, c(xax, yax)], inertcol_cumul < threshold) heavycol <- subset(evTab$co[, c(xax, yax)], inertcol_cumul >= threshold) heavy_inertcolnorm <- subset(inertcol_cumul, inertcol_cumul >= threshold) if(nrow(heavycol) == 0) stop("No points to draw, try lowering 'threshold'") if(is.null(sortparameters$heavy_col$plabels$cex)) { sortparameters$heavy_col$plabels$cex <- heavy_inertcolnorm / (max(heavy_inertcolnorm) / 2) } else { sortparameters$heavy_col$plabels$cex <- sortparameters$heavy_col$plabels$cex * heavy_inertcolnorm / (max(heavy_inertcolnorm) / 2) } limglobal <- setlimits2D(minX = min(c(heavycol[, 1], lightcol[, 1])), maxX = max(c(heavycol[, 1], lightcol[, 1])), minY = min(c(heavycol[, 2], lightcol[, 2])), maxY = max(c(heavycol[, 2], lightcol[, 2])), origin = adegtot$porigin$origin, aspect.ratio = adegtot$paxes$aspectratio, includeOr = adegtot$porigin$include) } params <- list() params$light_col <- list(xlim = limglobal$xlim, ylim = limglobal$ylim) sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) } ## displaying of the eigen values if(!is.null(position)) geig <- do.call("plotEig", c(list(eigvalue = call("$", ori[[2]], "eig"), nf = 1:evTab$nf, xax = xax, yax = yax, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$eig)) ## function to create the graphics about the row' contribution (individuals) on axes f_row <- function(posi = NULL, pos){ graphnames <- c(if(length(lightrow) > 0) {"light_row"}, "heavy_row", if(!is.null(posi)) {"eig"}) g1 <- do.call("s.label", c(list(dfxy = lightrow, xax = 1, yax = 2, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$light_row)) if(type == "label") g2 <- do.call("s.label", c(list(dfxy = heavyrow, xax = 1, yax = 2, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$heavy_row)) else g2 <- do.call("s.class", c(list(dfxy = cont_row, fac = fac_row, xax = 1, yax = 2, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$heavy_row)) grow <- do.call("superpose", list(g1, g2)) grow@Call <- call("superpose", list(g1@Call, g2@Call)) if(!is.null(posi)) grow <- do.call("insert", list(geig, grow, posi = posi, plot = FALSE, ratio = 0.25)) names(grow) <- graphnames return(grow) } # function to create the graphics about the columns' contribution (variables) on axes f_col <- function(posi = NULL, pos) { graphnames <- c(if(length(lightcol) > 0) {"light_col"}, "heavy_col", if(!is.null(posi)) {"eig"}) g3 <- do.call("s.label", c(list(dfxy = lightcol, xax = 1, yax = 2, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$light_col)) if(type == "label") g4 <- do.call("s.label", c(list(dfxy = heavycol, xax = 1, yax = 2, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$heavy_col)) else g4 <- do.call("s.class", c(list(dfxy = cont_col, fac = fac_col, xax = 1, yax = 2, plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters$heavy_col)) gcol <- do.call("superpose", list(g3, g4)) gcol@Call <- call("superpose", list(g3@Call, g4@Call)) if(!is.null(posi)) gcol <- do.call("insert", list(geig, gcol, posi = posi, plot = FALSE, ratio = 0.25)) names(gcol) <- graphnames return(gcol) } ## function to create a layout of the graphics about the contribution of rows (individuals) and columns (variables) on axes f_both <- function(posi = NULL, pos) { object <- do.call("cbindADEg", c(list(f_row(posi = NULL, pos = pos - 1), f_col(posi = posi, pos = pos - 1)))) names(object) <- c("row", "col") return(object) } ## creation of the appropriate plot according to the input data if(!is.null(x$row.rel) & is.null(x$col.rel)) object <- f_row(posi = position, pos = pos) if(!is.null(x$col.rel) & is.null(x$row.rel)) object <- f_col(posi = position, pos = pos) if(!is.null(x$row.rel) & !is.null(x$col.rel)) object <- f_both(posi = position, pos = pos) if(is.null(x$row.rel) & is.null(x$col.rel)) stop(paste("No inertia was calculated in the ", substitute(x), " object", sep = "")) object@Call <- match.call() if(plot) print(object) invisible(object) } "plot.randtest" <- function(x, nclass = 10, coeff = 1, pos = -1, storeData = TRUE, plot = TRUE, ...) { if(!inherits(x, "randtest")) stop("Object of class 'randtest' expected") # by default, in ade4, as.randtest computes the histogram with 10 class # x$sim is available only if !inherits(x, "lightrandtest") if(!inherits(x, "lightrandtest") & nclass != 10){ h0 <- hist(x$sim, plot = FALSE, nclass = nclass) } else { h0 <- x$plot$hist } ## common limits mylim <- x$plot$xlim ## parameter management graphsnames <- c("sim", "obs") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) params <- list() params[[1]] <- list(p1d = list(horizontal = TRUE), pgrid = list(draw = FALSE), paxes = list(draw = TRUE), xlim = mylim, main = "Histogram of sim", xlab = "sim", ylab = "Frequency") params[[2]] <- list(plines = list(lwd = 1.5), ppoints = list(pch = 18, cex = 1.5)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## plot creation object <- plotRandTest(hist = h0, nclass = nclass, obs = x$obs, params = sortparameters) names(object) <- graphsnames object@Call <- match.call() if(plot) print(object) invisible(object) } "plot.krandtest" <- function (x, nclass = 10, pos = -1, storeData = TRUE, plot = TRUE, ...) { if (!inherits(x, "krandtest")) stop("Object of class 'krandtest' expected") ng <- x$ntest maintitle <- x$names ## parameter management graphsnames <- paste0("g", seq_len(ng)) sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) params <- list() params <- lapply(seq_len(ng), function(i) {params[[i]] <- list(p1d = list(horizontal = TRUE), pgrid = list(draw = FALSE), paxes = list(draw = TRUE), xlim = x$plot[[i]]$xlim, main = maintitle[i], xlab = "", ylab = "", plines = list(lwd = 1.5), ppoints = list(pch = 18, cex = 1.5))}) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) if(inherits(x, "lightkrandtest")) { l <- list() l <- sapply(seq_len(ng), function(i) {do.call("plotRandTest", c(list(hist = x$plot[[i]]$hist, nclass = nclass, obs = x$obs[i], params = sortparameters[[i]])))}) ## ADEgS creation object <- new(Class = "ADEgS", ADEglist = l, positions = layout2position(rev(.n2mfrow(ng)), ng = ng), add = matrix(0, ncol = ng, nrow = ng), Call = match.call()) names(object) <- graphsnames } else { l <- list() for (k in 1:x$ntest) { rd <- as.randtest(x$sim[, k], x$obs[k], output = "full") l[[k]] <- do.call("plot.randtest", c(list(rd, nclass = nclass, plot = FALSE), sortparameters[[k]])) } ## ADEgS creation object <- new(Class = "ADEgS", ADEglist = l, positions = layout2position(rev(.n2mfrow(ng)), ng = ng), add = matrix(0, ncol = ng, nrow = ng), Call = match.call()) names(object) <- graphsnames } object@Call <- match.call() if(plot) print(object) invisible(object) } "plot.bcaloocv" <- function (x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if (!inherits(x, "bcaloocv")) stop("Use only with 'bcaloocv' objects") bca1 <- eval(x$call[[2]]) fac1 <- eval(bca1$call[[3]]) if (bca1$nf == 1) { warnings("One axis only : not yet implemented") return(invisible()) } # Permutation test rt1 <- ade4::randtest(bca1) # Compute cross-validated coordinates Oijbga <- x$Oij_bca Oijxval <- x$Oij_XVal dOij <- x$DeltaOij ## sort parameters for each graph graphsnames <- c("BCA", "XVal") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## default values for parameters params <- list() params[[1]] <- list(psub = list(text = "BCA"), pbackground = list(box = TRUE), plabels = list(cex = 1.25)) params[[2]] <- list(psub = list(text = "Cross-validation"), pbackground = list(box = TRUE), plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) # Character string: graph title, permutation test p-value and variance ratio pst1 <- paste0("Permutation test p = ", rt1$pvalue, ", Expl.Var = ", round(bca1$ratio, 2), ", Oij = ", round(Oijbga,2)) # Draw BGA factor map sc1 <- do.call("s.class", c(list(dfxy = bca1$ls[,c(xax, yax)], fac = fac1, col = TRUE, psub.text = pst1, ellipseSize = 0, chullSize = 1, plot = FALSE), storeData = storeData, pos = pos - 2, sortparameters[[1]])) # Compute cross-validated coordinates # Character string for graph title pst2 <- paste0("Cross-validation Oij = ", round(Oijxval,2), ", dOij = ", round(dOij), "%") # Cross-validated factor map sc2 <- do.call("s.class", c(list(x$XValCoord[,c(xax, yax)], fac1, col = TRUE, psub.text = pst2, ellipseSize = 0, chullSize = 1, plot = FALSE), storeData = storeData, pos = pos - 2, sortparameters[[2]])) # Display both factor maps side by side sc2 <- update(sc2, xlim = sc1@g.args$xlim, ylim = sc1@g.args$ylim) lay <- c(1, 2) object <- new(Class = "ADEgS", ADEglist = list(sc1, sc2), positions = layout2position(lay), add = matrix(0, ncol = 2, nrow = 2), Call = match.call() ) names(object) <- graphsnames if(plot) print(object) invisible(object) } "plot.discloocv" <- function (x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, ...) { if (!inherits(x, "discloocv")) stop("Use only with 'discloocv' objects") disc1 <- eval(x$call[[2]]) fac1 <- eval(disc1$call[[3]]) if (disc1$nf == 1) { warnings("One axis only : not yet implemented") return(invisible()) } # Permutation test rt1 <- ade4::randtest(disc1) # Compute cross-validated coordinates Oijdisc <- x$Oij_disc Oijxval <- x$Oij_XVal dOij <- x$DeltaOij ## sort parameters for each graph graphsnames <- c("Discrimin", "XVal") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) ## default values for parameters params <- list() params[[1]] <- list(psub = list(text = "Discrimin"), pbackground = list(box = TRUE), plabels = list(cex = 1.25)) params[[2]] <- list(psub = list(text = "Cross-validation"), pbackground = list(box = TRUE), plabels = list(cex = 1.25)) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) # Character string: graph title, permutation test p-value and variance ratio pst1 <- paste0("Permutation test p = ", rt1$pvalue, ", Oij = ", round(Oijdisc,2)) # Draw discrimin factor map sc1 <- do.call("s.class", c(list(dfxy = disc1$li[,c(xax, yax)], fac = fac1, col = TRUE, psub.text = pst1, ellipseSize = 0, chullSize = 1, plot = FALSE), storeData = storeData, pos = pos - 2, sortparameters[[1]])) # Compute cross-validated coordinates # Character string for graph title pst2 <- paste0("Cross-validation Oij = ", round(Oijxval,2), ", dOij = ", round(dOij), "%") # Cross-validated factor map sc2 <- do.call("s.class", c(list(x$XValCoord[,c(xax, yax)], fac1, col = TRUE, psub.text = pst2, ellipseSize = 0, chullSize = 1, plot = FALSE), storeData = storeData, pos = pos - 2, sortparameters[[2]])) # Display both factor maps side by side sc2 <- update(sc2, xlim = sc1@g.args$xlim, ylim = sc1@g.args$ylim) lay <- c(1, 2) object <- new(Class = "ADEgS", ADEglist = list(sc1, sc2), positions = layout2position(lay), add = matrix(0, ncol = 2, nrow = 2), Call = match.call() ) names(object) <- graphsnames if(plot) print(object) invisible(object) } adegraphics/R/Tr.class.R0000644000176200001440000002371613742303021014545 0ustar liggesusers###################################################### ## Tr.class ### ## Triangular representation with a factor ### ###################################################### setClass( Class = "Tr.class", contains = "ADEg.Tr" ) setMethod( f = "initialize", signature = "Tr.class", definition = function(.Object, data = list(dfxyz = NULL, fac = NULL, wt = NULL, labels = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) .Object@data$fac <- data$fac .Object@data$wt <- data$wt .Object@data$labels <- data$labels return(.Object) }) setMethod( f = "prepare", signature = "Tr.class", definition = function(object) { name_obj <- deparse(substitute(object)) if(object@data$storeData) { df <- object@data$dfxyz fac <- as.factor(object@data$fac) wt <- object@data$wt } else { fac <- as.factor(eval(object@data$fac, envir = sys.frame(object@data$frame))) df <- eval(object@data$dfxyz, envir = sys.frame(object@data$frame)) wt <- eval(object@data$wt, envir = sys.frame(object@data$frame)) } nlev <- nlevels(fac) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) ## change default for some parameters if(any(adegtot$plabels$cex > 0) & is.null(object@adeg.par$plegend$drawKey)) ## if labels, no legend adegtot$plegend$drawKey <- FALSE ## setting colors paramsToColor <- list(ppoints = list(col = object@adeg.par$ppoints$col, fill = object@adeg.par$ppoints$fill), plabels = list(col = object@adeg.par$plabels$col, boxes = list(border = object@adeg.par$plabels$boxes$border)), plines = list(col = object@adeg.par$plines$col), pellipses = list(border = object@adeg.par$pellipses$border, col = object@adeg.par$pellipses$col), ppolygons = list(border = object@adeg.par$ppolygons$border, col = object@adeg.par$ppolygons$col)) if(!(is.null(object@g.args$col) || (is.logical(object@g.args$col) && !object@g.args$col))) adegtot <- modifyList(adegtot, col2adepar(ccol = object@g.args$col, pparamsToColor = paramsToColor, nnlev = nlev)) ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph ## calculate 2D coordinates df <- sweep(df, 1, rowSums(df), "/") object@stats$coords2d <- .coordtotriangleM(df, mini3 = object@g.args$min3d, maxi3 = object@g.args$max3d)[, 2:3] ## compute means for the 3 variables (for getstats) object@stats$means <- matrix(meanfacwt(df, fac, wt), nrow = nlev) ## mean2d: columns: axes, row: levels object@stats$mean2d <- matrix(meanfacwt(object@stats$coords2d, fac, wt), nrow = nlev) mean.x <- object@stats$mean2d[, 1] ## all means rows as levels, columns as variables mean.y <- object@stats$mean2d[, 2] ## ellipses if(object@g.args$ellipseSize > 0) { object@stats$covvar <- covfacwt(df, fac, wt) object@stats$covvar2d <- covfacwt(object@stats$coords2d, fac, wt) covvartotal <- object@stats$covvar2d object@s.misc$ellipses <- lapply(1:nlev, FUN = function(i) { .util.ellipse(mean.x[i], mean.y[i], vx = covvartotal[[i]][1, 1], vy = covvartotal[[i]][2, 2], cxy = covvartotal[[i]][1, 2], coeff = object@g.args$ellipseSize) }) } ## convex hull if(!is.null(object@g.args$chullSize)) if(any(object@g.args$chullSize > 0)) object@s.misc$chullcoord <- .util.chull(object@stats$coords2d[, 1], object@stats$coords2d[, 2], mean.x, mean.y, fac = fac, chullSize = object@g.args$chullSize) ## never optimized labels for triangle.class object@adeg.par$plabels$optim <- FALSE assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "Tr.class", definition = function(object, x, y) { if(object@data$storeData) { df <- object@data$dfxyz fac <- object@data$fac labels <- object@data$labels } else { fac <- eval(object@data$fac, envir = sys.frame(object@data$frame)) df <- eval(object@data$dfxyz, envir = sys.frame(object@data$frame)) labels <- eval(object@data$labels, envir = sys.frame(object@data$frame)) } fac <- as.factor(fac) nlev <- nlevels(fac) ## draw convex hulls if(any(object@g.args$chullSize > 0)) { chullpo <- object@s.misc$chullcoord ppolygons <- lapply(object@adeg.par$ppolygons, FUN = function(x) rep(x, length.out = length(chullpo))) for(level in 1:nlev) { chull <- chullpo[[level]] for(j in 1:length(chull)) panel.polygon(x = chull[[j]][, 1], y = chull[[j]][, 2], border = ppolygons$border[level], col = ppolygons$col[level], lty = ppolygons$lty[level], lwd = ppolygons$lwd[level], alpha = ppolygons$alpha[level]) }} ## draw ellipses if(object@g.args$ellipseSize > 0) { ellip <- object@s.misc$ellipses pellip <- object@adeg.par$pellipses ## setting parameters, number of levels pellip <- lapply(pellip, FUN = function(x) {if(is.list(x)) return(x) else rep(x, length.out = length(ellip))}) pellip$axes <- lapply(pellip$axes, FUN = function(x) {rep(x, length.out = length(ellip))}) for(level in 1:nlev) { ell <- ellip[[level]] if(!(any(is.null(ell)))) if(!any(is.na(ell))) { panel.polygon(ell$x, ell$y, col = pellip$col[level], lwd = pellip$lwd[level], lty = pellip$lty[level], alpha = pellip$alpha[level], border = pellip$border[level]) if(pellip$axes$draw[level]) { ## draw axes panel.segments(ell$seg1[1], ell$seg1[2], ell$seg1[3], ell$seg1[4], lwd = pellip$axes$lwd[level], lty = pellip$axes$lty[level], col = pellip$axes$col[level]) panel.segments(ell$seg2[1], ell$seg2[2], ell$seg2[3], ell$seg2[4], lwd = pellip$axes$lwd[level], lty = pellip$axes$lty[level], col = pellip$axes$col[level]) } } } } ## draw stars if(object@g.args$starSize > 0) { plines <- lapply(object@adeg.par$plines, FUN = function(x) {rep(x, length.out = nlev)}) xlx <- split(object@stats$coords2d[, 1], fac) ylx <- split(object@stats$coords2d[, 2], fac) for(level in 1:nlev) { xbase <- object@stats$mean2d[level, 1] ybase <- object@stats$mean2d[level, 2] xlev <- xlx[[level]] ylev <- ylx[[level]] panel.segments( x0 = xbase, y0 = ybase, x1 = xbase + object@g.args$starSize * (xlev - xbase), y1 = ybase + object@g.args$starSize * (ylev - ybase), lty = plines$lty[level], lwd = plines$lwd[level], col = plines$col[level]) } } ## draw points npoints <- nrow(object@stats$coords2d) ppoints <- object@adeg.par$ppoints if(length(fac) > 1) { ppoints <- lapply(object@adeg.par$ppoints, function(x, fac) { if(length(x) > length(fac)) return(x) else { xlev <- rep(x, length.out = nlev) return(xlev[fac]) } }, fac = fac) } panel.points(x = object@stats$coords2d[, 1], y = object@stats$coords2d[, 2], type = "p", pch = ppoints$pch, cex = ppoints$cex, col = ppoints$col, alpha = ppoints$alpha, fill = ppoints$fill) ## draw labels if(any(object@adeg.par$plabels$cex > 0)) { center <- object@stats$mean2d adeg.panel.label(x = center[, 1], y = center[, 2] , labels = labels, object@adeg.par$plabels) } }) triangle.class <- function(dfxyz, fac, wt = rep(1, NROW(fac)), labels = levels(fac), col = NULL, ellipseSize = 1, starSize = 1, chullSize = NULL, adjust = TRUE, min3d = NULL, max3d = NULL, showposition = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## dfxyz: matrix/data.frame with 3 columns ## min3d, max3d: limits by default: c(0,0,0), c(1,1,1) thecall <- .expand.call(match.call()) ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if(NCOL(fac) == 1) object <- multi.facets.Tr(thecall, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed multiple fac") } ## multiple fac else if(NCOL(fac) > 1) { object <- multi.variables.Tr(thecall, "fac") } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(adjust = adjust, min3d = min3d, max3d = max3d, ellipseSize = ellipseSize, starSize = starSize, chullSize = chullSize, col = col)) if(storeData) tmp_data <- list(dfxyz = dfxyz, fac = fac, wt = wt, labels = labels, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(dfxyz = thecall$dfxyz, fac = thecall$fac, wt = thecall$wt, labels = thecall$labels, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "Tr.class", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = match.call()) ## preparation prepare(object) setlatticecall(object) if(showposition & add) { print("cannot show position and add") ## can be done, but modifies the meaning of the superposition showposition <- FALSE } if(showposition) object <- new(Class = "ADEgS", ADEglist = list("triangle" = object, "positions" = .showpos(object)), positions = rbind(c(0, 0, 1, 1), c(0, 0.7, 0.3, 1)), add = matrix(0, ncol = 2, nrow = 2), Call = match.call()) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/C1.curves.R0000644000176200001440000000512613742303021014620 0ustar liggesuserssetClass( Class = "C1.curves", contains = "C1.curve" ) setMethod( f = "panel", signature = "C1.curves", definition = function(object, x, y) { ## Drawing dotchart ## x is the index ## y is the score ## get some parameters nr <- NROW(object@data$score) nc <- NCOL(object@data$score) pscore <- object@adeg.par$p1d ppoints <- lapply(object@adeg.par$ppoints, FUN = function(x) {rep(rep(x, length.out = nc), each = nr)}) plines <- lapply(object@adeg.par$plines, FUN = function(x) {rep(rep(x, length.out = nc), each = nr)}) ymat <- matrix(y, nrow = nr, ncol = nc) ## reorder the values y <- as.vector(ymat[order(x), ]) x <- sort(x) ## Starts the display ## depends on the parametres horizontal ## rug.draw and reverse are always considered as FALSE for(i in 1:nc){ idx <- (i - 1)*nr + (1:nr) if(pscore$horizontal) { x.tmp <- y[idx] y.tmp <- x } else { x.tmp <- x y.tmp <- y[idx] } panel.lines(x = x.tmp, y = y.tmp, lwd = plines$lwd[idx], lty = plines$lty[idx], col = plines$col[idx]) panel.points(x = x.tmp, y = y.tmp, pch = ppoints$pch[idx], cex = ppoints$cex[idx], col = ppoints$col[idx], alpha = ppoints$alpha[idx]) } }) s1d.curves <- function(score, at = 1:NROW(score), facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters thecall <- .expand.call(match.call()) ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if(NCOL(score) == 1) object <- multi.facets.C1(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple scores") } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object if(storeData) tmp_data <- list(score = score, at = at, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(score = thecall$score, at = thecall$at, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "C1.curves", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = sortparameters$g.args, Call = match.call()) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/C1.interval.R0000644000176200001440000001352213742303021015134 0ustar liggesuserssetClass( Class = "C1.interval", contains = "ADEg.C1" ) setMethod( f = "initialize", signature = "C1.interval", definition = function(.Object, data = list(score = NULL, at = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.C1 initialize .Object@data$at <- data$at validObject(.Object) return(.Object) }) setMethod( f = "prepare", signature = "C1.interval", definition = function(object) { name_obj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) if(object@data$storeData) { score <- object@data$score at <- object@data$at } else { score <- eval(object@data$score, envir = sys.frame(object@data$frame)) at <- eval(object@data$at, envir = sys.frame(object@data$frame)) } score <- as.matrix(score)[, 1] ## to manage 'score' when it is a data.frame with only one column ## change default for some parameters adegtot$p1d$rug$draw <- FALSE if(object@g.args$method == "bars") { if(is.null(object@adeg.par$parrows$ends)) adegtot$parrows$ends <- "both" if(is.null(object@adeg.par$parrows$angle)) adegtot$parrows$angle <- 90 } ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph if(object@adeg.par$p1d$horizontal && is.null(object@g.args$ylim)) object@g.args$ylim <- setlimits1D(min(at), max(at), 0, FALSE) if(!object@adeg.par$p1d$horizontal && is.null(object@g.args$xlim)) object@g.args$xlim <- setlimits1D(min(at), max(at), 0, FALSE) assign(name_obj, object, envir = parent.frame()) }) setMethod( f= "panel", signature = "C1.interval", definition = function(object, x, y) { ## Drawing interval ## x is the index ## y is the score lims <- current.panel.limits(unit = "native") pscore <- object@adeg.par$p1d plines <- object@adeg.par$plines parrows <- object@adeg.par$parrows ppoly <- object@adeg.par$ppolygons nval <- length(y) %/% 2 score2 <- y[(nval + 1):length(y)] score1 <- y[1 : nval] ## reorder the values score1 <- score1[order(x)] score2 <- score2[order(x)] x <- sort(x) ## Starts the display ## depends on the parametres horizontal ## rug.draw and reverse are always considered as FALSE if(pscore$horizontal) { if(object@g.args$method == "area") { panel.polygon(x = c(score1, rev(score2)), y = c(x, rev(x)), border = "transparent", col = ppoly$col, alpha = ppoly$alpha) panel.lines(x = score1, y = x, col = ppoly$border, lty = ppoly$lty, lwd = ppoly$lwd) panel.lines(x = score2, y = x, col = ppoly$border, lty = ppoly$lty, lwd = ppoly$lwd) } else if(object@g.args$method == "bars") { panel.arrows(x0 = score1, y0 = x, x1 = score2, y1 = x, lwd = plines$lwd, col = plines$col, lty = plines$lty, angle = parrows$angle, length = parrows$length, ends = parrows$ends) } } else { if(object@g.args$method == "area") { panel.polygon(x = c(x, rev(x)), y = c(score1, rev(score2)), border = "transparent", col = ppoly$col, alpha = ppoly$alpha) panel.lines(x = x, y = score1, col = ppoly$border, lty = ppoly$lty, lwd = ppoly$lwd) panel.lines(x = x, y = score2, col = ppoly$border, lty = ppoly$lty, lwd = ppoly$lwd) } else if(object@g.args$method == "bars") { panel.arrows(x0 = x, y0 = score1, x1 = x, y1 = score2, lwd = plines$lwd, col = plines$col, lty = plines$lty, angle = parrows$angle, length = parrows$length, ends = parrows$ends) } } }) s1d.interval <- function(score1, score2, at = 1:NROW(score1), method = c("bars", "area"), facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters thecall <- .expand.call(match.call()) score1 <- eval(thecall$score1, envir = sys.frame(sys.nframe() + pos)) score2 <- eval(thecall$score2, envir = sys.frame(sys.nframe() + pos)) if(NROW(score1) != NROW(score2)) stop("score1 and score2 should have the same length") if(NCOL(score1) != NCOL(score2)) stop("score1 and score2 should have the same number of columns") if((is.data.frame(score1) & NCOL(score1) == 1) | (is.data.frame(score2) & NCOL(score2) == 1)) stop("Not yet implemented for data.frame with only one column, please convert into vector") ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if(NCOL(score1) == 1) object <- multi.facets.C1(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple scores") } ## multiple scores else if(NCOL(score1) > 1) { object <- multi.score.C1(thecall) } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(method = match.arg(method))) if(storeData) tmp_data <- list(score = c(score1, score2), at = at, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(score = call("c", thecall$score1, thecall$score2), at = thecall$at, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "C1.interval", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = match.call()) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/S1.class.R0000644000176200001440000002114113742303021014431 0ustar liggesusers########################################################### ## s1d.class ## ########################################################### setClass( Class = "S1.class", contains = "ADEg.S1", ) setMethod( f = "initialize", signature = "S1.class", definition = function(.Object, data = list(score = NULL, fac = NULL, wt = NULL, labels = NULL, at = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.S1 initialize .Object@data$fac <- data$fac .Object@data$wt <- data$wt .Object@data$labels <- data$labels return(.Object) }) setMethod( f = "prepare", signature = "S1.class", definition = function(object) { name_obj <- deparse(substitute(object)) if(object@data$storeData) fac <- as.factor(object@data$fac) else fac <- as.factor(eval(object@data$fac, envir = sys.frame(object@data$frame))) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) ## change default for some parameters if(adegtot$p1d$horizontal & is.null(object@adeg.par$plabels$srt)) adegtot$plabels$srt <- 90 else if(!adegtot$p1d$horizontal & is.null(object@adeg.par$plabels$srt)) adegtot$plabels$srt <- 0 if(any(adegtot$plabels$cex > 0) & is.null(object@adeg.par$plegend$drawKey)) ## if labels, no legend adegtot$plegend$drawKey <- FALSE ## setting colors paramsToColor <- list(ppoints = list(col = object@adeg.par$ppoints$col, fill = object@adeg.par$ppoints$fill), plabels = list(col = object@adeg.par$plabels$col, boxes = list(border = object@adeg.par$plabels$boxes$border)), plines = list(col = object@adeg.par$plines$col)) if(!(is.null(object@g.args$col) || (is.logical(object@g.args$col) && !object@g.args$col))) adegtot <- modifyList(adegtot, col2adepar(ccol = object@g.args$col, pparamsToColor = paramsToColor, nnlev = nlevels(fac))) ## manage limits if(adegtot$p1d$horizontal & is.null(object@g.args$ylim)) object@g.args$ylim <- c(0, 1) if(!adegtot$p1d$horizontal & is.null(object@g.args$xlim)) object@g.args$xlim <- c(0, 1) ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph assign(name_obj, object, envir = parent.frame()) }) ## TODO: label orientation (works only for horizontal / vertical labels) setMethod( f= "panel", signature = "S1.class", definition = function(object, x, y) { if(object@data$storeData) { fac <- object@data$fac score <- object@data$score wt <- object@data$wt at <- object@data$at labels <- object@data$labels } else { fac <- eval(object@data$fac, envir = sys.frame(object@data$frame)) score <- eval(object@data$score, envir = sys.frame(object@data$frame)) wt <- eval(object@data$wt, envir = sys.frame(object@data$frame)) at <- eval(object@data$at, envir = sys.frame(object@data$frame)) labels <- eval(object@data$labels, envir = sys.frame(object@data$frame)) } fac <- as.factor(fac) nlev <- nlevels(fac) object@stats$means <- meanfacwt(score, fac, wt = wt) lims <- current.panel.limits(unit = "native") pscore <- object@adeg.par$p1d ## repeat graphical parameters (one for each level) ppoints <- lapply(object@adeg.par$ppoints, FUN = function(x) x <- rep(x, length.out = nlev)) plines <- lapply(object@adeg.par$plines, FUN = function(x) x <- rep(x, length.out = nlev)) plabels <- lapply(object@adeg.par$plabels, FUN = function(x) x <- rep(x, length.out = nlev)) plboxes <- lapply(object@adeg.par$plabels$boxes, FUN = function(x) x <- rep(x, length.out = nlev)) plabels$boxes <- plboxes if(!is.null(labels)) { ## get text sizes for boxes test <- .textsize(labels, plabels) w <- test$w h <- test$h } lead <- ifelse(pscore$reverse, -1, 1) if(pscore$horizontal) { ## horizontal plot xpoints <- y ## get positions for labels if(object@g.args$poslabel == "regular") { spacelab <- diff(lims$xlim) / (nlev + 1) xlab <- seq(from = lims$xlim[1] + spacelab, by = spacelab, length.out = nlev)[rank(object@stats$means, ties.method = "first")] } else xlab <- object@stats$means ## repeat means for each individual xlablines <- xlab[fac] ## repeat ylab for each individual ylab <- rep(at, length.out = nlev) ylablines <- ylab[fac] ## draw lines and labels ypoints <- object@s.misc$rug panel.segments(x0 = xpoints, y0 = ypoints, x1 = xlablines, y1 = ylablines, lwd = plines$lwd[fac], col = plines$col[fac], lty = plines$lty[fac]) if(any(ppoints$cex > 0)) panel.points(x = xpoints, y = ypoints, pch = ppoints$pch[fac], cex = ppoints$cex[fac], col = ppoints$col[fac], alpha = ppoints$alpha[fac], fill = ppoints$fill[fac]) if(any(plabels$cex > 0)) adeg.panel.label(x = xlab, y = ylab + lead * h / 2, labels = labels, plabels = plabels) } else { ## vertical plot ypoints <- y ## get positions for labels if(object@g.args$poslabel == "regular") { spacelab <- diff(lims$ylim) / (nlev + 1) ylab <- seq(from = lims$ylim[1] + spacelab, by = spacelab, length.out = nlev)[rank(object@stats$means, ties.method = "first")] } else ylab <- object@stats$means ## repeat means for each individual ylablines <- ylab[fac] ## repeat ylab for each individual xlab <- rep(at, length.out = nlev) xlablines <- xlab[fac] ## draw lines and labels xpoints <- object@s.misc$rug panel.segments(x0 = xpoints, y0 = ypoints, x1 = xlablines, y1 = ylablines, lwd = plines$lwd[fac], col = plines$col[fac], lty = plines$lty[fac]) if(any(ppoints$cex > 0)) panel.points(x = xpoints, y = ypoints, pch = ppoints$pch[fac], cex = ppoints$cex[fac], col = ppoints$col[fac], alpha = ppoints$alpha[fac], fill = ppoints$fill[fac]) if(any(plabels$cex > 0)) adeg.panel.label(x = xlab + lead * w / 2 , y = ylab, labels = labels, plabels = plabels) } }) s1d.class <- function(score, fac, wt = rep(1, NROW(fac)), labels = levels(fac), at = 0.5, poslabel = c("regular", "value"), col = NULL, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters thecall <- .expand.call(match.call()) labels <- eval(thecall$labels, envir = sys.frame(sys.nframe() + pos)) fac <- eval(thecall$fac, envir = sys.frame(sys.nframe() + pos)) score <- eval(thecall$score, envir = sys.frame(sys.nframe() + pos)) if(NCOL(fac) == 1) { fac <- as.factor(fac) if(length(labels) != nlevels(fac)) stop("wrong number of labels") } if(NROW(score) != NROW(fac)) stop("score and factor must have the same number of rows") ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if(NCOL(score) == 1 & NCOL(fac) == 1) object <- multi.facets.S1(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple scores or fac") } ## multiple scores else if(NCOL(score) > 1) { if(NCOL(fac) == 1) object <- multi.score.S1(thecall) else stop("Multiple scores are not allowed with multiple fac") } ## multiple fac else if(NCOL(fac) > 1) { object <- multi.variables.S1(thecall, "fac") } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(poslabel = match.arg(poslabel), col = col)) if(storeData) tmp_data <- list(score = score, wt = wt, fac = fac, labels = labels, at = at, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(score = thecall$score, wt = thecall$wt, fac = thecall$fac, labels = thecall$labels, at = thecall$at, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "S1.class", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = match.call()) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/S2.image.R0000644000176200001440000001574114354572721014437 0ustar liggesusers########################################################################## ## s.image ## ########################################################################## ## TODO: prendre en comptre les differents z setClass( Class = "S2.image", contains = "ADEg.S2" ) setMethod( f = "initialize", signature = "S2.image", definition = function(.Object, data = list(dfxy = NULL, z = NULL, xax = 1, yax = 2, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.S2 initialize .Object@data$z <- data$z return(.Object) }) setMethod( f = "prepare", signature = "S2.image", definition = function(object) { name_obj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) if(object@data$storeData) { dfxy <- object@data$dfxy z <- object@data$z } else { dfxy <- eval(object@data$dfxy, envir = sys.frame(object@data$frame)) z <- eval(object@data$z, envir = sys.frame(object@data$frame)) } ## change default for some parameters object@g.args$gridsize <- rep(object@g.args$gridsize, length.out = 2) if(is.null(object@adeg.par$porigin$include) & (any(names(object@g.args) %in% c("Sp", "nbobject", "outsideLimits")))) adegtot$porigin$include <- FALSE if(is.null(object@g.args$breaks)) object@s.misc$breaks.update <- pretty(z, object@g.args$nclass) else object@s.misc$breaks.update <- object@g.args$breaks object@s.misc$breaks.update <- breakstest(object@s.misc$breaks.update, z, n = length(object@s.misc$breaks.update)) n <- length(object@s.misc$breaks.update) ## setting colors if(!is.null(object@g.args$col)) { if(length(object@g.args$col) < (n - 1)) stop(paste("not enough colors defined, at least ", (n - 1), " colors expected", sep = ""), call. = FALSE) adegtot$ppoints$col <- object@g.args$col[1:(n - 1)] ## color given by the user } else { if(is.null(object@adeg.par$ppoints$col)) adegtot$ppoints$col <- adegtot$ppalette$quanti(n - 1) } ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph (provide limits that are used below) ## create a sp grid minX <- object@g.args$xlim[1] minY <- object@g.args$ylim[1] cgridX <- diff(object@g.args$xlim) / object@g.args$gridsize[1] cgridY <- diff(object@g.args$ylim) / object@g.args$gridsize[2] gridSp <- SpatialGrid(GridTopology(c(minX, minY), c(cgridX, cgridY), c(object@g.args$gridsize[1], object@g.args$gridsize[2]))) x <- dfxy[, object@data$xax] y <- dfxy[, object@data$yax] if(!is.null(object@g.args$outsideLimits)) { ## outside limits are provided by an sp object whichis <- over(gridSp, object@g.args$outsideLimits) } else { ## define the outside limits by convex hull beplot <- cbind(x, y)[chull(cbind(x, y)), ] extCoord <- SpatialPolygons(list(Polygons(list(Polygon(rbind(cbind(beplot[, 1], beplot[, 2]), beplot[1, ]))), ID = "extcoord"))) whichis <- over(gridSp, extCoord) } ## NA not handled by panel.levelplot call afterward ==> we remove the points newgrid <- coordinates(gridSp) names(newgrid) <- c("x", "y") lo <- loess(z ~ x + y, span = object@g.args$span) ## Local Polynomial Regression Fitting predictval <- predict(lo, newdata = newgrid) predictval[which(is.na(whichis))] <- NA tokeep <- !is.na(predictval) predictval <- predictval[tokeep] newgrid <- newgrid[tokeep, ] object@stats$value <- predictval object@s.misc$newgrid <- newgrid assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "S2.image", definition = function(object, x, y) { zvalue <- object@stats$value col <- object@adeg.par$ppoints$col xx <- object@s.misc$newgrid[, 1] yy <- object@s.misc$newgrid[, 2] panel.levelplot(x = xx, y = yy, z = zvalue, subscripts = TRUE, col.regions = col, contour = object@g.args$contour, region = object@g.args$region, labels = object@adeg.par$plabels, label.style = if(object@adeg.par$plabels$srt == "horizontal") "flat" else "align") }) s.image <- function(dfxy, z, xax = 1, yax = 2, span = 0.5, gridsize = c(80L, 80L), contour = TRUE, region = TRUE, outsideLimits = NULL, breaks = NULL, nclass = 8, col = NULL, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { if(!is.null(outsideLimits)) { if(!inherits(outsideLimits, "SpatialPolygons")) stop("limits must be a SpatialPolygons") } ## evaluation of some parameters (required for multiplot) thecall <- .expand.call(match.call()) df <- try(as.data.frame(eval(thecall$dfxy, envir = sys.frame(sys.nframe() + pos))), silent = TRUE) z <- eval(thecall$z, envir = sys.frame(sys.nframe() + pos)) if(inherits(df, "try-error") | is.null(thecall$dfxy)) ## non convenient dfxy argument stop("non convenient selection for dfxy (can not be converted to dataframe)") if(NROW(df) != NROW(z)) stop("dfxy and z should have the same number of rows") ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if((length(xax) == 1 & length(yax) == 1) & NCOL(z) == 1) object <- multi.facets.S2(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple xax/yax or multiple z") } ## multiple axes else if((length(xax) > 1 | length(yax) > 1)) { if(NCOL(z) == 1) object <- multi.ax.S2(thecall) else stop("Multiple xax/yax are not allowed with multiple z") } ## multiple z else if(NCOL(z) > 1) { object <- multi.variables.S2(thecall, "z") } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(breaks = breaks, nclass = nclass, span = span, gridsize = gridsize, outsideLimits = outsideLimits, contour = contour, region = region, col = col)) if(storeData) tmp_data <- list(dfxy = dfxy, xax = xax, yax = yax, z = z, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(dfxy = thecall$dfxy, xax = xax, yax = yax, z = thecall$z, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "S2.image", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = as.call(thecall)) ## preparation of the graph prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(! add & plot) print(object) invisible(object) } adegraphics/R/utils.R0000644000176200001440000004012114354572106014215 0ustar liggesusersreplaceListNull <- function(x, val) { lapply(x, function(x) { if (is.list(x)){ replaceListNull(x, val) } else{ if(is.null(x)) val else(x) } }) } col2adepar <- function(ccol, pparamsToColor, nnlev) { myCol <- NULL if(is.logical(ccol) && isTRUE(ccol)) myCol <- adegpar()$ppalette$quali(nnlev) else myCol <- rep(ccol, length.out = nnlev) if(!is.null(myCol)) return(replaceListNull(pparamsToColor, myCol)) else return() } repList <- function(x, times) { if(times == 1) l <- x else { l <- list() l <- lapply(1:times, function(i) x) names(l) <- paste("l", sapply(1:times, function(i) i), sep = "") } return(l) } .proportional_map <- function(z, maxz) { ## Proportional Symbol Mapping in R ## Susumu Tanimura, Chusi Kuroiwa, Tsutomu Mizota ## Journal of Sratistical Software January 2006 sizes <- (abs(z) / maxz) ^ 0.57 return(sizes) } .symbol2pch <- function(symbol){ ## give the pch associated to some symbol names (used in *.value) res <- 22 ## square by default if(symbol == "circle"){ res <- 21 } else if(symbol == "diamond"){ res <- 23 } else if(symbol == "uptriangle"){ res <- 24 } else if(symbol == "downtriangle"){ res <- 25 } return(res) } .textpos <- function(xx, yy, origin = c(0, 0), n = length(xx)) { ## justification for labels and positions used in s.arrow and s.corcircle if(is.vector(origin) & length(origin) == 2) { xx <- xx - origin[1] yy <- yy - origin[2] } else stop("Invalid argument 'origin'") justif <- matrix(0, nrow = 2, ncol = n) for(i in 1:n) ## text justification ## move labels (w/2 for left/right or h/2 for bottom/top) if(yy[i] > 0) { if(abs(xx[i]) < yy[i]) justif[, i] <- c(0, 1) else if(xx[i] < 0) justif[, i] <- c(-1, 0) else justif[, i] <- c(1, 0) } else { ## y<=0 if(abs(xx[i]) < abs(yy[i])) justif[, i] <- c(0, -1) else if(xx[i] < 0) justif[, i] <- c(-1, 0) else justif[, i] <- c(1, 0) } return(justif) } .setposition <- function(position) { ## specify where to draw grid text if(is.character(position)) { if(position == "bottomleft") { posi <- c(unit(0.05, "npc"), unit(0.02, "npc")) just <- c("left", "bottom") } else if(position == "bottomright") { posi <- c(unit(0.95, "npc"), unit(0.02, "npc")) just <- c("right", "bottom") } else if(position == "topleft") { posi <- c(unit(0.05, "npc"), unit(0.98, "npc")) just <- c("left", "top") } else if(position == "topright") { posi <- c(unit(0.95, "npc"), unit(0.98, "npc")) just <- c("right", "top") } else stop("Wrong position") } else { posi <- position just <- c("left", "bottom") } return(list(posi = posi, just = just)) } .getgrid <- function(xlim, ylim, nbgrid = 5, origin, asp) { ## specify where to draw grid lines if(missing(origin)) { ## i.e. porigin.include = FALSE origin <- c(pretty(xlim, n = nbgrid)[1], pretty(ylim, n = nbgrid)[1]) } minX <- xlim[1] minY <- ylim[1] maxX <- xlim[2] maxY <- ylim[2] origin <- rep(origin, le = 2) cgrid.y <- diff(pretty(ylim, n = nbgrid))[1] cgrid.x <- diff(pretty(xlim, n = nbgrid))[1] if(asp == "iso") { if(diff(xlim) > diff(ylim)) cgrid.x <- cgrid.y else cgrid.y <- cgrid.x } if(is.na(cgrid.x) || is.na(cgrid.y)) stop("error while calculating grid") v0 <- origin[1] if((origin[1] + cgrid.x) <= maxX) v0 <- c(v0, seq(origin[1] + cgrid.x, maxX, by = cgrid.x)) if((origin[1] - cgrid.x >= minX)) v0 <- c(v0, seq(origin[1] - cgrid.x, minX, by = -cgrid.x)) v0 <- sort(v0[v0 >= minX & v0 <= maxX]) h0 <- origin[2] if((origin[2] + cgrid.y) <= maxY) h0 <- c(h0, seq(origin[2] + cgrid.y, maxY, by = cgrid.y)) if((origin[2] - cgrid.y >= minY)) h0 <- c(h0, seq(origin[2] - cgrid.y, minY, by = -cgrid.y)) h0 <- sort(h0[h0 >= minY & h0 <= maxY]) ## clean near-zero values delta <- diff(range(v0))/nbgrid if (any(small <- abs(v0) < 1e-14 * delta)) v0[small] <- 0 delta <- diff(range(h0))/nbgrid if (any(small <- abs(h0) < 1e-14 * delta)) h0[small] <- 0 res <- list(x0 = c(v0, rep(NA, length.out = length(h0))), x1 = c(v0, rep(NA, length.out = length(h0))) , y0 = c(rep(NA, length.out = length(v0)), h0), y1 = c(rep(NA, length.out = length(v0)), h0), d = signif(cgrid.x, 3)) return(res) } setlimits1D <- function(mini, maxi, origin, includeOr) { ## computes limits for 1D plots if(includeOr) { newvalu <- .includeorigin(origin, mini, maxi) mini <- newvalu[1L] maxi <- newvalu[2L] } ## add 10% in both directions if(abs(diff(c(mini, maxi))) > .Machine$double.eps ^ 2) res <- c(mini, maxi) + c(-1, 1) * diff(c(mini, maxi)) / 10 else { ## if there is only one value if(mini < .Machine$double.eps ^ 2) res <- mini + 0.02 * c(-1, 1) else res <- mini + c(-1, 1) * abs(mini) / 10 } return(res) } ## if aspect.ratio == "iso", we must have identical limits range in x and y setlimits2D <- function(minX, maxX, minY, maxY, origin = c(0, 0), aspect.ratio = "iso", includeOr) { origin <- rep(origin, length.out = 2) if(includeOr) { ## to include origin newvalu <- list(.includeorigin(origin[1], minX, maxX), .includeorigin(origin[2], minY, maxY)) minX <- newvalu[[1L]][1L] minY <- newvalu[[2L]][1L] maxX <- newvalu[[1L]][2L] maxY <- newvalu[[2L]][2L] } ## interval sizes interX <- diff(c(minX, maxX)) interY <- diff(c(minY, maxY)) if(aspect.ratio == "iso") { ## same limits (to have iso square) biggest <- max(c(max(interX, interY))) if(which(c(interX, interY) == biggest)[1] == 1) { ## biggest is in X minY <- minY - (interX - interY) / 2 maxY <- maxY + (interX - interY) / 2 } else { ## biggest is in Y minX <- minX - (interY - interX) / 2 maxX <- maxX + (interY - interX) / 2 } } if(interX > .Machine$double.eps ^ 2 || interY > .Machine$double.eps ^ 2) { xvalu <- c(minX, maxX) + c(-1, 1) * diff(c(minX, maxX)) / 10 yvalu <- c(minY, maxY) + c(-1, 1) * diff(c(minY, maxY)) / 10 } else { xvalu <- c(minX, maxX) + c(-1, 1) * abs(max(minX, minY)) / 10 yvalu <- c(minY, maxY) + c(-1, 1) * abs(max(minX, minY)) / 10 } return(list(xlim = xvalu, ylim = yvalu)) } .includeorigin <- function(origin, value1, value2) { ## compute limits including origin return(range(c(origin, value1, value2))) } ## separates a list of parameters to obtain 4 lists ## the first corresponds to 'padegraphic' ## the second to lattice parameters ## the third to graphics arguments ## the last to unused parameters sortparamADEg <- function(...) { if(try(is.list(...), silent = TRUE) == TRUE) dots <- as.list(...) else dots <- list(...) classtest <- try(list(...), silent = TRUE) if(inherits(classtest, "try-error")) stop("wrong parameters list, error in sortparamADEg") trellis <- list() adegpar <- list() g.args <- list() stats <- list() s.misc <- list() rest <- list() if(length(dots)) { ## compare to trellis parameters select <- separation(... , pattern = 1) trellis <- select[[1L]] rest <- select[[2L]] ## removing sp.layout items if(length(rest)) { indix2 <- pmatch(names(rest), "sp.layout") if(any(!is.na(indix2))) { whereis <- which(!is.na(indix2)) g.args <- list("sp.layout" = rest[[whereis]]) rest <- rest[-whereis] } } ## compare to adegpar parameters (pattern = 0 by default) if(length(rest)) { select <- separation(rest) adegpar <- select[[1L]] rest <- select[[2L]] } ## removing g.args items if(length(rest)) { pattern.g.args <- c("xlim", "ylim", "main", "sub", "xlab", "ylab", "Sp", "nbobject", "samelimits", "scales", "key", "colorkey", "col") pmatch.g.args <- pmatch(names(rest), pattern.g.args) indix <- which(!is.na(pmatch.g.args)) pmatch.g.args <- pmatch.g.args[!is.na(pmatch.g.args)] if(length(indix)) { g.args <- c(g.args, rest[indix]) names(g.args)[(1 + length(g.args) - length(pmatch.g.args)):length(g.args)] <- c(pattern.g.args[pmatch.g.args]) rest <- rest[-indix] } } } return(list(adepar = adegpar, trellis = trellis, g.args = g.args, rest = rest)) } ######################################################################## ### FROM CAR >= 3.1-1 (or MAPTOOLS before 2022-10-22) ####### ######################################################################## .pointLabel <- function(x, y = NULL, labels, width, height, limits, xyAspect, allowSmallOverlap = FALSE, trace = FALSE) { ## xyAspect: width_in/height_inch of the current panel ## limits would have been setted before (in ADEg.S2 prepare) ## width and height de rectangle en 'npc' (fig in original code__maptools package) ## labels <- graphicsAnnot(labels) ## to do before ## TODO redo boundary <- c(limits$xlim, limits$ylim) toUnityCoords <- function(xy) { return(list(x = (xy$x - boundary[1]) / (boundary[2] - boundary[1]) * xyAspect, y = (xy$y - boundary[3]) / (boundary[4] - boundary[3]) / xyAspect)) } toUserCoords <- function(xy) { return(list(x = boundary[1] + xy$x / xyAspect * (boundary[2] - boundary[1]), y = boundary[3] + xy$y * xyAspect * (boundary[4] - boundary[3]))) } z <- xy.coords(x, y, recycle = TRUE) z <- toUnityCoords(z) x <- z$x y <- z$y if(allowSmallOverlap) nudgeFactor <- 0.02 n_labels <- length(x) gen_offset <- function(code) { c(-1, -1, -1, 0, 0, 1, 1, 1)[code] * (width / 2) + (0 + 1i) * c(-1, 0, 1, -1, 1, -1, 0, 1)[code] * height / 2 } rect_intersect <- function(xy1, offset1, xy2, offset2) { ##intersections calculations w <- pmin(Re(xy1 + offset1 / 2), Re(xy2 + offset2 / 2)) - pmax(Re(xy1 - offset1 / 2), Re(xy2 - offset2 / 2)) h <- pmin(Im(xy1 + offset1 / 2), Im(xy2 + offset2 / 2)) - pmax(Im(xy1 - offset1 / 2), Im(xy2 - offset2 / 2)) w[w <= 0] <- 0 h[h <= 0] <- 0 w * h } nudge <- function(offset) { doesIntersect <- rect_intersect(xy[rectidx1] + offset[rectidx1], rectv[rectidx1], xy[rectidx2] + offset[rectidx2], rectv[rectidx2]) > 0 pyth <- abs(xy[rectidx1] + offset[rectidx1] - xy[rectidx2] - offset[rectidx2]) / nudgeFactor eps <- 1e-10 for (i in which(doesIntersect & pyth > eps)) { idx1 <- rectidx1[i] idx2 <- rectidx2[i] vect <- (xy[idx1] + offset[idx1] - xy[idx2] - offset[idx2]) / pyth[idx1] offset[idx1] <- offset[idx1] + vect offset[idx2] <- offset[idx2] - vect } offset } objective <- function(gene) { ## score calculations offset <- gen_offset(gene) if(allowSmallOverlap) offset <- nudge(offset) if(!is.null(rectidx1)) area <- sum(rect_intersect(xy[rectidx1] + offset[rectidx1], rectv[rectidx1], xy[rectidx2] + offset[rectidx2], rectv[rectidx2])) else area <- 0 n_outside <- sum(Re(xy + offset - rectv / 2) < 0 | Re(xy + offset + rectv / 2) > xyAspect | Im(xy + offset - rectv / 2) < 0 | Im(xy + offset + rectv / 2) > 1 / xyAspect) if(is.na(n_outside)) n_outside <- 0 ## TODO: to correct, n_outside sometimes NA res <- 1000 * area + n_outside res } xy <- x + (0 + 1i) * y rectv <- width + (0 + 1i) * height rectidx1 <- rectidx2 <- array(0, (length(x)^2 - length(x)) / 2) k <- 0 for(i in 1:length(x)) { for(j in seq(len = (i - 1))) { k <- k + 1 rectidx1[k] <- i rectidx2[k] <- j } } canIntersect <- rect_intersect(xy[rectidx1], 2 * rectv[rectidx1], xy[rectidx2], 2 * rectv[rectidx2]) > 0 rectidx1 <- rectidx1[canIntersect] ## which intersect with those in rectidx2 rectidx2 <- rectidx2[canIntersect] if(trace) cat("possible intersects = ", length(rectidx1), "\n") if(trace) cat("portion covered = ", sum(rect_intersect(xy, rectv, xy, rectv)), "\n") ## simulated annealing SANN <- function() { ## initialisation gene <- rep(8, n_labels) ## 'rep' is best to begin at center score <- objective(gene) ## initial score bestgene <- gene bestscore <- score T <- 2.5 ## pseudo initial temperature for (i in 1:50) { k <- 1 for (j in 1:50) { newgene <- gene newgene[sample(1:n_labels, 1)] <- sample(1:8, 1) newscore <- objective(newgene) ## score if(newscore <= score || runif(1) < exp((score - newscore) / T)) { ## empirical law to accept differences: if 'newscore' is better or with a proba exp(Dscorce/T) k <- k + 1 score <- newscore gene <- newgene } if(score <= bestscore) { bestscore <- score bestgene <- gene } if(bestscore == 0 || k == 10) break } if(bestscore == 0) ## no variation break if(trace) cat("overlap area =", bestscore, "\n") T <- 0.9 * T ## the temperature regularly decreases to become stable } if(trace) cat("overlap area =", bestscore, "\n") nx <- Re(xy + gen_offset(bestgene)) ny <- Im(xy + gen_offset(bestgene)) return(list(x = nx, y = ny)) } xy <- SANN() xy <- toUserCoords(xy) return(xy) } ## check if z is included in breaks ## no default value breakstest <- function(breaki, zi, n) { breaki <- sort(breaki, decreasing = TRUE) if(max(breaki) < max(zi) | min(breaki) > min(zi)) { zbis <- pretty(zi, n) if(max(breaki) < max(zi)) { warning(paste("breaks given does not include z limits, break added ", max(zbis), sep = " "), call. = FALSE) breaki <- c((max(zbis)), breaki) } if(min(breaki) > min(zi)) { warning(paste("breaks given does not include z limits, break added ", min(zbis), sep = " "), call. = FALSE) breaki <- c(breaki, min(zbis)) } } return(breaki) } ################ for axis..... ## extract from ## Lattice Graphs { Control of Panel of Panel & Strip Borders ## J H Maindonald ## http://www.maths.anu.edu.au/~johnm axis.L <- function(side, ..., line.col) { col <- trellis.par.get("axis.text")$col axis.default(side, ..., line.col = col) } .textsize <- function(labels, plabels) { ## can be improved see s1d.barchart for non-trivial rotation srt <- 0 if(is.numeric(plabels$srt)) srt <- plabels$srt[1] else { if(plabels$srt[1] == "horizontal") srt <- 0 else if(plabels$srt[1] == "vertical") srt <- 90 } if(srt == 90) { h <- (convertHeight(stringWidth(labels), unitTo = "native", valueOnly = TRUE) + convertHeight(stringWidth("h"), unitTo = "native", valueOnly = TRUE) / 2) * rep(plabels$cex, length.out = length(labels)) w <- (convertWidth(stringHeight(labels), unitTo = "native", valueOnly = TRUE) + convertWidth(stringHeight("m"), unitTo = "native", valueOnly = TRUE) / 2) * rep(plabels$cex, length.out = length(labels)) } else { ## if 0 or an other angle w <- (convertWidth(stringWidth(labels), unitTo = "native", valueOnly = TRUE) + convertWidth(stringWidth("m"), unitTo = "native", valueOnly = TRUE) / 2) * rep(plabels$cex, length.out=length(labels)) h <- (convertHeight(stringHeight(labels), unitTo = "native", valueOnly = TRUE) + convertHeight(stringHeight("h"), unitTo = "native", valueOnly = TRUE) / 2) * rep(plabels$cex, length.out=length(labels)) } return(list(w = w, h = h, srt = srt)) } .expand.call <- function(thecall, eval.formals = TRUE) { ## takes a call as argument and return a "cleaned" call where argument names are filled, and unset non empty formals are added and eventually evaluated using the call as environment ## supplied args: ans <- as.list(thecall) ## possible args: frmls <- formals(as.character(ans[[1]])) ## remove formal args with no presets: frmls <- frmls[!sapply(frmls, is.symbol)] add <- which(!(names(frmls) %in% names(ans))) frmls <- frmls[add] if(eval.formals) { ## evaluate the call locally and recursively frmls.new <- lapply(frmls, function(x) do.call("substitute", list(x, c(ans[-1], frmls)))) while(!isTRUE(all.equal(frmls, frmls.new))) { frmls <- frmls.new frmls.new <- lapply(frmls, function(x) do.call("substitute", list(x, c(ans[-1], frmls)))) } } return(c(ans, frmls)) } adegraphics/R/utilstriangle.R0000644000176200001440000001177213742303021015741 0ustar liggesusers## projection dans triangle ## de la base e1=c(1,0,0), e2=c(0,1,0), e3=c(0,0,1) ## a c(1/sqrt(3), 1/sqrt(3), 1/sqrt(3)), c(-1/sqrt(2),1/sqrt(2),0), c(-1/sqrt(6),-1/sqrt(6),2/sqrt(6)) .coordtotriangleUnity <- function(mdata3) { x <- mdata3[, 1] y <- mdata3[, 2] z <- mdata3[, 3] return(cbind(0, (y - x) / sqrt(2), (2 * z - x - y) / sqrt(6))) } ## projection depend also on scale defined by min and max ## need to rescale coordinates to maintain distances ## in the new space .coordtotriangleM <- function(ta, mini3, maxi3) { data3d <- t(apply(ta, 1, FUN = function(x) { x <- (x - mini3) / (maxi3 - mini3) return(x / sum(x))})) return(.coordtotriangleUnity(data3d)) } ## TODO: redo this, from ade4 .trranges <- function(df, adjust = TRUE, min3 = NULL, max3 = NULL) { ta <- sweep(df, 1, rowSums(df), "/") if(ncol(ta) != 3) stop("Non convenient data") if(min(ta) < 0) stop("Non convenient data") if((!is.null(min3)) & (!is.null(max3))) adjust <- TRUE cal <- matrix(0, 9, 3) tb <- t(apply(ta, 1, FUN = function(x) {x / sum(x)})) mini <- apply(tb, 2, min) maxi <- apply(tb, 2, max) mini <- (floor(mini / 0.1)) / 10 maxi <- (floor(maxi / 0.1) + 1) / 10 mini[mini < 0] <- 0 maxi[maxi > 1] <- 1 if(!is.null(min3)) mini <- min3 if(!is.null(max3)) maxi <- min3 ampli <- maxi - mini amplim <- max(ampli) if(!all(ampli == amplim)) { for (j in 1:3) { k <- amplim - ampli[j] while (k > 0) { if((k > 0) & (maxi[j] < 1)) { maxi[j] <- maxi[j] + 0.1 k <- k - 1 } if((k > 0) & (mini[j] > 0)) { mini[j] <- mini[j] - 0.1 k <- k - 1 } } } } cal[1, 1] <- mini[1] cal[1, 2] <- mini[2] cal[1, 3] <- 1 - cal[1, 1] - cal[1, 2] cal[2, 1] <- mini[1] cal[2, 2] <- maxi[2] cal[2, 3] <- 1 - cal[2, 1] - cal[2, 2] cal[3, 1] <- maxi[1] cal[3, 2] <- mini[2] cal[3, 3] <- 1 - cal[3, 1] - cal[3, 2] cal[4, 1] <- mini[1] cal[4, 3] <- mini[3] cal[4, 2] <- 1 - cal[4, 1] - cal[4, 3] cal[5, 1] <- mini[1] cal[5, 3] <- maxi[3] cal[5, 2] <- 1 - cal[5, 1] - cal[5, 3] cal[6, 1] <- maxi[1] cal[6, 3] <- mini[3] cal[6, 2] <- 1 - cal[6, 1] - cal[6, 3] cal[7, 2] <- mini[2] cal[7, 3] <- mini[3] cal[7, 1] <- 1 - cal[7, 2] - cal[7, 3] cal[8, 2] <- mini[2] cal[8, 3] <- maxi[3] cal[8, 1] <- 1 - cal[8, 2] - cal[8, 3] cal[9, 2] <- maxi[2] cal[9, 3] <- mini[3] cal[9, 1] <- 1 - cal[9, 2] - cal[9, 3] mini <- apply(cal, 2, min) mini <- round(mini, digits = 4) maxi <- apply(cal, 2, max) maxi <- round(maxi, digits = 4) ampli <- maxi - mini if(!adjust) { mini <- c(0, 0, 0) maxi <- c(1, 1, 1) } return(list(mini = mini, maxi = maxi)) } ## ## calcul maximum et minimum pour triangle ## ## data as list ## .trranges <- function(data, mini, maxi, adjust){ ## if(is.null(mini))mini <-c(0,0,0) ## if(is.null(maxi))maxi <-c(1,1,1) ## if(adjust){ ## if(!is.null(data$frame)) ## ta <- t(apply(eval(data$ta, envir = sys.frame(data$frame)), 1, function(x) x/sum(x))) ## else ## ta <- t(apply(data$ta, 1, function(x)x/sum(x))) ## tb <- t(apply(ta, 1, function(x) x/sum(x))) ## mini <- apply(tb, 2, min) ## maxi <- apply(tb, 2, max) ## mini <- (floor(mini/0.1))/10 ## maxi <- (floor(maxi/0.1) + 1)/10 ## mini[mini < 0] <- 0 ## maxi[maxi > 1] <- 1 ## } ## ampli <- maxi-mini ## amplim <- max(ampli) ## if(! all(ampli == amplim)){#on doit avoir la meme chose. ## for(i in 1:3){ ## diffv <- amplim -ampli[i]/2 ## mini[i] <- mini[i]-diffv ## maxi[i] <- maxi[i]+diffv ## if(mini[i]<0){ ## maxi[i] <- maxi[i]-mini[i] ## mini[i] <- 0 ## } ## if(maxi[i]>1){ ## mini[i] <- mini[i]-(maxi[i]-1) ## maxi[i] <- 1 ## } ## } ## } ## if(any(mini<0) | any(maxi>1)) ## stop("wrong calculus for limits", call. = FALSE) ## ##"ici partie cal non reprise. a voir ensuite ## return(list(mini=mini, maxi=maxi)) ## } .showpos <- function(object) { ## from ade4 mini <- object@g.args$min3d maxi <- object@g.args$max3d w <- matrix(0, 3, 3) w[1, 1] <- mini[1] w[1, 2] <- mini[2] w[1, 3] <- maxi[3] w[2, 1] <- maxi[1] w[2, 2] <- mini[2] w[2, 3] <- mini[3] w[3, 1] <- mini[1] w[3, 2] <- maxi[2] w[3, 3] <- mini[3] smallT <- .coordtotriangleM(matrix(c(0, 0, 1, 1, 0, 0, 0, 1, 0), byrow = TRUE, ncol = 3), mini3 = rep(0, 3), maxi3 = rep(1, 3))[, -1] A <- smallT[1, ] B <- smallT[2, ] C <- smallT[3, ] shadowS <- .coordtotriangleM(w, c(0, 0, 0), c(1, 1, 1))[, -1] a <- shadowS[1, ] b <- shadowS[2, ] c <- shadowS[3, ] aa <- xyplot(0 ~ 0, xlim = c(-0.7, 0.7), ylim = c(-0.55, 0.9), aspect = "iso", scale = list(draw = FALSE), xlab = NULL, ylab = NULL, par.settings = list(axis.line = list(col = "transparent")), panel = function(...) { panel.polygon(c(A[1], B[1], C[1]), c(A[2], B[2], C[2])) panel.polygon(c(a[1], b[1], c[1]), c(a[2], b[2], c[2]), col = grey(0.75)) }) invisible(aa) } adegraphics/R/T.image.R0000644000176200001440000001645713742303021014344 0ustar liggesuserssetClass( Class = "T.image", contains = "ADEg.T" ) setMethod( f = "prepare", signature = "T.image", definition = function(object) { name_obj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) if(object@data$storeData) { coordsx <- object@data$coordsx coordsy <- object@data$coordsy z <- as.vector(as.matrix(object@data$dftab)) dftab <- object@data$dftab labelsx <- object@data$labelsx labelsy <- object@data$labelsy } else { coordsx <- eval(object@data$coordsx, envir = sys.frame(object@data$frame)) coordsy <- eval(object@data$coordsy, envir = sys.frame(object@data$frame)) z <- as.vector(as.matrix(eval(object@data$dftab, envir = sys.frame(object@data$frame)))) dftab <- eval(object@data$dftab, envir = sys.frame(object@data$frame)) labelsx <- eval(object@data$labelsx, envir = sys.frame(object@data$frame)) labelsy <- eval(object@data$labelsy, envir = sys.frame(object@data$frame)) } if(is.null(object@g.args$breaks)) object@s.misc$breaks.update <- pretty(z, object@g.args$nclass) else object@s.misc$breaks.update <- object@g.args$breaks object@s.misc$breaks.update <- breakstest(object@s.misc$breaks.update, z, n = length(object@s.misc$breaks.update)) n <- length(object@s.misc$breaks.update) ## setting colors if(!is.null(object@g.args$col)) { if(length(object@g.args$col) < (n - 1)) stop(paste("not enough colors defined, at least ", (n - 1), " colors expected", sep = ""), call. = FALSE) adegtot$ppoints$col <- object@g.args$col[1:(n - 1)] ## color given by the user } else { if(is.null(object@adeg.par$ppoints$col)) adegtot$ppoints$col <- adegtot$ppalette$quanti(n - 1) } ## inspired by level.colors from lattice if(adegtot$plegend$drawColorKey) adegtot$ptable$y$pos <- "left" if(is.null(object@adeg.par$pgrid$col)) adegtot$pgrid$col <- "black" if(is.null(object@adeg.par$pgrid$lwd)) adegtot$pgrid$lwd <- 0.6 if(is.null(object@adeg.par$pgrid$draw)) adegtot$pgrid$draw <- FALSE ## no cells border by default if(is.null(labelsx)) adegtot$ptable$x$tck <- 0 if(is.null(labelsy)) adegtot$ptable$y$tck <- 0 ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph ## TODO: improve the code to avoid some repetition with the parent function wx <- range(coordsx) dx <- (diff(wx) + 1) / length(coordsx) wy <- range(coordsy) dy <- (diff(wy) + 1) / length(coordsy) ## add an half cell at both sides object@g.args$xlim <- wx + c(-0.5, 0.5) * dx object@g.args$ylim <- wy + c(-0.5, 0.5) * dy assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "T.image", definition = function(object, x, y) { ## x is data$coordsx and y is data$coordsy if(object@data$storeData) dftab <- as.matrix(object@data$dftab) else dftab <- as.matrix(eval(object@data$dftab, envir = sys.frame(object@data$frame))) xx <- x[!is.na(x)] yy <- y[!is.na(y)] zz <- as.vector(dftab) dx <- diff(sort(xx)) / 2 dy <- diff(sort(yy)) / 2 dx <- c(dx[1], dx) dy <- c(dy[1], dy) ## draw values panel.levelplot.raster(x = xx[col(dftab)], y = yy[row(dftab)], z = zz, subscripts = TRUE, col.regions = object@adeg.par$ppoints$col, at = object@s.misc$breaks.update, contour = FALSE, region = TRUE) ## draw grid (cells border) if(object@adeg.par$pgrid$draw) { xbis <- c(min(xx) - dx[1], xx + dx, max(xx) + dx[length(dx)]) ybis <- c(min(yy) - dy[1], yy + dy, max(yy) + dy[length(dy)]) panel.abline(h = ybis, v = xbis, col = object@adeg.par$pgrid$col, lwd = object@adeg.par$pgrid$lwd, lty = object@adeg.par$pgrid$lty) } }) ## TODO: decider quelle classe on prend en compte ## a faire: verifier espacement correct de coordsx et coordsy ## que faire de la sous grille? ## attention, coordsx et coordsy ne serve qu'a donner l'ordre de trace, ils seront considere comme egalement espace, sinon fonction a revoir table.image <- function(dftab, coordsx = 1:ncol(as.matrix(dftab)), coordsy = nrow(as.matrix(dftab)):1, labelsx = NULL, labelsy = NULL, nclass = 3, breaks = NULL, col = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## 4 different types can be used as tab : ## distance matrix (dist), contingency table (table), data.frame or matrix thecall <- .expand.call(match.call()) dftab <- eval(thecall$dftab, envir = sys.frame(sys.nframe() + pos)) ## modify coordsx/coordsy positions (we use only the order not the values) thecall$coordsx <- call("rank", thecall$coordsx, ties.method = "first") thecall$coordsy <- call("rank", thecall$coordsy, ties.method = "first") if(inherits(dftab, "dist")) { if(missing(labelsx)){ thecall$labelsx <- labelsx <- NULL if(!is.null(attr(dftab, "Labels"))) if(storeData) labelsx <- attr(dftab, "Labels") else thecall$labelsx <- call("attr", thecall$dftab, "Labels") } if(missing(labelsy)){ thecall$labelsy <- labelsy <- NULL if(!is.null(attr(dftab, "Labels"))) if(storeData) labelsy <- attr(dftab, "Labels") else thecall$labelsy <- call("attr", thecall$dftab, "Labels") } ## coordsx and coordsy should be identical for dist objects (symmetric) thecall$coordsx <- call(":", 1, call("attr", thecall$dftab, "Size")) thecall$coordsy <- call(":", call("attr", thecall$dftab, "Size"), 1) } else { ## data.frame, matrix, table if(missing(labelsy)){ thecall$labelsy <- labelsy <- NULL if(!is.null(rownames(dftab))) if(storeData) labelsy <- rownames(dftab) else thecall$labelsy <- call("rownames", thecall$dftab) } if(missing(labelsx)){ thecall$labelsx <- labelsx <- NULL if(!is.null(colnames(dftab))) if(storeData) labelsx <- colnames(dftab) else thecall$labelsx <- call("colnames", thecall$dftab) } } ## parameters sorted sortparameters <- sortparamADEg(...) ## creation of the ADEg object if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) g.args <- c(sortparameters$g.args, list(breaks = breaks, nclass = nclass, col = col)) if(storeData) tmp_data <- list(dftab = dftab, coordsx = coordsx, coordsy = coordsy, labelsx = labelsx, labelsy = labelsy, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(dftab = thecall$dftab, coordsx = thecall$coordsx, coordsy = thecall$coordsy, labelsx = thecall$labelsx, labelsy = thecall$labelsy, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "T.image", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = match.call()) ## preparation of the graph prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) else if(plot) print(object) invisible(object) } adegraphics/R/addhist.R0000644000176200001440000001523013742303021014464 0ustar liggesuserssetMethod( f = "addhist", signature = "ADEg.S2", definition = function(object, bandwidth, gridsize = 60, kernel = "normal", cbreaks = 2, storeData = TRUE, plot = TRUE, pos = -1, ...) { thecall <- .expand.call(match.call()) dfcall <- thecall$object dfxycall <- substitute(dfcall@data$dfxy) if(!(inherits(object, "ADEg.S2"))) stop("Only implemented for 'ADEg.S2' object") if(storeData) { dfxy <- object@data$dfxy xax <- object@data$xax yax <- object@data$yax } else { dfxy <- eval(object@data$dfxy, envir = sys.frame(object@data$frame)) xax <- eval(object@data$xax, envir = sys.frame(object@data$frame)) yax <- eval(object@data$yax, envir = sys.frame(object@data$frame)) } ## sorting parameters graphsnames <- c(all.names(substitute(object)), "densX", "densY", "link") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames) params <- vector("list", 4) names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) update(object, sortparameters[[1]], plot = FALSE) ## setting positions positions <- layout2position(matrix(c(2, 4, 1, 3), 2, 2, byrow = TRUE), c(3, 1) / 2, c(3, 1) / 2, FALSE) ## grid computation xlimX <- object@g.args$xlim ylimY <- object@g.args$ylim breaks <- object@s.misc$backgrid cgrid <- breaks$d / cbreaks bb1 <- range(breaks$x0[!is.na(breaks$x0)]) bb2 <- range(breaks$y0[!is.na(breaks$y0)]) breaksX <- seq(from = bb1[1], to = bb1[2], by = cgrid) breaksY <- seq(from = bb2[1], to = bb2[2], by = cgrid) while(min(breaksX) > xlimX[1]) breaksX <- c((min(breaksX) - cgrid), breaksX) while(max(breaksX) < xlimX[2]) breaksX <- c(breaksX, (max(breaksX) + cgrid)) while(min(breaksY) > ylimY[1]) breaksY <- c((min(breaksY) - cgrid), breaksY) while(max(breaksY) < ylimY[2]) breaksY <- c(breaksY, (max(breaksY) + cgrid)) ## limits and graduation dfxaxcall <- call("[", dfxycall, 1:NROW(eval(dfxycall)), substitute(xax)) dfxaxcallplus <- call("~", dfxaxcall, 1) dfyaxcall <- call("[", dfxycall, 1:NROW(eval(dfxycall)), substitute(yax)) dfyaxcallplus <- call("~", dfyaxcall, 1) limcalX <- hist(dfxy[, xax], breaksX, plot = FALSE) limcalXcall <- call("hist", substitute(dfxaxcall), breaksX, plot = FALSE) limcalY <- hist(dfxy[, yax], breaksY, plot = FALSE) limcalYcall <- call("hist", substitute(dfyaxcall), breaksY, plot = FALSE) top <- 1.1 * max(c(limcalX$counts, limcalY$counts)) xlimY <- ylimX <- c(0, top) drawLines <- pretty(0:top) drawLines <- drawLines[-c(1, length(drawLines))] if(!missing(bandwidth)) { densiX <- bkde(dfxy[, xax], kernel = kernel, bandwidth = bandwidth, gridsize = gridsize) densiXcall <- call("bkde", substitute(dfxaxcall), kernel = kernel, bandwidth = bandwidth, gridsize = gridsize) densiY <- bkde(dfxy[, yax], kernel = kernel, bandwidth = bandwidth, gridsize = gridsize) densiYcall <- call("bkde", substitute(dfyaxcall), kernel = kernel, bandwidth = bandwidth, gridsize = gridsize) } else { densiX <- bkde(dfxy[, xax], kernel = kernel, gridsize = gridsize) densiXcall <- call("bkde", substitute(dfxaxcall), kernel = kernel, gridsize = gridsize) densiY <- bkde(dfxy[, yax], kernel = kernel, gridsize = gridsize) densiYcall <- call("bkde", substitute(dfyaxcall), kernel = kernel, gridsize = gridsize) } ## trellis creation g2 <- xyplot(dfxy[, xax] ~ 1, xlim = xlimX, ylim = ylimX, horizontal = TRUE, scales = list(draw = FALSE), xlab = NULL, ylab = NULL, histValues = limcalX, drawLines = drawLines, densi = densiX, params = sortparameters[[2]], panel = function(histValues, horizontal, drawLines, densi, params) adeg.panel.hist(histValues = histValues, horizontal = horizontal, drawLines = drawLines, densi = densi, params = params)) g2$call <- call("xyplot", dfxaxcallplus, xlim = substitute(xlimX), ylim = substitute(ylimX), horizontal = TRUE, scales = list(draw = FALSE), xlab = NULL, ylab = NULL, histValues = limcalXcall, drawLines = substitute(drawLines), densi = substitute(densiXcall), params = sortparameters[[2]], panel = function(histValues, horizontal, drawLines, densi, params) adeg.panel.hist(histValues = histValues, horizontal = horizontal, drawLines = drawLines, densi = densi, params = params)) g3 <- xyplot(dfxy[, yax] ~ 1, xlim = xlimY, ylim = ylimY, horizontal = FALSE, scales = list(draw = FALSE), xlab = NULL, ylab = NULL, histValues = limcalY, drawLines = drawLines, densi = densiY, params = sortparameters[[3]], panel = function(histValues, horizontal, drawLines, densi, params) adeg.panel.hist(histValues = histValues, horizontal = horizontal, drawLines = drawLines, densi = densi, params = params)) g3$call <- call("xyplot", dfyaxcallplus, xlim = substitute(xlimY), ylim = substitute(ylimY), horizontal = FALSE, scales = list(draw = FALSE), xlab = NULL, ylab = NULL, histValues = limcalYcall, drawLines = substitute(drawLines), densi = substitute(densiYcall), params = sortparameters[[3]], panel = function(histValues, horizontal, drawLines, densi, params) adeg.panel.hist(histValues = histValues, horizontal = horizontal, drawLines = drawLines, densi = densi, params = params)) g4 <- xyplot(1 ~ 1, xlim = xlimY, ylim = ylimX, scales = list(draw = FALSE), xlab = NULL, ylab = NULL, drawLines = drawLines, params = sortparameters[[4]], panel = function(drawLines, params) adeg.panel.join(drawLines = drawLines, params = params)) g4$call <- call("xyplot", 1 ~ 1, xlim = substitute(xlimY), ylim = substitute(ylimX), scales = list(draw = FALSE), xlab = NULL, ylab = NULL, drawLines = substitute(drawLines), params = sortparameters[[4]], panel = function(drawLines, params) adeg.panel.join(drawLines = drawLines, params = params)) ## ADEgS creation and display obj <- new(Class = "ADEgS", ADEglist = list(object, g2, g3, g4), positions = positions, add = matrix(0, ncol = 4, nrow = 4), Call = match.call()) names(obj) <- graphsnames if(plot) print(obj) invisible(obj) })adegraphics/R/Tr.match.R0000644000176200001440000001220214354572102014530 0ustar liggesuserssetClass( Class = "Tr.match", contains = "ADEg.Tr", ) setMethod( f = "initialize", signature = "Tr.match", definition = function(.Object, data = list(dfxyz = NULL, labels = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.Tr initialize .Object@data$labels <- data$labels return(.Object) }) setMethod( f = "prepare", signature = "Tr.match", definition = function(object) { name_obj <- deparse(substitute(object)) if(object@data$storeData) { df <- object@data$dfxyz } else { df <- eval(object@data$dfxyz, envir = sys.frame(object@data$frame)) } ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph ## calculate 2D coordinates df <- sweep(df, 1, rowSums(df), "/") n <- NROW(df) / 2 df1 <- df[1:n,] df2 <- df[(1 + n):(2 * n), ] object@stats$coords2d1 <- .coordtotriangleM(df1, mini3 = object@g.args$min3d, maxi3 = object@g.args$max3d)[, 2:3] object@stats$coords2d2 <- .coordtotriangleM(df2, mini3 = object@g.args$min3d, maxi3 = object@g.args$max3d)[, 2:3] ## never optimized labels for triangle.match object@adeg.par$plabels$optim <- FALSE assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "Tr.match", definition = function(object, x, y) { if(object@data$storeData) { labels <- object@data$labels df <- object@data$dfxyz } else { labels <- eval(object@data$labels, envir = sys.frame(object@data$frame)) df <- eval(object@data$dfxyz, envir = sys.frame(object@data$frame)) } if(NROW(df) %% 2) stop("error in panel method : unable to split the two datasets") ## draw points if(any(object@adeg.par$ppoints$cex > 0)) do.call("panel.points", c(list(x = object@stats$coords2d1[, 1], y = object@stats$coords2d1[, 2]), object@adeg.par$ppoints)) ## draw arrows panel.arrows(x0 = object@stats$coords2d1[, 1], y0 = object@stats$coords2d1[, 2] , y1 = object@stats$coords2d2[, 2], x1 = object@stats$coords2d2[, 1], angle = object@adeg.par$parrows$angle, length = object@adeg.par$parrows$length, ends = object@adeg.par$parrows$end, lwd = object@adeg.par$plines$lwd, col = object@adeg.par$plines$col, lty = object@adeg.par$plines$lty) if(any(object@adeg.par$plabels$cex > 0)) { xlab <- (object@stats$coords2d1[, 1] + object@stats$coords2d2[, 1]) / 2 ylab <- (object@stats$coords2d1[, 2] + object@stats$coords2d2[, 2]) / 2 adeg.panel.label(xlab, ylab, labels = labels, object@adeg.par$plabels) } }) triangle.match <- function(dfxyz1, dfxyz2, labels = row.names(as.data.frame(dfxyz1)), min3d = NULL, max3d = NULL, adjust = TRUE, showposition = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters thecall <- .expand.call(match.call()) data1 <- try(as.data.frame(eval(thecall$dfxyz1, envir = sys.frame(sys.nframe() + pos))), silent = TRUE) data2 <- try(as.data.frame(eval(thecall$dfxyz2, envir = sys.frame(sys.nframe() + pos))), silent = TRUE) if(inherits(data1, "try-error") || inherits(data2, "try-error") || is.null(thecall$dfxyz1) || is.null(thecall$dfxyz2)) ## wrong conversion stop("non convenient selection for dfxyz1 or dfxyz2 (can not be converted to dataframe)") sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { object <- multi.facets.Tr(thecall, samelimits = sortparameters$g.args$samelimits) } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(adjust = adjust, min3d = min3d, max3d = max3d)) if(storeData) tmp_data <- list(dfxyz = rbind(dfxyz1, dfxyz2), labels = labels, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(dfxyz = call("rbind", thecall$dfxyz1, thecall$dfxyz2), labels = thecall$labels, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "Tr.match", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = match.call()) ## preparation prepare(object) setlatticecall(object) if(showposition & add) { print("cannot show position and add") ## can be done, but modifies the meaning of the superposition showposition <- FALSE } if(showposition) object <- new(Class = "ADEgS", ADEglist = list("triangle" = object, "positions" = .showpos(object)), positions = rbind(c(0, 0, 1, 1), c(0, 0.7, 0.3, 1)), add = matrix(0, ncol = 2, nrow = 2), Call = match.call()) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/C1.dotplot.R0000644000176200001440000001032113742303021014767 0ustar liggesuserssetClass( Class = "C1.dotplot", contains = "ADEg.C1" ) setMethod( f = "initialize", signature = "C1.dotplot", definition = function(.Object, data = list(score = NULL, at = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.C1 initialize .Object@data$at <- data$at validObject(.Object) return(.Object) }) setMethod( f = "prepare", signature = "C1.dotplot", definition = function(object) { nameobj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) if(object@data$storeData) { score <- object@data$score at <- object@data$at } else { score <- eval(object@data$score, envir = sys.frame(object@data$frame)) at <- eval(object@data$at, envir = sys.frame(object@data$frame)) } score <- as.matrix(score)[, 1] ## to manage 'score' when it is a data.frame with only one column ## change some defaults adegtot$p1d$rug$draw <- FALSE ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph if(object@adeg.par$p1d$horizontal && is.null(object@g.args$ylim)) object@g.args$ylim <- setlimits1D(min(at), max(at), 0, FALSE) if(!object@adeg.par$p1d$horizontal && is.null(object@g.args$xlim)) object@g.args$xlim <- setlimits1D(min(at), max(at), 0, FALSE) assign(nameobj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "C1.dotplot", definition = function(object, x, y) { ## Drawing dotchart ## x is the index ## y is the score ## get some parameters pscore <- object@adeg.par$p1d ppoints <- lapply(object@adeg.par$ppoints, FUN = function(x) {rep(x, length.out = length(x))}) plines <- lapply(object@adeg.par$plines, FUN = function(x) {rep(x, length.out = length(x))}) ## reorder the values y <- y[order(x)] x <- sort(x) ## Starts the display ## depends on the parametres horizontal ## rug.draw and reverse are always considered as FALSE if(pscore$horizontal) { x.tmp <- y y.tmp <- x panel.segments(object@adeg.par$porigin$origin[1], y.tmp, x.tmp, y.tmp, lwd = plines$lwd, lty = plines$lty, col = plines$col) } else { x.tmp <- x y.tmp <- y panel.segments(x.tmp, object@adeg.par$porigin$origin[1], x.tmp, y.tmp, lwd = plines$lwd, lty = plines$lty, col = plines$col) } panel.dotplot(x = x.tmp, y = y.tmp, horizontal = pscore$horizontal, pch = ppoints$pch, cex = ppoints$cex, col = ppoints$col, alpha = ppoints$alpha, col.line = "transparent") }) s1d.dotplot <- function(score, at = 1:NROW(score), facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters thecall <- .expand.call(match.call()) score <- eval(thecall$score, envir = sys.frame(sys.nframe() + pos)) ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if(NCOL(score) == 1) object <- multi.facets.C1(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple scores") } ## multiple scores else if(NCOL(score) > 1) { object <- multi.score.C1(thecall) } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object if(storeData) tmp_data <- list(score = score, at = at, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(score = thecall$score, at = thecall$at, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "C1.dotplot", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = sortparameters$g.args, Call = match.call()) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/S2.value.R0000644000176200001440000001546614354572717014502 0ustar liggesusers######################################################### ### s.value ## ######################################################### ## TO DO: calcul place legend, taille des points ## Remarque ==> pour size, si couleur selon <0 ou >0 il faut s'assurer que 0 ne sera donc pas dans un intervalle? (inclus ex [-1, 1]) setClass( Class = "S2.value", contains = "ADEg.S2" ) setMethod( f = "initialize", signature = "S2.value", definition = function(.Object, data = list(dfxy = NULL, z = NULL, xax = 1, yax = 2, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.S2 initialize .Object@data$z <- data$z return(.Object) }) setMethod( f = "prepare", signature = "S2.value", definition = function(object) { name_obj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) if(object@data$storeData) z <- object@data$z else z <- eval(object@data$z, envir = sys.frame(object@data$frame)) if(is.null(object@adeg.par$ppoints$alpha)) adegtot$ppoints$alpha <- 0.9 if(is.null(object@adeg.par$ppoints$cex)) adegtot$ppoints$cex <- 1 if(is.null(object@adeg.par$porigin$include) & (any(names(object@g.args) %in% c("Sp", "nbobject")))) adegtot$porigin$include <- FALSE if(is.null(object@g.args$breaks)) object@s.misc$breaks.update <- pretty(z, object@g.args$nclass) else object@s.misc$breaks.update <- object@g.args$breaks object@s.misc$breaks.update <- breakstest(object@s.misc$breaks.update, z, n = length(object@s.misc$breaks.update)) n <- length(object@s.misc$breaks.update) ## symbols for z = center if(!is.null(object@g.args$centerpar)) { default <- list(pch = 4, cex = 1, col = "black") if(is.list(object@g.args$centerpar)) object@g.args$centerpar <- modifyList(default, object@g.args$centerpar, keep.null = TRUE) else object@g.args$centerpar <- default } if(is.null(object@adeg.par$psub$position)) adegtot$psub$position <- "topleft" ## setting colors if(!is.null(object@g.args$col)) { switch(object@g.args$method, size = { if(length(object@g.args$col) != 2) stop("if method size choosen, col vector should be size 2", call. = FALSE) adegtot$ppoints$col <- object@g.args$col ## color given by the user }, color = { if(length(object@g.args$col) < (n - 1)) stop(paste("not enough colors defined for method color, at least ", (n - 1), " colors expected", sep = ""), call. = FALSE) adegtot$ppoints$fill <- object@g.args$col[1:(n - 1)] ## color given by the user }) } else { if(object@g.args$method == "color") adegtot$ppoints$fill <- adegtot$ppalette$quanti(n - 1) else adegtot$ppoints$col <- adegtot$ppalette$quanti(2) } ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph ## never optimized labels for s.value object@adeg.par$plabels$optim <- FALSE assign(name_obj, object, envir = parent.frame()) }) ## Draw symbols according to the different methods setMethod( f = "panel", signature = "S2.value", definition = function(object, x, y) { if(object@data$storeData) zorig <- object@data$z else zorig <- eval(object@data$z, envir = sys.frame(object@data$frame)) adeg.panel.values(x = x, y = y, z = zorig, method = object@g.args$method, symbol = object@g.args$symbol, ppoints = object@adeg.par$ppoints, breaks = object@s.misc$breaks.update, centerpar = object@g.args$centerpar, center = object@g.args$center) }) s.value <- function(dfxy, z, breaks = NULL, xax = 1, yax = 2, method = c("size", "color"), symbol = c("square", "circle", "diamond", "uptriangle", "downtriangle"), col = NULL, nclass = 4, center = 0, centerpar = NULL, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters thecall <- .expand.call(match.call()) thecall$method <- match.arg(method) if(thecall$method == "color") { if(center != 0 | !is.null(centerpar)) warning("'center' and 'centerpar' are not used with 'color' method", call. = FALSE) center <- 0 centerpar <- NULL } thecall$center <- center thecall$centerpar <- centerpar thecall$symbol <- match.arg(symbol) df <- try(as.data.frame(eval(thecall$dfxy, envir = sys.frame(sys.nframe() + pos))), silent = TRUE) z <- eval(thecall$z, envir = sys.frame(sys.nframe() + pos)) if(inherits(df, "try-error") | is.null(thecall$dfxy)) ## non convenient dfxy argument stop("non convenient selection for dfxy (can not be converted to dataframe)", call. = FALSE) if(NROW(df) != NROW(z)) stop("dfxy and z should have the same number of rows", call. = FALSE) ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if((length(xax) == 1 & length(yax) == 1) & NCOL(z) == 1) object <- multi.facets.S2(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple xax/yax or multiple z", call. = FALSE) } ## multiple axes else if((length(xax) > 1 | length(yax) > 1)) { if(NCOL(z) == 1) object <- multi.ax.S2(thecall) else stop("Multiple xax/yax are not allowed with multiple z", call. = FALSE) } ## multiple z else if(NCOL(z) > 1) { object <- multi.variables.S2(thecall, "z") } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(method = thecall$method, symbol = thecall$symbol, center = center, breaks = breaks, col = col, nclass = nclass, centerpar = centerpar)) if(storeData) tmp_data <- list(dfxy = dfxy, xax = xax, yax = yax, z = z, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(dfxy = thecall$dfxy, xax = xax, yax = yax, z = thecall$z, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "S2.value", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = as.call(thecall)) ## preparation of the graph prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(! add & plot) print(object) invisible(object) } adegraphics/R/ADEg.T.R0000644000176200001440000002226313742303021014012 0ustar liggesusers#################################################### ## Table/matrix/dist plot ## #################################################### setClass( Class = "ADEg.T", contains = c("ADEg", "VIRTUAL"), slots = c(data = "list") ) setMethod( f = "initialize", signature = "ADEg.T", definition = function(.Object, data = list(dftab = NULL, coordsx = NULL, coordsy = NULL, labelsx = NULL, labelsy = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, ...) ## ADEg initialize .Object@data <- data return(.Object) }) setMethod( f = "prepare", signature = "ADEg.T", definition = function(object) { name_obj <- deparse(substitute(object)) if(object@data$storeData){ coordsx <- object@data$coordsx coordsy <- object@data$coordsy } else { coordsx <- eval(object@data$coordsx, envir = sys.frame(object@data$frame)) coordsy <- eval(object@data$coordsy, envir = sys.frame(object@data$frame)) } ## cell size object@s.misc$axes$dx <- ifelse(length(coordsx) == 1, 1, diff(range(coordsx)) / length(coordsx)) object@s.misc$axes$dy <- ifelse(length(coordsy) == 1, 1, diff(range(coordsy)) / length(coordsy)) ## default margins if(object@adeg.par$ptable$x$pos == "top" & object@adeg.par$ptable$margin$top <= 5) object@adeg.par$ptable$margin$top <- 12 if(object@adeg.par$ptable$x$pos == "bottom" & object@adeg.par$ptable$margin$bottom <= 5) object@adeg.par$ptable$margin$bottom <- 12 if(object@adeg.par$ptable$y$pos == "right" & object@adeg.par$ptable$margin$right <= 5) object@adeg.par$ptable$margin$right <- 12 if(object@adeg.par$ptable$y$pos == "left" & object@adeg.par$ptable$margin$left <= 5) object@adeg.par$ptable$margin$left <- 12 object@g.args$xlim <- range(coordsx) + c(-1, 1) * object@s.misc$axes$dx object@g.args$ylim <- range(coordsy) + c(-1, 1) * object@s.misc$axes$dy object@trellis.par <- c(object@trellis.par, list(clip = list(panel = "off"), layout.heights = list(top.padding = object@adeg.par$ptable$margin$top, bottom.padding = object@adeg.par$ptable$margin$bottom), layout.widths = list(left.padding = object@adeg.par$ptable$margin$left, right.padding = object@adeg.par$ptable$margin$right))) assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panelbase", signature = "ADEg.T", definition = function(object, x, y) { callNextMethod() ## draw the box and the segments grid <- object@adeg.par$pgrid ## draw grid if(object@data$storeData) { xpos <- object@data$coordsx ypos <- object@data$coordsy labelsx <- object@data$labelsx labelsy <- object@data$labelsy } else { xpos <- eval(object@data$coordsx, envir = sys.frame(object@data$frame)) ypos <- eval(object@data$coordsy, envir = sys.frame(object@data$frame)) labelsx <- eval(object@data$labelsx, envir = sys.frame(object@data$frame)) labelsy <- eval(object@data$labelsy, envir = sys.frame(object@data$frame)) } nx <- length(xpos) ny <- length(ypos) ## draw grid (except for T.image) if(grid$draw & !inherits(object, "T.image")) panel.segments( x0 = c(xpos, rep(min(xpos)- object@s.misc$axes$dx, length.out = ny)), x1 = c(xpos, rep(max(xpos) + object@s.misc$axes$dx, length.out = ny)), y0 = c(rep(min(ypos) - object@s.misc$axes$dy, length.out = nx), ypos), y1 = c(rep(max(ypos) + object@s.misc$axes$dy, length.out = nx), ypos), col = grid$col, lwd = grid$lwd, lty = grid$lty) ## draw ticks limis <- current.panel.limits() ## if in ptable$x (or y) $tck; number without unit, considered as 'mm', otherwise used with the unit defined by user dxticks <- convertHeight(if(is.unit(object@adeg.par$ptable$x$tck)) object@adeg.par$ptable$x$tck else unit(object@adeg.par$ptable$x$tck, "mm"), unitTo = "native", valueOnly = TRUE) dyticks <- convertWidth(if(is.unit(object@adeg.par$ptable$y$tck)) object@adeg.par$ptable$y$tck else unit(object@adeg.par$ptable$y$tck, "mm"), unitTo = "native", valueOnly = TRUE) ## get parameters linespar <- modifyList(as.list(object@trellis.par$axis.line), trellis.par.get()$axis.line, keep.null = TRUE) textspar <- modifyList(as.list(object@trellis.par$axis.text), trellis.par.get()$axis.text, keep.null = TRUE) if(textspar$cex > 0 & dyticks > 0) { ## draw ticks for y y0axes <- ypos ## regular positions y1axes <- seq(from = min(ypos), to = max(ypos), length.out = ny)[rank(ypos, ties.method = "first")] yylab <- y1axes drawing <- FALSE if(any(object@adeg.par$ptable$y$pos == "right")) { if(any(is.na(object@adeg.par$ptable$y$adj))) adj <- c(0, 0.5) else adj <- object@adeg.par$ptable$y$adj x0axes <- limis$xlim[2] x1axes <- limis$xlim[2] + dyticks if(textspar$cex) xxlab <- limis$xlim[2] + 1.1 * dyticks drawing <- TRUE } if(any(object@adeg.par$ptable$y$pos == "left")) { if(any(is.na(object@adeg.par$ptable$y$adj))) adj <- c(1, 0.5) else adj <- object@adeg.par$ptable$y$adj x0axes <- limis$xlim[1] x1axes <- limis$xlim[1] - dyticks if(textspar$cex) xxlab <- limis$xlim[1] - 1.1 * dyticks drawing <- TRUE } if(drawing) { panel.segments(x0 = x0axes, y0 = y0axes, x1 = x1axes, y1 = y1axes, lwd = linespar$lwd, lty = linespar$lty, alpha = linespar$alpha, col = linespar$col) if(textspar$cex) panel.text(labels = labelsy, x = xxlab, y = yylab, cex = textspar$cex, col = textspar$col, font = textspar$font, lineheight = textspar$lineheight, alpha = textspar$alpha, adj = adj, srt = object@adeg.par$ptable$x$srt) } } if(textspar$cex > 0 & dxticks > 0) { ## draw ticks for x x0axes <- xpos ## regular positions x1axes <- seq(from = min(xpos), to = max(xpos), length.out = nx)[rank(xpos, ties.method = "first")] xxlab <- x1axes drawing <- FALSE if(any(object@adeg.par$ptable$x$pos == "top")) { if(any(is.na(object@adeg.par$ptable$x$adj))) adj <- c(0, 0.5) else adj <- object@adeg.par$ptable$x$adj y0axes <- limis$ylim[2] y1axes <- limis$ylim[2] + dxticks if(textspar$cex > 0) yylab <- limis$ylim[2] + 1.1 * dxticks drawing <- TRUE } if(any(object@adeg.par$ptable$x$pos == "bottom")) { if(any(is.na(object@adeg.par$ptable$x$adj))) adj <- c(1, 0.5) else adj <- object@adeg.par$ptable$x$adj y0axes <- limis$ylim[1] y1axes <- limis$ylim[1] - dxticks if(textspar$cex > 0) yylab <- limis$ylim[1] - 1.1 * dxticks drawing <- TRUE } if(drawing) { panel.segments(x0 = x0axes, y0 = y0axes, x1 = x1axes, y1 = y1axes, lwd = linespar$lwd, lty = linespar$lty, alpha = linespar$alpha, col = linespar$col) if(textspar$cex) panel.text(labels = labelsx, x = xxlab, y = yylab, cex = textspar$cex, col = textspar$col, font = textspar$font, lineheight = textspar$lineheight, alpha = textspar$alpha, adj = adj, srt = object@adeg.par$ptable$y$srt) } } }) setMethod( f = "setlatticecall", signature = "ADEg.T", definition = function(object) { name_obj <- deparse(substitute(object)) ## background and box object@trellis.par$panel.background$col <- object@adeg.par$pbackground$col if(!object@adeg.par$pbackground$box) object@trellis.par$axis.line$col <- "transparent" else object@trellis.par$axis.line$col <- "black" arguments <- list( par.settings = object@trellis.par, key = createkey(object), legend = createcolorkey(object), scales = list(draw = FALSE), panel = function(...) { panelbase(object, ...) panel(object, ...) }) object@lattice.call$arguments <- arguments object@lattice.call$graphictype <- "xyplot" ## get lattice arguments (set unspecified to NULL) argnames <- c("main", "sub", "xlab", "ylab") largs <- object@g.args[argnames] names(largs) <- argnames ## add xlim and ylim if not NULL if("xlim" %in% names(object@g.args)) largs["xlim"] <- object@g.args["xlim"] if("ylim" %in% names(object@g.args)) largs["ylim"] <- object@g.args["ylim"] object@lattice.call$arguments <- c(object@lattice.call$arguments, largs, list(strip = FALSE)) assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "gettrellis", signature = "ADEg.T", definition = function(object) { if(object@data$storeData) { xdata <- object@data$coordsx ydata <- object@data$coordsy } else { xdata <- eval(object@data$coordsx, envir = sys.frame(object@data$frame)) ydata <- eval(object@data$coordsy, envir = sys.frame(object@data$frame)) } tmptrellis <- do.call(what = object@lattice.call$graphictype, args = c(formula(ydata ~ xdata), object@lattice.call$arguments, environment())) return(tmptrellis) }) adegraphics/R/ADEg.C1.R0000644000176200001440000002436214354571670014075 0ustar liggesusers#################################################### ## Curves Plot ## ## 1d score represents in 2D plot ## #################################################### setClass( Class = "ADEg.C1", contains = c("ADEg", "VIRTUAL"), slots = c(data = "list") ) setMethod( f = "initialize", signature = "ADEg.C1", definition = function(.Object, data = list(score = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, ...) ## ADEg initialize .Object@data <- data return(.Object) }) setMethod( f = "prepare", signature = "ADEg.C1", definition = function(object) { ## prepare: grid calculations ## reset limits and sets axis information for lattice name_obj <- deparse(substitute(object)) if(object@data$storeData) score <- object@data$score else score <- eval(object@data$score, envir = sys.frame(object@data$frame)) if(inherits(object, "C1.barchart") | inherits(object, "C1.curve") | inherits(object, "C1.dotplot") | inherits(object, "C1.interval")) { if(object@data$storeData) at <- object@data$at else at <- eval(object@data$at, envir = sys.frame(object@data$frame)) } if(inherits(object, "C1.curves")) score <- as.matrix(score) else score <- as.matrix(score)[, 1] ## to manage 'score' when it is a data.frame with only one column if(inherits(object, "C1.interval")) ## to manage only the first score in c(score1, score2) score <- score[1:(length(score) / 2)] ## limits and scale if(!is.null(object@s.misc$hori.update)) if(object@s.misc$hori.update != object@adeg.par$p1d$horizontal) { aux <- object@g.args$xlim object@g.args$xlim <- object@g.args$ylim object@g.args$ylim <- aux } object@s.misc$hori.update <- object@adeg.par$p1d$horizontal minX <- min(score) maxX <- max(score) if(object@adeg.par$p1d$horizontal & !is.null(object@g.args$xlim)) { minX <- object@g.args$xlim[1] maxX <- object@g.args$xlim[2] } if(!object@adeg.par$p1d$horizontal & !is.null(object@g.args$ylim)) { minX <- object@g.args$ylim[1] maxX <- object@g.args$ylim[2] } origin <- object@adeg.par$porigin lim <- setlimits1D(minX, maxX, origin = origin$origin[1], includeOr = origin$include) ## compute grid size tmp <- pretty(lim, n = object@adeg.par$pgrid$nint) if(!origin$include) origin$origin[1] <- tmp[1] cgrid <- diff(tmp)[1] if(is.na(cgrid)) stop("error while calculating grid") ## compute grid location v0 <- origin$origin[1] if((origin$origin[1] + cgrid) <= lim[2]) v0 <- c(v0, seq(origin$origin[1] + cgrid, lim[2], by = cgrid)) if((origin$origin[1] - cgrid >= lim[1])) v0 <- c(v0, seq(origin$origin[1] - cgrid, lim[1], by = -cgrid)) v0 <- sort(v0[v0 >= lim[1] & v0 <= lim[2]]) ## clean near-zero values delta <- diff(range(v0))/object@adeg.par$pgrid$nint if (any(small <- abs(v0) < 1e-14 * delta)) v0[small] <- 0 object@s.misc$backgrid <- list(x = v0, d = cgrid) ## object@adeg.par$paxes has priority over object@g.args$scales object@adeg.par$paxes$aspectratio <- "fill" scalesandlab <- modifyList(as.list(object@g.args$scales), object@adeg.par$paxes, keep.null = TRUE) if(!scalesandlab$draw) { scalesandlab$x$draw <- FALSE scalesandlab$y$draw <- FALSE } lead <- ifelse(object@adeg.par$p1d$reverse, 1 , -1) if(object@adeg.par$p1d$horizontal) { ## draw axes for horizontal plot if(is.null(scalesandlab$x$at)) scalesandlab$x$at <- object@s.misc$backgrid$x if(is.null(object@g.args$xlim)) object@g.args$xlim <- lim } else { ## draw axes for vertical plot if(is.null(scalesandlab$y$at)) scalesandlab$y$at <- object@s.misc$backgrid$x if(is.null(object@g.args$ylim)) object@g.args$ylim <- lim } object@g.args$scales <- scalesandlab assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panelbase", signature = "ADEg.C1", definition = function(object, x, y) { ## Formula defined in gettrellis ## if horizontal, x is score and y is a vector with repetitions of origin ## if vertical, this is the inverse grid <- object@adeg.par$pgrid porigin <- object@adeg.par$porigin pscore <- object@adeg.par$p1d lims <- current.panel.limits(unit = "native") ## for rugs if(pscore$rug$draw & (pscore$rug$tck != 0)) { plines <- object@adeg.par$plines if(!is.null(object@data$fac)) { ## C1.density or C1.gauss (different colors for rugs) if(object@data$storeData) fac <- as.factor(object@data$fac) else fac <- as.factor(eval(object@data$fac, envir = sys.frame(object@data$frame))) plines <- lapply(plines, FUN = function(x) {return(rep(x, length.out = nlevels(fac))[fac])}) } } lead <- ifelse(pscore$reverse, -1, 1) if(pscore$horizontal) { ## horizontal plot ## draw grid if(grid$draw) panel.segments(x0 = object@s.misc$backgrid$x , x1 = object@s.misc$backgrid$x, y0 = lims$ylim[1], y1 = lims$ylim[2], col = grid$col, lty = grid$lty, lwd = grid$lwd) ## draw origin panel.abline( v = if(porigin$draw) porigin$origin else NULL, h = if(pscore$rug$draw & pscore$rug$line) object@s.misc$rug else NULL, col = porigin$col, lwd = porigin$lwd, lty = porigin$lty, alpha = porigin$alpha) ## draw rug if(pscore$rug$draw & (pscore$rug$tck != 0)) { ref <- ifelse(pscore$reverse, lims$ylim[2], lims$ylim[1]) ## tick end and starting points start <- object@s.misc$rug end <- start - pscore$rug$tck * lead * abs(start - ref) start <- convertUnit(unit(start, "native"), unitTo = "npc", axisFrom = "y", valueOnly = TRUE) end <- convertUnit(unit(end, "native"), unitTo = "npc", axisFrom = "y", valueOnly = TRUE) do.call("panel.rug", c(list(x = y, start = start, end = end), plines)) } } else { ## vertical plot ## draw grid if(grid$draw) panel.segments(y0 = object@s.misc$backgrid$x , y1 = object@s.misc$backgrid$x, x0 = lims$xlim[1], x1 = lims$xlim[2], col = grid$col, lty = grid$lty, lwd = grid$lwd) ## draw origin panel.abline( h = if(porigin$draw) porigin$origin else NULL, v = if(pscore$rug$draw & pscore$rug$line) object@s.misc$rug else NULL, col = porigin$col, lwd = porigin$lwd, lty = porigin$lty, alpha = porigin$alpha) ## draw rug if(pscore$rug$draw && pscore$rug$tck != 0) { ref <- ifelse(pscore$reverse, lims$xlim[2], lims$xlim[1]) ## tick end and starting points start <- object@s.misc$rug end <- start - pscore$rug$tck * lead * abs(start - ref) start <- convertUnit(unit(start, "native"), unitTo = "npc", axisFrom = "x", valueOnly = TRUE) end <- convertUnit(unit(end, "native"), unitTo = "npc", axisFrom = "x", valueOnly = TRUE) do.call("panel.rug", c(list(y = y, start = start, end = end), plines)) } } ## indicate grid size (d = **) if(grid$draw & (grid$text$cex > 0)) { text.pos <- .setposition(grid$text$pos) textgrid <- textGrob(label = paste("d =", object@s.misc$backgrid$d), x = text.pos$posi[1], y = text.pos$posi[2], gp = gpar(cex = grid$text$cex, col = grid$text$col), name = "gridtext") grid.rect(x = text.pos$posi[1], y = text.pos$posi[2], width = grobWidth(textgrid), height = grobHeight(textgrid), gp = gpar(fill = object@adeg.par$pbackground$col, alpha = 0.8, col = "transparent")) grid.draw(textgrid) } callNextMethod() }) setMethod( f = "setlatticecall", signature = "ADEg.C1", definition = function(object) { ## arguments recurrents de la liste, pas les limites car elles seront definis ensuite name_obj <- deparse(substitute(object)) ## grid background and box object@trellis.par$panel.background$col <- object@adeg.par$pbackground$col if(!object@adeg.par$pbackground$box) object@trellis.par$axis.line$col <- "transparent" else object@trellis.par$axis.line$col <- "black" arguments <- list( par.settings = object@trellis.par, scales = object@g.args$scales, aspect = object@adeg.par$paxes$aspectratio, key = createkey(object), axis = axis.L, ## see utils.R panel = function(...) { panelbase(object, ...) ## grid, panel(object, ...) ## call to C1.panel function, for slabel and ADEg.C1 class of graphs }) object@lattice.call$arguments <- arguments object@lattice.call$graphictype <- "xyplot" ## get lattice arguments (set unspecified to NULL) argnames <- c("main", "sub", "xlab", "ylab") largs <- object@g.args[argnames] names(largs) <- argnames ## add xlim and ylim if not NULL if("xlim" %in% names(object@g.args)) largs["xlim"] <- object@g.args["xlim"] if("ylim" %in% names(object@g.args)) largs["ylim"] <- object@g.args["ylim"] object@lattice.call$arguments <- c(object@lattice.call$arguments, largs, list(strip = FALSE)) assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "gettrellis", signature = "ADEg.C1", definition = function(object) { if(object@data$storeData) score <- object@data$score else score <- eval(object@data$score, envir = sys.frame(object@data$frame)) if(inherits(object, "C1.curves")) score <- as.matrix(score) else score <- as.matrix(score)[, 1] ## to manage 'score' when it is a data.frame with only one column xdata <- rep(1, length(score)) if(inherits(object, "C1.barchart") | inherits(object, "C1.curve") | inherits(object, "C1.dotplot") | inherits(object, "C1.interval")) { if(object@data$storeData) xdata <- object@data$at else xdata <- eval(object@data$at, envir = sys.frame(object@data$frame)) } fml <- as.formula(score ~ xdata) tmptrellis <- do.call(what = object@lattice.call$graphictype, args = c(fml, object@lattice.call$arguments, environment())) return(tmptrellis) }) adegraphics/R/Tr.label.R0000644000176200001440000001741613742303021014517 0ustar liggesusers############################################### ## triangle.label ## ############################################### setClass( Class = "Tr.label", contains = "ADEg.Tr" ) setMethod( f = "initialize", signature = "Tr.label", definition = function(.Object, data = list(dfxyz = NULL, labels = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.Tr initialize .Object@data$labels <- data$labels return(.Object) }) setMethod( f = "prepare", signature = "Tr.label", definition = function(object) { name_obj <- deparse(substitute(object)) if(object@data$storeData) { labels <- object@data$labels df <- object@data$dfxyz } else { labels <- eval(object@data$labels, envir = sys.frame(object@data$frame)) df <- eval(object@data$dfxyz, envir = sys.frame(object@data$frame)) } ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) ## change default for some parameters if((is.null(object@adeg.par$plabels$boxes$draw) & adegtot$plabels$optim) || (is.null(object@adeg.par$plabels$boxes$draw) & length(labels) > 1000)) adegtot$plabels$boxes$draw <- FALSE if(object@g.args$addmean) { default <- list(pch = 20, col = "black", cex = 2) if(is.list(object@g.args$meanpar)) object@g.args$meanpar <- modifyList(default, object@g.args$meanpar, keep.null = TRUE) else { if(!is.null(object@g.args$meanpar)) stop("meanpar must be a list of graphical parameters (pch, col, cex)", call. = FALSE) else object@g.args$meanpar <- default } } if(object@g.args$addaxes | object@g.args$addmean) { ## lines (axes or mean) default <- list(col = "black", lwd = 1, lty = 1) if(is.list(object@g.args$axespar)) object@g.args$axespar <- modifyList(default, object@g.args$axespar, keep.null = TRUE) else { if(!is.null(object@g.args$axespar)) stop("axespar must be a list of graphical parameters (lwd, col, lty)", call. = FALSE) else object@g.args$axespar <- default } ## point (axes or mean) default <- list(pch = 20, col = "black", cex = 2) if(is.list(object@g.args$meanpar)) object@g.args$meanpar <- modifyList(default, object@g.args$meanpar, keep.null = TRUE) else { if(!is.null(object@g.args$meanpar)) stop("meanpar must be a list of graphical parameters (pch, col, cex)", call. = FALSE) else object@g.args$meanpar <- default } } ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph ## calculate 2D coordinates df <- sweep(df, 1, rowSums(df), "/") object@stats$coords2d <- .coordtotriangleM(df, mini3 = object@g.args$min3d, maxi3 = object@g.args$max3d)[, 2:3] assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "Tr.label", definition = function(object, x, y) { if(object@data$storeData) { labels <- object@data$labels df <- object@data$dfxyz } else { labels <- eval(object@data$labels, envir = sys.frame(object@data$frame)) df <- eval(object@data$dfxyz, envir = sys.frame(object@data$frame)) } ## draw points and labels if(any(object@adeg.par$ppoints$cex > 0)) panel.points(object@stats$coords2d[, 1], object@stats$coords2d[, 2], pch = object@adeg.par$ppoints$pch, cex = object@adeg.par$ppoints$cex, col = object@adeg.par$ppoints$col, alpha = object@adeg.par$ppoints$alpha, fill = object@adeg.par$ppoints$fill) if(any(object@adeg.par$plabels$cex > 0)) adeg.panel.label(object@stats$coords2d[, 1], object@stats$coords2d[, 2], labels, object@adeg.par$plabels) ## addmean or addaxes if(object@g.args$addmean | object@g.args$addaxes) { df <- sweep(df, 1, rowSums(df), "/") mini3 <- object@g.args$min3d maxi3 <- object@g.args$max3d m3 <- colMeans(df) mxy <- .coordtotriangleM(t(as.matrix(m3)), mini3 = mini3, maxi3 = maxi3)[-1] if(object@g.args$addmean) { ## axis points: putting means on the axis A axp3 <- rbind(c(m3[1], mini3[2], 1 - m3[1] - mini3[2]), c(1 - m3[2] -mini3[3], m3[2], mini3[3]), c(mini3[1], 1 - m3[3] - mini3[1], m3[3])) axpxyz <- .coordtotriangleM(axp3, mini3 = mini3, maxi3 = maxi3) ## drawing lines for means apply(axpxyz, 1, FUN = function(x) { do.call("panel.lines", c(list(x = c(x[2], mxy[1]), y = c(x[3], mxy[2])), object@g.args$axespar)) }) do.call("panel.points", c(list(x = c(mxy[1], axpxyz[, 2]), y = c(mxy[2], axpxyz[, 3])), object@g.args$meanpar)) panel.text(x = axpxyz[, 2], y = axpxyz[, 3], labels = as.character(round(m3, digits = 4)), pos = c(2, 1, 4)) } if(object@g.args$addaxes) { axx <- dudi.pca(df, scale = FALSE, scannf = FALSE)$c1 cornerp <- object@s.misc$cornerp a1 <- axx[, 1] x1 <- a1[1] * cornerp$A + a1[2] * cornerp$B + a1[3] * cornerp$C do.call("panel.segments", c(list(x0 = mxy[1] - x1[1], x1 = mxy[1] + x1[1], y0 = mxy[2] - x1[2], y1 = mxy[2] + x1[2]), object@g.args$axespar)) a2 <- axx[, 2] x1 <- a2[1] * cornerp$A + a2[2] * cornerp$B + a2[3] * cornerp$C do.call("panel.segments", c(list(x0 = mxy[1] - x1[1], x1 = mxy[1] + x1[1], y0 = mxy[2] - x1[2], y1 = mxy[2] + x1[2]), object@g.args$axespar)) do.call("panel.points", c(list(x = mxy[1], y = mxy[2]), object@g.args$meanpar)) } } }) triangle.label <- function(dfxyz, labels = rownames(dfxyz), adjust = TRUE, min3d = NULL, max3d = NULL, addaxes = FALSE, addmean = FALSE, meanpar = NULL, axespar = NULL, showposition = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## dfxyz: matrix/data.frame with 3 columns ## min3d, max3d: limits by default: c(0,0,0), c(1,1,1) ## addaxes: should we draw pca axes ## addmean: should we draw mean thecall <- .expand.call(match.call()) ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { object <- multi.facets.Tr(thecall, samelimits = sortparameters$g.args$samelimits) } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(adjust = adjust, min3d = min3d, max3d = max3d, addaxes = addaxes, addmean = addmean, meanpar = meanpar, axespar = axespar)) if(storeData) tmp_data <- list(dfxyz = dfxyz, labels = labels, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(dfxyz = thecall$dfxyz, labels = thecall$labels, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "Tr.label", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = match.call()) ## preparation prepare(object) setlatticecall(object) if(showposition & add) { warning("cannot show position and add") ## can be done, but modifies the meaning of the superposition showposition <- FALSE } if(showposition) object <- new(Class = "ADEgS", ADEglist = list("triangle" = object, "positions" = .showpos(object)), positions = rbind(c(0, 0, 1, 1), c(0, 0.7, 0.3, 1)), add = matrix(0, ncol = 2, nrow = 2), Call = match.call()) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/addsegment.R0000644000176200001440000000567713742303021015175 0ustar liggesuserssetMethod( f = "addsegment", signature = "ADEg", definition = function(object, x0 = NULL, y0 = NULL, x1, y1, plot = TRUE, ...) { # collect limits xlim <- object@g.args$xlim ylim <- object@g.args$ylim aspect <- object@adeg.par$paxes$aspectratio ## sorting parameters sortparameters <- sortparamADEg(...)$adepar params <- adegpar() sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) params <- sortparameters$plines segmentadded <- xyplot(0 ~ 0, xlim = xlim, ylim = ylim, main = NULL, xlab = NULL, ylab = NULL, aspect = aspect, myx0 = x0, myy0 = y0, myx1 = x1, myy1 = y1, panel = function(x, y, ...) panel.segments(x0 = x0, y0 = y0, x1 = x1, y1 = y1, lwd = params$lwd, lty = params$lty, col = params$col), plot = FALSE) segmentadded$call <- call("xyplot", 0 ~ 0, xlim = substitute(xlim), ylim = substitute(ylim), xlab = NULL, ylab = NULL, aspect = substitute(aspect), lwd = params$lwd, lty = params$lty, col = params$col, x0 = substitute(x0), y0 = substitute(y0), x1 = substitute(x1), y1 = substitute(y1), panel = function(x, y, ...) panel.segments(x0 = x0, y0 = y0, x1 = x1, y1 = y1)) # superposition obj <- superpose(object, segmentadded, plot = FALSE) nn <- all.names(substitute(object)) names(obj) <- c(ifelse(is.na(nn[2]), nn[1], nn[2]), "segmentadded") if(plot) print(obj) invisible(obj) }) setMethod( f = "addsegment", signature = "ADEgS", definition = function(object, x0 = NULL, y0 = NULL, x1, y1, plot = TRUE, which = 1:length(object), ...) { ngraph <- length(object) if(max(which) > ngraph) stop("Values in 'which' should be lower than the length of object") if(length(which) == 1) { object[[which]] <- addsegment(object[[which]], x0 = x0, y0 = y0, x1 = x1, y1 = y1, ..., plot = FALSE) } else { if(sum(object@add) != 0) stop("The 'addsegment' function is not available for superposed objects.", call. = FALSE) ## sorting parameters sortparameters <- sortparamADEg(...)$adepar params <- adegpar() sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) params <- sortparameters$plines params <- rapply(params, function(X) rep(X, length.out = length(which)), how = "list") if(!is.null(x0)) x0 <- rep_len(x0, length.out = length(which)) if(!is.null(y0)) y0 <- rep_len(y0, length.out = length(which)) x1 <- rep_len(x1, length.out = length(which)) y1 <- rep_len(y1, length.out = length(which)) for (i in which) object[[i]] <- addsegment(object[[i]], x0 = x0[i], y0 = y0[i], x1 = x1[i], y1 = y1[i], which = 1, plot = FALSE, plines = lapply(params, function(X) X[i])) } obj <- object if(plot) print(obj) invisible(obj) })adegraphics/R/ADEg.S2.R0000644000176200001440000003373414354572444014121 0ustar liggesuserssetClass( Class = "ADEg.S2", contains = c("ADEg", "VIRTUAL"), slots = c(data = "list") ) setMethod( f = "initialize", signature = "ADEg.S2", definition = function(.Object, data = list(dfxy = NULL, xax = 1, yax = 2, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, ...) ## ADEg initialize .Object@data <- data return(.Object) }) setMethod( f = "prepare", signature = "ADEg.S2", definition = function(object) { ## TODO: factorise les if name_obj <- deparse(substitute(object)) if(object@data$storeData) dfxy <- object@data$dfxy else dfxy <- eval(object@data$dfxy, envir = sys.frame(object@data$frame)) ## axes limits if(inherits(object, "S2.corcircle")) { object@trellis.par$panel.background$col <- "transparent" if(object@g.args$fullcircle) { if(is.null(object@g.args$xlim) || !identical(object@s.misc$xfullcircle.update, object@g.args$fullcircle)) { minX <- -1 maxX <- 1 } else { minX <- object@g.args$xlim[1] maxX <- object@g.args$xlim[2] } if(is.null(object@g.args$ylim) || !identical(object@s.misc$yfullcircle.update, object@g.args$fullcircle)) { minY <- -1 maxY <- 1 } else { minY <- object@g.args$ylim[1] maxY <- object@g.args$ylim[2] } } else { if(is.null(object@g.args$xlim) || !identical(object@s.misc$xfullcircle.update, object@g.args$fullcircle)) { minX <- min(dfxy[, object@data$xax]) maxX <- max(dfxy[, object@data$xax]) } else { minX <- object@g.args$xlim[1] maxX <- object@g.args$xlim[2] } if(is.null(object@g.args$ylim) || !identical(object@s.misc$yfullcircle.update, object@g.args$fullcircle)) { minY <- min(dfxy[, object@data$yax]) maxY <- max(dfxy[, object@data$yax]) } else { minY <- object@g.args$ylim[1] maxY <- object@g.args$ylim[2] } } } else { if(is.null(object@g.args$xlim)) { minX <- min(dfxy[, object@data$xax]) maxX <- max(dfxy[, object@data$xax]) } else { minX <- object@g.args$xlim[1] maxX <- object@g.args$xlim[2] } if(is.null(object@g.args$ylim)) { minY <- min(dfxy[, object@data$yax]) maxY <- max(dfxy[, object@data$yax]) } else { minY <- object@g.args$ylim[1] maxY <- object@g.args$ylim[2] } } limits <- setlimits2D(minX = minX, maxX = maxX, minY = minY, maxY = maxY, origin = rep(object@adeg.par$porigin$origin, le = 2), aspect.ratio = object@adeg.par$paxes$aspectratio, includeOr = object@adeg.par$porigin$include) if(is.null(object@g.args$xlim) || !identical(object@s.misc$xfullcircle.update, object@g.args$fullcircle)) object@g.args$xlim <- limits$xlim if(is.null(object@g.args$ylim) || !identical(object@s.misc$yfullcircle.update, object@g.args$fullcircle)) object@g.args$ylim <- limits$ylim if(inherits(object, "S2.corcircle")) { object@s.misc$xfullcircle.update <- object@g.args$fullcircle object@s.misc$yfullcircle.update <- object@g.args$fullcircle } ## grid locations and axes if(object@adeg.par$pgrid$draw || object@adeg.par$paxes$draw) { ## axes division if(!inherits(object, "S2.corcircle")) { if(object@adeg.par$porigin$include) object@s.misc$backgrid <- .getgrid(xlim = object@g.args$xlim, ylim = object@g.args$ylim, object@adeg.par$pgrid$nint, rep(object@adeg.par$porigin$origin, le = 2), asp = object@adeg.par$paxes$aspectratio) else object@s.misc$backgrid <- .getgrid(xlim = object@g.args$xlim, ylim = object@g.args$ylim, object@adeg.par$pgrid$nint, asp = object@adeg.par$paxes$aspectratio) } if(object@adeg.par$paxes$draw) { ## parameters to plot axes scalesandlab <- modifyList(as.list(object@g.args$scales), object@adeg.par$paxes, keep.null = TRUE) if(is.null(scalesandlab$y$at)) { scalesandlab$y$at <- object@s.misc$backgrid[[3L]][!is.na(object@s.misc$backgrid[[3L]])] if(inherits(object, "S2.corcircle")) scalesandlab$y$at <- scalesandlab$y$at[(length(scalesandlab$y$at) / 2 + 1):length(scalesandlab$y$at)] } if(is.null(scalesandlab$x$at)) { scalesandlab$x$at <- object@s.misc$backgrid[[1L]][!is.na(object@s.misc$backgrid[[1L]])] if(inherits(object, "S2.corcircle")) scalesandlab$x$at <- scalesandlab$x$at[1:(length(scalesandlab$x$at) / 2)] } } else scalesandlab <- list(draw = FALSE) ## no axes } else scalesandlab <- list(draw = FALSE) ## no axes if(object@adeg.par$paxes$aspectratio != "iso") object@adeg.par$pgrid$text$cex <- 0 ## grid cell size has no meaning if(!is.null(object@g.args$Sp)) object@adeg.par$paxes$aspectratio <- ifelse(is.na(proj4string(object@g.args$Sp)) || is.projected(object@g.args$Sp), 1, 1/cos((mean(object@g.args$ylim) * pi)/180)) ## if grid and axes are drawn, no text indication if(object@adeg.par$pgrid$draw && object@adeg.par$paxes$draw) object@adeg.par$pgrid$text$cex <- 0 object@g.args$scales <- scalesandlab assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panelbase", signature = "ADEg.S2", definition = function(object, x, y) { ## draw grid lims <- current.panel.limits(unit = "native") porigin <- object@adeg.par$porigin porigin$origin <- rep(porigin$origin, length.out = 2) if(inherits(object, "S2.corcircle")) grid.circle(x = 0, y = 0, r = 1, default.units = "native", gp = gpar(col = "black", fill = object@adeg.par$pbackground$col), draw = TRUE, name = "circleGrid") if(object@adeg.par$pgrid$draw) { ## if grid to draw grid <- object@adeg.par$pgrid locations <- object@s.misc$backgrid ## coordinates for the grid panel.segments( x0 = c(locations$x0[!is.na(locations$x0)], rep(lims$xlim[1], sum(is.na(locations$x0)))), x1 = c(locations$x1[!is.na(locations$x1)], rep(lims$xlim[2], sum(is.na(locations$x1)))), y0 = c(rep(lims$ylim[1], sum(is.na(locations$y0))), locations$y0[!is.na(locations$y0)]), y1 = c(rep(lims$ylim[2], sum(is.na(locations$y1))), locations$y1[!is.na(locations$y1)]), col = grid$col, lty = grid$lty, lwd = grid$lwd) if(grid$text$cex > 0) { text.pos <- .setposition(grid$text$pos) textgrid <- textGrob(label = paste("d =", locations$d), x = text.pos$posi[1], y = text.pos$posi[2], just = text.pos$just, gp = gpar(cex = grid$text$cex, col = grid$text$col), name = "gridtext") grid.rect(x = text.pos$posi[1], y = text.pos$posi[2], width = grobWidth(textgrid), height = grobHeight(textgrid), just = text.pos$just, gp = gpar(fill = ifelse(inherits(object, "S2.corcircle"), "transparent", object@adeg.par$pbackground$col), alpha = 1, col = "transparent")) grid.draw(textgrid) } } if(porigin$draw && porigin$include & inherits(object, "S2.corcircle")) { panel.segments(x0 = c(-1, porigin$origin[1]), x1 = c(1, porigin$origin[1]), y0 = c(porigin$origin[2], -1), y1 = c(porigin$origin[2], 1), col = porigin$col, lwd = porigin$lwd, lty = porigin$lty, alpha = porigin$alpha) ## TODO: check last parameters valididy } if(porigin$draw && porigin$include & !inherits(object, "S2.corcircle")) { panel.abline(h = porigin$origin[2], v = porigin$origin[1], col = porigin$col, lwd = porigin$lwd, lty = porigin$lty, alpha = porigin$alpha) ## TODO: check last parameters valididy } ## spatial object management if(any(names(object@g.args) == "Sp")) { do.call("adeg.panel.Spatial", args = c(list(SpObject = object@g.args$Sp, sp.layout = object@g.args$sp.layout), object@adeg.par$pSp)) } else ## no Sp but sp.layout if(any(names(object@g.args) == "sp.layout")) sppanel(obj = object@g.args$sp.layout) ## neighbouring object management if(any(names(object@g.args) == "nbobject")) { nbobj <- object@g.args$nbobject if(!inherits(nbobj, "nb") & !inherits(nbobj, "listw")) stop("wrong class for the nb object") pnb <- object@adeg.par$pnb do.call("adeg.panel.nb", args = list(nbobject = nbobj, coords = cbind(x, y), col.edge = pnb$edge$col, lwd = pnb$edge$lwd, lty = pnb$edge$lty, pch = pnb$node$pch, cex = pnb$node$cex, col.node = pnb$node$col, alpha = pnb$node$alpha)) } callNextMethod() }) setMethod( f = "setlatticecall", signature = "ADEg.S2", definition = function(object) { ## arguments recurrents de la liste, pas les limites car elles seront definis ensuite name_obj <- deparse(substitute(object)) ## background and box if(!inherits(object, "S2.corcircle")) object@trellis.par$panel.background$col <- object@adeg.par$pbackground$col if(!object@adeg.par$pbackground$box) object@trellis.par$axis.line$col <- "transparent" else object@trellis.par$axis.line$col <- "black" arguments <- list( par.settings = object@trellis.par, scales = object@g.args$scales, aspect = object@adeg.par$paxes$aspectratio, key = createkey(object), legend = createcolorkey(object), axis = axis.L, ## see utils.R panel = function(...) { panelbase(object,...) ## grid, panel(object,...) ## call to S2.panel function, for slabel and ADEg.S2 class of graphs }) object@lattice.call$arguments <- arguments object@lattice.call$graphictype <- "xyplot" ## get lattice arguments (set unspecified to NULL) argnames <- c("main", "sub", "xlab", "ylab") largs <- object@g.args[argnames] names(largs) <- argnames ## add xlim and ylim if not NULL if("xlim" %in% names(object@g.args)) largs["xlim"] <- object@g.args["xlim"] if("ylim" %in% names(object@g.args)) largs["ylim"] <- object@g.args["ylim"] object@lattice.call$arguments <- c(object@lattice.call$arguments, largs, list(strip = FALSE)) assign(name_obj, object, envir = parent.frame()) }) ## zoom without center setMethod( f = "zoom", signature = c("ADEg.S2", "numeric", "missing"), definition = function(object, zoom, center) { oldxlim <- object@g.args$xlim oldylim <- object@g.args$ylim if(length(zoom) != 1) stop("zoom factor should be length 1") diffx <- diff(oldxlim) diffy <- diff(oldylim) center <- c(oldxlim[1] + diffx / 2, oldylim[1] + diffy / 2) diffx <- diffx / zoom diffy <- diffy / zoom object@g.args$xlim <- c(center[1] - diffx / 2, center[1] + diffx / 2) object@g.args$ylim <- c(center[2] - diffy / 2, center[2] + diffy / 2) if(object@adeg.par$pgrid$draw || object@adeg.par$paxes$draw) object@s.misc$backgrid <- .getgrid(xlim = object@g.args$xlim, ylim = object@g.args$ylim, object@adeg.par$pgrid$nint, object@adeg.par$porigin$origin, asp = object@adeg.par$paxes$aspectratio) prepare(object) setlatticecall(object) print(object) invisible(object) }) ## zoom with center setMethod( f = "zoom", signature = c("ADEg.S2", "numeric", "numeric"), definition = function(object, zoom, center) { if(length(center) != 2) stop("error, center should be length 2") if(length(zoom) != 1) stop("zoom factor should be length 1") diffx <- diff(object@g.args$xlim) / zoom diffy <- diff(object@g.args$ylim) / zoom object@g.args$xlim <- c(center[1] - diffx / 2, center[1] + diffx / 2) object@g.args$ylim <- c(center[2] - diffy / 2, center[2] + diffy / 2) if(object@adeg.par$pgrid$draw || object@adeg.par$paxes$draw) object@s.misc$backgrid <- .getgrid(xlim = object@g.args$xlim, ylim = object@g.args$ylim, object@adeg.par$pgrid$nint, object@adeg.par$porigin$origin, asp = object@adeg.par$paxes$aspectratio) prepare(object) setlatticecall(object) print(object) invisible(object) }) setMethod( f = "gettrellis", signature = "ADEg.S2", definition = function(object) { if(object@data$storeData) { dfxy <- as.matrix(object@data$dfxy) xax <- object@data$xax yax <- object@data$yax } else { dfxy <- as.matrix(eval(object@data$dfxy, envir = sys.frame(object@data$frame))) yax <- eval(object@data$yax, envir = sys.frame(object@data$frame)) xax <- eval(object@data$xax, envir = sys.frame(object@data$frame)) } tmptrellis <- do.call(what = object@lattice.call$graphictype, args = c(formula(dfxy[, yax] ~ dfxy[, xax]), object@lattice.call$arguments, environment())) return(tmptrellis) }) adegraphics/R/utilskey.R0000644000176200001440000001602113742303021014714 0ustar liggesuserssetMethod( f = "addkey", signature = "ADEg", definition = function(object) { object@adeg.par$plegend$drawKey <- TRUE object@g.args$key <- createkey(object) return(object) }) setMethod( f = "createkey", signature = "ADEg", definition = function(object) { if(object@adeg.par$plegend$drawKey){ res <- object@g.args$key } else res <- NULL return(res) }) setMethod( f = "createkey", signature = "S2.value", definition = function(object) { return(.createkeyvalue(object, type = "S2")) }) setMethod( f = "createkey", signature = "T.value", definition = function(object) { return(.createkeyvalue(object, type = "T")) }) setMethod( f = "createkey", signature = "S2.class", definition = function(object) { return(.createkeyclass(object, type = "S2")) }) setMethod( f = "createkey", signature = "S1.class", definition = function(object) { return(.createkeyclass(object, type = "S1")) }) setMethod( f = "createkey", signature = "Tr.class", definition = function(object) { return(.createkeyclass(object, type = "Tr")) }) setMethod( f = "createcolorkey", signature = "ADEg", definition = function(object) { if(object@adeg.par$plegend$drawColorKey){ res <- object@g.args$legend } else res <- NULL return(res) }) setMethod( f = "createcolorkey", signature = "T.image", definition = function(object) { ## add a small space before the colorkey trellis.par.set(layout.widths = list(axis.key.padding = 1)) return(.createcolorkeyimage(object, type = "T")) }) setMethod( f = "createcolorkey", signature = "S2.image", definition = function(object) { ## add a small space before the colorkey trellis.par.set(layout.widths = list(axis.key.padding = 1)) return(.createcolorkeyimage(object, type = "S2")) }) .createkeyvalue <- function(object, type = c("T", "S2")) { type <- match.arg(type) res <- NULL if(object@adeg.par$plegend$drawKey){ res <- list() res$points$pch <- .symbol2pch(object@g.args$symbol) cstnormal <- 5 ## same value in adeg.panel.value if(object@g.args$method == "size"){ center <- object@g.args$center breaks <- unique(c(object@s.misc$breaks.update, signif(center, 5))) maxsize <- max(abs(breaks)) breaks <- breaks[order(breaks, decreasing = FALSE)] l0 <- length(breaks) breaks <- (breaks[1:(l0 - 1)] + breaks[2:l0]) / 2 res$text$lab <- as.character(breaks) size <- breaks - center res$points$cex <- .proportional_map(size, maxsize) * object@adeg.par$ppoints$cex[1] * cstnormal res$points$fill <- object@adeg.par$ppoints$col[ifelse(breaks < center, 1, 2)] res$points$col <- object@adeg.par$ppoints$col[ifelse(breaks < center, 2, 1)] } else if(object@g.args$method == "color"){ breaks <- object@s.misc$breaks.update l0 <- length(breaks) res$points$cex <- object@adeg.par$ppoints$cex[1] * cstnormal / 2 * object@adeg.par$plegend$size res$text$lab <- paste("[", breaks[l0], ";", breaks[l0 - 1], "]", sep = "") for(i in (l0 - 1):2) res$text$lab <- c(res$text$lab, paste("]", breaks[i], ";", breaks[i - 1], "]", sep = "")) res$points$fill <- object@adeg.par$ppoints$fill[1:length(res$text$lab)] res$points$col <- object@adeg.par$ppoints$col } res$columns <- length(res$text$lab) res$border <- TRUE res$between <- 0.1 * object@adeg.par$plegend$size res$between.columns <- 0 * object@adeg.par$plegend$size res$padding.text <- 1.2 * max(res$points$cex) res$text$cex <- object@adeg.par$plegend$size if(is.null(object@g.args$key$space)){ if(type == "T"){ res$x <- 0 res$y <- 0 } else { res$corner <- c(0,0) res$x <- 0.01 res$y <- 0.01 } } res$background <- object@adeg.par$pbackground$col res <- modifyList(res, as.list(object@g.args$key), keep.null = TRUE) } return(res) } .createkeyclass <- function(object, type = c("S1", "S2", "Tr")) { type <- match.arg(type) res <- NULL if(object@adeg.par$plegend$drawKey){ res <- list() if(object@data$storeData) fac <- as.factor(object@data$fac) else fac <- as.factor(eval(object@data$fac, envir = sys.frame(object@data$frame))) res$text$lab <- levels(fac) res$text$col <- object@adeg.par$plabels$col if(object@adeg.par$ppoints$cex > 0){ res$points$pch <- object@adeg.par$ppoints$pch res$points$col <- object@adeg.par$ppoints$col res$points$fill <- object@adeg.par$ppoints$fill } else if(!is.null(object@g.args$chullSize)){ if(object@g.args$chullSize > 0){ res$rectangles$border <- object@adeg.par$ppolygons$border res$rectangles$col <- object@adeg.par$ppolygons$col res$rectangles$alpha <- object@adeg.par$ppolygons$alpha } } else if(object@g.args$ellipseSize > 0){ res$rectangles$border <- object@adeg.par$pellipses$border res$rectangles$col <- object@adeg.par$pellipses$col res$rectangles$alpha <- object@adeg.par$pellipses$alpha } else if(object@g.args$starSize > 0){ res$lines$col <- object@adeg.par$plines$col res$lines$lty <- object@adeg.par$plines$lty res$lines$lwd <- object@adeg.par$plines$lwd } res$between <- 0.1 * object@adeg.par$plegend$size res$between.columns <- 0 * object@adeg.par$plegend$size res$text$cex <- object@adeg.par$plegend$size if(is.null(object@g.args$key$space)){ if(type == "S2"){ res$corner <- c(0,0) res$x <- 0.01 res$y <- 0.01 } if(type == "S1"){ res$corner <- c(0,1) res$x <- 0.01 res$y <- 0.99 } if(type == "Tr"){ res$corner <- c(1,1) res$x <- 0.99 res$y <- 0.99 } } res$background <- object@adeg.par$pbackground$col res <- modifyList(res, as.list(object@g.args$key), keep.null = TRUE) } return(res) } .createcolorkeyimage <- function(object, type = c("T", "S2")) { type <- match.arg(type) res <- NULL if(object@adeg.par$plegend$drawColorKey){ res <- list(right = list(fun = draw.colorkey, args = list(key = list(col = object@adeg.par$ppoints$col, at = object@s.misc$breaks.update)))) } return(res) } adegraphics/R/parameter.R0000644000176200001440000002205413747033173015043 0ustar liggesuserschangelatticetheme <- function(...) { ## lattice.options(default.theme = adegspecial) ## change lattice theme ## if a device is open, it would apply only to new devices if(try(is.list(...), silent = TRUE) == TRUE) changes <- as.list(...) else changes <- list(...) newtheme <- get("lattice.theme", envir = getFromNamespace(".LatticeEnv", ns = "lattice")) adegspecial <- get("adegtheme", envir = .ADEgEnv) if(length(changes)) newtheme <- modifyList(newtheme, changes, keep.null = TRUE) else ## come back at the starting point newtheme <- modifyList(newtheme, adegspecial, keep.null = TRUE) ## for all new devices lattice.options(default.theme = switch(EXPR = .Device, newtheme)) if(dev.cur() != 1) ## if a device is open trellis.par.set(newtheme) invisible(newtheme) } .mergingList <- function(tomerge) { ## merge elements of the list by name recursively lnames <- names(tomerge) counter <- 0 ## safety counter while(length(lnames) != length(unique(lnames))) { ## be sure that there are duplicated values indix <- match(lnames, lnames) remove <- c() for(i in 1:length(indix)) { if(i != indix[i]) { tomerge[[indix[i]]] <- c(tomerge[[indix[i]]], tomerge[[i]]) remove <- c(remove, i) } } if(length(remove)) tomerge[remove] <- NULL tomerge <- lapply(tomerge, FUN = function(x) {if(is.list(x) & (length(x) > 1)) .mergingList(x) else x}) counter <- counter + 1 if(counter == 50) stop("error in .mergingList", call. = FALSE) lnames <- names(tomerge) } return(tomerge) } .replaceList <- function(x, val) { ## replaceList: inspired by modifyList but ## replace only previous existing elements and with partial names matching ## x: list to modify, val: modications to pass ## x structure can not be changed ## To be more specific if an element is a list, it cannot be change with a single value rest <- list() returned <- list() xnames <- names(x) for (v in names(val)) { indix <- pmatch(v, xnames, nomatch = 0) if(indix > 0) { ## if there is a match if(is.list(x[[indix]]) && (!is.list(val[[v]]))) stop(paste("cannot replace a list: ", xnames[indix], " by a single value element", sep = ""), call. = FALSE) else { if(is.list(x[[indix]])) { ## recursivity replace <- .replaceList(x[[indix]], val[[v]]) returned <- c(returned, list(replace$select)) rest <- c(rest, replace$rest) } else returned[[(length(returned) + 1)]] <- val[[v]] ## else replace values names(returned)[length(returned)] <- xnames[indix] } } else rest <- c(rest, val[v]) } return(list(select = returned, rest = rest)) } .getlist <- function(keys, values) { ## assembles keys and values as list of list ## keys: list of characters vectors, the keys splitted, values: the original list result <- list() for(i in 1:length(keys)) { l <- list(values[[i]]) names(l) <- keys[[i]][length(keys[[i]])] if(length(keys[[i]]) > 1) for(j in (length(keys[[i]]) - 1):1) { l <- list(l) names(l)[1] <- keys[[i]][j] } result[[i]] <- l } return(result) } separation <- function(... , pattern = 0, split = TRUE) { ## separate between the list passed to the function and the one already known ## if pattern is 1, compare to trellis parameters ## if pattern is 0, compare to 'padegraphic' parameters ## gets dots if(try(is.list(...), silent = TRUE) == TRUE) tmp_list <- as.list(...) else tmp_list <- list(...) if(is.null(names(tmp_list))) names(tmp_list) <- tmp_list if(!length(tmp_list)) return(list(select = list(), rest = list())) ## get pattern if(is.list(pattern)) listpat <- pattern else { if(pattern > 1) stop("pattern must be 0 or 1 in 'separation' function", call. = FALSE) else { if(pattern == 1) listpat <- trellis.par.get() else{ listpat <- get("padegraphic", envir = .ADEgEnv) } } } ## splitting list keys if(!is.list(pattern)) { if(pattern != 1 && split) { ## adegpar, collates keys sep <- strsplit(names(tmp_list), split = ".", fixed = TRUE) values <- tmp_list val <- .getlist(keys = sep, values = values) ## assemblies keys with values, as list of list... val <- sapply(val, FUN = function(x) return(x)) val <- .mergingList(val) } else val <- tmp_list } else val <- tmp_list res <- .replaceList(x = listpat, val) res[[1]] <- .mergingList(res[[1]]) return(res) } adegpar <- function(...) { ## case 0: nothing in parenthesis ## case 0 bis: only one key (no indication sublist, "paxes") ## case 1: ...= "axes.draw", "sub", "sub.size" # one level, only names ## case 2: ...= "axes" = list("draw") # two levels, only names ## case 3: ...= "axes.draw" = FALSE, "sub.size" = 12 # one level, key names and matching values ## case 4: ...= axes=list(draw=TRUE), sub=list(size=55) # two levels, key names and matching values ## case 5 : ... is a complete list ## if ... is a list ## does not assign, only find corresponding element in list patti recursfinder <- function(x, patti) { result <- list() okfu <- function(x, patti) { ## okfu: retrieve good values and keys (patti) if(length(x) > 1) stop("x has length > 1") ## to remove idx <- pmatch(names(x), names(patti)) if(!is.na(idx)) return( patti[idx]) else return(NA) } if(!is.list(x[[1]])) result <- c(result, okfu(x, patti)) else { idx <- pmatch(names(x), names(patti)) if(!is.na(idx)) { result <- c(result, list(recursfinder(x[[1]], patti[[idx]]))) names(result) <- names(patti[idx]) } else print("no matching found in adegpar") } return(result) } ## end recurs finder nonames <- function(userlist, pattili) { ## return the right values list sep <- sapply(userlist, strsplit, split = ".", fixed = TRUE) ## a list values <- userlist val <- .getlist(keys = sep, values = values) return(sapply(val, FUN = recursfinder, patti = pattili)) ## get result } value <- list() assignement <- FALSE if(try(is.list(...), silent = TRUE) == TRUE) argu <- as.list(...) ## ... is still a list else argu <- list(...) ## tranforms in list ## choose option padegr <- get("padegraphic", envir = .ADEgEnv) ## switching case: recursive switchingcase <- function(userlist, patternlist) { if(!length(userlist)) ## empty case 0 return(list(result = patternlist, assigni = list())) else { lnames <- names(userlist) if(is.null(lnames)) { ## no values, case 0 bis or 1 res <- nonames(userlist, patternlist) return(list(result = res, assigni = list())) } else { result <- list() assigni <- list() ## initialization for(i in 1:length(lnames)) { if(identical(lnames[i], "")) { ## no names, meaning value is the key cas 2/1 result <- c(result,nonames(userlist[i], patternlist)) } else { ## we have names so value to assign, or sublist sep <- sapply(lnames[i], strsplit, split = ".", fixed = TRUE) ## a list ## get a list of list with right keys (splitting *.* keys) val <- .getlist(keys = sep, values = userlist[i])[[1L]] idx <- pmatch(names(val), names(patternlist)) if(!is.na(idx)) { ## match with patternlist if(is.list(val[[1]])) { ## sublist val from user list ok <- switchingcase(val[[1]], patternlist = patternlist[[idx]]) if(length(ok$result)) { result <- c(result, list(ok$result)) ## level behind names(result)[length(result)] <- names(patternlist[idx]) } if(length(ok$assigni)) { assigni <- c(assigni, list(ok$assigni)) names(assigni)[length(assigni)] <- names(patternlist[idx]) } } else { ## if not a list, then a value to assign if(is.list(patternlist[[idx]])) stop(paste("be careful, intent to replace in adegraphics parameters: ", names(patternlist[idx]), " by a single value element", sep = ""), call. = FALSE) assigni <- c(assigni, list(userlist[[i]])) names(assigni)[length(assigni)] <- names(patternlist[idx]) } } } } } } return(list(result = result, assigni = assigni)) } ## end switching case if(!length(argu)) ## ... empty return(padegr) ## case 0 else { ## adegpar called with arguments switchi <- switchingcase(argu, padegr) } if(length(switchi$assign)) { padegr <- modifyList(padegr, switchi$assign, keep.null = TRUE) assign("padegraphic", padegr, envir = .ADEgEnv) return(invisible(padegr)) ## must be improve : avoid two calls to padegraphic } return(switchi$result) } adegraphics/R/S2.logo.R0000644000176200001440000000702614354572673014320 0ustar liggesusers######################################################### ## s.logo ## ######################################################### setClass( Class = "S2.logo", contains = "ADEg.S2" ) setMethod( f = "initialize", signature = "S2.logo", definition = function(.Object, data = list(dfxy = NULL, logos = NULL, xax = 1, yax = 2, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.S2 initialize .Object@data$logos <- data$logos return(.Object) }) setMethod( f = "prepare", signature = "S2.logo", definition = function(object) { name_obj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) if(is.null(object@adeg.par$porigin$include) & (any(names(object@g.args) %in% c("Sp", "nbobject")))) adegtot$porigin$include <- FALSE ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "S2.logo", definition = function(object, x, y) { ## list of bitmap objects:logos if(object@data$storeData) logos <- object@data$logos else logos <- eval(object@data$logos, envir = sys.frame(object@data$frame)) for(i in 1:length(logos)) { grid.draw(rasterGrob(logos[[i]], x = x[i], y = y[i], height = unit(0.1, "npc") * object@adeg.par$ppoints$cex, default.units = "native")) } }) s.logo <- function(dfxy, logos, xax = 1, yax = 2, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters thecall <- .expand.call(match.call()) df <- try(as.data.frame(eval(thecall$dfxy, envir = sys.frame(sys.nframe() + pos))), silent = TRUE) if(inherits(df, "try-error") | is.null(thecall$dfxy)) ## non convenient dfxy argument stop("non convenient selection for dfxy (can not be converted to dataframe)") logos <- eval(thecall$logos, envir = sys.frame(sys.nframe() + pos)) if(!is.list(logos)) stop("The argument 'logos' should be a list") ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if((length(xax) == 1 & length(yax) == 1)) object <- multi.facets.S2(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple xax/yax") } ## multiple axes else if((length(xax) > 1 | length(yax) > 1)) { object <- multi.ax.S2(thecall) } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object if(storeData) tmp_data <- list(dfxy = dfxy, xax = xax, yax = yax, logos = logos, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(dfxy = thecall$dfxy, xax = xax, yax = yax, logos = thecall$logos, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "S2.logo", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = sortparameters$g.args, Call = as.call(thecall)) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/C1.curve.R0000644000176200001440000000762513742303021014443 0ustar liggesuserssetClass( Class = "C1.curve", contains = "ADEg.C1" ) setMethod( f = "initialize", signature = "C1.curve", definition = function(.Object, data = list(score = NULL, at = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.C1 initialize .Object@data$at <- data$at validObject(.Object) return(.Object) }) setMethod( f = "prepare", signature = "C1.curve", definition = function(object) { nameobj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) if(object@data$storeData) { score <- object@data$score at <- object@data$at } else { score <- eval(object@data$score, envir = sys.frame(object@data$frame)) at <- eval(object@data$at, envir = sys.frame(object@data$frame)) } score <- as.matrix(score)[, 1] ## to manage 'score' when it is a data.frame with only one column ## change some defaults adegtot$p1d$rug$draw <- FALSE ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph if(object@adeg.par$p1d$horizontal && is.null(object@g.args$ylim)) object@g.args$ylim <- setlimits1D(min(at), max(at), 0, FALSE) if(!object@adeg.par$p1d$horizontal && is.null(object@g.args$xlim)) object@g.args$xlim <- setlimits1D(min(at), max(at), 0, FALSE) assign(nameobj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "C1.curve", definition = function(object, x, y) { ## Drawing dotchart ## x is the index ## y is the score ## get some parameters pscore <- object@adeg.par$p1d ppoints <- lapply(object@adeg.par$ppoints, FUN = function(x) {rep(x, length.out = length(x))}) plines <- lapply(object@adeg.par$plines, FUN = function(x) {rep(x, length.out = length(x))}) ## reorder the values y <- y[order(x)] x <- sort(x) ## Starts the display ## depends on the parametres horizontal ## rug.draw and reverse are always considered as FALSE if(pscore$horizontal) { x.tmp <- y y.tmp <- x } else { x.tmp <- x y.tmp <- y } panel.lines(x = x.tmp, y = y.tmp, lwd = plines$lwd, lty = plines$lty, col = plines$col) panel.points(x = x.tmp, y = y.tmp, pch = ppoints$pch, cex = ppoints$cex, col = ppoints$col, alpha = ppoints$alpha) }) s1d.curve <- function(score, at = 1:NROW(score), facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters thecall <- .expand.call(match.call()) ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if(NCOL(score) == 1) object <- multi.facets.C1(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple scores") } ## multiple scores else if(NCOL(score) > 1) { object <- multi.score.C1(thecall) } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object if(storeData) tmp_data <- list(score = score, at = at, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(score = thecall$score, at = thecall$at, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "C1.curve", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = sortparameters$g.args, Call = match.call()) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/C1.density.R0000644000176200001440000002550214550522102014771 0ustar liggesusers##################################################################### ## S1.density to compare with S1.gauss afterwards ## ## TODO: reverse/vertical mettre a l'echelle distribution calculee ## ## Dans l'idée S1.density plutot si pas de factor... ## ##################################################################### setClass( Class = "C1.density", contains = "ADEg.C1" ) setMethod( f = "initialize", signature = "C1.density", definition = function(.Object, data = list(score = NULL, fac = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.C1 initialize .Object@data$fac <- data$fac return(.Object) }) ### densities calculations according to user parameters and score/factor setMethod( f = "prepare", signature = "C1.density", definition = function(object) { nameobj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) if(object@data$storeData) { score <- object@data$score fac <- object@data$fac } else { score <- eval(object@data$score, envir = sys.frame(object@data$frame)) fac <- eval(object@data$fac, envir = sys.frame(object@data$frame)) } score <- as.matrix(score)[, 1] ## to manage 'score' when it is a data.frame with only one column nlev <- nlevels(as.factor(fac)) ## If axes are plotted, put a label for axis if(adegtot$paxes$draw) { if(is.null(object@g.args$xlab) & !adegtot$p1d$horizontal) object@g.args$xlab <- "density" if(is.null(object@g.args$ylab) & adegtot$p1d$horizontal) object@g.args$ylab <- "density" } ## setting colors paramsToColor <- list(plabels = list(col = object@adeg.par$plabels$col, boxes = list(col = object@adeg.par$plabels$boxes$col)), plines = list(col = object@adeg.par$plines$col), ppolygons = list(border = object@adeg.par$ppolygons$border, col = object@adeg.par$ppolygons$col)) if(!(is.null(object@g.args$col) || (is.logical(object@g.args$col) && !object@g.args$col))) adegtot <- modifyList(adegtot, col2adepar(ccol = object@g.args$col, pparamsToColor = paramsToColor, nnlev = nlev)) ## if fill is FALSE, polygons density curves are transparent if(!object@g.args$fill) adegtot$ppolygons$col <- "transparent" ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph scores <- split(score, fac) densit <- vector(mode = "list", length = length(scores)) names(densit) <- names(scores) ## estimate density for each level of the factor for(i in 1:length(scores)) { if(length(scores[[i]]) == 0) { ## no data in the given level densit[[i]] <- list(x = NA, y = NA) } else { if(!is.null(object@g.args$bandwidth)) densit[[i]] <- bkde(scores[[i]], kernel = object@g.args$kernel, bandwidth = object@g.args$bandwidth, gridsize = object@g.args$gridsize) else densit[[i]] <- bkde(scores[[i]], kernel = object@g.args$kernel, gridsize = object@g.args$gridsize) } } lead <- ifelse(object@adeg.par$p1d$reverse, 1 , -1) if(object@adeg.par$p1d$horizontal) { Ylim <- object@g.args$ylim if(is.null(object@s.misc$p1dReverse.update) || object@adeg.par$p1d$reverse != object@s.misc$p1dReverse.update || is.null(object@s.misc$Ylim.update) || any(Ylim != object@s.misc$Ylim.update)) { if(is.null(object@g.args$ylim)) Ylim <- c(0, max(sapply(densit, FUN = function(x) {ifelse(is.na(x$y[1]), 0, max(x$y))}) / 0.85)) if(object@adeg.par$p1d$rug$draw) { ref <- ifelse(object@adeg.par$p1d$reverse, 2, 1) margin <- Ylim[ref] if(object@adeg.par$p1d$rug$draw) margin <- object@adeg.par$p1d$rug$margin * abs(diff(Ylim)) object@s.misc$rug <- Ylim[ref] Ylim[ref] <- Ylim[ref] + lead * margin } object@s.misc$Ylim.update <- Ylim object@s.misc$p1dReverse.update <- object@adeg.par$p1d$reverse } object@g.args$ylim <- Ylim } else { Xlim <- object@g.args$xlim if(is.null(object@s.misc$p1dReverse.update) || object@adeg.par$p1d$reverse != object@s.misc$p1dReverse.update || is.null(object@s.misc$Xlim.update) || any(Xlim != object@s.misc$Xlim.update)) { if(is.null(object@g.args$xlim)) Xlim <- c(0, max(sapply(densit, FUN = function(x) {ifelse(is.na(x$y[1]), 0, max(x$y))}) / 0.85)) if(object@adeg.par$p1d$rug$draw) { ref <- ifelse(object@adeg.par$p1d$reverse, 2, 1) margin <- Xlim[ref] if(object@adeg.par$p1d$rug$draw) margin <- object@adeg.par$p1d$rug$margin * abs(diff(Xlim)) object@s.misc$rug <- Xlim[ref] Xlim[ref] <- Xlim[ref] + lead * margin } object@s.misc$Xlim.update <- Xlim object@s.misc$p1dReverse.update <- object@adeg.par$p1d$reverse } object@g.args$xlim <- Xlim } object@stats$densit <- densit assign(nameobj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "C1.density", definition = function(object, x, y) { ## Drawing densities as polygons (filled or not) ## one polygon per level ## y is the score ## get some parameters pscore <- object@adeg.par$p1d curvess <- object@stats$densit labels <- names(curvess) lims <- current.panel.limits(unit = "native") if(object@data$storeData) fac <- object@data$fac else fac <- eval(object@data$fac, envir = sys.frame(object@data$frame)) nlev <- nlevels(as.factor(fac)) ppoly <- lapply(object@adeg.par$ppolygons, FUN = function(x) rep(x, length.out = nlev)) plabels <- lapply(object@adeg.par$plabels, FUN = function(x) rep(x, length.out = nlev)) y <- split(y, fac) ## manage string rotation srt <- 0 if(is.numeric(plabels$srt[1])) srt <- plabels$srt[1] else{ if(plabels$srt[1] == "horizontal") srt <- 0 else if(plabels$srt[1] == "vertical") srt <- 90 } ## Starts the display ## depends on the parametres horizontal and reverse lead <- ifelse(pscore$reverse, -1, 1) if(pscore$horizontal) { ## horizontal drawing margin <- ifelse(pscore$reverse, lims$ylim[2], lims$ylim[1]) if(pscore$rug$draw) margin <- if(is.unit(object@s.misc$rug)) convertUnit(object@s.misc$rug, typeFrom = "dimension", unitTo = "native", axisFrom = "y", valueOnly = TRUE) else object@s.misc$rug # margin <- ifelse(pscore$reverse, lims$ylim[2], lims$ylim[1]) + lead * margin for(i in 1:nlev) { if(!is.na(curvess[[i]]$y[1])) { y <- margin + lead * curvess[[i]]$y panel.polygon(x = c(min(curvess[[i]]$x), curvess[[i]]$x, max(curvess[[i]]$x)), y = c(margin, y, margin), border = ppoly$border[i], col = ppoly$col[i], lty = ppoly$lty[i], lwd = ppoly$lwd[i], alpha = ppoly$alpha[i]) if(nlev > 1) { ## indicate levels names for each curve ymaxindex <- which.max(curvess[[i]]$y) ## places at the maximum panel.text(x = curvess[[i]]$x[ymaxindex], y = y[ymaxindex], labels = names(curvess)[i], pos = ifelse(pscore$reverse, 1, 3), col = plabels$col[i], cex = plabels$cex[i], alpha = plabels$alpha[i], srt = srt) } } } } else { ## vertical drawing margin <- ifelse(pscore$reverse, lims$xlim[2], lims$xlim[1]) if(pscore$rug$draw) margin <- if(is.unit(object@s.misc$rug)) convertUnit(object@s.misc$rug, typeFrom = "dimension", unitTo = "native", axisFrom = "x", valueOnly = TRUE) else object@s.misc$rug # margin <- ifelse(pscore$reverse, lims$xlim[2], lims$xlim[1]) + lead * margin for(i in 1:nlev) { if(!is.na(curvess[[i]]$y[1])) { x <- margin + lead * curvess[[i]]$y panel.polygon(x = c(margin, x, margin), y = c(min(curvess[[i]]$x), curvess[[i]]$x, max(curvess[[i]]$x)), border = ppoly$border[i], col = ppoly$col[i], lty = ppoly$lty[i], lwd = ppoly$lwd[i], alpha = ppoly$alpha[i]) if(nlev > 1) { ## indicate levels names for each curve xmaxindex <- which.max(curvess[[i]]$y) panel.text(x = x[xmaxindex], y = curvess[[i]]$x[xmaxindex], labels = names(curvess)[i], pos = ifelse(pscore$reverse, 2, 4), col = plabels$col[i], cex = plabels$cex[i], alpha = plabels$alpha[i], srt = srt) } } } } }) ## s1d.density: user function ## kernel, bandwidth and gridsize directly passed to the bkde function (for density calculation) ## if fill is FALSE, polygons density curves are transparent s1d.density <- function(score, fac = gl(1, NROW(score)), kernel = c("normal", "box", "epanech", "biweight", "triweight"), bandwidth = NULL, gridsize = 450, col = NULL, fill = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { thecall <- .expand.call(match.call()) ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if(NCOL(score) == 1 & NCOL(fac) == 1) object <- multi.facets.C1(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple scores and/or multiple fac") } ## multiple scores else if(NCOL(score) > 1) { if(NCOL(fac) == 1) object <- multi.score.C1(thecall) else stop("Multiple scores are not allowed with multiple fac") } ## multiple fac else if(NCOL(fac) > 1) { object <- multi.variables.C1(thecall, "fac") } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(kernel = match.arg(kernel), bandwidth = bandwidth, gridsize = gridsize, fill = fill, col = col)) if(storeData) tmp_data <- list(score = score, fac = fac, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(score = thecall$score, fac = thecall$fac, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "C1.density", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = match.call()) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/C1.gauss.R0000644000176200001440000002507014550522117014442 0ustar liggesusers######################################################### ## C1.gauss: here assumption: gaussian distribution ### ######################################################### setClass( Class = "C1.gauss", contains = "ADEg.C1" ) setMethod( f = "initialize", signature = "C1.gauss", definition = function(.Object, data = list(score = NULL, fac = NULL, wt = NULL, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.C1 initialize .Object@data$fac <- data$fac .Object@data$wt <- data$wt return(.Object) }) setMethod( f = "prepare", signature = "C1.gauss", definition = function(object) { nameobj <- deparse(substitute(object)) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) if(object@data$storeData) { score <- object@data$score fac <- object@data$fac wt <- object@data$wt } else { score <- eval(object@data$score, envir = sys.frame(object@data$frame)) fac <- eval(object@data$fac, envir = sys.frame(object@data$frame)) wt <- eval(object@data$wt, envir = sys.frame(object@data$frame)) } score <- as.matrix(score)[, 1] ## to manage 'score' when it is a data.frame with only one column nlev <- nlevels(as.factor(fac)) ## If axes are plotted, put a label for axis if(adegtot$paxes$draw) { if(is.null(object@g.args$xlab) & !adegtot$p1d$horizontal) object@g.args$xlab <- "density" if(is.null(object@g.args$ylab) & adegtot$p1d$horizontal) object@g.args$ylab <- "density" } ## setting colors paramsToColor <- list(plabels = list(col = object@adeg.par$plabels$col, boxes = list(col = object@adeg.par$plabels$boxes$col)), plines = list(col = object@adeg.par$plines$col), ppolygons = list(border = object@adeg.par$ppolygons$border, col = object@adeg.par$ppolygons$col)) if(!(is.null(object@g.args$col) || (is.logical(object@g.args$col) && !object@g.args$col))) adegtot <- modifyList(adegtot, col2adepar(ccol = object@g.args$col, pparamsToColor = paramsToColor, nnlev = nlev)) ## if fill is FALSE, polygons density curves are transparent if(!object@g.args$fill) adegtot$ppolygons$col <- "transparent" ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph ## statistics calculus object@stats$means <- meanfacwt(score, fac, wt) object@stats$var <- varfacwt(score, fac) ## here steps fixed, could be a argument of s1d.gauss steps <- object@g.args$steps nind <- table(fac) gausscurv <- list() if(object@adeg.par$p1d$horizontal) xx <- seq(from = object@g.args$xlim[1], to = object@g.args$xlim[2], length.out = steps) else xx <- seq(from = object@g.args$ylim[1], to = object@g.args$ylim[2], length.out = steps) for(i in 1:nlev) { if(nind[i] == 0) gausscurv[[i]] <- NA else gausscurv[[i]] <- dnorm(xx, mean = object@stats$means[i], sd = sqrt(object@stats$var[i])) } names(gausscurv) <- levels(fac) lead <- ifelse(object@adeg.par$p1d$reverse, 1 , -1) if(object@adeg.par$p1d$horizontal) { Ylim <- object@g.args$ylim if(is.null(object@s.misc$p1dReverse.update) || object@adeg.par$p1d$reverse != object@s.misc$p1dReverse.update || is.null(object@s.misc$Ylim.update) || any(Ylim != object@s.misc$Ylim.update)) { if(is.null(object@g.args$ylim)) Ylim <- c(0, max(sapply(gausscurv, FUN = function(x) {ifelse(is.na(x[1]), 0, max(x)) / 0.85}))) if(object@adeg.par$p1d$rug$draw) { ref <- ifelse(object@adeg.par$p1d$reverse, 2, 1) margin <- Ylim[ref] if(object@adeg.par$p1d$rug$draw) margin <- object@adeg.par$p1d$rug$margin * abs(diff(Ylim)) object@s.misc$rug <- Ylim[ref] Ylim[ref] <- Ylim[ref] + lead * margin } object@s.misc$Ylim.update <- Ylim } object@g.args$ylim <- Ylim object@s.misc$p1dReverse.update <- object@adeg.par$p1d$reverse } else { Xlim <- object@g.args$xlim if(is.null(object@s.misc$p1dReverse.update) || object@adeg.par$p1d$reverse != object@s.misc$p1dReverse.update || is.null(object@s.misc$Xlim.update) || any(Xlim != object@s.misc$Xlim.update)) { if(is.null(object@g.args$xlim)) Xlim <- c(0, max(sapply(gausscurv, FUN = function(x) {ifelse(is.na(x[1]), 0, max(x)) / 0.85}))) if(object@adeg.par$p1d$rug$draw) { ref <- ifelse(object@adeg.par$p1d$reverse, 2, 1) margin <- Xlim[ref] if(object@adeg.par$p1d$rug$draw) margin <- object@adeg.par$p1d$rug$margin * abs(diff(Xlim)) object@s.misc$rug <- Xlim[ref] Xlim[ref] <- Xlim[ref] + lead * margin } object@s.misc$Xlim.update <- Xlim object@s.misc$p1dReverse.update <- object@adeg.par$p1d$reverse } object@g.args$xlim <- Xlim } object@stats$gausscurves <- gausscurv assign(nameobj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "C1.gauss", definition = function(object, x, y) { ## Drawing gauss curves as polygons (filled or not) ## one polygon per level ## y is the score ## get some parameters pscore <- object@adeg.par$p1d curvess <- object@stats$gausscurves labels <- names(curvess) lims <- current.panel.limits(unit = "native") if(object@data$storeData) fac <- object@data$fac else fac <- eval(object@data$fac, envir = sys.frame(object@data$frame)) nlev <- nlevels(as.factor(fac)) ppoly <- lapply(object@adeg.par$ppolygons, FUN = function(x) rep(x, length.out = nlev)) plabels <- lapply(object@adeg.par$plabels, FUN = function(x) rep(x, length.out = nlev)) ## manage string rotation srt <- 0 if(is.numeric(plabels$srt[1])) srt <- plabels$srt[1] else { if(plabels$srt[1] == "horizontal") srt <- 0 else if(plabels$srt[1] == "vertical") srt <- 90 } ## Starts the display ## depends on the parametres horizontal and reverse lead <- ifelse(pscore$reverse, -1, 1) if(pscore$horizontal) { ## horizontal drawing margin <- ifelse(pscore$reverse, lims$ylim[2], lims$ylim[1]) xx <- seq(from = lims$xlim[1], to = lims$xlim[2], length.out = object@g.args$steps) if(pscore$rug$draw) margin <- if(is.unit(object@s.misc$rug)) convertUnit(object@s.misc$rug, typeFrom = "dimension", unitTo = "native", axisFrom = "y", valueOnly = TRUE) else object@s.misc$rug # margin <- ifelse(pscore$reverse, lims$ylim[2], lims$ylim[1]) + lead * margin for(i in 1:nlev) { if(!is.na(curvess[[i]][1])) { y <- margin + lead * curvess[[i]] panel.polygon(x = c(lims$xlim[1], xx, lims$xlim[2]), y = c(margin, y, margin) , border = ppoly$border[i], col = ppoly$col[i], lty = ppoly$lty[i], lwd = ppoly$lwd[i], alpha = ppoly$alpha[i]) if(nlev > 1) { ## indicate levels names for each curve ymaxindex <- which.max(curvess[[i]]) ## places at the maximum panel.text(x = xx[ymaxindex], y = y[ymaxindex], labels = names(curvess)[i], pos = ifelse(pscore$reverse, 1, 3), col = plabels$col[i], cex = plabels$cex[i], alpha = plabels$alpha[i], srt = srt) } } } } else { ## vertical drawing margin <- ifelse(pscore$reverse, lims$xlim[2], lims$xlim[1]) yy <- seq(from = lims$ylim[1], to = lims$ylim[2], length.out = object@g.args$steps) if(pscore$rug$draw) margin <- if(is.unit(object@s.misc$rug)) convertUnit(object@s.misc$rug, typeFrom = "dimension", unitTo = "native", axisFrom = "x", valueOnly = TRUE) else object@s.misc$rug # margin <- ifelse(pscore$reverse, lims$xlim[2], lims$xlim[1]) + lead * margin for(i in 1:nlev) { if(!is.na(curvess[[i]][1])) { x <- margin + lead * curvess[[i]] panel.polygon(x = c(margin, x, margin), y = c(lims$ylim[1], yy, lims$ylim[2]), border = ppoly$border[i], col = ppoly$col[i], lty = ppoly$lty[i], lwd = ppoly$lwd[i], alpha = ppoly$alpha[i]) if(nlev > 1) { xmaxindex <- which.max(curvess[[i]]) panel.text(x = x[xmaxindex], y = yy[xmaxindex], labels = names(curvess)[i], col = plabels$col[i], pos = ifelse(pscore$reverse, 2, 4), cex = plabels$cex[i], alpha = plabels$alpha[i], srt = srt) } } } } }) s1d.gauss <- function(score, fac = gl(1, NROW(score)), wt = rep(1, NROW(score)), steps = 200, col = NULL, fill = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { thecall <- .expand.call(match.call()) ## parameters management sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if(NCOL(score) == 1 & NCOL(fac) == 1) object <- multi.facets.C1(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple scores and/or multiple fac") } ## multiple scores else if(NCOL(score) > 1) { if(NCOL(fac) == 1) object <- multi.score.C1(thecall) else stop("Multiple scores are not allowed with multiple fac") } ## multiple fac else if(NCOL(fac) > 1) { object <- multi.variables.C1(thecall, "fac") } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(steps = steps, fill = fill, col = col)) if(storeData) tmp_data <- list(score = score, fac = fac, wt = wt, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(score = thecall$score, fac = thecall$fac, wt = thecall$wt, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "C1.gauss", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = match.call()) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(!add & plot) print(object) invisible(object) } adegraphics/R/S2.traject.R0000644000176200001440000001673514354572704015016 0ustar liggesusers######################################################### ### s.traject ## ######################################################### setClass( Class= "S2.traject", contains = "ADEg.S2" ) setMethod( f = "initialize", signature = "S2.traject", definition = function(.Object, data = list(dfxy = NULL, fac = NULL, labels = NULL, xax = 1, yax = 2, frame = 0, storeData = TRUE), ...) { .Object <- callNextMethod(.Object, data = data, ...) ## ADEg.S2 initialize .Object@data$labels <- data$labels .Object@data$fac <- data$fac return(.Object) }) setMethod( f = "prepare", signature = "S2.traject", definition = function(object) { name_obj <- deparse(substitute(object)) if(object@data$storeData) fac <- as.factor(object@data$fac) else fac <- as.factor(eval(object@data$fac, envir = sys.frame(object@data$frame))) ## pre-management of graphics parameters oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(object@adeg.par) ## change default for some parameters if(is.null(object@adeg.par$porigin$include) & (any(names(object@g.args) %in% c("Sp", "nbobject")))) adegtot$porigin$include <- FALSE ## setting colors paramsToColor <- list(ppoints = list(col = object@adeg.par$ppoints$col, fill = object@adeg.par$ppoints$fill), plabels = list(col = object@adeg.par$plabels$col, boxes = list(border = object@adeg.par$plabels$boxes$border)), plines = list(col = object@adeg.par$plines$col)) if(!(is.null(object@g.args$col) || (is.logical(object@g.args$col) && !object@g.args$col))) adegtot <- modifyList(adegtot, col2adepar(ccol = object@g.args$col, pparamsToColor = paramsToColor, nnlev = nlevels(fac))) ## object modification before calling inherited method object@adeg.par <- adegtot callNextMethod() ## prepare graph ## never optimized labels for s.traject object@adeg.par$plabels$optim <- FALSE assign(name_obj, object, envir = parent.frame()) }) setMethod( f = "panel", signature = "S2.traject", definition = function(object, x, y) { if(object@data$storeData) { fact <- object@data$fac labels <- object@data$labels } else { fact <- eval(object@data$fac, envir = sys.frame(object@data$frame)) labels <- eval(object@data$labels, envir = sys.frame(object@data$frame)) } todrawX <- split(x, fact) todrawY <- split(y, fact) sizelevels <- sapply(todrawX, length) if(!is.null(object@g.args$order)) orderdraw <- split(order, fact) else orderdraw <- lapply(sizelevels, FUN = function(x) if(x > 0) 1:x else NULL) ## ordrerdraw is a list used to recycle graphical parameters setparam <- function(params, nblevel, sizelevels) { ## for param begin and end or repetition if(length(params) == nblevel) return(mapply(params, FUN = function(x, y) rep(x, length.out = y), sizelevels, SIMPLIFY = FALSE)) else return(mapply(sizelevels, FUN = function(x, y) rep(params, length.out = x), SIMPLIFY = FALSE)) } parrows <- lapply(object@adeg.par$parrows, setparam, nblevel = length(todrawX), sizelevels = sizelevels) plines <- lapply(object@adeg.par$plines, setparam, nblevel = length(todrawX), sizelevels = sizelevels) ppoints <- lapply(object@adeg.par$ppoints, setparam, nblevel = length(todrawX), sizelevels = sizelevels) for(i in 1:length(todrawX)) { if(length(todrawX[[i]]) > 0) panel.points(x = todrawX[[i]], y = todrawY[[i]], col = ppoints$col[[i]], cex = ppoints$cex[[i]], pch = ppoints$pch[[i]], fill = ppoints$fill[[i]]) } for(i in 1:length(todrawX)) { if(length(todrawX[[i]]) > 1) { suborder <- orderdraw[[i]] for(j in 1:(length(todrawX[[i]]) - 1)) { panel.arrows(x0 = todrawX[[i]][suborder[j]], y0 = todrawY[[i]][suborder[j]], x1 = todrawX[[i]][suborder[j + 1]], y1 = todrawY[[i]][suborder[j + 1]], angle = parrows$angle[[i]][suborder[j + 1]], length = parrows$length[[i]][suborder[j + 1]], ends = parrows$end[[i]][suborder[j + 1]], lwd = plines$lwd[[i]][suborder[j + 1]], col = plines$col[[i]][suborder[j + 1]], lty = plines$lty[[i]][suborder[j + 1]]) } } } if(any(object@adeg.par$plabels$cex > 0)) { ## draws labels in the middle part of the trajectory middl <- sapply(orderdraw, FUN = function(x) floor(length(x) / 2)) x <- y <- rep(NA, length(middl)) for(i in 1:length(middl)) { if(length(todrawX[[i]]) > 1) { x[i] <- (todrawX[[i]][suborder[middl[i]]] + todrawX[[i]][suborder[middl[i]+1]]) / 2 y[i] <- (todrawY[[i]][suborder[middl[i]]] + todrawY[[i]][suborder[middl[i]+1]]) / 2 } } adeg.panel.label(x, y, labels = labels, plabels = object@adeg.par$plabels) } }) s.traject <- function(dfxy, fac = gl(1, nrow(dfxy)), order, labels = levels(fac), xax = 1, yax = 2, col = NULL, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) { ## evaluation of some parameters (required for multiplot) thecall <- .expand.call(match.call()) labels <- eval(thecall$labels, envir = sys.frame(sys.nframe() + pos)) fac <- eval(thecall$fac, envir = sys.frame(sys.nframe() + pos)) df <- try(as.data.frame(eval(thecall$dfxy, envir = sys.frame(sys.nframe() + pos))), silent = TRUE) if(inherits(df, "try-error") | is.null(thecall$dfxy)) ## non convenient dfxy argument stop("non convenient selection for dfxy (can not be converted to dataframe)") if(missing(fac)) stop("no factor specified") if(NCOL(fac) == 1) { fac <- as.factor(fac) if(length(labels) != nlevels(fac)) stop("wrong number of labels") } ## parameters sorted sortparameters <- sortparamADEg(...) ## facets if(!is.null(facets)) { if((length(xax) == 1 & length(yax) == 1) & NCOL(fac) == 1) object <- multi.facets.S2(thecall, sortparameters$adepar, samelimits = sortparameters$g.args$samelimits) else stop("Facets are not allowed with multiple xax/yax or multiple fac") } ## multiple axes else if((length(xax) > 1 | length(yax) > 1)) { if(NCOL(fac) == 1) object <- multi.ax.S2(thecall) else stop("Multiple xax/yax are not allowed with multiple fac") } ## multiple fac else if(NCOL(fac) > 1) { object <- multi.variables.S2(thecall, "fac") } ## simple ADEg graphic else { if(length(sortparameters$rest)) warning(c("Unused parameters: ", paste(unique(names(sortparameters$rest)), " ", sep = "")), call. = FALSE) ## creation of the ADEg object g.args <- c(sortparameters$g.args, list(order = thecall$order, col = col)) if(storeData) tmp_data <- list(dfxy = dfxy, xax = xax, yax = yax, labels = labels, fac = fac, frame = sys.nframe() + pos, storeData = storeData) else tmp_data <- list(dfxy = thecall$dfxy, xax = xax, yax = yax, labels = thecall$labels, fac = thecall$fac, frame = sys.nframe() + pos, storeData = storeData) object <- new(Class = "S2.traject", data = tmp_data, adeg.par = sortparameters$adepar, trellis.par = sortparameters$trellis, g.args = g.args, Call = as.call(thecall)) ## preparation prepare(object) setlatticecall(object) if(add) object <- add.ADEg(object) } if(! add & plot) print(object) invisible(object) } adegraphics/R/multiplot.R0000644000176200001440000006046113742303021015103 0ustar liggesusers####################################################################### ## S2. Class ## ####################################################################### multi.ax.S2 <- function(thecall) { ## function to plot ADEgS when an s.* function is called and 'xax/yax' arguments are vectors of length > 1 listGraph <- list() thenewcall <- thecall ## update some arguments thenewcall$pos <- eval(thenewcall$pos) - 3 thenewcall$plot <- FALSE if(thenewcall[[1]] == "s.value") { if(is.null(thenewcall$psub.position)) thenewcall$psub.position <- "topleft" } ## evaluate some arguments in the correct frame xax <- eval(thecall$xax, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) yax <- eval(thecall$yax, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) ## create ADEg plots for(i in yax) { for(j in xax) { thenewcall$xax <- j thenewcall$yax <- i thenewcall$psub.text <- paste("xax=", j, ", yax=", i, collapse = "", sep = "") listGraph <- c(listGraph, do.call(as.character(thenewcall[[1]]), thenewcall[-1])) } } ## create the multiplot ADEgS names(listGraph) <- paste("x", apply(expand.grid(xax, yax), 1, paste, collapse = "y"), sep = "") posmatrix <- layout2position(c(length(yax), length(xax)), ng = length(listGraph), square = FALSE) object <- new(Class = "ADEgS", ADEglist = listGraph, positions = posmatrix, add = matrix(0, ncol = length(listGraph), nrow = length(listGraph)), Call = as.call(thecall)) return(object) } ## ## ## multi.facets.S2 <- function(thecall, adepar, samelimits = TRUE) { ## function to plot ADEgS when the 'facets' argument is used listGraph <- list() oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(adepar) ## update some arguments in the newcall thenewcall <- thecall thenewcall$plot <- FALSE thenewcall$pos <- eval(thenewcall$pos) - 3 thenewcall$facets <- NULL ## evaluate some arguments in the correct frame if(thecall[[1]] != "s.match") dfxy <- eval(thecall$dfxy, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) else dfxy <- do.call("rbind", list(thecall$dfxy1, thecall$dfxy2), envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) facets <- factor(eval(thecall$facets, envir = sys.frame(sys.nframe() + thenewcall$pos + 2))) ## same limits for all sub-graphics if((isTRUE(samelimits) | is.null(samelimits)) & (thecall[[1]] != "s.corcircle")) { xax <- eval(thecall$xax, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) yax <- eval(thecall$yax, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) if(is.null(thenewcall$Sp)) lim.global <- setlimits2D(minX = min(dfxy[, xax]), maxX = max(dfxy[, xax]), minY = min(dfxy[, yax]), maxY = max(dfxy[, yax]), origin = adegtot$porigin$origin, aspect.ratio = adegtot$paxes$aspectratio, includeOr = adegtot$porigin$include) else { ## Sp: ex map, alors par defaut on prend la bbox limsSp <- bbox(eval(thenewcall$Sp)) lim.global <- setlimits2D(minX = limsSp[1, 1], maxX = limsSp[1, 2], minY = limsSp[2, 1], maxY = limsSp[2, 2], origin = rep(adegtot$porigin$origin, le = 2), aspect.ratio = adegtot$paxes$aspectratio, includeOr = adegtot$porigin$include) } if(is.null(thecall$xlim)) thenewcall$xlim <- lim.global$xlim if(is.null(thecall$ylim)) thenewcall$ylim <- lim.global$ylim } ## creation of the plots (ADEg objects) for(i in 1:nlevels(facets)) { thenewcall$psub.text <- levels(facets)[i] ## specific arguments for the different functions if(thecall[[1]] == "s.match") { thenewcall$dfxy1 <- call("[[", call("split", call("as.data.frame", thecall$dfxy1), thecall$facets), i) thenewcall$dfxy2 <- call("[[", call("split", call("as.data.frame", thecall$dfxy2), thecall$facets), i) thenewcall$labels <- call("[[", call("split", thecall$labels, thecall$facets), i) } else { thenewcall$dfxy <- call("[[", call("split", call("as.data.frame", thecall$dfxy), thecall$facets), i) } if(thecall[[1]] == "s.class") { thenewcall$fac <- call("[[", call("split", thecall$fac, thecall$facets), i) thenewcall$wt <- call("[[", call("split", thecall$wt, thecall$facets), i) } if(thecall[[1]] == "s.distri") thenewcall$dfdistri <- call("[[", call("split", thecall$dfdistri, thecall$facets), i) if(thecall[[1]] == "s.image") thenewcall$z <- call("[[", call("split", thecall$z, thecall$facets), i) if(thecall[[1]] == "s.label" || thecall[[1]] == "s.corcircle"|| thecall[[1]] == "s.arrow") thenewcall$labels <- call("[[", call("split", thecall$labels, thecall$facets), i) if(thecall[[1]] == "s.logo") thenewcall$logos <- call("[[", call("split", thecall$logos, thecall$facets), i) if(thecall[[1]] == "s.traject") { thenewcall$fac <- call("[[", call("split", thecall$fac, thecall$facets), i) if(!is.null(thecall$order)) thenewcall$order <- call("[[", call("split", thecall$order, thecall$facets), i) } if(thecall[[1]] == "s.value") { thenewcall$z <- call("[[", call("split", thecall$z, thecall$facets), i) if(is.null(thenewcall$breaks)) { ## same breaks for all groups z <- eval(thecall$z, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) breaks <- pretty(z, thenewcall$n) thenewcall$breaks <- breakstest(breaks, z, n = length(breaks)) } if(is.null(thenewcall$psub.position)) thenewcall$psub.position <- "topleft" } listGraph <- c(listGraph, do.call(as.character(thenewcall[[1]]), thenewcall[-1])) } ## creation of the multi-plot (ADEgS object) names(listGraph) <- levels(facets) posmatrix <- layout2position(.n2mfrow(nlevels(facets)), ng = nlevels(facets), square = FALSE) object <- new(Class = "ADEgS", ADEglist = listGraph, positions = posmatrix, add = matrix(0, ncol = nlevels(facets), nrow = nlevels(facets)), Call = as.call(thecall)) ## change pos et frame a posteriori ?? return(object) } ## ## ## multi.variables.S2 <- function(thecall, arg.vary) { ## function to plot ADEgS when an s.* function is called and an argument is multivariable (e.g., z in s.value, fac in s.class, etc) ## the name of the varying argument is in name.vary listGraph <- list() thenewcall <- thecall ## update some arguments thenewcall$pos <- eval(thecall$pos) - 3 thenewcall$plot <- FALSE ## evaluate some arguments in the correct frame name.vary <- thenewcall[[arg.vary]] dfvary <- eval(name.vary, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) ## create ADEg plots for(j in 1:ncol(dfvary)) { thenewcall[[arg.vary]] <- call("[", name.vary, substitute(1:nrow(name.vary)), j) thenewcall$psub.text <- colnames(dfvary)[j] if(thenewcall[[1]] == "s.class" || thenewcall[[1]] == "s.traject") { thenewcall$labels <- call("levels", call("as.factor", thenewcall[[arg.vary]])) } if(thenewcall[[1]] == "s.value") { if(is.null(thenewcall$psub.position)) thenewcall$psub.position <- "topleft" } listGraph <- c(listGraph, do.call(as.character(thenewcall[[1]]), thenewcall[-1])) } ## create the multiplot ADEgS names(listGraph) <- colnames(dfvary) posmatrix <- layout2position(.n2mfrow(ncol(dfvary)), ng = ncol(dfvary), square = FALSE) object <- new(Class = "ADEgS", ADEglist = listGraph, positions = posmatrix, add = matrix(0, ncol = ncol(dfvary), nrow = ncol(dfvary)), Call = as.call(thecall)) return(object) } ####################################################################### ## C1. Class ## ####################################################################### multi.score.C1 <- function(thecall) { ## function to plot ADEgS when an s1d.* function is called and score is a data.frame with multiple columns listGraph <- list() thenewcall <- thecall ## update some arguments thenewcall$pos <- eval(thenewcall$pos) - 3 thenewcall$plot <- FALSE ## evaluate some arguments in the correct frame if(thenewcall[[1]] != "s1d.interval") { score <- eval(thecall$score, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) name.score <- thecall$score } else { score <- eval(thecall$score1, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) name.score <- thecall$score1 } nc <- ncol(score) ## create ADEg plots for(i in 1:nc) { thenewcall$psub.text <- colnames(score)[i] ## specific arguments for the different functions if(thenewcall[[1]] != "s1d.interval") { thenewcall$score <- call("[", thecall$score, substitute(1:nrow(name.score)), i) } else { thenewcall$score1 <- call("[", thecall$score1, substitute(1:nrow(name.score)), i) thenewcall$score2 <- call("[", thecall$score2, substitute(1:nrow(name.score)), i) } if(thenewcall[[1]] == "s1d.barchart") { if(is.null(thenewcall$labels)) thenewcall$labels <- call("rownames", thecall$score) } listGraph <- c(listGraph, do.call(as.character(thenewcall[[1]]), thenewcall[-1])) } ## create the multiplot ADEgS names(listGraph) <- colnames(score) posmatrix <- layout2position(.n2mfrow(nc), ng = nc) object <- new(Class = "ADEgS", ADEglist = listGraph, positions = posmatrix, add = matrix(0, ncol = length(listGraph), nrow = length(listGraph)), Call = as.call(thecall)) return(object) } ## ## ## multi.facets.C1 <- function(thecall, adepar, samelimits = TRUE) { ## function to plot ADEgS when the 'facets' argument is used listGraph <- list() oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(adepar) ## update some arguments in the newcall thenewcall <- thecall thenewcall$plot <- FALSE thenewcall$pos <- eval(thenewcall$pos) - 3 thenewcall$facets <- NULL ## evaluate some arguments in the correct frame if(thenewcall[[1]] != "s1d.interval") { score <- eval(thecall$score, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) } else { score1 <- eval(thecall$score1, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) score2 <- eval(thecall$score2, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) score <- c(score1, score2) } facets <- factor(eval(thecall$facets, envir = sys.frame(sys.nframe() + thenewcall$pos + 2))) ## same limits for all graphics if(isTRUE(samelimits) | is.null(samelimits)) { lim.axe1 <- setlimits1D(min(score), max(score), origin = adegtot$porigin$origin[1], includeOr = adegtot$porigin$include) if(adegtot$p1d$horizontal & is.null(thecall$xlim)) { thenewcall$xlim <- lim.axe1 } if(!adegtot$p1d$horizontal & is.null(thecall$ylim)) { thenewcall$ylim <- lim.axe1 } } ## creation of the plots (ADEg objects) for(i in 1:nlevels(facets)) { thenewcall$psub.text <- levels(facets)[i] if(thecall[[1]] == "s1d.interval") { thenewcall$score1 <- call("[[", call("split", thecall$score1, thecall$facets), i) thenewcall$score2 <- call("[[", call("split", thecall$score2, thecall$facets), i) } else { thenewcall$score <- call("[[", call("split", thecall$score, thecall$facets), i) } if(thecall[[1]] == "s1d.barchart" & !is.null(thecall$labels)) thenewcall$labels <- call("[[", call("split", thecall$labels, thecall$facets), i) if(thecall[[1]] == "s1d.barchart" | thecall[[1]] == "s1d.dotplot" | thecall[[1]] == "s1d.curve" | thecall[[1]] == "s1d.interval") thenewcall$at <- call("[[", call("split", thecall$at, thecall$facets), i) if(thecall[[1]] == "s1d.density" | thecall[[1]] == "s1d.gauss") thenewcall$fac <- call("[[", call("split", thecall$fac, thecall$facets), i) if(thecall[[1]] == "s1d.gauss") thenewcall$wt <- call("[[", call("split", thecall$wt, thecall$facets), i) listGraph <- c(listGraph, do.call(as.character(thenewcall[[1]]), thenewcall[-1])) } ## creation of the multi-plot (ADEgS object) names(listGraph) <- levels(facets) posmatrix <- layout2position(.n2mfrow(nlevels(facets)), ng = nlevels(facets)) object <- new(Class = "ADEgS", ADEglist = listGraph, positions = posmatrix, add = matrix(0, ncol = nlevels(facets), nrow = nlevels(facets)), Call = as.call(thecall)) ## same limits for all graphics when the second axis is done by intern calculations if(inherits(object[[1]], "C1.density") | inherits(object[[1]], "C1.gauss") | inherits(object[[1]], "C1.hist")) { if(isTRUE(samelimits) | is.null(samelimits)) { cc <- object@Call if(adegtot$p1d$horizontal & is.null(thecall$ylim)) { Ylim <- range(sapply(object@ADEglist, function(x) x@g.args$ylim)) update(object, ylim = Ylim) object@Call <- cc # this call does not include the ylim update } if(!adegtot$p1d$horizontal & is.null(thecall$xlim)) { Xlim <- range(sapply(listGraph, function(x) x@g.args$xlim)) update(object, xlim = Xlim) object@Call <- paste(substr(cc, 1, nchar(cc) - 1), ", xlim = c(", Xlim[1], ",", Xlim[2], ")", sep = "") object@Call <- cc # this call does not include the xlim update } } } ## change pos et frame a posteriori ?? return(object) } ## ## ## multi.variables.C1 <- function(thecall, arg.vary) { ## function to plot ADEgS when an s1d.* function is called and an argument is multivariable (e.g., fac in s1d.density) ## the name of the varying argument is in name.vary listGraph <- list() thenewcall <- thecall ## update some arguments thenewcall$pos <- eval(thecall$pos) - 3 thenewcall$plot <- FALSE ## evaluate some arguments in the correct frame name.vary <- thenewcall[[arg.vary]] dfvary <- eval(name.vary, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) ## create ADEg plots for(j in 1:ncol(dfvary)) { thenewcall[[arg.vary]] <- call("[", name.vary, substitute(1:nrow(name.vary)), j) thenewcall$psub.text <- colnames(dfvary)[j] listGraph <- c(listGraph, do.call(as.character(thenewcall[[1]]), thenewcall[-1])) } ## create the multiplot ADEgS names(listGraph) <- colnames(dfvary) posmatrix <- layout2position(.n2mfrow(ncol(dfvary)), ng = ncol(dfvary)) object <- new(Class = "ADEgS", ADEglist = listGraph, positions = posmatrix, add = matrix(0, ncol = ncol(dfvary), nrow = ncol(dfvary)), Call = as.call(thecall)) return(object) } ####################################################################### ## S1. Class ## ####################################################################### multi.score.S1 <- function(thecall) { ## function to plot ADEgS when an s1d.* function is called and score is a data.frame with multiple columns listGraph <- list() thenewcall <- thecall ## update some arguments thenewcall$pos <- eval(thenewcall$pos) - 3 thenewcall$plot <- FALSE ## evaluate some arguments in the correct frame if(thenewcall[[1]] != "s1d.match") { score <- eval(thecall$score, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) name.score <- thecall$score } else { score <- eval(thecall$score1, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) name.score <- thecall$score1 } ## create ADEg plots nc <- ncol(score) for(i in 1:nc) { ## specific arguments for the different functions if(thenewcall[[1]] != "s1d.match") { thenewcall$score <- call("[", thecall$score, substitute(1:nrow(name.score)), i) } else { thenewcall$score1 <- call("[", thecall$score1, substitute(1:nrow(name.score)), i) thenewcall$score2 <- call("[", thecall$score2, substitute(1:nrow(name.score)), i) } thenewcall$psub.text <- colnames(score)[i] listGraph <- c(listGraph, do.call(as.character(thenewcall[[1]]), thenewcall[-1])) } ## create the multiplot ADEgS names(listGraph) <- colnames(score) posmatrix <- layout2position(.n2mfrow(nc), ng = nc) object <- new(Class = "ADEgS", ADEglist = listGraph, positions = posmatrix, add = matrix(0, ncol = length(listGraph), nrow = length(listGraph)), Call = as.call(thecall)) return(object) } ## ## ## multi.facets.S1 <- function(thecall, adepar, samelimits = TRUE) { ## function to plot ADEgS when the 'facets' argument is used listGraph <- list() oldparamadeg <- adegpar() on.exit(adegpar(oldparamadeg)) adegtot <- adegpar(adepar) ## update some arguments in the newcall thenewcall <- thecall thenewcall$plot <- FALSE thenewcall$pos <- eval(thenewcall$pos) - 3 thenewcall$facets <- NULL ## evaluate some arguments in the correct frame if(thenewcall[[1]] != "s1d.match") { score <- eval(thecall$score, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) } else { score1 <- eval(thecall$score1, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) score2 <- eval(thecall$score2, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) score <- c(score1, score2) } facets <- factor(eval(thecall$facets, envir = sys.frame(sys.nframe() + thenewcall$pos + 2))) ## same limits for all graphics if(isTRUE(samelimits) | is.null(samelimits)) { lim.global <- setlimits1D(min(score), max(score), origin = adegtot$porigin$origin[1], includeOr = adegtot$porigin$include) if(adegtot$p1d$horizontal & is.null(thecall$xlim)) thenewcall$xlim <- lim.global if(!adegtot$p1d$horizontal & is.null(thecall$ylim)) thenewcall$ylim <- lim.global } ## creation of the plots (ADEg objects) for(i in 1:nlevels(facets)) { thenewcall$psub.text <- levels(facets)[i] if(thecall[[1]] == "s1d.match") { thenewcall$score1 <- call("[[", call("split", thecall$score1, thecall$facets), i) thenewcall$score2 <- call("[[", call("split", thecall$score2, thecall$facets), i) thenewcall$labels <- call("[[", call("split", thecall$labels, thecall$facets), i) } else { thenewcall$score <- call("[[", call("split", thecall$score, thecall$facets), i) } if(thecall[[1]] == "s1d.label" & !is.null(thecall$labels)) thenewcall$labels <- call("[[", call("split", thecall$labels, thecall$facets), i) if(thecall[[1]] == "s1d.class") { thenewcall$fac <- call("[[", call("split", thecall$fac, thecall$facets), i) thenewcall$wt <- call("[[", call("split", thecall$wt, thecall$facets), i) } if(thecall[[1]] == "s1d.distri") thenewcall$dfdistri <- call("[[", call("split", thecall$dfdistri, thecall$facets), i) if(thecall[[1]] == "s1d.boxplot") thenewcall$fac <- call("[[", call("split", thecall$fac, thecall$facets), i) listGraph <- c(listGraph, do.call(as.character(thenewcall[[1]]), thenewcall[-1])) } ## creation of the multi-plot (ADEgS object) names(listGraph) <- levels(facets) posmatrix <- layout2position(.n2mfrow(nlevels(facets)), ng = nlevels(facets)) object <- new(Class = "ADEgS", ADEglist = listGraph, positions = posmatrix, add = matrix(0, ncol = nlevels(facets), nrow = nlevels(facets)), Call = as.call(thecall)) ## change pos et frame a posteriori ?? return(object) } ## ## ## multi.variables.S1 <- function(thecall, arg.vary) { ## function to plot ADEgS when an s1d.* function is called and an argument is multivariable (e.g., z in fac in s1d.class) ## the name of the varying argument is in name.vary listGraph <- list() thenewcall <- thecall ## update some arguments thenewcall$pos <- eval(thecall$pos) - 3 thenewcall$plot <- FALSE ## evaluate some arguments in the correct frame name.vary <- thenewcall[[arg.vary]] dfvary <- eval(name.vary, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) ## create ADEg plots for(j in 1:ncol(dfvary)) { thenewcall[[arg.vary]] <- call("[", name.vary, substitute(1:nrow(name.vary)), j) thenewcall$psub.text <- colnames(dfvary)[j] if(thenewcall[[1]] == "s1d.class") thenewcall$labels <- call("levels", call("as.factor", thenewcall[[arg.vary]])) if(thenewcall[[1]] == "s1d.boxplot" || thenewcall[[1]] == "s1d.distri") thenewcall$at <- call("seq", 1, call("nlevels", call("as.factor", thenewcall[[arg.vary]]))) listGraph <- c(listGraph, do.call(as.character(thenewcall[[1]]), thenewcall[-1])) } ## create the multiplot ADEgS names(listGraph) <- colnames(dfvary) posmatrix <- layout2position(.n2mfrow(ncol(dfvary)), ng = ncol(dfvary), square = FALSE) object <- new(Class = "ADEgS", ADEglist = listGraph, positions = posmatrix, add = matrix(0, ncol = ncol(dfvary), nrow = ncol(dfvary)), Call = as.call(thecall)) return(object) } ####################################################################### ## Tr. Class ## ####################################################################### multi.facets.Tr <- function(thecall, samelimits = TRUE) { ## function to plot ADEgS when the 'facets' argument is used listGraph <- list() ## update some arguments in the newcall thenewcall <- thecall thenewcall$plot <- FALSE thenewcall$pos <- eval(thenewcall$pos) - 3 thenewcall$facets <- NULL ## evaluate some arguments in the correct frame if(thecall[[1]] != "triangle.match") dfxyz <- eval(thecall$dfxyz, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) else dfxyz <- do.call("rbind", list(thecall$dfxyz1, thecall$dfxyz2), envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) facets <- factor(eval(thecall$facets, envir = sys.frame(sys.nframe() + thenewcall$pos + 2))) ## same limits for all graphics if(isTRUE(samelimits) | is.null(samelimits)) { #lim.global <- .trranges(df = dfxyz, scale = thecall$scale, min3 = NULL, max3 = NULL) lim.global <- .trranges(df = dfxyz, adjust = TRUE, min3 = NULL, max3 = NULL) if(is.null(thecall$min3d)) thenewcall$min3d <- lim.global$mini if(is.null(thecall$max3d)) thenewcall$max3d <- lim.global$maxi } ## creation of the plots (ADEg objects) for(i in 1:nlevels(facets)) { thenewcall$psub.text <- levels(facets)[i] ## specific arguments for the different functions if(thecall[[1]] == "triangle.match") { thenewcall$dfxyz1 <- call("[[", call("split", call("as.data.frame", thecall$dfxyz1), thecall$facets), i) thenewcall$dfxyz2 <- call("[[", call("split", call("as.data.frame", thecall$dfxyz2), thecall$facets), i) thenewcall$labels <- call("[[", call("split", thecall$labels, thecall$facets), i) } else { thenewcall$dfxyz <- call("[[", call("split", call("as.data.frame", thecall$dfxyz), thecall$facets), i) } if(thecall[[1]] == "triangle.class") { thenewcall$fac <- call("[[", call("split", thecall$fac, thecall$facets), i) thenewcall$wt <- call("[[", call("split", thecall$wt, thecall$facets), i) } if(thecall[[1]] == "triangle.label") thenewcall$labels <- call("[[", call("split", thecall$labels, thecall$facets), i) listGraph <- c(listGraph, do.call(as.character(thenewcall[[1]]), thenewcall[-1])) } ## creation of the multi-plot (ADEgS object) names(listGraph) <- levels(facets) posmatrix <- layout2position(.n2mfrow(nlevels(facets)), ng = nlevels(facets)) object <- new(Class = "ADEgS", ADEglist = listGraph, positions = posmatrix, add = matrix(0, ncol = nlevels(facets), nrow = nlevels(facets)), Call = as.call(thecall)) ## change pos et frame a posteriori ?? return(object) } ## ## ## multi.variables.Tr <- function(thecall, arg.vary) { ## function to plot ADEgS when an triangle.* function is called and an argument is multivariable (e.g., fac in triangle.class, etc) ## the name of the varying argument is in name.vary listGraph <- list() thenewcall <- thecall ## update some arguments thenewcall$pos <- eval(thecall$pos) - 3 thenewcall$plot <- FALSE ## evaluate some arguments in the correct frame name.vary <- thenewcall[[arg.vary]] dfvary <- eval(name.vary, envir = sys.frame(sys.nframe() + thenewcall$pos + 2)) ## create ADEg plots for(j in 1:ncol(dfvary)) { thenewcall[[arg.vary]] <- call("[", name.vary, substitute(1:nrow(name.vary)), j) thenewcall$psub.text <- colnames(dfvary)[j] if(thenewcall[[1]] == "triangle.class") { thenewcall$labels <- call("levels", call("as.factor", thenewcall[[arg.vary]])) } listGraph <- c(listGraph, do.call(as.character(thenewcall[[1]]), thenewcall[-1])) } ## create the multiplot ADEgS names(listGraph) <- colnames(dfvary) posmatrix <- layout2position(.n2mfrow(ncol(dfvary)), ng = ncol(dfvary)) object <- new(Class = "ADEgS", ADEglist = listGraph, positions = posmatrix, add = matrix(0, ncol = ncol(dfvary), nrow = ncol(dfvary)), Call = as.call(thecall)) return(object) } adegraphics/vignettes/0000755000176200001440000000000014774707431014552 5ustar liggesusersadegraphics/vignettes/adegraphics.bib0000644000176200001440000000264514115624042017472 0ustar liggesusers@article{Siberchicot2017, author = {Aurélie Siberchicot and Alice Julien-Laferrière and Anne-Béatrice Dufour and Jean Thioulouse and Stéphane Dray}, title = {{adegraphics: An S4 Lattice-Based Package for the Representation of Multivariate Data}}, year = {2017}, journal = {{The R Journal}}, url = {https://journal.r-project.org/archive/2017/RJ-2017-042/index.html}, pages = {198--212}, volume = {9}, number = {2} } @article{DrayJombart2011, title = {Revisiting Guerry's data: introducing spatial constraints in multivariate analysis}, author = {Stéphane Dray and Thibaut Jombart}, journal = {{The Annals of Applied Statistics}}, year = {2011}, volume = {5}, pages = {2278-2299} } @book{Sarkar2008, title={Lattice: multivariate data visualization with R}, author={Deepayan Sarkar}, year={2008}, publisher={Springer}, url = {https://doi.org/10.1007/978-0-387-75969-2} } @book{Murrell2005, title={R graphics}, author={Paul Murrell}, year={2005}, publisher={Chapman \& Hall/CRC Press}, url = {https://www.e-reading.club/bookreader.php/137370/C486x_APPb.pdf} } @article{Dray2007, author = {Stéphane Dray and Anne-Béatrice Dufour}, journal = {Journal of Statistical Software}, number = {4}, pages = {1--20}, title = {{The ade4 Package: Implementing the Duality Diagram for Ecologists}}, volume = {22}, year = {2007}, url = {https://doi.org/10.18637/jss.v022.i04} } adegraphics/vignettes/FAQ.Rmd0000644000176200001440000000402114647411121015605 0ustar liggesusers--- title: "Frequently Asked Questions" author: "Aurélie Siberchicot, Stéphane Dray, Jean Thioulouse" date: '`r Sys.Date()`' output: html_vignette: number_sections: yes toc: yes vignette: > %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{Frequently Asked Questions} %!\VignetteEncoding{UTF-8} \usepackage[utf8]{inputenc} --- ```{r} set.seed(2564) library(ade4) library(adegraphics) ``` # How to personalize plots ## How to update title axes? ```{r} df <- data.frame(x = rep(1:10,1), y = rep(1:10, each = 10), ms_li = runif(100, min = -5, max = 4)) s.value(df[, 1:2], df$ms_li, paxes.draw = TRUE) ``` ### Size titles on axes `xlab.cex` and `ylab.cex` manage the size titles on the `x` and `y` axes. ```{r} s.value(df[, 1:2], df$ms_li, paxes.draw = TRUE, xlab = "Longitude", xlab.cex = 0.5, ylab = "Latitude", ylab.cex = 0.5 ) ``` ### Size labels on axes `scales.x.cex` and `scales.y.cex` manage the sizes labels on the `x` and `y` axes. ```{r} s.value(df[, 1:2], df$ms_li, paxes.draw = TRUE, scales.x.cex = 0.5, scales.y.cex = 0.5 ) ``` ### Margin of axis `layout.heights = list(bottom.padding = 1)` manages the margin of the bottom axis. This enlarges the space for a larger title axis. ```{r} s.value(df[, 1:2], df$ms_li, paxes.draw = TRUE, xlab = "Longitude", xlab.cex = 2, ylab = "Latitude", ylab.cex = 2, layout.heights = list(bottom.padding = 2) ) ``` ## How to update label's boxes ? ```{r} x0 <- runif(50, -2, 2) y0 <- runif(50, -2, 2) s.label(data.frame(x0, y0)) ``` ### Remove boxes around labels ```{r} s.label(data.frame(x0, y0), plabels.boxes.border = 0) s.label(data.frame(x0, y0), plabels.boxes.draw = FALSE, ppoints.cex = 0) ``` ### Color of label's boxes ```{r} s.label(data.frame(x0, y0), plabels.boxes.col = "orange") ``` ### Border of label's boxes ```{r} s.label(data.frame(x0, y0), plabels.boxes.border = "blue", plabels.boxes.lwd = 2) ``` adegraphics/vignettes/gargsVSclass.csv0000644000176200001440000000376113747764071017702 0ustar liggesusers,s1d.barchart,s1d.curve,s1d.curves,s1d.density,s1d.dotplot,s1d.gauss,s1d.hist,s1d.interval,s1d.boxplot,s1d.class,s1d.distri,s1d.label,s1d.match,s.arrow,s.class,s.corcircle,s.density,s.distri,s.image,s.label,s.logo,s.match,s.traject,s.value,table.value (T.cont),table.image,table.value (T.value),triangle.class,triangle.label,triangle.match,triangle.traject ablineX,,,,,,,,,,,,,,,,,,,,,,,,,1,,,,,, ablineY,,,,,,,,,,,,,,,,,,,,,,,,,1,,,,,, addaxes,,,,,,,,,,,,,,,,,,,,,,,,,,,,,1,, addmean,,,,,,,,,,,,,,,,,,,,,,,,,,,,,1,, adjust,,,,,,,,,,,,,,,,,,,,,,,,,,,,1,1,1,1 arrows,,,,,,,,,,,,,,,,,,,,,,1,,,,,,,,, axespar,,,,,,,,,,,,,,,,,,,,,,,,,,,,,1,, bandwidth,,,,1,,,,,,,,,,,,,1,,,,,,,,,,,,,, breaks,,,,,,,1,,,,,,,,,,,,1,,,,,1,1,1,1,,,, center,,,,,,,,,,,,,,,,,,,,,,,,1,1,,1,,,, centerpar,,,,,,,,,,,,,,,,,,,,,,,,1,1,,1,,,, chullSize,,,,,,,,,,,,,,,1,,,,,,,,,,,,,1,,, col,,,,1,,1,,,1,1,,,,,1,,1,1,,,,,1,1,1,1,1,1,,,1 contour,,,,,,,,,,,,,,,,,1,,1,,,,,,,,,,,, ellipseSize,,,,,,,,,,,,,,,1,,,1,,,,,,,,,,1,,, fill,,,,1,,1,,,,,,,,,,,,,,,,,,,,,,,,, fullcircle,,,,,,,,,,,,,,,,1,,,,,,,,,,,,,,, gridsize,,,,1,,,,,,,,,,,,,1,,1,,,,,,,,,,,, kernel,,,,1,,,,,,,,,,,,,,,,,,,,,,,,,,, max3d,,,,,,,,,,,,,,,,,,,,,,,,,,,,1,1,1,1 meanpar,,,,,,,,,,,,,,,,,,,,,,,,,,,,,1,, meanX,,,,,,,,,,,,,,,,,,,,,,,,,1,,,,,, meanY,,,,,,,,,,,,,,,,,,,,,,,,,1,,,,,, method,,,,,,,,1,,,,,,,,,,,,,,,,1,1,,1,,,, min3d,,,,,,,,,,,,,,,,,,,,,,,,,,,,1,1,1,1 nclass,,,,,,,1,,,,,,,,,,1,,1,,,,,1,1,1,1,,,, nrpoints,,,,,,,,,,,,,,,,,1,,,,,,,,,,,,,, order,,,,,,,,,,,,,,,,,,,,,,,1,,,,,,,,1 outsideLimits,,,,,,,,,,,,,,,,,,,1,,,,,,,,,,,, poslab,,,,,,,,,,1,,1,,,,,,,,,,,,,,,,,,, rect,,,,,,,,,,,,,,,,,,,,,1,,,,,,,,,, region,,,,,,,,,,,,,,,,,1,,1,,,,,,,,,,,, right,,,,,,1,,,,,,,,,,,,,,,,,,,,,,,,, sdSize,,,,,,,,,,,1,,,,,,,,,,,,,,,,,,,, span,,,,,,,,,,,,,,,,,,,1,,,,,,,,,,,, starSize,,,,,,,,,,,,,,,1,,,1,,,,,,,,,,1,,, steps,,,,,,1,,,,,,,,,,,,,,,,,,,,,,,,, symbol,,,,,,,,,,,,,,,,,,,,,,,,1,1,,1,,,, threshold,,,,,,,,,,,,,,,,,1,,,,,,,,,,,,,, type,,,,,,,1,,,,,,,,,,,,,,,,,,,,,,,, yrank,,,,,,,,,,,1,,,,,,,,,,,,,,,,,,,, adegraphics/vignettes/gargsVSclass.R0000644000176200001440000000070713742303021017260 0ustar liggesuserslibrary(grid) t <- read.csv("gargsVSclass.csv", sep = ",", header = TRUE, check.names = FALSE) row.names(t) <- t[, 1] t <- t[, -1] t[is.na(t)] <- 0 table.value(t, plegend.drawKey = FALSE, ppoints.cex = 0.2, symbol = "circle", axis.text = list(cex = 0.7), pgrid.draw = TRUE, ptable.margin = list(bottom = 5, left = 15, top = 15, right = 5), ptable.x = list(tck = 5), ptable.y = list(tck = 5, srt = 45, pos = "left")) adegraphics/vignettes/adegraphics.Rmd0000644000176200001440000015643014572055321017467 0ustar liggesusers--- title: "The `adegraphics` package" author: "Alice Julien-Laferrière, Aurélie Siberchicot and Stéphane Dray" date: '`r Sys.Date()`' output: html_vignette: number_sections: yes toc: yes bibliography: adegraphics.bib vignette: > %\VignetteIndexEntry{The `adegraphics` package} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} \usepackage[utf8]{inputenc} ---

The `adegraphics` package [@Siberchicot2017] is a complete reimplementation of the graphical functionalities of the `ade4` package [@Dray2007]. The package has been initially designed to improve the representation of the outputs of multivariate analyses performed with `ade4` but as its graphical functionalities are very general, they can be used for other purposes. The `adegraphics` package provides a flexible environment to produce, edit and manipulate graphs. We adopted an *object oriented* approach (a graph is an object) using `S4` classes and methods and used the visualization system provided by the `lattice` [@Sarkar2008] and `grid` [@Murrell2005] packages. In `adegraphics`, graphs are R objects that can be edited, stored, combined, saved, removed, etc. Note that we tried to facilitate the handling of `adegraphics` by `ade4` users. Hence, the name of functions and parameters has been preserved in many cases. The main changes are listed in the appendix of this vignette so that it should be quite easy to use `adegraphics`. However, several new functionalities (graphical parameters, creation and manipulation of graphical objects, etc.) are now available and detailed in this vignette. The *adelist* mailing list can be used to send questions and/or comments on `adegraphics` (see )
An overview of object classes ============================= In `adegraphics`, a user-level function produces a plot that is stored (and returned) as an object. The class architecture of the objects created by `adegraphics` functions is described in [Figure 1](#classes).
Figure 1: Classes structure and user-level functions

This class management highlights a hierarchy with two parent classes: - `ADEg` for simple graphs. It contains the display of a single data set using only one kind of representation (e.g., arrows, points, lines, etc.) - `ADEgS` for multiple graphs. It contains a collection of at least two simple graphs (`ADEg`, `trellis` or `ADEgS`) The `ADEg` class has five child classes which are also subdivided in several child classes. Each of these five child classes is dedicated for a particular graphical data representation: - `ADEg.S1`: unidimensional graph of a numeric score - `ADEg.S2`: bidimensional graph of xy coordinates (`matrix` or `data.frame` object) - `ADEg.C1`: bidimensional graph of a numeric score (bar chart or curve) - `ADEg.T`: heat map-like representation of a data table (`matrix`, `data.frame`, `dist` or `table` object) - `ADEg.Tr`: ternary plot of xyz coordinates (`matrix` or `data.frame` object) The `ADEg` class and its five child classes are virtual: it is not allowed to create object belonging to these classes. Users can only create objects belonging to child classes by calls to user functions (see the [User functions](#user-functions) section). Simple graph (`ADEg` object) ============================ In the `adegraphics` package, a graph is created by a call to a user function and stored as an R object. These functions allow to display the raw data but also the outputs of a multivariate analysis. The following sections describe the different graphical functions available in the package. User functions -------------- Several user functions are available to create a simple graph (stored as an `ADEg` object in R). Each function creates an object of a given class (see [Figure 1](#classes)). [Table 1](#functionsADEg) lists the different functions, their corresponding classes and a short description. The `ade4` users would not be lost: many functions have kept their names in `adegraphics`. The main changes are listed in [Table 2](#functionsADEgchanged).
Table 1: Graphical functions available in `adegraphics` Function Class of the returned object Description --------- ------------------------------ -------------- `s1d.barchart` `C1.barchart` 1-D plot of a numeric score by bars `s1d.curve` `C1.curve` 1-D plot of a numeric score linked by curves `s1d.curves` `C1.curves` 1-D plot of multiple scores linked by curves `s1d.density` `C1.density` 1-D plot of a numeric score by density curves `s1d.dotplot` `C1.dotplot` 1-D plot of a numeric score by dots `s1d.gauss` `C1.gauss` 1-D plot of a numeric score by Gaussian curves `s1d.hist` `C1.hist` 1-D plot of a numeric score by bars `s1d.interval` `C1.interval` 1-D plot of the interval between two numeric scores `s1d.boxplot` `S1.boxplot` 1-D box plot of a numeric score partitioned in classes `s1d.class` `S1.class` 1-D plot of a numeric score partitioned in classes `s1d.distri` `S1.distri` 1-D plot of a numeric score by means/tandard deviations computed using an external table of weights `s1d.label` `S1.label` 1-D plot of a numeric score with labels `s1d.match` `S1.match` 1-D plot of the matching between two numeric scores `s.arrow` `S2.arrow` 2-D scatter plot with arrows `s.class` `S2.class` 2-D scatter plot with a partition in classes `s.corcircle` `S2.corcircle` Correlation circle `s.density` `S2.density` 2-D scatter plot with kernel density estimation `s.distri` `S2.distri` 2-D scatter plot with means/standard deviations computed using an external table of weights `s.image` `S2.image` 2-D scatter plot with loess estimation of an additional numeric score `s.label` `S2.label` 2-D scatter plot with labels `s.logo` `S2.logo` 2-D scatter plot with logos (pixmap objects) `s.match` `S2.match` 2-D scatter plot of the matching between two sets of coordinates `s.Spatial` `S2.label` Mapping of a `Spatial*` object `s.traject` `S2.traject` 2-D scatter plot with trajectories `s.value` `S2.value` 2-D scatter plot with proportional symbols `table.image` `T.image` Heat map-like representation with colored cells `table.value` `T.value` or `T.cont` Heat map-like representation with proportional symbols `triangle.class` `Tr.class` Ternary plot with a partition in classes `triangle.label` `Tr.label` Ternary plot with labels `triangle.match` `Tr.match` Ternary plot of the matching between two sets of coordinates `triangle.traject` `Tr.match` Ternary plot with trajectories
Table 2: Changes in functions names between `ade4` and `adegraphics` Function in `ade4` Equivalence in `adegraphics` ------------------------------------------- ------------------------------ `table.cont`, `table.dist`, `table.value` `table.value` [^1] `table.paint` `table.image` `sco.boxplot` `s1d.boxplot` `sco.class` `s1d.class` `sco.distri` `s1d.distri` `sco.gauss` `s1d.gauss` `sco.label` `s1d.label` `sco.match` `s1d.match` `sco.quant` no equivalence `s.chull` `s.class`[^2] `s.kde2d` `s.density` `s.match.class` superposition of `s.match` and `s.class` `triangle.biplot` `triangle.match` `triangle.plot` `triangle.label` `s.multinom` `triangle.multinom` [^1]: The `table.value` function is now generic and can handle `dist` or `table` objects as arguments. [^2]: Convex hulls are now drawn by the `s.class` function (argument `chullSize`.) Arguments --------- The list of arguments of a function are given by the `args` function. ```{r label=chunk1} library(ade4) library(adegraphics) args(s.label) ``` Some arguments are very general and present in all user functions: - `plot`: a logical value indicating if the graph should be displayed - `storeData`: a logical value indicating if the data should be stored in the returned object. If `FALSE`, only the names of the data are stored. This allows to reduce the size of the returned object but it implies that the data should not be modified in the environment to plot again the graph. - `add`: a logical value indicating if the graph should be superposed on the graph already displayed in the current device (it replaces the argument `add.plot` in `ade4`). - `pos`: an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if `storeData` is `FALSE`. - `…`: additional graphical parameters (see below) Some other arguments influence the graphical outputs and they are thus specific to the type of produced graph. [Figure 2](#gargsVSclass) summarizes some of these graphical parameters available for the different functions. We only reported the parameters stored in the `g.args` slot of the returned object (see the [Parameters in `g.args`](#gargs) section).
Figure 2: Specific arguments in each object class ```{r label=fig-gargsVSclass, include=TRUE, echo=FALSE, fig.width=7, fig.height=8} source("gargsVSclass.R") ```


The `ade4` users would note that the names of some arguments have been modified in `adegraphics`. The [Appendix](#appendix) gives a full list of these modifications. Slots and Methods ----------------- A call to a graphical function (see the [User functions](#user-functions) section) returns an `ADEg` object. Each object is defined by a number of slots and several methods are associated to this class. Let us consider the `olympic` data set available in the `ade4` package. A principal component analysis (PCA) is applied on the `olympic$tab` table that contains the results for 33 participating athletes at the 1988 summer olympic games: ```{r label=chunk2} data(olympic) pca1 <- dudi.pca(olympic$tab, scannf = FALSE) ``` The barplot of eigenvalues is then drawn and stored in `g1`: ```{r label=plot1, fig.height=4, fig.width=4} g1 <- s1d.barchart(pca1$eig, p1d.horizontal = F, ppolygons.col = "white") ```
The class of the `g1` object is `C1.barchart` which extends the `ADEg` class: ```{r label=chunk3} class(g1) showClass("C1.barchart") ```
This object contains different slots: ```{r label=chunk4} slotNames(g1) ```
These slots are defined for each `ADEg` object and contain different types of information. The package `adegraphics` uses the capabilities of the `lattice` package to display a graph (by generating a `trellis` object). Hence, several slots contain information that will be passed in the call to the `lattice` functions: - `data`: a list containing information about the data. - `trellis.par`: a list of graphical parameters that are directly passed to the `lattice` functions using the `par.settings` argument (see the [Parameters in `trellis.par`](#trellispar) section). - `adeg.par`: a list of graphical parameters defined in `adegraphics`. The list of parameters can be obtained using the `adegpar` function (see the [Parameters in `adeg.par`](#adegpar) section). - `lattice.call`: a list of two elements containing the information required to create the `trellis` object: `graphictype` (the name of the `lattice` functions that should be used) and `arguments` (the list of parameter values required to obtain the `trellis` object). - `g.args`: a list containing at least the different values of the graphical arguments described in [Figure 2](#gargsVSclass) (see the [Parameters in `g.args`](#gargs) section). - `stats`: a list of internal preliminary computations performed to display the graph. - `s.misc`: a list of other internal parameters. - `Call`: an object of class `call` containing the matched call.
These different slots can be extracted using the `@` operator: ```{r label=chunk5} g1@data ```
All these slots are automatically filled during the object creation. The `trellis.par`, `adeg.par` and `g.args` can also be modified *a posteriori* using the `update` method (see the [Customizing a graph](#update) section). This allows to customize graphs after their creation. We consider the correlation circle that depicts the correlation between PCA axes and the results for each event: ```{r label=plot2, fig.width=4, fig.height=4} g2 <- s.corcircle(pca1$co) ``` ```{r label=chunk6} class(g2) g2@g.args ```
The argument `fullcircle` can be updated *a posteriori* so that the original object is modified: ```{r label=plot3, fig.width=4, fig.height=4} update(g2, fullcircle = FALSE) g2@g.args ``` Several other methods have been defined for the `ADEg` class allowing to extract information, modify or combine objects: - `getcall`, `getlatticecall` and `getstats`: these accessor methods return respectively the `Call`, the `lattice.call` and the `stats` slots. - `getparameters`: this method returns the `trellis.par` and/or the `adeg.par` slots. - `show`, `print` and `plot`: these methods display the `ADEg` object in the current device or in a new one. - `gettrellis`: this method returns the `ADEg` object as a `trellis` object. It can then be exploited using the `lattice` and `latticeExtra` packages. - `superpose`, `+` and `add.ADEg`: these methods superpose two `ADEg` graphs. It returns a multiple graph object of class `ADEgS` (see the [The basic methods for superposition, juxtaposition and insertion](#superpose) section). - `insert`: this method inserts an `ADEg` graph in an existing one or in the current device. It returns an `ADEgS` object (see the [The basic methods for superposition, juxtaposition and insertion](#superpose) section). - `cbindADEg`, `rbindADEg`: these methods combine several `ADEg` graphs. It returns an `ADEgS` object (see the [The basic methods for superposition, juxtaposition and insertion](#superpose) section). - `update`: this method modifies the graphical parameters after the `ADEg` creation. It updates the current display and returns the modified `ADEg` (see the [Customizing a graph](#update) section). For instance: ```{r label=chunk7} getcall(g1) ## equivalent to g1@Call ``` A biplot-like graph can be obtained using the `superpose` method. The result is a multiple graph: ```{r label=plot4, fig.width=4, fig.height=4} g3 <- s.label(pca1$li) g4 <- s.arrow(5 * pca1$c1, add = TRUE) class(g4) ``` In addition, some object classes have specific methods. For instance, a `zoom` method is available for `ADEg.S1` and `ADEg.S2` classes. For the `ADEg.S2` class, the method `addhist` (see the [The basic methods for superposition, juxtaposition and insertion](#superpose) section) decorates a 2-D graph by adding marginal distributions as histograms and density lines (this method replaces and extends the `s.hist` function of `ade4`). ```{r label=plot5, fig.width=4, fig.height=4} zoom(g3, zoom = 2, center = c(2, -2)) ``` Multiple graph (`ADEgS` object) =============================== The `adegraphics` package provides class `ADEgS` to manage easily the combination of several graphs. This class allows to deal with the superposition, insertion or juxtaposition of several graphs in a single object. An object of this class is a list containing several graphical objects and information about their positioning. Different ways to generate `ADEgS` objects are described below. Slots and Methods ----------------- The class `ADEgS` is used to store multiple graphs. Different slots are associated to this class (use the symbol `@` to extract information): - `ADEglist`: a list of graphs stored as `trellis`, `ADEg` and/or `ADEgS` objects. - `positions`: a matrix containing the positions of the graphs. It has four columns and as many rows as the number of graphical objects in the `ADEglist` slot. For each graph (i.e. row), it contains the coordinates of the bottom-left and top-right corners in `npc` units (i.e. normalized parent coordinates varying between 0 and 1). - `add`: a square binary matrix with as many rows and columns as the number of graphical objects in the `ADEglist` slot. It allows to manage the superposition of graphs: the value at the i-th row and j-th column is equal to 1 if the j-th graphical object is superposed on the i-th. Otherwise, this value is equal to 0. - `Call`: an object of class `call` containing the matched call. Several methods have been implemented to obtain information, edit or modify `ADEgS` objects. Several methods are inspired from the management of `list` in R: - `[`, `[[` and `$`: these methods extract one or more elements from the `ADEgS` object. - `getpositions`, `getgraphics` and `getcall`: these methods return the `positions`, the `ADEglist` and the `Call` slots, respectively. - `names` and `length`: these methods return the names and number of graphs contained in the object. - `[[<-` and `names<-`: these methods replace a graph or its name in an `ADEgS` object (acts on the `ADEglist` slot). - `show`, `plot` and `print`: these methods display the `ADEgS` object in the current device or in a new one. - `superpose` and `+`: these methods superpose two graphs. It returns a multiple graph object of class `ADEgS` (see the [The basic methods for superposition, juxtaposition and insertion](#superpose) section). - `insert`: this method inserts a graph in an existing one or in the current device. It returns a multiple graph object of class `ADEgS` (see the [The basic methods for superposition, juxtaposition and insertion](#superpose) section). - `cbindADEg`, `rbindADEg`: these methods combine several graphs. It returns an `ADEgS` object (see the [The basic methods for superposition, juxtaposition and insertion](#superpose) section). - `update`: this method modifies the names and/or the `positions` of the graphs contained in an `ADEgS` object. It updates the current display and returns the modified `ADEgS`. We will show in the next sections how these methods can be used to deal with `ADEgS` objects. Creating an `ADEgS` object by hand ---------------------------------- The `ADEgS` objects can be created by easy manipulation of several simple graphs. Some methods (e.g., `insert`, `superpose`) can be used to create a compilation of graphs by hand. ### The basic methods for superposition, juxtaposition and insertion The functions `superpose`, `+` and `add.ADEg` allow the superposition of an `ADEg`/`ADEgS` object on an `ADEg`/`ADEgS` object. The vector `olympic$score` contains the total number of points computed for each participant. This vector is used to generate a `factor` partitioning the participants in two groups according to their final result (more or less than 8000 points): ```{r label=chunk8} fac.score <- factor(olympic$score < 8000, labels = c("MT8000", "LT8000")) ``` These two groups can be represented on the PCA factorial map using the `s.class` function: ```{r label=plot6, fig.width=4, fig.height=4} g5 <- s.class(pca1$li, fac.score, col = c("red", "blue"), chullSize = 1, ellipseSize = 0, plabels.cex = 2, pbackground.col = "grey85", paxes.draw = TRUE) ``` The graph with the labels (object `g3`) can then be superposed on this one: ```{r label=plot7, fig.width=4, fig.height=4} g6 <- superpose(g5, g3, plot = TRUE) ## equivalent to g5 + g3 class(g6) ``` In the case of a superposition, the graphical parameters (e.g., background and limits) of the first graph (the one below) are used as a reference and applied to the second one (the one above). Note that it is also possible to use the `add = TRUE` argument in the call of a simple user function (functions described in [Table 1](#functionsADEg)) to perform a superposition. The graph `g6` can also be obtained by: ```{r label=chunk9, eval=FALSE} g5 s.label(pca1$li, add = TRUE) ``` The functions `cbindADEg` and `rbindADEg` allows to combine several graphical objects (`ADEg`, `ADEgS` or `trellis`) by rows or by columns. The new created `ADEgS` contains the list of the reduced graphs: ```{r label=plot8, fig.width=6, fig.height=6} rbindADEg(cbindADEg(g2, g3), cbindADEg(g5, g6), plot = TRUE) ``` The function `insert` allows the insertion of a graphical object on another one (`ADEg` or `ADEgS`). It takes the position of the inserted graph as an argument: ```{r label=plot9, fig.width=4, fig.height=4} g7 <- insert(g2, g6, posi = c(0.65, 0.65, 0.95, 0.95)) class(g7) ``` The different methods associated to the `ADEgS` class allow to obtain information and to modify the multiple graph: ```{r label=chunk10} length(g7) names(g7) names(g7) <- c("chulls", "labels", "cor") class(g7[1]) class(g7[[1]]) class(g7$chulls) ``` The multiple graph contains three simple graphs. It can be easily updated. For instance, the size of the inserted graph can be modified: ```{r label=plot10, fig.width=4, fig.height=4} pos.mat <- getpositions(g7) pos.mat pos.mat[3,] <- c(0.1, 0.7, 0.3, 0.9) update(g7, positions = pos.mat) ``` The graphs themselves can be modified, without affecting the global structure of the `ADEgS` object. Here, we replace the correlation circle by the barplot of eigenvalues: ```{r label=plot11, fig.width=4, fig.height=4} g7[[3]] <- g1 g7 ``` The `addhist` method adds univariate marginal distributions around an `ADEg.S2` and returns an `ADEgS` object: ```{r label=plot12, fig.width=4, fig.height=4} addhist(g3) ``` More examples are available in the help page by typing `example(superpose)`, `example(insert)`, `example(add.ADEg)` and `example(addhist)` in the R session. ### The `ADEgS` function The `ADEgS` function provides the most elementary and flexible way to create an `ADEgS` object. The different arguments of the function are: - `adeglist`: a list of several `trellis`, `ADEg` and/or `ADEgS` objects. - `positions`: a matrix with four columns and as many rows as the number of graphical objects in the `ADEglist` slot. For each subgraph, i.e. in each row, the coordinates of the top-right and the bottom-left hand corners are given in `npc` units (i.e., normalized parent coordinates varying from 0 to 1). - `layout`: an alternative way to specify the positions of graphs. It could be a vector of length 2 indicating the number of rows and columns used to split the device (similar to `mfrow` parameter in basic graphs). It could also be a matrix specifying the location of the graphs: each value in this matrix should be 0 or a positive integer (similar to `layout` function for basic graphs). - `add`: a square matrix with as many rows and columns as the number of graphical objects in the `ADEglist` slot. The value at the i-th row and j-th column is equal to 1 if the j-th graphical object is superposed to i-th one. Otherwise, this value is equal to 0. - `plot`: a logical value indicating if the graphs should be displayed. When users fill only one argument among `positions`, `layout` and `add`, the other values are automatically computed to define the `ADEgS` object. We illustrate the different possibilities to create objects with the `ADEgS` function. Simple juxtaposition using a vector as layout: ```{r label=plot13, fig.width=6, fig.height=3} ADEgS(adeglist = list(g2, g3), layout = c(1, 2)) ``` Layout specified as a matrix: ```{r label=plot14, fig.width=5, fig.height=5} mlay <- matrix(c(1, 1, 0, 1, 1, 0, 0, 0, 2), byrow = T, nrow = 3) mlay ADEgS(adeglist = list(g6, g2), layout = mlay) ``` Using the matrix of positions offers a very flexible way to arrange the different graphs: ```{r label=plot15, fig.width=5, fig.height=5} mpos <- rbind(c(0, 0.3, 0.7, 1), c(0.5, 0, 1, 0.5)) ADEgS(adeglist = list(g3, g5), positions = mpos) ``` Lastly, superposition can also be specified using the `add` argument: ```{r label=plot16, fig.width=4, fig.height=4} ADEgS(list(g5, g3), add = matrix(c(0, 1, 0, 0), byrow = TRUE, ncol = 2)) ``` More examples are available in the help page by typing `example(ADEgS)` in the R session. Automatic collections --------------------- The package `adegraphics` contains functionalities to create collections of graphs. These collections are based on a simple graph repeated for different groups of individuals, variables or axes. The building process of these collections is quite simple (definition of arguments in the call of a user function) and leads to the creation of an `ADEgS` object. ### Partitioning the data (`facets`) The `adegraphics` package allows to split up the data by one variable (`factor`) and to plot the subsets of data together. This possibility of conditional plot is available for all user functions (except the `table.*` functions) by setting the `facets` argument. This is directly inspired by the functionalities offered in the `lattice` and `ggplot2` packages. Let us consider the `jv73` data set. The table `jv73$morpho` contains the measures of 6 variables describing the geomorphology of 92 sites. A PCA can be performed on this data set: ```{r label=plot17, fig.width=4, fig.height=4} data(jv73) pca2 <- dudi.pca(jv73$morpho, scannf = FALSE) s.label(pca2$li) ``` The sites are located on 12 rivers (`jv73$fac.riv`) and it is possible to represent the PCA scores for each river using the `facets` argument: ```{r label=plot18, fig.width=7, fig.height=5.2} g8 <- s.label(pca2$li, facets = jv73$fac.riv) length(g8) names(g8) ``` The `ADEgS` returned object contains the 12 plots. It is then possible to focus on a given river (e.g., the Doubs river) by considering only a subplot (e.g., type `g8$Doubs`). The `facets` functionality is very general and available for the majority of `adegraphics` functions. For instance, with the `s.class` function: ```{r label=plot19, fig.width=7, fig.height=5.2} s.class(pca2$li, fac = jv73$fac.riv, col = rainbow(12), facets = jv73$fac.riv) ``` ### Multiple axes All 2-D functions (i.e. `s.*`) returning an object inheriting from the `ADEg.S2` class have the `xax` et `yax` arguments. These arguments allow to choose which column of the main argument (i.e. `df`) should be plotted as x and y axes. As in `ade4`, these two arguments can be simple integers. In `adegraphics`, the user can also specify vectors as `xax` and/or `yax` arguments to obtain multiple graphs. Here, we represent the different correlation circles associated to the first four PCA axes of the olympic data set: ```{r label=plot20, fig.width=6, fig.height=6} pca1 <- dudi.pca(olympic$tab, scannf = FALSE, nf = 4) g9 <- s.corcircle(pca1$co, xax = 1:2, yax = 3:4) length(g9) names(g9) g9@positions ``` ### Multiple score All 1-D functions (i.e. `s1d.*`) returning an object inheriting from the `ADEg.C1` or `ADEg.S1` classes have the `score` argument. Usually, this argument should be a numeric vector but it is also possible to consider an object with several columns (`data.frame` or `matrix`). In this case, an `ADEgS` object is returned in which one graph by column is created. For instance for the `olympic` data set, we can represent the link between the global performance (`fac.score`) and the PCA scores on the first four axes (`pca1$li`): ```{r label=plot21, fig.width=6, fig.height=6} dim(pca1$li) s1d.boxplot(pca1$li, fac.score, col = c("red", "blue"), psub = list(position = "topleft", cex = 2)) ``` ### Multiple variable Some user functions (`s1d.density`, `s1d.gauss`, `s1d.boxplot`, `s1d.class`, `s.class`, `s.image`, `s.traject`, `s.value`, `triangle.class`) have an argument named `fac` or `z`. This argument can have several columns (`data.frame` or `matrix`) so that each column is used to create a separate graph. For instance, we can represent the distribution of the 6 environmental variables on the PCA factorial map of the `jv73$tab` data set: ```{r label=plot22, fig.width=6, fig.height=4} s.value(pca2$li, pca2$tab, symbol = "circle") ``` ### Outputs of the `ade4` package Lastly, we reimplemented all the graphical functions of the `ade4` package designed to represent the outputs of a multivariate analysis. The functions `ade4::plot.*`, `ade4::kplot.*`, `ade4::scatter.*` and `ade4::score.*` return `ADEgS` objects. It is now very easy to represent or modify these graphical outputs: ```{r label=plot23, fig.width=6, fig.height=6} data(meaudret) pca3 <- dudi.pca(meaudret$env, scannf = FALSE) pca4 <- dudi.pca(meaudret$spe, scale = FALSE, scannf = FALSE) coi1 <- coinertia(pca3, pca4, scannf = FALSE, nf = 3) g10 <- plot(coi1) class(g10) names(g10) g10@Call ``` Customizing a graph =================== Compared to the `ade4` package, the main advantage of `adegraphics` concerns the numerous possibilities to customize a graph using several graphical parameters. These parameters are stored in slots `trellis.par`, `adeg.par` and `g.args` (see the [Slots and Methods](#slots) section) of an `ADEg` object. These parameters can be defined during the creation of a graph or updated *a posteriori* (using the `update` method). Parameters in `trellis.par` --------------------------- The `trellis.par` slot is a list of parameters that are directly included in the call of functions of the `lattice` package. The name of parameters and their default value are given by the `trellis.par.get` function of `lattice`. ```{r label=chunk11} library(lattice) sort(names(trellis.par.get())) ``` Hence, modifications of some of these parameters will modify the graphical display of an `ADEg` object. For instance, margins are defined using `layout.widths` and `layout.heights` parameters, `clip` parameter allows to overpass panel boundaries and `axis.line` and `axis.text` allow to customize lines and text of axes. ```{r label=plot24, fig.width=7, fig.height=3.5} d <- scale(olympic$tab) g11 <- table.image(d, plot = FALSE) g12 <- table.image(d, axis.line = list(col = "blue"), axis.text = list(col = "red"), plot = FALSE) ADEgS(c(g11, g12), layout = c(1, 2)) ``` Parameters in `adeg.par` ------------------------ The `adeg.par` slot is a list of graphical parameters specific to the `adegraphics` package. The name of parameters and their default value are available using the `adegpar` function which is inspired by the `par` function of the `graphics` package. ```{r label=chunk12} names(adegpar()) ``` A description of these parameters is available in the help page of the function (`?adegpar`). Note that each `adeg.par` parameter starts by the letter ’p’ and its name relates to the type of graphical element considered (`ptable` is for tables display, `ppoints` for points, `parrows` for arrows, etc). Each element of this list can contain one or more sublists. Details on a sublist are obtained using its name either as a parameter of the `adegpar` function or after the `$` symbol. For example, if we want to know the different parameters to manage the display of points: ```{r label=chunk13} adegpar("ppoints") adegpar()$ppoints ``` The full list of available parameters is summarized in [Figure 3](#paramVSparam).
Figure 3: Parameters that can be set with the `adegpar` function. ```{r label=fig-paramVSparam, echo=FALSE, fig.width=7, fig.height=7} source("paramVSparam.R") ```

The ordinate represents the different sublists and the abscissa gives the name of the parameters available in each sublist. Note that some row names have two keys separated by a dot: the first key indicates the first level of the sublist, etc. For example `plabels.boxes` is the sublist `boxes` of the sublist `plabels`. The parameters `border`,`col`, `alpha`, `lwd`, `lty` and `draw` in `plabels.boxes` allow to control the aspect of the boxes around labels. According to the function called, only some of the full list of `adeg.par` parameters are useful to modify the graphical display. [Figure 4](#paramVSfunction) indicates which parameters can affect the display of an object created by a given user function. For example, the background (`pbackground` parameter) can be modified for all functions whereas the display of ellipses (`pellipses` parameter) affects only three functions.
Figure 4: Effect of `adeg.par` parameters in `adegraphics` functions. ```{r label=fig-paramVSfunction, echo=FALSE, fig.width=7, fig.height=10} source("paramVSfunction.R") ```

### Global assignment The `adegpar` function allows to modify globally the values of graphical parameters so that changes will affect all subsequent displays. For example, we update the size/color of labels and add axes to a plot: ```{r label=plot25, fig.width=6, fig.height=3} oldadegpar <- adegpar() adegpar("plabels") g13 <- s.label(dfxy = pca1$li, plot = FALSE) adegpar(plabels = list(col = "blue", cex = 1.5), paxes.draw = TRUE) adegpar("plabels") g14 <- s.label(dfxy = pca1$li, plot = FALSE) ADEgS(c(g13, g14), layout = c(1, 2)) ``` As the `adegpar` function can accept numerous graphical parameters, it can be used to define some graphical themes. The next releases of `adegraphics` will offer functionalities to easily create, edit and store graphical themes. Here, we reassign the original default parameters: ```{r label=chunk14} adegpar(oldadegpar) ``` ### Local assignment A second option is to update the graphical parameters locally so that the changes will only modify the object created. This is done using the dots (`...`) argument in the call to a user function. In this case, the default values of parameters in the global environment are not modified: ```{r label=plot26, fig.width=4, fig.height=4} adegpar("ppoints") s.label(dfxy = pca1$li, plabels.cex = 0, ppoints = list(col = c(2, 4, 5), cex = 1.5, pch = 15)) adegpar("ppoints") ``` In the previous example, we can see that parameters can be either specified using a ’`.`’ separator or a list. For instance, using `plabels.cex = 0` or `plabels = list(cex = 0)` is strictly equivalent. Moreover, partial names can be used if there is no ambiguity (such as `plab.ce = 0` in our example). Parameters in `g.args` ---------------------- The `g.args` slot is a list of parameters specific to the function used (and thus to the class of the returned object). Several parameters are very general and used in all `adegraphics` functions: - `xlim`, `ylim`: limits of the graph on the x and y axes - `main`, `sub`: main title and subtitle - `xlab`, `ylab`: labels of the x and y axes - `scales`: a list determining how the x and y axes (tick marks dans labels) are drawn; this is the `scales` parameter of the `xyplot` function of `lattice` The `ADEg.S2` objects can also contain spatial information (map stored as a `Spatial` object or neighborhood stored as a `nb` object): - `Sp`, `sp.layout`: objects from the `sp` package to display spatial objects, `Sp` for maps and `sp.layout` for spatial widgets as a North arrow, scale, etc. - `nbobject`: object of class `nb` or `listw` to display neighbor graphs. When the `facets` (see the [Partitioning the data (`facets`)](#facets) section) argument is used, users can modify the parameter `samelimits`: if it is `TRUE`, all graphs have the same limits whereas limits are computed for each subgraph independently when it is `FALSE`. For example, considering the `jv73` data set, each subgraph is computed with its own limits and labels are then more scattered: ```{r label=plot27, fig.width=7, fig.height=5.2} s.label(pca2$li, facets = jv73$fac.riv, samelimits = FALSE) ``` Several other `g.args` parameters can be updated according to the class of the created object (see [Figure 2](#gargsVSclass)). Parameters applied on a `ADEgS` ------------------------------- Users can either apply the changes to all graphs or to update only one graph. Of an `ADEgS`, to apply changes on all the graphs contained in an `ADEgS`, the syntax is similar to the one described for an `ADEg` object. For example, background color can be changed for all graphs in `g10` using the `pbackground.col` parameter. ```{r label=plot28, fig.width=6, fig.height=6} g15 <- plot(coi1, pbackground.col = "steelblue") ``` To change the parameters of a given graph, the name of the parameter must be preceded by the name of the subgraph. This supposes that the names of subgraphs are known. For example, to modify only two graphs: ```{r label=plot29, fig.width=6, fig.height=6} names(g15) plot(coi1, XYmatch.pbackground.col = "steelblue", XYmatch.pgrid.col = "red", eig.ppolygons.col = "orange") ``` Using `adegraphics` functions in your package ============================================= In this section, we illustrate how `adegraphics` functionalities can be used to implement graphical functions in your own package. We created an objet of class `track` that contains a vector of distance and time. ```{r label=chunk15} tra1 <- list() tra1$time <- runif(300) tra1$distance <- tra1$time * 5 + rnorm(300) class(tra1) <- "track" ``` For an object of the class `track`, we wish to represent different components of the data: - an histogram of distances - an histogram of speeds (i.e., distance / time) - a 2D plot representing the distance, the time and the line corresponding to the linear model that predict distance by time The corresponding multiple plot can be done using `adegraphics` functions: ```{r label=plot30, fig.width=7, fig.height=2.3} g1 <- s1d.hist(tra1$distance, psub.text = "distance", ppolygons.col = "blue", pgrid.draw = FALSE, plot = FALSE) g2 <- s1d.hist(tra1$distance / tra1$time, psub.text = "speed", ppolygons.col = "red", plot = FALSE) g31 <- s.label(cbind(tra1$time, tra1$distance), paxes = list(aspectratio = "fill", draw = TRUE), plot = FALSE) g32 <- xyplot(tra1$distance ~ tra1$time, aspect = g31@adeg.par$paxes$aspectratio, panel = function(x, y) {panel.lmline(x, y)}) g3 <- superpose(g31, g32) G <- ADEgS(list(g1, g2, g3)) ``` To facilitate the graphical representation of an object of class `track`, the simplest solution is to design a function `plot` for this class. We illustrate how to define such function with a particular emphasis on the management of graphical parameters. The function is provided below and we detail the different steps. ```{r label=chunk16} plot.track <- function(x, pos = -1, storeData = TRUE, plot = TRUE, ...) { ## step 1 : sort parameters for each graph graphsnames <- c("histDist", "histSpeed", "regression") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames, nbsubgraphs = c(1, 1, 2)) ## step 2 : define default values for graphical parameters params <- list() params[[1]] <- list(psub = list(text = "distance"), ppolygons = list(col = "blue"), pgrid = list(draw = FALSE)) params[[2]] <- list(psub = list(text = "speed"), ppolygons = list(col = "red"), pgrid = list(draw = FALSE)) params[[3]] <- list() params[[3]]$l1 <- list(paxes = list(aspectratio = "fill", draw = TRUE)) params[[3]]$l2 <- list() names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## step 3 : create each individual plot (ADEg) g1 <- do.call("s1d.hist", c(list(score = substitute(x$distance), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s1d.hist", c(list(score = substitute(x$distance / x$time), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g31 <- do.call("s.label", c(list(dfxy = substitute(cbind(x$time, x$distance)), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]][[1]])) g32 <- xyplot(x$distance ~ x$time, aspect = g31@adeg.par$paxes$aspectratio, panel = function(x, y) {panel.lmline(x, y)}) g3 <- do.call("superpose", list(g31, g32)) g3@Call <- call("superpose", g31@Call, g32$call) ## step 4 : create the multiple plot (ADEgS) lay <- matrix(1:3, 1, 3) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3), positions = layout2position(lay), add = matrix(0, ncol = 3, nrow = 3), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } ``` In the first step, the arguments given by the user through the dots (…) argument are managed. A name is given to each subgraph and stored in the vector `graphnames`. Then, the function `sortparamADEgS` associates the graphical parameters of the dots (…) argument to each subgraph. If a prefix is specified and matches the name of a graph (e.g., `histDist.pbackground.col = grey`), the parameter is applied only to the graphic specified (e.g., called `histDist`). If no prefix is specified (e.g., `pbackground.col = grey`), the parameter is applied to all subgraphs. The function `sortparamADEgS` returns a list (length equal to the number of subgraph) of lists of graphical parameters.\ In the second step, default values for some graphical parameters are modified. The default parameters are stored in a list which has the same structure that the one produced by `sortparamADEgS` (i.e., names corresponding to those contained in `graphsnames`). Then, the `modifyList` function is applied to merge user and defaults values of paramaters (if a parameter is specified by the user and in the default, the value given by the user is used).\ In the third step, each subgraph is created. Here, we create two `C1.hist` objects and superpose a `S2.label` object and a `trellis` one. The functions `do.call` and `substitute` are used to provide a pretty call for each subgraph (stored in the `Call` slot).\ In a final step, the multiple graph is build through the creation of a new `ADEgS` object and possibly plotted.\ The `plot.track` function can then be used by: ```{r label=plot31, fig.width=7, fig.height=2.3} plot(tra1) ``` Graphical parameters can be modified by: ```{r label=plot32, fig.width=7, fig.height=2.3} plot(tra1, histDist.ppoly.col = "green", pbackground.col = "grey") ``` Examples ======== Labels customization -------------------- ```{r label=plot33, fig.width=6, fig.height=3} data(meaudret) g16 <- s.label(pca3$li, plot = FALSE) g17 <- s.label(pca3$li, ppoints.col= "red", plabels = list(box = list(draw = FALSE), optim = TRUE), plot = FALSE) ADEgS(c(g16, g17), layout = c(1, 2)) ``` Ellipses, stars and convex hulls -------------------------------- ```{r label=plot34, fig.width=6, fig.height=6} g18 <- s.class(pca3$li, fac = meaudret$design$season, plot = FALSE) g19 <- s.class(pca3$li, fac = meaudret$design$season, ellipseSize = 0, chullSize = 1, starSize = 0.5, col = TRUE, plot = FALSE) g20 <- s.class(pca3$li, fac = meaudret$design$season, pellipses.lwd = 2, pellipses.border = 2:5, pellipses.col = 2:5, plot = FALSE) g21 <- s.class(pca3$li, fac = meaudret$design$season, ellipseSize = 0, chullSize = 0, ppolygons.lwd = 2, plines.col = 2:5, starSize = 1.2, plot = FALSE) ADEgS(c(g18, g19, g20, g21), layout = c(2, 2)) ``` Values and legend ----------------- ```{r label=plot35, fig.width=6, fig.height=6} data(rpjdl) coa2 <- dudi.coa(rpjdl$fau, scannf = FALSE, nf = 3) g22 <- s.value(coa2$li, coa2$li[,3], plot = FALSE) g23 <- s.value(coa2$li, coa2$li[,3], method = "color", ppoints.cex = 0.8, plegend.size= 0.8, plot = FALSE) g24 <- s.value(coa2$li, coa2$li[,3], plegend.size = 0.8, ppoints.cex = 0.8, symbol = "square", method = "color", key = list(columns = 1), col = colorRampPalette(c("yellow", "blue"))(6), plot = FALSE) g25 <- s.value(coa2$li, coa2$li[, 3], center = 0, method = "size", ppoints.cex = 0.6, symbol = "circle", col = c("yellow", "red"), plot = FALSE) ADEgS(c(g22, g23, g24, g25), layout = c(2, 2)) ``` 1-D plot -------- ```{r label=plot36, fig.width=6, fig.height=6} score1 <- c(rnorm(1000, mean = -0.5, sd = 0.5), rnorm(1000, mean = 1)) fac1 <- rep(c("A", "B"), each = 1000) g26 <- s1d.density(score1, fac1, pback.col = "grey75", plot = FALSE) g27 <- s1d.density(score1, fac1, col = c(2, 4), plot = FALSE) g28 <- s1d.density(score1, fac1, col = c(2, 4), p1d.reverse = TRUE, p1d.horizontal = FALSE, p1d.rug.draw = FALSE, plot = FALSE) g29 <- s1d.density(score1, fac1, col = c(2, 4), ppolygons.alpha = 0.2, p1d = list(rug = list(tck = 1, line = FALSE)), plot = FALSE) ADEgS(c(g26, g27, g28, g29), layout = c(2, 2)) ``` Maps and neighbor graphs ------------------------ ```{r label=plot37, fig.width=6, fig.height=3} if(require(Guerry)) { library(sp) data(gfrance85) region.names <- data.frame(gfrance85)[, 5] col.region <- colors()[c(149, 254, 468, 552, 26)] g30 <- s.class(coordinates(gfrance85), region.names, porigin.include = FALSE, plot = FALSE) g31 <- s.class(coordinates(gfrance85), region.names, ellipseSize = 0, starSize = 0, Sp = gfrance85, pgrid.draw = FALSE, pSp.col = col.region[region.names], pSp.alpha = 0.4, plot = FALSE) ADEgS(c(g30, g31), layout = c(1, 2)) } ``` ```{r label=plot38, fig.width=6, fig.height=4} # if(require(Guerry)) { # s.Spatial(gfrance85[,7:12]) # } ``` ```{r label=plot39, fig.width=6, fig.height=3} data(mafragh, package = "ade4") g32 <- s.label(mafragh$xy, nb = mafragh$nb, plot = FALSE) g33 <- s.label(mafragh$xy, nb = mafragh$nb, pnb.ed.col = "red", plab.cex = 0, pnb.node = list(cex = 3, col = "blue"), ppoints.col = "green", plot = FALSE) ADEgS(c(g32, g33), layout = c(1, 2)) ``` Ternary plots ------------- ```{r label=plot40, fig.width=6, fig.height=3} data(euro123, package = "ade4") df <- rbind.data.frame(euro123$in78, euro123$in86, euro123$in97) row.names(df) <- paste(row.names(euro123$in78), rep(c(1, 2, 3), rep(12, 3)), sep = "") g34 <- triangle.label(df, label = row.names(df), showposition = TRUE, plot = FALSE) g35 <- triangle.label(euro123$in78, plabels.cex = 0, ppoints.cex = 2, addmean = TRUE, show = FALSE, plot = FALSE) ADEgS(c(g34, g35), layout = c(1, 2)) ``` Appendix ============================= This appendix summarizes the main changes between `ade4` and `adegraphics`. Each line corresponds to a graphical argument defined in `ade4` and its equivalent in `adegraphics` is given. | Arguments in `ade4` | Functions in `ade4` | `g.args` in `adegraphics` | `adeg.par` in `adegraphics` | | | ------------------- | ----------------------| ----------------------------| ------------------------------|---| | `abline.x` | `table.cont` | `ablineX` | | | | `abline.y` | `table.cont` | `ablineY` | | | | `abmean.x` | `table.cont` | `meanX` | | | | `abmean.y` | `table.cont` | `meanY` | | | | `addaxes` | `s.arrow`, `s.chull`, `s.class`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value`, `triangle.class`, `triangle.plot` | |`paxes.draw` | | | `area` | `s.arrow`, `s.chull`, `s.class`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value` | `Sp` | | a `Sp` object | | `axesell` | `s.class`, `s.distri`, `triangle.class` | | `pellipses.axes.draw` | | | `box` | `s.corcircle`, `triangle.plot` | | `pbackground.box` | | | `boxes` | `s.arrow`, `s.label`, `sco.class`, `sco.label`, `sco.match` | | `plabels.boxes.draw` | | | `cellipse` | `s.class`, `s.distri`, `triangle.class` | `ellipseSize` | | | | `cgrid` | `s.arrow`, `s.class`, `s.chull`, `s.corcircle`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value`, `sco.boxplot`, `sco.class`, `sco.distri`, `sco.gauss`, `sco.label`, `sco.match` | | `pgrid.nint` | both play on the grid mesh, but they are not strictly equivalent | | `clabel` | `s.arrow`, `s.class`, `s.chull`, `s.corcircle`, `s.distri`, `s.kde2d`, `s.label`, `s.match`, `s.traject`, `sco.boxplot`, `sco.class`, `sco.distri`, `sco.gauss`, `sco.label`, `sco.match`, `triangle.plot` | | `plabels.cex` | | | `clabel` | `table.dist` | | | `axis.text = list()` `lattice` parameter | | `clabel.col` | `table.cont`, `table.paint`, `table.value` | | | `axis.text = list()` `lattice` parameter | | `clabel.row` | `table.cont`, `table.paint`, `table.value` | | | `axis.text = list()` `lattice` parameter | | `clegend` | `s.value`, `table.cont`, `table.value` | | `plegend.size` `ppoints.cex` | parameters setting the legend size | | `clegend` | `table.paint` | | `plegend.size` | | | `clogo` | `s.logo` | | `ppoints.cex` | | | `cneig` | `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.value` | | `pnb.edge.lwd` | | | `col.labels` | `table.cont`, `table.paint`, `table.value` | `labelsy` | | | | `contour` | `s.arrow`, `s.class`, `s.chull`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value` | `Sp` | | a `Sp` object | | `contour.plot` | `s.image` | `region` | | | | `cpoints`, `cpoint` | `s.arrow`, `s.class`, `s.chull`, `s.distri`, `s.kde2d`, `s.label`, `s.match`, `s.traject`, `s.value`, `sco.class`, `sco.label`, `sco.match`, `triangle.class`, `triangle.plot` | | `ppoints.cex` | | | `csize` | `s.value`, `table.cont`, `table.dist`, `table.paint`, `table.value` | `ppoints.cex` | | | | `csize` | `sco.distri` | `sdSize` | | | | `cstar` | `s.class`, `s.distri`, `triangle.class` | `starSize` | | | | `csub` | `s.arrow`, `s.chull`, `s.class`, `s.corcircle`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value`, `sco.boxplot`, `sco.class`, `sco.distri`, `sco.gauss`, `sco.label`, `sco.match`, `triangle.class`, `triangle.plot` | | `psub.cex` | | | `draw.line` | `triangle.biplot`, `triangle.class`, `triangle.plot` | | `pgrid.draw` | | | `edge` | `s.arrow`, `s.match`, `s.traject` | | `parrows.length` | setting the length of the arrows to 0 is equivalent to `edge = FALSE` | | `grid` | `s.arrow`, `s.chull`, `s.class`, `s.corcircle`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value`, `sco.boxplot`, `sco.class`, `sco.distri`, `sco.gauss`, `sco.label`, `sco.match`, `table.cont`, `table.dist`, `table.value` | | `pgrid.draw` | | | `horizontal` | `sco.class`, `sco.gauss`, `sco.label`, `sco.match` | | `p1d.horizontal` | | | `image.plot` | `s.image` | `contour` | | | | `includeorigin`, `include.origin` | `s.arrow`, `s.chull`, `s.class`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value`, `sco.boxplot`, `sco.class`, `sco.distri`, `sco.gauss`, `sco.label`, `sco.match` | | `porigin.include` | | | `kgrid` | `s.image` | `gridsize` | | | | `klogo` | `s.logo` | | | no correspondence | | `labeltriangle` | `triangle.class` , `triangle.plot` | | | no correspondence | | `legen` | `sco.gauss` | `labelplot` | | | | `neig` | `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.value` | `nbobject` | | a `nb` object | | `optchull` | `s.chull` | `chullSize` | | | | `origin` | `s.arrow`, `s.chull`, `s.class`, `s.corcircle`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value`, `sco.boxplot`, `sco.class`, `sco.distri`, `sco.gauss`, `sco.label`, `sco.match` | | `porigin.origin` | | | `pch` | `s.arrow`, `s.chull`, `s.class`, `s.distri`, `s.kde2d`, `s.label`, `s.match`, `s.traject`, `s.value`, `sco.boxplot`, `sco.class`, `sco.label`, `sco.match`, `triangle.class`, `triangle.plot`, `table.cont` | | `ppoints.pch` | | | `pixmap` | `s.arrow`, `s.chull`, `s.class`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value` | | | no correspondence | | `pos.lab` | `sco.class`, `sco.label`, `sco.match` | | `p1d.labpos` | | | `possub` | `s.arrow`, `s.chull`, `s.class`, `s.corcircle`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value`, `sco.class`, `sco.gauss`, `sco.label`, `sco.match`, `triangle.class`, `triangle.plot` | | `psub.pos` | | | `rectlogo` | `s.logo` | `rect` | | | | `reverse` | `sco.class`, `sco.gauss`, `sco.label`, `sco.match` | | `p1d.reverse` | | | `row.labels` | `table.cont`, `table.paint`, `table.value` | `labelsx` | | | | `scale` | `triangle.class`, `triangle.plot` | `adjust` | | | | `show.position` | `triangle.class`, `triangle.plot` | `showposition` | | | | `sub` | `s.arrow`, `s.chull`, `s.class`, `s.corcircle`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value`, `sco.boxplot`, `sco.class`, `sco.distri`, `sco.gauss`, `sco.label`, `sco.match`, `triangle.class`, `triangle.plot` | | `psub.text` | | | `y.rank` | `sco.distri` | `yrank` | | | | `zmax` | `s.value` | | | set to default max(abs(z)) | | | | | | | References =============================adegraphics/vignettes/tableparamVSfunction.csv0000644000176200001440000000245613742303021021402 0ustar liggesusers,"p1d","parrows","paxes","pbackground","pellipses","pgrid","plabels","plegend","plines","pnb","porigin","ppalette","ppoints","ppolygons","pSp","psub","ptable" "s.arrow",,1,1,1,,1,1,,1,1,1,,,,1,1, "s.class",,,1,1,1,1,1,1,1,1,1,1,1,1,1,1, "s.corcircle",,1,1,1,,1,1,,1,1,1,,,,1,1, "s.density",,,1,1,,1,1,,,1,1,1,1,,1,1, "s.distri",,,1,1,1,1,1,,1,1,1,1,1,,1,1, "s.image",,,1,1,,1,1,1,,1,1,1,,,1,1, "s.label",,,1,1,,1,1,,,1,1,,1,,1,1, "s.logo",,,1,1,,1,,,,1,1,,,,1,1, "s.match",,1,1,1,,1,1,,1,1,1,,1,,1,1, "s.traject",,1,1,1,,1,1,,1,1,1,,1,,1,1, "s.value",,,1,1,,1,,1,,1,1,1,1,,1,1, "s1d.barchart",1,,1,1,,1,1,,,,1,,,1,,1, "s1d.boxplot",1,,1,1,,1,1,,1,,1,,1,1,,1, "s1d.class",1,,1,1,,1,1,1,1,,1,,1,,,1, "s1d.curve",1,,1,1,,1,,,1,,1,,1,,,1, "s1d.curves",1,,1,1,,1,,,1,,1,,1,,,1, "s1d.density",1,,1,1,,1,1,,1,,1,,,,,1, "s1d.distri",1,,1,1,,1,1,,1,,1,,1,,,1, "s1d.dotplot",1,,1,1,,1,,,1,,1,,1,,,1, "s1d.gauss",1,,1,1,,1,1,,1,,1,,,,,1, "s1d.hist",1,,1,1,,1,,,,,1,,,1,,1, "s1d.interval",1,1,1,1,,1,,,1,,1,,,1,,1, "s1d.label",1,,1,1,,1,1,,1,,1,,1,,,1, "s1d.match",1,,1,1,,1,1,,1,,1,,1,,,1, "table.image",,,,1,,1,,1,,,,,1,,,1,1 "table.value",,,,1,,1,,1,1,,,1,1,,,1,1 "triangle.class",,,1,1,1,1,1,1,1,,,1,1,1,,1, "triangle.label",,,1,1,,1,1,,,,,,1,,,1, "triangle.match",,1,1,1,,1,1,,1,,,,1,,,1, "triangle.traject",,1,1,1,,1,1,,1,,,,1,,,1, adegraphics/vignettes/classes.png0000644000176200001440000272372313742303021016712 0ustar liggesusersPNG  IHDR 3sBIT|d pHYs B(xtEXtSoftwarewww.inkscape.org< IDATxw@%! ,'u=:{~;ܭjڪֺu*CdW$w?s}Ays)<!B!B!BH#uڵeܪ%=)ܜe:8;ɥ2qcpbx^.a$LH8ѵBȭa$F#ra$FN228o ZMui]optݷB'B!B!B!N삏\pw\x8R&Y$r` ZW8I:Ɋ[nU:!B!B!Bi(tbc'Ȍr)^<#Q2.!D"J`59[N!B!B!BZ+ r.~JWx1/wtMBZ/ s<#SstRCՀy(;a B!B!B!V:1)cLw oayBix8UR^RѣutImN!B!B!BZ+ \'eWpB2JGC!1<dzL3/)ұ(QB!B!B! m ;^ّӞ&BnU,FMf8FB!B!B! 0O; ] !X>~f|ut-ͅB'B!B!B!-:I oEޙa97GB!4ayWp!A?qVN!B!B!BZ6:9/ʌYIk!BJ.*GbO:!B!B!Bih$i$?)#b Q8B!Ua2b .d.B!B!B!O9B!UFu{m˱B!B!B!|Je_ B!1/(ni+n2AzlAB!B!B!b5>>^rfHoHy!B cusOGb- B!B!B!,z5/#B] !I$pJ]HtjkN!B!B!BŒNTK&aBi Ȝ|zCe:!B!B!B!xZq\1F!fxNY2ѵEB!B!B!" /K^1Lʷ%!֎g%^_Nut-bPB!B!B!v)׬ y;B!VLktOY49ѵ !B!B!B1*[&aB02i#0 B!B!B!N%w0/wt-B톑r!)Kt[eC!B!B!BH딲dJK0s]@B!Įq ?23QZZҲ2h4kcDtdaaft:N8Cjj*N9sϡ%n.٣' &-V0t NZ QB!B'MHeyܛˉ?i ,\>qV}V17fl\#fTM3R>.iݜ< !b#u]vڅ;~j5j5._S}=<<ÆţFBrrr?cݨ~\]]1bp~&LzsgsB*vZNpMCC UC!Bc%-'BH[sψ<<4mOYZB'B6nތKllۆ˗.I`0 q׷MKl,zdfeaHN%K1l0x{[T?!B!ҜV$>QXgVI7 uCT}!Tgd0`RiB.-P*\:ywDFZ[k9zףzeUw/i59w(J|=\R:ypgL⠘*k9kz=gCbZ׏j?[NpzpM.Kzvp!{h^ vr.Bs%ex3^qB2;O/4ϷϏqper/W ipR{Œ]hg|Ǩ.Sum֠7^iPʝ>hMO&exn8t~`VWFA3q~ڲvoQtw_^~ _W_᝷U5Xùsq!uPaDͣh TTV<t訨f{oQXXrWFϠ JW(J!&&瑞ϣ^A;z!}{g^Gn^rrrPV^N{YPA\g02TUUh0F]{mJhe߷eBԠzx^^^GxxKENn.RP\\A.]e!B8u8k<~xVϊꌬj] +8['2ySaD;7ͻo|/5rыS՚<xWՍ*u|1}_DN.b`9Bs|ӯxx ,g2dd[G4:Un.NbB'ީyĕN.V{:Y),3ϮЩFs7SZN/~k㑉8eӋ~gkſ%xOP)ǻiUuN^/'긤(1߃T/nnB' Y-gn,ѻLyVswY2~^:m>KYbfI Փ͍Pkph뉧Fh$ʫі'q}-^koJn]gUՍoA3tT7,ƑB|)zA gFyE9;؏ϋ4.]гGDpPZ-vډGbRTሊB\Ϟٳ'"í9v,vډDdfe ~ѯo_3G8ao۱O=={⎞qNj8lܴQX_NT*'''X&?. v<09&%5om>7mou]6|=~޺UUM? SRphuMwcinzjllƫapᡮÙ3gv,Ξ;\..+SUƏ{}iXt1#"jЀM?lƏ?RKv sg}kyܳnt VΝ;}HH\P <<QQQqqquuu8s&igp9d核a܃~Z=<]F;1 >|? v,^{ yzzbu~VTرk/Sw۾5bF\.͍ /]~,berL2O<>ɪ!B9J'>oهM*V+Aym@;M4 U=\RaF~DcK߯EO6ܤ:XJu + +Ѷ?t;5ėsנ7ն&8ٓh[^̣-x{??؞6Vy-09O5ِXR7|np%dZ,+uJU>n 0睶bf'`V:!ByϢo=6NƝ\BN>O?m<* Ǿ}>7|Yúwߡ%)kkkq>s~r~ۖݻt2Y5R8w<w'Z4OٳXl)N>mvjyHMaY֬ƆZeMM N>SOc+aZ)ǏXC>Mv5YoO 544`0y&tZH:u oUJ`eۯa*|_{a15ܹ}M(+/ǎ];cNt 믾aCZ4G^=v @Ա[＃m> Yڃ%˖ Șp>=W64v{ڋ gcip1o$$&ٳLviNkׯkoauव),*˯?E*Y|m>Gcb٨lkǎǤ'' 4)ӦY"B]%+s#u8ߩ?[aIcU#|Ǜ,gǙܲԼv a kY \QX9ytr}KB͇Sļ+C3pr.;.znZӆgY8VM}UhAˉKR6 9bOhvt!2/j쓓SneoϗիpfǪ5k ^y5~ٶ ŗ/WBP_8|]khi=*jܽc܏cǏ ;}4b[Ȍ x7Eo*lЀƹ筪y,^^m7I&+/lyW㏬;o]2Cb՗-Ӗ-ɜo:fsګv&&%bғEHvdB^xqҲ2| Vj,B!rc'0<:LV8KK%L=Ɩd >PgE=,a0D,1s_Y^ɰl^TUc=V?0kx%*C'z]srC&B!YҺ9N],~x۟̍qK {t> :)eR,ϱf唨:ThzXےj^pg'G&}dl\RxY\'ePj^̭'20ހ!h 3V!s?R T%&r늝>75n\zIVndyz>\coJ=B'ss@LO NEӢj`ZaPJny uxQZoӕ`$$/>c~ B!&KwC[npvn x{ysHknn0PjPFVV6/իЃ9{\:vD׮] ggh롮CAA2P__/xӧEE^+tZZKxWm~~~קہeFbR:{?3&=1{%ptOOO(ףVFAA:rEQd2"^oETCǎ{B'555z{J-liF#F.}DDD ...P*iuVU.y+>?ldqغWKvϜQmk:W7+:5JKKm>י8+kYUBUU5.^ Qs-[.tëo13qg,?oB'B!6 囵~kS3]8FEx\5(& @2Xg=!eO$\^X5IhCxCQA^3(>1g_j5.y^߿SfLCYE)H\_FY,Tw+ш[HZgݱ̟0ࠗ҅MޗY Ǜ?OgF`jkPkbQȤúh#R NU h[ .?\uϭR_׆ٵ?ZΘ~\M.Q3kUForsB_]SJ STz-z w&Pu]St[5sD׬_;|?O+Sھ`sG{j'>986!ߜ/,w~)9e#+lUǖON!>zܙUpV(0h <wu'Ig+?\ʤQL9hvN;bň1;'p1?qjxHH4oRş|!Cbf)J$JqQ ˱K.\]]c܃A*>,^T\wIIf3f |~G{#*2_P 'qq8quuf絧bq]N;u\nm1QQB'Kl`$B?__8;7~Zr*9ƌ|#:C&O[^R>t( 6<#1)K/ޒ/"*э:u1G#,XֈSOݻE}ڻEB' )`'b!fuUUUHLJ±cB{7rws!C1d` ?@TgSOcيHIM5;.BΞEn_H$3zu_ƥL .NwKgz1G ѽ[7(JT*$$&~ nA bߐ?;JeHO?v{mB!.˩::VcCSnSS5ǥY#{\b9`}ݧZfD&?6'Ŵc濴Fsqޟ7{q}R S?>ybп&l/u.P56B0V/ܜw0o\]rs1{z~7{,+BE0:I, 7gEuWTpq^n.%Spusin|=I %jɯߍ_oCSI% ӣ]7yBs>W0&.@/=ë]ܭ}o1ܻzPI[RҸCIczk5עb-:G2}\}D [B'B E iKẹ㙹ON~`՘KœL8i6tRQi3+/,8PGNá;wB*3g{ Æܷ/Ǝǀy$Jo;v|' /DT⛯B7탃~Z̘SLæ͛0|]{ 0aahu:8x;vDjQWV/_ܵ2quםwbƴӻup?sSRvVT*ŢO>=c^ ǍSsf۵E@?zM<2~l<>>>3z4ƌ qic\݄믾Gyn$w^ͷxr4ĉ'n r,_]2͇wqv-Z–-[1 xxѣFaĈXp!~ݾMp5t2qx <1m:;999fg9ӻj"B]*h\M'l{:E,"0cw]R;\h.!~? | qߗ_Q{1<YFt|B$ 5k:[@X6,>Iaō>4tψ?a9:m;Sm:ޱN7L"Q5|1>iXgJk49˥Ekf\~}1BKxU5>]+<֒zoIUJmOr H^*31{NɭX_ۑWҊ'ɮOGeB!fh4AS]Z8a~jฤS̾^6 MR(3z4V:GDw@BaI àohx>`0=3&'Wr0smd uB{ǎUѱCļ$D"{okb7-]デǍ5kcێE8i,*2+.|Yb䈑2yE O*8Voٳ1w'WD՗_5Ozz]jJs|3 >{ 2xOfq*'''̜>]p#޽[Բ:O>MƤ v1مsἝޓF&;⣅:~g\B!@b W79wy}/g|oW5iy~и';gD;O- dT;97NuZ:f:ܜ.N 5&?L#ny[w" ,'QTWA2G*aw yHClt$W nI\Z'g'swvѱ?p$غ!'^ϕotB!qD<} #(\lrף{pwwNSCnN.jD֚ Ehd\0}sYY<=#cРAбCGB.5`ǣ_߾ѽ;";GC!3!>4)Qfpĉ&C'A2Ʉ >CFlL ;Sǎ 8؋T>:~v]ĞW  :4ER .asSSzfTVV"'7yyQPAGCelĎkW^^^o 2zYy9za={NHUUr򐛗+`h;P@,"11QpAD2$۾c+8.,4T0t"ԩB!ܬA/~-*0_wSyLU?XxAgmB+ 3Kq,g]\<دɃb\ZǻMΝ/6FևxF*aA{(ĵn%$ 0 5M:1MN'BDJ$b.֠3 ]N,eu+m ~Ƈ cܭ}L*Q:6uqKKFzj4~?ټD.3GFߥVRXU<`|DKJlω9ּc Y1KvL~7:޷wkRCBީ";Gw^u-28'Nĉ'z`@ۻD;3+[p̅0ks 1J߯k>j޽kk_z"ٹ3;^*b5zq7C]-_F':Xn^e'zNKZ"!1{Ñ#GPXdr\Xj`Q*,:K ?@p q8 ?H\}zߦzN#QPP`\7tt-/ [aϢT"A=p!ĄԄ 3"&X)vCB!rŹm mgOݰbg]Nq1rp]tAXOstiYJp l٘~xz^^R%%]Rw\e`a_C*b@xxx6ܪ5E_ 3}fvA~~~psu˗;,q46/եT**jCs{FpY-+/GYy9Nt쒘%  Tl%&&F8g;!B2au:WՑ2 j'YZ4!]r/,;^:l XF}_)Neۚѱ d 2I>@*ax -k&gӇ:>Җyb9-r#v ^2}+wE7׭3Ow6|>B!l~ɕΦ5s%+!1O~h>g,cǏ7GAҩSf3 xn d"> TWۥ{LNܧeq1xx, FpP;Q232$QcAj3'&ZҸ7q0a[x㪝´35pr=/$"(Z +vp>]$̚yyy5w;fv\^Oumm->Ǻ29^",e?5s&fLn㐝gߴdGsԩq:apEQcmڗBaE<'3n?qo. ]%ǡ5u۸#,tLĪ fZN>|:mlh:5f{Lu__J$Ί"B$2qmH.tuX4L"JQ|?00OޭGޮda,ZfZޜn^:;ٯj SdVzq]k m=2v:m˻ 2ůu`p޷$*KqߝZx;_2i=Ukѯm84sU,XE.mOB!!j\yE9ѷOf.ւNNN񁯏uZ)/0wyV|S1 x7ןfrܘѣ%6ob|K9p wvk(-mNB^{}]HMO7^| 1:uWWWQK5=~ MhSRш*]ڴ/ş5Zz"oB( %]ZuTdK|Q#G"66V,vrj 0q={h8׮ |||}Tz23m-ׅ[`Y)RdY~B!P HyX\Z+f0b=Qc8~N2E7Q}ݕ3?Ⱥ\Yt`V4:CRB㯻)LZ:[$G8-Lr.vlRB$b[j!xFlPV:<DT@S- IDAT7 Yvz& .0 z5[=^ԣDUQUX`YX|Zj^H6`@eB3q )tB!гGODMm.tĤ$q5);v,BBBc0קjӻ76.\}p2!i6O?O2;.44-[Ҳ2޳'NĩӧE <֮_U+5//&oZ \5 ӱ~8yigt_0mT"HлW/>rDp]:ٹkq;t@MKS<=<.*.BQcU*֊hҿGPp?ΙQ#Fϯ1231m9سkoKڹ.)uX媛~I nョLζ[wT]/];F!Bڢusj]{X)57L;;3E+vxhO3uY_ulAU3UZz .: s/q:IqHRKXVT+ª^W8]Tr$λ-TVV^P)8τܨkϖc;qtIrJ2RУ{wSQQ?v)j찡ìڇ (==C 565-Ֆ |}}?"0 z܎1mTL2ǡYYAQQѕs]f&Dw2!:eU>^^^lv\siĆN221tff w9!Bq0zM#i.'гKU /]! ኔbڧo##T#8`e;\,~65ZM.oMߓ8yo tba$uB]^n.ƩCppOr8r&/p[+<ж'8D1V-fBm@lֻZ9v)999cƌ-8<999!** g>~7mɣǰ6t[T"AXXfｇoG;wa)OikZde=6*2Rpiig9rDޱc6cDZi 4Hps5{cF%uN!orrG @^~aO>8#!1Q:))H!BH둴nIn&s J/fX L3?R Юa֘:1z={Skَ<|\m{ 56ܟ7wlL. >R^MXg}9XH[1uDl>JTCxXSO7xY%L>W] fpWTpIbIazޔ\b9eJ>2aqvVc:zWPQ'ݞB'BqqqƖb(+/iŗҫ`u6#RS;v5ׁC8>w0.nhi*6 VjVVZ9r[@QQAw2|wy}Ԟ(ҵKߛo9l b68+22R}x\3g*VE٣otw 9^ˀEMEn];oOZqlaQXW#='2z(&$$_}9/]"?._>{KV\uw|v!7mL$ʪUιKFGE;u7ܹ.""BfΘ!㮹تB'yD8͙/닢(ҧwodf:תkjثK,᪢5*'""zE8f=)#w⵳U%6\rGݘ|9/|#4Z.YU[b~-6wݕצ6%#~c'/YÐզ1۫z.j7 J}uCzgƮ}1W'+㏄xn>Fd v&R_hi/}iՍ),g~Q]qtȦ> ~tݐ_kTqDoOEol͚Uupౙ 7JnQ~IS;z|d,YDfɵ-)6Uʒŋs=Y Cޞu:i׶$>\㸪"">޵4wA~-uM6i*'+UUfyC~N>,>P)Uʒ&AA{* mڴXV1YuXBfckTUfx )vUO?ThN(LuקѣFNef=DFv%tCIəs3+?M۠ A]X,uNu>p@yy;XRRny\O~6^v]^~Ǖsu8(2lP@Ù5kNHN+ou7N~keAޞ;|=x,Vg~Yv^I^MMuń|̸.S.}ﱜ@ bnkdP?bβ/5u{w4dU۟ݦZ5}4{// {j|Eu!i7$:p"oxa87a;G<ŀ?:_dܖ.ɫ֘PjԿݗo/9X@U5)nO2K7w /e|)_I#hۆFG5xd}|+>kg3sM|:U[WOZ_N䗘;Mb[^;:o[ޓ_bh>XnɩecQPbIȝMZeH=c*͙|5)KTÐ@Q5~I!"NpSǎ2/pj|zz7uS3V_ʡCdueZjj6eaa<8!vd_qe5Hf۟bH]51WiCFK6m][Dd 5Mu&;sָի996ZiferV;~dҥ2qDfXZTTf6={jc2d5k&wu%qfdaxŲnzdo-\}t٥K>}$&&FhTQn^\?˯%--M,`:(YY5YbL?^tH?!3f< Çe=wQd NO;S&uAr[ nuf%?w_gyJ <0aaa<4sAD_߾Yp~MK :c@oLXvUΌWVAɀn<9'V^"%+lJVgSmz RZZ*KF~󍄆ʥJ>}$u4o޼sݑ#G䋯WzN"""*moݺ9o~yc\jjlo[o]+zOFrm˜t8?6kۋTNמIK4CvAiҾRb8=v.iR0Ņb=^ڏ J,GU55M56ZF{G|7oz:+"6[Xbuu_[;G~zfoj.,mSX+c4]CMUx%̹#Co N02ݹrm۷M4̔zv.4P~m+-Ҽysr()INr:x Q$ʂEDDWBKET͕TZo 6ܩq'OKKn.#^b0$7/O$ K\eEDGz y >>u7,b6azv^h32ە+LƣsnqLg+7\u466%LD\ 86;h"ܩSCR'ڶi+}qjrlܴIlZ)pR u@$Jn:Yaٻd^[f9$;wʆ?x/Š8yrϏ1B~dzlrټevm.,pR|ٟ(u:88kƎ ,X(11enPP,DGE9]1g\naU{K"!Cna$ac:W)pr>EfxٸiSu7M 1W4W69|X֭_'U <~ܸ:=^}02g~յn]̇ x(a ]&h{q}0eNW4w'g<8wMa/^N~xWE}#tu>j(=Z֩_uYWc5:éOju^/]@~)c;M٪YspKu]WhS*& K&Զ . >P&_m #OZEQG՟Gf<,kƎ#pin;5}VI)44T>zkQQO?:$|I&OMshyڶ.  矝uNzU2d*t_琐yg8~p2Ԑ"""9k׮2wͥЀ~5`TtCnt{ڄ|S:h!""Z3?^yNgx3uQ9T_۾GQ㻷 YRř9#qѠ˙o|ڛ+&ẩ lPXoV=Woyzks,8o=#:|Mn uJIL3o>yk}?V>9񖡝Z㹭a4`ANf;yY{t;oO~]6x3:~қ Yccn6tm+=5o1>ϨɋB_|NS;^Q˭z]ndߟO^Jlh,l6K_ ~}w|++W/-|00~L7^.WeɇÏ>"·;v(Dh!V눉INN>cӻLԱcsNo^ttL1}rۧ|чxR)..>zBe2rޭ[Zƴ(9rs߯ibEQd҄rW_~!K.s:fyˠ[oEBBBYf'dȐrJ?8UU%΄An[mNM.8H^| CIINw1  .;ބ;EEFt*L2iDi"O;<<+DdEJFgu8z]QIk|5Paxyj, q\V{uU9<ƕ\y?u<PmF۴+}"Ȧ'N9WbiZXbTMS=mvӠוŬ|Mn!~^;JsXCz|D{.-p5k7\cdݺud߾}}li+%C.,mڴqzϿBvYÇ]fYl,[9x`-3 t]&']v6 v]f>94- rrrdΝoTZPRwiT ˫!}']';=##C^{us 5۾c|U߯Hpyh;N>\㘫F5M3g`Gf<,͚ռeII ""?K.V¢"z?HѪۼ{KKzˤA~I﫯8cψ˵Y,ٟ( )(("-7,]:wpa;^Y.)wϿ;$11:=ݥSNҳGO1lK;*JMK9oY ud5գ\uNbЇv!s&x4> Uwn||șN'yy!RVfboҴIl+yytHrs󤤤D$4DLjd:l6ʒ ),,,EE%)%Y3AУ"M$IIOO)))R1!&IB%22m\QPP _/RXX$&Id2IXhԺ}EMVdfeIfffdp "i'NHFvU<==d2IhhX|'27jc2dM׻sffIISbY%a#nnn-U4MN朔BRVV&s]DD:;+;[9"9Nj//KLt\vŒvK~ADFDɎohS 1 Uwt냟lV]pB@-X,8`7wy |}r/Eת-34ng?vRnopAxW%p-_i<'""VsyO')8B'Ehͯkddubٜ/==]6MñM_~*px6~_E3 ]IUUY믲_%0 @z)ݺt__),*<9xl.7n:u#SE '?Ԗ":]o2: rse5z͚:9#ꫮcd>ХծHS/D^~%Qsj vyw:uf5w犇GC:@]kv%K&kC{,:*Jf>\:pPCZ6U 0XU蚧n "Gʦ͛%//Vpss1cd!ӱ"m,^C]Up{:pFFM$QIHHCII.'NKqIxK۶C&6V'Cbd?YXWyB'ELQ訨.P'bk2EF|5MEYSU[wU^ݻ 4rb@} t:VMS ]8B'3c"tЈN@Q*+\Mbz1a"tЈi5%ͫ#N1Nh*U!tH 34tf1:KUUm'tḨWnGJEtUa 4RZ5b= Fji:rvB'^g54t ""P) KfV:B@h@0,FJgtpP4r@wRFJQt.47M_)cBR4ơT-!tpPTV:̓: UUF^ahG.#t:eN2B'p \F.#t:eN2B'p \F.#t: ]}w˾k2\Zl%Oe "NpZjj| ]X~ B'H#Ei 8j 1"t@-s F ';;M-xJNPiߡOC_,.j\xeN2B'p \F.#t:e.@㕒rOJDchSw>T_Kn[[8&/odI-t_ܢ⶛tL2jC:Po<*Sᝯ歊ĩ口}%ꭚA}Oj{+wWqW (n4txt5Ҽ$9W-)GҸaï;~ɥcp^x{%zlsV^h""=f~vhBpA tyK>\$''N$W_&K)_y\;nL>Վ͔̐#{ ?r2{I4N8膮kq%kS`4= SM|M#Emp䆮:qI~ 3xNa5lu͐`7wnv.sH]`甌؜2kM{i"zN_fxy$kavD,1--VKW|<6RgĖZl]iD3Zh#=hvA2-bS}UM0(R77}M|fa\Q?H_Sj5v_^n̊ ~Ў Jlvݧmw0SVAIRsŦzStf^Wfnwﰎ'h{6_Mnٻq&i{d?ޗ==du)*[lQ=z6u)'EDs[TYٱ}u(NBC$:Ĵ$1%:uG/Z.7),1NNMWգ"fbsdnkGw3ydߪgW5k89EU5ϊϕYa"]PjM_Kds_wҦvUNHȗwgߛҲS3Y2Zf+)㞎Mh_uSw@UMynɖq3dw5#ED$,yC?:x-f~ snOs .Nn>%ZZ_M r4VU5GyyY_3RÏےJMPr K/Ye#L35Ky.5i\.4Nfs,xJk ^(J:m^kS8rk=p<_Uݠp3dt}UTޕM/URi:$xV_8w!àWJ6կb ?SE#ТG~[۹ t^W,fͧlknك+41l=^mCn6M5Ϝ827.nܭv5? p!#t@=X'~ƶ[˭?sNr>>U \ OJvVf,a1_gsh&'OIVq)**&fZ@ボs 8,)RVV"QInN#//[R(OJJ E7_FI@@Hכy\NK^^ϿDEXgˉÒRJKEӉ5E\)*ʓcHA~6Nnw8s@Sw_5O}~mLzn6}ruKn{{ʷUMyۭ=ޑAD7q}옿zW/7VXbiWjS欈{^-pݘ"wݰiwh;{L^[n؟vsQeR5bGkk^G'>mþ2m|a?_Na%[;;p:D4jNu 9{yH=9spzn;)mGt˺fjC7]wTHɼcGr1!5 *)e]#n76I}cd49aݾ+y(#R5BDD(Pez\S[qNW"^aq[{+n_~{{UƚVGvNW .TVT܊[KN+nn݇j# cZٷOI:/ee_gi֬t>DuGv ?Ⱥ?98*LU./5Çg;ҷ(`""bZ*M[۞qf3n2wug:j vݢ_wsҀ$kh^~yYB {dޚ]ΏےC>A  ^hLݕoYڜrv:pSJ 4+VP "rY%ʷX߽`E\V}U6WϝLc IDAT2weF\rUUˮV;+F]D'3FIEc{Jۻ7Wĭ|fg>3ntϘ"'>M>گ\Pw3[.Zwm.lr2wK=Վ+~_'};~IL&qT^풞~22ʟ?5>+G!OR(a3B-W]wdO^9#RY}f"6.Uu| ?G6oZ.7-_ȼwgT)WZZ,6.[~)w(CNt}^YȞeJ1WG8yV1ٳ{+ egʛ'{WSU)--:c%&8V+Pg?)sWK\r} z*,397ڞN9`ߚެ\ Jp^ntήQ]mUu?FQoGPWnئνgGΩ.pRd4ƿ|av;{dO**Qnt&omɣc^2KkMGkF Zcvv])G󯪸MB#:T#Q?V8{/n3ZNҒ;PDj {m_Mu=8'smG H/^܇ E>0#UNYsm|~ _^^<'g۲ymRZw9.N*+w~n7~NDTw)Gʆ;89[IIؾVfzgv,xqٴG8Ғ'}Nf3ON1p""UBllTHYR ^Ҙ~a%or⍉ Xj_m*/vJ-t?U8ⶈ&>+3 5~&o֙>ᝣWfك_^gdЫچ}YqۉSE@('u:p""]4ٕIm·o3c:EKmVvU;՘}='UʹdAVs)AR8_Nc{nKA PɅMw~PSEDhtH^#$8YYe{ܯqg5!o͙*=(_*"-[u6%*6KjA߹^vpF{Ȓߐ'?Ru ӊN? n݇HTT{1yJIq8,R^$%e<$1l[!ҥ i,JnJA)IIId_ZeҒdŏN\BB"W$*\*{ddv4M=+:.(:Ҽyxy&6ErrN;eg)--ߜ&5qTvys)""6ݤc,:^rNK͢i5())qCƌG{J@`5P7lNLMPif<{`_Oy[l= 1y?ްDڴFil٫\#f+ǘ1Z9Eմc#c̬I}?U5Δ́"R[76~u|Džؼ"hs85é񓅃+>1n\9FmE6]G5߳`vU3ٝ|yOS`_SaS2ۋHnÊw t@*..glk4V/vY%+߭R+͛yCZDd9LF_5Eq?t]d!Lup6v\+o)e;ɱc?,KWTD4Q\5.qw4۟)..7_RsrIШ*sʺ߿.>""7n(7 qger'eejΗի><(:s\vMҶ]ZuF 7>*}|l8yy{_ugNy&:y%&cq&M"F\=-١(MUhޝ#Vܷp<ѤB2ٱ,fW}~[ XTØ[l>2ŚG6i@c Y׹:۶cw>UNʵo޴(cgNai$˻Uǰ zzoJʿ|۩²vu_ߺń(b4 "j䴀]9N@[@sM K\9ƹмNWƏؖvGD%t""vFˠ"swMm'I.ZJ[QTą[Q!"Fx}D@%Ji-tϴiy?hCӤmAJϓ9nӖ$>1<.FtJՠ%l]ʕ|u/ahz{-fz7E{\]]? G;s㝷Fʥ5aok3s>N†_Y/7l?_t /oUbR#ýßv(_D/w_n^)ɉg}JL1 rqqAk߂q߀n>/͢;bYṉ{ OJ"jmkmbe wD&QjmCj~'Ow<[,&$ QQz3:xʫCt'` Q *,̳cyr NJ㩧/T\{xunnUKSO ~ϡ-}J`'eg?7XED/.4G`+,8)!Hq`sYY7 :RpRڰOB^wcࠇ>\W'VEHNNSa)uMfV&ŜT*EHMPT汛\]]P( H,b jCpq,E%\]]f]8VXTd1'Jl~/4 t:ռR+ѝ“oL'N]PrZ7IZ^р_O\%lG\qm[̜}KnV$kš†&?g% ׳}*+:wIzBU3JNZ'_x%xdרkZd JGATyzj$V`~X 7; NjSXo5Io{kw|n "5^yc_TaIum ((Azz;tA&9f?@:g8Աr:+\褪A@ﾣ,$&RI#0(&ӫ2Qqa3|;oZmG`17r}X`U쌙o豣sa}oVVs /db23dŜZFϾ}b?3ga5Ą prw֭[[.[jc-ou61M/?ny{PW^~/!w#=ݲs|O?}ؾcŜ;pb"_|h؄XoG_ >t^e;kо\NN^hcݞ8UdfZ4ߦuV~8`1'Xܵ \\\~sޜȈ7׺c݃[Ϳ2y4:wddՇq&.b˗.ݶ};6nd1ysb \| r3xqҹŜdo̰ٽ>hmߪWZe`̘>*v֭ػo,pyӏ8yxDF/g'\:6!5c]heǭtFoQpKաV,'}|-vAjw\ѡ۞ͩ@/MG=!ޞ9kjtM>omڶ 7r&/y|P?꺻vA1M\$U*Q k&qIj]F~ayŲGVmS4*+KonתK]$@C.7TU}6ȥoM"~^ܤU!脈(`T*B"ȺăE'U֧H7ڢbb z]l"55+4o3[GEAtt'QUmrxۛЦzy.'vo VTg}} ?__4on%AA6{th1״IZTj٥.MgV.O [򲚓J6cDFBVKOTD`.ۙ-b&.fk/ m[VP(m!9ș LV֪]tDQo݉ 222==m8o&9 |a5[`3o6x?JQ(l_?MIau?%rrsmQTdZơÇcQX8JG/\:v@))6PVE'99}N[@mzyya<93g,{k]t`~Ǫ$%%?mwEIvakRVuw*:7XgQP=rz~,u]5i ̂__q{D>iXG[hHQ7lRXXnB䫵m$}t:GA,o3LEU\*Rq]D<ʚ-Ԗ(P[UH%>sJT\*-Ja iX*pXyM:⏇T*qsUl:  wDo5kHj3x#GfAq Hz^$,:!""""""1OLAYAzKOVoߪ^kWϢiG-FJET(..Dqq!L&Ec*᜛5P^Cb):|ުjXcyF HZZtwÖ\Yk С>{-}b}Gy^6ѣFaQvvh?ޮX777c`K}g۷OcqŖ@my|vݱo|úË-Ϯhou\U+W̄ xfb{ӱvrc83s2t=:f@Q94Sdǟs&ٳ1kLr3z4c'2"Ͼ_6lʹlEyͱ"ZlzVlHV-|lwקSjn5RE&8qq}vt*5qOF:\N[ԡPk&`4yILtߢ-yTx"JaV7ZYgb_[`Z*:_fWk*[p!ٵr֚:NժYn.]`FSRl<0tD#zctmls5m [tBDc Q%>t}|;Xl_PBm5Ww2A޸ye5T*rɮI 8ۅW wWL=Bì:W(## z͞,oro-VZGŅQ\xw8gglL*Xh&_qjFd U%2 V}:p鱯cf(\>&%W%npsqxé7&QcZxҝ4_Vk`QZĢ"""""" ܸgcsNr* pwW@./u\\\mֶGTE/U*4)M@1E OO>U󳾫; ؾK2mǺmFmiwXDDt+,]̂➎uJr=N oS[hxhyglc#Csf\RjX鸘kYUj&GH-n2iN銄|QU[Tu5EхWeݥԹiU ]W 5:JZ~fo O J寔gLc45YJ|<:Rp}ڈF脈j_}yy7/d2rvׁj.5rmXUҢD]T~t̟8RR.#J榀 =?/.pкo7}V'$rwJu%1uɩ^\^:9$[vydŶ-8x2ͤ:Fwo2{e/ߚ{Fy:sf~%|=.d.穵U邑D|v!1IJGb]`jR[6P\#HTnȹڑ2M?,wԦ:¡`SŖ'Hca&[ݦXtBDDDDDDd(HxsN/au+ga4*B5KI*jūV'ѷhѢ+Fۻ$c,_"YS?nʩDܭ*O ʎSW)w`2yWQ]UtCÏ>2}||jJں":ZNU#D IDATp@Ӡ0bj1i 7PrαJ뢓[Gmt1I Hڴ.8RrUVn_XCriOlcFzw^{S}*81ž'WYjCmі/9OٵȾ+;ƍ\ijyU*`QZLY{b2 :{snԷyV|hEVdR~=+,ogpb;IuE"6Ns%C鬜jL]z|)-k~.{MMC|KE?\ pV>D5E'DDDDDDDܸߘJXlB ѳp{V EI;.z"L&\hhSgX=Ρs zHX5 (ն2cnyt h֬Û;tɒ2 [}QAyǁ^-BV,y#/7agփNx{*?aH$ K6yT"ߢNy~H_n:r791IY-.[T㈫y FW7T́)-t}E1*˄O~O3]y%T"hˡ/+%W%׹*.ޯ6nF|JJ${F2!""W{)j;(\6f餬}ݚ5<0{qI>rыOR%2g[R[vMi3/j7EŬu~~i:rwr i㡄/'Z27m8o1wz_e7gcJohtƆ}]&QwғW36.M/&QXx-G/-^@xO̠_!36nu9#9Fe>ۻe#J/r]DϿ^V3՛DQt~_2ti;̩YXqlC}Z\/tw1(KU#W}4 <Ի>^j'aۉK^,XtB?ώKR ſg<.Z}[{ q0-hP\q1:󌏧{v=֯[,Q脈tx{l=w<7|0 &59K5T!;w=>BzUm0ػ[/ ioZҭYHӆO zɿ@kt.PZk&<@y(u2 }rTe N<|7.=;]aK$'&#Xzy+VͭU{ɷkw#Wc0c%0ʯl)yſ'TxGV֍JrӰv\9ocxA 4߿NS |5{ us׮gy"A_U[Kbpʮ6~1.5p!""m%*cq 8T*M"t9MTP[9̸cs[,J*U kل/-I> wƼӮqma)`ڼngGvJu<^/zy)xz^/̺sGo: < dcѷLjmﶏT"),E&"lٶ7,Kۅ0p}&lNF L:&@*`Vc+ƛ_cQPÁZŠe/yθDn..rժq& sNmWQDt斻;Dd1.(q7j rI @Ecԏ8ؤ `DdY?[~o;wˢF|!|v?&R5 'HOOH$R}h2bN7#77~aU>//%t֮}_d.bQW0kZ6FQbok8y)ѢE\rswCk-94O3 ms9yJm5L& ( r K]c_JOP;l?u. X*˶-{V}\SquDצh\щ K2jJLÒbE5 /\%@}GUx{OoBym_"~ !4iJ r ǏB̩̅?S'rLg=Ze;ӇM^С?z9Hv.Ga2击;֙粳S1зht4a(";; gk 9lg} ?/Zm1>p*>hۧxj/M\t6)UJ6ڄ:CѾXmYbKDw_iprFtJV!>O `gUonݎ}nXyMU:bD]Zc*~OlyfpU]A;4_U{O' ԳYH<%,:!""""";wf#Yxؽǟ4 mEogvY=ip&y/@؇^s5I0=k ӓ`4p`fؿҵ-[uäVUϿbA&99_]PZLXռJSBCb x3̼ydD=߉U#Nٳ-:ZJ־֭{8$"xnb^Ee"/ϲ LvkI!DDDDDDDWk`7FEGGcJ_LfQQm|/o">p }-` //?74m5<7r]ċ/ܽ5o ڽ65j6b3T YU^-:۽/>FU271Tj;#Xf ooo^TU΃Щ $&‘#;{ׯ_h,wMHH$6뀮݆s v>Q39&RE/u Zn ?a_?coqrEWpqqEp'Ц# Z-Ç0*F*Eˮk#k8{y7)ѕk{.&:xyŗQ]#&f/n\*7>((ET=yckb(yk|}{:\rhkР!z{=eMy*y*fksYAp'0p^9+h n%!tXyQp#79D|1]ڝva[ (ÆO3^Ezzr3QTT@BO74h§O򑝕T? 7F/&\BvV*4"xy BV#U󳐝,h4j+FÆQP:;=THI*2 ||X$_Oěo ~PQDDTⷌS Tzkc""""""chZ6uL~ͮ"GXX35sj OOoxzz#qZ9 H1>P*}ѢeWgADDDDDDD(Q=1o|ğ=kk0&<3"""""""""}脈k^M7X`ApbVDDDDDDDDD/QwQ,_<+Ĭno,:!"""""z-55gH$Xh15j̈no,:!"""""zKb5Ͻ$ljY,:!"""""zkނ7 OOČQoq&8** σ N̊` ;bNa+c///|j5 'fEDDDDDDDDT脈ꕴ4L2z HEwrfDDDDDDDDD Nj""""""""E'DDDDDDtۉ˖ǞXr% -ֶI,:!"""""JfV&L^H$Xx1D5e9E'DDDDDDt1 :}:223s/"K߹S'|j-9-~~NȌE'DDDDDDtۘpN:e0/<-;?zyGDDDDDDDDTI=Glg82",D·DDDDDDDDDO戈΋9}/]b{zzbʕP*N̊Ƣ""""""Ӳ0u4t: X0wD5qrfDDDDDDDDDw6Qe00H0Ͻ‹{`'fEDDDDDDDDDNh!N>>NqN"=)ɉxM,:!"""""[*;;LV AMRiQ=&o ]YLDDDDDDhĴ#--<`{UNYt ?n3"""""""""b [֯7C6@*[S""""""""?#"""""Zwy7wy&+Ĭ:XtBDDDDDD*//LFU˖NΌE'DDDDDDTkF#^6 ))湧z 3ԉYQM` ՚˗cq1yd'fDDDDDDDDDD5E'DDDDDDT+~ݶ _y0!-Y oE~GDDDDDD5xwM.+VljYQMb ը|L2<۳ѺU+'fEDDDDDDDDD5M0Lx}HNI1Mx)9҉YQun߀"VQ262fl̉lmvJzw)*YP״ RO!!XtBDDDDDD5fي8q1ed'fDDDDDDDu|ʓjqX.-b 9KJJg!psMl͙9&׿ϧN-OԜnQض};}y0!RԉYMEEHJN^P*} щ껼BדÎ^LNVEghUźh(k!> w$koT& IDAT|I crhb/48ߙy ,:!"""""jpޙy,u^RDDDuV[wݸp8SˍPihޢ3z#?? /X$_dx 7Z "";׳jHQ:"Gl9v9KJco3s*1sԚo FrGƨ΋?2""""""|L:<[ouVN̊nhز35 ZV{z?bOdžWEˮ6it6ҵ*U..&ƕgpr._> <k3s*kPFm0([@y.Jȸ+p?w⧧'Yw.\p0`oܢ½kWرc 򳫝_0"@+ƙ؃/ "Ztv2K1ݢ)=dƒ\5kav[8d"5~'dT"!be<y`DQma 9,!!3z (r9V-_?__'gFjw}ԫǯ+֬ص_AZڵj;|h;juxfqGD㈖6+l_*֖D5ij;ֱ脈ȉ~y}$/<Uόś׶xQSy^n+~+˵{RQ;;7""""""rH~~>&MbYouN̊Rb'qrǕJ_kzyyĹsGp$L&ź˗l N99igE%ztsc&WbK?\9|""*_JJU螙W@Q8;r(1G.:E8;GiLRh`xA?%W%RQAyUF(њ5`\Rzn`F{{\KY9I _V!wҷxcsh=>v&r&kXtBDDDDDDv3Lxc֛~yqN̊Q\\ys#yǚ6GMG6=*&0GM|VD7Fd?w? Ο.AQ0UH\PP8߀S__a QLծAW2MFOTR"KUx?ڿB򜑯ť'yƢ(@":,=۲N*\lz^**75LҏˤjǙ.MM%V*7{e4 >6ctGrZhkJAޞ?|vЎּ]# 4!%NM,u%uw.yHf`  Dz}G|6[vLw$F( HۼXÿ% J˵`_Ź~vpDGo%3IC%>X 0;viS:1#(XdTg 嬶P`]_1sϏe(*ʯt]PpcD5i6ψ\"}HX̹y`+]pRB.wGCkXuJ3ܹNJN Too6EdTkn ^^~ILc4q9\Y#=fL*Cx1W.=vnd2M}G!q=)z :{iy0%HF$\8qe rP);CDdk_[آkq:fNAB"\C@`6BӦ8Қ=;[^^;ǝMy$b FʨRitIY%i wݪ|e4}KiMGMZ7hc>˗/ [{6}+2&e^m^|$!Ɂm4[R4Kn."Ilp#w\8Ps@E'g ƿUyjMVwN!MMòཆRPk5#Xxs׳(=7me.3uZx]^hK+W4P'n٢w$cx< 7DbK~F>2C纯K#GS"m}q)ڄf;7Q]Ǣ""""""?v5k`^.._la?-\]0e'i@)!Ѿ}_X>7ZS.v^Q4Y q;)SҵU8~lZwǰOslƞ?KonMO>ۡ 0 ' ؃`+7O>WŚ/c6!uo/X7I8s:bv}u4}:lTrށ/CDD+<h׾Ctl)vƪkPEJ_3O=C#*-[vydŶw3 {UeHTzea4K7OQ0%Xk㟧UU =p>e(!B,:K~:|!lc+KwEQQ@!FUU 1KCrB/yO]ׂ# ;uuNRj _kIsu8g\]X1:UdD?J%]m]ޯM.c U*!13z WrV_wY?U.8)-0(swaM]7ao( m׷uU۪Qjn (Y* " ;$dA<ޓs9̄| ^j i/cQ O3MV?V_57Aj$']Jt\=[CS9?t}2λK 3 kV°0efaY<ʾg=y،GůnPKsH<6bJX.TJZ(jÉ_ipج k?͜.Ui3T"}iiQ۟5MЉLrZs a&/7+nnk0SŤ\RuqZ,(ˤ qH*VGųo8FhdPo>s˨3Ϫ9he~œWle+c"®T,.:.d +"0$xᐠ     cTUUiږ.^ΝL 3s"K׾&]۵ij(+{vtlc7qF4P$%˥ maee?u@ zF[G`HR{C\` \"dRܹ-?|Jh,/=5tsy!BÆsF6RcB-]`܎J^pbee[;gX[;̀R&LЛy%"9 cRrU[ 'הnf rK^nߘ;&Q!>(ZfDW:MbUoS8?vw:Oqwl|LYݖnzod2p٬SKNyaʇwfޗ IOr15gHe`&k*kD+BN   j5.^lM0~K͸*X4MٿO4TU%Ɖؑ!#Ip4vnʬ%s̕8zdw&d=Hm5e] :w '{:w J6m:OߋDJpq?Hu&^M"a!K5mQA')W{7wǫלsgN_F4hu3voN۷-pfs0`8x*<=nz먽2,H_<_[(CCW7ol[C/DUmCW/j}cjЛ ƅlwG7یČ5RmVS%Av->AAA|6nڄ11렠 ̟;WDaV m~L+j}ey#u&off -5Vָ uطɨrr gw9(#wд\/OpKAA66REOV3\=ʾ[OfXIs.\=huª፷VV`C5 kوM[.bii*+PRtiwѷXM p|!} n5? '?MzhһΣXF0ޖ;< ދw:#o?E[e:* a]Lza|7k!cǯ-|[ʦ=.2RkZ x)?;Դ_|Lwo?B|\L\h-nKff.1dwlheY Dž-7JZX}f*?gS<6}^) +]O%BfSTE=}}]KqyZ:AAAD6nc30vj>>A:z?GUծN}nffA\QD2mBBܻwX%^^罼ҩ.;o^~gH6w #+sKġ*5ژn**5MBۼXr.d/(:YK+}.)v^H PVm=:o_ C(R;"\Cq=u$1=\"|J>Ʃ4QPPp3T:+#Q":5BڰB7=\ZnE7BIAPn6BeJӟSfgr`(fȔ*We"sSK9@AAA0TTTJqK-BΝqUDCNOQ,RHo"yDDZ}AO{3aӖ=̪Nb>L4N z:VY7nVml50\Oo 5*2_9а!z.Ŋ꜂}+deϿvGϾ}kN" $u& V:zjB89E~17wGa079R)딤'1 tԔ(*GQFy5Z"A&3iFnNF~D֠c!.[4MJm_&'E,W?9u[mNv IDAT:iRy,9}+V wгUSJʰ[Yr/E)?ry, Ӄ7`ذ\6K;O![$Trn٭:eUr_-}jN雦}-ܮg|t/NcRǑ9lv0É+:xUʯFf'J%yHpH AAAVήh:e &zR5D̠ KKk}}܎ݴkx5`F^wl(>~Fҵ/옙]MqAF[xK?{lM5^:aǛ ꝏ`Ǜ`mi(/SrETUUXf  Qc`5t 2ՙ ߭k%:x<c\.EF-F[xxXmh8>_5v)`kuj s?+m\i b_(kuq<89{0~ڶN'|v?dfxRXY z֞v5fO\ܢh>tah嗈,yϡ+/1ڵ>&Gu " %%K3nyl- !J}miKcPWW4ōfv͢(RsKt׬yAeefQi6\'6mm%o،-'nI&7gR6ky9:AAAƦ? ::(( o@- M:yoNNmk@| j_g$Lb/|ڪi>)Si|%3#efAJrx |zD{@?MӐ8{:dv71Ҳ2|p00cZݲt EJK.[kq܅bQ6+s^6;{뙱T0,Xkbo\ص¾;-Q0Pj\]T1*bk >'gv4\Fc4W ^w0jZ6MSP&((G\JgKyv^Nַ>&qs>R%uz 'Ū])Ȕ*ƓМs673n4 9pLrpBТn]Xa^9뼨ܝ~9wf(,!+۸塪}9ol>ݻJbDQrߤGžI_|R?Np'ͷvKpj}4Ui?Op75AAA8~.{zcrL>c/iVQYYk@U7 /Qمs\ 3wS*b|Cp)J^٧iɕJ4F P0qr9YEMwvlX{ipS{_گÌU((&\ Iqʃ&]=\-C7J@R[TVӌ5sXX`]J6' :/l6w վvLJup-3tL,6B:rA'0gQd' x\XN(Tj wƌB|8b'ER*Ka)Ȉ ZAAAb1>#Tk-[ݻukU4Mc?m5h0}E@5{ bqE3uHgp|e ^m:ݬ4FDĄ3+ fֹw ry͡E.}FPȑLݦolk :\lyyafpb11A&%$& 8i8ʚGv ?? s>Rd=Ho羖֢Vg+#c5%qa{˸ O볇v3O3"h*5w|. )u-:+Ujq2Եbɽ<5c2~jlP躩|ɔ*kR\mx!Ӭj5mMo8ΥbV_ד߂ϫq~{PYk TZ%*d(/&L=#kHY"SxC4'QcWt=oL ҹaUP(8s,.#==$^;I}wos_,Je^2 2,jZJQ1*Çr9R*5MzOLj^'aebY (i$f.zt?wiL3W*5Mi.(J5u˦oUreUP͚{ $r\/nd(FɟQ)C}eJQoW3fS,ega/(VB2+݋;p.&z78qYpAv ")1W}%<9EVܨ@hMH AAADhuP` _Ќ+j90w|D\Դq8OfXMΖҚt",B!7Y k5͟m@ "Pִ]>7Y^>B:vƅւb1|8 ''q!: q/CPru;}m4qIܸy4 4Э[${Y(ϕt'Q`iLPaC(l{JeI9trTZG3Ph:&~6 /@ѧ,XHsIwpN,Ju4Mx\ +fpY/ZNjH)V߻bR=5B"De)UjGo{gf\âiށ'hRͬoCsS󴃜IJM5Q ?re tMIX U*5M1=z.ut-A'`)e'9Qܩ) Ng嗛/uqƽҩ}ϛ {Ʀ>vD+QN S)JAAA4.5X;x *B)..Ƭ_cXYY᝷g Yg/ƵJƒͳVB.gZ&72߻ }֊ڲwA. ޿(amڴe~´)SâtxY[zYY١/sO1n\juڲ5\Zem@B3CTJfIL8 &`f_8om<@8km,> l+K׾uݳVbL0sӉ5y^NVG_vp1g "2 [eJ>0R9ܫ==&%Ew7N##w}PvŤ,{6##M\aryH𚏍lK=vF!︴!^,ܴnj kʘ{O1ak~Xl$;=r̫r3wvc*ro$緫D~, Z   ?AV/]9p۵pvjCʣG0w0&nނqe[7mkrv >sr йK/88^t~L̜DjDdG7E#ˌWMGoyx4fcff^={WϞXp!32HHLJ3X@}oUص'n5F zx{:usT%MӠ(K73Cޣp_1uƵn6o02k|ܾV:cq9f?aV J acK^>RZEI-ͮ{;$.a\XcKj#q]T1J74ypZyRyNr䜢8=Fu! sc%qe&3*)j4r:}7tZuۃ!*5;E /4}%"1f(Jp=rpu[Nq倴M]N:-3_+TѮ!e옚oփB[נvu2UXƨ+'s}]m/e#A-U"AAA\bc*k6ӗ.Z$NR͜8o9f.]iKL8 +i=ju(ӳ $K`%(#3b.b).~5BDz/[nmkDssoio:~i;ΞW+VbAӧlg!gt;/!:j_ΣR)~ͅ3O b.ER> Iw.7撞YߝRi);OWZ@SeeO6m4MФ!D-)9O,ԷZ'ﾯi?9|3'-Cj<̢rqfDTkTm=s˷D$}n,ʜK7bm{ry۱;\]?*ځ[r6vvv;f }qcxY>r}9 <1o>/_6Zף_6ʽZ}0g!1ݝk;̤w_YYK4hwl?݃ORйK:$AѩRi^ QB}++],vك&Ʈ2{ icibDrCRPP!}-47)Ei~0h۹;s*ꭆ\u1uX΋=ڥ;oܨjҔ'u=mSi=`T-/ƅe=՘i zv̱5Uc [Z?TQxwh9SȐ$[ u{yS>y1}\.],0XhpW'|.##]g[VhPkY,Jը?%JR(JCA- :!  ٲu+Ξ9ص+>_Y3e8p |1ҚG¶-?Bh٨k>Wl6NB4no|~ak$s.#|S-CmkL*pؓjy#a %8B0Op8u8) b7kZ&sK6pth^{7|_B=7_٠Þ]hzD+kf_v,GIq~ÓqcRi˄џ)0J.F`7&---nibH:mvv.}/WgX Ǘjkuk9Mh?ez$Jk̽dD+l%./?$T7.+ ?B,SK*WܢqsFvKn ddIoo9aWL1s_,ج/ƅ3OxAS2}W ߢZXj=2q̂mւKADA]`('Eͬf|l1Ly0cñcVNwd.f\;/$bϟm>9)1=ߺOfV,6'Ae}~;sW5,ڥ/ kPTAAA\֟iuxFhƖ[e돌Ӧc`ZY#^;eX.߃=#0(/qyyC B"yٿ::EkbJU'HsԔ넫g W A&N監WnS.\^sJd٣qOڴiSaiBUUA OKM}8g,zQE$*Ŋ/c0zlXX<ЫRp1z?EEyMFqs'Fy &/ӴDhoFeB%݉C1 24Iq?0echECFy>VդnDN}F)2=4m{^R 25D"3q^&fIqԟ IDAT=-t0:hZ}{g98ŨhBz_׋T,v$1ۉn1]lnw?gP*Ռ2 FB3c ~v}iN Ƞ/];`TosBRP&Ϳ>]R?zfT\ fy'H`V}\js)-sʣebYW`( !LQ!{IʹJfz=ڰY9E_@tCů]q`ͱzdy< j-񓳋cRgvxT, xdtPw'hJUV疊BEʔ*ﾵv79Z_okwoxwm5/˳M_(2|#EQ=v랡\F:[Ʈ ZtBAA!-Y)p۵pvrj5J/W>o,-SLiƕ5.;{جii[,/v/IE a3q͏b#$?h%/Qd(ìTxzw41ƦvKгɞ~˥| MEt>F߰`nn|&~PfWuߜ  ͽV _DYi].qn/VV`W*(/FF-ܸ/0a͛>BH~:m%u._)CudU0/vlsZ__hH AAA N,Ï>Rsx?!3$ >?16իVaؐ͸1~xiJK ҉Xg6^O!Fh e=y?b8uMpMyXjfsi<#3c_;Xk8j/GN4"WZcDDN`ĸ/C1xY*̌d W6=Xzx ^łHT Gz#P}n݌R0> 5ݯQQQf$KV89;B[Hb=AΣưuƤs׮o4mj ڊ#,6HDxR 'G0!7ȉV3o@j~xظCTUռJ  6ak @J(h.R0+^ >m=:R1ˋP:c;vS БЌww/DŽz`-zʹR;I5]V8,hbxwgVzÜ"0ΌA 8zKxwWm9eʨ?jX%s͊/Opט1[߀6Ħ :id}Zau=fD5*%3r` Ye64x9K ]dNti.% hqݫ獽玳;TmfȰQX\^ڴY.C}ژ[bp~o 1ʼ4o4\Njecoo !`iiʲ:q8\7-Vĺ)ۣV(#S3dUHӨ:¼f-aV |OlZhj^I igRe cƂԭѵ"ϲYT (bi;=?_~?tRՏ(ŅcYl6%^7ͮ7*f+j6O3]ҷ^Lgtʌ'*5m0b͢$VĞ\O~:Ge<[< oeTl,b}ROr폑bepT\Y86ф,BU'j~Bc"2_ ={ĦL(uQtwx|'+@/KsG&Xr"]6י1Q),t/϶=䝼 Ab&|—tv0fՎ^dY}%#   ^`?nۊghv?[n`ċ-;;ٚ6w77l#ڵk׌+kzXN|r#XAR]B/NreE(+-DjUܸ~Ay>^XøWa1zd:5pu$']ִ?y#1(ܚTx7w( 1w 3t+99Njl\!&l62Yd&!>ΝKS6#$t0'gi(us`5hZŋ1tL/j ?@փ$ݹĄaQ\>^:Llj!&Irl@-Bow $(a7fж/T/EQk^{sXY۷@?.}Gɝu<B˸ǚsجD>~oހJO?4}ܼɌ 89{`ٰ֫kYg<GeB6S\>%q˽ _f.!>. M$QtzPfAWDbAme/rȟv@Jq1+o\^8\c{F֌p"ٛJ+rkLia\.<߿}֌+sT%W!%Jn*IJg-?q pWWF `)sY>i)͢踯-2㕵q5{HZ[}l%?*~hm'o q6î"vJWBm.U,͸l1˒8YYwʘ/`2mمfD9lh'MA&$   u).[m\cw{tPRZoغG8;ᣵ UaLb}RSjGT*\8EQZU*+L(@ 6'OiSU8szΜu9 t iqA'E!"r< nM@"98[$v~];˃ x<ڔ)9Aϓ f,@Fmܽ{ RQXeeq <ѡC:v}b&>ʨ~_˘i ?|b͋HKKDiiD+d[Bhewn]S ƿ_FBiܾURh;;WxzWpwьWkR֥kNeLj?NKfs"""4$']F(/+Br 03nѮ]'77xokkWk 3 e JkroHl<mr6!AB$   !.&+w| ggf^Y8w<|RYM=z`lƕ=Nr~? ߌ 0|{033Ue;/_ٿ-4g>>(--ĕ:p2xtL)>M%2NƎm[~Tp3v66o}O WoJl)S罐'8.|{%֬=аr:iӦ/gpxApqsV2mЩ""'4nnØ't 6́_M_?bi   }9lM̂eha2J -w[x@   q4?CzFm̨ј͸A4l݊-[dϘ6.X@R9 ˋ~&rr5ehgKKX8ۻ |:`O/[eYcN۠<<:b!I| (EEE hZ +:ýM{v Ig6|ԔHMH8W d|^L6'n>  ч( Bp HIYJQYY Jss ps󆛛7tJAAċV(Х7\6 w3`s+TĿ^IfiƻZDhj$   mv:}Zs}֌+j ˖/ǑcG5ml >] 1f)XlXX4}[Ht٨53?1c7dy&̌ j, а!mN   3c3 TT喞s7ך8I+ =OǍnQx cã0 ) w&]DP&-H ("AW# l@LvvCI=>=s,f̹DDDD/3g`u֬\kk*yYYY?q} GΝĚ¯A=f!#F­۷1'''Y 413"""""""**nr\%vOUr;"脈㐞M4 M71a#G"*:J OĈ^RR """""t6c޻'bV%k'e,8!""""""""*&,:!"""""*þ{8tP?QfN.bF%ȱ$c-7oXtBDDDDDTF9{k֮яrr؈U-?ar }޽a:ًB|QQdhZL&F3+:6l !cH$"eFDDDDDDDD` QƌFJd&MMUQT:}ܿ_Ix"fFDDDDDDDDja Q0m ޽ (bV%'33&Lg1[[[,]ڶ13""""""""WNʐ؈ЏkTYgQɉOpm}kWBĚĢ"""""2sXz~䄕˗FĬJƽ1|HDGGc*T7ïR%3#""""""""zuIN/2* &V IXp*Y z,(8X[7̂"""""""""脈Q(0.h !n=wLJ| bF%c-?q" >7~ى Q6#8W^g/|J|q >d`'RVDDTt:S """""z脈:w ‹ B "gV|1zX\tI%KЮM[3SqbAD/1Z)v DDDDDDDb Q)P`\PSRѺU+*^q>j$ܹa5 1'#==Y4^iɓ脈=wnǝ:v >1u= 5111X PW'opNn/q0"*=NHt,:!"""""*E~i~\Z5,7 3n32:kc5puu1x9DDeJ6mжM """""z脈8X;99aղ尵1sLr  >Zzb؈Y:v3m; "zɤRS """"""c Q)OFHR,+V9y,z Z>ַϛ9}:d2L&Bfm-vDDDDDDDDDNDP(0vBqcƢM"fU&˱l/eG""""""""WND+Xb~舕˖VĬ^l\P}\rXz k13"""""""""z,:!"""""Att4ZHR,"gV޻a#G 66VX"nKZ^5R """""z( 0IIIѣѶM*z/\>ԭSl'DDDDDDDDD/nK IDATq0"fTF@zF>wËp{"""""yܽK?s!HD̪hm޲^Vf_̘6 2L̈(脈\ ˗ǎXj5E̪hZ,X[UH$1l8F!bfDDDDDDDDDTXtBDDDDDTbbb0fxT*T*+rfECTbԩ8p>fii9fW"fFDDDDDDDDDŅE'DDDDDDLP`lPѣ>C6mE̪褦b\.򯗢uV"fFDDDDDDDDDʼnE'DDDDDDlނq~0t3*:QQ6r'NS; "zjW; """"""",:!"""""*6Xk]B;~<223zub5pqv1tb@DDDDDDDDNA|B֩c'|wpvv13"""""""""*m,Nz.^ap1~F,_:N{Vy1Dcb"fFDDDDDDDDDN̤V4i"bCΝE̪p1qI}EnĎJ;iނq-1bp3*;VX&,:!"""""2Þ?JXx dRY/""FG1wwlXիW13"""""""""*+XtBDDDDDd׮a\.Ǫ+ bVqF|*+u)bfDebņ;:u[ѫCQcq~rEʈ`/[_鸜Mzl3hϘ[Àc{4)fNۑv6;6` ʧ  11'NRH$̝5U*W939{&L@ff>ִISZ"fFx0/ѣۈ@Fz2X[.P*Vm*Uֶ辷 E6Avv ^zX[ˋ<%ƵvC?݂E'%DX~Eʆdge;/VLpoVu*%D&dVIlthJ/1)Ms}rDb),:)V/N^r,:!"""""zZI :w"bV۵{7fΙ Zu /)Ғpf<;#L> u@PA{d2U*sa@xvh ~ *TjDDDDD,FL{"ӫ%TKVVtE$-XҟbIDDd=ǂE qee9bl AbIJ"eEh4ط[ܱ Eǫ*\8Oe|T4hؾcي6#2"%$DN46#""gxӌlUc&DN{ܱݓ-VNDd>}{mq%__,[2Rj1g\l߱CH$7?H$ɱX3ܹ}s--!JPm.*>-;ktP9ø4,ey#-̚=[?X|Dt٘0iN>YYYaܹzW3#SG`άn595ڠz&pvvX</SHOOBI$RtZ)TbN"eCDDD$ Iw·19;XtBDDDDDdDbb">;9 'A̚Ui1Q9::bhܨ)ӓ1 :cml򇗗?ZZcG %9\llD@@?6Bn%0t< """* 4Vv֡\CeN܈^D5/?Y&vDTXtBDDDDDZƄ'!66V:dvy]ĬLc 9Ÿ,PZ53#S[319&Lڀ:u[%>ڵ X{y1 GZP6 r^e|4=BnQ5AM'BʍE脈(KKq-٨DtoF!)v*UT7֣|"fF:}j7{\r^ ժ58IӲQ`EDDDDTR;bADDTXtBDDDDDb믿>XpdRiGOɟ#''Gkִ)V._{{3#STJR{?7zZ]VV:"""5%pggb?J@t%!== pppEyOb?NN#1! 99W(sdd ]dd@́T*%ggH$";QI:{7rTjT"X[TNvuGsP( H$Yn}&7 lt[[{M\߾} {vk}ݞ^~i^6Vf: )1G3EḶ\i-ãos55X:l><<* bRaΪc |]>⣏6go|1.hVR {X*a\Zj="""*y{.|2ㄴv &6G 4In}ۭk."rCuD$fSk.y1nBi[ϴ8s'ORFvC26Vw{ZQCEY0m1eBS$gt27sSd4u;.4:rOrK}S.䌜y_oaGu|Y~}js_ü~>uWxBZƳ2iåwZ8U{=8Y{議O&H7^SA&t尘O2D}Bf9JXtBDDDDD %%#GFD"YPjU3+Nú nzAbI-̉ bz|Ď&R(8yE<￝#I  ʿDZ_&!~޼ǏmǗ6ˤ6a%P(Lkfj<֒WvVnߺX`NTo!gPnϾ捳qhuAN3b_:&g7KLnv'*sz~Ë;1#=·FhuV<5ZԾ7{cJ_/ɒ18/6IlWмeӷ">:k{ϹﴙQ2_l>DOs}Xg+k\g~/ѿS隔8J<2tᠨPU:7zLw[Qɦv|hup#rbٻхnS$9@&(ϟm\zZʿ>$e ?XnR+KyQ'{6nom;尞Yks@:{ODϰ 5.^z|1fh3z,M?`eek)Eo]F#|*v XX׾AN`iizqN(Y H/ߧ@Arr,V, Zmqض;4 l _owpZԟjtؼi\\<вUB.?HSm 򾰲Fjj]=sg ߊM0|׿zX-YZZYnS=k9ґǏ`\73~Mqu{?Hk ysr|wqveHIYy=UP ۛWmS=pWgZ<m%?w?6ۭHN bw$huaNV=q8\lUoШD[G&gvt9J-(TK7OX`{|@y燮N9JUXlIҲZ==NٙۑAIv?G>!m/T*p.BKq4.%MטPU!;'^WmVT"Qx(h(|g=yNLiX~"oGy|  kXL ~Jevv ]ܞs㟎#2:FlV_ɭ-M9kXtBDDDDDϿlя}dbJqlBnf*4jPE1>h-*V+VCѳPXƽj) O/?|6zT5]zCn`ْሉyڷLEj ^gfaO[#G/_-y}F`: _6;~YAg%|*.ƅkggwIBBAI?[[ 4mNN吚6E'@7GJ4ӡ;Je&ADD$L+AgrN^oT|#έc{3ie~ d+E.M[yƅΧB H$6|`\LNmĆ'tVI]J.c`Gz$g*Xݛػ>ͪDNl+3 m/7jDnmIǺ w 4]jӪeKa;ҪwW4R[_h`LݿjZ?9_:> >M ns}q.|0S+ ׻/\$z68`+p"$`KmhCAlﰧ|Z=;}3"H;V^E%"""""*fٳckkX.΅[ N|OYpR%?-?8Wsq)~2(8;_~ iR(~$AAou_hIn1kv꼑=6p!VN?@̜hj`ĵHOܕ1:WO bC/$7KK+hcǯ~dXXXCwcG~|OHOv?A&opQ2G՘x),fԼj>e}3kۙfnQ=IMTڹނ N|\w8oʛK'3Aj)wc]߅F N|\&Bu )4 CsldK>j NI2i!rs8z1GUI=GSp7K;k!=5Z{/3'2p[_uBtoҫI1Ngn#xap)8qqP,]dV9b9Cc7'=;k:cDgCDϰ脈^I)));~l_{L*a\j]-5o3/dczK27]d2iҠ̩{XjG{׮"fUǎ!tfͰy&13**1ۉ EKjkа=U3K}NwM1ܾc2WOFVezY{xfsU*eju[Iya#CG'*AN,7""4G OtVM^.(Y9c`JGqZrۧ[nc%WkZ'nWj%L~f)77[=tmk>t;&bjZ9ʹc]+^v,:!""""W˖g7 7kqcƊQv܉' G쁧7z7^̨(ef[N;/ b1{m;&.1bmڽ5h`?zxˬT5J893ee-YtqLl4`Knk4;V*O:tz /Q6sС]L,)Ngڣ\|ʖ_z/SBS;^lMzq)9ҽ'* I9g5shS;23_Bt:/m+Nʞfs.4N,=/w{Sc%ho[=Ԝ t)* zX :v-whgs[ML/&ju6^\1!QWD/+^$""""WƝ;w0c,+-sƢR0m YGWT)_Lw13*.ì4q|EF B"bjLKKkT&mێa-ipϧժ x,nz'o.&rr2jt!$~hqM^k:uZ?6dyI"Sر;#-"9w/?oaa:/\JBL5Zɭr i=\}t^ߖ5.fSRgC?ku:[+9^jUޗ[JGQV>onA²*"Iw}swӭ]0i똘 42iz>N-Q@|z\Ҙ\$Jf=qP.+oaRm}{ <}+bӱVow[]uwԢ׿[w[hQ9۪xvw}:~0T=&fu!"+"55c#''G4֪UQ?϶hyѥsP1Sh4J34$]Nll䰵}nd2 HL6i~FBņcޜ>1ƶYOa_H\ϵEL^͚wkj6CF`V7qѵk J##q57hotÿMvaNZܾs3ƈaQC072* ~=@FOΟFxOn:pMƒ1gg=`'p)AL &7Gع[5zvjՄ;5T*^`n о];-[/=z^7||g 'N֭+ a眆 ALA̧vy`'&xhsoܹsK++:udP|#G 4hU*W6ܽ }TbE4ofEӈr9zt7*fHBB ;rBRR.^2ܞn:4ZWbEԪY ~9 qpp@- ޾s6Ա(&&7׬Qy'J` >>XAJ )~{1TfM̍E؃gC*"9 7Y< ܆F# * Gz 8-ӪV++a9Bx...~t4kgoo=6.*R%ʗ/o07%%y^ߵ7<;ZޗI%lB<]7\]-չcNr="ÃCJ)=[ՙiP~4t:LE̸W8YvڹAkfiq}7A<V~\RWh5/g"*N襧j1ɈxG{q 1jnݾ999aUh Z]wcPհ6:MD?_+*-nccc~Sr;3NR }Q*MS@R >>}*T 9<Vۧ2zm-ۗ-{ؑ[DD›۝:1BIщFATT؁`Pt;vQF E';vJ%|6';hɉpAѢ7ocE'~Fj4Ztblr@E'Ɲ;wZ=w[ >jwl E'iiiF1hwGLp-Z-:~?p@1Zt|5hk6Asf/[@P ݻv5Zty9+ i䩓X~AUE'w"hD,D2`9s ~ojx~9mA| \&,lP2,Oخov0Xj.?0ո9Zp?iĆ;έuۄ^ZCRmXSHvtNwgXTBdRI}f}Aw"t{^juϊhе-{'n\bgm*G-%r=S,RiF)TIQia)T5Ϝ!k<Ni:{U]2^7K=w_:ЕJ`B;ֻI!*Koe̳͚6Eиq"fd\XXg[HWu'^b0VG`x .mIE_çsݻ- ohP#/JI/D^?Evo)fd= MXr _t~}ʿǐWWOQ+yD Dä k0}?xѵYZ@r;L 2`cc^mɰ|ձlzuĬέT&BzAzGGM71[XZ6h`V?gg'g7ki-h8de o} MQ,y5kh1ww5T^}k3U 0:oyr;Z4ok+ 6,\0 s1|{ysϸ{9mȚ7k+kÜ-a gh4ݺ!9EX gɦMFȧXr@ey:.] *]CK `@@<.`nzzt:-܍HТk3oS*}ͫVs;٦:T;Nil q1lꡅTTk\jMQZYDx8ow:b)^r =6pc7?K됭P%#GYG.sm紨U|UE@MT+&VA2q=~=cg'].YϟQN4F o7 GJJ#?lGWbE[~S\97d&`tԪY*xyylْ\n&}~uOf͌v1JFf"?:Xǖ4o| "c|}}#L hgohcU #`h(?:o7v72qFF ʌ2Z$s ;gOL۩CGtѤ*L*5Z䗟/o돷75~c\7hl2Lj;<7}.ōē. B&M-`xζXصS~m/??6v|jflhחLEI?\cmS$.lS&uK8sY9k4?ZkV4wjhԾ {cJ T OG?*RXqcS(%SQoO'{e¢"5F -{yN#rvvG=Ѣ哇cq?8{fN{FL#}5}oDd2KG)_ "Y?o#bVB:kׯǂE>0d`̛=uz.&MA⥋"h8c/xi$yqW)pY1ڵ[ jJP^{ GEvgQQֶhs#[wzGUΦoADDTWp2)8ZК6 Zo:0Yw8Tף{3PIR Aru{U?9u#-K*ﶩvO"sND󥻱fӸj+N@}Y}ٯ~?)ԚFYյTKQ*^H}to7c{}d)T~f^D2Kgي `¸"f$R0)Xa>&J14v$BoNf CФۿ:$3Ǝ1d`XYYHN>Ѫu/A,;;LlW"j._:Z$kM"F&?̽Nm| U%sYkmmHO)ml biEv._qV ʲW5H,qoFFu\M; }eMycwcӜCeOk9?g?fnTXnrJP(s+29kh:4]RHčk{)oalQ&;onT,h'8&9m8W]NV7V$zU脈^*G?=^ +-/5C2331rh>fkk+Wo٫#::3FC\!1d`X[Rxod‡$CBcúhe̚.N"LCff?$Z5{8{Ԯ{D"A^CWpf23ܮC&X$k{yvVViaqRN|DDD+|ڣxDts(cݔ7~tnvgZdpUU Ur+5-NL*|2dLJFoWN/NX[[cҥpuu9'3ٻ﨨 4A,"v$I4cG{%5V,DMD%&64jLKT&0G>GFP>Zw יygosssnڌΝ:N҆DY¾sD"`,F6ߎ7UߍAbbL)='=Y :2ѣFh= iammQ刏*Xl \T] F-ps wRKKtoY~'wKt+QBhܿGC5ƿ DFFz,c~Z[Hː @Olkvos/f}\:m;}/?(1g=w, ײKNs0հ6 ًv{J`ʶ? ePUG??6__}s>oyF,ī(G~- <  5( {f'Ȉɑp5`hh;=D>r!֮~sR |dNۈ5x_D#_7qq۽8H-]=rV,>}=ѳ|;$69._:;m-kVCaAhH~Iׯ=4j[tTj|u][i]؏kC6C,͚wkzx6m{Hk̗G'g4j\vGMk\ڱS]g*/b\/<xΥuztZ(n?(:Ic=G+1tcԌgNvx.)KAKnmhøMAJgB͙خtOxLNJLw tĎ#fe(qnM):,+/mRnmӺ7/S(U YK=T}]]E&RTC:] ezXLFguNJQ~gx[^\Vwӫ{?h hwP,*9s>oy(\3ߍ6',L ~!KDEƦ"""""J%f͝ϟkÆ E>}u[9yյ "`Æ ˻(33P({n2i2W/ї\^ػgF3DNN6~; GkSS+YA(")))  KA*k=8״=g)LVѶݧDcޜhۮ'ZGESZ׵9dYWu5nw|) G؆-k :dd"11O[Mm(+wn;Tj ٹjԬSS+"3+ ) ǵk8"bZ_ ?dLxaf03Hj75\1~ª"=[$[wyU~ NL w: R~=aV7l- :XZZg$e$YF&f:>y)-;nE”[\B~nNJH*q1#ݏHVМH(LݭgosU9AJ_x9ӂ=s ru46̈OmujP*&Ǯ?YrX,LI@|bcnpl YMc4j`[Cl:!""""Jo/KDMݚbƴi:Lʩӧ0k\Ѯm;_FF~ɍJI.߈|m۴iQnXD9`RREw( ۢ˜0q5ӓq-P(r7gie~Xۣ(X`V׳ ]ɲpq"#H1y2ɹ!>9GߦQWHNErRF],Cq|u ~"W^f=qiZDDDX441,.Re!65C# " 2ѦUt.1-{9/?wCTum\c̪ieU8o_e]REħ}=QaWLt^{Jm J8fJR~PD$QI[i?/\wjPaNߏ8?_ *9Vyb6c#]v917~#Ʃ?Oc걍 ׮D~ڹSgh8ӻ76l`IžQOx| 'm۴]yKh8yY{?ksL DZLX1H$R̘] @Pݴk:5`iiW;vꋥ~EN%~%ܻEV144)Ց85kǢovyn_\Br>F\ss?ZlEDDD@*%PiI3\8N  EP$d|Ҵ_v:[ R<3pdz-zU?Ң]Ji<1627D,L]բt@?U(zΛݛس}[flM["aEV&_m]N;Q_/P JkX* ޾>~Gi^StݥT*tٳ_RjҸ1&MFVEɺ144asO\r׮ %N Z%:u {ZZe;wsijZ㧤R :ƱqYY>Ƈ]B$ﭑ;ʫ3G0w<~| ݻ%=T ڠQhب:˛XXVA=c7zaooKsoɓdeeFFߠ-:v-Ax7 2jMɓxYY ޹H˹V#\3}}Ctػ!""gŰN=zN nҳ䵕*MET[3]}y۫"@k_`i|G"fi#X\_!>y|jyk$"aR5S>i,Ǧ{y~wJB{P/8y]goŒ}O'>-eGD_#:4`gn|%;'EV(n={M]۵FFtMhB@fd jn\^̓_fyKyFzbce@[еK8k>[O4Y/-+N!i&W[թzjрnedz&k"4?Nxwrz>wX'%#jBaTj~mkf(̡oBZVcH嚁t+oi *R%3xcYnT,13d4qvo\3NKKT _Zh\uZFQ äֱ]Ո+NMyzdt3 +*';ئqnm,CĦdedK2SIU'͜^Tԟ[aNyj$jJfQp( Pro\3]h.yPDVPB[:'vtOek]xo^ljHz$ʎM'DDDDDTn؀ο a" 6.='haee h@7xnݾ ?_\r%\ժU1nX჈J#:.M|TU =wlebpOڑC.b U*۾Wmmf-$2= Ÿ yuL#lBu]clބ'O曳/cСJx$5QEES>RGi$Nު!s[TᠮtBDDDDDƓ'O0믡Rw\||`kE\S -6XZZ,׻ɓ'ߏR1gff`ė_HG ]Po:Jfk[ ma*"""""*Ȥ4Og[3J¾6֩DT*l:!""""J!=#MEzƫsQCutfϛ L}Х ֬\}}}zDGGcsV8x BcCQabbD.@Zj ;;@Ѹ/D|"zd0*RҍB'8]~30S&U& TIIe"""""J%f͞0um߯2s'VYF>}xBD"Ν< HЧwoLkkk%$wɥG9`[iа-:v[NVfXۮ15tp 啉}¦"""""6oĹnM`Y:ɢRn7ء xOAow? 9X ࠣD>R:&M@ u"""""*!C/;uwNBl TnZH$rϒy_c'k" ^yYYYص{7niiisBݺkdԨ^]G }bА01u"""""*PU!v:Xd~Nzy_χJqbk֢mgIMMŤ)^vfhhuנc垧8t06#>>>|6m0}4suA:"z_um㖩dž&S}H:LFDDDDDEեAzu/FRiz5ku0^"*=6QS-7͚6-,/bc1s>|Y[[oԯ_y*\qo[SLBft7ΰwu """""*] R?L9Wl:!"""" GTb9 U~1@'G,H$*,;wK/盳__߾YUrl:!"""" !##^Sje3\4o֬2(JXv٣ xOrQY= JҘ07#0lPHR%$"""""""""mb J 3 Eeq uM"`7ߠWO-GeP0h@|5f uNH7mBЩSqƍxr[?%%xꚡ!׬E-GeM[P(s2x0ƌSSS%$""""""""Ħ"""""ҩaӖ걕׬^q<u7kdlyNd29D>{66:JHDDDDDDDDDM'DDDDD3ObyP,bVA*UeaUלU%Ce=-HHט p ӼQG <鄈t"33^S --M];{Z4o^._|^Sj4O4i6ܼ\2TYYYص{7oCjjƜ@ @wwwL8 5kQB"""""""""6QSTpk}  (9!77W]XJK咡28t06 .>.|6m0mTԯWO*\922R HGtBDDDDDnӖ8ׯW.,ڹ+WJR׆9fA(KNT")Y|Mݚk$lB*'~?:N鄈Յizlee >eÈB˱g^uM cxxzxڕJɠ nCӧ5l_CΝu:n鄈g0mL(JX,UQJ2]W&ayH$,[={(ӵ+.azoܻ?\-Z@www='DDDDDDDDDl:!""""rS͙9̏hIIIɸ|S]344о]2]2|>~~zZ9j"=033Cztc5u"""""""56QSTzB< U>TFDFb< Wlm#\뺖ݝlތs7WJ>zzz:HWqn ;[DDDDDDDDDNm ĉ'zXpay]xLus-lGժUt,4,p2(*JcСC/(!Ul:!""""2uElߨc:2mjp"NtuͭIly[EEGaK` 8R1ghha1016QB"""""""""ltBDDDDDe&2* 3V79D"_e~o#77W]ֵVX^ l۱{CNNƜ>ƎQeŦ"""""*4ڬ3вE2[mql̰!C1{L2["JNNƶv`ΝȖ4b1 =`kcDDDDDDDDDTٱ鄈NRaEx֫6dhP*lro&0uFU&kVTؽg~t9Pn0uUDDDDDDDDD` i]q ص+/\X&keeeaY89uM"`oOd͊(;;~["11QcN SN2i\\\t5l:!"""""p"6lP }}} OVLLL-[zQnn.:M7߶ML tBDDDDDZYsfCTD"׬׊ T][׫hJ%N?o S&MB-ul:!"""""Ȗ0eT$%'k3MGVxLqLZ?vvvZ_"QT8_wSwA:"""""""""z鄈JMR p}ugr0uL>Z~=L^Er%x{9;;ctww@ A:"""""""""z߰鄈Jm8vz\n],YX~걙|yC___|mר 2g΄mx6mٌ'O曳Ĉ} ===#""""""""NĢ0cL(JH(VQkk(J,]-߯ L2F:IXX6 IDATdPT*Ɯ9F CBݥz;!wtcVpkD1鄈J([&ԩHJNVצOim,L9aⓏ>:ETtF 1x =&:JHnœtc۵z] """""""""""* qO>}'$$c'޻oZ4ou*DGјH$ӻ7&M^ۀ\N@DDDDDDM'DDDDDTl؁Ǐ...Xh֞sϞkUlmi?\\\%''c;sNddsb}QBz6Qyb UDl:!""""bt2}^moffu000`DO$&%kujfTRE+kZff&vك"-=]cN(½[7L4իWQB*Z^ֺADd=_1 Ħ"""""*(̜=  V|jժigΞŌٳn >abl5tI.߈|m۴iQn]Ou "zE<Ħ""""""tBDDDDDE-aʴi;Lk%K --[T5t%77oۦ NB tdtBDDDDDEtٷ{zܭk7>UTߴ 4Æ 3! K(J:~xYy&M5iZltDDDDDDDDDDæ"""""*?C...n2R=WP`ɲo_5P`Az]t ׭ſoN7uﮃdDDDDDDDDDD"""""zW`zljj u000(s3331m ouMOO+-?*ճuKݻw999a1ճg` Ett4f̚ B X;TVTύDOܻ_]355_4o֬T֕[+W䛫Z*ƍ~}B$ 鄈 $5}Ե)&czg0s={9cJl]x16o‰'YZX`ė1lPHR#"""""""""*;l:!""""-]L㈘nvŨ#KwsDF:u?UlmKl GRԘ333C0/addDDDDDDDDDDeM'DDDDDϏ?XR?b֜ȖԵ6[Fƥ[9p+<>v% <cG67nzljj>j |TIw^XŕeIbRv~޹<3 HЧwoLkkk%$"""""""""*_]"""""*111IUl:!""""zaPU+sumxNdu62kKf:Jݐrތ#Aöo>==&tDVVFI#SY+ľx(9i:vDP̛F]!Hu*Y?9Voj0Koǎ{965Ի;$]fzm8<;-3qsg[.u]Ŧ""""L&$//ǩk'xsN~֩?Oc9ȖԵm`u%1ݸy}}pƍ|s;z fAp̛Hq̐D$$DC&wXW[3J%NJ)Kk""zW鄈=l Q?|5fLXz5Jϰdb%;wK/盳__߾^ U E.zՠ|szzh޼+o==Wq\4敊 Epp觐e@DDDDDl}8*S&/DDD@z={S͚Xb#Ri7hG*ԑ4CC)'R4,1r :R)L l8б7+o_$^VW ӧv$'9H$Cm897s8;7B `ℎ,}# LBL:Z<_*|P[מT>r-PJM'DDDDD`\Z=6227L~ \. ѣH(y0Z[QQ} 8EX܃WcT#ӿh <sGz1,ۏ5k0!""""FUGmP,R~Q""""H\|Θ\ Xw\υ ꚁ֮ZΝ:k=sI`-8p  Ɯ 1#GTG U 1A$:D..J{Efa {"77f@l\6ab5aOpssjޒHJNv;!4$ OX(!Qq{%i\\$Ozڳ*h<Ą& 6^u\ d]\{w/!"1RScc3Y7h>h$%B"уjvC:?N-99wC.".6́LͬRj֬|DDDT~RjJ\PDn/I15|Ѹ\UOX~z2kx?X@*xskk{7] @ ʺQQazܸ~2YJ мE7 8vUkk7 {B$|+h[B5R[y+V,{s3{-ZcƬoNDDDBEKy8#2L mwb Gc2erߏ֠ۏܛT߶h@uIiR#ĦP({VxɩYZ}ߩC6֍NЛ>#d(t_w#Dbh{Vga HaTҠR3sMϷncg_~8{ȵ3>ԥydïwB 8}Yѹ_>k[ᶾGoNLTP>߯ʭM `"4EsgvjAsb'Mq m.OtBDDDDسw/8;լ˖C(,ns$$''k 4D zޢ®ݻ}RSS5cI:o!*۷FrrFյj,oc^|Gl.>> [+'1eRR58V(^/e?Gp13_ ]C^:vt;~a9B~~qغy>.;Q[up^> IL_#.xN\F;qB"""LF'zlZբ8)*䌎gCWPaN!>GfF%vmzvN4韕/ǥ='n.}SK*iOL.էepi=zsrUr}z֟!OwYK,(;׾Qؿ:Jg^--ݕ7;OF(U*®UTԬ>G;|&hb(~"*w UXnaU걑|ab\9uFpҮm;lۺUg 'r'~u>5m{wkpBҍ>:PI*_b56D"ZV_Xz\M*oPt:Ɔ}wP(rq 8H*ea| 'J nEX6YYkKls,76"8+F?G2"U"i1WD$dJD$@ {5UZfho_D "a2]:bR}G|kM 'b0M$hlT򀓷to]hLȚ75e=-;]l5KX9xm 'B@U(M]]tb5^B[}xدp" ޴U <6OD&U3J3鄈i3#'',[kvĪ5T:Of"rBT")Y|MݚbhѼyg#Ҧ\WWT>W._k|] Fڍ!R}=A'~B@ȝ Pdu8ס\!$)rBCܯu,-`А1sVo0IHٻx4lr4St\xL=ߠ >5D{ Ѹ8x)k? ƖMs5կuJB.awcTnbb^E=`cPd G؆ǷʱolTGM\1/ .И=wb3n/""R(U)|T$zl7w쓚S?oX_QZz4s nYJܽ8On?$.mrQ.6)oM(Ե۷U\5ԝg}^^Hz3nMhj֬#}^Xl23ӊ|dK^]oh 1sVԯ:_Wpum{cq~Eo[.p2: UwpFtR\዁SIO??o깋@EBwo/]?BG50cfYiԍѾghۮ'ZoV) l𝊕Thll/CFm7DDDH(P ze֏灵vW?oSrF5u<܋Lwlgntft|G}G6w+GoUg9?L& ||Ў4^X էegφ<]e+w84ik6mƱ I93vɯRf(fr\pּNjښscf,PnN?=9uEIf/e*v|t~E"`_6Ey[]/nӜN W53Y:ERuiё#S*U޿_i Ȓg9?&rz6w^tp{㩬L ݛѽɿm?"WT,>]/יҳE~VF󏕉smH!""""zG}b9߸wz_NNf͙p" xB4\t ´35ru`;pB|GT^]+ǎnOXuu\bMJ6/@z#@ ČY5Q:}FSRkJCܻ'k8¢ ߑow;Wk 18yG]՚=| 'y " 6]i|ނp9W*[02U7U,k䏗=|5odN9u̍:vqsM>мts.Im5% Thmr,o=!-wi;T*-5yp?Kùmt.$bBz"*Wl:!""""zݿWk֨-Piiic<?__fy r3&1½5c8{~(JT٤䫙X IT*p}&nоC"ߠa[toBÃ׎CmƮ$oĭ3:uxo_Exbg33k V/7ZZaǸV3 ڕk02ʿIA}9U4jǏ,DDDj g/k2è_=/ [O nˬϽOFK{9#oɼ]~S4vto!yQ !B!+WeˌWT*mp^^~>^xe\ƾd2CioP/ TB,R Tju-򅅀-^#ࡐy:-U,VجSka,9[{lp8j'g37ҼZB!B 5jK"T&kp^\ &"!!ïlBdi,O7^DŽIqfggg6w݇&N]P,gD"X%11mo([4v39]ps bo_gt{Ey<>zEc/l=%%e^oG;sgB!y(ܧϗ) 3[ \m=t%գj =B9hѬOj5JvQC(*.Gt;pT]iqiyRJP;%oKբ9Ǯ>zvtc ߔ|8yMv`o=n5eU0{$BɏvNPR7QN-GwtB!BB7^Gn^16uʫ2xp.\CNN1֩cGleiYYXt ;:*D"+/?+/ f7jJ+$%2ojv˫gt£/NXxD7 m#3סBɈk|`a̶Iɚ$@x啴]]ψ%fB/]K4xRMo0UbsfoopOcu V7eY6;Z=߯] ˩^Vk*.d<nR6Ux+ZKɹ6Bmܷ`B!B>3\Tsv}0c>r y*UK-H$j@nn.6nRM$aܘ:e \]]9!&gVVr)(dl8$\(EPȸ.FBxZuO>fL~|rddd I.Džjx|p8MSV`0@Csxlp|Z1&$$`kYǘ3sF Ί?>z4ZfE`o~t)nܼ/װ}~߹v7puaW\'};o\ݛ/;lP;7q'ٚcX{~݌gſkF 濆vrX۬FĨGB3b۷ksi0 'ƞ:};Ŋ6o>|}L|j%k'=Ċ;Pk đ]"$vooC"M>'oɼs]~atȬjѧG&N}=so>>xudǥ8v{YgC޾}`ē d+z{.gO݇QZqcDz?qIIrFOgXQFݍٽvszDn?oMD 85CneD>X#g76X~A>ѣ5&υ[Wv5ǎsttcC&$$ ?(䨳K;naǣdu-+T(ea:п=𡸔`c`*(En93 &{8u h`dgAuq=/&d}%5o T ecsصJ{ѵP/St^N*G*[GboKj ܣ-&AqZ^jxFg'[-թuQј[sZp)UlzΈ C#smyKm=tg^NTiąʞʞrfKdϟ 1g I+(g}0sLa;Y|VuH.J% ʎ˱|.NYx9[u^k֟^P:H`ݤּbeU<τ&J:!BPġ#[zg-z}֝MflOpчKjrZ;ｇix<,z=_BBUU;[=>~}aU!*++Cz $%ɑbb,l||eDg^̋yZ jUNhb>;:~S[lӦMzm[#hTc[7p8\pC}`ͪ&v7\5ϔ؋fNJ2y2^x9V}M W/=y&cֽ_^N9c&^|=]D6OOcMcOI ]·0wTTT@n=.xj9ձm[^o3Q''զ{I,[IڨG"*Ƶ +."}NJL,L4]YwcJK]OmrͦVFv/VhnhrL&3w~8[_ʉ>3bu߃zt/b}}|X1Octbo[Ob۳L1=zLj~~&Ƕoߞp8&Ƕ53O?A 4.d.>tsːglY7-}\Xc;bj~*4}*UȎ({tNVoi)ywlt1g3)Vu7 Լ~8K;?cXd|s!"!hFk@I`0XW`0r`_oF]XU  MH$&g~ozo֛Hp/cE"EjH`׭~;:ڬ\.XR6m{>UO"O]"챝:v41 $$ĬNNN?nxbhZKd.'ѥ.///frf`V}z^={2bGC6o2c'k:_9nS# _Ocܲ?޾ׄ.SAt9=. w/kJ<.=/ zYS[Xi͆A?|[@iRcU9;Vk+1֬٧f fY1>z7u^q^o{S(jt`6Y XQePQŚb/0BMQ !3JM{1g˗!&6ָݧwo̜1ܼRoyyRG.p7VW8.#6sL!v%S+WRa~S-_3f tT3Ԑ.AyCpKy.aPbf^o̮NkM9he-o'{5˩ @٥eաPφ";Z%X!uZ,W`v@8oJk,VZDo>ҋ ?Wj6pr8j}5YfH-a h#e7$4;J:!BB< VRX+9v=bo}}|e33*㻵 Mc0p j #ZxX:բ4 )++P"#=n;y0XJ. ԹK_89y<2ւ+k!Vq*4{XFEj Λr"NQYYزϷ3ڴ5@vՀ0D!:!MI).)qܤ!^F)YѡC7vgZ]NVQy_ް4aj"RX(t?F)VͳT7ص`zRO+x8VYr& `ށ$r[r [4:b*td5ًrRm]P4w ?y\rH{]!Q !$ohe@t<Yu+>.YbܖH$zW&psσVΝ:5_sr*ܸɾXYg`p86;'yphZ䰒KQ^a}\TM0燰PY"Y <;waX>-NTTu_lDqq.\\XUVW7,Zm2 |hK3e]l;? B1TJcţߢ\zUUJF,,k| 7B!JS7' %z_[$ꊳྫྷfbA v7VuL;7&M8vInNoX!*rVx案/VnsvfOKNsۭ5 z-Patzy\.E@_VK|wj/}[ofԜRqSeCj "E1'{- oљ_bJ:!B!>RXXsfۇp8,Coٻh4clX2D"xka՚5eDW'OƘ1cLV`!= iv8HLJZn 1K{_':=>r2 E1v=Fjs@TOةx<t =N߅QOL3DeeN:?ӧKJq1t1YLxcv2]8qwNrSˈuI<;D3[Ξُg'vǎ2{оCzNjVNfB_Wަ xbO'ILo Ev l!ETW҉&9%J Vt%-69d\Js_3;z^4c6x\Q[RHu,%dB$Y*XrgK|<^Q]Eypf'd+)yR`E}sB>#Z٬cI˞dQ=B̮;>;~%brNm Z7v){ec:F[?WK 󸌤rzkD(B!NÂ7`ə+:1_6o^_s'߷NLķ߭_s&jiC.3K32aq[i#@OOOcK H$ D_|_Yoټ<#cTXݻ8y||.rrԄtg-\\<u bccXTxe' ۶x?Ayy1e>_|[6`..Ϋg._7E&9lݕ@ DGl=0IKLzmߺyňE{CͿypBHVP b '@( twЯvJj-cZrVj@VpsRJN).'pLi漎{bSsKGYsny{~cbQyc /DcIZ\7m͍'%x;٫ IDATԎE{nhZwV(,l{ad#!+Snط]{xsr媹8.xyBAJ6.AWG!B7 /)TTyΒ XOv\v3h5}?>þy}澿t w:м~|& ` =NcYzT+ n0e_lמ1[>{Xԟͱws3:L_wx?\:3aʫ4q6CCJ:$)xV>P !B!-[۾>>Xl9"Zﾋ?cvyVv[;wNl+H0g0ɐ:8yHSVV:pHMMaJ. [2J Fw3}v@^X!) .]:3!/7͢g'"!!*w8zdK=nEk0Wѷߓ8yb1vi|d\OI+%yn;tB*e ƌ󇐙YS{P^^ɯ~ww?֜4-ܼq ÓcgչK_FKnn>%<6yxzٍUʜ0Տ0XnF¶+ozF 1{SX=yFSdDžncߨ[WhA~}@Rݾ:V9zٞ/^}ݩ;;n0n/!s}9tM;@;?>;oŒLd!!{@`YS'7TJؿoP(/.J]P(Aii!QYYa<^-`n8˪:Ґ;wdI'!!"#&V ^;;=H89)7wh4wى3YtN;;f]?ʚĝYоC/wT2E1R-ݖJ殄]?D`P;IӸvts6oh%= QNDpHGt.P* - eNUNGgˍ1Nw|?Ȩ _ @qQ.^9woO=Y|%u[9^N1"AW|JZ^Z8>.m)my+ϙ+7]{gy;=vVzTq@UUܲ*WuwY[XKG;~U RRq1;t$^"Ti4ТʮuzpTzjN%}Y UXRP\RMAu-DI'B!b%%%;>pҥh߮qLfVΘc|5EDX} ͛QR1|<1m:<ܛ1=ZtV,7Dl|YnBI wd?)v5g%wƯ.wP22>f}r-N*u6cϠ ?twW⎛ 0{JU lg|c\3~L]<;?"0]q8̞ ~ '׿?T@Ju$_otތY[A6[);;6#i Oit~TW [? Ͻ.6$D!Vw*TTv/TTv7gD(H~ -m\&?9T~{[jW, 9%9%c+(>a^Ö~Yyଡ଼u땚_6ctoq=W;]J*Yކ,{NҌŰVa6Rq/i*{ʲzÜw_V)U:*UrG;oD85*" Q !B!Nü Ys^°džo'&bڌͫ)ukۢ{J[n?yGżsnQAZ %r93Ñ'ˑ-q|>-qd2`OmAOG!ؿ=d`УϠWPp8fR/>t~a1ΝmF=77̘?WNZ}ޠtsgYI \.SOχjÊkp>TT4lNNnX||F{yi}&1t jM|yUH.;~j;ػ;\; ^$B!z)o*`c vޱ|bMA^NMF[X05Ogz&ЌH:q9fGΙ2?N^*[AA IY/m;SPXT:s+Tq9pdž_M]^nl~귇b9Sk@ׯ^9Gfbbcѽza9sc(Iҹ3^94 ؽk~Bvxh۶4VVrIbb"=a)TF;???d nMTg&q3zIWRf;$PWWOE",< Q]Ϣwųߴ=|:ghhEqrrü׾B:/<:p8\89?ѽo'-mYwqĴ1jT?'.P*k,HGT Q^/99)LBQ h5̶hTrtt·puEEhVwBhX$<8zaVKjaD3<]]z$.]Ϫ;>A?tYUҊ+:FM0O{iw:#(zW>Zޱ1Y'=T3G;i k,Yx5ijlk$uv^*v"i~nC"OԿ}}Enotz÷;/}$WTjX栴?Dס .FFee9bVlXd ̜EK`g'8ɤTU)VWA*uy`~e'텣P>XjuK/BH33ʐ}rbJE"дsBR[& ,kʖ*t3#N p?brEpoV!+Ʈ[cvi]vakgY2%GEU4o}nU:!B!OK>4nB^ҘpXb9 8YfŮqZ%X#tٳѳewC.3K32x-!y7$T_?d2Dm DbG@Z֜ p5=w+ }a>u2i4Z$NRiRG&!88!B!B! J:!B!-NUFυؾldfe{n&zBddfc/" J}6xR>ܬ=w+\7nc+1r!n;$9RSS[@MK%2pB!B!bJ:!BrJpz<+>tb|߿9g896^Rx:/j۵N" /uEAG 5o"fTƾFD+i[ld!ƤR8HJs>s8>W/̟;9g.]6H$XxOFw VY 1X1uyIx/nS;$1) V~ bɿ &D6B!B!zP !B溜ػ!H6)ꞏ0Xs=/] 礅_VNk}SM$܎ߜDž#auZ=J (-TƅtFIQlk^E 5o!zrt-E0ԓ8ΣINj5v&N`}z>\`_|}brd`ڌHIM5swsǷkFDۈϙo}bsuqϿI'B($ZFZz:+`"ONfA݄P} Cf!B!B!J:!BU4jnG]IɽiH]82$B 'cL?nXDT^Z\Ɵa]0qA_8;~XѱzLZŸBQQsr118v>\ƱBYY>{ d!2[+%%߭_}C_&Nx/>>c*խ*l AJ/|FŌEﾇR_xd.5pv6]%;;vA1b<;a Ri.> 0 Wsh4ͽT"#=3IIr$NRɮhd.GGGi# oBRH.- B!BQ=B[zBI'Bl3`lG8cP(L0ƏlڢI'՜\%x8l]}  IDAT[Wfv^Ǡq&8u\?ƈo;.jG/`gjRÁJf>Yfi4{7f- X_{ m#lOYYI#55:-L (B!B!B!5(B!~. 9i%mdGI'O0[6f_g]0a(Ϋ_1mI<2M[5%VgN|>  pp#:o[aSŏsI5'W { l۾V/uIRY=whZ?xkYL(̟;ݺvh"-q&[}L;;;Kd!!kE!B!B!atB!vݮ]%΀c;c;@?h\#(p@n߂+kZŎ/(6ݞᅷA`ۻUjZ M0P$g1b|1h̙gq'-񁵸S^G`/MKΘ3k6{ՒmFV#-=rI%&ȓQUUeq&{NLp%!B!B!4+J:!Bٔ y8y|.n=?Դ>9 ٖ X/tO2wlI'EXd78`2ʩTl(iv^gņMj5&[~jb|b9^'ijƄd1m:  N pM(ˑyb;}j^^^6UyIxM|*ˑhS*nS\__B!B!B!ztB!IGlFl8ӭ[5n9)> C\͗t)7Z] v#1? x1He98 #)%8Oxdz>`Á`c=7qϝk[T'gd 33|xyyK} 6<6[;!B!B!փN!bUNxI c?}}MRS{1dB^قybe#z.~^v5; 1vzt*!V_k;=ػ!qVnֽߚzqV%hZK33$G(PGGGi#ܬ-!B!B!D|ϵ؞ȣR1e ;w  a`AIJTVH.CplMG)B!B!gQ !BtjZwI1plGFIIAb=$Ty)PlYUwMm6it*݋D@( ~lAP%,, Li2R=I|A7ﺼ7y{B6Ӗoīv["j\?ӄ tY'ׯk&&&(((kh_/ =^{֮A'GG?fL}osvr-B!B!, B!Mԭ;V_FU8w0`Nо. 鯾:/*vOzIٞj)BS߈W s93{pQ\>*P(Njvn߁v+!xxx`G}oB!B!z%BH**pSg[ԵLc2ĽaSO;2$r2uƵ]s 3Thj'QߌffS'1) Owke}B!B!B!EQBiZ-sUW ZԔ,D14RWN NT5`,)&WH-#t7&SZ-EvvxRg^UYRSS;kvqB!B!B!Q{B! k7zKg[눭L^L4J6/«SjW] 5]j0?ԧ<- 2TkTPubCpܾ7R]g{+qx*VzxgF*sxdMouK1رɸt,5`OM`͛7Gs;; ?q0kU "0(+DH Ph؞B!B!Bi bt {Jq9 j`{ǖ5~bdy=qiv,5>_O8Eºe0TE\7+aL&V[olN p|@G{)=%Fä%aU{3=%|AƬ7SOfϜ3?Vy `7x8:8v+ H,EdT$Jekj46ra<=Ͷqsu B!B!ByPBibҐSʭuBy|.z l[#{=G/t0ŭ|/YO=Փ-yP+W!?qaq?1 dW̸7Dj\6NRK}H+Uu$&$ڎ~c:˛h`49A8GWii;{s#u_l_?E?YN!~w vo@\C4(?S(RW-qT4de>i0|)e[{*]G}y%N=/ƕ0111x VE|B#"JUE /B4D ihVCо=5P!B!B!B'BHSP\arwy37 \|#.<x4 c? 6'/?y CR@γC'pP,{x\cın{_W湮 GH?̑ߖXى`BfU4jte7Ux\EbTF{bםrsrfϜS\0 S<S㇏ŘV8<npsuŐAW8ATQӕd2\qo< زP|!EEN!B!B!%@B!;J{ G S#z^褤:G7jE3S}#NFК4 @_ ,m̰pPxB3Lłf\|S˳Y朜t9rZK0jrF,O>˾p;lE`U8xΛU|>)!Ws_"Jl\lkddf 0(A옽=|%lBA}_B!B!Bi(tB!411OC' *#V43ctyӭ=ŮVu8w0C'>ڡmwAnuV6L՞Q; Z cLxgFW+ edOF~8\ 8?vi\^CG#޽r0 Y|۶wGU+aG3/X6mT{?"3$I$XFfKZD޽Pd䔻Frr2qD*+NNlO"WY!B!B!4n:!B觡T9)zcXB`bTc{b\6 1#cưиqa*2B1LEXى`&NMm[~å@|rRRp kW1zԻ=k&Dfj4[ol%K!<_"6.qll..UwB!B!BH ZB!׺C+nVvfz)q荭1 VAi(yJY88UV|->^-ODdT*U'?!'P:ƦwMH͋ BK#mBCベG1KK!RxZ Ç%>_Cƪ5qvnDd$&L^Xh[{ADEGUD+PFfȎQ:I$H$nBa&9ݲ!4jpB!B6 B!MHtL4% E=Ԕ #oRPcͬc.oI% 6 GE{Z ;[[ھ&O 1~8w۶ؽc'.bŪHNIa ĵQ=k&DfAH'y&q}HRܑJrx6oo*J;<#ڣ#-O\._,^wǼaV-Z;hb|x _: `k®ub_xwϜ3Ol/HQ<K`+GD n<_"6.q8~"@qOH|%lٹA/yҥ/{S BHLŮ6!B!2QBi":?xX[#11wDjRzJ>/]Gǖp]!dJ$f!Z"Vhhgx{q6t-[򯾆%"/Z}( |Bp|ƎE}q&9z:@qCGcтzUG ;[[?;T`R*|FVJDpww׫ZB^n׿≄RM!B!rQBi"T*ckkz -A4Ji/3jEP?^/t@$ayP= ]r x<{-Z%F3+WBT>q'?|9ZjUwW}v׷/ I|B#"ت(aa(***|BiҐρ-@FʪNB!B!B: B!MDTtޱu=41x|.]_ۃ' f͜*@q 6`sZ]>_GyooݵHI}L رc1탩033a<npsuŐA ǁa2@`P ٱg( !B!B!) !DD< 4oBwCjRW`oܹ;)G9*0kekOI+tuoXXÎIe1{.t[1 P(u G׮]o>lٶ (U*l߱'Nir5c~^ Bl%X䔔rx6rז2_B!B!B!OQBi" IDATد|,MSꊽvcʴ }&6o܄fVVe_-#NJի>q'[oaܹhղUK]?zc%A)R,|FcD155^EWp8"B!B!(tB!4b==J0 g 0(cnjԴdz6϶)Z]H! cbnnWںNB!B!BN!& "2RˋB'4A-[]1utDEԊǸmoppp(\~}¿W/l Jw'9 1P(W%6.5223@v~6 @PC!B!B!B'BH~.[!6Xm[`ΧkLL27lD*\yXw{XzBe'G߷e˖v/$I$L&CXx8[ ^=dggFrr2qDщ x{}v022!B!B!BB! anY;!P ǂٳ|Lp*3uZuڷkwgfZD! !EGG_\n!`ifu?8ܰ˥ex*עE ;7z4VZ{Bc`OaccSx< JAA*DZgedf 0(AXIDDm! HP|/c_V=D6߹0 !B!/YRGhRGJ#WT !B'BH#Y҉g=}o D"1.Z `O?"/?s?q\ 4}|;v;RظyfϜV /N,Aqc+դgdP#"p7.rss<_!6.q8~"?? $x{\.ԟ̌n&bZ ܾu.+w~ _B!l=A!$ B!NCLӲ^:!C -^ Fؾc29XZ!̜1Ç/ѣGXX4><)W+lmaXzFR)RGD 22'gi46ra<=*~=99i }{յ#V07oyMGt9pOjF?7tB!B!B6 B!d<-U'N!++ @q'pyL?SLqǃ+\]vG11J J|BH`nn^'DOb 'ffXh<:Ui=[[{L N͋_t&z gprn TkW9B!Ʊ{kqL1û{$y:w޿#h!F,:if͚`UoAyހN~~رm499@L#lU{m.!>}snl۱jPPP7䩓x{|> +䈉W%6.5223@˅^[oo^ Dj^ ToL,²{mK!B!#ixwA%B!) !҈EE= xmX{{tTO0BjP -|g.L!Ҋ+ܺ} NŖaiiB뛚b8`~^ N9>C]hxS-~ $v,=# GD޽P6,NظXJ<NNlO"x\ ?ևl}l~B<_ "j TNCNN:XZN #77B9FY"ыݐr&06Us[L+~@(49[7kB!TM!4E:!B-s<==2x0 \["4P}nLC$%%0~$l7ھ5noM\111cݼw`gYf/|=RlmaX 4DwQXXXZ bjj OO(..F=ΝهBXju,jtst0B(*R=&W?IU?VeGV\*VAxu]GdM]gw>oԹxn:zWi խ#:onx_TƍpqDC/sÅ=;ҥ_]!Ҹ kDfˑ+EZ+18/L`nm.|co^/VbU 7)92E="W5Wkt|TO& 8gr}ﳴ߃"Ng+ʹ:Ęa&g ~WZX pNΐ/>[Ub~j{BTiu:+3se6ڷ ֯]شVIY-K[XNS~2~LH[ɱhސWBwNi)92W͑)EZK Øp rB40S{yT^ uH휞p-T?Z#s\.Ge&4zla*Hsjn5W쪬O:!B\^ϙM!@w.L1 b܄ض7iӦFj.8A<֭Evvk:Ob%L<5rMR; hu:剈JUkH! cbnnyR _H1 4v8eg?-! T7#10227F5z[@.ϭRSbS71mJV:BBNTqp)28|EE T FLL09}Ӿ9Qe"qJ%×\%ZÙ[1zv T@BlB3&o?vq6Ѫu?Ig+PdɀLـˑ)2_'[u0\8[F\VFv4,Y՘T^(w~ʛgvL±[1Ym0Ѫ2\z;29c;s+|Ydpױ(92Rrdy;<' =>쇊ᛝNΐ+PO͖#29 ܉gM#{Wt BH@EB!TdTޱ'N!;0}GZ8[l[+TŐA?܁={uLu?ÜYѯo&}<.npsuŐA l5`)ӕ]5Z&Ae+x{÷cn2KL@F\\խC=qzFZZRϹx23aպ+8)aܾuIQX^4oPaϟ^C+"J iEaF-YB!M[HRx +e֧1ǹ*[S.ANrkO|_ح9so~~ j}sX~zc7,1N|;>ِ/˯'C#U"Z>m=kYCb菠5"1f)r 6`Jtjjl_HiB'4:!Bҭuo3Fۊٟ|7n2230a$lٸ ۵k : Ac ;銅X->oDQ(ѫ)׌ }Om#T:#ve$R q]^^ Z ap/ [{06Cggh&&f((#=!nnHZ {NzCv&wFF 3NMw5͛塰PkbO76JN'Pi eVǘ~JV\{bYY 9"X,rhuhm9Ou-/pb*0J4S9\F.j&+,`*ޘdp<#We#ZkU.rd~/P,3j%YxeNx?]hq"N.Z*E:#5m>; Q |n1v 3j$9fU[D ~L&CXx8RGD ,< YYY宑g3'G'6Ȩ隣 3suX;i|Xv|uÌk`cc#M@ؽku\ɝ`Tħ]7w,|%!>ع+ܺyKljm6|f_Fnꌏ箇U O~x9giw+]*PS*K!4U_{{;ܘF^޹ b#{ѷctYhu (s>H}]T72s_Z1>ͣ#_ŒM 4ݤY*N]|X:#3DGG/y6pbgnzeJvᥗJJ1Ò2F8oИVؘ_;b k q~"ǒU.Lk_{4orZS?-lwBo︲AC>xHS۱?(=&{o;k~ѝÓ3{)^+k! !HE<}˫wBinZ,]%>~@q듩ӧu?k5;~]q!=v 9ojZ:|Ϝ&cq&hbb1un]cl% A^^^kZ"6.O( 8;14.%<:aal\ڵ/Ų#PWlAN߬Y ̝ [6-ĥŠoX~G ;1{,`07oV۸c/ʭw.i'`ffUBHSlTfn`}&$˳wơN-n=&j[H|Me<.@x\3g'On/r\kZM̘XzLe~^o:3Ħ|1=H;k"Z۲6 `Wit֥ڶ޽˚Jg7lZ1U-z]{kq[ /z@k+j$'s%%f{Clݧχ=Ua&{JclXi8lmaksHNN DFF@**Fa+%Df"Q:I${iHrJ\.J2;wn?t:-{ldd3xnऄ}w3۷.ֵ8)p0iWr99#UJzWk%3#ECRIi2ғ;u~B)φohyε9 _N\4.}S[Xl`>vkM/Я0jvW5cׅ{#JW }--+pRln/{yg]LۥM8)mFߎiyk΄$,ε׌u紴0Stw?XҲa{z:MBGq?P5>\zed IDATb̽ř'1{"/ B!<;֓B'p8X`cl߹PTT @ak|B~]a ._fOHGf[׮X`!\]keᱷ= I|B#" JXx<_C"4DʎزP|ѡC&I!ׯcj*~`A5 -Z8s>oƱ#*z6ݺ;ر1! .tRs85_H*;۲ V5Tk,J[ kr}BHDB!*Z9 !bs?XONe_ L'ڵ ~V^co;FbСxXYZ>g%x<Օ "2*J/Wn덌 "0(+DH۱#LLLj Zi7ǣ8W~*н 8&V!GzqquzxILde=uUi77FFj'׮Bd>'go<O'%1ʖ);e˔ĥvf!a !EEG_{yyN!Mѻ#GAd&_؁,^\nͷE(1nX 87o?@-~2//+WŸb٣G4>b ;VB @h]yVCl\,bbqD|>j(:|H\ff{)(n4-Z:XXu^VŽ˸q --I/@TTi,rov]3v F= &&fպ[}N_G7⟓;ѡcO:@N/x7Bco3sըϞ = |TA MLB#;s;^|VǛN-, w~}rkat'. yeo{սŅ}km%V#=@T Sc#6IVZ:/{N&Umϙ v:]6jV2B+晿#"Nrdr:)캰F|WS[Mg[ C]xÀ ! _]I8VC BjN!FaD<@NjA!eп?D"3|:oT8L/J#|B5 ~XWc̏ЭkW|p!\]\ku/񲳵?z(hBb"pDEFB*cFcD (**0+VzRN .a!x%y5+cͭ!AؽU{ P*fEq *2̒;_Oб'Uj 9So\*ĭgp-<<Ӯ:E Dzk`"9iU+++uAJJ"e+iCu<`]YQcjJ`L$VB0kbb###|ϧ7 !6mƩ[/IJ#jm˲8^۳mbꖍ~ݟN*T)c3eo'g>vR$,6lBa!*9 7y[=IͩM=GJv6UjSDTov:}7~7ծ_(e·gl9Oږ8!#PBFWVfЖawdK 3uea(=.+P On̈Fvw[v)"eGB!LJj*r(tBeF̜3}( ( a:i;6R` VY>v 9GY3gB,jp NN4` 79Q*J8_SSZ:+\5" ==Q^מ#4޿'B)8.*V9ub T뺥|w+tZ$%F!)1 B)^CMGV.^c/`ie#~Zmt 4nw@q 6?a.R7?;o1d`jZoNnj I|%}n˿?7fll s>Vu(ݻ-4x61Xhwܟ/c0wɗK덕wW4?v}:` !v>uf߮'O322BЅs=?3߻k7\CQQ3ý}ɧ[zcZ2;x ̜1`|Ƭ qY1> <_7nP vͪptpЛs>rަM{{5ﭾ2y 7Yn0wӖ͸xŁ}̽x7j闰w+W̝8~zޘVô c 0Y=nggg,Y?7oq9\zkׯѣ}:[KJJO1QxK1Ny ޭ;F n0uH?{ 2d)=_Zwպ:묣Vk{׽-ZmmQֽF=k Nr]][QVDy(Z?o3GUhL^NJeM=n= ]/4X R9uM43_3*A*UP!ߵe˔Ej DNye>/gN$@ak\W\y!,ڂ[XXU0D/CTTy!5:.ߵ)ɳ1ߵIyT 'Mo|( ߹g>)9]:.ߵj7",,X1?{U o"OKwm(Nڂܼu+wljsM:y$Zݨ0rV,@Чm2]tr߯C[M}Nh{9W~Z)t }U-t:Y<Þ jR>:6-Fgs,-LjVZ#Ժ<efE&9G$קKNMNo{L,YZNjT./ʘV{дq?:ZVIRMNz\Xdtj2ۚv;}_QG2*' '8{7zoww{@|iCDDDZz5VY ǿAǠY֮ZR$''cڵؽg74ZË^^^nD|Ь[}rqa~_gгW޻a_v~ޡ-McX]{_+ٵcYW\ 68ry7lu?s>wFC|\vW;~*T{=?ò%#RJc톋ϞfWE1rZRv$}j~ܺM/ :]Q* W MBiI_ 8èsDFŝz[Z''w̞s.FM|r'uHD/XL谈rܠJ1,--$l?&JaiigޘVVc˯UZz&򸺺IBll޿ƴﲱ C111yZrKpuY3$Y$Zժy&&%!**oba%/}!6<*zy^>[9D^{m%7/FyɊL[+k %rKG^. Mu&4٢K #DdP*6+~yɫku:}fҲcG'wY2j2y,>m>mq&:+|1EWɓ\s{7:+|eь_$3o+9?֏ѩ[ dҐOymԩ5XTTV'j0qI'WmtC9\r?$2?t_5>=}*38y .]pqHdbTE*Sao;l,96\ԭG͞&MȪ;?2DI$;5l0JJ'DDD%L;h  O*yU0h`}[oc௱nZ8:8X1y$t ǥEŻQ=rl,qbq+!d5d+&R6Ysz< \eڡcSgfid܅=K5a 8oUlONSm sziS2t:Jg߾s#I'DDD%Lhhv]!ȣlYl߲_BBCw@lXnnno5زq œ ʣ¹e/0F}OT9:JKLƕQFfrW˓'w4`߾zfF%ϓ(eiaPeJSR^d$ +Ԫj@&`KqͨeTIn\|nBC.aɢ@ 866ſ`LDDzp,1I)eV׽hZ|eDoK.:_psk?ʹʃ.o$1-G14edII[6jieЗ0ƫ߇s4YzȊ/%-3rι-*n \BE08F[>i'Ш{r*A`>χKU4͹Чcmգ? X‫o?fJJW]xR|gDDo rQc}|(ADK;cͨY#\Çѧ<0C??>&N2H.QTرk'>iwӊ]֪ur?s^:m>urAm.a9ǩʗ-^x+_BVp+47u?:j:7_kTc& =cy.41\bPEZ{tOc1ư6N}퉜J_Ϊu*ȷdw߉/n.ދLNJаP>lCDo_R~:ԫ[W?,B|sѧW/=ݺA"W=qJ+Ih[t{Gq`vJލll[`_{?Y-6&n1 a|33*c߻wC^cܼqFeo`+ԮuOIy箋%CwwxJQ 'qk{']1o;۾-S}׹s+Uqs0xq*4eY\ >dbhׯ sig̘=ڍ w~0|HD>}*PDoDb~?rx5N|Eiq?|,SѺM/Gwp꯽Yh4FƦٳKaEF  o¼y,2 XZ:Keņ7ZZڼ! 欬^9J Fu)щmc@hJY[ܪO 0Wn) IDAT]-w.r!Z*bHsNmD7mHۚ$bAbK:seǮ3jȫjWcF+9{qw!IBQ}Ef"UαJ1ⶠ; {@Vpzshw )v%kn 4^6&J~jue`tBDDTg'TT ff&CermF?'1h;^ȀjUb-X|<ʖ5t:;uĜy󐞞^JV0h4Xr_Rvj8 'v|U^V|SeX0"k~eӏu"ݹ}.\X˖2߸Ąbpd-ng_Je0JBtsxJtrv‰86u*9.Amԧ;}\Rͤ0'o>rt9: OnedJҲ9ħb%*vD\WoȚXuGZSA׺kg-svD|]VEX-?vmI22Rwj~>79Me͉DE.勦UD /.8>M[;ww|Y'n<){k-Ced["1鄈ٶucKWBQ#_ sȡ7z ll\WTرk'w}C-~ dVNï{`ض8oT*e{gKI;1vT+l8ii:NEzzJUVs8^1zR)1ر}s ̞G4^VqD$MDDTBj}eŘdزm+ ++ ƏfK΂giaСVYLb0c֏w`?8 4V&oCTňzKG URZsLFx$%",2ܿ 䬄(|3͵Z /NgFQ\ժ7A/׽KsGX񂃃 4jbb ))G.?/49/jÍA?|ڮjneѨ۷ũ$nsϵSaXb~R)p`o178w6o4rU$F.O+pp TXj5GE([2lmaai<qxg#,1'g ~NDDD]S?ZZn!tuOOOgٿ.YIS3K?O/l⵳޵4MNoYZ=e"SUFR25Xׯ׺s}rlQFފPTTi\t:? 5{6Tl?zy|}:K^+[EQ5 3EVq\!Mwﱧ]_us=V{`ok'IGՉV^Żsnn4jGYj͹Owo}kj~1e˱D&Fj1RI+""1鄈>? H ~ G,^j1}oG8;cn;^|~:y2ʖ)#`D5Yj + ܸdPժ5F^g&k8o9tPu:=gOG*Ĩ1]/O$KKB?h&Msa0= 6j;;G ,, = .tAѥ4hڨ}S5Rw_f̋OR[I#fqF5Tk2j7F{_k K}sD&= L:'&tǤm, x_jLQkNGNjrp= s,VUIڿXga&mQc7av[>_pQljiY$T~$/L_|1M zaguMqZKPXu)>EL^PUh/։E"eߖg2@gT.yr*:1F zD%C,DLV#Sfi\u9X8ɬ.6){$Ɯ2*ϐ' }C$]MC sIDjYGJZˠ6~hu>~WLcea%HDbFR;*UjE,r&DM}Z:DDD%DhxgHoV:!"3&OXNü(zjضy /X'$t:v˖"==#<={Msft^50U~n-[V%N(Wt9РakdffI걶+tW=v97hUn=ϫ\jlh||cOPbU%ffn߀M) :_ADDDfJW\ :9/.ULU5;k靥>[|2k3͞qt:{FMJW։NNKgϙpbn&NYeVI"݁ rYMAJY[ܞ#Ԯjrn07/C~Z5A,7Td=bS3G'%+kL8E]T>:}n-rNyf <3;3K3ᤔŭ_qllJy.J51wA ǟ'w#----ѸI;t2e4yVw {B"ysE`$'C©t8;E^DG=F|3(Tpw_fff :"%%L̥+<+T :B|r'uHD͚aeBEDDo:hG]Tx=M[9}Io<#-3JHe.[I]JY߫|kT ӷ:݉wz]1wjT{)WfM\۵fOg(UnJT"NŗY>^->~><*/"vǵugB_xoTRz eEYYXni.Iv|R*lx:j "2$H!&NJ~-Ĉa0|0#""*/ѣUD'`affzoƜquyH6[cq(^yNY[9}H?nSvѻI'DDĤ"8RaKrm֦Kn)BDD/Ĵn/$""|EGGNWhqFش~Jn/5f 2sT@15-[xBu:8q:weK h !! 3Q@YαT 'DDoNJа0@fظn=sAgNcaHK7D"ڶiG0|0XZdWMоs' ӊO+W| *5$`TDDDDDC*r/cw߯wDPjUXaѫa Q ҉O"b ؾe <˗߹#&6V 9gcS[ow7a<^(l# jF#x 9@BRR \ OǨ~}1ʔ—= >;vDے[7wVQ0V{s\XxᴳUM71LhI'FBDjʸ-[m<@~}a:ϑbjj֨[h` /]Yt:qN9c?,r!)33 g c] '""""%N~ۏVOlfT@RklYӔܥgocqk;J'DDD&.==O>Տ}}999aMS~g3?0D"taa% ֬Fp$ :NHHU5칇P<^' Pr$  !!&p>m"e`-RE?w}FTĪ+a:T\` 1c֏HLJ(B"""""""""̄҉ҥKc:b8nܼ DAa:T8ףi&8>a58C"{nhӺ5VY{@RRR0w IDATrFCDdR)/XOڴr 2;'`doF ذv*Wd 3or@?|"""""""S:DDD&(,,\s aii)`4DD ̓MوQ#1\iZ_M{^\JdVcN İ!CUH$Gn[/X(tDsrr:"""""""=Q: """C7ks tXt 6m٢Řڹpa)))Xf vmК *VI'EEGDDDDDJ|.*z^?%''cyg\|Y(c  ͑t:DDC??Y666#;[dee aooɓ&a=hؠP#G"22R$c  +`$DDF auFLRޞزqV._mAоs'̙7iiEHDDDDDDDDD%NLHbRbco!"zwԨ^[7m~33f_ĕWJ&а0ϖ()`4DDlٰr}#&&F>Θ1{ٵ35>r$">(B"""""""""2uL:!""2!aI'>w[W?C#"LժVŶ[r x-k-t:u˖"==]TJ ^LJuGGGlٸu=z#<<\Ȅ:qF?TbMhߩ#V+`DDDDDDDDDdJtBDDd"cLJI'DDoL&ÆkAfx7np,-,0G{n稸~D޽p5$"""""""""S! qS'tDDD㋯z;mGڵR0qw8q~ +.C&MLx3>]7L2DhӺ5;e˔(:a;V: "zի[&L: ""zG;ӄH"ީ9fCL93!"""C!aab1T0"9_3gCB#yGP8իW-[pI,\Ϣt:8qAOW_a׃amm-poGZZ޻+tDsqq:"""""""=&줓ʽ7LD,Ə3fVfm۷xlܷbѩcG#H$B6mײ%vڅ5!##6!00GF!?Ȕ^BDDDoCXJ'>FBD~D4~ƍhtصSL%#Qtl $&6SME^pu$""""""""NLNCxx~#`4DDﷁBAaμyHMMÄOp..3{6z}s7H2|C֭1aܷpww0ҷ}BADﰧOi݅(_L:!""2ǾL:!"W={rjd*Pg5-[qI,XQQQ'RqNK }s$b ,,7J>!""2aac__!"Zd"HRMO?A Dhۦ  K233jjG&а:pqv0""zGa{NZ02biiÆ᷀@tl"H-&&SME޽p $""""""""׍I'DDD& 4,T3͛cݚFLRL+̞]wvZnݾbԩ(B"""""""""ztBDDdBò ~zشa#sA0t0 iU&vnێҥKu:aP2iDc r9co&jUb-puu]|d#3M":tc>t,r(R(Xf5u#tFJDDDDDDDDD/I'DDD 1J'DD&bŊرu+<˗߀02eeeÆᷣؾhL6 2h5GDDDDDDDDD%NZG*b CDDE*^6o~ӯ/'N%I'DDDRTx~]j""25VVVX|>~.%%_׮ Y`mmÆȁhۦ0 BXM"""""""""2L:!""Rc__!"!Jx"tQ?'OKC YQ|y,^oaKѭǗDWOR(a0" ++`[_2+ioqP**G  KՉ p7;^pɹ7(TlTYdfi_%bmƛ<_F!J[yPr7Cy%"*tBDD$аP2 nnnFCDDo_K?Y#FDzBK;;;=]:uƂEt:H>r$6iI&JFu_][7N-pB"qqr/@inhպ\u>"[xp>Gqv%P'HKˮggҥћ3$">;^-WdUhuONW h L3'q_,_4}"dLDD1鄈H 9*T H$`4DD&5loÐ 8l9nPBZ/\p}.ۗ_K=r S/}ؿoGCоאJ- \mO-&iub=sD?nI)`DDDDDowM$IN(]e#Ke)"Kq1d 2Ad){DEDE@dUHRJ tMI~`CC:hI{:u>yɝRM^솂Lk^?:w,ֿ]ȇBf""z7'""HޕNBBQeW~}l۲nOVJ9= IEiݪ~G̛3פ$''?ك{aǮ]tn3>YhÉ\^QދYr|j4j l8UpBDDDDBFk͆""l 3q}8$M'DDUAo݆Qc &jo1ͺpuu8aeee~o]`&T,^Mڷ8msI,[:YfGNoQѸt(Ο?`0rJA#%/zr%7l>'58?|܎m|?~0;arI+,Z>&uo@x+W*949;߱a"9}ww"[ԲgN>ӼNSy,s @ 3iHNNNͷxeKc-66  R)`ʥuV㏘1m:2 vA ڷw-<4Uy /QI^Zwǧ /›s}ã6NÕxvb Ogͯᄈ*tBDD$+pk"kW&O©ӏILLБ#5hҤ ++++3x0zu6LRSSxGLڵm+pڊ#-5~lR? .yo@y#"HcT\@bb,Nn?"NQ7uIqLV 66Q&jׯ>eυ86]" ovÞM.T;h%$dsRTYmbluZu'!^wG`:oq{)ELw6J*5JXd(,¹r'^YeLM,Njg]-l\7e9eI7;}v\`B3Kw%8Ef"}jc߈uAhѢ+:w} 5Ll\v*c܁CwzgMDDD3sp׿~ۙdv=iU߮}XVq%d߹T C jzˉ#_7k:ynORe67#[Dhl3]FvעjiTlrz'sˑ"~?oY~5*uvut6v6^u}/K߱)FMl?Z57鄈E޹:!!l:!"ꬭtdRٻ ｇ//AΝNXcu8v8111ǎ8gNc`xwD-yԉc{j]^}[$?aǶϠ~Afbb,֯Nb»![;W.׫&#=/uu wnf ZQjȲwmזiBZfۄ̶gb1l\@wix]U$JNo Z<ލz.Q"FA,)WMyZs; c C{}genʴM/,qY:ȸ]Tn_wKi#"* e+QwkuŘ7 2XjT(:}`ƴ&%999ЭGwص˸=a4ߏ0 BPPSUlG[7/$ӧcOK-S荳Xtl 'R }*]+Gui4U"e䭫5Z߈ߟR,e_߳`·GzUsU4 y h8c%D"Ql`  j8ULfU/XNR&! >|MDHU.(D"DDTp""2T{zzY4DDTD"|4e \]\ʯ:s}Uz:U$, ^=z`݆ nw&,^ 4 -78muެVދ$8szqܬ+hӶٚ,(?lsϝh۾ś}rrfLh5 ;C6=Pf vK#h߶)ˏQjHR8x"AM'jhܤ N36 zq`śNn\?c >f5kA͚uж]/hqTn69{*UI-[4{#`RҹܻP(f6m@.TqԨ^ä9h<<V5Ylnff\ptt4egg#+++~t0kgg ԑfVY==#Vְ}{mtxGwqNDXCqF;~f W/^2޽Ef^ߍP 1uvfs g2>JҤV'ػgD"K~{wo?"~]Ao6th돩'cfߟ ߘ]x1ͤ&q ?˾Ҭm7o1Κ1z4ztln=ĉf ﾋw"Mj!AXb+W?Mjlo`5qo zMg n_n޹ ȕ"Xk%;J:Aq~>?w4[[+IRfUPl$q~nGZy;F$Bm-NTg4Di)5֙tT9;s7kYz5dvW2[bS2,Hl=u*;IDDT'oɤ2xs5^l݈#5 Ͽ< 5\jjk`ޜM̘= H*3jʬf]-`o_k 2i:IKM*dvUn3_Gv.PEK+RtγH>\>r QisWs_jիW7}>$߹ 7g2ժUC74׮]۬&HۤIk.fժY+߹-57[ţWۧ6^լ*.\ooX,wnݐ/ZhӺ٪&|~PgzW3֭Zeug5H\ھhܨ\L?|zyy~=ՙ z}fs6Hl,nJ !33<5j5k4=*K.\f67;W 5A$2kJO7W^1WJJrsǛoŞs<=?􌌧z@FkNV:+[ LN[mnZfTZlh,$+[q7!6Gocc-ߵJCF;tؐA]~ޱXܳy'e! ^Ǖ^($~xzE|Ef$KcѦwGyǏTY/rpӒCDTB^3=,aGjiִ)o*l ""Pn)3~Vm͛5Úի!{k*?Y3!a0{ ǠӄUfL녨;&-ۯy,l۲Фcpw$GS!&I#}EWf8yɕݺðs =fdǟߍW0%} ot} ..[WM©OV9"Lńchۦ VRXDDTrBm +'*.>%[cи,l+k5.r6[r;6q/m()XUMfwVu5_`.qlXcכSZN`0^YS]~י}\47.%cUnw*QI Yupе嚜׎-%MDT͆n4iJ'DDDe(:ZnHoيQc ..pE5 ֭/JHqIU&_8VeIy'כֿXU̒ n Z#Yc-##{=Fۣnr9W'""Sfѳ&>nK Y}.l79WTs`I4MΈozn<}+o wy~}9:IWD#u-em!kt%gh~yF?J(瑫w1tluG+-ݏOJ9*"6eX!A!";nT><22 0ۆP\ìھuM- ud7t| D!&:  `8[t)DDDdIc?rlZ{yW3ЭUg}?2QtirFV#`1&~{d_M 2Ű鄈( `nCDDaooWq@ZZFU+BVNHw}au'QwBW_dTlmQ~+ԫ oYYj\r܁gMtyms/""lx< 'Vb:. 9>+IBh>8pj/݈N|3oC_? k+q4Oƪ GIΓR踪J`& ?gZ=|щ1=R2:MTeݙ 9[;nCDDTz=#" 6X[[c׍5Z ｋ0Uf;1>K$$$;;ت| o fNsJFDDD_2H]f_nމ98գ^>XUNӵo80g핼=)Tn5%9ϣԬG9sfiy {5!#^(E鄈 ܽ{O J'DDda ǐ6ֲ1iɨz6.?""@Hh^ o@ZLـDbm2fgJ."""*ըx;N=M/:XIB*|Fwi8_˷,kQ5sDQZfS&jsYz"o-UvVF L ܳ6[J7tBDDA$aG05N9s`O? *#WWt}mNSѨ--r.*}"~+ηx5Puiֺg9*D,eO:WD"юcK]h-Jsskgm$Ou*\DD%e%t""@ĭF *#F.`NǼ RaİaBǣJQ}cH,6ܥv$VM^`z,'#(TU9;W/p񥒉Dť riPy>+4u͘"4H-L7,JHJFIC7Z\E ZcޱU3NR;zuN̕}W|/W~%p2Lex`mm>;"¯`쾸vdy~V,?ܼ_ofl;ӄd1?Y#}\\lBo17(p~mz&Q7W%"""z bPOgE":7uۢSƵ;ONI,t 95KߝR|Yyo*u+OƮ?.4,qa)1i֪9'e oW.P%"*M\鄈 (OVL:DDTV&2fΞ+*oڼ=s!y4ÄwU(,t(7hN/GFT-s%p0Ο; ^＂} S^69l\nnаQ|*N؇=?D/m^hּ3RBQ*.bkvvxU ֶjH賡{U+.nJz8,kwG :afW [I"%]k5u߽.I^]no")Zjе7&Ml Y7;%ǧʱИҍ$2Y)[,߬BDߝ .%#E"`-uU5w^7py&G疧lߡ_St^f󹰙1Z{y9' *DT%鄈%%%!Qq̦""*CݻuTS K? ,Z)$Jq u׫&!3gz,D"<<|T >6Euy\hϜX_M'Ց^9WC"B-`Շ{-dHMy)/!*9:Ц ڿ`݋ x'wn∈zE'2&Endghogddj]RTuSNo,uo9zġϚ+UixF[_) hM5y֒34M>}偋=]d2{̬YlJFTu&HmWcqϚ*Qef\rvD{[M.Ffg&9M$UV`j](|ݜ~չQxA痈E5kr!2nbnMӻ t6,6c^jø.,"""RvK0s{""*[ڿ c{!=#ہHOOǗ_,-/X׬yg,Z+6w{gcc=G>-IAԝPD }c tTwFxe܋)}v"""2&&2J,V1dvwyGm&ݙ49:ܺ`JHl:D":5YR>rd|DOF  #/W_['v_[ԼUc_6KHl)JR&""*e -9Sijެ6oggc;a22 1xz_?ۛW10h ,䅎]Jt?fނoZI^r|>]z9_uT%HSݜ'o3oX:%ukpNݜ'e8g9VʯZIJԉc-' l79ˬsysu IDAT98O~y[$MMefxsE:Yjȧz7IZXdo˜}FU>{Q#3[gә~[Xn" z t""ʬw>wcNDDDU0jDGGkv7pQCdߡÇ1c, t1O:V@V!SR3$5(22ҠѨ ܋ !"жMjб .tHΑ~0]"3]sYRJm}12ޥOڄ0Umʲq7Y#]"X"$ ?0o+,Qw` ;lqc} M|5kqH xTQDDDDeB`kj:Ki&wvm[mb(AUbODDT""¡=Yv=8M'DDT>T^6oAF{cب%\0"""""""""0tBDDT X,F@rtt ߠuVZll, R!`2"""""""""tBDDTaONj׮ spp_㕗_6֒0lH\rYdDDDDDDDDDTޱ鄈]$[Q9ecc˖^5JQc3&#""""""""M'DDD`0 <<80 Q$ .X75ֲ0paQyŦ""Rt8$8D4DDDEŘ7g.F fiZLY`DDDDDDDDDT.鄈(JqH!"O$aʤɘƚNymvQyæ""R {tkxF9?XF˖˕_ 6['M'!!uLBDDT2A"k6og?`0l:!""*%yW:˭uѽ;V }f}1t:ɈHhl:!""*)))3tBDDWaZHRcc)0 M'DDD@TC Up-oѣx҇0 M'DDD :v+\""" iPm5NaqP ""R̳I``H$YN`@vlێ5kk/]ˆQ#,`2"""""""""*kl:!""*4pk""ljz{cm 0n޺!ÇÇ&#""""""""d%t""FΝ;qHNqQ[6nqP*wCb7ߠ q9cQ%f @l:!""۷j`6Qꊭ6a0d0|n=NXRS!51u,LPD"0 Qظaڶic=zCGWLVDD"x㍷2 Q>tBDDda0~Z LCDDTfjtXKKKècpY"?|7ު܍]'DDDDDDTq{""" S(4Wm˖~ycﾟ{bbt~ -NpB *L"ȈM'DDDd0 3CLCDDT$b1̛\m;1yT,-pgee\.t """"""""rYЃX!!!""*{"ӦN>4tz=fϝv ,M'DDDP(L\鄈#F`Dx]NdDDDDDDDDDd)l:!"" Ri AO!H5˕_ ,M'DDD {tUN={_X۴y3|)zɈy鄈ȂʼM'!&!""*?^ V|;;;cY3#`2"""""""""zl:!""J\鄈Ȩ}vfze2c?&!K0N,DT`0utBDDdYӦؼq\]\'c܄HH0N,Ddkkkk |W.o wwwc 1z4SRLFDDDDDDDDDŦ""" Q*Ì`mm-`"";mCmc-44CxQq鄈BJ~HpI?/O/غ AAA2l(bbbLFDDDDDDDDDϊM'DDDp;280 QPZ5l۴M76ݿw CxDɈYX 2 Fc2r9::boqY@£ 1׬E Nh*''YYB * vvvB """""""""ȻH$BpW:!""zVXj5>1G:HMM1UxeK>q1c,cQֶMj1p{"""P*Ì<=(`""_.[_{XS՘޻8u ` oexAq""" ȻIp0W9!""* XO/\&Î]YYYxx"t 0ʊ )l:!""Ri"`""M$aƴv:VŴӑ7xC]DTiٸ/BDDDDDDDb sz!SR UǏ-VZ ^y #=]aC Ϩm4x1{ (_bUty 1sfφXWW//Ǘ+8l:!""znO֑Ie0 Q2_,Y9,Թif|"zN2IIHH0D"i*VX;[[cݻ1㏡LFDDDDDDDDT鄈9)yNQR_2X7|0y4Ɉ.6=Z{ Un-7oc7q"jɈ&6=ez8J'DDD~ضe ܌saQHMM0Qæ""PK$ jPV-c:b8%ja sP)akk+`""7vl݊:u 9qqq&#"""""""":tBDD >!""*[5MѨaCcNT6Qw j` Q zGDA!""ob˖Zll, RQȑDDDDDDDDDtBDDTBwe rpp_}vZbb"+Wrc Q )JqH!""VݺjT*7gΞ0QŦ""R=i:qwwiK,oaeffb{#&#""""""""tBDDTB x?[ ~CkZS>.Q%Ħ""ʻNHN H'ck:s};w r:QED8+;#G-Y ^%_,ţG& )TqTTc;{]LDUGB=Z^HU\U#?hE0lWZw%:^0];viڇx%=.Dz 厛HvkDT^7^""y8$$D$DDDTAB&a9tM7Ci 8C{HMy-!9A&wFj%BG,?~|zMNob܄&Nv4- DDDDdۏݪ)ܱD,Rl߳$W׼~3KOo ם<WDT^鄈J񾽽=jլ)`"""*L=!0eGh_vAC,.;jٸr.? ŭx0R6Fppsi?NOOA눌h%t OOz""""*%]k[~KL>xi.GDDT6R4VUe:v5k ##=HO-UX߷6#%%ᙎgpg E=\EVvUDF@y1ӽ6ONPst;pNBЃDUP*+(]7 cc%N/ˌT<6[B3׽+d&"V>U#""*aauLBDDDϪeͷ;aUl:!""*0z8$$D4DDDT\ue&;qqq /bĨQذn=\wY0 &uX."Qݿۑܙ]b/{YJǡc\?;""""DZu.,Q M܌}OQ!d""*\O$JD,F@QIbm5v >^8M > o _;M~lp]og;ށ}څ}{BJ~cϯ?zu/SUI^lDDDDDH{R0/gYXڮaUz:I] 0T^jRDsѳi2IIm__ J۷lŘP*xgPl |||4OFF*~t:IQ;r՝NZ(Rfd(CĽQzsOD8@,{vAY]tϴM/_'yrMi~˧𒩗.#GM߸W]p-~ͻdPL%b @;x/^TMx7O%))ZΖoEZ~=).>aW+=q'3}+Ͽyާ8h>Y'vcz{f~:N'b48! ^O~$>lظADD n̑5Ɋ_մZych:569٢ [ʊc>PBC#<&;;C qppg kk}JI>E @4ZHll 2A""b]b#GcEݟsX||=^HfNee߷QNHyyjN8L'Aa.αcb2Zǝ;w_޾m$oRSmZ#A]o!Fcd۝gޢRP ?"'Zn8ZCHv!)(ȖʊRы_ta0DZ]@{_S#:鷌S|KG{ &͛ N*]XZh6͊J-&OD'wƧy0INiǻpxe)Xk>:mahOaq.+][/+@NAHݸo1YMpkFxvIn9xRqy-g 0;WL!*S)2oMwL;>Y'֤(*E{ј_j2wsBtZ45ΑRO7@V CmXh(:K-7mx̖zhlYܣhs@TX`IYCSQ69nӫFJ+~nEDzwjv*k'=R_Vݣ֬FhCGcb݂5]33`HO 2Yˊ+EDL.yeWQjkv1cIT>qۻ ea_)j|,IIf_w?iȚ?ɷ^[Frfə7~zYX[fusUy3-l jjn~Y+mrU{+;nX4{+ lQT}iݝ"E"YT!2x\=r;5u[!zӆnDI帺qL&PDyG{j9ٱeU#/?S7}w YEqㅷ;^x[S_?$".%;_x4|(i]T1iSZ?okK8ym]{vy &̓rﱂL)9RXi[s5R3^zW[]֮ɑRw8o߱Ճ,5 %gʢ]?ą:%@+-b7f{:Nxu~4k`0}/i}:&N>&)E>p|cN*qï򯧯3B<Y&'u",xhܱH}N3*DE]SᱽzHW,'ϝ-{o6pb(W5\1$K雷SwXDdgUNXiS͹7Y+lDpH*ܙwos7bRr~^J*j8uət43*&?~gJ37C78UX^56=&߿>Wvye^Y?_5T;-W翲H'ů&Qf[}4>Gj1to}}gUl.pbd?^x--y-\OhZ 5-z;88X:uQ瞓nZ3_:CBAA?fWӿNnj!=Vt!c'o/Ka(| ϟNΑ0X)#D_Sc_S6oZҪ7jWC{jF mi}ǝ-IUUE`([VƝe!Iwҭ[ID$-mŏ@{4,6[.xbCU^eLW3|78#_`GƉ l'EuG˟+5kxV.9wMkAJz &>WR9}jcϽZ󛋷RZQ.w|♶5F];TT/k͖9Kw;m9m]r}g9x;RݖNhW;>+oET~ jeς IDATy|2x6W2ۉEՃ>==K*j&zu \AZM#-X=spϓ6꥟6`nhRRC' n\ 8]T*rW!*ٴ79[7jy2>|ӃS;qo֍-d[ {m|h_tc0߭IzsK7:s+n>Z1vZ]14>|EdVIE[ƬZ%h_}g~էDIeC'1""j&&4ν1yFs}z{?_5imk2k$.dH\R}__u򮌼LfK]xB`.ߝz /{Tb"W1VcY/+˵DžxWxM4nն;lۆFsۆ/"՜xAxnAo{y?߷ dL5_Յ-NL@C5O]Ƭßlhg$t ?/ܚ_6x':=~ ۭplnƈN~Y_h(Z[s 7mxLVcG%t{kG.8-H_ʍcהL+_V5ӕ{bnkupQIIȫ=!q_^VEL&SnRn9Nnmv~4O']{f't:O7GTf6eʖshjI&% rn}cno,_3[Nnq)3lǗisӇ<;|bϕ jQng[Cb>sYj3Vj ؚЯG}ϱ՘̝>mgӻzŢx׍=Wxc[ sŃVT5u5CMmgadKסRj2'?jhxɮޮ%='0jm_d拈<}ms-cn[ek实st:E))vxB't_zt:b2oXDiqvͨl>W_,ƌ._/Ixxso>u[j=_QSdILlRrHHHxI8^:Iii q]3!ӘIc[Wi4Z>o[kwy(b6%%5U}.L&y1|0‹s~(yv[out29lWj48ݵkfCnZvN|s/|NLfy$P򫯤PDD""9L.zܵIzz]MQ˭70wi&%8ȾO^~,Za1c$.6֮fX/p(F:^;ZbBBBwu69r]MV˕3f8=xܹӡ>y$ V92d􌊲Y,mtvHnظA+j2|0,kjZ&M0رc狈5J~~vټ_OT*DGGKX}OQٴyyt,={:ؽg ^'}u{(T*1|'NHaǜǮVUUtn׮]%(0Ю(ÿ""AAs!##Cj>N?9R\lHR9 "RT\,999)zΝ[FQlDT'((H|}}ꙙ5_??υsmNt s[T\,JzDDCh4Jl^'"{OpkF1}"ۭs06fXR/ -YKB4wf]#ڨ{^r+^(Z~`5-Y4j2uP/Zs`p]-rPSh\dh3prE+>֊g__697'_DQQ:n?*"[GqLBcs.p]~NjMq0F1cɯ>֮/W]wQq)E֮ٮ6vu0i~GۍgVZ]#G~fY $9Nfݜ:NC'W& t:Ynp]id߁g9/zC$Dӹ={9 8{뜆N/KJJr:Yb,ɮݻwv3!ttnHHCb6;{̙NC'~4We p:eBv5N4teyw̴ Cy; g8nǥ䓏>vwkܿuwAkqc;̨hyc$O%oCo_nZH磏JyykR]u܆:.Lۇxԍt>l<3ugGD8eH83ȍ7 Ev0[nM4!Ǘ$!zPsw>}w%Prmooy3iRPX`W 1c$8$خNP 5Ri8٭RwՕAIcĉҿ_?ZDnN2D4Z FB{11N[G@@\8guTN&$8v#5ra٣>}zKE}W>e8OFP١q:IP47)܍.O)2>h1-^/}=^i N_8崫JD1+WUMmSը+}i-tkq/Ժu TjKmO""݂Zs.Zxyf%0q׺燈ȘE[˪/wɻHD ,zЮ & ?G ʣ ˪jfYklb@.jt.:Fn&fsJzgs|1leDc2նrU%JO?+-Uk(wM}A o㯴 lټLnߍvO1evl$"C~]ٷwKkTVXڣҺ^0m 2T늑}˪u5EQt .֧Ty 7 *tIn!jٮ}S֜sﱴ'E<Rӈ {E﫸H^@6/uvΛv_КUMvIJc@cs8-l#IQyՠ{6=V{_}׷kܒ_^5\"J+k .H?xPL# ,tR^V䆕tLZi;rp]mv)OﱣλTEkl޴DƟＳ v1)&:\bƕsMl@릐MjAtLz}Cmҭ[ ,'DDDQYz\uCv֮o-NpHoK9v㘘ӵk&fYh'ޞA>[¶>nAwL5rص"VDdczNiSU -pB7Ѫ5"Z׷ZUaxI`CKQϚ6mWgj(j:DﵳW-SGolhwϝFƆ _%"DD7J*v0fEYQΊ:Mq͆:c[rUǡy#;"6!c%".C'"" ]n[89aEv[t [O]Aamm\OZ89We67u׹UVv[ g889.dْ/EQ,nX Fٮ{Ko?s" zlЯ8l.1]mFs+(@pz`3;&JmRe4Z/]}eNbKB>lk;3Mm=4>oMSsG m*6.%4 HMC@``tܹ-hڙ:Կ:M#%y|:Nݸp.1r f/}ݳ5O算S]ie7Zwܽ6 Y->AK^}j{]9pJksQ/WWddRSS{OOo9j WUUHZk(Ey@YkeXŮ]`|w0+mkG˦w^1='p[w]17id>Mz{~*2vi9< 5DŶS|+ &ˆmi%ucEDUɓ^e˰Z%frӸ>.!]C]=o|lQ|\5?))lN}EvoUUҭ/HyyRlXH}x|Kg˾ Z[ w/EEoXԴ T*YR9 /p߷k:$ϝ-.hmGZ'Y'ڰ(vzIjkk9$$9S5zNz^mmvQ ׎Okd[\?Ojʺe;_/+rJ|ŚMKy9p´♶Ե0W8rԶ-=?UTucES=o]u[Frshm%Og¶[|9B'rcv+dVȺ=%طcDDE5_-cphByyXqn\ 8ʬ'?}8f&mged@I=L;F,erٱٱcƼo^ʊR8qԡpG.=jEÆ_(˖~i8&?:U3MB"$ D4NVzpFɵ=*~VZZ />9E.r ZplC{ZٲiEQ$6n`-3+e -N約Fc.Kv Anya&W߷Ie9rxu̮ 8(˪F[c莆1#oKg]lQ|l?ܶM㽓ZS!J.[RY_Qt|̮thmn\USYUSv΀i9p缪69K߾zt[NhlQT,ݕƴK 5DD4jUJ5-- sNhBJj(J:-,<7ԔvUUUȚ?ʚ?Zk~~hu3>uHaaNlۺ:K>#$&f^xS›,myj5&Q]k 1uv^?x8XA%6XMmdcg/"MD| ˫j͖>zod֗15&uBO`tb=kHnWo/jLRY2h@{w\wwwVQUVUߟ)#XZjJ5jul3Z E>-)y|OVI+6ھZ]x/g=Ʒ_b}XQ]{ߟ@WV]Yc4ѶgQ&[ mja@[KZCz"(CVN|&_=Zc)%weCcߟ:ݓRj7e={gp軂^C6~> [ڿ{O~Б\yՒr2>ctyܼ"NWYO>!"("S*3gEQp>II*G$K^q)+-ZQ4j/@G&Hll?NJ65,+_󏙼UjkֱF޽N%;ZAav8W*+ˬ.=\vVnQ˴B$G˷aT抡L v۸9SSc䭲&9~xn,mcZHضu ϊ{'HmƬs$4WRY]aDNNiWp2CL_kVŢժ5Zy<:_{iv|򀨼}] bF,p2GT1Y,EՔxi!z#:o}!{mym.%t;2oBdz{e$Iԍ JK kQ(8h4= a2db4ͫ 8[8 8t5p""w*B'4"%-z[RI\lӭ HM߮[׮gB'4"%5zu{NhD:qn\ p!tR\RbŻq5ه Nڍ^E'RRSzt wjt/*ʍ>Npa=B'4PYY)YYYq|!B'4&:NHHpjHIIh4ݫW@jZvttxxxq5ى Yo'ǻq%Kp61[,rA8 hbp3^"tÇKuu7-R-܂uj7sJNV:ҥq5lR`#9>tƕDG{:]ݽ`ö Ш#eȑ^pVP{- 򥰰:#t4 IZGN'@Sm___pjf'j5?&p5 v:IH`k)Nj9vuGh D$5-MuLiNu4jDǸq5ُ "fSܸGIMKfkyNbt8> B'cb0D:"tl B'/5>t)TBBBܸ} tRlB' l KIIfk5NZQq[NW:th]NDD .!tRRS$G7h?:ԴI\lhh\5@fNB|W/Nh#GZn\ о:tXb2B':TmZ-qn\ о:tXiǍB'+զIB|W?N(fǻq5@C!effJyEu@hB')5-nLe:usXW?NRJjvD7h:uZh)B'\rss87h:dQ:NOpj IIZCzFEo1@;EᤤՇNbcbDպq5@DᤤևNZhB'V22287h:C: :NJJJ:*Jt@V:ܸ֭"tPRRӬZh=B'%-6t:@k:t9RRRbh=B'#fkx7h:m^/]tqj Ht(*ʍ7B'öIB[ C,8! p*:4Q:sjOp&n$WWګyyww/@)$%%{@f+Zt:Wګݻwˬ'p2t`G~@D:N'lNͮ}pƨT^yfY:d'Żq5\ADp6"t8e>,555qBwaQ_w}DY4RsOMM2Rs)[\r̲4]K44s}eQaf? ; ̌|9};30s漄TQoY abq!NZ B!B B!u:҈!BH } |Z awB!B W B{{{ٹWC!B!B!BH@E'B꼤䤊:B!B!B!T*:!R%&iJ!B!B!B;BH8'a!5B!B!B!B*:!R%iu9 !B!B!B!ՅN!i[׷WC!B!B!BHAE'B4N'!`WC!B!B!BHAE'BĤĊ:B!B!B!T*:!Rgd2llkz95bܘv$ǟ| QmkpE۶.=U7{eWD!Bt-tc>]aؐ5_߹?,t(?rڻ>l|U,}9s"$Y B!z~BokŲǍ6th[ec!\TtB!NJHJS !Bj`z[LJw Hde!#//e5,.B!JBkBHUtWW\ !Birs3r$z?#h* Jq \;˗!??aB!*;UL^!b**:!R'%%?-: B! ?@(ZqB( 66jȨ>b&n8ׁa慠H5Asv?bϮf_!B!af8ۉ}#\ Muq7,uC!RP !:)1Q脶!BH- Iw0'&ʬs1 ZCzKyݬ!B!i;gԫc IqQz!@E' gH IDATB꜂VR !Bj;CTpb{7D7)/(3C!B\49LB!B!uNbR"8,!Bȋ/?/K/ְaT nhHNQT89 1M;ͻbY 9*!lgjv9e!??,Xx"B dR:4C&.lX!Be;]PT9(j;B^F^.o IqsUzuFKJ2HXhc:g۶X-gŇ(,yU.Ol+}Q1ݢ4qM JdRIa6"aUa0SsU,ZsfԃLPDBO'̷;_lT&'?H"W;IJ'+>ZXbhxȫa.\#!ϨBH ׯB!F\Zn,Cb(60<4owޝp*+bϮ8z/>60 F_мEJϩѨ1pŊ@ Ĭo 88aQTSsuE/eԊc?FGs<\8ѥۛx}x"Yݻ7/BPwsD61pЄ*0jd Ϝ>nnXl 'B i}WYP*eYXMt>zKdkzjŇ]vy .lc %hfa٤ܘˮzJ%RqXw<>uϺFt>l(j Lp!eF.ŠrB}v}6_ye}ga7侯kۆ 6l&DF+n6ˁ-柊6aѿcs{wlPBu}T8@8莽UNv>leyN'f.qixz~igFco(Fpzڀ֎PyOkLaEzBF[1Ď FT^M/BnIONBCB!⳶/0ɨ^2Y).~[3h 0 65ܱʢn8OwֿWZpd>)nbј=M"8:UT*%/ؤ˖|)8b'~;ΝmJKc L'25JV._'+-8GǿÇ6'k$BHְ̀;q΢|e'ZXI1fMk4zE/wty f}u0CtBc'jS~sJ͝ڼ3*+8)'W=o>`-YYqts0;/rʃu Nm9h cYr$m[x<鰑0P Ba8UⲗF|J];'Є>>+1"%×QV|[$rÙ [j( &W=7J7c6n>ak7W$U\ 璧_\cv{Uce:||\@;c+"[amxOu2g.K ]w䬉 kcvdv{} A@v5? B!:H{VqJE'B%#ZaNnCHh3eh vس{5\t1;׃,7p8ur~kӏͻV9Ͻױb٧P]?ŠGi{{gh4j>…{/(--J>w4MTt{?۷-]t=G]ߝ;ubN,:^7kV&bْP*|]acKI .#;A؂l̝BY畓q;<'&Z۫o}k@\Ą8|O]vW2{W;#~wḠ/ -!gK/%Cۅ]nȻu"r_ӎ&n[E^jX{۔b)W?Y*_\e_36m `GwN,Fg݉;A/?BP$F;B-?vsة?^w`O\_$ Qk؊bBUGگʊb{|'WiDž|^A-[Rl>ae;?uՔe\ ˊ\I*eWZ4.&d ;UjL=4sc[]څC>hvsl|MUקmé2>yq}׿i|wlP6*KŜ/U;#7|ĝk{ku\p]G r.컚5qQe+I1|h_chE쿞X+HPcoWHHCE'B{r> B!NNi׮,?OÙ;ѵ0DF3{{'vvNr:4 vf4Ehޢ-JYqokBxD+* \eK N>nQ?^7;y"͊& 0|  /W\l{w}PR>lRc-tM1E^ic+sDNѪuO,] =Sw _Ѝc5O8I݊Hm|Gݶ aԣm;?L)a^I;._3ae vNtg4>bc*|Gi9ocYV_~)p|Z7] /5zְkON)a6o8C_wQ$G[Q^lR^1u܌{WRs>Һ>7?.t.Uu9\ңq1SDy?̩"wQJD{D?y}׾Iڏ_sґ/ם1>`mNls*"mC!NZQpp%لB!/oN w.aɢyO[ Ξم4[0<|>gbw q`J?78nC>58xbʗkYϟ?tp= 򳍌|>1J?DReY / +b<?YG'J2aah܏F;O ;&|A 3KuPzX[':tʤϲj]#!Ry sre9rsE)vO?dž׫J1,^ =| t})GC'tN.l: lRSB}\6*8ַyP֔~-'yT+쾒ApavV$Ly̫3t N9 U|wQT B\;n6cX+.R7Õ_-Վl9e\Sy'ul>.cbMgY:1kxSS jDD;Ol;fWT& #Yؿo-.Lx#G4üGb_x//BU'y^Dz,sw4 )xP8thC\]0vBNtr2hUqg#j{#gs֩PJ?0ە# J֥zɹ{PRRPmk$Bj+“Jq,(zփ/?Ìh[Qkr:)W΍Rjj-Ia䬂ڱ;wT~wwWugmZ4k(FXTĝ cc6` [,56ǰ߽~+֎_ӿqs+*:,[&͸t7˹>FHq1l{|23f|7|Ϋ|1[9Am (x?5-{z"E1M;u9{zWc:9K''&\[~|gCLFxϴ]gp/[[tݻQ ànP*xA6!“څ'XW"Uǧ翷Ul{I_?{ rkD)ڱN77M^vS?{p<S{%\+ǮW'lzbxyp^)7Jl\FEo F9(Wݧn<3Eas֟=eيn>xsljgȾԦ?F wۮ+5;Ym?+oaYNŮQ 6A軷nvWBB3Xݻw+CCMB!E(!8YEbev~K@`c uEt3'v7$ C}[$v_fp1fzY61ׯEC~~'MvGD6Ӧmo;eF͗tsܢLpqlj{ !G'+S5.yoZ5x~Yۺ"& [rH >yO{b,ߐA3|9^N2OGڱ"iܝR|j ?r+3u^sI"koFqZXvpȤ(Snb}5*0it=XVuSouh|L'컚b>ăbι^ͯ7AjZ;V(׶I6TtB!HOOG8,4WC!l|>:u9scђcxwLl.&vM폼Gy/F=APNs޽9''w k2|>OHT*QP3~hmŘ=FqPHoD+WkyP:Bv4%x2EHrfu,n9eՄߎuk|9rKdz|ױL*wgHk;ي,hP}2Hy%2 q~vb"D,UuN~W8ѡo j!c&esMv惜9%vڱ_ nsܵsu01}%2 O$hRM5W~v=__B!djyhS5NEngLj袽W"v->jdre`Ύ36/h;0ļ6k5H"WrڻY߷<^ζ.6Vi aYѵκyb1aZXT`k},+MǰsN(k9?+V7K֥+s%t2Tɕj`j,2nzex%TZB):B!K&ARϯ?]<Mu葿wH$%ܴq3&qppqRDR3β˅Bll DtkFazE4ih],ڞO{YJ >O(BQfV=%eT*qګgEO?EWpr w~}b̨zQAڃXDx8Q/Dž qAR`$ qz~׋/7Ē1zcnjA91RaＭxw}39F!3{^osqb=z6mK/>kW~6%5sA/wEm81ZQ}Sg9t^|N`86o8Η1{9{vl׋V~}v gj4w6n\;v@}rO9dnaz 8w^~pu/((c;Bhȉ,۰aC4kU#(*45+^yeܸ+Wp>s{a0rSSSq޽㓻䗽۹p?RsIBUz%2 ow^JѰ, ~TY,GN3 *$7ڄ{EC*kJi[xbcq9 t[wza=]؁2ӍGXat֪TjLӺw֡sv6BI2V|E=֝WRRTsb|>B(+>3R6kLGIFyp[t`qrwF6I̳Ngߢ5z^mͨBH]tҘ!BH5h4uoX|9'۟5oH}0i|I7(O?-,|IpK@RZ6N DBΖgh9 yk~f𶵿y TKRTd `o.P~R[8(gPH$B6mtJsE"n߸iw}z6JKK߬] 0 v1OވlDo>CZ45zoڴIJSX?8Gy')S]8BHBHPTT*:!Bȳ+((pYNw mzI߮E'2Yۅ`w>eT*%/`3˪e\/tSRv'.+5axRѱ筕B]|>ߤs3'/@!znHdaLA?7`!!Ft "p&] Ø cR.6h^əC0^|Q)FtMc+uK #:3q½&3Jʕ s?hXD|/MZͬZP+jٕkKRd\Lz=~lNLf- n+?F?X*4t˂T,3owd1BNNJϷ#-Nv (4,[QPZ8dٮf"B!uBN0tB!gtL6 y1À o!N%z_Srr-&o\b*8yNW{ȸ0_ݢR1 <1 <8g3]ƃe uE% ƥڿ(' {Wo+-S4u9UС8pY*Mo%G\fѸ"+Rfpmm2TH풢bv^%VfFzN?r}9e*~άYG:q}?ssKdG<8ܵ/11KU|\v3%mDfr1 Խ5H{B@E'Bꄤ7 ndtnB!<;#ŊU+<-(xsgl7Q&Ŝk`%;/@(3kLnn2rb vdsyw0 *f"77VL^Ƿ!|=Fc=9p \zsӷ Phm%5m 6oc[̚O")ƅ8Vz j4ӮVVdRX[?? 󠬬X4֧ܙ]PUU'K(ù9ϴ]Q8^ÇIF ;~o?em$߬9 !dC-8aSpc _o1aooἷ;d+nptpN,-Szt:N1ncvjƾfIYf{R!. 8ȝlEyů<*U|p9q/c i׸|/=0H"TԠcE'=ݷB>vӷg\DR2h͑fu9]X m^e'StbYW9Xsf#qc 9 e㟐BJ%߿_qBE'B1]\? i=lvy;ۢ-[%']k'91;;' R*p~翄;,>BT[T{pb^g_wF9gvNnjJ׷idRN۫oU:fywF 1aXнǻ:ۅG2y}2qpzZbn1+]ɶ+]u5\7&/,|];VqbC8Et;$Bj+ =m>z:2xi^;:k5c3]Xz .UdaYv5]yy:ٝՎ%qnI狥sIY:w[/4SSkX,(}Ŝ"gGi xG?M;֡o~ /S&='l<0'V]$ ^hzz&lzڊӊvzg3]Lְ̆S cc yCnccJ-SB;*:!RKIR8 B!^J 9ȉ[60##_n#,Y1>*Nߊ2(Giۻn5E*cq<~_VMt/1D(â0 FT:Gw0OJaY -*vV>}iNF\;{~ڴccS0[vٝ@mk+b ͳؾm9'08 a/YνZCӾO,-t_tף3.P03tEyv,iOeiڜs^6cӹ*x:!`w\b flL헒G$??c %fo-[y<ə.O^+aw̓m>~|=Üƾ`Ϩ"Œic, Q(ʰ%سkV>ch_pxyQ]@ 'bʤ>J/^8"E"(eexy^eqذ~. _xu,JJ *b۷-G^^&yw:r VL+n^rΨ8nO y =|ιo[[B!>ע@R=U)wir.S()O1rš7}7oX=^q1!_,~Tr8իNvcUoL 1v; p^`K>X|]$n;[2=cy̐8K?kHwLٛN-lѰ6]T>LKoMe|i9%iǭY?p e!s%eփKY9ְ̔ :ORkosva %Uy3<=MTpeu &Slh cmDKWRZuFɕ]4>=~?t]4@/'n":sgrB X-:0ǜ9MNGJXVYT9|.Qwu\xZV˪'nYϞeE~b~`w)p7lmJ CBHޮƷ%B g-h"""?߿V%KqN9wprrqE!0Xuw2f[3m=zON  E.ƍдY'EyHN[p s;_8D$&\gᇹۻ"*~ޖ:(F/j KM66QcO v~~]=Ѥk?7iCLVWN.|~stA^4x"D<91fX0TOڎ "*=EyHLԔ[zqu~0i6m{aӟ8?SW5x!"jPK,а(#O=#O}2{ka={0ڪTV J2gXLp:y/-7vr'ogNHn꺊sYns31+D*?6z˹uK_l{ڪL[, ZocE@Rssu8ZP*k\Zl(S~;zkI .Wm d MXHFa2 |e<ODzүs6$d]cYVxA]f3(K˔Yry\DWW~`ف %ڱk hs lRcYVGU<ּ/fM{}ι;<HK Gf%REXg;эewԹ1!m} J]ii"x?;q'Ȫ@TbY|0Ph4C|Y:4ͯdw:H|ʆL;}bGjRP !Z/1iIh/ B!r\&O9O0 })BaϽ󳐟_iW`ggQmqe_0-ZRKŃ珙_ {{Ӻ' V6s=87s #+~#f{3l޴IN,o3 Ɩz۫o S'!I+t4Фs;çqܸ~ V9o7#Df0i,q g+*R+qGq%ha+ M$ !}B!uFZH%RIU>dD&SG)=g36]TP{Y/5˚0PuZZs&1ZMjӹ"0%REx4_ B0> _εib,9PvITjCfAirmvM@mw\<m.IEݢsNawܽ9+S}>gf>۔s@؆jRsFO1mn2iƮ:)3:T ԾM,SeJZ4o1I mxǂ !3ÕB%XER΁a5B! \?)8quq0u-8`7[г{}.;;'3?-9SpRyWupw7m6m`wfZA93 nbL(|J N]=ݻ~Zn62°O4ۚYFm@ W{FaZv!yW"}mfnnUsF!XwyB!T /"7uO;Na(lr?瓦Zϊܹ11|3`/NJvӨUzX;M*4`/7}ogiUϪkT`{ qdϦɯ5mN {oרƾnD~+&u:!Refe8,"gB!/"Ne𨡕q1 aa ;NGNN:\kLEstt_#!Ik4EֶZ,0kszxVp3OR>}/'Ѥ5,:ӧHOOFqQXVWzhڬ3ڵа̸".>_=Gcxa?_;+())ؾG(Qʥ(C{fO(agq>N<;+ ~~L>@ Ļ}.]#!T IDAT>,rs2*D C6Ю}?p :l i`x |>g¥Kq)der88 A86V{]d; 0jȸQZZL6UlD!G0M}T(;q'=7Nt;2́mN9 Uʗ[\<_o9惜V$JeE0P[.ַB|].~Ӂ^N;{Q@c_mڱ>q^&?֌f⺣jzjV(Uy~qFt>r~{L)n++}j˓kdTVng6>Vi欱{vTgχYQB[>7Jx?wxTe{fI&=R!JtԵRԵ *"U@A]XW?]ZP!HｄC!!L%3s?\LfR 9]5{yb2-RB;ʋT*8o{9_9ûWsJkM}kQfśRSP~ndg~]CIb\qrfX!3ڕH.v[r; [*͊(HfP=-SlWwg]e+ԧԻE|־GOqmñwZAQ0Ta.%VZoƥx:d|UƕNQO\vwwg:kׯǖm[!н[wsnёd^$ ܼ)bP%rmQ vӊǃ"J[ T@oeC]+]W4i<\. p,QS 5j "vBDDD͛6s&C Ţ Q}`脈&EG قQQXd1479:8`{S҄ "vFDDDDDDDD0tBDDVw22LptBDDlJhڽ۬>=V\P:#""""""""j:!"F+.. Ƒ 5K1116k&cGy(RgDDDDDDDDDMC'DDhZڵ"""jh `֭Xn-LuW#1R>NъO0=i"vCDDD )sű]:wƪ+: @ΈN*IDxQC:s,f}!rrsL5D cΎ5GDD`@rJi.b7DDD 6lڄ 6h4-Z%Kп_#jNvvr!""""+·`&=!0DD 5J))tqDxуf!::ڬ޿_?,[-[3ApB,vDDDDDTϜdƱ3.NQ*D"AxW:!""j8>^bSo1 oO T*bwDDDDDDDDDC'DD('MnAtX~=6obVjWBdDH 5RW: *'DDDMMrJ2͘Dc0o899 5J˙)A՚jΘ7g<1ZΈs1$ &iS^NщO0=vqvAџ!6o݊k@כXx1QU:!"F'>!8""Dn0k:}ʬާwX ޭZC'DD^[5NN¬9sgd2L&ޚ<2T&:!"FEVvzi&b7DDDT[Xnl ALu???\=w;""""""""" NQIHHh4 Qq35g@lU`cCpYee⅃bADMX^^-U""jTbMe2 Ԏ(,^jTsppMK&ٟsANb脈ppp"""J¢%K{Y=88kVDXX*O""""""""""q1tBDDJ\mqg4cܹP("u1pBDDDDDDDD 5"IIqxx3)nŚukQVVf8`yx|(sڶnvAnȄ""j4nB՚a"vCDDD`y8zYsNXb%Zn-Rg#,, S@DDDDDDDDD""j4^Ȗ;3gFvN&H0axLWP""""""""Qp?tO!""{ 6lڄ6`4^^^Xx <у 5qqqZ&dffbYtYCahٲHу 5  hj2 ''OT*;"""""""""z:!"F!??q8W:!""Nyz?V._n]5$NQk6""-%%̜r+aðp54NQ7=V(hӺ5O;hbh4SSޛ&L3"""""""""C'DD(%C* QR* b޽fz*""jʭt.b'DDD˵1m j> f͘ G#"""""""""11tBDD6OVji у&6o݊k@כXp=-`脈l^bb" Fi!b7DDDM_~~>f'O2 +-H-a脈l^\\L*EhH5mϜ9"77TId5y2dR-a脈l^|Bq۠ 8:: Qd0a&lشr+beճَ<|H6 lÇN:""NFϜ+W<?^www:=IrF f:!"""""" 4ш8"""}c(JS7ǏD";%bw@D%a脈ltj8+ Nuc-fvaƃ"jH -b脈lZ\\٘yI`4$%'ǎ΅BƧkGQbADMXAA~~mY ٴxc///lRn7AyV] >;O<5N1nۉ b脈lZ\Id'""Bh=jVر#V/_@:#""""""""Ɗ""iqV:`脈N_8g#+;TH$0n>7O0wVD:#""""""""戡""9 >J'a"vCDDdΜ=Y~SM*b0`g_a]I""9w22T*M0!""`MaFFSEXd /bwDDDDDDDDDԜ1tBDD6:uyYmV 5iŎѷr^z(4}B nI(wo,JOǍAyJM{cL Q-1tBDD6'>>[Qsi3#1)ɬ>v̛3NNN"uFIII!-5> C{As0Bju]Nԛr ))בr wR`4 ^{Z\RfXz2,XV)쳻w~zX}U"")Jqxx5QQXxZys`E쌚g>BQQn+jՈ~1OcanUX[VV0!""""jJN'fz,|.L+k+R{""":!""ALctBDDM >{nVءVX"uFW昽{ sp v="""""1%gz痌"" ٔc\vD솈r*f̚;wL5D cԩ;jN.o5p쎇An"m8ZAJe'f5ĜAs\a脈lJ||qH*""jzF#lۆk@כ^XhQsi,<<`,^}}\\<,Q(\Pۻ <(8wv/RcԋBጠv.;#8M0 5IRD㦐'y*ڶtM⛰fDž FAp7""'yDDdSL5EYYY1{.\hVӻV,[VDꌚ #7Y_ Hj|WWO :CÍ35: O~;]p'A"DDDD4y+?/`i2,f#""Nfz$a"vCDDT9?Baa&0yқx{dHޅR /uN'uPy{K̩u]w B>C'DDd3RRRPZZjs""j*JKKf:lٶl ???Zݻu;jAAM(QGNk 'Qzː}u j%]//_t: rӡժѨP8^-|/r3P,FT*\= LVςYӹr>v҈.Nv2=ي}WRS^BEjToYT2sۜԇK)Yn7s[i4NQtq>p7Mg_X=Z((ֹ8+0t ȫ@DMC'DDd3bM% BCE솈~LM3gV,c s6 =N܅ˇq)Y*H{s|D_>gwބ`go!]н` 6uffM9#.^8mF"$;z| kNSq$%^FSbuL&O[銎Wpq"""jN>|ŗ?͡kh|Xq# + MGRmRu0.LL/ o+DFwTe3yvB %d9mZksWS[-yJM/3=r5kz+[Y>be FA?%-QpFA+JmixjvSg3̂Z<%"jb:!""pnCDDJ¢%K{Y=88kVDXXHYrs2[#%:Tb8;3\Rk8v:T@pOaA]=Qc56Roo_]G2^9ї ǜ:?Z@5u=9+<_IԖ 7Gy+.{00|"QGbAT"JD_WTrQp<wW>+#߾+ 8D[R5ez)>=?Nƭ\_0Ϯ )^-5P&܃;alkxxz#<u@prrT*JUx\>4!x/Q;7YNS3j IDATгP7psD"Z]tFfT{ lrEp$,:wZx$']iпg""wGn{)oPn螑rmQ|_ߙwyr:1)*N\[tqjXiB=H6HQuTFٰꪊ{M+CAGѕߒprOruk妸P*틵:\UXfAIA ;g'/Dm0 5;Ϩ8qet9)١MX BUkVaI"MMwQp\1p"H\g\b<\=\%veNSi]ntiȿg"m M{. oy.b7DDD'6o݊5֢Twqv>#GQzG~2:=S>H٦m[VXN\]=49dPT'vbϮHor# ~y!]^ٸz86m9wLX~r Q;6պtzoAQ=Nwk2gg7gu`W* pn>CsȺoëI94LQQ0n˱`_v<50?ۮOw_zJo0K=,ꎽ߮>}3/˺[R^.u ӏ)߾ /$f|c1wJ$nt2.cb.WK5i M72"Q_PcfΝ:ahݺ&ہgh 7Sգ/A# DNбS?DFW:Ş]6yŜy! ['^È/`=Z ?<77A+ե@,\#}99Xeoʫ*=.9JjouA*Ńf/ϩQ^?GLİj4aDo0-T=zP詸*(sʏ{&кU6=go=> OSr j+뷅S4nn}lzĆ^>ݯ Nv-ӛ% Q<[ ل'ˏy_>d]M߸:W2 <](r5 确~V.>|v>;%fV"X]juQK͸;y>ΎNjr~"j> ل+D77i1 ذi6lJ^^^Xd)_AHJNFԞ(-+=ѳQ ‚Ec#==ʹ9t.]<P(Q2tBú7Ds' WՆx!!]E9-QT iނ_:{RiӤחYShA@YY)8~K-Ɠcǚtѧ9&3gZԟz/HLJ2u9ysc%|[`ي_ֵoY̝7guxtcs{LE}+/#%%ŬֹS'lrK`or9snBCCd"_lG#r9?b#GeVyYSRRtr} xa7oN „q-h!j"#~-p9L*Ū+-mTn>ϣOo`01} dzYdæMu׬: oQQ}٬&Hܹs_ݿ5Mv'#Ws3ݻv1Xd1@n/⏐h]01;ٲ99f5?_{E)+WwJVU=~~S@^zuړ1s౷w5[Z`$wB=?:4H] ^ JM/fk*(cҍrY1=wbhm0 f`V|_Rۣ|G;-5 oȤaXLd͎FY0iXvY#O\4},(vjh4HnS%2z~"j>:!""p?0^L"""effbYo{!,_-[3oYط?~ݱle6AW~ZŲ;-/Q\WA4 G}EVMo+VH1e;?mqj|Љ[ 'Tյ~rl '0|*j$ \\\ئnuhZw+s<,mooou>*z߹cuNg,3A-,*zݬ,-[:7?bneyqâj܂ Vvj=ė쬿iq޽{XhV[,):Q,j XT!tk_aak=@LL ~߷Ϭ&ɰGiiis` Y;a_s< k(ҹŋ-22IRr2~'?o:Ϸ:sNB'_#;ɉ'ϖZ$6.lg nޑBq)@|[ٓ*֊5ڝ,B'of?]- hO]<ߢ~{ƍE|bZ5%I tzM~+]Q.-/@?yx$e=bԅ2zUhQ.~nAӘh\4 ۉB7\H+ķ|Y=NޠE4q/ H""k:!""ѩT*7:!""u[Ŧ|cޞ }ֵ+b\\{{_~^㹋. k4g';X*S(5;;;sLR`4x-Ypp& ov~ ?w-vlBnKׁeZ zr HE2 nnn5>wm8[(XP(P(jt~g[.[]ǚVKe-ƩgA :vPs?V5>2bO\]j4W"x.ׯs;v숎IäM6fA!ړBfBy+>j*I%QM|(H[NqIG쮷^|"ys`㱃onlKŅv>Fuow!w쳶 պcOJV)!B'.1>SOt֜q|8Xn,3,v1|8>h>\]]MARr2~߷؁ sR)v'nj,\AusmЯh`@be<GlGiV  }:+VD4V)Qo*++EԎt?u.z'-ĜO[Z2$#N2v7d2ڶDD>ԩ?:wyVoгP |i?Y]){pxy"<:t1BDDTNR H%Rk.ְ %O>kh&fb3ZE?#ܓ}[%Ff:Wȩv@i j^ekZyarF11uOҠJzXx בt Uoաkw<6J0[aN_ѕﴜ1i9cF Nin^' rւcD$.NHtq C'۷TDDD aGT.^4aQ]`}}y9|; { զMd腈^˳kWͷJHO"uY 4󛋝//VU+&!^Vxv|HL`@Ju\Ǟ]_'~ ZUyhQ;7A/:'?.NڅӧvA" <Fy={ m~+Q'@epu!eze4EJף@qvޫ[߸k u2ޡu^-gk*[I֕M)kS<[N'^ARjT c脈Dw?t.b'DDD)KJpBٻ׬!2V<.N#GbGTN: ^ou;ǠGzٲ{ΞINF KHˆ/fXN |e5T5a`Ui` u:Ax-kkD"ŧ.p2[{s ȌlhܺUI0RJ7v8ӏԖV{Vϭ–~tKU[ssV8ꇍPFA-T=IԅQ~a=\"@DMC'DD$*ш[3tBDD66sM5D \hD+ع+ %*7r{3C{ vvU+s'C(NjRؑMx%P(ktn7J$= zVF\98 HLB˰?ˠ֔ޯ>xx9ӈ1gP\o맱px,\\\<܈#QQMݼy{]Qf:v1`OÃJY;٦ZaaAhۜxN m&~1v;XTVs>Э t>[܈9+pdl}D۠_" mF`BܺWOHNj6?##?|~nDDDfRDrǹ'z?7wp=6 #oo |,w-R:|m?3y,] v2Dy Ժ"ٝWR/Y I.VWsMϑYWHM=) Nc\|τ; `W`LC;pu*T+C1Sz.R>x!?lVOHDMC'DD$[@XX+=0yyy=wN:eVݫ7V,[on`ˊ}+[QF٧k,tb0QZBĮG@fWݰ]=i6>bb' Nzr}GG'z| 'Ė,þ7ΡD c'JQ|~ T"Ӝ㥗ޞ+TUR:9t9ףϹ#:]ML*^!ARl_?_f0%%d~Qeꙛ?|Tݹ+\R_y:pw4N)NHT C']DD$SOc95dR)&9oM b[i8u4v¡ÇQVfpWWW ~tƎmnت+\$'W7S8nnVWXo0 0֦۬Mܷo'J'UqpP7֭X]4.5v{}#|Nƭ[ Zo!""jo?9]Ǎvtaӟ}XS:B{5A짓 >bU6q%5w ڜ'G\YpQݝ7 TjynW%%l;T9s[s>!KveidvY^Ύt`(~KN\ ߽;j%?*Ti;Vu5m b˭t.b'DDzl׿aFFS+-G=D*svFEa((A=Çcpt+S54de2yx6:ul?pxk @ifo_CϖԳIQaާZDDDMhƓ}lUjl殺&h._kz ite Ldn T9ЉR[+o_qZF\~,V+$Nەu}B =n+=ԥuZ2[.:1"ݹ>CDo#""Q_鄡""jHw224 y1Ï ؘL1jh OI5nyee/vЧ^m BB!$YmY vvf*%Ы¹uGB%|mEwfۖx`._fϊTd?V++9akrN?? vLn0[_Ŝdg߮% |\K)Yn?o]cW8]]:S?ՏN-ʏK!o}Ś;czse;TM0 + l[Zu6J0'QFOq{.w1YTq/wEzy%d:o.?V2dR5^Dg""W:!"MRaҥع=7kkVD8`4ܹs}CZc1xog㚾?@"CފvW;wuZkkk{wUeoH $3  x|?|~cz{^~8i>&LRaoOR8<#FN146|ZV@5، sqh~,- V ksN'9x%wNaç 7?EZQV7=3>_q̞(&LO'n9}QQZG̈0 BaLnw jpvlW>""".䖻~(?;/8'Xhn>'|FbЖW*$zq{5iuVvi[{ESGkRըT>S?S~mP`O}>L_ktZum,y~w~uO'r'*ܷ:#Ӥ0r[+qAtm,)ls֓~=zVUQKk~>Z>"~(ǩfW*$OkFkܟqnL tG߹h“?D6nw1E'DDd6))R} DDD|2,[Vʈ^gd 6N-[Pp"e1?.PT_~ڄ_~WWo88 B _Ef$;Тm׵_[{ps+?.r/0K?Dc1r:Je 3~'O$W;-9a{;?bE?R={/uzçOPV,?lO?A0(l,=b+(j*QU]d23.eG88:a?Bju*+KQZ3qP -%VQ%(+bNdT{:qK \ai;gT{\)W zyN˛hɿsN'^ ;ɦ>D)(vI/W6B01,-ˣGo$8,:!""IMM? PȮoDDt:ۼljvR[jΙct[qq1vƖHMMmu^`@ e2DGEյyԹ PVV#7܌T} _ߞr-X#6IqNg}&G}_ HN>ֶxygQ:WJ_;,,,o:F7Xr 4C4Z 嬼 W ۽߀.yqG0-ۜa)e5v%eA\MzЁKy\jf}mC)&+:"|?eMFxm\Y))JjfÓ}rIUkc:@WsY쟏8?OG۾st:Қ5c甴{?'oZ~ٯS5UUb u]3ݼ=GȬXtBDDfvRhhϼ(ADDUYUVaûa۷^Z%$΄:tU131 4){ؿ7$_: 榫J `x~t<:1aU7cwgkP(; b#hP6዗t\^ ިCcS-!ӵJ|\0nvbQ/ae!lZpKwYAޟĴ6 LڿB$:r{Wsﳑ3C:1/̻뢿3ǟy\Q?ZoH(}Lۏ#aEIUbg}?O^מ8 ԍM !˿Kcodn`k%ԁeƐ9XtBDDfЀܜ,:!"uI,_%XB,y%XZzZO@\]{ve;H0ydDE0qD"sM TV|A\N>'PP O8B}>z6&LO`쁀[B{VpvlqNkXH_Vc/gCiiw "ai2>8x: 2EE/ƠAco3{[{b0g Ѧݽ9_AĬq~\>$(UmfH1|TLz/ /ܹxӓPX N~~0ab4M6yQ o;rWZa E:U/A[H,{:y!rD܈vqqWYn>}%; 'Z0ŷ?h^bZFkodQ*0m7$8J%u3DZc& rԏhj[eO(l΅\*c;XՍe/2';Uª{V/GS T6Z'G'6hgeѤ^vZ+[;׶W<΋CdT75o7dHXnݣ4 ynܙ=:L1NؤuikMζg'褽"_҉W\J: ΟGoy3u""4 > |h8;;b fL׻gd 6NX# 1tPDd7w.lllLcv++_NtyEK46QT(ըcdkk;X[K}A,2on0 E٨BQ ++XYI@X[^3(F}vNpttG_{vt:**PTB44A/*$W0%%yP*+Q_Xb ;8x_J]3]ˣ 0~8}GEDD&t)6JWi|E{.T{V68֫56bHm#uw>n'RlvRhNSQ`gcYd[:~O`JskM]FċAeJ׊zzuZ,sZU qɏֺTy\q}!7RԤ;I*<e\ j2.fz&T7ZbQdkU5.+k09i}rK &:F*)m$`/ǂ{eKDݏH$NWp""2fuDB!7c"")l+8}ѣoLzRLH@<ɗ/:/0 "hm}}7Q^^^Y[bv}[\\e簶@;qU"""y:sH:6ֲyw]pY:B}*bh*ԛN6M)hktߘش m`. fd=VŹ$};jkkΓH$3z e2L6 |JDDDDDDDDS>""29V+W!,:!"[/3XA fΘV ;;;3%233}NcotP(!C1+"yhDDDDDDDDDd ,:!""˽zuuu\鄈nA\֭E}}~J" ϿG-2c v!F.sg[9 *2}5aB"""""""""2ɥls""eoo7CPfJֳj9zqrILDSSyH@`DDDDDDDDDd.,:!""k ...fLCDDw.bzxT oZ+++3%9.%'#V.G\6TUU#1vXDd6u*,--Mɥ4+: ek""jN6o~F-VfG2c;_Aao߁_~EAOs,RysɄ ;b \J:lCDD7SQQġÇ Ƈ G3%) $yǎN3:= F?__$""""""""E'DDdR()-o脈Zw1Xe_;DB!?ṧtDcc#9 Hؕ<;[[L2Q2ƌ @`DDDDDDDDDt''DDdRW9,:!""#4 > |jqlx]5ry.%'#V.GxTTV# Y f΄SѝE'DDdR)VVVόi;*(,q.)`|)X8::)ٝ-iu^`@ e2̏ ѝE'DDdRi׋N  ͘]P(cb/"^m^nBT"q^8v8t:y9c&̏FhHSQO""2f+"]ӠRM qfAĉ˱kng%`Ɉaĉ,$""""""""Ƣ""2ZlvHHQ%˖JzxT VuockL ˍ :d(e2̛;K"""""""""T,:!""r ۡ,:!"brYcR| 1YT\R])) Ĭ, o/o&$""""""""ބE'DDd2)i[B1 Bo΄AakdOJ#F.ǡÇhssuìDd4pS^cQVU]fDDDDDDDb Ljjo߾\⟈J:^Y|@ bK/ҌVsIIc[|<ΓH$2y2"e8aD"RSH|1̂E'DDd2)1 FgϿV?uoŤ͘{ A~A9BC ELs@*8%]#;y脈LB!-J'!!!fLCDDV\\e+^ӧ Gݷ߁_uu5vB\ζ:sfFL>}0!Â"""""""""CTCYtBDk$݋U@UU~L$aOŋ! ͘,X`EDDDDDDDDD=N˥]/: |4j IDAT!"?q%1@E-җ_1kZ8qr9vBCCyR[L:Q2ƌ @`DDDDDDDDDD3> &"n-55Mul}>shZ YǍ3cΓ89ĠPE1cMȼXtBDD]0 /KAkEEFB*;F*,,W^sg Ǎw֮u$څ-1[@Ddf"""""""""""Rhlloss &OأNvٍUWF?faa' >>&LHw /0w "BBB#;QKrNh[uw oY;w07~fJ~* G\CA3)ÈMTؑ`Dԋ)JQ""2os" X|cZ_|b،ڦjq.) qroߎZb1Ǝh ӧMѭ̝z#AGDDDDDD=?a%".j•N%N6oGSS~z 'M6ceee!~c en4h@"e͛GGG&'DdJ,8!"""""E'DDeRRSe4DDdLyy9^YG1w~fJֺLH@\ζ:s}w߃}0!&'1s *>ADDDDDDdNˤo#"V=DYY~L$aO⯋C$1!Z#G"6N=+4gggٳf!*RÆ񵇺+;`b#E'DDet:DDFSS>K|jqOOOz>܌ ]JNF\mPYUet%ƍh ӦNSN,:!".U"??_b4DDtMvN,[))ӧM[߄]WXXߑAB)üsd„DDDDDDDDDD脈Hjjt:~;4E'DD#cPWWH$xȢEfL( $yǎ7x i_?$"""""""""XtBDD]ykKKK1 QV[[o8?_!!) h8qbr$ޅlm1uTDd3z41,:!".KKK3!"꽒/_ƒeKsCH^5X[[A}0y|ށOoO< 'wN?nwP_F̗'(+о6wM I~la~':C#FϾ94Z~] w32'GLl,ʌ :d(e2̛;666]Nӥ]/:򂣣PW;pE 䤔"|4C*@U߈%Ⱥ\Cq)w{L?c vn\ݺ%ؙ\NIiu^`@ fED`~t4|$ Nӥ4[$4uz?o9sS__>9-_@_ώTlX=ixh[Y@,@ZU}cH| tN9awz5وD",~Ix`6}o귅BV"JJ_5[kXXVkJY|m[$wqJsfG?޾(B1vӁϔ1ԫbCte;սW(w@ {͙̇E'DDԩRR akF; ƦO=|rT\/s!v"1kpްu#NIMF^zyl,q״(Ȫg uaUe۶gߝhZ,] 3:G͛ VÛY>oAao߁_~EKs,RyѝOi q%.uJhB @a7"Q>碸*KmugF\8`LݨjsZ>=iZ|u:ITZ7<Mc\PhP4- ̙=Ju3I2oO>DQ?FufuA׶Ϙ3N#̐`Tb XI;;X=0$~٦{]?%At"c(ʭot(_5ikġ8#K'^Bҡld 4@A(bIsc;~+ذq#5f]waã窩΄8t4兹swo"IO+n2DbAac0|T JJ"+"23. 3"2/Bl vN] C""DDDDplVqreCpm}cV8nۢ7GN2Zqqu~[K&˱Q¢""4iij<+X77;V:)g NE'n?7b O@#[˼N݂FM:cPV7`CC8u.6&\:qDz}oo߸ɿ~c"\.^ аZ#G"6NĽ{ht-N( cFf[4^CPQ^tKTu8s:gN'#~}>9\8h uo/0U%_6c""""-!)}^WQ`rkrWY)yڶTr~ߚ^0g&"脈:MJjH$BۘMwR75uvoA+PV73ר-NOuˢeO3ްwFBe8{vn> ˛)tHؿۿ,-?OŲ@tA _?'@y.lx]56/%'#V.GxTTV# Y f΄U{IDs|dHM$ b4MMP*P_󦦜b  %65uADDԙXtBDD&Yщ$^\n\Ǵ\bB|UQp &sbb,RMӤKѨ6,8qxY Y H|*>Z uY5?\Ǡ@&r 8#C!_CT*d jkkc^Hp <ܳ7gԩxkptlSQQ[z@DdX0>o "0>xETꀙ qWxKKվ*de^Dji: نŜK @$hppt鷅X񪷲u0^P(2S"""M:Nː㡪چkہfӭx8+i(!ݜyȼzDD%RӮ1 uF md060-K%Cqc>߭N}bmPK~MI9[7>0<7 _q k -(O;~x9m0^WM/oç+wbH FE`$֖&gNk־@ @@@ֽ~GtNb/"^hRĽ{!6ၙg¶gDԊ*&>S:b ^OO,^gwggO~ @c-sJҼmsN|Hl֭lcynpӳ5w">XtBDDBJb`^NJGMU`-[\30Ⱥ\]#ݤE'&-+*m162<~f>0`_xn|=|?"ߛnx)rg Z5EKXtZӭv"X+v@lۭrRJR]?&A ьcaZ.` ZHRPl2KX[[32'֘=P(p"e9}:lll: !=-m:\pҜXlت]sxCDDDDC DB>8{W3w""Ģ"")Z,: 8{0`l=r" !,-׏ߚ? KKrvԾ1uC|mgu.^vvf2̸0~tOk?|*OǓoI]TTT^Fi5A" vakLAK"Z&CtT\]];;>-_1C;[^_Euul //?88tkj* ֐J} tߢŢ]AUU2PDDD>~;vKy9B~%L)p{!'VmШEDT4upB';͎i:{**jVU^CrB}j͝ϘsY%v I9J&N`UTr\ JYo+U޵&kNc!HkgeQlS>W0wuiU61ǯT*UMMjP_1䊹QŢ""innpvv6c ]VsXb nߴ{ N8 mc/iT,0YvleY ֡}wssi pM<ckN ~ϬH:+IhTknoAV/xld,X<i;FŒPRҾD"~Q((((Vk7W7̊@tTC"T~) 6g]Qm_c_/(,j@ @PpȢY|T|RP(wk_ ;CbflN(O 8cfcp9+ẆO ]l/̩=#p=k=$ee-=G?A.*>k0gͺnk""ƞ\:`\SEO:,=9:ؓ3%XM|qb?EgVMoPkښ~IT"t8ρ d\nڟ/)ؤuo/hmOE]wz6m;TCeQ:ŵMq<z+="Nil}ymǯm-5""aTr9ȓ31_>qoZA P7i >hWM\gme{N|c}>}dy9H'F`aNOe_Cn>6ݭ/+wtl+\,:!"N.QL@GvbZ'|finC<~z?_6E'cb]Xd8ےmߐa IDAT Tb} nhBbd^*FbG^qĉvϯFuub1NH&N{DDw>KKNCMMEZ;N?>zyy鐖vGϾKR5!3~ǏmW_]Z rsR/>bKj_s*)E[e.+7XM/- 6} *ʋ:aZ`p,csȸwtPڝI٫ iim>xYfos:BOL L~8Hj]}u: EE=1kȌ1o|dtܩ̥mw t+Gx!`r/?)36Wl'. hm^FVPLs߸5:w+nP*ZM?;zqWV(F<ciMҚ^AF9ju֭=wMMʱŘReu~ZV_&\E]_)|m7Vpx\:] ҋ*_>F:6;Kk=aʢݧQuPzKo>,}U8_gm|7+kU͝l,:!"VQYҲRvNN; W9qrbDVf4)j YMENx+ M(3\Uz E1V6Vf3%'w[|>:?~t_GR74!櫓x|Tl'N 7*olYFD]*$ y?i.kkQpg>qprvG}8t0'NCrq.XQQzݠD$!|l9 nn}`o T u.G~~2/왽()\^ kM4}~ӥ@ؾJe>i}Xl&cQpppVۄ"=E'DDD?ډv&eAt9tVUj&kMacl'4>N{Fz `]1ؕQ酕.:éH2:?Y|c271!!mCFTۤWzV\-^UZl$U_ZXTVQ=y24ZbQ_Q\RYWu""mKIl̢ࡃPThTz: Gt;tH4^8xȕ4ތԽZ ]VQj՝zYd!Ģ'BӤo[FE`ٷ}]fy.- _T~oœZ).G8l,&Giu:;gXYRmi۩gr1AS5ݛDugfoa};*qΡt:*qفEw7X2||~ecs%-fҚqsK?P9Yl_0x:݋lclG|Wj^bQ;W,? ,<XZ?tE f; '26IӾq"XtBDDr:;bͭ9F U}MhA)TȸPSSKs6|^O e$өSl7r'xqYHE9U,[h3ciiKɐJ;' N@@pZNpUGk}ں:r_i}jm:QqΊ  +$?a+˹7'n=9\^/υ 4hD:^NDTFFxa[XGjŅ*l}\]=۾<\OWbu2Rm[ 9}?wx/>$ ee]Km}qv'Z{tl1@yTpҫw(fGՍ'IeSsZ%Lq61$I肒Sحvoo(80{x׫wZC JJV\kjiᛪoĵ7l0ΈV5k(mO^XQ_ _5"@B> 7cֆP'PNHw-iED E'DDTg E'^QO־桭W#%-Ǿ\C_Xؠ`e~tZJȪdG:JlbZjM褴Tw@$!;;=BRQ?mb{{§r4%6.r0\O;+{7p Dxx^m;˻||C[O*.mZܽbȰW' J`1뛽+^J*PP*H$SZ-VPZ|<ggkf4$%'aP(9b8:8hf䠨P}Q @sWͮ뒂j~urr(R66603ST*q=X3ss<(D"@qq1d20KKKRTEr? LMMa`ӷD_|~bJVxH\aY 躳?=O5U]ߜo RYZۡ\W.JJfHmS᭵Seկsm*vhh?VR\]qcKY 墭.A~ %KM{ZW}ڹ_U'DD_-DDTgN8Z)S>S v'o'f!bj}{ mNHDmV}ERN{P*QDɱ9ahV\X5H WjuKݻsy"z3\ `h ;V+^D s}^M#d">Ommp`,t>Q8d]V&/S.-|S<&&/2mRJd2;&W-/s U dj1Lsjpz?6mؠʯ;"Bm1k؍%˖iczx]v a/Oֈӈ 0 X4y }d1vޭmc;/]slvA9\/i~g9bښL&C>5b'Nk_W[ Gi444hnW|tm驶v%gaa,a_2OcFޙ+/FRZ{__w/YVc܁/WXx'9y{6'Nr ш ӧkO9I7ּM%fDEBܣwo^lF7n`h#|ڛ߯S(0!lFlx}k͛[ş}qQ5@߷lш=M[6khB))bbW&޽z) L S#_@&M Xp֭[ 4b߶gΞU[ rrؿO;G]xnlBUu뺨K?~-"ѡ"W(ÿnͬϯyc}95,LJۡII$315gcJW:9ԧ96Z^(JJdUp,MRRCG[Meym7F+:s3ⶁP(:Ϩ=×ngIv3 ئH;"z脈D*Eʭն`jwKcE VN B?=N:k=mi '"!hbwTS\X KiNT碶QċwѲRi9\}`T8ǻK^^.gdHc.I 1oWPl ΜޯsqDVV*vl_ pO䤫1ͭFU\6PmGz.zQ}3H(~_Oׅ"Hp"{>777;HR7qwsG=ִupn ,,-*uۊP(4MZs622RmUy |}|*D`,|Դǻ@=J3x9XmÜmм4C-_?s sXχX,V-++{^'K{Ws3jE aO#)2/}$Pnff-k^pݮ]/:䫪; ` 3ӿA>8:eo> +W|YeA1:ǾxWu8`S;~b tV9vFx8f;4hii]϶mt500߷ [s`wt AhfǎʴƁwIbGtv FQuԱ#b/igαc6c?|':N?ƏD"Q;G`f7O_cc͋E"Q^̂yn%e*<}R<,zgߟ66DBa}`# |.Mqcǩ 1 <ڗ yNqvZ.mn?-Eh hҵFSP|sH'X7GJ‡tZ,)) v1-PZyuQ -I>-lO71W +Ni,dKrFި׳u^վMٽv-MtI"K˷$ ^tr/G".;ndU߯ 䵲;ԧ\:zv+l{7|b}M:mm4jE'DDT'GB+* k\'4 Z1̭*_›=0w.s@S&bӊȾB(7_J;4ܬB(~$zEQг .(.,Eԯ0_ %ܥ.)!7K2RiƸ`lZyKKKXZZDjjJ `goDDfhhn݃Э{:ukB&SٽkZ罵zʰ~=^tbbR_q^~cdįz/ p0j3̬0p(b1{[M Nn&qF78r iQKH*k:%#o ym]lv}<ޮ6M |\PTyj6s˖jnhQ6DWfykX삁x`Bi%&9cڲg/t\͛t1=9XtBDDT*X>˫t xd2D*/Jpss͛7C#\B^ѯF먎5W$AA}:`f)ƫ `u / C'#!&vƪJK몓훓u) %RdWfWGa3k;v2DC8޾<:69lM`(6@qa)RBiB"\= IDAT>DkGE$a:{~֍JH:u 1tΣ"R R j\,~CDXzEY k{OmJD Ջc +E-N~X Μޏ;q- JK5 w),CĮu8vtޞ-|l\+4 """Iḯ~@R\Uqb[.6g;q:;-e; SYcPL{"-̒?z;kPNRz2Lv/oOf ֘VGڋOQrbD*)_KGɾ뮳7˒ɫ%)o:~d?]SCD QݹsdDEG#7[W[Z(FXؘsF0/AJ;AvE碓063;b쌞{rA p 8ǔJA5g뺺b/4:5Z#R9/C{5Olb> ~ yￏoBVVڏݸiD 5r$lmm1Q"7`4"v}{n֤bܹ7;NW|)**Y" zWPdq"!. WZ˗?nn5_"""ү NBA?ͬώxlSRߜJ2r$_]z+ýRʊPerG,lJ]^D"a%2YUj_M٘hNPhl]%2ykmM99g 5璝^Jt33cfnQgmsR2GL^W1̕脈j-!1QmKODTwvvswRSG êǢԄ1wC%#'6kU_toA S HV C Ohikdl~OMѻf&wNHDNfݺl>V7166XWΧ;FLp̟8q|'oKO/[DDDԸ-8쁤5SM;]ܜΆpjc!?{ ˑmogSjkC&Tmtt䡶֬F>\ Ss#aacVhn맭S +f-u6]z4s4,,]ܪ !'CZbN;j <:>3~9 WOA;~) y0Hl^:#|Ҧ]=kT8~~~xwd2<=1kL=7/qfITHjEBT|+H:STVU6s/+Z.uTTs^ 4ˑK2zO;]BIɘVG̢"z脈j->w;=fBW{czZk6s}6:K 郀> oѶnm_LUnN"Wqnx|ؕ0_ԛ)FqRL̍`bffpneAF>h܋u:F}41 ._ƾMHL1/|H\tQ[D"AĞHD쉄3 1Fe˖ tTXfieLꟇG'B$ݸ ~5:+gZ 3f~w'%]Zt".+UGDDDMƣq>A~:蝹3ͤ߸G⾭,8t)m/OzKVng?.(x;¯3 A~q^֒IRɷ\?{kr^Su;DB>`ْ֮.h9.A^q[T]"jr\""zrTtҎuh___x7Pȕ8$Imͣc/Օm;9K?7n}#-:jvu.8i>x<=8 1ciDڍoE14$&͛[ρH4;j33K'vMhQ$TXXD$[K$5uv.ff +*os ۠.P]T* _Ml9iZ\76Tq;=WbZnОJH\Y/[(+kZGɟD{:QCzz\@s y$/"""JRT"jY5Ɉ6fb ar$b]+?/$Or>\sś\r>^BB4pˉ >ñs 6 ðⶡH󌅉Xc2MCEDT[,:!"ZXt/"C9#jJ2ᇏ>=QOV-[b%GgW GZ|ĞH8a<߸. ő zwRDƜEOq!&=.3a!Z#556 zV)ֻ+xkf?VVaO`wAXFeΟ;G)o]?T*jKQT~EZ[Vێ;S$"""ҷW}=+;U*!|zLκuVk'-;;WW[nVf~kVfm~mnVܖ+?E:pJ|BX,F֭3LTb򑦽{ V+gGs-o/w[Xv$$9j]81zZJѿ_?XNJN+D>@Dd*FROoKaa~C%ض};mߎ6m`h AѓC&+EԁM8^]ѧ(t66NU'߰{Z}#FNKJEɐ|UK4`o1"h鉠!/Tkqb>cm+BT@(5h"|t8909 xk{_myh[w8Yl^!C&֮YQ#gyܺ.rr_]mxǮy⚕8v_Uw=^ʭ-xDwg+3UK?w=BNYC6໖%[ 31*ڝMHL/wATR4r⬂eK&9Y>璝8mc|6)=p\?zhvH*+SLthNT֦m]kgTO;"ɖ+))frO)ޱ脈j%BmFCPܽW=4ufi)>?nѡgKnGsH' c ~#wCƕWqy@AA6j"vCĮu044=SOB=ROIe'<>($u{Klk3bYYJ:o]ukwk^EyYO뮶+?vj\0~;+د"khy6473yK]tofFz8]s>n[o(t[jnaB4#]sc[Ž2ORix7K2d!;N%Z\nfez쮕qب$=&+^NGjvA@\aY&-maj R9YOHQ]T$m8͆q0 s D+zz3&"NVU(:ZhO ,rO꾹9_2hJ Kq"ND^~ǃ(+ҕH$_!##p3%Eե(o_D>3:DJKnaaM6_ʪKTL~|v-*;xxEyg,#8+D@7R)DEa[000K-Cl\\ݟ(= Eu:@ Dðmp=e4;OC]8)0d+wKwb9zfZaނtӵ`|h3;TLDDD٘0ebv6o Pl [6KCͶws\'ě R85X Lelm5]6]m,?:eP(DDotBDD5v#) 2YHoosީ>o=fCᝯq\:QTmha2+U>SǎxwxR$W(hBî'rk֭}ء/` DP` 223q kjqYشe36m w7wbpqv&&#GOӑ q- 55iZXؠUv B`k׬Əoai=)i֬U1YӢ{{,>ǎn+A.W?lll 1lië6Oً̫Y} ..ڿA߈f ?(!~8RT(.A 7gLG؄x?Q wwy{6ޞΞ=H<|k b. b ._O> 9i&` {W}䙘yhޢS\\ʬ4O[Σ!uvs支>'&N@bb=kxő X#W(pi,`!  :""""""""""' NFUЬY3=fQ*طjo>cFDofffXx1LMMU?) 7o444D, ;|?={$)(@ĞH>m* oVNFʯgw9KMUms=2"$~ǞIR,] oq-,,0"$?~ǜge?1,$&͛ 9Q` HN'^UDRC,cii} 55[–ڔ) _:rǍŅ`xc IDAT}|g6e G_äavc00p0ϚQQd ? ԺlxI*Jq! 1#"j0~٩kSڵ+ ϝ#oW#(0j1>9ｋcgBL JeGDDDDDDDDDDuǢ""Y||ޞzsH Tۡ!z̆{>۶ϫr9֬[קNFrŗ8~(}5mv9߭];w4JDDDDDDDDDDT;,:!""Uchh777=fN~z̆vvvaZ{Zⅱc} P*شe3.\WU˖P(DgtXt4vGF_'~IRDFhXYY!p`""""""""""j,:!""r$%'PRRv cǿ,@hp DP` 223q * vM-.//۶oǶ掠@1..zʜ:DDdHRv;o4$\/2\#y㍷F G_ _g۶B_.DQQ{/aocxmk%%'aͺ2|&2mߎB=dLDDDDDDDDD;""z2T#펈P744D/?F4pwsǯ`0=;Eb7}pwǜgCSSSB1X٧ۿ.EG!""""""""":DDD}fΰc6B=Z}g#7*5"H뻍b̟;ݺv!??rƇM@i6" ѳGK?Btt4vGF+p * pN;oo=fOO˗OB"wD+*;"""""""XtBDD:IHLPhFsYܿ_]:"qkA#b k֭K/*mOb1#!ܽ jqشe36m w7w &|uuܽs]iEӸd cxxcoee>{1"z8`fZgOqc]՜RXvl݆;v)S`kk߬€b=dLO7xnDDDDDDDMNZGNnjS<;qa!C`ddnji'0#<?~To?1gC=`j{MԱ3"gIvN~8ޡ}{|l97ojNRP#G"rO$N9 ÇcQhݪU#gIO\; "zYZZMiQ#*U%;""""(W\c Uj9N̮曪q-[ľH~މQ)Jlڲ_}2Lnan?C1IKKþu8_`С!"""""j,,:!""!"j%$&{{{ddf̙Ӫ!!Qx), 7-[%x1B1ÚsvvkS`_l7Lkkظ8,] Ӧbwd$JR=dLDDDDDDDDDt脈L{\Ma=|}}<\gQĞH0ׯ)sq!|jP-FPXB8.ĩӧ!"""""""""z脈T\\;w襁<ͳ#bh޼!"z8^m%X055U'%'a|DlܼYՍ`/qQ,#ktH$קMCU]ň"""""""""NJ Pq<ͳ!!!=fCDnDHZ+T˗9scnj s^i_ZZ~ZCC1nxlܼ9zȘHXtBDDU/l b1""MmZƯ6a0n qcs1F՟6m`Fx8GƟ7`1073׈0` L5 PVVNJ E'nnzP(~cFDD322s׫`mmZOKKS໵k:e=ɄB!:cчѣXK Z\ii)Gc{X٧tUE'DDTx}ixN 6GQS7غ ]tQrYOL=fWuZz5?F\^^mߎ^y!F⻵kq==dLDDDDDDDDDpXtBDDZ \qCl {"UmmlлW/=fCD''''L3"agΞ cz̮X[[c1شa"v75bhpLzel۾zȘ~脈նyѣCjn "jDB!f'''zvNϚ%˖A&1Æs>lyƎSSSB1X٧ӿ.EGC.)k"""""""""a iN' )ACC Qt؁@՚RĦ-dܾ}[5oV4ﾧ4F* Hda++""jڲU'l~{ڥ+ Nb,cܹҹ3>d$ fJ &L9!i ٣zѣg@,6D*Ł(##GˋA" u}AD0}@DDDDDD¢""TܵkjU!57BC Q <x\\t PZZ˗3Oamm,#BB0"$ػovډ[gd`Ӗشe31"$#GtT5,ፈoDDDDDDDM 2QkN {Le@QqKEVmZ=[kmjh]U\ '8PFV $dG$$L <|rJ󉋓DUM/{p0m !B-^^p޽-Y #G}4! XZj~\=FiB!B!JQ !bt:Ua& {-{yz0Bz̩SXj%ܽ ]{p]l۲-,Te~rqqHˬ-,_?ajj!9|,[Ta ɂ 4`lS B!B*DBQ29Y6:FFFճ !O{؍eKB]]]6)F+*̮~P//o?/]‚ТE t}<<1f8{(rT1!B!B!B! ?D"R7nݒ==WTtB!DAL;fpDzP/rB!e ©'x زm+/Z.>=j> 0k[X(ĽHN{'&MS(,*TAƄB!B! B#H/G H$&!*ΈBVZG0iDW1bhGD(S֭1.C1z(hkkH$auYsJ` D"&B!B!gTtB!D7odc;[;fp]xA[׮055Ua6Rq8,_~ }}}|jZ*kgTDg''Yn߼Bb`"k֯Ó0eM!B!BBXu:sQHHL=iiBʀ/I6'{|;sT`;v] IJ%K`oSx?AJj 2&B!B!'TtB!DN\|쵑6ml&?k l!ajjC>`1*s=Qav?f0yD:Ο9iS*{`L2|}庤B!B!B*:!"'6}щ-Sb1.^ 3" l?Le999ll޺BP6 m`<ܼz oO/hjjH$auӿ,^[AA*ʚB!B!Q !9e:QI}޾}+:R;ݺvS׷lN*ȱ4e ^~&..ؼq#n]M6 L_%bs0p l޺1#B!B!4p@B!B!pP !O$)Dj[X xXLQL!``ĉ8ϿlR6_XT˖bʕ(..Va &O3'O6u*םpu3y~B!B!ҀН.B!2qep`iil+W/ޞ*̆B{{:²e~=~*ؒ|6X0wn]퇷444b BNJU+6WDJ*ʚB!B!RBL\\u۶mbTMSvi6J$ R{ؼq#6m---/0~${ kXL&z`ƍu:6m؈..`0rqBc6xv/_(kB!B!BȇPSuBظ٩0'5-OdaC0Bi؆zyK,^OlۊbWq .zyap%=W^ťh/O/ 2'5Q\\GLf,ThLϓ{uXꪦH -23Rr*V X,#"eqȝkf*̆B!f)LhŃ̼bY%8gr"/YL U=^@xUᗈ$RH lJeR U!B!DD/@ڨ0'k.011$BH]PSSl89:b7ӧaƷa`1iO98`ܸyBP#  l޺ .ݻ+,C>.>SƵƉ"MGtD捓traЭZxH~Iϐ /"D4B!R[)M>{ikϳ-8-9/Pi !R*:!@~im۪0%SHN4|ݩ{s!B =G!/{ݲE h0?_ZSS\Pa685iv%Kᣇ9zT]㦧ѣF8wfy qi 1ߣGW3ib*,8104Cwtq.nswrsB!4h\~ N!44BN'*̤a |l---fD!ة-]7oPp|*D>VZa|f@xDq%EEG#*:;v.=0 BԎ@/?RXNG[[COahL(x<. 쬔:KSS:uOB!B&G _ CB>#tEBR)w:|6rN┯/Zn0-,T)8X[[KYe2@= T+}$xz 33+0`'!BixM&s;[+SbUC!C!DniSQ& KAAo^`1G/!'Cpqx<֬_ekִ&O#5f qIIIؽwIS=DQjJ"23_s Cگzj歩B!Dd:°h3*8!ҐPB!{LLLTMqes !R8q(v܉#ǎ"22۷nCU!Q5g GD/.^ǓH$!,< mE~>{Ūْ/Aeum[ZcEx*)_S\\>tm`cG/b^! ̸9:9F[ (FlL(_[ ^1ZZon9%TxD!4{/0x8d&ZBUJiyZ&* "&L1 zVmMRcIToM*&:ۘ<֭CNVSa{A„|T*U,rx2~P[㙝E]\/bc,݈-*B?8 ߌLjmΩW(!]& :% ;b钿o<.H3 x3 xŦb'$ɼNiw [X"e%`z|j8n'H5rݍ}M \bm݁#'ę_"6f}S!^w%e4`/=~A|S'iyZ>[ܭ8}C\ {́~5=VJ.ڜRʧd֫!ؚ[ 5=&!(CBH#r&ڨ0/ @v3b/U!2330k\g{!!1f4޻Hucĉ8}$Ο9iSI& qINtἿ?ꆆK,ܣku/ƭزZ+b㺯 NX,VKᗟg!+-VYiIEbۖoq;\I!3Kةaqn9Gpd؟fħG' jL&@?д?.z N{.a5e"ޯOZT,TQp"E++cSrkQ$f칲NIRy{ɱBqaǫlGE' @Os/6uĝ䘄RtB!\l\܅otR7.^({ݳGF4!|nX,fK,[YYob,L?.J9hcmsa ?^ >/H$!cѧOɲJV8_f-u ڴ++{7}˗1x3y"C{r'Ǝ_X:)) G ^ѫ[`m' ϳ058Xxwo޼-'}06i6[/pn\bbY kP%BHpᰙ \yIVf^Q̼wc@J37 qne2kpϮ Kv 鹣Ω͛`he4)K N6oPmΗBJB>ظxk6֭Z0!,< /_ƴ!|wӧ|r*߾ J8r("F৭мysgId z`q&q"¢B/&&&8 # X,z+GO }[XZW:F=tv2 eǠa`h\"db+Vrkjjk7w8w3év+)+#!I<`40\ξ+ !77b]O;@M.BC:>I |“%bI#|h57޽탁>Ur!(Dr7wkk,̀g3) @3cSv_ a2:2`@4Ն-5wqKkGb6%R.'OLV'x;?e1JvEvg2O.98׻~.9|]J NԘL7pk/h]bx'+w{2́"_/-ӥq>¯O0Tv}g/8imY6?tϧu|濐Moܨty𑳕$$DiXǽHOd/"}9;*-8)i3 XuX8D$CSS<@rQ!UovfxzPpR:6[C6{w+ݎB!uoNߺwXb2 D"*(q/6m\q%PXo/[4ջhhקՉ3Lq%)btEx4XW|_ͯyn{n<{t.1#+-3}BʢBiD"dc[[f0 B^r^*̆BH]k׮|Ou7 ټ_?"m3GGG8::bْ%ܸySVCvGrr u<~tG5]uJ.b ^B (YŖ45T>hN! {r \nҮ81Uj#3D|_D -TeC&H$BdT,^$ݴ~,"EB\LI&bRŢm? rsNN8rX؉8'7fH!ڍؼugжMĄLB0DJc'˖)v9::b>sͱl=Ts6oRWv~QQ0yBk1b"=V?nV-_0?bh.@qY9Ob8Μ'6 mu|ga;'t_t8QX!u5jDsaמw+$+HL-iq̆Io[GV"DXPBog5!BiĒPRxƶhR~~ù !1hkkc٣'6l({r:)) &M0ybof~߯ p%0T &aVۼy[l懐{pa<VB'y1gޯh#g8hhhA_rruUEHKMUv5O.j\ҫ\щD"FbB+FEȍjFOVVHJzB*"6uT}5 X,4["m\d6u¼S'G91l8s͙+ۧ6m*ŠCbaXZ).KA)Wu^)3VHMM$c0X[[cʻǰX*cjb v+ޭwS얢L-fUU7fv찡C:Tw^ݫWb,-cOՊeXՎ V;)_)_W+ WW||)[[+\ Ūv,qMcg{elڶ{pbU;v{c̝W^C<5zWmmmqBVB;UV;vŲeJ)3r^e3DTDV>yڱk\Sƌ1WEyKVLyv q0QX?dHLWS7x>OXJJj%zO;YD@ƳnE*1޿~Fm}KصsҮ0, h &X,uhhhDHaۚԮv׽y<']|ª;ԖX,h&BhYiF:!έBf j>v3ʆ 2߿1sw(O"rrs2;%e05о5m`](oB"Xß:hnOi07#%Rexj Z:c!Vg1-,n/I|Hښ:iYrE"ҢX~JX&4|TtB!Tzz:r?)hGN>lI/ VqFBT®?~HrP= ֯G>}U%!/u< Ujc%r'w`ݦ#lJ1(.UnvoVa0kii}v/ӢER/ƽ{F&usaBdbԩpvvƒeK&%s` X`ku-zO[[{W/uu)Ūu< d;}G lJJA'cxXB!O ;HaWkЙNZj N{8E@pdJ'8e9Hמ&OBog>cYBHl\: ZW/]Ocw%b1x:[~|{݇P,s,5k_(~WWcDbY Fz|{1 !.Q !4Rq׺073$T'x}Lo/ZZBЩcG<5kr ;0uZl, 8l(q rTI J04Pnn5*8(,̫: YY)hU̔QG@i!޾M{]=0I!|.B;x'fzZۚv mUhx۷-r ~vdقj$Z죢T1 x? Lk,.V}* }ʎ-jRpD.שW"wq^P\[&(<]' LU'@!D5v:CY/lR-::߯!R۱iFhh_6#*:ƍfGǣ2Mvv*;λR}|S'_×15F$"MܜXV115>!B>'LClknxt[kzߦq(3رUكOZ6'{\~mzSaXvXf?Zm)%RFAq\vjؔ\bPMMeju/.ۮV8#]M9E<BT#"F*.>^V|\* GBzycѶM\QQX+WǫtiiB>;$ C] fD+4K*53?[X pb1]=V'$$D %%2nEK;NrD"sj(!B>)NqlsUfR_d&!(;Wh*um`OƿbjMg%uZ,ŹueI%[U,6Quz!B)/Q7][%N.bN-4E'Ku"Dw?+ +]F,2Q[;dH<~ 2dHu4e'eI/bWM_/ z5. V SU\J.;%fi 'WyKGt=b zp>V_\|BB#0ƿ/:Qa6.B$ƞCT !ύ99p{d]n޺cFc,Ic _m@g7tw [.044pߟ(. )_ֱnB$*}/NI!ahh4iSstrU &vsǍžh)l#pnD  6ra5PR?6"/7 ̃ĄHK{!7?jhԼc4o_O_%+(a4xxNAJq?"гNB!TBVXr按;&h{j$mW(T[z37 VAR{F4|eO^lZw^Y sޞ_"6+-8-?rߟ? 53ԍT/(.jdzc0 QV%eάnΟڱ=ϏoT[nq75Ժcna%%ZYViyEƚh%vVAqɣeO_fMJj9nS@V&[D?-}6Y*GflkoubT/<{xr{TO3RGS6]%B|^i~qI@\JaB]$FF, !1A6ZIJJBTTll!|\wǙSb*ܾs HpQ<}۷nCs gITdgV;W_q1χq ކ~'Wn۷/p.=T+ĤVgv0uw gyz`01hWXhjT_ ؼ.=BѶ]Ou\ڴfr_];Yo[?ێ->-n_;\W\.V+/C"H UDOsu 3wꜯk+Sr<%޳n;kW1>|C7u'2Ve'nt.~R/]<V8t p5IŘFj]ZJsxYrqz{sԡw D(SS<؟+dR}gjNycMW>~e-`lѯY*7Ⱦ!S>7j|+v#K%9.Gz4=.1ܷw箮Xw09%m4Z}/s2IR~UeЦgp*wzVUHk35<…3g]&"kxxxDΨ9vyyOcvH$""¢BغmInbx:ٗyv.E[AJT":`u'"&"z!.$$E'UVc{CPܻ7k֚,WVcx^C~~QcƢ"F$V&cv:?LGE1""j,fJL A(_y=xr8h h"""""""""¢"F$:ĢꊊbBX0!"DTbάYbgprr2SRg7KB׋!56,:!"jDbbvvvh޼?8tqM֣#c:K-?["fGDDDDDDDDD NxvP`$[Ç 5f>u9zO5HDԈƗ/̥u:aaamRlJ$xi4pws3Ƴ1_/ᣅ hD̐:5vqȢHLJĥF)b6DDDt7_~Ƙ`ի0pu#""""""""E'DDD\|t( YoHx86[cj -3^E^^Q}Ǣ"F(..6Xtb="8bdUV'L: IK?ONg,:!"jbbM,:^Ԗh㶏ڷk'b6DDDG*iehڴ1~M<ܳfRz3$""""""""E'DD@\\qYfpuu1##3G1GGD@3"""ݻc ճ1dR<"=#C숈=|NE̤~ٺmS߂ `"gDDDTsM4Kbdj'ɱc~"gY:bAD XF-v DDDDDDDUb Q#pP/QK<ұ#7o[u IDAT.b6DDD HII_ȉ3f@PiݗL """"""""!"jrssY~!$((Hlꏸ8ǣFF Ѯm[l\Ç5 V^rbmAůZtBD]td¢TrT*1$<\l{|pzwˉ?q^}UL9:XtBDmJl)b6^ۍAR7:"BCf}Xh!NǜyCǟ5b2#"""""R@H%\Y^9 KQc+WacU]py,Za:r9NNG".B`3?w^"fCDDTJ%̚/> T㙧ҥ"fHDDDDDDDDDuN2\IN6K())i:Q@lZ:c:K- Ӧ֭["fGDDDDDDDDDuNhZ8E'knǣ"F <==>u$;|;1;"""""""""Nu$ [1:-[mh[!""T*KӦﾃ[fxvv64-\hRJDDDDDDDDDNxO1/=#Ǐ7G-b6DDDuK.]q3 Xz&?E'DD Xl\q;8(XLhz >l-M\\W_aYqضcQmc Qe0_$((Hlm[۝;uFsoo!""AHyZExcL̙;%%%"fHDDDDDDDDDE'DD ԍ7PPXhMw%'$ǣ"F Qڦ ֯#LgFEoIM_ab QUqi˖-mR Q`oo~vvvxRR&LĊUD̎65Pq.vvvm:v0J%bFDDD[!Ej -+3f //O숈aa QUI @dCuq12Bl'?__^'EBc|pi#""""""""E'DD Tl\qK]ťu4i=z QP(0g,|pvv6s⛥KE̐$ уWPP7oAA"fS⏿2Gjb@ڴšÇ^nɲ8q$~ܚ59`N=z`ǟ5Hb/`0tR]w8:DDD+]֬'?V;~ Oy>+rէPVVv{`\"4yU"(6|iB?__㢶D&$DlD)о=ޘ5)7nrrsҿȉkA.i j@΂N֭Zq*䩓v9!""zڷk cN`իp:4>^-}|DA4; """""""x7nsimٺzOb>\䌈.>cqy /bx{\D)r9S4K9FE "K 1)8 1m붭]ClXf [6Ɗ071g\UNĤDh4㘝N,;<.'ɥujK֬Zɓ"MQ[0vx\)3"""""""""50tbIԖh㶍  (b6DDDR9fOOzL˗#""""""""E'DD Ll|q*t:vi8"fDDDx 4׭CXX1VVV_|OGVVݰ脈-/::?p!""~^#OeÇ18tQUXtBD'/ĥu,bvuuEnD̆@*ioѬi3c<++ /L.V1C"""""""""E'DD HZZrss  w^8bHHR3"""wM6OƘ`ի0駐rㆈQE,:!"j@bL,:lΝ(UQ#G YKg΂\.7Ϟ;1b"fGDDDDDDDDDw脈5nT*xzxMTqiV baQ]$DFbO?/(,3gbܹ(--1C"""""""""b Qo "fScG Y#44׮ňMQ[0nD'$脈$K똉ڲ H0|03""""k8;`G OLJIXj5^,:!"j q 8(E'Eojޭ;ĔktD֯Y`cTƂE k!??_숈5qq.N'&Μ=+񨈑%CDDDWI&K }7cNeo"""""""""zXtBD@T\ZG&!?@l-[۶8Q!""P*3ks8;;ixgҥ"fHDDDDDDDD8脈7n@.MݢhcN8| ى=CN1N%˖_@Ff5|,:!"j bA\Z}#'78!b6DDD yxx` =z;1;"MEEy&_:N씈b4ZŔLsXT9 ½$N&vDDTs:/_6YtRQTtqۭY3tUlAJ$xi4tFzF ;'/DN_{w+..@aA 7`o;895;5tx&?ڌV:QS9靱T"xH1sg_]ַR=,:!"j\Z],8E'wc}qȑ&&""Kظ~ޚ6ڻ`0r*>O,Y֞B<{x,rr-S*-}CЪu:oB>pt&u2P5p}jk<}̀bFDDt/,:!"jLƭ[Iݳ}#G!sqv_| 7b(0… ;aޞ;#G9ˇK)æ _aVsZ]kpZ=g޶ꜷ2o )QCI3= H·Z,:!"223mIm۷{聦M )|`bYZƂE q1|8% /?lVꉹV+vy :uFpV/}m~wD~~6^xsQC%IM[++y}v ,:!"zE'DD\llɘE'9Wc.CDDD^^awawBO\x>ZΝ:9|ȼ@jUIerj~PpgӰw횧z:?ѵg[  "7o.b6uGԖh㶃0@lJxi4|tIt\c|Tܺ ^7wBC`g945bNE|)dd\Cqq]Ѵ:uցa}(55 I琒̌A hh:YR>UL^2M\=:bpd#??EEyu3[w\^k`ee8W.֭T݂!4ڶ Ҷ!""U6'F-Wn;)ب.ib%murzhZnFX9B*-T$t&[\.vա =֭T蜕ri<˻Õ s++ iΙ%'f^.vŝ[yӨ&g/Ѹi\m^.gx!Wn爹 ݯd5PʥM)>տMRMCV'YׅWnN-),-sK 2YO3Uܠvgv-#&-H/vtu6%'̵L5mRiBd%-A`qs%C=RsK˚5zG\`#~bښ,sqw/rs˟7)b6DDDTW5i˾YWşB'ĸп_?7FRLVeΕXMhw{g5&ƞ-1^Ϛs:l?i r,_U07u:-Ν=Ç̙}ȭThToV qHһMy:?xwݿo~lSe9ezsRiG: ĐS+uعgl -* ƌ{Cf[{ iݏ&G{q!m"~C1?MYִ׳L2M#}u~˥e: 9{!E)~qs,4!E9m4kWmGi%jO2Ke lՂ)}Us-#浟>;Zo0(+ߞ]׳Y7}-#m{?No<컐Obz9mWL,f0@:oUw߫ms^YR]Gz^qP|MH{4wuslϠ͑}BV5*7r 3-=.3c ,hR8XtBDTqP`Q[nnԩQ]&DFcX>k*77/ơ\ \ FmݼyEČò%3ZJIIV]鋌 %%dыp=u9!9oGo[э8? >ƃ-z9֮ĬPn>j}:g܂;HJ<-Dr"""&o`x_}VZ(QkZ$mt3w̆#q*SGX}a"?>vf~I[Z|3gZN"E':Ax^IuzAy95gϷvyobٵ5&~K׳^ @ջIOznw?{/wQǓz8 bI^^E>چņ_~aLQ[0~$\,Rfid "eS<;|I P\\ne_%;FS>xڬD.WBrXPRROB;[[PؠiS/*y''&No?oD&I JӠ/_5+8P\\g_%5>?Q}44/=g(7+Mf~I#i3fؿk~m>1A|/wYEA.)ɎvJy\&ɪk@7O.UK'QHTX[,E`,x(Vk^shaqF5gDAN&K.; ßU.8HRTXL󋵺,6 iⲍBzC*-ͻv+϶ͭɹj"ZE&g= 'AP+e yR&Mݏ3 ,HA-J:K9hOظ8T"A@V"fS7l۾ee1F .b6DDDT8; ѻWo())\NLĄI+M,- mK:,d^-D̬˽eKfBA5MDPpr47Ӓs 3<7}>B|)SS~l*t Gfj58 ֬W//k>sRiG΃Ъ=<=}!ߺcGw`U<|rEC<|vh/ PT9LI}gu17۲NkV-ğ3w<GMh7$\pGo Gza~AxuڃUKZ͜o[0N<ȸށ^^P׌ܢc6>!^+L̕ Uԉn7nUkuMk/yuC3#*Aдid¢6\P}=f+bsמeJμADo;zv8jI7s**l?}Ww|j޺Z*;/H֞q>zҲcSGYL*r?ڲ~m'Tc}O$=DexsMvwIJo1?2!aG{7}9s-?];4s- -;7Hݱb\kѷM/xAe'3 *(J9tNI7sUSV}V!M˄!GLku%[O~:yRVAI׊꿆vQSYODF,:!"*ﵥ:hB"""h5R - IDATD0muZ1h$ٽyjjf>{ G&D̲nqv:2鋧y[߾i%vĜ Ҧ+^M!mq9!x}9ellɩ)"Ơ`kp׹Mzag1q8ywm^яM#T, rnwu4^ǏLbxeW> ;^$>g{$mR|Bⴅogkg-&Fά9 Gfܭ.(]pӉ/SLjpC۝skMRqlF,W] ܎8[YCI[ZgljqS+ƤI!A#wz1Wg͡Z{Z_{+VT357iE)Ox~PO|ۿn=q2O>F&;W񩳃ͱg}6[~Sܵ[ܳzfޛc~'jdwIj8’햎Xq7**0Z}ԗ&W.PʤSu|m,'Xӡ9\.Tb'_쌈3G߹M7}>{f꜓<7@DTŗIp5;85rQ}+WaHghL;ꂖ!4xY\S30g(wfܸqZ,8h hӦI?a0Ys[,lC󕺚[ULѳW"Fpςlmkǧ:w5L~gr澽ʂK1bs>O`~ aLbFW|DDD Ixߌw'aV"vi3f~ Q`G:\7),mSq<VpR\~K%Bz'Ǻkढa~/|dXBAAbxٕ N*GWʤ*2Kzos_T}3{{}_1Vrz) є~dIFw}ӱwA:|1%\*~oR*8/|;{~7g}QsnT"~F!M?րꞏ7J۝5|B|1x=z>jxr+ع0a|9 Lbc@arB.#d88LA~~6<`t:-ύC&$dN_IݱM6ѽٱ7nބܜ\"FݿLHRݾ^١}{ٙ+(, # n͚ 5;?__gQ\\lS6ĤDdddA@nf -:z@@Y'ْ$]b6g`0KfsӼYDbR"JKMWԴTe*<46[XTh{ &2dd{{{`7;8}/ ==jBaqR%pt4/,++Cij'wp0=t(**2kcc|i|BY12Gu 6%=2KzMC]킢Mwou]\B,)=MRwgoqš#\ 9N txBvQ[4u͜qǻ,0h]No0;'_}]6]ԝXx- &Fv_TKeI$Bɂދ몲z6vjwbEj^!;dDDdWԸ[ Dof"fDDDD Eh׶-fΙSƋ;R [7|{SX'~c[?k lл.{n"8YMN_  &_BYY)l&cG&6~^?C HL:]ж=FzN׮ˍ?Vk2ɓ"-XC 1Ţv( b&2wtZjŹM65/:j{͍8bɒeK_XXŢ_o Ţǎ :t0+:7f/{hNkoM8sg1駈O0֡Vl_aor9bN4{A|#hKLL/`63t:sq;:o+V??L3'Oݹs'CIS&}o|<&1Nq'͝8aޚYٳMOK}M]J8{ʼi˖hoӺRl\&N4kz 1l֛soŚڷk5+ͻn}`6n6-(J$8{:l͛׭CpiqK0!Ҽ#ܻcѣ oş7kkW6`&uW EX191z{?KA-c oD,|~*۝a;]Pn=HpkOcz]cׄ @UHym%V>ʒݧktz }6W5ߒn?q_^[{;\tENe"R:5ȼ}bIvAi?HIǎv Xmۧj#~U٫ɱ4箭=+-ְ脈7}C""Sb:DDDxzz?,ga]Jbd 97` v\~ʹdj58x` ف3k)H*M'R:kۮ'=Hm}5fTFh)Ovkh^x*[eJŢR5P;f&L\7{ɦIj~n[p;^&N,:!N꩸O5kzlbvw@~K$TC_`sS\䘗䘗|. ǐx䂺%Z+~sN"rwRi~* =?׼E mT&*fVM)CB)\Դ+˂Z] VcqZm4EqQY]W^2b޻wp28MD 777+Vqѻ*[=K.ټ%[Х2*,J$2bKIU郾}+X miK<==-X"H lށ*[xu0 E?4obѐ%R0ũV=jFe^={WϞVmc,Db\x׬;qxL?ުǀ~Uss?omܩ//h, 5k+H K3^y3^yŪ#GKi/D`Hف 5oUcT"|i\3`l>XyR5(u^ZLu,cI~qY_l]Ǻ>w_W6rSOCS]E'*[gwd[\99:PȤ&(+әW%C|Zݚ&),.4:3`r`41=6FOI$B3#zN]6]VW]Jɚr)%k-'39۝kto[cxuEiΤ}ϸ9]|Sp62i*UvJ'qn:\*19`ϒ1Xj7{!O>|YC C4Z[ïDbdmk `RtPHK8v6گ1 ˜O{+=_:{Rne$2LRZqVW${2T5y Hjg"jXtBDT^25usrpAxTHH$fKb=\9mM`щ/_Ě4O=Cw}mi^FSVkar 瓨-uFqh@?vQe'jI`>s~ϹI鹝s znj]症|E*J5F_e_c2\pb' ZRx_|jD!mKDTC*,ckk>>"f#m۷A-9r!"""߆{ʬx;6mڤ`#t_TT-gffQ]PUL*o=r||crʱ6tn׹o~ }_L )NoܾM8{5+,w9["H2嗪zȱ*]앧Wʪ1S JK.iu* ¢"z(.$uF#*|iOl77P\PPP~ 6>0MǛ,8ɃFc{⒔ ,:!""V-'?ĠQ7o:#cdR=I%m& bc]^>1Xݮ}?I%AtM(g@bznU*G[EvűVw< ˈb Q=[Ic^Z')) .\0G1"""A5)4Al(U_) :1.'<ବ LVcǟBv=EɇjlT񉽃wm+v^uN{wB#:hGL.x2ڃ>}BMUխ8[=W+mcJ1_`NV^ǧĢO$ :P.DDfG㉈)ZqPPxɈbLC Qiw$®b2;88A.WT'O^gÛ:>ߒlx,0K w$i&hڦIӤmf4iھYmf5& a1%/l^x%p,!y}l\uG9liM!CF;ڹZl._`ǿv狷ݷ_ݳ78iN"v')F=D$ُ|Ԧ^9%^5le=KYUC_IM9Wdí~l[ay{[tZ;kk-nNIIMպӉfu߮S3g̐hwI}}\H ti+͚*Z}yyueeMn;ϥCm;!2N揎j4-Tjk]x#ޔEmƛkZm."h4Xlm9MǢK*kGA>Nç"Nzﰟ;_ZyWZf[hZ:0`VƴWk44矽4?~\w6Y]_%%.0p϶y m9:s*s;N\K^mOvcX`ehosy%$|ӹbCiyw?ז?z{ _U dagں)9 TԻ}-wdDBq$-nVwul6ѽ䩒zaΔ:.^^^*V5qud̙*VCSO.?|>E,6_^^,rddr ]R}{g(O(矽֪?{G 0޳;ͭqz/Y~s%+!AN&mӽZ]ؗyӝIz+nk5哇&_.MS +5Qζl|Y͝WX^X[ל#iˏgW]M]{orAcMt/woKTT5OW m}DŽ+9'hɬ9m-Ӎg`?W^]gU/fy:9%^Y{dD[#݌:Z[wS /艎&Go? 2u >Y ;ijgRduaRYY--wo%Vj%5./Dӵx߫Fʛ/k IDAT+sy'$}:}.M>%9r‡Z{OƎ-mQ'_\3}_z zwKr6eLV<"Y~d[:ɐ=d/$ R[4vV%,`cРmwL{Ȱ&w,ٝ7 ?/]n?gktH@?tyz&6kFOZIJ_NvxҾJ.V2U?{gߗM~^z?;>[O=V^SgqiK,Vz7aި۷*(_Uo/=cޛPyM]ڻgu[z?/`Xh~>JK'F\z=+^7>\ay[ѡza'"cDzd. '<toNl hQ-[B/]b5]OYYll_Dk*$/7KjƼwȜ5#ʶ+[]))ALI M>~-:sÍL;vt<,1&pxxxJYYdď$eF~|+mLLRR%#'\?(b鵵NV| yKzz@+*J䓏_>}U"b'uuRZZ pI+LSRY;fJΘ)9л |zyy =*V{e]CPUm}h%nonK79q->298O~\DD\oUVUleW]gΤ7WH=[ӽvnZmv&}5_nEVAY=0/󨿷Yh-UuAE#j,J#FSdBԫ_KS[ê?JXd.~*S[T9''A>N|`ꇯ_m(-zj,[vɳyyһik,VCfw:n̙3RQZw:Y߸ExXh=Fj-eM(V]Cn!ᦇE\q/~7yNX,r~9uj4讧Kӏ_i}{_)_K91")G%5Cm-SG3O]ooĸe-|a?7? _ܽgk:OT6zDx ]<3۟(lɅՓ]jjbG=tr})4Ƭ})9ol;y6ͽ@2=wtiQRY;f'r=oddv=WQQ}ezoI~2gJ5z/1s3V3jGOlyNVA~u wL;Ϙ0$x7M9jl""׎x湋4-VDD9_/]26eJx!:$M`c"ѷM :oqHW~_?~V&M-XRU3 "w8ȷW萝 KkާU;g˸s7Dz.U^]m._^K qoxykrJ+׿ؘc ʪ5X6Nֻyg w1ob8uCr9%1׫c#^Xwߙ5b@f[ҜN92ou*V9No#w:X,nze>b5+''G>-a; t]n Fj:VڵbZEDDET@k:.d2)džZg%88Xjbٳ`Vx2QRҔXZbfnFDh0XMZ{zzusX t]L٬t:b5bus犷h B'ŘC'^Ws.),,TƴB'ŘL&G։S{-S&OVmE*)`VSQY!۷oWKNJNS"mĚ Q=u7HMm2^b5ڃ t!&al;ط%AjBLɍIPPtl9|2^lh/B'Ѕv:驭uʼnfV+^rEڃ t!uƞr&~Zx)ҿ^N(**elycǏ etIz,NH2FckKΞb5."Lv^zTkhh6(]'^^^*Vr:.”lV h=;vHqI2^Dj\&tc&scdb%cM|rܯo_4i\N ̌ elY2ٱs2^+ p?RRRb*cC 륮N.UWL&rj%zP[ 3{FN 0'Ab5W֙3gرcxip:. :1FGXɕ&>^l6\e׫\+ fIjJ26 *Vsvr_ -adhX~@'0[t:zRIw^c<ϯ=)+Tr\<|7yܙeu uV[5-p⺣YE r\W5Xl8>hFވ⊚V /R{Sr3izݭthX`} ms/,r?S\soJFniZ_#|Z:AVPuq؆@'!t,#4\o>*]5K|}}9]MjQٶq<2yMd`x Y$urVٰ#*o#bdʔqF'}Ynuk%|lV0{-/wYwTƈH[KΑ/vlɃ[GUX^Vf/W`憰@-3e~O}#_{pED=G)ms:*QB'we* IDAT2v զy->{Mũ94H90vwVՎ&i;\0 -=Ɏ.uZMgn[ޚoAsO*"O}cΤ_x㊟t t0:"k}I^~V~lBl6׽xON\qwIȤ i%2*F 2vVC{f'ئ:@)j_f/j㩚:|CV!\)m9f-ƚϼ}u{=;֫5V>"b:W-*"0+6=_R955[m6}vQżO-y])"bڼ'$6wގsj/?}l:I+v99/-t0src$88XTm+rʹi*V8|hx`xL{Y r_6N-GG;̝NOlUh'N[qwj5ήbGtZMMWj]bDw0-;Z{7J}klB q ={_׽TDԹ륏l6#൸Y&1>=~&kVoljʫV5X=Xms1z:- t$NSkjټ /www+@[TIIy#TMi::-Vdl6hUJX$/7SrrNKee׊^%ҷ_ r^f LL*Mz#N{.IVYboo2JЊ:RZR Ţh/H%|A4>@wڪ 6<׫^z:kF_8eIC̍t޾mNUE`j螤lcRvє%U-VwgԪjy <0>28Iљ^n'xܝ_K~fޢMw~HHډC>Or4+ԼzEvC[pQ}P[x`Y6mnV)7OrVŸ{돌t,sivQuRso~{`j {z񹢊"Qs+%e0bϖġ??qOv$ X/5iǛZ] `; 3vMJ/]ry@+++t; q+--l6IK=&nS%5444_=Cb'G~z)-i|^+xBbFM,Y]ٻgTU;?ϿݳVV<%""bZd֕aGt%ɝ?zO& ?wKudk%v}>؊g.dAe|z}޹گ92PDNt;twKSH첟bϗU;==tO8#st_N8 'xǮ 2IH}]÷L7qU5#GKeny/VB':by]5k.td.'~I B'ЁN'kA2rH@{9T{2ʳU]RYYڹZv\-3f.~GmAVY _(>O>zIj<&iJzzcd˛=ul))Η9QVV$;-;wkg@-yskVNdedPİfϭݻ8BBxOz^ _=o?{eMΑg{3B{$7]kG(vxsAl*pJtH@?Ѫ,{|Sn߾/xRZU;zuRSǀ>~IJw~iVS'r!ZPzޏ.Fɥ^핵 v&}f{;on|9wωI}w_Dfgɘgnv/w6X^.+lA+"rl3 Z n}OLe{Nϟel2@{V~bt r3u=k+8gnV?Қɿf'""6SzEEInNw7*px-lܝR^^ڑ#9ͦC->g'OLt=oϔ8 ApuߴZ0kuۖ+AՉ8^ 2(b*^޾ӺIEe;"Ǐ7H}}i'^zv7ٴ3eG&LN"_@ܜ ٻwN'Y.E""he2j /Z˩Es &.EE^^2c 2vܵҧOXmV͐d80GjQy奻WN#_*+KEDV̦C3&ׅ5]>vnY{o^\coȩ]nǓ.mcbzT/ǔ->顽}O >^n\X:]V1=1ʹyUJ \ۖ`j+pm9DflN[3Zʼ}ˤGl6'NΘa ]j}dߡܒYǹ%\9W\W4=k""V-'G>u$0ɿ3ڷj5(B'ЁЉ! Zm`*~Zx 2 ,Ljp9Muĭy_Ҏ˲Ș颻$tcN57•Իw,W\.~~.?(""CY@Ο?+_Kҩ]wF[!F6fFozXxxx:E dff$b$ؠ%l$|a7VoJ: .J)O0Z}ڴ&]/ܙ"2t`t=&V5{Sr )_W`UԌ88ϯfȁ44=o8NR,ޞ'@MN%مNZ'dvKĪX .uou>;W:ON'^b6IF"1L^*U+bXaNt(o}{-}>oy;%k?lWbP'Q̽uvhz׉mr} S'}:<5d^u驊AFyI]ED$n{rݼۥOPLs8[V4y ۛ9ٶuTIjQ1bphL4k}] }b%tRT^3~ы|3΋riȠ+8W\_'ulAdaEMpMŷje:Wg؏,8lV˩os˫IHX"l}uZ-d%EÛZlRT˭\L^k7yԡ![gKU=sHDƬ7m)tSʹ =}}i[!tF27Fwɚ z̛{ryxxʯW{6tzJ&GlN'a0^&JL5鼎꛿Dnyeyxxʽ y|2wfk5N[lव=Gl6pr ?r˃l޽C{__X,q'rOlb CKժ q i7TNobitZM[]B=Z(k>΍ jmKz[mᬂr|q":kqLUB#}z>[T@DnѬ|1/>_YZUh! n tX_;X,YmΞ-ml~Y}?~C{% & g/I24zluM\L],aQ-/^EEL07cr kL8OF#ܶ_Ɋ~wGaQZ-r~4y2IO;GL#޻JL-7 V.ߝl6)g2k,rǏ~t.|3=+粳DEɓOi??PslS&n޲EN=󬄅:~&/ONkn6u\CC<Ѓ""-: Lq Nx%7ϱey䡇/$`{Wڽ[^zLBBB223i=ab /id…N;  skȑct:SH8 ֯wH~rrr_~vud^U׷֎5Z̞4'HA!!VpM$uZ<ϝ=vLl*""<= 7 Akϟ8k̘>]V|;6lײ7VIQQ\~}ei;wd9V+uԴ49r뮓`_QQl޲i dpDÜj}ڨ(7{ަﾓ "d9Nk="Y4̟7i3gTRS^*--};1bSKi&7mrZ;p@>l{{z^zHȑNkӝj42yڼzӡ}_?>joWJ*~ d/涼kAזhܴ:{;z{ZEu> [֞{xz86>#߻!!A*Cg JJtZM(; TB'6;Lco?ܞ8f)׺%w͉Iks:b2cV+CZBZ+]Y֙,M4ɀCOVJ%'t'Ʌ7?,nQ^>}Z>23N:N~_G TB'"":.ã[^ g,kb8~xuƬ|ߙntJNvz1d70O2ttjXŌ.FFLݻ.rL+W/%$<-t"rr9y2WRAk梱c\=;~\RRSjjj]MKO9yx''7iHUU\yY˵K;|Z.{qz~cƌGr^x2Q6l0!̬L""~ dڙg8NV|rZwww693zIUNu:IMMsY:ϗ_Nkp جVko_eիGr:ٱsssss:IJJrYnjӝB'999_rZ2tjns:Olv21z(69t:IBBKNbbB'gϝg_xi =:l.׮Vw55 |j@NG:ݵg"/0u_;}ge 6˵r wNoN/fHϜd׭{~[o ""< p ь/^gߘ3hF[st;=UQS7ԩˣ:[Ph>.ǘZ><|aA#U]#M;4őW|đ[mjU ߈|Y?$"wyz=܊" n:o5 ʙSVr׶Z5N?{;@ ^z7RsJ}B\i#[Nd:Ka'9'"SZQZU$͂|<s[(K:W4^DɉBK^Gڲ tNؿ`1X<==Uu[|1j/6M,V贗BUt:3V3VIM=&oөv)lʉ'];x4ܹT?rhhhm;Uee;*EER[[% }Eua^5hc5&MS41lni=&[b+JG@҇2L?ya5{qyslF^YiywvMMEJT- Ȩ!Ol&#ݲJFLVfV1GzNZv$im>IE'&)cp73KKϢnA߻NA3FyBXuvvƞ+`0X~_;6.]XplΝ=k6&}_[{x8_$0tҸ<^U"iܿrŘ.=0iHbo64ئhe_??C@yB>p4w޻caUiQ籮xTU57<>TPh>H< 9c@_ 3G52+{y] IDATf(=*_g;u2݈z}(~ZE~臛st;+\k <9- Nj}~u|ܾ1QAzUt"'ҪЩ1F:wj[UN 6==Bɧ7t~}<-TO)ӪUuzC?(RTYkzh"uXtBDMRut:u'Θ''7ADDDtmېut9E z}=rsSs#-PPߋo>h8y'*:iYrEh <<ߘA koNsdoUָvCKjf1- ="?f*$87[i8%F5WP`vwŰWDx_V ]ZuS5WP=Ǝ@,~`<ZjKK>>>mQ(vwc#F`vg8[mZآP( ϙckL1d`[+EP=:osg%&`cK˿k5:[sG%Þ*s ?sed q*Zߖ2]::5p\`Mf~?ulQ:CcKɼ  L+@Z~E-QN'DD 5-"E'8tNb""" z) O~}ΞɰءC_+WT桤iO]TwÙtpLtbF"$$#k_mӴKg:\s1^Zl/Aaӆ/d(k^tP(10Aaog,oR*7ßނBhrU {U;_Ka=1ǏeitٮڧNojUYo2BAW?u5F鬺ҚlcMrj-^Ҟlo]tWFZUpۓZ8,:@lvT![cCk5i/:)֢$:HG>"E'DD --Mz_ߞ}V_lp3eΈOQ\tcRyw9iI[gw5Ѫsx񹿢0bکp]آ#Yuט5~zR}b< kYPS__յl  B 8s&8qxV8(]RI.)QC+ ѥjg'm=h[z`dDMv:l̻,QfQT_7vM rYt;Noו9!@u]TtRQNֺ>L4;DgmE'gʪW雟G)^?2N%!/o0}~FSP7i}=QOƢ"nڬ$&&=ï12fCDDDsWTϿ␐+=gr8|IGTW#?߲>/[ ٽ"?xr".++uL&**,orvukC̅㑙yLK> 1(By\㭏{rwF8,ykdl>6_@©CZ[vxYXg4)NJs{WԨ:-ٕ].|ė;ίQ&Js_H>SvW>ڝ ?І$T;)-.ZxM7mq7wۥcI5y/cOE7N}as wՁ+6kQƝWa^n>>_E#Zˉ>>_E+DD=!"bRR,\tb2 RU9S=ۼ.F>Cbѥd0k[7F JpZ(|{@1#R9K'Buرq#䤲!""\ctUr,Eҙ&ZXQ0l]wR*~MeΔO4 <}\]f}J a*B+#9] ~dڛRcJ*k/l8/W1owj'wiMz!u\/v?pYM_'DD=k.1iiMgGGGC?j׬m:ZRlzD.j5._:Gx㵅xrLٽ&ʼn,j uuu5x;eAz葷Tv_} hGWkʡb-UUuo/[ pQ9ӦAl6wNkgd^S5<oyΑ[xK͋Jjkf<~Xs!""CtwyvBZ0=y`Vww/Oycp?OAIs#zzfǟؿ)B-x\tpżkҠL'x{GXouQ%wDDv:!"biMĶ1S^Zm&I3"""b[p);12=Y^^zsݽ1v\ƌKDd6E),7` ZAt23Y" ICnnuGtq2yK{< ZcsMza,o) sJ&[saqui×3xyx7jcGw`'Snݽ޿77/l{}X|۝ݽѯ_1&*r?o|ΨtۉK *u15uWF\ U2OK'm|lp{ *ս|lP {*Ţ_H߰bY5t pYUJEZ,qӤF&!̯tllžZ6pAB릵lill(U6 .H^8"w|Hθ+ FKT^TTyj8`Wg4T-6aW_g 8x1yɍE'DD]sr8& = ѠKD!"""L&z])]w)_B]7|JFxD<ܼ`6FqQ22uBb}S]tΞ1L{<Y*+cٽk-RS`ĹJ/t5(.[|bo(]k%?G7):g41tDl68oFJ~kqAЉn;<<G{LTx`hn1?hE3EDDD6wiьjJmkV<-!l]3[7!>lB|ȧ>:RPm6,Ok;ݓfuUM+c˼qXNQyֱ{ڟ}뉈z"uLMc{pɚuM/GFD""""G᧟- 7W6V^iڱNC&`P)3yZ.n>vyBBD DQDzzSi'HJL/"""ޕ N[\\\ [{ @ʝF """"""B!wDD|n81֭YVzh0ed!"""/Rc)7^N,:!"iiH899ɘUWKX fN!sFDDDDOPVV&ŏ.~=#"""""""" XtBDRSNz:[/=3f d̆H>%%믤xt52fDDDDDDDDD{脈" degIqLLX;z(rrsxVbwECC?cAƌz/]l )iN֬['=j.[XvOZ M*cFDDDDDDDDDN.RjZ: :t:1 ظy_wTh43""""ބl899EeΈwc EJMo*: Xھc;*++xVRR|M7_h~,:!"HME'=h>>|CERjq}1#""""""""K vؘsNUUݼfA`!]~~]'O{]rs<%"")E'DD~466J3d̆HX.}.]k{.Qo¢㘣 IDAT"f8`"#ĕH_ ΜiЃBtɵK.CDDDDDDDDk脈"J$c6Mp )NJL1""""yO>p̙5K͂"""""""""]ԴtqlL,k!"@Tbƴi2gDDDDx~QK,Rka:[zұDDDDDDD,:!"iMuDQĺJUcWƌ|1Wp׍] r'@D[ju8{9bWRRcoAG?"sFDDDDDDDDDuRZZt N'k֭ᚉȘ 㥥Yt~>m ,cFDDDDDDDDD&uRZZ:NNN1z=6n$Ӯ Zƌ7߀lT*,z!3"""""""""4脈қN"""Rdm۷Fd̆vލ{H܂+Bƌ.],:!"ꤔfNbcz:A6t9lƲߒbwww,>3"""""""""脈L&23386Z kJJBDDDtXnNH}w///3"""""""""H"N8^/ű7F)N1SlKIq̻63"""""""""脈RSS-⨨h2if:xɘ c}(,,/]XtBD ii㠠 xܶ='7'xVb9Vuu5>S)FRb]XtBD iME'1zj鱓O.c6DDDDPUU%K]u7 GD ͋Nb-:E_/㯺J+DDDD_P^GqcʘE'DDTRZr)C_P t:)~|cP(k-\f32238&:F<~]^?^^^BDDD(gϞŏ?$㯺 cF1#"""""""""b rPWW'ű1?pEEER(KDDDD7a0 ^$sFDDDDDDDDDĢ"";5?Zbecͺu<==1ADDD('y)4 q2uHDDDDDDDDD脈Nii:<lw)~upvvvxDDDDƲeEV…2gDDDDDDDDDDNּILwnwJqRb,y9K 3""""""""" XtBDd4qLt,94?Z'44C%""""G0xw }Qs,:!"CyEJϕJqLLs(=W{JD<姕?!+;K_nn2fDDDDDDDDDDͱ脈)qluzf H+@7ɘĢ"";4;ZGѠ_hsXnxhB?4#Yƌ%!-$:* c|ffe!-)YIݟȑ_Hx\wT3""""""""""[XtBDdrjjZƴsxDDDD娭G?Ad̈la Q;z=NHqLLC7X7)z;4""""G9,L+G1#"""""""""j t0LRN'{Eqqh"""2FR#˜eeRqW͒1#""""H٦JO9QǢ"vK "#^^^j8ODDD(ǎ[J 7܀Ȉ3"deG^^*jkQ_WYnn^ B> OOޯ 9O!7'ee h\/RR㛯+qF脈Ѽ>sK LXtBDDmb Q;ӤBCjw}}=~Ϙ>*a9ҫQ.j5m]}Jl{dg'۽?11Ð0t"N]rrNa 8vl!6+J9M\iw~DDDDDDDDXtBDԎT鱣ٴe ꤘGѥj8ru]ӧ]NڇW<=WsZ(J|]:Ahu?`/q&/9L& '\;~Η.Bz2Q!11~h4boI7v3<^z~~ NZ2MٿoC NZڹPUuCDDDDDDDDN'DDm8{,t:)vdR߿_gϚDn^?ɘdlL&bJaïѯ_ݽqC]m5tJ=8gfrui4nUHO;]֠bMAA6x埡Te""""""""G1DDmHMKcbbu`2?^̜1a{9J]]C)߯nF3g N-x~!Vk<<|Q x\@A~oEvP(1$a&^3ÆOJlsޘm7nGEQXvv269f&cDDDDDDDDtXtBDԆE'>w~]'=1|8XODDD}PVԹŋ_U?i16$ax(J.œ}۝/ jn0C"CRc_/Yf̼ !5-Uz}SRSԞ<)1a{9JIi)>K)ߡJ';y MQt/܂ԔXU9FlN]:E'DDmh$6&aYVzV1uʵۛQ[ǖB3ụΨvwQxDyu~酕ڜJzZ2( Â+TƮ~dA{iE y=[KDt)c Q+PTt}LtC5LXoR2@wd&(vgO.iX7`IԪ<y`F OFGS[L71VE'? \Ny~qW\4|̢ކq3V ihh_;BruIu?̡ S=+jԯ:8d^ل:}h1MT;)4Χ)WF9' +6|,gJIeZ}cQ~oUj5Ϊ?w԰>'LM]ϋa Q+w9X{;R!""KϫoJzH._- $z{ .6:u*DNǎn߽mΫ!=0c/+ tY.Ueqfڝ_YQ=Şݿo^m s:(n釷׷}c4P\<ۻ_}2n#q6eeG[42gn+Ϝ7ڛk2ڲQe5]鎘 >;ڑ5n󱜇FS@;S䧯+rNٛlk'rE%uW9t Q9IN5}{o*LG>'"ފE'DDHMkj3VֿCm~ƍ}CؾcӨҢBKVTw 7]kDь>=cGwWGccC\,3ep<f 3U|&\wpWS^1Emg̢֛Vo6 Z[N|}yEí&gAYmpW]\93͢KJ~9_/{Y92 F7m1Lm}|W}]o4u QU:z"YH(nSW[JDDDtEoLZ-3(ϒↆ:m6djvoHh(7aVsq"~8w juUDzcaE",lB/; t*=QQQlfڏ':oURĀ>^~p44Ԣ RzЮn:UexG N !^^jQ[[JKEVq{}""")3,Pxra]TucvQՍe}]7sxY# eLKW~3_- NN>^<4WJ7uMWo8WS׿VS7:*ϻpӑѢB`ԪN*UBc}I[k>Wkhl9MrVTT¤o4T7_S^0O~d?nxt,fFCh8gxi8yh+:}B_k_QS?`2w}Y^_{'NJEUvŹClh4j􍮥uhG~zIDԊtq\LCܼy ^TMJLrȾDDDDƍ8z}k3ua'cןk,֬UUe{")֙L&lG1D WªD`13խ{&/\-AQWN cpvviud®?W_tg/b ls߶/C``6s4qlA:]qm,cU󈈈ȶ{ Vl:dhq(KGV׏ޗQSzhH=$&ubrl{!8&&^4vNJ˯ݭ9,jC[4 !eݑϖ]yhO XVG緻p=myO" =!T9)nsFmk, n9i{F<^)&7U=v|yokѥE'DD6 dggKqLcN֬['=& ޻RUƌF?l~ *:1f!rP(;dcnn^x *zhƭ|[f|R W߀xAU9ǦM_[6=˥Xq8 CƐa4~[,[o{'}pHnˣƇODDD28 Okh4坫N;W,:9kqQNK+nkmOSZeq>_.uon٣"^J+'[s[?!>lB|ʚ:#^]?xГ_:{YgWk.L9sVNJ]4 o>fO (pꐴSU[}XNqKMfqMM[mBDtʂhlllY\RJ$v9!""K˷BE>W6&P*xx2:fRgOa?X8Bai[cHu_0MR,?]'i4nhܺ47 N wbl֕miyLPv䤲9."-3.ˮODDDg̅S/uR*]cEuyME>oGgj?=\74gxi]VI4"ܞܵN:tVG N.[4s+ H_Z}šAٛ^/}R**)8iЈ/("NlHKK ns50+ $Θ{9JN?P â(B4vm}=VL& 7'[W_*^z}<{ JF܄Aǵ=f>8bmhYݥ -ÎD|!XAA~'i|ȑߞl?luH$$$X޳55:1oo/9jndX) \;eܼ4kr*7<#GjG^ۖ|fᅶ-Jn:h-~={b  iME'}kޅh˯΅9bz>z%P*{_{`ߖkfظ Ž֔b˱v4|{wy~f o/[L)ކcft~-=hwwT*ѯN&7u28f)S>T|K>AoL*sG_ 뷑>&>ʞOѠKw&>f?` />ҹ3֮6|>Bfn&R0Z܋'Fŀ >4A㓟+PH,K .]vJ%l0y3k1κNѽ:Owݗ~e~?~2i> ]K$N1rkZbIs5'>% ǩihnW物û]6ԼJ0 *vѸ~6VwOSeυ ZVqk[ ʧ;X+*$ >NvzU}e/={_xcc.䣴<>{5?X""脈1xct `cǰXbܣ{w 2t Ӎ77B4Z[[[G<;48 Gl"T P4 vX;?ZTtZ{8{Fdv0Fۧ:ї>AbEQEy(U@V̑S۵ӟ>A@Ó#]0"+@RbZqfR3iFkhhL333LLҾws WWW("=kXdX^ OJx|hUVPÇ 3_s{ L{k߮}q1WqNCA|| ;K$>`CopɝHu%TU_iv̱E} +9DJmPia]YW`J]yzzkX)*Fbeeh,Bs<*pQP۶cR^zkBt歿'__;ܼҹ6֕"&uxH$%w7欤DN$%%UdaQѝs=D28ZL%+-#)R*=p%/V5J=%IW]2:#X;y%mKOƤ']U1{.Xw!V'\HʴM(-VZ* UjޑMť*66mѺ#Z ZJ]Csp.(q;N쳈g׶KDZ Νo?DD-NCAţP_>S_|Q㏱[𰴰={ &"""jޟ3[T X˪*[iZLy9:}D3F~|5.F+ W/!!"n\18";;'|*Oʨ N~];omoW"-Ńζ;<'^[l̒M.͒~Ĥ-gCWX9a_ "Ow:<$$Tꒃ}O,ؔw[[Ȯyj.:Zm`ݑ_t:UJ%BaөO ήDD͝Tj~x RRzȍ h4lݾM>Q#G  NUĂ,R,.#8tp#NePRP/_x{b֜_ rbO0%N=Ÿk?E~~^/)_X92wq\|lm>:FǎԹE(C7n~mj Ԧ!ڱ:u++.EDDTUiX|4.qY )8]u=ҵǙGv>WbƴNħI.JuNOv:Akc)Kpt!g Zc_14#OƿRT4dFSmU'y˭*ȋ66':2t>#λYת {|v*V]wFN.]8l27Kr5W:Y%"jXtBDt>=2C*?Ƙu%t 3^}]x|7b,R tP}IIq7qE938a]{Wm[~ss칫ZM@ՠX*fZ—_cj\5|Ǽ`HMMtNaa.Ξ+b1r A?4|4 ^W/b떟!YG0zshܭJDDDU9>+V*T3L?>K@fchL6gݑ{5-ATRa$ҼČ]SY+;Nd2Izkij?2YkΪ"NgWWHy㱅>ζGK잊VM|^2oRvoRvt6{SQs¢";(bk{{{xzVsX6EťҾDDDDщ'p1~|chF{gCuڸ 033Ck96|}c?0$&^ڑÛ]tןKizc.3o5]g;i4j\dMCMVkPp"! o;89y`mcw߾ǷiπطwvW/T;?33 -ǖ+18h|-Ҵp'eJ<eeUW8vt ݂ㅗ""zki&9Ljhkq_wy˺GR i*Otf%?ģ?=Uͯ/z?xA[F=#++86lw]f} :7G+ =3g^{Oxk_G<>p*ho`i6T5~>rsq4ꪦ"esa)7\Q#"""j*[6S/90+Wqۀ5OԯС7흑-egBթ{0gxz+:u+:ͽ{N߿o3r?@&$J6}"W7 yp33.sq.TJvRW kt .aJe bO…#8ql22nͿ Okt ɊCNĦtYpOAi j-zolDDN*(,*DrJ7nIDdx.(!Fݏ)T*|bIO=eŒNTYCu*T* -֯: GDVVZ#2b~_ޘ f[ o@[W^JZ4sQLS $3%P;C,i"~]Qc5xzzoaau0|~q^ ];䉒DDD_g N̤\w!.'(?ճgs4%/}Vp*๖Y XGN6iEb\T -,1s2y +=+ζRpJ?f%p 5yK7&BSWSP;YI3FuQ.X٦S:x_xܞ[rg!"-EDԚ(>!҈'3bMٚWGT/(. I+[vKû[K/D*脈ud2Ӕ""Dz9z.YҨ?ZvqZ> JeޘZCDDԚ=w+]ۺfJ AT0sO?s/|n533Ia8+ث.^d*go!3hylcY"HAoTbV?"&U!!. !gz1QSINIyݫg/ 0݇7Oxu+no.㏞gLCb¥zt#`W޷{Z\1W^wvĦ0!z.]OWUtdX<7K_jj\yr-u:H/>~l+20E?wkzs$Yšo}q^KJS!9JJ? hnn^ZϩZ;_yZ[?ǡ7*YKS& P=%*2ƶ.)eMű25\TO]Ist{mFg2פ/(Vk|1Pe6᳈~dڧm~.78'?˝͡ZH#=Ӎ'h{H)xo͡w* z~XHDԜժڐ5zJe';4I'j۶makkFً( lٺUGwOkbblee-nVJ!&bbNayh wC@Pۻ 󐙙ĄK8yb'rr ֒KK JϵAꍕaG B{cނ?}MAWg,Żo#;-Qx1pЃc(v3A<$#>i5ع7h4NvtwpA wLfJԔ: [7,w_0._:V=nosu:uꇀN A~-gyzA+][[~0zAA]607FA^^&22p;>G'VDDD iu:q@w!q]۸ۗg;y,6w\jXFPq~ޫ*+d0^jrn)_\bc!>.u#ͮbB }ntfV_+Y>x0:)Ly{1# Cvw/-Tt|o>XT>Nhs0#hP[PiNod=֪SM IDAT_jfcW;qwVKw>wJY#t:D&P/:@[4xQd8lnݳglv^^N8v%1MÊnIYJ4z{9u}6Q3Ƣ"Tl4I'DNn@ZZO> ZLWlfђ%yhohԸ+qQuo7Bfg >Z=a<'O6xWezGDH^*;E&7®k V*Nĩ;ƫ6̘,,j.q=7VU'|h%""VDMy<6%ۢ u:@'_G,2tgU_o(k3i#L~眬>_73?ھRVQn8BwmQE%B՝-nThRtRWtZf2ϱ8 J:]-x@; g;\iZ뒘7>1#oދ7!@ӡ {'߾x/u~""f|d E^ްo}*qwsC>}MDDDt;x+?!ɉOτ͖[mv1׷/&< 3jZ;)ة>x#º5ӳ .YFAjuȧ<5*5M@_':WurD*ʂ kL2O>n%""VMP$Q)A(e冷-X1Yro5A(2ښGc (+ze' # Yr5MD&d4g^՜Z$ Djw]U݃I'DDQĈ!Z'??1G#ۉjXevvvxLQddfb-/XXBhg0r3HMM@}|8bOWjbg}FZjW7[X7J99yj#=O17^WDIIg{{qPu){j\ `e֯Sjll1x#x鰳sp{:Vy /}{397bk{AB"<>l#e62Ξ,]q[ML.Rk]L*)p:/krmsb~PyY:e__@3EPE jCO ]ukK{ZnVv/,};_9H雚S_\,jBvُX\DDDDMeÿbbog1]Bu48p3ztw܉wgQ`o7EM.++) HO{5_WagΘKO6+$%'?cg''̟3;N,:!"mmlc=6nVG3DQ<`=J~~>Vr$"2Bu}"""PTcooǸ~6{DDDDDDDDDNUS(ⵇ;ƈt:T*#Fmm"""Y%!l?9zo ]0)&̈a j1ژut:"l'"""j*| 7߄Drw*YPPXh1wyDDDDDDDDD _q#V-I'!!r{Y$%%qxMDDDT]úo>&̨v,Z^mژ0#"""""""" Jvv6n޼)`lmml1tPMDDDT._Z J$x}LgT]{vcmbܷO,:!VGP! ֵk$"""j w@TT?3i2\LQJJJ9h333|d ,xɰ脈ZExl9zTdž  Z)j|bg&M2aFOpu1>et 5aFDDDDDDDDDĢ"jUrss.!e j5A5?*q˰1aFU;r(w ųA5Lzu{5aFU۽gl*}zO4aF@Bb"֬]ku]E'DԪT&5&NO>L1MQZ-ޝ5 ؜Yj¬*,:!VCCi.]Qc۲u+.]$My...&̨rk֮ʼn'x1| 3"""""""""脈ZNElI'deeb>xc&̈jE'D*(bˋEBkƍL&ðop^DDDD%=#k֮=z`&PYYޛ=* Hdbؘ83""""""""" Q#^קVŖm[x!ptt4JnDDDDa(--_i }׈)'g&̈E'D %5U:q11[LP rf1~`t 3aFΝ/VqP`O{لQ]脈Z:NC^gSDxc܈çK?Vp-_1qFJKKYT*ŇęQ]脈ZBdh۶m/)){x@&-?""""c:|=*{ &'}kׯScǎ&̈E'D)*o׮#;vBqqݭZ-}\lm /0#CGß։qhxgMNŋQĈz։sNFɋ""#q9:Z989:0#}3.fff&ΌE'DԢi4\MHcnE'8q;hRė|-x'M%|T1~hdŒ!XtBD-Z||~g1Fxx 3җ5>X ?At7N{J&Mzf6,,L5ov`pLRv۱lʜm9-&62'"脈Z4Eo//ʼnq1F͍X{wQAŋ%L!;+ 11'<23PRR<[BfnGGwӫ vO9UƵh$'#?? Ey=>:t {#>)57ؽkؔh9E'S脈u5-/|͂2@*:OϕW|ƒ2a,:!*脈Z4ElyIHHH!^[XX`Ì$?޽zM7n]xxh&-pAtZgmm}Эy,:!I'`yh4زu;d(쌚1,b9&Ψ\zF>1vttyLiȚ'WOSp^xiIsKKɈUN>GlƉ>%<:a&R|@DDDDDDDDXiiiyN=7oqx8['Fm۷Q14Ԅt3o.ű9fՄYNAA,|gee())j~* ZCAF 2sH$- NŪZ[{uqOz""">3hڳd2L68|z>„NϦWZpұS? 8l VaFAnn.!y9 %:uh׾+`g ip.z977L|O͇7&eCDDDDtv/,-o IDAT;u6e>DDwQS^tbggo/ZWXT={$""pq1~'kŒݸq˾B\0Mi> /q-EnC*G* ..^~Lx ddsu?03" kkÖvvNpuFN0qN9+0x <`_: """"޻SADt7ỨDbU<$D. o](--1Fύ!4Z-.[&xLQ9VFqq8p|8880+ڱ7X"~B{qwÏӐ~څ UYR7/}FƎk̔uʙZ6JD-VB褶6EFׁjԼߍ"1~+Wٳb#`&ȴn"..JoOߑu.8Lvαu7ԩ6T^2"j$gdSb<.ݥT7}'>x&̨B7}+ƾ>>x7M饦&Bu 8xS8{d(ŰnhzVPt䠠 66qoDvViao 'gԮ]gCTJ$'#/7%pppOkuNCDA~2XZH5SʐL>ppp7o /& R)aii Oxx@*53*LFA~ s`c{{xxLfnj 'W q>]N{9|W˗[XbTB2ؙ[8;Xtp+9FI𸖑t^֙Y[JBӇhjm&ּJI8Bnj;+b/'>2B} 9x0:/Hi:WGOpV}<33K,ͤ* Y=%9R$eM>ljsrNšK)YJ{$ nw0&96srNJ9X;dfʼ8XtBD-"Vhy-O: H$3jtGDDDT_~iixULJwgςJu>D ęV^M\<MGҍ8'.^87b o t}=zשff2m]g!9Jsе |}Ξً-W/^aöpQT'Lmt:N؁Ƕ#3wE0p|\3#:~aػRmADžicyA;Y–?ţ(++ջQ39ǎn Q<33ڵ ã WNڍ`aaNaGЫ5}v;}wD%u\[7#zoWh9bSsĈ JʂuK3J -}=ܷqR*OV' 2,(h+pQyɧPSUXב>GoTkvw~]=/x&w֩Cl[  Ӄ.?66.5gDRզۧN[Q vGsf^Ⲏ:Nv!Jr\vu>{qSVwǦ戟$uuk{ ExD%"ێS W$(Vٻﰦ/${T κuQZG:=ꨵn몶[muT2D@ $\rI &<{ sϑ*N⾾}G&eۯ:xO|ZNYa#5h}@cX wz>.goq؟SEYO$g߯_کBJ:!TK%ujV-[c#Bl͎ѻW/ FTbӖ-.oİh٢#t]˶@$?2dw^9U-4aIIOq4m&>]P* ۯ_?@2 =9NgNoa#sJ{qZAl0C+snj~w%ERGuZs\. ߟ$MqrRAA< 7ԻmY?߇W 65Ŋ Gdd8Z=]EW:I0 " " 5mE!X·4EL˔̔ M$_gtm| \isNtEʠ2lE*8SZ*SZ޳ݚw5EUC|'OKjߗZB!jvVHJϚ)|#zݻd@L FTu8:iݻ{:_?y<> o*n㐛Yss߮ kVÃWڷJ™Al}|.hŢy3 +0 C~}~SnB}2jWUP>(7aDW8v;J*0 rsSA\*sߍIm,.f}!߀Bd[5O*A9])tqީ|wYf|?,&K [ljC ea~бunˋT'3hRy|{kyz]>O r,Jc1 cuORg8Gh\cj|yٯ=g :ZUc5p&k+de!:*B)}kZb˿!:@&ŋDݻ˭<*Fk&!&N&;<<kW#6"z^+VJ B!X[u;2qȤN cS\Z}DՉC#|{ͽNߋ80aFU,U񆷓(Q$V 69 ک!yjWſպ[ڊpDlg-ϒ:d&Ksd-Tj'Cya8onqd#S'd֎I'W\=t؆_s̑)<߈^p\lz9?r.(TI>)6" t'!]1 YcrzX6ӳ&FYu˹7]rL+D wwQe&*<|p Ǐ}c>-Zvӹ9F6q| ~>P({\Q8~l7x|ӟC۵NBĸ +ic\t۷Aa˶CN/نB-c MK/12g/r{ɽo20:Yj}T& o3J'm)C6._k mxb3Rrm @!5~Îiu>2){Ǿ̔ۓo7~SI1J:!T;q8$8m.]̒;!B钋G_۵}AxX FT5܊8EJUcGcPf=4l Fpv`L&{WqD"1t{޽k$=G`ʯrJZє99cŸʬ:Qv-܋AZZO7@ÓT-ʽkc_wfE~~.vl}!fܢ7iE/@&иI2#S(>Gw?,Z+=n6ei\.-9-w1uFlU~GѠakc'\V=0mƦ2Gx<wgg,_!.(6>]=v'!e߸\fI15dIͳ]{,2oXX,k{KJ㔑lQkg9 ',7Hrx ¾9\}|92i+x]Sbj;mn.xL$f0(O Ԝv?wlNKa@hӡ.}0s>L{~\k~ۃ/,, ?Gkqg~g,_|888`?N``Z\Ջ3T*7<N5?Ùk԰vlݪvي8vs=ָpo՚ߺi3GFbڧڱ}:m:wRT_Ot&Ndb8s!!X7ZkY'O=lG ?i=y۽Kk~P71[0_;qfZZk{tѣFil6%p;bs~\|3[?_~֚_4jԨ×+Wh9Co׎3R1nssNyY 9sk*r9>Jk핫W??>~ܿ XqyojřS՘lP(Ɩ[OZغ};RR9s~;ZGZ`<7q쯒[.LROz-fhx>(OLݔsPfx=\+>p-(M,ȔʵH0/6M49b΍k5쁳uQEm :LU]*$IJ6'1oзME;T^lcso`4wCι }Mа<'ڲ@ AW[u=eD*m'}>wJoE 2~agN$c f9^iqs5ozVWLZZ:u~t~s'DT ]4j}t4Ȩc&z5Q@lI0:6iDg1qqVsLL,^ƙwTjjZ@Dsm(\_[W^CdT$gIƘ:Y{ÇpꙀt,Zxܤ\k۵m7M:ae IDATk|Τu~5ҙt(#N:kNGp.'uN@32)+ ֓1:9[gba0ȤeLJ*׋n\?3||WC.,"M|:{IDGš8C+|2e-< h;󪲳Ӑϙk-':*BkIhӸI{x|Ne[F%^?x<4kŨ}T/u9s<*"1]夘NI|#Nx<֗1Y൓&L0[=ѻaԯǎ/еmv}>>Cg5]+vҨa#\u=W'kkkYFys9_k]),43hk_˖,EWڷ֙D`5רaC?PεٽjU'JE*Oqcr'$kW ;Z\q+Wj%}t?c9}ɕ=wGƍkkխSGD__*S|]+JV:7X8V"#гo{S'NŝG/̐wlX+ڮa YsE諾{sA>ɺn]R w`n>M WZg,o/~xe[';64~_ݽ<4aWOeDĤrw-D[OMͤExOCG'{(c %2c W"j2R%1 %Kg9xTa:AC0 RcqsO܅R3pz".6?<}z+i 0iJ4汰YuIgZ:_ 4$eRufS8˾J;V|5yŐV*5ٯp"~VJXm[{6[*lphי]/>=gg?^ۄkXd;3L22NO3{[xoSG(r8 qMע_Ÿ44W(5^N"U1s̓rUG}t %B?|%4Mjs9|N>͎۶i"uaFN)t}Ex<Ձ_kT 8{fnEe-u;Jǎ{FB&+a/ѶawTRݰNȗqotqp򐛛7'$??m4/{d'k+&܊8[gMa $_*zً;Nߓ;^ۇ;wc* <@L[tE] lX7ϖށ^GڶBx/J1r|]=[Gdj'2D"gyWn+P҉9x|LIh+*Q)UK?GMШBH7dvbV^wCLˌ>o;Ӵ*Z Ef+f+>x9=9;ؙ| *NƲCHV-M/Kg 'yJDek@V7' @,1"f}.W*R(RDEE_]{}ŕ׷Yc#B1o /ӦY4a,\%Ο_v8+Wc[[[5 ;w}gք7h`g9-wrsF,[2 R>:z1j<8{V9ݲ"eJn.*U,]ѧ*%Qb!Y?dաϒ򺕵Jt u~/KlȝsijvBYfO齗4W6jΗximf`vjѱo^g9JEQeKBJ:!T+5NBBislqB!*.>ʥsNxU+ Fox;Vӂߵ1w<Ǫ+qeQ.N3ntIj3,]< 99 oʱV g0 d2)Mzmm d9P%}X^Yu!.u*tb JJ9؂B!QV PE657]#4J#u)3/~ `ش9a2md #kI=LZ "U`Wj5#,+(TWd_RE6f<墵yH2ɄMyP.";ߎ6M5HB#N!Ն\@³D I'EEE8q;֥+D"?B!PT.3SY4D|n-;p -=xMEaa!.Xn]SiZI'lڬ%`Z yg*+XQ Y&O:s+?K$jS>m#ss23Sz_PؤЭ"y^zΜI'A>2W0 {S0cd)bJTjM/,)=wi7%BI'j#::*;O'\xْsӦLۃ[0\\2+uKO%>JV8x";{5ki=yrj8>>q^/g~ HI7@jӨQg yy'XRR瘕4XOEؘB1ℓDj9h߰ƍ] οqREʳwa&Kp⓳q0 )[j"6i?U$%KZP7[zY3vmɔ<% se iU;4@P2MTIkKC J:!TQQ%k ~MJ>ۧ|sH!:u4n߹͎G~8^^?&6[ne~5 "ÄO&!9$)w^-WL=9W*@df`x{saﾣ0tx9&8[k%ɼ*oo8;sP_9u녽Rl_N 'O11+o }9s'O&YRxa B1Cڄ\X-U/t`[<4粤rs>~%:i) jqJv_:[˝tqz`gqjGhUjC׻[: ✣Z>x&gJ ZBB,BH`N:Bvܯ!BeT*l࣑ܲZ,"̙; j|>_.] {dNr?IbnӺ5\WLNd#%%UCRӿh7lԦ2SdHOK!q铟LV?WxT*nIx;+#._3׺MoDbĨG^ܿ Q*4SUx<=3g~W6/Zhނ{_{c!RU9m}O.--kvEukeI`TBHyfiak%r$exJNXp5pΧ]}㦊Qﶹngcɲ$ORM/ZqZs^|y>ƒ$7}T ]Îyrd]p'B!T}XvzĎ -ZZ,sR՘guLFa:٪^/شa:U*6W+yӳ& NÒ TICG 8ULmʤN=)onW-ZvE}|Z{ݺ@ m$7??n ҽ0q6ڹѷWY%u>bnۨXG/SC&s~o VYYT*!bZW8{nZ +͹恞 ֯9r'i3_.Ok"+U!9yw W[ĥIiΉl}1umLE1-xs2*/,0EJTj|o*H1}9XR;wqѣF`s/\T5G?qߌڦbntB?L&c!!!:%%';?rB!˒dغc;;] bx>z]ώ0ucN `E8s,;WV-lٸ "ѭRUtfNsɽ4hp,^.C{7q$7'K EjJig?/ҟ#=-rLL ʙzl4Ӡ #Z9V77 43eKyB|$$pڕS!foSc>^ƙ+(×KRdOaZ+FQ}<o7¡[]kF4xg.%%kWa'))&64FB!/:)uɻv^Y{οo{)ߥӼ_w\{Z5+OG%͹\Ya1[^mw$+S*N[q&rX"[gs9-}"kIjW[\z`}\Jo !cUB""9`݉b |B!ݻY0mTXYY歚BsQT%@ e_Bh[f|?d^ع};\]]DGBt-ڹ>W)|| vX 2Y.GZUJim)8ɱZwnO:W8OE*}y\]1y:\> *U;q&YP GxjmRq2\ӧwٹO0~hݦ7Zw?dH[gqQ(xzQ L ] ǩ{9혏#wUNN /EƋ$ǝ[EmmV=Ч=S* 8v;z'7h 'g  Is<*4䝩&ٳHDdb7'[tApHs89ys|%;i !RA|EKP^N/?wL_gT*W$dH]3󼞤d߾tEzհelc}W01CڳxNfD#gvj;^ u}$8l2g>zYy*?xW1\Ċ~Fa7/r ^y@oS jޫ%ɓG&fD%gu+W]o juCjJV%Cm&1u8UF&v$dRv^.ø|p[F g_c9it.]䅿^2O^XO[|Efc+;,jP#ޜIeLrI"vlzuLZ{B-^e'Fu!BTTIl}UNܹg%g!BʲyfTNLRגCB0n%#ǎbuX(bXǪQ:uSoi!T{H7iqjb .ݺ@ (w}1va}pw$%n ||0t6Nw l31$!NŌ[eP5n-b󜣕5FY7ۻm|вe7FF! m Go :*ii PUenh׾?šv28 3)pxA7 cE~~u1wRs]: ; "W}KΞm {ehּ Ο;G7PX(׹?BC;cӟHfc+:Gcڴ7Z•Gq_x:s4laQArWB!;& 3ȕ՗S3><DC\bky:~RH*Fhι;%QoJ?7}bKd"ȚnﵫC1k'xg{/y;6{vAx˕i}[,+#d穻(FZ]^>7_Ny2-QqX R{=n lUJ< Tû,iH!"HЮSGvzWݳ'gRD] H KVjB!&N?@qP#fÑŜݿQcǰex<-^Naμ`a>}G̪P'CZT(:e2`Wea$ ߍ&wΔʝ"{[+ysZ}썮QZRXtIsf^h-tiܱ},ƒ$[R|2rN92LlgZ+OTKUf1ɮb|2reN|Ah- ԭJTl)љj;IN{[7Gv~[X*6BqGLӜJ'Hθ:/gNjC! `N!C,pryNIXXF aXiL Oig4s NL5jC_LW~~uz_:eVȨlmX0+!Y: |jԬ5wBy zov\YB!<#%Kzt뎰J={p3<8]t8stk^ X0*B!B!B7J:! c!!%I' 'Ob=wP(!B`oRVVV2yrM[J*xyya̙ OgςJ|\ڶpdB!B!TotBymisC*~}!B*t2;߻vZJœyP(llbJ\rqF0oB!'$&&ɟ|PX1]OcbѣѤqJJ%)GTk٢%^TݎB!B!JEI'࣏1mj=KAH6| >581aŕN=Ã}?HB! R;wbǁЯpmgvAVcqUv.((׭*D>_"&7I%B!BыN!H:666:|ѽ{eF!m;v@")@8kƧv|L/σZҊe`mm]i10Xl)N>լY; Xlbb#&ŎO!B!B%Q !~]n]XYYa/vcpssDxBJNIϿŽ[h:Tj +V''!((-^7oر+mdzء !B!B(Z,I:)nĤ$vZB!mظ 0kƧzWCqXh(F~a`ۇm;vc{lv+jתe(B!B!J:!J%bbcqp;w9ΉбcJB!]QQQ8qvܻW/4lذҎ/Hy`  |ٗ9?qW`Ƕؼq#ꇄX$0^"&TѓB!BHBI'Nll,J%; B3s={B!?j7kV֘!B!B!U}!?)2CpPR);Ou!R.^׮ٻ︦.$@{(" ֽUZm{սGw[NpD@AL dzF~>>'Ͻ oֿt2\ʌ4n~}+4999r?-۵pfB!B!ϨR+:_8T uDjBd2lڲae~|B3o}CC,]rPH0BM0YYB!B!BDE' '88͵ĺuVoB!b9{GԴ_xҘ9s`ggWfZ|BF$&6_?> y!B!B!ʡBH6-5\q%H$&ֹS'ME!H$¶1ckk 0?q$ܽˌx{k.eedfb:̚!B!B!BHTfVÍN//89:j 3B!|:XfU!N/v sgdKK>9{ r͚yS|>%aWI.P9U23g{#B.#99!o9n5p%fܪEKyBDc'N0F ievxx8lʌm1k2Y[m؀SgN3ckkk5!B!B!DTtBvG>Q!*VI}DܽUpu5Bޭ5)pvW%WW#`JOͲѨWό}I3]<1\W/ !]ٸirrr\.LV&JR̞7"`ɢ066.UmϾ}ػ3624ĎmQɮ"B!B!(!J;t(ݻq6{6n~_D^ܱxuRRSIJLbmbbF bXn-iB~z W]e]tA5dvWмY2Y[.\70c]>۷n"B!B!}G |M& R4)"Bi@VtH Xb Ri^k|v6_Å?-Czb~'ORq >}V?ŶuѫWRcmDZK}<.&x>*-:)).mѱ-Nɓ!a^J;j4FuCIcm[BP!fll%˗1(D-Ւ!B?Oƻ0fo'K!B!TtBukܡ ,,t0`…zTSTsO{xzKrG `8}#ʰ)IA[3vᆩ^X]Xb[؜<#<ς8]H$yWoN;hR)/%%/}ⲑ&5z[ :$'>Ay \:X[0|>kW"Bj}\_ Zv^NB)V]e̊Əs)աѣQX53E K;۬lV!sshksx7{Փ!B;))ػo?3vᆎ?uS̸uUI"`) db^Xz5x<3S޽ѹMA}zGk: B!B!@TtBU::\f<`4zmq\pP$d J_>/tGE ѽ""̔``ܹGAve*~r>:vD=Ԕ!BGwLA&3>m\nG| [RPWW˗.O몒\.ǂE q}&쌿n3S-cVtoD!B!BU+=|LVl@ָQ# TfPEӪW7DH$ý{ʨh11Y~'ff:hme>?W/ C=fnL| lbRJX03"B&::'j5RK-emǔpZ V]3c[[[LLO:!B!B!P )ԗ]Nj4F:.D9q""QɶDQ&M,bOh აQǏ5ېz no501U5mJp8rXr ՜!B'k7X,\L oFJ-߅Td6u:8~>^y*˵BcLVΑ BϞ~_Ν`m]x[ޱUmt R>n6moC*vQIz1tP5gC!͚uk u|=Zk[87 IDATxٰS߭[Xrf6Rq0!B!B!(*:!::[[ֶWaܺ`oKT[!SsD2ܺP"deI }/ !!+COԹ==M0xpUkR,Wltp`bb5VǥMBQ7}3fjS}3nݻvU뚪8 fLTbYӦΌB!B!.t(xX_T)+ I*ȑ(WZ [hիXcKK>:TC~sTaFg:/UdC!T&-yØǘY պ* )!i;j0+B!B!BQ Qs(|;kSyڕy4tt?m'OSY]_QOOT\>|.4m3_ݺudD!ɉ'ƌnj #CC'0w|d 2؂yaaa5U)::t&6fh W fE!B!B) aH8rݡgJ-~hc#"?͛[<ϒe MtuKVak˗UEm7褶I4AttV-/RR21F V..j]LOd(:IK+ K㯥ŁRbeȐb]jUXU3 ~utta:EwB!B) (N mmmM[63ckk̞9SmR ƌXoo̟3WYB!B!BmCXDժQ#zsW;w.e-11G!fgL όZ3jL̛''2ΈB!ߺd?xPkT"[$p8,^j[SUb1L7AALAXj5x$B!B!B i "\NJyyQɎ}LVCUb=y+OArrd 1Մu&&ژ7&N}Ί[[Y]vʊB!߲-۶A 0㩓'm]Wq}ѢmX2fΙ ?&-7R':R!} U`Fߗҙ]%'XZV`FB!ߦ ᶫN?Z?vΓ͌DJ2f_G <6Վ22MD!BE'qXbv3qǯ:aHxόDz5]ؕbe0^Lc 0dc桌ƍqX3~8 h9ΜH$SGz&PjW^ahҸ1:n5&!Bv52㡿 Zœ ~^xXl|ZSay}Λ+Ѥqc gm{xЂjεQ*Wv9!f == Q!Jw+)jՃ= ɐ7|ogd}B!BW yl|!Ddd/dSٺ1C>eVt"ɱf[_ViS]aeU.a9s^!++°\Z+VH JTby}{ڷIQ<B!$HyflnnRz׮ŇHftZRH0Ba^!лW/ f}}_$$Dbu*8##39cnG=`ђcX2:uVd 8:c񲓨ٌe8qlRkB!B!NsaaowV |h.H8r4_'!A bѷ4l;wԬi@K+>wLM\{D@&+#3Sw{(ﯤbcHI"ɓs'ߴLdF!N `3cǪUղVFF/ZteX|9o5U;_?1BY}?=kk1z*hiirD*Un=F;o򔭘n5:8y3 LXW/#+>B!B!|UNR&|ZZ糺uMQ.2ĤQ."%%)5Pt x&EovՃN;1Ly^?7.?Akc+jcL,'Gi#г=j4Ex3?">!w#ccmWwG|u*N>?{̙3Xd)ZhsB!{?)'d'f4P}TƟ+ }иqkqSWofys0d#ܯ"Ho:e_h 瀄D͊g`J->b?M:;]q}R9iB!;1c/OOn|oKq KjYKE"0!!!LQÆXt܊"B$b[[WP6%SVV ėyAw<#55YY03 ~CW+Jn#$8))HOO\.9,-+Gԫ.%<;Ί5lFFfۧw GAbb a`h33k{4AӦ]RN_ff*."8"#ClR)++{9'jlI ݧT0H0ڛ׏ ڻ/x<>}ׯX5o|^D"[/[B!x;cT&+rcu/X/_Z+}2YvLr$.~bsd<.{/험@"4Xqa:kj'Q?9;>&9\w137Zri?Ier/헟s9ve}-$M(r{맗 295sλF~׼ѥ~O͝qN;oF~u"}Qx}Hr6]SlrjZi߆{uYbלM}L鼧a鿋Ӆ][SÇgfv\BTtW$ѫR]HջweXr'RQ1ZUa1?V|̙ IIbzh)׌Kׂ<X}}}L<U!8. =B!߾-[";;siQKNIK!-YTA*ax4랇n w $%O*-fzya`hK㣰{\|x?>> QѼE _\. 8~t" -. Ivˊ9;{ I{<{zK$% \W}DB{b .]Sha@ IIr0*U̺? xo ط AB-HK-Zǃ!^\-xS x|pشRB!ۖ+_|H&˕ ,bmc#۴]I JjQƗϐHeU．a6j7uOoa%W qX2WHq0[b#c#  ^$ ?I~1Ӻ.; ͌J`Ͳdf(R.VFV۫$_v_ %ߗGRSB8drNa/aq,M^|84&ǔ e& *`j!|QŰ~}T7gΜ@tQk|.ݍѫWe^G7ƌq'뀇bƌpu-XX=lsmTLL*nIBB/P BlڲhҸ14n wת}}hB!|'q9fܾ];ԭSW-k-^x̙dWI-k}-\E &VJu+}v*c& I4Mɤ$)LMdwc ,8\.;p^%~պYYslThIA=կZ?:*sf( \E 33U)X?ΝYl'Ą#;p˚5Ȋ8R}yW X[ !B??$'em&–Wp_RFVÑ]S fvcvn*h% NΑb~ K] Z]\I~IY l2_w^}XxoSI N*?y]p8yLfV9׿Bxqz7Bt]9 C92c-nn7|hE&XےHM+"`h##mx"w~+>ZX`,7̞冤g#11ڨZU.&o3Yc{ҵ...}Fb-hP#BHf:HRqղ3gX[Bղ*߸ΜfVV{.qQJ1 ī~T/3׍ eC[ͭ>y1P]= ?j݌,_:#^+fnn ^01Cr'y*Ɔu1if4jS)O]so # ;Tvp{ v7`ߞ?qCkl}W/[k_~P#BHzSMtҠ1#t6ͣv&^Um]LocSRV{8#;%,()AU/> [eQtIo ?PnPtČ7U ]K0[bƫ%2|.7r{cFرm;+Ϯ,/ذn, [-)MKb=ˊUvk*j]W*biXza؈Ű`wx } bߗx]\({4A~SV\b Ad2)v5 N; 3gPpv{ig̜\.McE%ثNKLȂFm}ԟض>my;e-V@ndż+B!|9l͗9mřii66k3.UX/u-Oc33o.I1EI:tU0=̥ٱ)jI}Ias2y?&ed>6q3/ N4w'pΩ_ԭ:/M+q=t'ȱcN>_p`bej-Y?ו=,M\6멆[ix> .Uc0szgk_Addngb,ዛ&Jq>V]n8ykeeg qLW M%{gL_Ĕ-{wIΫVZbŞyLT[ָ]%z/[6ozʄEU]gryhӮJs$BRk}c;kF&w~Ν^pl-WI9H"e֫Jr)HXM]^m*su_;٘T&< cUۚ ;Kto\ؽh[mTL`AfV'g17 RWx:ZQ>d9Н 4vXL.P !X,gOG ` ca>bx; >N'6e81F3bL߸| !R~blپ[[YA8t"޿džMX̙9K‹/1mtH$q8,^жE.ѧ"d2)>71cO16mgOTZ*KJ Hc 01B[[kM$'b ѣ0j5B%/ 1v>8hv^-\.Nq"mm> /N@f&{"#ciZݸ~Xo\?uu!$k؎M /@./E }i4hg;|Oi峲Xյ)B&/[DZ31)/MZH#X}qH?6R. iSA7U(]ҟM(;Thf2,&9ӹrXiޫʌ }y\OT&3\coe=O1s~nD9B*6*:!h6ǣQx;Tg>»m\zͻ~VM|bxܻ^F\|ncbkӦB^>zQQQxqSQT9";;3 E>aa=n,ش)SгG""ЫD_/wV ImwrzғɤؼqB +(y?Ʀ j7.9ڶ_ulڬ+J|-Kt|`l|!/EuWc_k]Wn߁ݍ'<%"_{\ll޼~kJs#B4'>'H#һ^xsg,:f+}}UDbms^pL^xjpyd-+!m=n-*%=+1q-tui\#$n h1RK㵵Ic:x?3nD0Gb^\+cČ{|_ZR9ښdU4?C|[|LGgQ· 脐rΝD.Ѣ-o0usj0lXBCNؾSt鋢*L&ç8Zb7{xacTf,0|>sFMB!fNNNٽ?x2l}Тys0jXu0>t(6DsI"ժV>n2Ebӆ زi2D(\;ymV -?=g׶ۿxn>__"Q_~WA5j#<%:RZ K6ff6@^؂.I*|`RGY_K+{xiYBHhk3 S~`asrVrFvgלylV:VocSUNؘ??IlvKN7tIǺ|Mە]:[Sk*dmbe1Վ?KuTXS}gY_TjPܟW .u]yߺ#ZRjz!6]SUdFG25I4!hb ^ի'pv6ѣak[r,>+IO֯Gn]! Q3P7߆@__K/\.-{PQf-F^H$ĆuPZBmRխą>M3=K9 [!iOm!Ht`Osog@T9R.]?/5U2oZ^%.(kCZg\9*> tչaiFzOm͞YU5ʲCPT)XOvuEbm:*IbcA| 1rR)0#dKll|pYOJB۝6n`a|%21yoR\?$& o 0 dnUYfAv’S lQ/}>eX[Mbc4OoRx4lhdn530f3 +v\\^ {1XGGVVHHvƬ3qUTsrB`lگO_<,^2 rZ T*B!⋋ϑcuGS̞7brlRFdggcܤϻ6٪e+,_0_l^f8.k1_ H!_@JJq^7`Wpr\zsĜJLiiJم666nk[U颓dů靡TNNYc*j5Bf]w5iT[:`jjnQíj7Fժnp*VS݆: gfe pBy*22R16mIBHYbm]“r҄"=^|}W *?qyiߣoz5C.gPH2OOXs. H﹫٣1k߭U*X*eU{B zJ!2۸TATJʑ?+]@z5he/^dd縆丆Ĥr?Xf Nuԝ*5nwZ{w9*1}d|* _TK珵]—!B>WZ >A?$<{wBFiib.-BiҴ w]nhiiûM_>8Zhщìqm֨\.D"A`` F #G"`lŭZ4k=z(W]OqX1'GGL7^aGI++V*̽{NUvƴ?`kkˊEEE}{uX1T.W۰ACtQ!}_OH`*;`С sϜ=x<̛3WaǏpJnyCCpy/c }bog%ɰifu<[!~!$&%bvvЯkׯ<.<&( ={܌]d+mѢ\;Bd2ݷOan͚5ѴI3ŠYY[[ s<|(p s߅ٳg +tMNN͛ sׯ'GGVL&S溸8n 7n:9ڶi0׈p8оH+ě6i##Ç sQޞv\Ԫu˗!<=憅!>pиQ#qqqP{֮P)˗8;;ڊE.|>|>ffS8Gxx8j07&6))5)떜PKVrkj͌X-#u/=9;wU(288\T24KAT{X[v㪐wAC!G -9aPk>;LZa$R'U4:s݃mkWM,옯!Y?:ZR +$&jG&+3 wq5:> n K홿M~r)ݧ>>4st`-oeҚӳ^E&%2 ˪mҗsO? eu9kGNV!B-k+>zt+?Vi >~ޭ޻nje2<} ֭ݺu N>ܩ<.f͙$ɾ-۶A^B&}/^d? 9όUcǩt%˱`"ܻ8;cǶ+0)H$q<^ZKK~.`Hc:p_ -8K˲%G\::oMZv4 WЪu/>AoB./<\W@ktu0i~ΞlS a^œ5/cb; ,<ܿSRS'yRW]S[Y\wXubB+s+~P`cF$8yRan]:4WG[kׯ+:uXtIΜeZXt]ytY$.>٣0BщL*-p/Xtri e߳U`ɝw ,: M-7W(:)pyE'eN|ӳ /*?--N?~e+T{yz*DEGc% s.^\`IAs_`_v"$$D!N?SgNb</++:~5j`>DFb?.]{b2C'.Epųvm90w4`3Ŏd7o²=~n5؍ ""3z-Yz6dryss)ħϚj{xa;wSʽkׯceC@eƅ'Ꮋn9ٯb{1L*sw6>wff_̅Ggfn/Brz2Q{/c:x{S}ٿ .!MX_,6_&OH:]~\OG--2}GEq~}. XDTPPckX{{E[즨$1EbE. E) s\g4Yvܛr))ٮZNj3)B +xI.%I'uC[᫨qIUwI+A\tY~nţ:&)m}VW]NG?{#h^PXCD(|ϐQVk$ťN\]3 E' yowLML1n$%%'tZ;.Ijʕh4޽ٝyT*1}  ,q^/KW,ǑG|7xgx!>,a&L$z]q@}ٹ&o_U|qxԷui̚enM^fҝD߉پ&;ML0l\]73. jnZ͛0w/+x"55<{Cna\w)(J9~z32=_Ttcg焚X`ddcDKe^dhhgt˖A83 Fx GN0Yjԡc//_>C̥relٸ)Cr]s 2=6}͙_]:uY<Цgp FNEuCXV.[!^fn "c242L0NI֙>w=ТysQ,QFZZvvvb3=n݌8ryf!C-n`rv2ȲԩGJg,βؚkdLI7 WoDDDbd^ ֢ys؊ ~Y5V!n[2LҙZ%p2,cԪ!ڶEZSkР1转>..ޭ[uI7 :6>.jժUp,4m *Tl:gzF3F =)EyqlW\XG%IU]>k%-k{۲f 2wN;O oTU|NM?5[_p̀jibI[ܬm~՚;r,iT"_"*XtBDҰΈMQ;5ߩfWO?Ś0vxT\ۺ};0c,4#""\tQX,_ɭe+eip)mܼv6غqS/Q֎;^ (+PXdE˯3z}{ +J9?!ˮ*C,..W3K+ u*U"o c9T)i=ڴSܺyo]̀3tyvl\p ?!$'9m, ^555g|s!sp@9u7Ͳ8 =K 4l+˳},kDvUvqAe}>ʖ-eKz֢?D.gXh$O5kc|.J,>@cҲE l"[VV-ӱ&ɪ(#3r<tUVڷkG:ulٲUQMV 5$+_v/f`kY!BdU gw{dئM~S.цtW+?qyW!icRԯVW<(ѥ,Mo8}Z,6/\Ӳ>-=pLʶyٛZ5E*5ZсA= rQVpeB!\.C&VprpUPPbcsxe-s߁\@;Fe+R_d;;.] ժaЀ:F^9v 6&&&Xv])sqq4u Ϝ!*8)kg#C, /LJrP =8w[[Z`=pti170YaC~V!>sBv0vzlge_R V梮=Je:b'ZeEs""jK/{iZ+4&F:ۺoyn{Q(8ɌB.j[m֮IT雏sU2%]$_-Fgaj0:<*VnO:]CsgvܺfHʃBj8f >hSv6%6!ITپӱ̏,QrU*W ]=7ovZտ2VfƢT:>7 YJڵFxn.L5S# Z5[zJ8_uq]"_E2"*2ai4_aa:_iSV7 J6k2eЧWs^ "<<\X36m ?&L$<~d;͛58Ab=ӷ/={&--,rr,򂡡N+/R.sOڃ K`n^gDE*W+Z_?q񾑑 7h4F?PMNadd"Z'dqdδjMw G]qzDDDUv Nfvg8Amkߗd*ˬύnͪޕeʴWCdUT9j}ټrX;t(gkvQ[duln(D%urWB.pu;mbL}or*.'DQ,:!"5]W>&^zضe }IL:)))8 EXx Gș? ǎ.׫>zlw>F J%&O/vY^DDK 99Yש]X.))?(.?!;HfΞُm[f N,1}l_P6"Z~Z'ؙj-~=yKW2 VV☎ab*6&F7-,Ѥ8{z(Pժ75 #CzA#u oJYP=:~L>ydq6&QY'逪iӪ['8Z6EW9sBްvuZ ~c׹;)jSC"Z[R46jV'GvJ. O *Z2帮uq="o,:!"'N'Aw"665WM`kc#wFCDDDKLL n&V:, /Y Őa|԰!Cc>fUt\|tR;#+r ;w\gv$%)?~p2yy[6Z`ڌp\;|k5[dSɹ&ط11ٺS{QLY/P־(s<Jϐ]:mlBz-5V՜߸{}O}9uˏ]狆.G5GtQ '{D*||ٰʎt5>y}ANo뙛':Yn/.74F_EJ0~4vhMq.T&ֱٴǯcDO8ZV&^#"V8!%"תUHZuvnێ2S F % O %MzCфq3<^ mӦLAu^DDFb؈xޭF!aVEZ &aۖ슌|c<{z/G_?CbU5h36NVb&&f:};T"< ­DoIIqut,^qqY\ r ;{~ 72YRϹpLJJR?byp3W䇤$%F o~Flldj5صc`J0@u_%gׯOtKpv%UDǧ~144FVZDDDͼC/S(^;:ޱ^9&|ߞߍ5þmj||%<2b n;jV6~64ֲf9ݴaKcP+2W'o<율DVx᫡ r{Lz5ʗT&d{QfY޵/FmcƦ*/wC#<꿥Cm]v> l:ᙘ6޲N|幱UӦ[OJE%eNcѹBr&MW_lPaxkݪfM!]RE0L:7D֭Zav8gTXu[p` !eKzh۾jϟ?q_~oT ]Tk߷FZШR.9VBqf޾$Vؽsj5wE23}uZ %Keӹ yg]>3%I'XXH-<|5JlZ6Q9jmpXdఫ7$L {%̌"- T*qLBuD><2a*Yt'\&Kئo鏭6]{ABxU?߱ص J[ݴ2W&w~&*E-< drz];ӋxCZ5GϕZ)a\((>^dbtSUW%UjbґMlg&Y+ier3sXc#yRt|Rxeщ&6J?~/괒\!i]1esOx Z\mqUv";kWޞswb201ѾNp?"*&XtBDE[U E'WuzJ+b0xBCC~:>6B#""Yn-ލd4a~/[*pB1V!99&L#=7Ċ˲jqui̞7W4ǎC^ 7gO{8urw544>nMZ:C<&&"j2kʀAXTl >&c(]&fzHMÏ061q |pT8hѝ;Νְ 2' !>))ɹ8V 98S Ұ0/F跈~鹎U:?RoMNN`efͻ] ENkۮW&""*w0[RQX(e_$ŗ}ivd/ݢړʩugϦfZh/?K[^5ǒw'7E' L{|7^}֞xvfZ5{uLb@F5NPՌNP|"̔4nǏ̹Zr h4i)juDs.s E'+s'V8:(%%Q`O[uCr}]L{Nĸ ް(G~eMsKAJNN›<}eIM0s?LMXin >mm+\ U7x"""0}aocgab@:X`ĜMqj]ޭF22quޞ*2wiYmq4ծ.L tBK.%֮PfTJ3r4]'T+_r\磛|o<&mL!%O]_;Q暡jׯ_G-tz-{{{޾ ƃw#K1p`l޸ 6:Qq|Jh4Ɓb:{8!yN;t^,^;uJX;::bFXZZ~AH&N_tY3fSmE||4EpDD 5k5G_i.󍅅5??N/gڡ⽒%UƢhsԩO;MX366;6jͺܼN##SL ׯ[7#,aϭ\.:u&Mkؗ6Vmвfkv5F?Tզ@kjx^v5PKdW"F9j7ˆ7'~pܚk\ m_/NTEM < K]uU?:[zŘ^_:$GUxژ];MH9̍_ LrV%d6P!23_u[LlfWBɐ1BNV&n)Y,y;RԻr稸$[Urɒ5JPRehJQkʗ<{j&_^5bOJA%&"q<C4kV~ڴp1~|%"" ƽ\]uBq3QqϿcaݿo?L?^'{ݐ9ҥJ/D _^a|7mֶ66ؽs*V aVۑc9JJcҹsߩS6sZ@:w{Muz O!<^ E\\4```SSsl prrC%9.`jHH9d`Jejffrޠ5%%7Ap?"#_"!!vC*P'1+IIJ$'~o8EHx^?Fll$bc#P %J3٥ >"Eq1JFF!66Cn!,,/_>CtkT05uiTX UփG&j##cS|| ߨlff"ӧ`N8ft ff_>M2 A1)GІmg/J<706J*S4]Da heiX,8Bll,xu5j`%]2QL|_&IiDwf g,Rό Ltv}{J}}r;uD-Cz:}ӢѴYgI NHZFzκB.Ӷpshdf4bդ}/)賓7|vmift'DS,:5~ꊂցwO;np(v]<[YYaƍ:7o=z[X\\~;hLaw[okׄunt>/7'.Z( j TVM¬ /?L> /_>G(лg/L?fGDٝxX%]>eCDDDD?N|\ed7!9TqqbW$''ӧ$̈Li77 E'jׯ@-KKKlٸ G*ϟضy3ʗϿ;PPT}O $>S;8+I'dＸwLr9.ZMHYhq#6n(|wc/(DDT;YZ.$ʆ(l#VZB9[%L(О]NӧصQ:vn.aFknU]3]ע0339f4. ,<  Ķ[Pj'""*jvڅ/^ѣF8&''cPT\an9c ))IM<۵0˗iQI6mC,8!,%'pܺy]Pp Dy=CDDDDTikW(y~ϦN.:Gnnnir/< br|ٵCp# @s!""W+׬FrrcGɾ+V'O!CPFMJ #FD IDATPpkܨ/4;=}1uYVVVfGDEBߌ@I Qɠ17ޣۤ];:"*8^V:SUSפj:\_]ʃиQωH_ܺ}N_vW`º n|Zip5!VFM_FFFUk~?~\wqvKQJ2#j7KkI(Y^܈tix*ޯ͌ .q:D+,:!%C:,:G\3/:u6ann^(r̟7fػ]qpbb"udQqrjw1Fxxyظ8̘=K@?Z-yz3B g8u >}*ѥ+̚2#DR1kiJ7f&aNkmj5nJ3F&aO!T*1b(ߒDDDT_wEXE!<<\X=U*W󾹵jj/ºLزqJ,)YNV={лK ,_XpBDDDDDDDD$bI`jj uڶ~?b=L)&cؐB,)) &NݽLDDDhfZameey߿GC}>pFڻon.--,$˩Q#x$'' Z5ky #""""""""*XtB+CщDyPsM3bTxE'1nj?q"]¬BBaӞQQ9OXbPd= ?q.&^A|ӭ_!&ЧWos%̎XtBz+CD_VM}A&11QxۢTc kF3gѣfEDDT%&&WX;+w ۷zprrqe̘= ˱dbԯWO| Z >>4t^y-K,>6e $̐KWsV'z-$))Ix?%%oܐ" gPj3f¾$Όھs`1Qzqc8unڤ <[nƨc12 sAHOaG(}~9x͚60;"""""""""JE'dH?^E'MN;b#vw=s&ߺ_kB޳G̈ ܵ[X׬Q=_zEKRXZZb<  B !6a8|Kar|ۣ߸. 0|6zTRfGDDDDDDDDD1 uXtʔ-"""eJOW O  s==hjdRh4jG#""*46x#.>NX;6O!ZsELL=sgn|Æ@ttݳWJ VO{Ÿa%SDч 魌E'%B5uĎaj=ݭ۷Dw~ ,Z B݋`K/ę<_~֭>5ӞĿ 붟AgnDEEaа b]:wƴ)S <"az.]YpBDDDDDDDDTWD-:I{pJJ nHu/Aj\Z¬ UW#%%1n<W k[[[̙5+O{RĈ1C!iX8$#~ #ǎGϞw377"//,򂙙ǰ/USN޼y ssapyvj ۶aʕfEDD$7q?_..O`YHHHb ̓m̩07nbkŠe˄gIl\&N3g@T ժKW #""""""""b DtW :lEK]&i O X(EDDҲ+߁&>tX۾c^~ >mi)VTvqoh.[ЭGwBL&Oسk7*89I!*xqT PTԻoݾ R ͚G>p 5̜DDT<>so\] y >º&Oscي8ro(QsVO{b$^ +gX,H)R@DDDDDD%bIP(Pre z'''F@>iX>;6zc3hWlODDŋZ 녵 뛧͜)r,􄅹Es͉M[`][|7޾@۷o1u \tQo԰/\2e$,^x/J$x<魌E'%BZ;/^/EJ9R^=lۼYt'0e4DDDCx>#O"|SQ 6S9ucX~6115kEc.E' Çy`˦MED@&Ʒ{#""""""*Wgd`ՉsZt!7j ߽'UZ9RF lݴAdTDBb"VX###3$""ҽn$os_;غ}Tƌss0sl۞֬\uhRJJJzol߱F-[/Az$Nd_&"""""""E':Mx?%%*VNn޺R ˶jnnع};o^sǍŚ`ll,qDDDuvyFXO7KRaB0BE `R?o`IPLϹмYAj<ɓp7(Hog?w[QӬYSڿ_4373:"""""""NHowȢZ*rp'EjKdܼƍ ~n8`-8d0^zy >L tع{]ڶiV^!!zȠUfr̉c(J!6yD|ٵk #ǎaB/$$$1ccc3?-afaan ܏~"""""""""'r /uXtQ\9as;H+*U];v1a##>>^̈tg7 3<ˮ׮a}º+s :111Blؐ! ,)c>sRJط'(8!"""""""""1bI*=ԫ[WX_-ZE'Xo݊ ׮aላ03""{~7a6_^ӅgFFFX+czr*"2Æ{ˮ]1rAñ㿋_tC5c4""""""""",:!D<`-: FCwwap&*i剃vlي NNB0h$̌(oZ Z P=jdZd)Ä#QJ<6?b[yRThZ޳O>Xx yyT (?;KnnXNJJ­[7%*ʖ-;vJB, 2fFDD;Wsun쒫>wIRn]Ïy1;1v޹#ceP(T"0b(,^Bf8|:u(avDDDDDDDDDTXtBz+=,:)ҵnj077WވJ,mIDDThZZZXc\9󄵩)_:͚IIE'2H8תiaԢ$ܺuKt[6nBF04O>03""wwը#DZHX[ZZbyg0F_TP!߯-3ŷׅBa6DDDDDDDDD5PtVi;B HKLMMn=6i"C~x"afDDD[uxV9"::Z͚>e˖Ir?p644Ī+PZ|T*-Y1Ɖ>k\?++>;HujiNZ-NBi lX[bo޼AAq}#""Ħ-[!ǏB}>WX3tI'9~+8e0ZF.cEP}C|ߧho?<$GDDDDDDDDDNHoo΢:(8iF J"|addUWmB,""}fFDDW֭sOXjYucqHJJbS'Op1b&Ƙ:y V-_KKK #""""""""‚E'ҏN BggaF SNT*n֯b CCC\];wb1114t(nޔ03""w֮_R)Ǐ=4 fΞx!6g,$Ǭ<{ =!66V1{J!.>N3(+`}wo #""""""""@Kv:)^\p]@PpjլSSS??7h e:` 9= ŠCaZ4jH w>;&?ou>;v킟˯Dëׯ1h}V}ߣ ו­۷1qd_t9g$M'dR bݽ@|eN`IZUxAHZ-֩K/1TB.|b߁xk֢'H!G+VZ`̨9ÇXAXaĉ:13qq1ϟ iM⧽{| qkkkxyGO?0'11aRADXBH"""""""L&:hMx?99>{w$ III022*|#0ct(iRѣn4mT 8 =C'V1mLT*~͟;VVV:5-JF"(8H5n˖,B?SJ#""0m cE(Oea;,Qa¢k>#\Ah԰J nFJ1_d2L< ;wc>jV,]6}&qDDThZ,[BXcȠA9o ={Y+Tk42m^&jԨuU˗1utyF)r 2Æի$2$"5w #""""""*lXtBz-S,:)^,-PAht/:v J%ww^k '޾>u}?i"/YvmJ!OG;zЀ(Yds.l*+Uqc,Z-yz3B ><߮[j5|7m轢1˖-% A +z:vꇞ'Kg1mRADDDDDD)޺F-,:)vҎ !֩#H1cuJJ &L#ǎIdeJƏ}h$L1)))B `bb\Zv ~a]tilٸ)20ؿ}}D'nd NHmsN'ŏkUAAjh.n ))I 0qxah0k,ۯfEDD짽{*GbUkVAH4`jת۷?n&--,a985 ҩӧm Č1u]fGDDDDDDDDDE^HI#mx  1Rہ_} 󽼠jh0{\$&&w^RGDDz$66[o8;;ˮ9 puwvuua:1'N`֭=(*V^+UKHDDDDDDDDD`ktRA].2bY!_bђ%OgFDDd͈֓OB>k0xP˗1c,z K-BzAH3C]о,8!""""""""j$ JdTF=ԨQGΝ%̎ NHtKҌ 4to(ĔJ%n. wU`dd$ĶnۆWIe8 aݩcGԨQ#b9B /B?[^zAC ""BsBL&Oسs$̎ NHHIƵjjڵjX_"BӖb0Nغ};,bw ""ʱVB 1j?o||RXO?+TiAC ,b 5Q zq䖦ӉVŽ{`ddڵq?)R+4Z4o033b DDDs\tIX'ʗ/O|(ւyCG 4޾>PݸQ#|0Zh!avDDDDDDDDDϊ泪D$t¢EtWoꈝBkHNN. BC""(FkkKKK 4(~^oasBJJ N7 ڵja5E ȟo Pti #"""""""""}Ǣk2褸344h.ĔJ%) c7,-Ͽ)ӦBVKvGݠ a=x X[[g9s!**JXϘ>:Qb<{sqvoZARaђ%=ns`۶aGBDDDDDDDDDE$X_iGtRv q?ϫ0Wm"zɓ4u RRR$̌ +J>ڮL{қt.E{T|]-{ｗXXb^(*"H^|dYs|3sܹAʼ3gpfܾ];xuQ_ܰE IDAT9 pyflll=;wBGGҏ%oo޼OC؉k܎:ɓpwsW`vB!B!NHƮ:Q\Dl N#"  "R&99:޽cb^S"77WB=~ ߿gS&Oj 뙱/XX9;GΌuuuJRߠL!-3k6lmmmfG!B!BiTk"E'TrRs9t7oL<0(:yaog#Аݾ{MEB,-- fƶ޽LۊD"[LlUVxlƌUUUcVX[[Wq-#3~!;;X'0d`fG!B!BTktRcٳ,<=1,|sY[[Ё066fb߇qR`fBƧO+X:vnݾ 2ׁJJJؼa#*8K8\Ċᅓ!B!B!RcPIͥSaWW|&^)P G㐑!(ZLl,8;? @A1Ũ# 1^O1bh۵::: ΐB"lٺyyy.3fi;Pckp8Xx +-xO&6kƯճgCޒSR0w<ܽwwi֬2#5P(DVVrr25(+xb Mmr;VUJOOIYu.Cm"_?NJeC1r{Eb=UB!Gk^3IBHuAE'Z5lv&< @ X):cF#kG}{BOWWBJ/^e^ݻLٷ_`ƃD-*-xxO4&6vh 2Ҏ!o?Ɯs1q8 fΘA*F=Du3df~#cK+wCpXU,mt> DE#1{K+{Էug'87hz{!$ΥH,*qPچ%@$t?B!D$p"+&xA/+݆# .?_+zD(+2BJtTk H"vv̯SSSij*8. ((o?cF#,<@App>*8CB!UeӖ-̃`>&iٷ[XX`)WJj*Fx& &LcȓP({{Dkժ+Vy"BVT+~h^z\ܴd%#"<oPP}Meۿ|wĹBo"_M \ruϳٸs8RBnj졭SKB!`Y_wL{u,!dTtBE'FgCBC`ll 7WW|~nGE'%Ǒ0/^#G062RpBxA?3SRoB (XgPW22331v7DE1m`ْE!r8̜3AAAxfͱz ԪEqI8n7NBHKKƝIJ,:w61xu뿋%(]> NTTT0}Tٹ NH9}j 8Vj z\ѴY7k-Z{[۔{)/|q8JJһS߾u۷NHD !B!BD5V u:8lm e>D'' *E={1adbbc1|HܷkVpBٳ1cSvA8v3c+%'H9sL̶~}lݴ|>R!/9شy38Ίױ`o/cKB*߫pVx}[wq<\\[AYYEٙU^+uY44tмEX Μފw>;mX31ӷ3C!RAsKJ<ٕ5\'l\x'TkP )dog-:{ {]۷cxRv+uB!ߟ\ܳaЀn @(jŊJ+Y~\[c֮u,UڲCCK%3x 855 4pi.-1|bG\aU={yqPVw*5ώؽsa}~fj#44J/hiinN㻠EB!v6Ojl~[y|7Mm\ߔ!FuHF/l_{777OK씕*o݆͚3x  MxB!߿GÇS&Mf)uk[f}HHxԔiAOuܠ%4jB99Xy#6:>%!''<2`hh:q)1O̯şN"774͂@όT竱$'@FF*Btt ж]_0D"!J]]B!XyַaJznF[pElK%Bup9B.8B UT=M:1چ1VDמEy49#$+OQWI~ݵs=ܯjFRTr sa- 3Jڦϣ E;v4 4ΑHy)jAod}.+Ojy̳RC-_AQR3-MUWQJBWLK,duiE!|TkN6aaa.<dff"8$NΊH󻥤 c8ؽs\]!!3gqVЬiR[|k9SW_gςN.5+WzD"߸)|=]]XmZV`vHa9TTʶԍ"q8\N2S4w8rhH(u::v>}'W$3,ׇx<3- >=9pQ#7=FAI]7zkq̸Cǁ=v% :*XAv/*:?=\!jv/^+|e/.+{MLnelk^`@dzFdIۧox|PѢW errMfRRP $duj<;¢¢w77(++#?:?*:eKs 5v vl݆&+8CB!~FG.)&7pfܤqc 8s iӐfϜ.;!)) sÃXƞf**(3BTUمb06TPFekjVٱ=}{!77y99Yxa}bCPWf8~l5_fb"#_ 2:t--=9fYW e2BHq9⓳{S~L+ڧb+Vz2vbq-3"f𻤡]lh`SQ㴷ӺgQ(WI,C^,:qJ(CL!䳯mM7uHfgg:""y*2ܪ eK`𠟘Xvv6O*03B!s\q v%n%˖1c-MMX쫗5xFFzza~__V xqؿw/oJ-3;gIf#11{>عW'JJʨUT&>>˗ AꧏUckp>߃`dl mZd7J,8{>!Rԕx{5׼%/ՊÕE6kMC^t+kE* %d(񸩪*Jƍ+u%˖!996{LMM*d??>Я?ƍC^^6lڄ`]{bhѩD]rgo<~t^kKP>CbƝѭ;x)|p6df~X;O9FE?b&5 <^-!Hh|'7x iRbYfUa-o4x89^w"qvaᓅE}iMg I)^ !RJ<ٽ]sq~&x ϢFhT.%?ck)U{W++9)=KԃEsV+msήu:9~/ʿne9#n|CѱJ聉]g<^ MXsqԕx"N=>cg+cwE?܆@m\t1Ks@WIFE']]]а \x߯Js&MS2|LWsQYB)P$mۙ.^6qqXn=k ~U90igc_Fv d1gllٴ N7!sE= M&`HO̙^.7 ~ fźtmZr=uDb?oԂ1wޑ*+ fJ竣s!PS2 i&z8NB!'mnzNm_v_y㧻YG MQEE|nPt@y:ؚf msVnUX#k] Ni~zF\N<*.)-ۥw9z&t=肥fxw:<!{ANH&DAyo!E'prrBPPMd? BrnFp8ظyχP D^!N>ב8oohijʜ/0Bddf09E"̙o7%33V(Ɔ5kakk̈Bp\}o[k2l>^X$X,BT+DEbbo&hڬ ̪$qVL[['nqO?Pmk߀i8 SGָ߮zk Bj)MP).9ӵQBm5~ё:XF**iG'v/:TU:YY'^K! EJVo}VKKw(:BP ֊:vu6 $vg#$ B{{5rpcŪDh!1h@EG!䳬,ڳ[XX~%ns 2=Х̥Xl)],--kvhh|;/Ƚ| 3gb- χ2;+\/@IIYwka05ƾ=sc\32R7pj87h>Cn9$`+|Q`ԕq ==Ϟeźtee~Ѯ}df~Xžä$'¢\Y~6\jL,#??=B]gN.|i^^~-={bXo m--6;[;,[Db]pmVLYY?*1ҕ+8|D|u]6+$&6۰b>'$$b5b. )aP IDAT#ły%˗%zȈ{=8.;ɉZP$–m[%溹}vǏ#c"+fjbAH̽z^zɊq9\LT7nTG}o<2H̕< e )+YtчHVWymo^ޜ>7r+@X՗q Z;').BGg51:ēan~|gX,߷8ИZٛ%ⴢs j-`Z^NHNIABb" w`? =#ptpPHѠql D"bX CܒBH8t>~,|C~{ l-8`ld$Nyl޺bUKfX,Ʊ'aF3qM M,ZP}?.sgL,UniMw/ܼIIb?e^=v|J-'' y#9)5nm+XD?ӬywSVVA&S#HJ*|t&5}x-%-[(::WO_OD,K;hE'N@Hh+ҠԢkׯٿY1+W7h,Qt˖J]xDщH,:w`RNv+5pvZtr){$1ÇŋfXG CB̯E-* ==%5H}aTGKc2r*r5W 4JL6JLivE=M>M[H[ˇR|Fna#5&PTN_~αÁ` ʚ/aoBZV͎MUY)>+7BGmZp˂d_ӀgB)NH&N $$):qwsk`??*:dK“k ++ cGVtzR%''ߙqggo}! 1w|E]O?xkijb׎07e;J ;xgg_ ʌT {*.\@!W eet:All=W DjJB߻{1±`qhhTJNXj$"e4ϬcuSX_&Onr/:qwoWB`5-[Nŗ? mpѢyslۼĹ|>/>+ϝfb<OsaYeo>X֐l_ =a***R*ٳsPTҋjfLqcƲ2:[mZI4 DsI"'SRR?$;*V(k.QqmDQYvW)+VV1;[[OD"dd6a^S/X(Qȣ%}~AnX1Y?_vPXsVظnDx PmJ\KKKy:m:YE_ -[`d|X@{?R纻IYp8s^1R;Hգ8;b")UӧLILLm,r8R:8K~b>cq-[N["f{?{t<[Z#&ۚQ< x ͵1 6ͤPHʵLupp9\]MFƗrwk^VcVKqX\ StuG\N_Ck4ETW±&z.:(8LIRzv񯱝]n)TkTtB&22 nuVuuu89:鳂s~ePZ]PSSǜA(nP!\v@ff&3>ujˇ;Ϟ?gGue\رm;j~oHH,lp0xO9cJ(||puCעT|Wpպ sz07a7o^!<<^>BhHDzb܃_ Q~~.֯W bҔr?l?׶1dۮ<:vKBjjW8zdVVhk--ɇފdhH|\bw/ʼBx<^ W3WCvY/DM MhjH/~(痹8ѱXK/YyeV95mZ@A׏)066. ]]2/r˵df{{8ؗ{!$sʪSǎe>..?G2Z'k}e/UphR׿`u d2"MUS}fv&wk[z?{3!r򄦏Oy~JFcZ52G򔞓ǪP~ E^D5&vixfڑzE"qS>Gڵ^Ty, 5gB)x kX@$`-L==<E"կuu<.~tٱkrrsQB!DDEZYo=˜{ P*|Gc ^\Y J,M^B!v݋={@(*|UWHmJ_E;IIҗkrpuqE///t ǜyskD4zFp3{ö ^9˗#7]46|q.>@SSLJJ? ,o55+EKKI]] 3fƚU#~\,#*^^p8Զkkl VuQMl !"'?Uph=5{8C7Kv3)I+{5]rARH\|HNzN]h\]h\ =i]KqOKi%XGJJb&.#͓4]rq蒲GMUZZUqBEY,B!Q $;((ͱ/,: +^tO@XXXߜ ӥsgbڌ4Á!lM!2mܼ>r1e_y6\.+.zIe L:yyy -\V~\7|ѬiS^D҇\v /Gp%mmХsgػL坾E&Ll+d\_P-&!-V;fՊ]!g$ڏzTԷu>8~l5=TRQb\ 4xlmW"}B!TwW悓/L, qx8wT?o@ĴnFN^ؤI?PK}:#/]ĕޚzr/Ss6ogӲes<$oPK:e)؄=Rq_S ֎u۷b5tw}ϏNMغi3Lυ'FVVϝ .u! zݺŌO؎{@Ç GF:v۷?i" }M2}~_W߼!-e0`رow$'7oyܻ)*]:wFO/r-k@1uv,ZЏUtk$H[*+nmsZ >2{ B˭tSmàpy<  2 ~ `9cdJ!oKY NyCugK9|k˥Wb57佐g^wMNog'C暎I;‹gSB,Hc4%Bb}S ؄tU1QUoiKCER;q/iFybuR,+= 6\y<@ Pє*.zާ4{\JfC1fӾm cB1TtB5u_>IHh('St D">ș܅q& #{3gUW B^EPP30J C((jr_!==#}ޭΞS}UH̘= aaaxNtbhi[z#_ʿWqyIr^^^ШU}[v %y{X=sU':gEhi o+*# N4dgg:.CtT03O,иIp8]B)q(Rp‹7k`exd;:&:Z{UD'sDAo\}" À|"S9Dy/lTeTtW?}LW躡YE#>ǖd[~'_{x’%R.TtB5*:!n:>l>}0;q?.A(bͪUPR!2 lٶ㗡{۰o N7NNN>nNn.M*hִ)V,]">>X|rrr*Sb ˋӧOz 0(P漺u.] Ua͡)%Zab{w۷ΰ-m1oQhiUBW{ɥؘPR*_WWSSDֽѢm.2%&MKX4P`B*cw_8$.^Pqg:ZWڶr4J6Ԍ}_\gYGnR/g:.9ӗqzNP$r=Kΐ|>S3YqyRzv/e\4i^9B)zUToŋN6Yb'$4Y Y5|*#")=]]&v꿘9^=У{wV4R{wCMM (/[F||4+VzF28tp1]=ΊXac%n5SCVuenpѾ}k}|ao[cGWU,*L Tcw(\*-%r#BĦhb1C] w^ֺulivh71ȳ4ԾK]RZw n-k/"1)ҫDMX̺)a.<򕔒y?e֒5BSR_JNHQE;@ph(kȃO.4uG`a^F'Gf7. !,!1;ƌ]]\С]{soܼÌ5l*1<ÿaƺؿg/Lʽa5OO9u Niii8u4~xwI-8155#p"N~^ N'&&֌o{ )}b?J[^WbFƖX"flkl8]X=b1nҋ-N܂|UeG=II˽7O~9.w9NGIMrB!D6gݐṛ@ۯGͭמG] ZToڕvA"CiO"?hmu&e/ÏUN=gdi1kCײjYIB(WBWN'ZuHItuualdt E] 5l4 ](jXЁ1z4޽{x#F] !}dgv9c))Xl)3+矋ؼu+3VUUŎ-[amm]G0g\|\3cǂG]*//>ą>ϗ:OKK ڴEO//4m䫺sBQo^bۖPSD&]ѰQ;ԷuY! =\oH|^,x>ʥqWVeCPVV)}ba_q&Ecprn&MVV:], A>xW.A#hּ;NyQq|-+j2[k\ό"rPt3 jC_*|6tN!oKjVjh\Og~Ͻᭉ}KZf(6%?ȝ/%R4n~ϭQzeدisBO=^VnՄ7jivr7Wŷ S3rkKQ􍠩 A~R?}D8zX1rpn#]˼/_/#?_e'g/Pqg)vjiYyN_bٹo<~~hS-u<Ǵ,/Kp865 tyrWD 4ʑz1y4IqrtWIǘ;/crBf=Ĵ즗46_M[*'$RMӉ ,{{;ܾ{*8XsO"E'~D~T=|#njFxD߳c`ߞ=Sp}Xq#ŋaR=wo\gm۴{XO=ÌYq8,YZ`ggxv|Rꚥ %97ST* zyy޽_.ͤ o㑜_նŴ;`fn}8.f܅GI,(q0xohԨCU" J̭8 ̜&uJp1yV,_2ii%%Bbe]FMeNVK]1j<٥j-nngً!_kb<<۲Wq;ilTҼZZ?v\"FIs !=9%)muxrr2>xz4b~'D$j}Y`aHHLT`f}g-~RnXόtudr+<"K,ӻW d^q^> N|>̚6SIKy;v-Ӹp,FA'rԷ,\|]Aehhcm**A;n._hjbҔ5JkYZƆYX=ʴm݆AK !gbqdw[ 0кqDѣ:Ƚn֟3OgwJ&{yԛctKέמ˛G=KDY-GYj\Z:B:jMbiw*:!-^P40` 6˅s~??/Sq;}}}9pcy7o`8o?!!|b1m=zy /BZZ?o XxxO董ː%lUrrsif;^nݺXf elI*P$/.kɑ:OSC۵CO//4mDbL"?\.NMG.F‡EDSE7BنW>,aeeְkT߷VM=Jy11+X1s]++߀h{,}!>> 99Yx156jA]] !qlM͒46dm);&LPx >G#3f=}XYήY#  [Ąwx.99d͓w};Eq PZ"ku=uZT!NuPAAE+@z4$ $u=HIȹr}ԛcCK4o """G3{NJ1q:cҲr2s_IC$B$~rV~ߦ7ʡvڎ_e|~ T.c-ktïg !EZ\GRe&rM$+s*ֳٝٱm~ -+"ujU12>5]H^ E>V)gu6O.uiJTtrhjl ynݺSӤVv(Sj:>KWDQcoDBo.<>_nJX+FTG-7z 6֭[:`!KMKÐaCq=4T[IN)1d`qvEKݺao}Ĥ$|-B??n߹'Çj>R̚1:Cw}a?^١X,F3//Hԡ{oxL*/ޭw҉,aaaÇ.++f{ ##cZz bbdDy|Բ%֮Ae QFp&=|_.5+ǧP~Lezff?Qw>dOw oR'}$"c F nn/C'Znxzx_~$%%~d$jլI;sss_#F /bcca-YrݿALL1lƌ NfD;{lmdNNN[o }6Ċ H*^/1) gęΨ׭[/ae8s e2;wVX0Աz;7"""""""""2 aӘDOuP&|deeM6D,n3tRaݚ7qN> cۦpuuoDDz[ mgggCcՖ%Wo|ܺ[CTbʴi8WfMlqkjI  SsO$o0a8x R롡8 CR~MxKѺU+Hw:!&ס7sI[RwѠ~} nnn} JGuRLLLj L<O$$$eFԫ[Oϖm[$'q?<<6mN+c¸qo}˗HQlwJ%6nڄM7ͮaooкU=8 C@ qqZLjb4lR)u KKKWIDDDDDDDDD |pҪVZH$P(0 xzx T*HrrL1)))0x06߀ B""{9~ݳGh{4mOڴQ)3#''@^`o ߸;Uhۗ)7C1\A>}ISիj͛5 K89IKS:2hC鄴135Ej i<=<_ 5jNz3X~~I@޲º5k t5? ++ @hqzDDDo<=<'m ---q8Wn'1sl$'' }!K\g_&ùpn~Ա#|hҸ$"""""""""}c C'܄IЉ$b0upp0C'D,y077Ǟ~ddd`5hѼ+$"ҍ]:uF \ O?$]\\0b:S`666+PNw+5r9V^_V{_X/FFJR롡8 áÇu Z4o_۵$""""""""PA2h=A> RT{J >_~ZD"O #DX!++ F+4 "2DVÒFFF5b,L9CTJ$,󃙩 ' b,^-[,x)** 'OҘc7{lllJ܆.** A,?.p\:u Bڽ;tX!V L'v݅333ժ|: J6Q!0y$ail?+.Cv\!Q …v/@ժU,_>Æ Ax숈3r\T } 4.Co+  4/;w.\b4D4a,--~@NNMeSǎz)J,[Bh[ZZbЀjc.]Chש]cbb0p }Ç_L#-= p!.5|R֪U"5Tٸp"pIjgmm.;[ƍ1dKDDDDDDDDDb PPqqp'=6X,* a=1|Pb0i"ϛ_T/}4`vjZf̞%qMLLhBO 6B}aCy&&L~o)fϜ 339!u6d2DACat׾];L6*IRaXj%rrr~k++̙=D1$8t0ڷѯWNHޭ˔aDDDDDDDDDd:!:C'T07W7=wu: J[J Aff&J]wI=jHAN:2ݤqc|r 9w^ym%K!T͜!AXd)*W.T<}2\|uŊѽ[7|ڣrDDDDDDDDDD 4͙NT܄ŋ([e.y7Ƣ:|琈%7J* ,BZYJJ .]kՂ%0g>>s*Y`ͪ=n,r9`ێxӓJ0>rDh{w뎺u{3klgϜ *xCcEB֮- C\UWc_WDz%KQ۝ R d8v8233335E6m-EV Ht\)@zz S<1tBM#tN\3331M= T*! ZjMcȑJ{~ fMX |J5# 8w֥ vR.]f ǓXh<6-Zݿ &{j>R̜>rսp@k#ѰACJޭ='`4>t A!L'z*>ŭP*q=ԫ[Om-j֬@pH>NቍcHOO_B0xBD?gKB #a͡OVn޺cF-3{,thߡXj0o>>KKK̜>r8 ?0pΝ:/*;:Bz-N 6.CZ,&aa o!t4m۷lC 8p /\e TQ*aZmmm ۦ͜!s̆c=#Ə5 z~uaܹ8xTn:Xd)Vxd8s e2; B8;;;t>R4iXURA:u "q P""""""*M:!sNMQjUD=x: ÃQZ5]I%^zغi3$#GP*tb񥓈J 93PɶqUa[^ЦZs 4 B_/Ā~߹70idN)ťL2hO0tBo]:yuF`N Hڵmf < ª+`jj C%c݆ B۱#ذi#&8ii:b8>wiS}Jك+W 77W/S~1D8|(cb16h_]v$"""""""""*NȠ +=Rx5\\p=@|ֻk_v~y\0jj5B-i3CTț]dK-_ cͰ/RMQ`Iߡ]{̟;666E:ni$ >?խSRo)wG;;VHDDDDDDDDD A?[9C'ppc˔A ܻ|%{Y[*U?¿۷@lٴ7H'V^lX,ƘQ+VƒqBz4߶};~gmgg-6cp222>SSS=[cV)))8 CRJֵ+zaT"""""""""2x AiNSw^ 8S \Hʕ+[A ۷lC9=WHDߛ7qXJQ߄jn?z[J*zGݻgy"QKBWűAéӧ 7n|ھÑ)M?=|} UCBb"ϜΞU_/Y ''BHMKS ; å˗ |XBtl777c>D A˗9aޚD,F5ͼS# !NBuR1z.^x|mٌ.5\a.#Ҙm]ݻCRœ>sss,?X{do@0eT<D" ǏXʧS( BLc'r^efj6m[֭[}o( 1QaqzB$,o)ƌV(ظy36nexlٲXlYҋ{# cb1yyA-Eaaa*}T*m&#"H$]蓈 B%y.1Ar055 H$0t111+1~D8y <) K1XX.Ƞ]=Y졓?35Gh`ײE KhgeeaĨ|~iyo]ll,&Nkׯl\rE$z9~HkԀT _H8)ӧ "}Բ%֮t2hop*گ ݿuh3"#n4=uV'Xl9&Nc ?lް sDIHHϿC&Mгˀ5 b1*iؠV,] DV=~8fΙ !.d8s e2; B8rܩ|}|PvmWIZ> ~DDDDDDDł2h"z/B, K Gk :t1220sLdT 2o@ \!OmX4=f(̞;B߬3QByK~L6 /\תY׭'˱rjZeGG,[ 4xK*1JCCp@!##C8SSS|Ҧ |hݪ[qQ_nD̜Q 4tBU0:QXOѣGprrITHb̟7HMKÀnZ4sD>x!ڻWh FGsB_vѭKlr>zDhWX׭'!"BsN;k6rJ8r4$1b 4Tn]RU.[;.DD%''GgO]V A˗9a ]8γD"3L"cޜ9077ǯ{v2331l]Zh [z5rssNϗ7ag6m/v 2vvغi3*Vsd7YYYB&z.)VIII8v8e2\~q...ҩ3|}|T+M{OI. أ:Gei 6tB GaaPT3@rPzuDEEg:JH'C" 70|HX ڶsDTZ޸N زu+Ӆ3g_mشa#WyR0o<:rDNXd)WV WS_~HODFF :uB믾bbb0p` ۆ o-.^/Ib 4CD,.yl\xd8yrrrF6G*Efʹ,HDDDDDDDDDD $:pws%tڱ/C'%^|$[R J!Wx c"2lظeЮP.],1zh$$&baj{Cj=nnn.6mق7AT +VEѴI׻u6d2-I8wNQ~Ek^-fTϿt˘lDTWHI|xyfax>[I[Z bIl\<{oKP*^zT0,ptu8) :íq, ##oo~mff&5LLL ,Fc˜*U`ˆV;;w0aDk|5c͋4ܻdط?[N:h=DDDDDDDDDD A\]*nn/C'o4_ x1>cIM돱fj;YoQ#?P*0{RQF033ÊU+_^6o؈jU }II>s&8Pn=,_UT)k48y GqY(;8SNZQqؽk Sv_Zz|WyP=\޼65Q c [ :qs{:EdT$ݴDs(瀪U"7 T:၍cHKO"f];MW MFWW6yf.SH#^<"z,2Rc#o=äOwbҮاN12`֎E$)-v-G#pbd,AoMQmfgVp .HO/R IϺߢ**1Y<ggiڶAPa";P4mW^rlܼ F$ ssst ,bڵj`L:Ϟ?W;N>_a¸q066.kP* NGfLMѦMxKѺUR;C(.޽n 922RKK޾"WGY!lmmVGw:DƳgHMMDvv,-maii*UP˵1\ݚشpΝGB7""""*բS_m$ C'dttBEvC0,, xyx+!: Cƍ}V 2AE`dT:^ON/ޛ[&$%!Ae77mX,Bz"WG"p+˼dgbEh]Lb [U/Ҿ*A"ＦgamY;z713Bhuą8[[b$FçzRS#><ļT ɨ*l;E }$ !;x7B嫳 ~X ""d"x4m P(ظy36mޤ6ӈ=CV{# :F,aJѭkWXZZ˹) <ۍj_'4h >w:.?Nɓ7ˠm-۲Jq犨y=B=+K+899!&&k^@LL bccQR<5On:ضy Ĥ$+ \IW"o=Cgj}><*aB?nk褰$FbvG+owEfz]PaèR9NCrp8g{I~#1ZKk͡fjIShcco;zcxHM|9{ǝGx8+WeeMlݾIv~{";;gU$aYءӧ4u \_fͰxB8{qq8Yn)&u )oʎ\BdžuyH=‰0f܏hޢ[c ź5U&"N/W"KDDDDDDDD#wD%)L'*NΝׇN<Yٙf9 #1. ۫%Rcjz]&?p'giY8n߆H$R 4_[׮2h00~$ϰձC̟3օ EFFѣS[RHw]AD%HMMTZcǯCJZ13SZpR m>!"NE"14m>C&m!h~`ccGG4o RXr>TJl:KWҺq0ȯDODDDDT܎5W5i 6.Cue^:hDGG#66*U*09U۶Bի7p 6o[ۢ-+Rh{sݮW=IDA]*:M|{WU }^F ؖ1o##M~VPǦ%ea3v&ӷAu/YZͪ$*5K4-k;s-# [o0J a4-Y3g"3ecF7}u' Íгhܤ[GJC'z* BŊQ敧=uZի%R}+9bO?K 歛0x^gy8]_]5UP;zPEmپZJ3Qzҳ1?N$FbTf+-Ē{7/`}P*'qORz_T#44g?) JԴ7"5-H`Zfm dgg37q>ns8g{cO?CÇe=ui}{D'أlׇ膱*p)A>g:!yN]rP,TXNNNx Jw/p9s[1` Dܽ }-6L=?J9<ںhk׫>|8,LK¨׬ .Pw#m? ci]Q_ŶoV޵ai"o##MXR<ŭAj!Ub^٠({oE"qkP-ha###ddd ==][3gߺ}2:X` -TvmظHQqF_FmJ"ѻ=ҬyWl<YY/gz7 II">03Dj|0cff:bb‘##c9S ŷl\gϢ Ye9ںdSfgg$%AR}y-[ V%rWTJxIIqHMI)mQ#,, T}Xr^W29FFPX&5w+Cў8)E2΅Ŗ4!1-$[2޼wϭO\meinYUGKĢb)dqJO2srM,͍3[[CDlť'%562u.gЪngX~Jb+9u+2)6fƙ쭒?vjyw_1tB-лrws:yL'e$8DkCٲemK^俟0}Vwp(*_}XGkؾर|MVFЩO(ܛV{9ۅݼg{R@e-;;b$Q\U9\/y&:BkimkQUkon v9rssVV3{6t\>Ob#k^DGG8n:zKѽ[%'k롒166 "#o }IR֬c֤iX|Za`_6/Tt9jD"jBOAZR)qA ܅+PËe#)z>H\ro]BxX?q8:^;8:j <׮\~B$F}t>n I{_~CL˿:tfͻ* Wĥz$hH$͚wA_ظ􄤉HoTTj|@" $ eO/戵IDT\:!9 C'n^w~ RRR`cSS0:Ϟ?GZ52e4tnaPwXSovAd; VnZWjU[k[WնjUXWUP@EE" q $ Q ױoc/#!YZ.JG}S!?aނ! p^" }#PR6-)[RNd Vu\ _&oQBTBQ)+ߜ\Y84.v݊~GwTT[gxCWPL]sW|" ]nJBw_c)a Y~*>.ɻFtL̺{啖wPIJsÂIY\&W6~(^"FlFOm AV}s ^8$hN@NtBQ=hۑ;fL͏xqbw)O`֜9طg5O8Sy~uQ/AX|^%**ʰq|ZHc'?O8ڔָr(vz*UeWcμ5zN@A_p/CB5|M*͎C5e|vzt5dS\t:oⲍ_x9s htBo:u@b :3jFD刍X쭚OYpŎSZ\s6mYNcsJ j3g^8ts?bj.C!r A Ե[\_/[Y8q4<U4S&#R.% 4 3WGG)O7hmX26j>>02#C gPP, 6=z@`>B+ x3ڎ ?0}88cvpƦ\>q<#Ʃ= ؼ񵚀+Ɩqr _;޼LV~\;>Ak044Ay Yx Z](49~.VީqۺppѳhtK+Yld#U82d㛯ҸQǾc|;uB@P8 H$sܾ\Sjy'066GMAAϧ?x'fV&7-MDkc!L!̗UIJ\r˼\[uNL ;XEX rPeɒAe2}px\XcϪN8lvAX #c~q\%J+N/[G^pNB9 ,K#}SD+cH(rY2aj^sZ^I@L:Ҋ;Bt9+Y,%G< *Vj:6#WVl EQ2;! 2 go76?`!dmlb ,+R~2y EQ O>,CRH ѮP?褍&B\]#@\\\##ڠW.D"v| o-7YYYxu\ 2Eq#(*jW9, ع1\Q5m56!BKAjJMIMfѶ;p~MeǏ]Voç_7Kb$.A9 M@DL^VhI |iyƪȤ :1009s7־\;aBp0&N g#Am;b-8!// ԗF C=4 f_fX&e?aΟ;}?}\@QZۣH_ #@hࠩ2m޴V~'AbEۇYQ'cipsk Pe(ƍ Y)صc xnCĭ1]r ,ݱlwprd{ L[m.Gll$ՄhgaS3k,Z5>1륐HjÇpsuAAϫ/ I1a9l u7}{Tj\ ͒MI=w e-ǣL| Ƥ3MeYTjN~_(/T*+p4>~f~Nz8}>:e Ltn,(z8_ZǯNOLB :)ʓ!RzwoބZLJ/Mq n8tlVI{@҃lڶkŦMN@dǤE=1iQO'ލ'Y78VpdG82S fۄ ,oc6op{N2T044>nZ9 8vM۽qu@ƛZfX,k0dWk4Wvck_C̃3n4DT 6K+|ns{OGr#RTrTV~[Y9baffXW.Xa|DT⯣۱hɗz̓  gL5k)E"k/xE3 J{dv&ͳ\p֢( \#lfeû9k\!aߗe'G:IJUgKWg7Ъڎ3YRVQa(~:7|Z/} 1ͪ`#0YZ0[b_8nISyCc#Mͮf$%yc;S)|g~jkzދ**{y6>̝5u {L'#vԔ!(+GN}AXjLsBN xNLJRpI=7###$ز+ : Y? >=a𔆳TՖQ~K[.u yzfSWfh?f4vMlYƵ4G7 l-o/c~td|fWq:{Eg7-r u7F}s Ǝa_S*yC~} fUwqHrR\+*ʰ{Wf69+uNM((*X8a6C,6/Ƅ7z\6ӤJ<| vØp48srI2h"`p[_xidgfc9XfW'Lͬh =XڿQ\\ yv`]:XTM3 J_m+4C-B tڦR[I]{Vw:D,dOagfpn[fAifb>'ռdn[Vaـ|iY7;RMQ:Ḿ>_5pR]o+l8>R6fY^Qc'^Ӂj)!p|F(DDBNv~tB:A'J?nk#H Jx<޴ F+**[-Z~X^#xoΟAQvl[ZeԳ}ө:2Ǎ[sƙJH$i(+^ά;;֖pWk\\{%:z!0>>ED8;_pq=wU*uIAtɔ@2σF#6_*yvn4(-PfbP'uY47ao؀e^H E \zc_H(w߸.eN@EKFz263Ob=L͟\_g:˩ TM\> ZcMkVxDx<=i[? :"2UEriFL0a#_PimHKCl9+TM{s-(^v4nhVTAfhhş?Oޜ ~F nDi IDAT1qjEEU$9M۰s#00hA/??2K6 9>1V,ӭ6ÇsNn0cV;fk{tJЁbЫ;J̃(e<)2FBmZ[߾z_ wIy 8YKuN#  Ӂc:[WN]*UjpŖb]#q*}3o ĉҚCgO|\dy^Z_b?Ԉ fs3!K<.;~^MyjgfW{.).k0 ADk A'D,F!/OظӃ7=#0fԨVAU뇄P)%ÅCW6Gzb>b2*̲Xށm0 P^K]IaƵQ3q`U(O#(#?lޘ_T*fQ^^rM-x_ṖSn guL&N~Jc8 !2 L]"s =fll +gsX& 1s<ł@ Dyym BE;g2Y^L\ 3~v]X%:ONg35“'k2igur%  x֨?fwu5h WVbF{B2,~rPbNiJM VԚY%Pj[wf6Szl;sWMXa"}E ʍj)hJ  BNv"D-.ա쑙U:22ϴܽ h)oKOE/4sm2mMh96mQMS5ښЀHWTTBА>r3K ɠ?g2h EBQ\+Wn-m )**Rѫʳó;<<״f;+cxM.=h.`pppk־ۊH_D״]y*= YQLkee\.ȰI1669D*/oq듕CAͯF>c)9!ZuGiz 卹,(?(u) e)<]fj(|`ntwCaݘ'ϰVG-`>P!СTa*WJ\zt5Ev3HJPk %턕e4%8HTaejNJZ`Hi}]WeL/AO :!5f :!Zgmmbdeeή1A8R;"'mb& g~_7ʬP݆v4^wO {Ҧ @*U%}a7N5>J nqZDz4uliiQ]BQ .^ξٿ3LOރYfh+32'NDZ? k?)[N:#VF_~+x}bFߵ~XP(0pFiS`sf#9^&k.ؽl/>ǩ3g`,?x8qF!!رk'}pqv=U҉Wahm;<5~\0.Yh_ ![%4p MRaƬ#GĂyt=陈\]\{1g\qp8o]GGzd|KF߹_߾6JEo0NG”I_mRHZG''3V-Z捛}߸c^v'}zj3Fߠ@3ѾknddpF!!sbcG1FDFԙӌů[[ZddfǟDB!x# C]oon:wgͣ/Ō}C/\z.6˘?{ϥ5QVo~l@Zd{.Q9ݜ7ȇOXcL$aތ?o8Lacsfۅ2y}tTM3 JgNQ L;3Û{=ЧV>Ъ ͍L^-JMK.{1扟Ց/f D ic : U7+$/6A< s^Z}ĚIke \?S6yMϑ@bcr٦QtSPgFA6}ȐU'O 7C$Ba`n+e:!xX,6F{^{ Jx<j8 "yo<<̂}8 Чo0|:'m iw8'3`@~o[ddRיRУoӏ޽z6ؗ)fm4efʕXCiSbԩ:ڥ S_>s_*>C|:9̜N}|}}O<Oב J͋?|}YZN2Ǝe1iD"FW[pϮm<<-}WXůNo<c04p}J%B6%**tod"LeZs#G_p?66=?fjk2b~e6 Xҹ..5s;wfeXز+~;h.ɻj H-D01iӻMۻ7mWB~(+S9[Kwn~@oM}{(.@lFiE łJ؛ ~RSpL[ t-uK:/)kn̯\bFu(+]7Dn1 uf|wOfAкmzmN:*TgW*UjntRS:זRy7'ߟL[E A'D;W?褍A;, P1CVVUHtB<9L?ػYd|kF!q!]4k)9}q D3^s6/bȔ.8Q'Ix\=77##uuۨ(]!4c윆WKO7tAQ/.1{ ukp\Q }RfqxbbbSՙ3aeFċ|h("@Qbo -o-ZOUB}IhKK{XBK ڈQ ;;Te9lcq璹D{!"Hc &|>_k H}:Q@173,/Pr^|>_c MeҦk'3JhB$nMX,z=x[WtrF #C#b0rRV}zֹoΝ5hҡCZPTVƬz۝e6pYy M L "8Yޘ;;J[gnιû9wۄD</-BRmDjϻSHOsń/\UhJ2ڪ'JmUdag׍{)Vd:8Х [m} $hH5y{tTշ=qNDdT͍ L*Ǎ3~ab &҃Nëk60iTj$=ƅCqT1[Z⣟@9f\9׹[WLa/j P(&ob@; ZiSKFNbnos77A뾺Y^kCy1q̶S_f$Za K*'fsPZ*)*S౺v7~ baY^{;/c떥Xz'|<m0IHM:::2ۤ<;$--,[;gڶD"AѰy->p 8a2 u2 mn 6빿A?%giwF{SyfHNlTɚmIq-b 8r'=<CS6B";1S6Wc2^-U0-KZt+*UrMxApҜ\ş|*Y={õ H*x/ Aj|,5#g;͞>bn!VL=85~Rs8/ yY%';g+xhm"C>Eؿjރ1Ƽx ##1(B66`5ߵױw_kCOʙNg&Ulj lY\.WnA-5EB8vpk|yy)R_$2c'0GFwqz7&bCtKVT{ ~ `7Dd[Fz9G5L񒢲'lnvȭ$O?'Ȇ)*څG'[S9l'TYrNT5Q+NJN}Xy?z[Vp{ g{Mk̘tB/ڠ g +e'A?u<W~ML :ϖd n<}nR  0/U }vt}xbڡسZ{Bt{U:A'.yCiqB)mdd"!f"p8,*VY\>arf򳘋e VoS Pxҩ+r[4 \|  ď~@.]ZvAZJVaN.PS3+r^ǴkHjΜއ3A3]Ng3Y<7^SlQLm rTe"9lekfx#=O:In⟝mMuǭ,ӬRR:.bTj2zzO 0cxcb;;(N<;2zpаJ{ b=\8&16a 캲s쀓-x~ z,L:1?EXNH l8Ix7Ӑ5fa,s^%zWVHRL 'MO{"//AApRSP!C22q/NNZFTy_p[ooE#=/Bd'L 0vNw|~N CcWf`=˿kWMZ Ђ%''c˷[1d0,\:\E7A"oǛK 7i%eP%7%aL86} EEMonAc4]$'?ivi=o\>J FĮ@++G?v 9mc/]<ڡ1`33Z۞ÛM<nx xԟ IDATk'H.Rfbѭ@WN9;|̙;Og s07~re=jgAu@74m~ߪ_/7c˩h 7hf(eI.hWxmczjV,)X3!ͪ{cuf}jb}qV@SA4)Co3yyz"..nN;'O$%'捌"0^im~[8 *LhFp! 2Xcs Z>Ǹ9IY{SKC`0?O Q((O6L` ,6/#makӱrڇ|A㧍l };·o"IF bS|d?)2@dȇȈkGt5z uL-losA' 'M€~ŋ8!rUj5 _nA1>8z$e'[&o?x .T;nB^^&5ulll$6nX7ypw$'IAr0]!~Dvnn: o|AE޹ 3MEݫ()=9r[ioßy$BNƵz 06w77cVWW*r|UL{yFRi!"#Bq.qẼ_.?t=xe6#!?qZ/֛mbe~G&ޖV(l[㶉 KduH%e f>9t'5EU_0(X6^j5 Nyrַ^Tm) #?;ܵeH7KTR\n(#ޙCgf$. ztʼB:U"rdwS"!+vҺRIA6RvVi78tNم/U)Jp3!`.D$V(yruz~{^IwI8"}7ADK!A'DƸ/ENU[^PqJ ~P 6ȑHQ$ VtkFyqTBA,cBp0&#++ ϜѿI*}xNN~ڻ?݋>>GlZ񂫬T"1.6޹9b43q8\,y+|~JEM{NN*-0C.#!Nݥk^z)KiIZxu0p2.Phqǎ[cݳVJH*-ąp!FAċi}nj5%Kd=:wQ9L6ܯ3Q?Al%er̈́o&diaMyK+]a_I}:R6U,&,rPgM8Lˑg$TU~\ѽº/JExbxbSAn A<N@NM=ӵN```->/ MWhmNiF3zD ACvvvX0>NġWf̔5C|i# ^Tu6dx=Fρn7Q̈wH,05Ƈkofo|X3n>LJ{X0O>; oO?LMAċ@QY,E=5q}?֨?[r^/ 6K/,72|NQ^2792o?OB,lQK7T)ZTH:E֨?^Z,7>B~إ: 9H]#u&agk̬L@\\<6>.( N$&%D'B|JUS(YnGoZfżEXh8l>>U+VFXN KT*kj#,<6~a|p0zbYx688a1g:$'ǣ7M$&F8l666NC {Wtַgpy11 79 t:V5k}4[3νhƯ!¦O#z(dll0p3ṶhsvvkXj; %uQP ppn~[3(F}fյ >EOpo߫o fýH/(VSBM O3XbԒ E1-Ej3[^nkNF&?CBi8E6Ƀ:E\=&P*PմH[wޛtK>9VBְ|iRn6%lLDw;XD-a }<'ڭ_Ư6l^m [K{žv7:&\->lX͑x1m۱{ *YbzJDtç@d櫸w~ߜ WVQ{, \.8AAظal_RRsxHFpkgg1Gcprr{";>UUsy1sM[OA2Y123Q\rrC$2XlDm=M)PUHMC$ RiLabb ++ɒ`[imqsrRRiB"D03+BxXUe~" ʘ㩬x&-CZVɹj$AZ4,X(9XM<:ebR% csCQAaMV_{f6n>ZfW'66yEJMވsLΓZHMJ+bL㕻XHF:A umѾ12{'N ==/++ ?݋Eg Ƹc5!ghhWb9pvYVۑжpTe2!AAFlUrsyщ 4tNk SwHKlN PUv~^iLȓ]#uӣ뢢"Ʀq8} A)s+ 1tޮIp%X,XZX /X[់(,*›o/`Պ K,Ep7:'N̙(<|e7ݫ7&c!rɥAt)r= 57AADK*HGmsGiO5m &A<'ŜT'DmpXuBb" Zt^A-1nzz. "٧3m~0l]kI999xc=|cFy( MII:̓f?v^-A% W^wVcߧqAA-ן?DB66 AAA4LXk]}RWO 6tBkL' A'DsppX\sNX]Nj( QQ->7 ڇW͍1?p1DU.8\6L, oUK;6LJ^(h+aggW},_7n}PXzbR^1kN#GǕ.kߏYrs xDl߹& AA4&2"{$'Uرm5B?:w N][cAAAƏ}׮>ȰХ,Q\RR֯nΒ֙%Aij&5HyX,xzx 2*c^N\ameIn. "2 Æky|u2)ܭBۛ6|P9vLcD'''V= LJϿ`t]x@\/7mĝwɺi055ŴS1mT$%'qdfe%''cǮصvń`=z xq(8B?EN]ak ##SPRi! W.y\9U}-* سadgelY{[CFY([*vN?O*NNu^纻,zs=$>]UyXOJrFYU*۰SrߦeHn=O2tyƏ;ʲ?\C[C`@TTE'v:a k+k$:::6nG¸ ZU&]]]{=@䕫xKRD"T(_O=:|9ص+V9O ױ{)/XQ\\2f "\A@:|o߾d2DDF "2z=uuD-!H t]""Roو:OWWYBʌ(wـuj;/l"sy;OS"NڦF咾ʕ-NNqq8W݉Êիg o]ѡ}{""RzhѲZHJJg $";[MMmke6""""R5&jw8r O$e2FvRU3!kߕE҉,:!5ǝNhiiF 'ѱ1y>q8r( ,; ajj DÆ eʔA2eлg/rmq=zsa LLOOl\oƍ$ \\`gBcBB\4` L ״ ?vBCC'OݻwL!!yݺ:UV"QIchhCC/O$""""*&ZYWLhe]1Ay} /5XtBEÖy/:co"11Qyꘘwx[ƺAOOO?d000iXZz:M`طj-eggc? :=R{XfMb…8}$-XfM*XPƍEN11y=IDDDDDDDDDDNH)tDDo߾%K;±L&FDDȇLLL0t!~-455/=w~F$ ?_tipuU[R`شa#N=PZ5y_~կ/[ ! }XtBu}IZz:ݿkL2Bv)\٩Q16|P ;<1a8K%FW^ɭ%0 ~mCUL O//68|9bb]4 &K+̋WMv5f4"--Ps#""""""""""b ,f &k++8-vD" Sj^DDT*U .c811ժp0AǏcY ?|?8#9%Eaͺu`ϮcW񀃁7pbcc ([<=

(:dԼx7!~ƍ D̙?:X9-BB1c*2YkwwtIOOǒ?qb:o>ؾu+ R¼Ob-6??NL,\XtBjgYtBây>eʔpEDDşChdc#ġhټ>sQjUg'OE>vձcv $wtIʊ+V#FCؽs t¼QQX:8uX Bff 2&"""""""""i:¤XtDİ):Ix/_D"4nAǏ -G*_a]NH&}S&Mt K*Tu4l( 33Squm---xzxcYH]C>}a#G`ϣ044Dѭ#l6̥"6zN'T>c`E'`V(:Arr2 #LYRD_z4 ڷ'GdwP IDATw,]Y3yR ~]!##99ۺu000NF6mo?yy Tu}~/FY* hco6x ǁ@DDƒ=5js+WVQDDDDDDDDDD%Zl W*U/1y>N8dtRsK _|UŞ<>?tb;YZZbʕ~l}eʔu0m44rCBѻo;UAYзOlߺ *W0ݻXbСdLDDDDDDDDDTpRk ۬s*d"p911y>\ p/xLţwCJxnci@Lv)Q5ssseD^8|RSS92 h}StwtDvk)L&UuDd2U@DDDDDDIԚlCEZ(:N'"5Z*J~Tro۵SuDT. <(ֱw=ϙ1.FZZ¶A"}v兹2331a$y Ԯk;ރ9sh1CDdy/EU X,F#4Ɓ@<Ҝ/|6gallllT=#C: """""""""`{Rktš* VV}"ĩ⌻}zu2,Z:::(wT8tѩcGcA6%&&b?n={b/?y NH) _mL[|p,p9Rs#"oǰP|y!^&nnDE ;9 qpvuyfwGG޹j c6}:;:bӆ8y,ӦzRa/}zn={b-$"""""""""*J,:!&jXYZ 1dy>p,p92Bѷž=~o߱x"hh)0} }V QzuaLp0fΞ{*-Eng /g>pg.ʕ+NNؿ#`bb0/NV^1jh kCDDDDDDDDDTұ;愊UNIZZܿskժB܈3qx&==]=gaΣGrjJcӆ(_0v 0k~% \\ 035_z..X퍬5iap)lڰݺ:* d3֡=~V0ٳgؼe ~~c^VADDDDDDDDDDRoT;1:6gTHEDDߦʕ*~B /F7v0 ,YTcRH$_2wΝ?\D";9o_r))e2ZmO//\ a3%ZqRw:ǫW|X,FF8,,Lѷ# X:XCOOOټsӭ#3JZZƏÝ;w >.^E ʵNϯ@gZZZhco˖33sl(KNNF@3;wƊիCdLDDDDDDDDDT8XtBjMDEPdme-wƶ((%/"" v *5J+bxט3^k-p^g.iXݑTോ3CCC۷n+WVl޲?t6??$&& c""""""""""a 5tBTJ*UJumNщT*EdFDD.mmm*_Ν>{þUkgNFࡃ3e$=g1o޼)pn5jm0h}؉'л_?DDFxoA5#ϭۧ3s#* KzmcAARADDDDDDDDDD_E'>9A6XtBEG,RcӉ%8,<\iѷ#j[(M®s̖pѢ\w0D;k6Zl)݉W{ikkkV0 1k}}! @, ̜s`ŲomD"7/##g>e2Zk9rzza 7tB*VJ8o{X 8,mdy .\DPJSqQaL߯_$&&bሻ'إ ,\ԥ2o؀ 7@'&KchݪWcAAإ .^'{utto?UZ_!C iJ5,< aL$i@LvwRdrqa}6yhcon]ѪeKV=Tt4_HDTHZ4oUU!Qq[ ZXZ |ر+-7""YYY]#q 0}n#*W,6malΝJ{0;4t>^lP|WzGN0}TslS*zVVsf>w:?~&8v=SjDDX"? XgϝCV ÇC-aiizի5+W7dff";;s̓!;|u"}􁍍 &O[oRRS1^Y3f@WW-+W,;9an!` 9p^w'+V*5I8vuDGϯ(UPU2{kWUuDDDDDDDb 9tBgmiGx^G&A,FSvv±T*ŕWмYsIDD߮1?Abb"`ي_ѢysH$b:b8d22220mMM\kִ)Λi^! 鉍Mv5-,kN\ w qu,uO@84aL&Ő\ ŋѮm[tstM뾃ϦQ[ p4H=zx W: """"""\GRk~ 9_{Io`` aJˍԃF!w!ndcA qLL |7?vӄ8-=ncAtLֆV.Uwݻw1p`lc$b15m SX`!5mpϛ5f4~ވ)nkDDDDDDDDDD_¢Rk,Hj[?/$b1Ա#455He2\ ^h^^m"""""""""7ZN'T\X[)N'ֵk@/)D2ibMrs\Qn=!۹^u%b1/m㜝nܸ###CIhִ)G-1Lu}1Qxүn+-S1g,4Q?NNNF@3:W*ʚ5,:!5Ǣ*>HHHqX8N(wvvrvH$,^͜3III]WG[k}| ) d ֯]iS=@߁ř`_S]o>ؾu+9WgTREaӧOytv~c^'& c"""""""""VOrE'"?(: bV8v:޽{yz4[,Y#ssss&ϟ?˿>|׮EJNaEJ\H$`''\Dbb"ƍ Fpsq@ls+ t¼QQX:8uX Bff 2&""""""""E'(*URJ qANdffիJɍԏeZpttcAA3l}Pи?8q.kfM6L2خݻ~%dzuѥsg񀃁i@ܺ}Юb1ctQnW@`Obya 5ŢVjbԪYScb_tRۺ6-vs2:::Bb*b,7zzzJ*ش~ 1ks2ϝ>-Ƣ +ߎCϯЮ+-S1g,| Eݱ=RADDDDDDDDDT\ԚBwTZ8|H=+[: ˗qi9+U¤8k̙?/O[ZZbʕƖ,]cAA_uwt;aii)cRoL< Ʌz}ugdd}`֭ؿ.T¼wbz_tvACb?RRST1NHNrݻHKKs \v@kQ1z(U+!JZⓧNyZ],^ _+d2<{ŋJͱk\Q ?"ʕB~Iaan7=t܊}w9u۶p2g(P1bei%Ke2{ ;ۜL\zU)z#G {w>9"̅06B<{,Oh߮OLL4 Q7o~e O^R.O`aX LV9bll0g,=}+-}k{H$y8qcЩ{{rD&""""""""Rk"%Bbq7cbF:u/aJɍ׀~BժUgZ)kfiBsf`"))⌻}]yЮ=lrZIR[.xs(ItѩcGcA6潌;0xPtk}}dLDDDDDDDDDE'>.:a .}_LlN$ 6l aaJɍԗ&ƺ" غ/y?v:v /b^<_EMpvs- *["!!շ/oP53`''#`jj0/N֭E.]0hP۷oU1)NH)tjY[< ]5>ls5u^DD:wꄆ rغ fxy ,]>ؾc~]BO=s&t\ytx9:}ǽ=wa?X[#zt2eʨ(sT#{whh@GG&0+[ff (/X$"=tgr媢rZ ϔO9/Ο; ]~!f|挢&1 [LLʫ(sA-u5~*̈Hv_^a\PŲq{b_rbc=H USaoĔLCǯSW*s""RzNHŬ蘘|H$4l^xyXxeHDDjlDw;RR k|~+MBC~C-`YV|1dPܽwp̜= /PhXD";9 xL`4;fPhC\r9bFQQ G 7/NV^>kФI8vuD)## ΗH4PFXlu~V^xgpY܌ ۷ɟS u5C'4i ?!9!U335{j7&`vWչQz!'NyzX0o.##gx ;IXff؁@+AխS{vn])VuԁΜ9%1jh8 +Vv³c7yg_TWO>;'956>1ї \XtuL aA: E'jNR__t]zа΋J3S3 8Aa\,nfncW}/&Ogץ?p oH$Fhۮ/zz_wط  333zXܸ~Qi9i:$uXtBN'Ϟ=D66 7a,:!"9|8E||<`hcoMMMyX`!,HRx߻ڡ|N e7qR)1k)S-[P{ժalw߸2 p)܈²%hdcS9 *`9bnDE! 0Dy7p#* +VDڶUX_0޲Uw tIb=x|]_$ڴƶ>Y*HM)iXtr=;ZxknPq`N'S;kWUyQQT)8\޽>_HI{{,7O?xZ_KCCn..ذg0lQH֩O:~kSǎАv"##g>e2Zk9rD jHR>q+TpUZOX$N xX,AV ̞ m|x_ھ,C2r?{!N;Oa 7P1Tz 1ZE'zWFDD%G}ann."%5%׹n.[oChXh٭#Ə+iiip?wZмY3۽͛5ƤR)֭Ũѣ E+-S1g,4Tܑ&)) {1xP8莵x 26ed!2"Xnܼz3>O$Qvotu|Q2n%*V܏UP. !G NH)tD> QfM!-:Ճ_b"";DqnqϭxhKLf}Hs~9 CDrO{-e(S 6bT4BBѻo ٤ FFFۧo݊+URw=[~c?jC߻rc-[HThkCC*bb.!;;T-,""""E_B` VVVv:t qE@Xx8\(-E""*:88 ""#nArZ[+V<~K-Ǽ9s})&Mspvs_ ##DcTrrnDEFTV^7EwGGoNUOIMXTIծb4 IZ'Ou#qۈ))o R70Fʵ`]s{ɤ; <~"=LQ\e5&wlHHxȈ`\zϞGқWHK{ ]]=;4G?s҂zҵfEM-CWM Jn)Je !KSCHOQuSm_)̒fIQ3Z$ͨ%--eBhHDIZDSCh NnRƠT7JG ߥgKϒikj2׾eWI=\.! r,[U5y =Kf%5$7WM#ԫ2ʡ/HDDOH}\s:T\X[Z qw ==]xz5/K iu<{ĵW5{Kx?obuA?$V;SaQA|rco k[gs.(Z] 6m Tt!Lg|~|m2#+K',CjD,9-W[;vYkBo=UhPЕ{eG Zwś+8Qی2Y=7Q|+8Mf̥;/\;_6Kc?92eZ{4rݴmg Ĕw]rS'ynKS:&$""(Pqaei8ةW¿:7""*y&N dX-trSreO( ;~V0|,f̈́Lڇ;:bΝUjj*<具oߪ0;ʫff=Ɓ}1r)̻s֭?vC_EOIPrM'v"%%Q[rY%hi|bvgui.h0mEc(S/d|׋uMTO$ʺ1ڶ.?@?0c. uÇ`ͪLH$YpD{hGP]`寮.V ˆ؟nߠb TfIeFOR۟pkӪCC}XIeŪȢfI]G?Ѻef{aˊwU55X\@&Ǫ63Խ(S䯙yʽ8PIDT7ARJJʸ &&@hjja 1J˓JժO^ص{7Lp0 M:~>,9q$=.?kcӆ4d<}C`hhi|Gaan~;r*l' ĥ˗{)ԯ )?jZX}L;" 0'N+ d@Dd,=uuD-!HT}05,qnG/p.Ej*n_Ń1rcܼp]\-ΝXj]9wl#4j#l*rsR)Νݏm[ 55I>Bݾx==CvCOP᜸WmDG_ ?ѭ;CDDTT?5uY{3oEo3jxn>q퍩nyyKZսʺb,<HI˴pɎ}5u}&a)@:P7*XG[VVnkݫjmVAE&BJ~+sܩVss?MwRRTNEZΓ7FƧ(L N$XSjWrDmbSLడ :2>ldAϝ*yW)gy~doVUEG {6ӻJ72ȳfŸ5'$ydHB?_e^;MPB\2_ |\|QgPؤ#EA/NTc*3/xvޭz$57όXf}aӖ-FB#ѼY3,_Wk]VD85- ΟǘX?]ӈ=y|3u8ur;?6+ARj1H֭{)U\s2ߓ\ N┩ӷzC|\=6m{c'@F'֟E?jٵII_y;e'ѥp'Pf]p-ZvQ9QQzDDDd+g{jKv5li% J˨YUٜ= NNta~Ϲ {o.m倏}Z]Ω-huyX<{;Y(=sD"f5g'YbI/W5Z/꨼3nǥщjJ=sʧE_l,M9;{&aNRe zDD9P(V=&sQgfIjZ0p@a|/~;.*g a9Y غi3,--ؚukquZڵmGG#!&˱y= o߾5bv+9>7ls1s i{G^XJ(  >҈T*޻V`֌6 -ÇVyqwU-֬ygԨo|u5/q]G_.^8s]aKWFUGr=#`欝pt9% 1\_X"""2d!JHMwg'be&7D +okqYs8L|:K^LRZ0""ʂE'Ti #74KiP>o#P\uuA]С}VW]OǏ|ỵ`jj ۂ q:iHNNNسs'FqW]Wz⟫Ws9; Ǐݧ/tyא+vY"I$LQkIVII{ ~9C0yb{</_>,\> bVV7##J.݆nVeT?Cb_8~Z{qw̤kZǠRߝT,!!AA+66VcRDpH^e&Ra9|MHLԜL17--Mܤ$kkRSSMLJԘӺ)))Z&==]\Q)'kXmi Oﺠ6s~x}֝EP:vXDnd(Mk9V`$J󨆺%5DΟԥV. ݗ;4ѿ[ލ"QnhBF쬮dxy~'"zߙ;u8swU6~(*W\uLMMѰA{#㢳?DDDF^ďGw̛37o"**oWTŬ7kcYP*P([Фqc4$D1FI̜#ܐˆѣݧ/M~*׫aqN:/J3VV5g7Ǐowp#e+5gry80>. V@ZZZ|(WRتW 9**11aoXuN tLv}x]?FD8;h̽u2RR2Ii:xz  1xTFP ^}/A]զd2Kc~}:3b(qj8jլ st4X8λO_̚9S#o{j]|~9p{NOǰl ~k-n߹,]Yh1[7L&g}>/{tb }s̛O355maccvm=Y{0lHBN r9>_})&kխnӘd29{V-fbb+И{ilܼY#u&T^]- 5sA-P(Щk]:GkGGOܱ~[m?ߋX,ݯΝ?vԈU}V!fϝ1wԈukBDs;oCшO9Ϟ=S5lP{QDb|u?Јϟ3|uܓOt2 G-[ŔJ%ܺU+h5xAL?^cGXrܫ׮X{f(;6EmϹ_}Xi;CѪ'}lz+kLT=1)ܚ~OU;+1Ii|3_T8!55EkMU6+k,"()kɯw^UUlwȸںSE;zT_d|"ydBsL}mq2t^֨xtOލ%7(DD+^ RE'T9::EѮM16OGa9JP* wwNŤTHb4o ͛5,\|!3 N$cAhݦ]=@p ({˸{  r.\EJJ"V>86+#D"ؖ)BmdxNx{Rc$ؤYc+;\%kZ"4YNvB""޹˻Tj|:e^t)"c:bEͧbú:C {G\ ""٥˗1na<웡Zj֜8q0>u*|Z ֬_vf>Y|y߻\3BXv kk̟7y!J.`,"T@΃{*)) Gh?Ow~}Ea!55˗Dh-Zvk oC$}%BC0`Sy>nݼgB)ɉHJҾ{c欝h:o#_bb&CˏpD&Oh'?4՘7}x~);[ZXhtpdY$Nm11lhr)]<]eM'U1_{֬5PD4ZH֨h#ޮn)S${?>Y澮M$fk9_Re4/v>%{FPrK]\:4yL{)xg G04&>u+4<~TBKrZ\P*URRgD࿲_ W"G"H~yANt[/q6G50iA.Oߩɰ!m몷ʧFSST_"{~8g37Ϳ|42J{U9m.Qi"՟C;P](:  4T*.&g ͧWS袵w>NNN937 -h_O@lL,~9H 1wAٲeu^אD"{{Μ3&$&b+?w TrD' k4jba ߍu2d2aDZpRrP&m1f"-8WExhZq.m=SwKEjjE'o΋Vd~\NLLP>1Q{"T*J333#H$;jSV`o{|ߵ ԅ s]\4~N+MCUDmsTMپ+Tz4O+c:y&Z}f>'"U˗֢S@~-JRM[`ɢE9ηƒ0tpT*g,>p0ǖyD?oqϟcԸؽnݺ8vG,ZϜ'OB`PV5J+|/GKG( >-,>yd4v$o'oDR2.o(rl4MC>ʂ_K>DͧܕJF$$hٞA))ZQ!yWp&>+5`k^!`h~};k ̞ʂ4E%ɪ>OU}6_aXt3 tZNŲ:ʫO+r~$T@5Kt}E@˓QiQ&W 6I'=T2HlNXtBŌZs!5׽5lڄ K~-Ξ󺅥zj8?V] C/~Av 4hd, '(:yyP(D8Y!f ׳Ƶ\a()QIZɏ8f76j[T\mDDDTr+8Diem\ntjr[ȱ|Ӯo5xBmxZHDo&7PTj"SZ|)e?ãd5q1w)z?-!W*t1i ʾ^eqBs.%""G MHy";!A'ʋF ̧W]26h!ǏcƍzR|yضe˖b^0g |vxDDM[ߒ\F,1!&+ l8׮QԃϜ=ڵѤ%#5Xޓ VpsyNDžx6wu8#GDDDE/*!4{svǺ75ܯ]sֶ)'I"ը CxS7oۻfE#zG_'$%FJSphT"0&.1YKMW8>_n'UVmXek!/5%"Ţ*4:A ??~2L絼<=o޺ZDDD`og PlǍ5 nnnx})eFXYev8ذiЍ8j8~(<4b n&2҈-;w+R-៿OūUYsʪmO6rygsH^Z>&.-"b5k6:7}Ov%""*M^sfaTbjW?ny_[gi]7ߩU,.Z:ekwfJs鸢6!9^Ay_^YoݲbQJϏܞfקuXWMDDzc j:yNd2=I^E'¶=DDD8`*V| rbjjW[(J̙7II[0Xݺuqzenr%Ν?څ;w#GA"޳rňW4bvX[pdˋ9LM N$P( tkņ9ԫBm:Acuva~9F?%"#o7ٺ<`t)i2&̻k:6!r'eUlc[ ڊf,M$ʲYcķMLKA""NT!:,:U+OH[4@b'57#qxD8{5j`Ԉ8K|fArj|W  3fkyi<cF¾={QR%!b/Q!7 $U1*۷?~RW\ s퇍+jfS UΛ7/paNj-"ɉBsbnMPV:ZA-PQqe[lz%{%$HFhH$Y)rj. *y{7s;n鵳+9\i~ZjO3E3%""]J5uXtBŐ5*W,C^tbnn cClc@DDPfMaq & ǎG6m0{,a,0idҰA;ru T*<s#fGob?zsYܺyY-&ZjtJRa9|ZܹR ̙eSn6ouk ;e:i|?L EvC2:sAXX}s/Z.CbCoCfݞȐbe& JB_}XIR͛o9ǭg}Mg]Ν;KSS=[qJp;"*Bio376QfrJ8dٰS,L{N,j_.BD_,:RMH-oN3sʛnA.ѥcĉ8!!;v b/` W0jDfĤD5OinQX[cͷlRH8}YH.9>_HJ ݍ 'jZ9n'Rs<~ZS5̝vvyoˣpYu?mV?ZWG#8Ay6|#559y~7jʕkyq+P13/ӱ}O#"""ʯ|u+#XG[ꄊ'w77\xJQ4_^M $O""z4C\_u^j\2&+2n\FĒ _5vh$$$`cb0b(سʕ39 K.]PNL> >$%%a,s*ΞVCTT>`Ũ[\]kc89U=RK( $$DeC~ךzʕ='x[7/q3Ssl8UWcPA7`΅8:ffT$_đk CE(UJlT^<@Pп>D&m`jy8sj.?1T$c؈ejj#ZbmZG">4AJ55MJ'A ÿg!-r&z%8lK^qArW4ܡa5_qIfiG )Y;kS?8uǻ~#<:}E퇡;q+ADPT`#5 MHM׫[L.S:(U*[ߌX^-]e=\!^K@_o=xKsgTB6>_6u?3H^3MCH;]EXX=;wֶx_/Y< 3p)w?Zn@TxdtܾnCVĜ \Jextb~YL$1qR2KJ; ǖ4o6=mu:J% JHiMman  R]jl;x%x>9HMM^7vq8t5$b2Oh㯷?vnk2yEBD;²6gqטG;c"?l~25GJ$bH!W*J;R%eY""nCFP1u{ ⺹9׫'u^(;w7wt,P3 8HE ,^o߾]-bT+8^0ݽWvA$Pk-8%7`:uRs{bI{jDD<*i'V:7!J4Yոz 2 [yH$IP:'׉ON,AfX"ڟWN L,^'15SqԘNӂλx֘k"k'T$+&ɪ'LMWT̥De)5I-ȹg,:RNprr0 k=&unބ\^lQ)0qelàR:αB̜6]b9fjjuWNBSOB09 [qQx4l(ӱb/MX#fG ֬UkΡדQn3?33)Ŵߣ\9ݺVe:aSh<%YG:45`YGD_R/ \e+b#  h }o,Zr C/DDDDyi`yEKqAtl-x֘s~~yU*"?8m6fy5U-nr2;YM s R̞q ܺc]εO˫&wȥVsIt4 jXՃZ-]OD>޹˻Tjš' 5j񟍘QΆ ok׮yoƇT~BDDVaϾx-e|;qd\xQ/Zݿ`E`x٣̝gs6B۷cmP*B+gmoAw̜= *UF#N,dt<}xHMMBzz*LLL!Z.R..sJGdQVe+0&X&>. I66/&5nB\[d(S,ʔ)JkppvLTTyGB/beUDpnddn\FxDBjj2ʔ)NJUUv{h^ÇwdiJ ZS58;@ P^7))IF̤`܍% -Z`úNųfEm]Jtjh6.T6](fILWZcg[ʚk^GZ&҅[w+ "L"1 ?q1P$kɟYtBS֛w+U¹VjZ&Oo6HDDD@笎_tF\\Ƶ ZpQHy7Su QQQ |> 7% ȷBl7fQ]ٳއD,ƠA0~Xr4脈E'DDĢ"""*.p{*4krss~~xגu6+7""lmm!8uTuW:YsuWJ}V ۷c};GQhެ=?,V(aN <a/_r4Qb n+jg):QT_<=nބBNDDDүo_8;enA HMm>]:!o޺4?Ze&HR!r*gqLq-7a055wE^=sF̎g,:R-{͉JN'T|ըQfff8$4Tz6CDDDDDDDDDPƢ*i܄<|LzM2 y Ri-Ƈ~ϟ?ӦLE*U[q/AsCb@8&6ߌ(tGV+}1qd$$$1;"""""""""zJ5#A_Ynd2lYt`#""ɴɓ!g|dذicJXd)$;^PgLDDıBx#_x333,_DҥT*1g\$%%rhupttĶ͛QL!snڳPW@oڼ )))>^"`ْ(`> +pmB^PW0s {Уwo9{ֈQIǢ*ݸ@NN!o%RDDD9155ŸcHٷ@kTV 'LT[c ]zaz;J‚ qv΢"CUxbR"̄* """"""""""zE'TYtB%H$k;v:/OOD`M""tsԭ[Wk' F}ѲE a|;`9f׼Y3,]bq$R3g[v΢Tvm=#z?yzLQaʾXtB%Dmw70LI#@.Qvm%""ʉH$´S0!dl~;f),xKФqc+WPܩtr@jZF=;w-?KKK,;?l"!!&LD}5?GSiQ)sc@DDDDDD#Pb9;PIIXXacmz[ܽ ǀΓ(7^ו+A^51}T̙?bw %gۧ^~v%lؿw*9;yg:^z6c -- +V,D2eeןןǍQp{zJ w̢J뽦g-vP*^(/&OD"( lؼk|vm ?8a4a"0~#x⬒3ڍ#G [ .^=p+D"⋯{G,:R/kXuB%C 055ơbǫIfIBB<п(/...֥0>nݾUuϝ aQH<ǍCrrr`̨QضyږE^o`Ӗ-,T́o>_狈:TD"a[nC%)\\\b4i&&&~pws{]"";goWƁ}+8cy?i" 1)sۿ/:!|9~ c033+CqQ̙^(Jl޺~]*9Bh'Ncuj6v DDDDDDDPN$qwsN ujc@~zKDD c@~ؾcݻt2ڶiSuڶiΝ:ٳoÇݧs~GjnM6bА! ;{._-MIWlYlۼĪ5BU??tK/FOZ9K """"""""*JRd}E'T ??x@/-vd|""*"C|e oYQbEazZ{M&E'qqqxk凕*<}~>^ulllxB3^ZZ|f6Hqfn*/۶GlB=ԯW~g#--`æMwpnR>3qڵB?[-~ytw5RfDDDDDDDDDdL,:ROgPI.bO̢8<| H$ qJJ 6o٪Z0~6mݢwѶM%e2&M"91g _Bex8M[=â*t:Nqwlcofƍ'kDƍi?G:5~X֪%w }S̗{#qbR"FϞ]8~(y4b nQ#[#fGDDDDDDDDDEE'TocDt `-v^0/sDDDYM4@47|:fffXd)LMMJErrr͸1cݧ0ѣJ}ᅓ܉#GAgs#""""""""¢*ԊN*Y*Uajuzz ?>ժ/Ɨ._ :U# aaaXn9Yj6r,cH$3j~ؾʗ1zB.1C"""""""""*l,:RO NdDpsb'aN<?꼥>Ə +++af:? : Ƈ;]-7b<V$9SS1!R8aaaF̎ NE'Teb'$Duq&digu ݻ.贖D"%K!57o7Hy155իQGm ;?L> Hr0&{{lڰ3:2~Oꅳf숈J,NXtB%[faaHJJ{Mkkg&. r 5A&V1axa,;ƶ-[QZ5!v?x"D"{{}ROLJĴ3{6RSS! *tU'˃HGnnJ}uZ7.Sukth`9[7mF6p1u(qcIVN;#/]SgN O^P VkKW^;Nc˕Gƍ@x.S㏄yۈPɒ sfF޽^?Ę/?G5^J%?3gacmz/UHLJ;qg-[`98d>3Mǀ~,ĩSXl)9&MFLw/\ٳZh ; ""*B]UDbTYc^JDfffp^]5ȺM4Dπ?!""#?n0Ůݻt^3ME ʱ\kwk\\-N:Uy[.]paβ_ZZVńIgR_|ٻ(/ߙ;Di0VAv5X׵[w׮ ][[PDna^f`dy|AaB!5tB=J:!偧G5!!!jYy{S !i/-޳qqq^[.hڸl|J=K\t֜ٸw~CӜq`>ӗڍڳ<}ӕ|?X!B!HK [}LI'{qxx8b 7oJ7!_O~Ja&̝3͟;vArr2`E񁭭N\͚a޿s1} HRD"0۷lWZvMɓQn]̘= X s Æ1}/ܼPF=MReÚ>!B!%r*@I.pqv)>>ؽw 9%s [ IDAT#Բ.!R5 -~W]:} kֳ31n@Ff&f̞mje5rss1zݵNr-~͛5Ù'1etX,ƆM1,Zk++ R5n}A)>} B!B!ew!CNwS e]:uwRB!5~8hi}ɍK$XjUk/uG8t߸6d/aC4KKKlްS&M]@@`v[wnktB!B!UP )N4xBJ 666qhzN.Q !rRݻuoݹh3g2]r"?|(њ1鯿dϟ?cHKK+hE}wn))5f -YPB!B!BAI'ܣ:oFMN/-v  B!7r!H1;W077g΀ksШaCYw>j$rrrJ,eE͟~±#GѦUkYL*b߁;?>DEitB!B!P )8R>Tku}%$''j[B) ss1w8$4._.њ G.]dgϟc箝%Z8zJxyyb/^_&A,yc##/[@OOO~{4x:B!B!BHa(鄔{rNy%$''#!1A-ԩ.7ￃjC! @FKUkVC h)Llnhk,ݺ} g;v#M”i0utdggktB!B!E(鄔{|Y'? Ŏ) B!e.F.G%ZS__ ɖBL >_u 6m,v9\R8ק/#~Y oBWB!B!RrtB?J:!Dʕadh$ŎO^G}B!Lܹ3\]\d[6#--Dkz{y_~wiY\666ش~LMMe;wb]9OY'c ##ѧ?ݿB!B!RFP )XN4tBJ="Ih%$''#22RmkB!r1ax8==w,ǎlmk7/U==1tǏXfM-`y DShKY0jlݴVd$ 1,H$ !B!BqQ )؅N(|<=N$ ߾U~>m]B!jT6Zgϝ7oJCQz w_s3ڷk&ƹ|>FP,W.N=ƍbRGStOG!B!BȏNH%xud'$&}d&BJjq%r՚%^ayٳ^ⵋO4plG!:&Fcg*K,,,qzL4ڲ/ѭGw\|I#Dde^HOKP({)kfsO>!B)|wZ϶k/4}&B!4}B9J:!刮.;@hh˅D"QmB!%aogݻc{hP~uvvƘѣ9>K/ÂJ|8~RSpIٙBc*+8^^{dDEEI}fϜ === }m3D{D3skX[.5 *1* /^AxS||J%ꣲ\ݼժ+>%4X,OB!DX(ҍBJ:!҉AxzzʒNY.. Gj[B)GٳJ$Wu[8u45i-Zp0glgdk(=;mFUT^GqY̹~˗.-D}]:aI)HMGXܼq`ffйhX[W.r۷OsHJ-t.6.];;W0޵ !B!B( {;ۨ y{> X")dj|}|em]B!DLLLgBCCqr1<bsCRRR..%NڲثW=n,FDӌ tb,wݷ2Qg`AH&捣UxվwNcmq"N~% uVB!B!R8J:!^b^|<=Nrss}H5M!À~akk+Z|~׵?SR0g[zXv<3g/:v耣Sxk:)b hkٹkM:~vf#8{?+S wڰsS8Cذ/F+B!B!^{:tBsP899e:uȾOXZ&BAWWٳ?ƁP{nMܾspM=ڵ/eldM7߀\t 1mU999޽Xj< {>s5ƲŋS~^~GV⮮бxy7kAWxiū"d`` ڡf&S  ":-sGjӿX{B!B!Ũ )(鄔7氶CCCպlZB){:%anٶjYs`jj*/XP'k++lۼÇe6 lɓf*cLl  7n*1Ŵ{\Ruy OׯU '`hh0dlڀj)FǦ0dBԭ׆phب-= b@VU!B!BQ'J:!_P W; S_ >~(@kB!r1nX8##Cm VV1uZڙ9gq:bk֭ű5xqQԩ][ذi#  1* "0b޵OI$p<ԭ@: kmm ǒѸIg)F]7woF<++ O_W鼄B!B!ptB=v 5}椓:>!*JB!иQ#ԯW)ZnhӪlC>zT-kDձnRoyrOV6UX;##tMF۬X߆x]$ר~-r"<zĊ?{kB!B!ii|kNH9!t$FÑ*jYBQ&nzB"@(bXhZ֞9}:pjV0bk{p;scϫ,DyðrfY|9 vnb/':lH]wII|KXclnT.x@jյW~_E[}ꛜcJ$Rm=^vJ-'׃[ 1QVB)!J:!^jϚ.N:xzx2!hؠZֶ073޾{ B.]Բ6!Nh8w<ŋ_T^ka6rR)rss1mtٵQ5Cڶit[0  1~DڱU==GaƬ-_~/w`?>勗l s8\[hE+;FIFzJ!W BW. ]\[['m05xIRׯ‰된W<*/pj;Zy1yv~]gJ ~vFnc`llB!Zz*ҳ}S2rEt }D_kE[F>rQzP$)!1X|Qd]ZqOF7v.>$% +/Bv6c_T0zazE=Fwe ܀w&8"{ Ns18g2UكBHjC=v{2|8T 8$$D  TڄB:=nf ݰAtI6~9vޭKW>tlÇ! l373úk0g,ޫ,y2R E$CYNwo_`ػ{A '[7O"&&BضeF '!˖ s MQFvv, 'EKva쨦sT&B)HHԸw'g)*+l~#M[z*Ы>&QXW|W6yxÕ֪w'$6<QPW#B?kl+pG '_Ӱ^\7%ݟB~TtB=J:!˅l}N>?u}B!D]*UB^e ܾsGmO<+WmX0_cF}iUrJ )k D8wUiS1uthe-+vi D5|~+qò/_ü !Xap̞޾Pzt,7!o'²"._ڃ{,--sg'7~ӂdbúpbO!R^ώOx\n/Vp .wd.p>+y޺}8*߽{ng~2r3ux G$Ƥ|?eҳ6v:5Gr}N$ߑ[+#:˟tcnx9/uGxÍB)K O!-- l?6hPV p|>H$L1v |c'MBbR"._#=;vXç+\]\pA\ Ϝ;|V;YXѱjY'RΣ! j6i sV,\kѾԮ󳬭Ljj̩͈KHŃ"LLy۶@Ļ9:w Fn\?׏@*HXb4"#_3Fh`oNp8s:!.]܍nJR۳66Z3B!DTw[3oV )*!|LW''#j}z:y2V.g$}wss=&Ecɢ?pYY:bb`ĴuP `LDN_Z¢%gѴYWY YE>X>-פ%bEpcĜkUm7p.51dBL::zJ R왭x:e+.kTY;>k7ǟsXo4 )*B!xC,;=z᱀:9?MןG\#=c6Ɏ~.1 '`f-Ytef9ƵhY-3D$edkobZ׊G.L6z7&@˚ ۆ:uTA憺O+NuslQ{quRF|Pޱnׄq9q/Lﲰ")MTS|mPfU>fzׄphOP|KqN>S{BRqW£I9!X"A۷j]OΣBfB!׿o_k׭SkBq"oݾ/^,ңV,'OXT|֘V-[UKXt NB1p8\0%On TӦtľ= y|x~FajZAC'*ؓ7kCZ3 kQ^5iL &&^WVc9©133+L*T*m{ XFF !BhxZazȃe{DygvWEQ%fԔr^TUy2wis唙7 ~K6_$`|?6hˢugjGc3[JA׉%RN1=^\ܿznk D=5 MՃOi^)x\tv\+Eb':,򣢤RqX9'e9!%7xHU #tg|FH\[%'CͫVy!n۶CjyUx؎$_jU 4H6~UWm07 QB^%ǎa^Sx<1[6nb| 0hXq#Oym ¤)aa\@FF `Ϯ5-E_X XtJG#F-7ݻ8Ӓ}FY03Vz nkň<0>clddTͯUeΰ IDATѨx !B &x"d BcRzMOw|7Z=-{Oﺺˑ!3sO˷)ʸv|Jl.Hf?~XW^ +ˑ8ۜRvW?ˏࡲۙkU>"-gJB!+ DF$ǥf5iʈMWO4vpgC )RtMY(w^ؠ̜c=x^SuVkD{!&fVU0jq־?0?%e󅌖?nU~ZռWQ5 O!_7dfe!;[Jk ԩ;v2J'^2.^B"0J—/޿xHN!}>h԰!޻8t0* _SâѭWO|H$L>Z()w77Y F/UںO},_H 7o Hj}R^ikMہhv >F勻~'HOO.ZT۷N0̘rtV%_oZWGGNÊ { |qTwdbPű*B(;‡7 =꨼>3͟DC!5IoZ*H V ID@XzcM_Av+? U4zuf] m]떗u&ϧUz%jC/Oϼ999QHOj]B0'aD"YV;;;cQϟtrQR>>_ <ޗSMýJW6q8v,PXʵh~[aægVt2 LΉxǩ3Pe#^˫ MX#>(7޵X566Q۶%'DzbU<,Z*kB!D=ƶ~=Y<.G2u"$.5؉cw^?xM_ddѭkq3q!X}d^yGŦSVcc%06&gXd*aut\jf˸.G fM!D1tBJÇhRΪKI'|644U0[u~>;#aog !o :tӧ^Ag}奶=wn#N:M/-ԶGI5o 3Mǜys|I;aАOOg<сsHyХ{7Λ޵aaQ7խ{nHJN=v 'U7c >{s @.|U 7E"%3n+v҉X,8:#Z llf2 Te3R`gWa ]\tuw>lH$bpei5B$Up0&,p|cH(d_:ttr}ˈy{ycnv"Ɏ];qFLGGOXsݸEK⧎+#[ 65wD Ӧ[jwyyya=6m%~Ux.^̊e Pq#܂_PfMػ5wEǧ珟?q-d=WӿkEN1HZuj 3NcŻPF7sl8uxxjC ߉#G~{jh߮#&ѨYSܮYYZ5lۼ5w8{#rqm'O`000V׮3cnhh(NZc vhϚ۾m;59z4޽gUt+YsW^KW.3b8r kWmvSX2W~sF-.I9fޘ٭=c۰v#ڡEbi\jVWBbczQu! q9}~fAGlrDRFN݂InF$7l2oj[R]i0BPGWD UzĬ'|֓Jsc=vf\2rZ<ƓeDBم$J:!F `ҥ]]]4i^jJp1;NHyၻO: -b|}|eI'l'B4P?4oLm{ 0w|_3o.֬\=aСHKOÞ_xJIMðwKuX<(&Ŝ=ɄjJ$blX7^bĝk`]*)J"kkuttYs |]rs67WE"C,0׈AN{;;hWY-_rM? bŽk)եSg$&'1bl+) ~]{n)+fiipn{vFG f[")<=}Qaywb| Hl8ea=04~MoQt%q浊 Zde=MfFAɀ-vWMK₉:9Gހ Ա#2GA)lHʕ1g,x<#ۻgOS6D X V,[\\wl@@ܼ9~n\.. +W(p!%K;r[jtXw77pu딞;qx;k;^ܹ[D|y|;v*=wڔ) )ҵstE?ը/r ǏQzsdcH$k_NжM8>9qY,YYoPses#V#5 k7wn3![(E%f-=hnfPqF HapVUo6TJIΪ+pERTO-<?|T)fB_@$)vI=XʸVWhknz"|?F9|XugKbS9hkإ !(DI'ܻw1nִ)V6J'v;BJ|IHNNVkY__8((UB)0tP,Y半8q;`ѩk}yv]|=gRr,Yw1zo }߆̤HOO*`6T*MSq㌸[$M޸X,BB*qQ0rU+.5266Wy B!,҂uttU!hkkc̨Ѳqrr2۫}ڷk(~;~+4COOV,v-L9%ɐ)5-35*:Tf5fkJv.1{LL]oݝVqu /Vg@K oqojZ6'D}A(F[u!R4UNtxLuq~~fnϞmm\xܾmjzd=\ETákT 5(NF9 V]a &=㒳%edk+[W_|I.x2"**{3A5Eb BaRj8r*[ )\.\CþAI;ruBB!Dc~m^߱ko|3PBxe* 073[`kk+=+׬ȏ;1ÁuBJعc^ψWu`DJYe_ f֌UZC$Mf,, ڰop^ xab;U3@͚ ))V5];s8ֺB)g㍇n_X ɵ2ѿ_vލ|f2wg~p%2s:W}zq92aqTY#2.M?*!ч@7j50Ew+_tJOI]U9#ˑV0gKj$U8'Qg_A!?2J:!ںI%G^oPϗ1 z=!o`¸qvv66m٬}ٲqNN͜ D!oi^k;v`מ<)=O+:;HFɩzI#RwÕK E665mJ|.E22RƟԾC'xpk\8Vm8?dܰ'7!VYN܀(hպc,o"1ׯ2Nj\T> !B $m7g X-J t?V4?ңWgwxuv<9Ng- bS $R)maovS?{nv*h~qٙX\%eԝwOA7i"L>VǥoY+XOD?m74fۍꗟȏ%#T5VIY>fcjxI $UB!?*J:!ܝII5+v&xxt\>٪`*r- M!=>uic}5mN;O=Ş{Ծ:` 6}WS4x*R}%aڔxpN=  CfV& JagtB?ODwoߢzj" (PkB!៉q]bb^WP>S'OF@@ݚuаACnԸ?e0f8bHR̙7hҸGʘw/zn_QNs.RD"Fry>o_ Z\mpn+^˫ = nuXJ̬0`tl<]JǼ9}ot4kޕR8zxD"=C-^ݝkCa8ub,3zAvߠ=*Ur R7ʪhkǷ%?c2t&99yYH U_4n^TڟB!p"Jv0Tq IDAT+3#mQWRzo>%Zϊ憷87w`a5)S2*=/'ou}۝/>%fKnI&7y\ ݿw[ʼq]ڥҢ=L~HȄ_c|fݥgObseQNX\ŃИZoSfr-ħgCqp˚V{Q*j?Ĺibego۱iNkf"|ܹىm'"CI'ԴlK/Grr2D"Ν^=z}a Q{#pw˅߄=N| `D!uNNNܱkׯӧ} 0\9tR)͘C[[JYMp|L> R"kCʇ ܼqDV066.\ӧrabjqׂ+ew W/[WN_z:YYؼq2wSXZVT*-dfikԞ=zN@bB4ɫ.JpYܻ{8]Oxa_Y8`X/H$)+cn J3@jJ<^z߁sRB!y6vvz[tLY4E"$gIlqqPO;H/PO;P[;C dB\/D¸Vc  ;G>jZI9~_c"3jcfh(k'HYU+[2{zmwssI}Jh)1Go^$z;/zr9Y!ǎDܷq)=AN6ZƧe ĬuBe2BHJ:!FOWƍ_oڼ-~*T9(鄔C0{_]8q~kߡلBH4j(x99_nrZc%*T]?? [1zH.۵C|BW~cQؽc'1qPGB'VBa\1/{4`̸000kKMG\S/ry9z9LL-qnYHatu1x|4n,c|X}6 ZZXfB,.Vݣ6&M٦~BQΈVwL"d<3rqSiJYKq9k兩qY6>|:*1]KH氲{Ml7uF%fErϙq> txY]'ogl!/^T/>5I|jXmjЉBXEO!D}t.NHL1mQ'$$D[[YA6 z=!o kK\q5qx89:[mW^0h@@8#3#F "?=cƬ}h٪/,,*{KK[0 K/P‰\.C-aeeun\.{6}+hsd- n[;)]4D񴰏SZE~ҬآNqRZ~OW㤴<'^x,B.ObϚI G{binH+l[خp{k˅}Br&""z=tBF7k 88c͸v:>C Ƈ] N L>8p "2Zra{˗}a݈|lZ&&ΛO>jNؕ1c=ša68::J<IE.WFƨQ101wqF0nݼGQxsIqz155ʕA UQ;O5^UjKyUAAzk |g ,jq.B~=IqQEpttCP^Kԩ 5ռkw!!!YY055GٲQbG=~W;g ~%Jutf ˲,LMYrfr׆a P%./F)札Vdx8Fڴ-ޖ{Y*co,sHCp_Hs7c&gݟ$f yuows:=PTd.];dQQQoB}1(077G5 ;[;EO]omA8}Pg/xy *N:!Ç ?Dr ?~Ǥ)SCpw/p%QO?!h<:y z)Je+ >qEe_yvQ6o+G{:S&C=c{c j078YYssj 篷ɤ)[PN7j ٙ}UR<&,&ceREDDFB@ir7!Ln!<demx8(ab{A{h~лtSLތBav zGtBFs/:7mz׳а~dGIyT~~NjGDH*{aB#,\H^UQs,jҒVgNUzr4""""z=LL5I*6}Ii&̻ޢF ;888QÆ.?tN$gNg}{ш(6~X3t:degc0stQz/N:AVN3gglX=>?3\]]1OGDo"###5G6En(_߽{7W.U+DDDDCo ]U lPmי)9;X%!0tBFSvmlX*tĤ$8G@:4, udDDDRV-j;سg>7xy\.san=2{Yط{7 kC*_u [[G#=- qO FD]-!ss+  B#Vk(y{?Y=GkpGU,DJP&eKΨ& yn Ue|C- x2DAW@ x! $,""z5'NZF˰rrQzyzzQ1g\O0c,,;QJ5rr 6999tf7E6m 6bczcǯEٲ# """"dd*dd*|cǏ\ph>M4CEg( G9sh8yB$ Bkk"?N.Wi.wU |T1QeE}L&S/coS8 x2' PQū ^ w1`w8ҋ?tKcG5L&73g჏"%%0klԫSgH۷Grr2 dggc؈زiI<ƍ`ܾu11w4޵T&Uo ͽ4CQ׾Nǁ^}\Y.[uڶgNc޽3G^:!!ӧO% P*8!""""S%ODNJN+:aJ8?FQQ |~~{h(C'DDÇyNQ{N: NNNB=|=a^h0d0RSS%*d:aJ6__.J@w(}GUK}i}LL6 V˱`|4nHXĈѣEiN+ C'TYYYPGDD' @ 1)r1Bq&Q{l]:w /`4SSS|x1U*` oEp C'7?zX6c?~* |}#N'(^Vy[BB!&&FԞwwwn2ܼuKԞbcmuk֢b ڱƜ """"""""""c`Zv{LiB" G ҃H _-<ƪ5kDY=srr0yjQ֭^2ek)I*Nt`J~C'iix(}s=y"J"""cYڶi#Կn{3 4={ 7~Q{'֯]R)^{K """""""""cJ<N9RO눝zu0QIa1055hZ,[\|wL͚upU7V,] sssam8xSX:N'LP) {{'ʺPQI=uS3gϊA@!UM`ԩ!bP(r;_OOx2"""""""""24N譵ssm \/s ~~w;k3tBDD%̐KCՊڳNE_UDih-[SZRa̸vS1tBoewsqv.x!w:R*; x:sEEDDdlz?p@ÇPo6eݺaİaBACݻ EDDDDDDDDDe"Db ߨzɰ3x}NPoI]; Xrڵm 333zb T*Z-N=;wZ6x $''c?@lߺ nnnOg|H1z""""""bJtB^ ާ\rpwwGLL 4""*Y,1t`L9#'|yQb!Xb9ÇXd1fN.j_C0n<bcc1xPlۼO·cRADDDDDDDD$ C% C' Bdd^+\#"EP;!oDDDA]P[ɢ߯խ+;wSDkH2 ̜& k7oaC)doN&7x3ލ8bJsQ/dbb-EڵK/c h4NI3oV:oDDDDDDD ס/2 Pikׯ :t ûډ֏H 4k smߎ{SԾʕ#1w|O0g\,} +g_;w'Ni0/(UŊK=b+Vz"""""""C'T{*M|}}nCR}ʗ/777BB:!"iرjPTXf {ɓiкU+o }}>GLL ?+ƌ%t oo """"""""*xx?1 ~~}JQE/ |A?)*&&Lٳ6;(O>bհ6lڈ-۶J8 P'CN$H>z+1 ~έ۷ Z/""")9 fffVEK &/III>kQzZ//]ڢ%Kw> """""""""bZfWV^];x*Mlm!"N:aa"""GٲgO ]m6B} ٷ( V͚X` 3gNI<C':vo:|XR:N{ w:P<\]\:$GQ5d a}Z(O'''Qz;AsvZ1c…$ *eN:RG.߁G섆2tBDD%-PGFF?0JoG̜6]3220yT^ s0fhƐ)TDDDDDDDDDT Pɗ0tBKޝNRSS#Z@硓n!!!A^DDDRwo ˑeޭZ{: [ _틾}T 6bI7C'T?^J?__:\#vtpyzI#qqF?u w˖Fohcnj]>qq?p CDDDDDDDDDC'Zx 6^6aɐofNqwwPG֫RŊpqv0z{ժV6"))(663!dIS&CVd2̚9mZEGcȐp2"""""""""zNF ݪW^;:RG)jڋHjrGT۰h5lݺ 7a&74\oGu+WbQɑp2"""""""""zN+xC'T9bG̝N@37oD>MDD$&qFB\) IDATӎ;ʗkڵkFohXraijNFDDDDDDDDD1tB%w:!|i#+yD!tN/"##nEfEʗ/5+Wo,]ֵ$3ݺ}G7T(_;tz """"""" P) Cu$HB&&&\7 B'HJJ=Oz¦-[!8q$i(0o|ܻ7T*Z-L=;w(3FXl9t:|3ڢm6F'** 7r"Nƍ:!"""""bPS'TJ #EU? @v--YFc~~fρ\+Fɓ&L:oƛoDDDDDDD C'T<]P+ܿyT*h*U''' ;DDT:(J K¾~5 jwĩ1 bؾ=&=I1la'7)H3oVnDDDDDDDסFEppP*^5v:_/ODRΝ;L&C>a脈J޽>_~+WB`iii s[ΆN3oeqq 4 2?l݆ K2S-иI'IzQ鐐;~\$DDDDDDD/ ղ@M/:DrC'2L;p#"B <DތDRRqDDD%)sw{[? 854J+bј[ay~sm> ص{7 !![L2FlJh=% Quē!DA$T*Q]#""DW?0@jqQ':vDjՄzM7 {BBFA 2 ӧNCmcHMMp2""""""""҇* f~~~HqC'+UP""*=d2Ə+X{ 1?(JRX4O>5bPX0o>5l(EFFb1ɑp2""""""""҅*Nxf>pw:dPNt DM;q/:ڨ3b¸qB1 b155%KP5O68$&NFp2""""""""҃* nt ^~C'III_#v#""j?""cڥVt2ѦuqoFC 66~:TPAX1 p*""""""""҃* tN{ n'}VEGDDTx{ #Gp1c48:: oQ#!G]eʔ~ٵ֬p*""""""""ҁ*x;lmm:<"\~^+#v1|8,,,zFNӦ ujZN^b+W׬RV]m.TDDDDDDDDD%Pɱ{\zը=*k!Di?L_!!N'2 8| 4""*}\]\YO~˗qѺU+ѺU+t Ə;~B^u`ҥ4t( -soL ƟK=FaJ;?__N ?@#55USDDD/Ğ}{nRӼ9LL+)Sq,]ƍRŊFC,X4 Z-<J%4n,xDDDDDDDDD%ס`愡*|}|<@Zz/Qqdmm w{ϡT*1{,!ZZĴSZRa̸vSL PNt:DFw*ptt0QW իn97jn}$׮_Ǧ-[>wC uzz: ;wJ7Q xB'`J*^^055pQd2׫'!#""*LLL0rNHHm$e('jȐA ubR(-DDDDDDDDDDoθS`WGgff&Zk Q^\2""" G7n 55JRDDDͻmuŋ-۶Gnp.l9,--1wljL;`nnnY4~8xyaUrdff.^ ;[;|ХN|| 'OAjjbgaa*uP^KowJ}Jп|/S~2 ժ7D_ P* TUjב+h԰P{{{;>~qb2 c!!$""*}vޅO/-[gTFao1wNg[Zx=:3'''4kd|v÷,qYYz4^9ú ~e8fNõgpֱxS0izkSmky&"""""zwOMެSeAmr&"2(o̜6]oMVD,ͱa |}IIIxWQ{7n -= 66$""*ά0x ̙xvڅOzdz@Hhn8GwZH~difƤ)SV1zWذn֩+x?-=8/$܏Čov@ћj5{Q$pTj:#[r"Ҁ2(333tM1̜0tBtWxD術}F .Oݺ?!** fZ~gIrAgknHK%9_>:wzqdR@VVm7ëݑ_8qppEw>DZMYve ɑD܏ĝ+r_DAռިV|d!!1"p/ 11wrȥHlC'D7#D{{{ 'QqP(0jpNHL-[$ǣlY7N0s7#/ꤤ$ 4bI8Uѥ$cǏ w|8OzO@a,ssK)Su@n#0c,}9 U:ŷ Ģ_oФigփ{%WDj Aסn_}TnߺG~DDDDDDDDdt P'C w:!y~ND\zuoW"zO""Amtٲu+bcc%[׮xYs>폒{‡]>qq?p $hN[N}Leڵ ;׾zkk;t9+לBPb>FP[Q |w:aHp ~εבnDDD݄qㄝfӬ3v(;obbb$H<2 3OGf̈́{:b8222$BՖWd2{ucǯGFҲAu^UjCtah""""""""2  [u:!>Ȁ=.^D&MDIDD6U&ZjݷUv̉8qƬ30j@jZΘ /$011w`8ի9f4֬\SSS'|oU5('BϏdhѲ;nߺ~$ʗ}ޘZBRbcѪ W E?%9G#++J=ʔR`9SdfAV6J{89C.|)'' IIǑ4[XBtK7we22R'+ އm-=X8hu?B%)Sm,"Yrs1/V';S\REr@01ht{kKӬJ.v V6'2Mp#>5:-CeicefkZӊnv% "Ct4;SLhcު#1~ n8ߌI(cjbPFοRBk^DDE x^dHwVHԩSGԞ>>EJJ! 1FPhn2^ByڴjǁCgϝÎ_~A=%ILXr니6Μ=)ӧa~\sPF$5;2MS4*<')鉨=n=F uXQ< ׯF#5tHzz2߂NCl=drxANаQ47qI\vo_FRb _7x͚SS~Xl2@n&[/O?T#.> W/۷/A+VCѠaT\PEӓqV:?([27NO;r}ۘ>R.jW|ab!-=x:9=F{D"MӼG3u^B][;͂gᆟ /ԍӛ5ZeVvVZmkGk:'[^rzvM]9S>wx8(:Xm'7z\;>5zVCCtL٭֡ޭ]6,#KUҲT~VlRw{z6Zħlu܇m;YL uf𘦧c0LMp[6u7&w.r\VlaVk\c]c9w3fo{cؤ ؤw%ef/ϗJ/tLR2=x6nǼ_-$}oSR2rV>-ݱ]Lްʃ0z2(dRpV(Rr|#rͣ:nzݟilbz@Fꅿfd*gd*O2xi$C\wK~h_u,+GSԲv8z^m֫9r%gd4yhm%]kHCm6OEADd(cZDu^ +U _zFKDD6:d(l~ђj-WTbάYꬬ,L6 g 6|=vM$rllCR_IkF#==I^)ܿ)},Z0Ν=U+zBNKHłp`xCucɋ<}ȏ9wI^O43DE]-r/""ctk"}>Q?=scrVo _P Ү vޓ/ #|I~laf:Ur4n[oB4:>530t:iģO:37>5CN#c:7TCbzSUt:(.ߋ򃽊:!p*d`U|y3p :h4t7jlDDDŝ9V^ cԸQc|صgKزe OV|yY}GFFУ{w'{*޵)R=A zL&WZBc655CW>lm½{7p~?pbff֬9sճta,''wo/[X#5%.µgZ96 |?TRVVJ*&NUFB|lSm[P/j|so+k[n:J'}QN}LNNn/ ͧ?^.Wj jngg(@R܉yȽױmKܣ{\P^Kx󆕕-23SqE՛+++kWo+N4DDD%x2&hיg*.)y\RzvYGU j[ʤYyoS\3Qofkev2򱓍EYzj"!5aBZŧ>iٵ?qcTl 0hhcn? IDATgP=Ӛff}\؝'v8ꐼb Zr,Uusa|ߣw:g5A; ?壠l'8*-8YvVZ=0O35S2s?OOȩ1>2x./={L$5z3,֫rwxzt\Ee䁇LY'({+d,q)?S Z5d5 ɲWUi\JfOS; WnZpo/ћ`J;H4Q1{͛h4P(F$YpqJgNgsܥ5<_~ڣbN?׺̢$"zS<^J<Cj>lܻwO  uph=&2pP?x;~E‰KKK̝= y999zT*I[ ltPwZ|rϝ=;aVXn NRa\! L>dz@k|=y '`kq \q֡CǾ'oO>v?:w qK| WNhݦ&M SSჩx!BCu,譵llym*Ub⤢qRe'mBN^k;&M[[GI]""")S̞X)^QYde09:T!OQQ/Dyl.V]ABZ;b۟(pT%pL&;qozy[mKFu{5v#6 m34*ϲ ?zD0'߉MHowOYYUl=9LA^,-ܿG1/=N(/ =EDDD$OLlUG~9լ3h#u^f}SY*ގ.Vybཀ z>l=o4j˰wW.@A*λ01ˮA̯l˯sZ]{abch}ecֺfE>NJ+iTZ]aL o[ccZә ]([0%zv:C'DyUؾ?<2;toЉZƅѸQ#-r9FFRRRqf|5js9 gΜ[Gb߸M4Eu%KlzǏ~oJk`7;tp=~IIOp>·XY)Ѩq'i *UؘXtޟ9 LtEL^kۻFo ,MLLQv39vεӲ~< v3: ZPd2 <ȁ;~Q7/j*Gbj"LWt:Zq]_7o*Uh4زukojժQÆw݃DຸsAN[zkr}|Qkׯٳֻv {s8 D 4Z-S*UPN>r@p Z,pmHh?; HX" [k[WkuVֶֺZkUj{EMPB z &@øו:@ 9O״T&sϘpUW;tw774=vlnXX֩c2f0}7:|Y&chۦܸqHLwoR +RŹɸf-ZŴ13+ qq]7n _1ш#G?_vm4jlgҒ/\/WxOhl㉄,m~KҚ8Xn =E'TIuJ .(:Ywwwdffbǰ脈v튶m7X!Yaa/NNNX8  N35kn@U5ǍÙ38r(Y{EK6?c_!3bl399عc5v :>FLO'(;;Mo0|7mRo-:Y]rA8| }|߻S'rkwp x{KN7[wF]􄓓 ТՇ;rr2w*L `NåKѲZjt:9 {~Ţ_/ kbmƍ&cNNNNN:i1.]ݨvfϛk6wE':ŹCa^L_[|~Y Ri2R1dP`@O2hOf6>QPMkjѼ9V-_a6wEX޴L&Sfs׭_ Y`iqֹ1xfsΞm7Тebƴf hafsg͙^/<^"bZϩovB*h(s-}(i g }=Zv,ͽ{E]P':Aedžt n-HʚLj5ԏ?hZ4˖Nd E'D7o+ "&l-(4 7=ږ,x:]_tq({I̥±T"Nx^γQ濸鮈/\t@a脪s\T45Bl6lq*.,b/|E}̽{VѠ7:Z(Ndh>t"3:KV皜q ZщW E\rJc3Wn8p_.Dm/b1Lq2oT 67nrKuܵEPHݚf%I)JUtr ϳWnd)4mu lmye-9-䗮(22R(:9woUgг{lٶcC-1Gc;{Cf+W#]cUޤ)Ҋ[pR" 7o޼Kq9,SͱxnJJ2[0 Z>oBE/!>{m1?ő˝MNl{Pvh['1"NkLrV)^U5ibyy(~F H PN7 qS(=[_ Ȩ'^KQ.*(Tj\KҹUs#""a]љ[ɤR>̼GQztn׻MT2vǒNȤRѯZ=wȠA2hPt- G?jL*z.V9|FaGvţ]Z5QFo+J Y{ƫm\[4n5V[5W&bV/>Ǐ㭚Txwo!֝?xU4PV.Ȥca}KyϞ&1 =ToCV8np='Ï{$sBщ'yz+N4VNciG5dҬ]d27> \F3fĆuFFՇ_}po ^:ǁo~FF m̘p]rsL#ZvŸ +bڵMFvB GG'kf0@*e!QePPpb(p7n]!ʒL*18ow|T˷ҺkwNfn^kSzZ[x^V Mc2$ǿ۾@?`Wܮ 4p+e h fdK$`;"b脪HDF)QuNT{֑Bə8B ""yyzbԋOjoބ>O=-j^Ró#;^U˖57\!Ͽe2.E^OM@Lv&M#0eOpvv}\wn' T* ##ԢjJTܽLbр,r .""̚7cBock_8O7G=s,O]V?=}jĿ2Dhuz{g)~cOg.au9 \ѻO 烋_|䃈\#`yg<8}ON"jE'DDR W\ANN\\ʿa(8??bcѮmr_2 m$'V'GPP.ޜ4 sbeEkޢ#/(r˦k z|$9dlLRHJLe[?i- ʺ^m)8\m:.rG7sȃ` 6i L&*.d2l!1~ IDATvYק/B o&bFH$̙5 /\ te#7t+uH)h_6oi3~gX6 t չc6+emOj5=\=X\o73C>X0xo;Q]l{!P L׫ecF#d|Iw@?˶/.;7O_䙦$pl0lbR)m)nQ" E'T%\PR!^!r95l(ju֎j)>sv[J? !ķ/bF|}|0)Bfh4sU$n]CVimM|ݳd<^SL2јn#9|;W|Ba̬TӼy8V.b6E.s;-3ˏmV9UomsL"l7Mn;8芚k;N.ͺ2p3aj( V|P>cF ؑ#0v0aP* رW{&"":w U+q53*'ѫGO!>|VČ qerm[/шﾙݻLu6ƌY+PF2ɭru5}<''æÇƕۼL>23R]^OD"b.?8QxAf*9HLlҩPeR鄛i=w*:)R 347Ogsw=$^x,⍑1m.`!"XtBzo)MTPt`3C5k')cb.Qe֤/DΨiPVA'KիŜA뽅/bޜ8wHll0E7(ͺ]-f*Y0e` ,?4غ>Qeâz=a6"dCT⪝nd2,:!""*RēOpMYջo 96-KPY#ꀿ&s;& \1Pqfnr⍯EޛyJZ!6Xx~ߣl-6tW/\ EDDDöۑшKmP> ذp)/5rUzՇXC 7*U,V"yxѡSԹ/ \;|,ބ1;#!޴iݮ]Ö? Fww/x􃇇{羾f/Ƈ l_pFa;ϯ\\ܑEF]9?w NE~MF]Hnghگ?z_ .Gxu.6R#3Ku<=LsMht,|  T4kyزMC w,ILYk!lHݚdzK{'`t49fZ#EbnR'S'}zr'riT*/|u {L*1.yv}}gjg7y48VBotJJipNFȍNzmjDDNR^LG[ pkv̆_ܺ}ox:O, [DEF yyy8}:mem""ʪn:x~h?p;u9{ڵ{ЩcG5m*rfǝۉu<˦jzƌY+Pӻv$F6i8:w6cFl=~`}C5 GaضuxffA ?r_n֗tDn6YYiؾmY"""" nI)Yb>/Ov8Z!Wv?rY{YyMyPU.DJ$!gH$. '֒DDU;PwNi ^tyq޽ܺ2*KJ%Pv[W&!"<DDDY5򨗰dG qF<ӯșӪeK 2@Voؕ,=m06)8sΟ;ƍ0_ m'СzM݌-k\(GݻX8`{ANDlۊo%v톷}h'pA(;Q!ZO틤I?__lo(%߀VCK^/hѼșnxwT _щL&CxO9FDDDT*ś& qvv6[3271 +WX13"""""""""tڕ+BܠQ  o5Dt4ܾm*`R8VWt؉= Vk*6QmL[ozdxo|R`0`̙DDDDDDDDDN@Ov6dxnBl0{6FTU( em6QE'Zg6QUIJgƁژB(bFDDDDDDDDDTZ,:JE=;vD"A=oOFT+c /ma,1v[* O=%[mũX32lZ׭;v1#"""""""""* Pr! qPl^Hh( pَ7͉* Ȥ"T*vpp@DxGmm""b7P(FK},rFR)̛WWWalμyHII1+"""""""""NRycɃM {Gb%)ro@jٺ`Xu}""C^cǞ{E\@ݺ4a`"fDDDDDDDDDDb UY8z;8:s׮Eֳ'$ܺzQUʨ).z^Č 0;u❻va3ʼn* P{vvоS'רQ:!(8D޹S5GDY$>>;m5 hMDDTUc˯˗~32'H0wxxxcsGrrYXtB-[5g?[4',X,v[Bc!^zB_@ш9_Ly!Čٳ`4E̊_3gmw(zL&{@S.9U5BBLbJe"#S+鈈7^{]o߹EČ,{S٣:|['bFDDDDDDDDDd PcO:>ptr* 74G*X,^S1YtBDDTZQxs!^v-DȲGvE>}䩓u"fDDDDDDDDDDa Ux7w9JU8;}Bl0k۶2ˏ*Str-uBc8yv]*ys$d2^'&rFMy] O?E "fDDDDDDDDDDEq;o.z:݅ MmތA/UuAA&:>۵QQqnn.ơeDKODDT_X;pIjY~ayxh4"//SO+Px1nJ4 H+v DDDDDDDExrh~d q 4 :Qm i+p1>MND4lB\رgI͡ˑc脈!kؼh4%b!HDT6m0d`\ p^~ƌ93sW; """""""""Qp{ж$~WR]G&+DdN&"iS!VZODDT`aB|ܵSČ6yD4l@1#s |DDDDDDDN@#B,Jh=M Vvn^_U`XV}'o^ooo!^lt:YP(pȤl2}Mlb|>烈:Taڻ P(a[4oFM͛N3N"udKTU)J8ehZrY3!"<38+Xh+Wv: 4H̅hQ/·|2>S曢3g>) $gcON*S:!^rBCC~^^ujx套>QU~r*ٴ nn"gfNsu@o%rfDDDDD;F|ydNOf1nCDDRA*-uq^NNNhѼGu}""ǽ!)_D̨hX8i`0`ڌ93"""""""""b bu}N-vN:Ng=z ""BGܼy3Ӥqc}U!NLJK>1#"""""""""XtBDDVV *GEsrrDDDpޚ4o9"Zj%Ŀ[脈JT* 0v]?ERc>QUGv?/]/bHR,7...جs&bVDDDDDDDDDNDNpu/<,Lcb>QU6iD888>d- Ownc{ Ëzc (88$Vv!*2J8>q$t:s ""5lyVwكǎQN; -[-"fDDDDDDDDDT}脈Jooo!$R8QUرpuu>vz֒H$;{jԨ!͙77o1+""""""""E'T defFRn$&}J *bGV}pr!{DDDUU͚51B|&.[o1ݷLL5UUb'@d+k6 Y}'Ť)S ;+XCӉ\.GXh(8>F{DDDUՋ#F`Ǻ> '''3Oc=ض};Ccz| U7xiG."NN'HCPTdp|Iz@DDTU`̫zb"VČJ6s -{}\vMČPpIa8~ةU[&q||sqy@DDT?6⯾YY"fTN$~rMr9:=(ڴk&MWRiUy2M7A8Z{ a8q$ &&F{DDDU=V-[ oW 0k9M2cp e}vhڤI{4VbQ '$8/)vDDDDDDDXtB\ݻ8oXHAJ# IDATh(_"eET}+"@ǡ!DɅzͷ0dPFj/1o*ϙGFyyy:}V-_799;v,kBѰ脈* nCZѣ0B\}) ND/]Vk"[G 8:oaaޭo([٢]۶TJhؠB g>z=*"nCZzzI2H(J0 Zf!!vAP ,4 'Ob':8[K +WۿAvDάh  #71et]ry٩s_|bx\nݼOM; """""""XtBiW5k  pUZ/JQ'Co0@&e.""6fظ/deg>#] {7"<#G?HHHg7'M*<<Ѱar68KDDDDDDD$N!??X+R&Dt_`uZ"#̬,T*Q ""jzyő#XV-[KJ !_%Q9` Uh 64IʠU0xXih@DDT]1ke~<3*_ ^0 >sEΌja Uha%G @HpAIVv잃B@hhDDDG!cW81) ~[-bFQ*&y_OLć}$bFDDDDDDDDDUNBdCݻu={b "fDDDDDDDDDT脈l&Фqc!ӉI;1ADDT݌*<<x f<>O?+WJܳSJsWGh4BbiXr88T?z-cG>4,*vΥMg)WǴڭcs'I6 a ￾E~~wf UH35NIC %$mcIvfz/niV脈FDD֭ׯTj)6QQN`0@* Q!J1=v 33_-y-3Nv0v s1WDz}2bB:qFYY{' /ťU6QK24lBZ ]ǹM@FF y &?Q%Ƣ""*`epAщe-u$G@zz:.\RYYDDDT:uUWAQ^=3['#r*/@*rf%;vt+dL*ɧFgգ =TD݆7 33զe2ZwAGEx8;Z͛~@ w30u6KxB,m!""""\zҔ>y'"ǏQ+V;ֺU+d2!>#JDDD՛' ]矕pF쌅C_zSOV[YI,H0nR {aJ'fbċ3ׇ0z (Q+LH!J ADDT])J~I!g={VČlÇ K/Ędq}Ju=GG9}l"Zv-v^@&Xn|q&j֬m-;fGl:DDDDDDDDTq*b|< Xm0Dܻ'xxzAT?JF:qh DDDT&;#Wh⏖;-{u8xrOҩ3"[93'ƺ ͜kIOc6Vv2\͡:_Phz\:vt+ =@՘b!,&hI8ܺyU}|иI !ġ!!\~wa0#Exgk:\x*U4^Q!)23Ӑ G'9\=Y Jek4k!^`WTB\FM4 m;7a EPu[k]uVԶvX۪]VjZ]w[W{[#$ԐKˠO74{N`_W.Cɹ\!w6ZnScbwRpiܸ 塴T -NZUowfc޷B!,WST,+hZ# AlsקCHy CbFFJw¯d{^j+(ldQ;w(PJ#Z75s`ڃ)6[T{kt@kH{Yhd\۸yťŪ2/Vg16<.GqmlO'kQr)Cj,O)g_Thu ׃WNťE+( )-:k>"VaL&.VU( Yi˵ZF!Q <(.n`߅!F̐m={3.U_uzW[_UuW{C#6BtB!^Z|y@BBС#x\>I-:&N!ɓ㯝}n]ǫ~S!^ҟǬO>rdJJ9]#Wl(Rk\6}h,]2 ۻ쮾ͷ؈C7=)@bUؾu)T})&k.]<'vB!J,D3#AnV{U]9ukAm;Z&N&/.ǽ[;~B@@1ut!nYM>_RRL:| z>~Z߽m8[,6{{' !B#O6! ØA U..RE%eF&];4g{<.A>_rls$gUv"Ag#&U{1beWynr٨΁[S2 mم2CV')*ae+5ZGkM핧Pu0\rbU;ٯn:mpGf RyTb{y~Ijt2wN.ߙPz\)rUWdM^s$>+Gw߭q(P?xljֵXU&O)x:>>7o ԗ<Uč$0}hČ!C}!ԋ\^b'>N BjgyJ/ !M*b_V&: !Ǜ6oƉ'ivv2;)qV 2Y3+E04r|h ֯dI%kV©O81#== KU+?Veu0 6=>hلS/bcw>fiyl6Ĝ{qZB!OWSeə#%TSPQt/fgnf&,crVps#K+9an*L)Tm8qW7qVFapm8\‰)YEn_bӝj{WR\/ܶt%S, t$*( I^ƦQOLPtbHjh< "DӁ˥JB!a?ylڼwV?cakkT IxX0 3j5sfcpppvxz~FsYMZD]vuR >Ţc/=gg;BT )cMp8H*KJ YJL,(vB!K⭫|_PTU$xtrs~IiN/tI_h㺞䘫^eկʵ:q8r{[a#jN.o(-c/+>_[`x> Tn㔚$<(Xͦhݶ׼b5ʤau/]X@AAn%'Ub!BToOy~1 +;k֭'[92ݩE8_,rdm"!Xc/S0pt t3{:t(e9㷧tCNNeק,DkMcJ\Ydg| |'3h|| lDD"[DvNܮ+lm%&שT ?[ E~~Ѿ}/ Z1gN\{a䨩2Nvd7o&(iZ,~Q‰DbçWѐJco]3{pVmmj%xr}bL+GU!Z} kb l8_QZEozIY?v+HU5?}X'p95KҒ}2 k|6w{a*p\EˆjsOV9+5o:!>L 'RF?f=]-RnRS|Uc$0tA{_6j‰ϻ)Ï{ڗVݮ@/w-r}>3c}PdW>|\kx9!AQ !zP(DYYŗ VK:ر#x\:Rtt4%B!V̠AXn-b*ڽ71VrGvBnPlm%oY͚sW.C 톶mmRUض'֜:?mA‰ ~!&& }Q]L7g23+/0 v.oqmR\hXOޏMW8ryiDyZцSb/%ᘯH}RŞe͵ ǟ8.CEB<$B,;]p9\۹_ukpEoÿi00׃n9BZP߮iypb+ܝ76jzkbv.g;ؔwjc:t>_U`-\] Ccl~;r}pe qNUˁ!Y%= ]v}癟bj1Rq7hե{..hu2hu;cyupU8Kmϭyw^+擑\83c(!X  R/|>~%Yݸvv4}d&B`%%%Xr#=./̓/@qqӹal䨩&J4r;+W|iS{7Ssr\vʇ,-~C&ި#`?M8N-J81gj{ 22nsӷ*6pb6633R}6 Evk XmIU"-BB[By=KVN0$g|&~Qy7w˗o8쮘d!~>a~;jQӪVxT#:}h*:^+ӒCS&jܝ§ Y>Dx1sn2m3,5pbŧF^f)n9d6d+E.sbmӇ}V*{g¯[BN!ԛaG|q)"-Zv]| IDAT^n&Ο6,&՗B1_Q_mE}wƚssg'=7.ܮK W Bz F?NR߈fͽDb3[ssk~'3Jz}Z'B!䞎%+3Sj#L*Od&f7k ]>E``M-co8psγV,жeƔ'8"?kudD>ͧku\.G騨j Ȩg-n-ٸ\81)`HBd!ByQ !z L:Iu >;GW.ǭdB!<ޟx܊_;5 ,sGo>qll,o{hZ˯v!A(hV+X+5+VV&at9@wX䅦oq5/jAAX㤛'OmT= XS ?5b%B!qhX1ό'VI7_{ֿ:͕ￒjXQ_M[+Áfӡ{qy\lo{prrV>Nݼ>c'N* i*w@ԺaN3똎#C"|3j{LByTP !zk#L:)++C)mp-f5!BS@qr_ol? NN-`*lN55H??g«ߏkZ:LkWO6xl9WR'8 > ~M$E<慍A֌5NocTr!k2ՎG,FZZѺBܹîX5aB!/E37L ͖4"e\s|Sׯ请l=Q"\;p%[8 oEv/Ʊ6VGnqiq-V eDV벯>Z]3MFh8%x'p8V6 h]}"C@@nWN}!ƎJ,BymwJKKXc,ٟ}w{O?j6_e2 Fy$&\q'QC%%j˘>s%wxAS%⹑S3[=ZZz5ȾJqQ$ݼ;wn 'ԥJnM9kT5HT%HU~9C,fˋ}'eVEPcB!~䞎%+ 1yUe5~(-Ӻ'gH,lBRkٙa~8=MKç3,z:1ᑑ1==sccqP|;Kws JJetZcL4T,DB nuc=wpaՔ<wr9u9&!<*7dBIRHw ^<I'11`摺E!gzX0۾g5#Xq<6-xl"mW{>ԧ]+/ ;:}پK/,0uX7Ciͪ-qvg䗹B`'(ecwAByQ y"V (+s]{-[BH !O\O:O0[y5k|;~~VByM~Ul۱yy{ѣ*D<,>NFaQEE p W >"RS{ k]IIvXW&ͫ󱊊ż `@اXL|:)KXdպ "(6R)J$x|6ͮ4ahp=6Ϙ7f,"Yk5 f~>wÆ/e9Ys-[ī/lv_+9>Y|;{g4Sڌ} ݻXwÆ EXh(kNb/B66aSFXv-r7{{`Fkݿ7o|2;j4 pqa'edd`?maFk۴i.QQFw@~za3f2YO͛ڹ<.^~%q7n̙3FÇ#zrssqft:l۾hڇ?~prrB޽F %%5r1rInҥK.]@jΟ7G۶m222c kNR|-<<<(A Npww7ONN꿊~R)B!YY-Z)J(ȯn촒rgU,X)8i +oT.3h;:D<p7ČqNsn97OQZVƬ*(J%6WZ5^{zDd쳡l5_?O-RZTdd={]Ed7CS1=*l<7f-bӦW(R:[*+UJ˴ 'O4ZV\^fBHDI'䑓~.޶gOBݻ ACR !CKxǎr*=CI'BI$6i2kl۱Grdcb_Jj^^ZC;cKz E?iw4I}HfԧRjj|T*wB |ۧ-\a+B"1 gou>~M]OUNg4WZ~-D"F@!++ ߯ٽJVZ@3}T\ԿĚkdh߬9Ph2fMlٺh~.d\>4d҉J:پsL:9~vkN(L:UQ,k}}NtZ-[Ǎ3tv:$VI$ 5tk'kN L:|8wftr7- s',~1wɤSk7d_W 115b2䯿6:?>o2$::_,\`4cVHU?w.Zxgt:kǍYb4P{АlXh͛}~>rm߼foƤ_3Z;\f|~֎3s79)];l\hkbvBK?/ж͛!d'$ݺ7Z;o<71 F3n :F/;?fOk9:c[[t19x\Pci{!U[==sw|^5J.nR]{Nk+Lnnq9Pjz.`B;㿖3&QbsG&eيJ[( rrV"e&%jmVNa` Na}8ƌBJ:!2,v_H&4r/, 7K{{{qcX%B!T7f 6lڈԊv+K<=ɣU 0 B瑪tb +ʕ(ϗ*tryx5[S*q'}wpT"]O:aj,V /jP^޸]l6>?R 4~$ה*U PА򂶧Z@7;;9sTKM_ye< *ko>&o0?Wy|~mZME//gNbvu{yܘ1ѭ;ku -Zl4owV&VT$sySLy J &2!!9󋌌4G͍<<<ڶmk4rMmcL?d%SgbBCCqJKQV^JU͚W^1lm\j4ÇCvҐ{Hqtb'pQ#G͛z;99\[*yZk*avUMVy ,,Ϫk7J5Mmi\a\ۦZUݣVVmu___Du>skޜ6)>V[q.ڻHmJ67fWSk]TSkłT*zJjtmiY'Ӏ(D|^LrO#:iևT{+gtU ۫w'=+ R u{,7:%mF.MVQ[LVc;PH:g"hMo!qBI'䑠,)Dbu[vB̓W)`'/ !+ۘ>s&x]7ߘbjyNl ayVI'* | ɷ;u~oO\Jݺu =SN,GV4 ^h4 vv :%%FO2TjT*.[CU?*IY{b9\.%klaDd2 ٦p\1ZŜpvL\R)\3ITQݻG5/Ԧɶ-L1g&Ɯ[~yGG "<¢-<=M&r-^ of\ŜÆ[%?^^^&Lr{/N|/N|O쉧zԏ5d$0n0猶h-/1k '\G-]m&;;k|w_#?4aJ닕GO!-OѡPf5S;3?C?Uz&hb>4FDb/F4Cn:Pg)hXTmFc_͝c2Dbg__8܁ H Nf6ޅqB-v*Dm{ !p ?"?@NN#"BQ`*U ~n&KGDiKQIU/f[*nlP2GWƭxl|gF=&!B DkGMl _73~n9gۚzIUR1_;uPuӞYwtޘgl+@ݜJ|VϷI8ܸ|VrI~w-ecS&eKLR&%BktBsgN㬹ցzɏؾVn؈?e6n{ݘlWޥh.[eZ]A1 РqBN:J G_b4B*>/gpRX1"dȲk J|e$&\dwﾷ<X5~f kԩHLXzjŮfxF=!k.>>QI!prJ۞"wz=p3 Rqyc0>cȲΫ 5Zc[7\NXְ9^J[XT=߳M)3;y#-1z)ζ75Ʊ8U@0TQ i\5~]:g'!g4?o>;jm'wFѪđvn]]L %B!MAxǎR[nŭƭ@yhj%Y*ٟ?>X>_`1֗JMIIGQQ>k,ݍYSq+jCdR`ͫ|(ͬ?~cGA6 Һ B!)~WL;KN =rȁ٣>]6߮Y5mddTS;;HUrK% }(hY=֚p˹NZ#nب$eb!+ $9Rm/nrYȨͭ}[b!DI'I+*,+ɱR{{|2wD"Q{,y$ވŒoiX !@`@eݻw(1j4S}>& n BH{_rEǥ?Y9GOC]j8nѼOP۩*|dŝcͷ f,7Vam66ﲋId k?lD C=z g)-Ubez̞O=ggmr,[[EV~_B!MŢѡ%\Lr{,wa5akMA-)V`4x g^Bs K,Vc8mnvpThͱu<xJY.Ru^6u(6nvU'%&ˬăѱ^lwfԏ݃!Os30HLihpX/B!`aÇp%+F9|O,֯܎?!3#5ʻ 5kavR,5^?Úo n7 Ԥ(?|6뿿vZ֞ys/Tuٍ5t0Z˒H_;66FXF}ڢc8=DžگVkZT~}֬%똦d33 BE;C7_ciFj#LhyKX8nؾϞtR}|fR֒YS#Lwa33`+^?o5VhF>?U)atwpZaŞ _Łי] Ys*s>'efծe/N؉\A!pƋ8o<̅)5k(R1_/{9 iu]Lx5)Vjx3M9x9ܺa>[;n5SiZˡv$ۮ\ hq9VB%M$!g?XCЧu)/+q AקzvrŝRgN-@B@ /*MHߝ$&V>#GY5&B!Th /N|p5H4cg#LR|᧞z:~ws_x0d.tEXRuۿOǧ)3F䘿>_o.T)JuN^}$vg0Óq90Z׻XYq rOcg3:<)[w'9;[ApT3ol!XNHR(y<$bI6wH(G% $vvu< @tr#I'@E}I4U:!BW_~[oCNNOɪF,WRR3w]y@}|_ᘯ,^fJm*PRZjquռ*\T%8y/3ע>BL1~][qV6 ӑ.Sc.(Uթ@:y>V6M~>5csI T)P(Dqq~+Pٽ98q|' KV( аr~8ǎn5މN!/OF.ӺiuNzbaϓW_j>udlzbqiYr)5SDdTP_C"|3ݜp/s ܉r`X$H-#Vkܪ&k{8n{tcԷH3 9ŪbnEy9>uZiF'[;NY08,aI^R(9RN'Vkε=އC#]ktiVůhd 1Ijs%B!M@dY/päܬjVVJɨٖmG^`3n޼iqo^Y!1;')wO;!Tb158-- [mbDWז9Z}` :6DxM+!by|6{\\wS|)&Hj<@ ´oU*dfAru'9wCPuږByxڗZ;Hɔr߂uh,HѺJ8ifo{f[Ol0R1_N6B ^&6G.o_+.- 0J8qs{}HahE}Ɛ{\r*0WѺ*JKJ˴@8N,ט5#g9|1bܫ,@UiQo7;:̲ ?ģҤI$_DiZT&d2rs*QTQ3+ !!vJAE҉aIh+FC!F___x/ˡ(QTаX4ߌNo0\ ՑHѫ(|NBH$U~d؈1} |6{=z^FYϽ3wkexe?0{ԧn/`4a>wyqIyʖ:av:N5fE;φuƳ >:m T~. EE(/WF <<|[zrmEnv06(<;;XRqSA-)O{fVǬ5S rK[kee)y< WlosθnAeu :Ӟ T=ǭdɕZq* Nؗ{KMb{p|_d效]2[QͽW !(4i|$n&N:χFSj]&KKqp^֜Kf 1!nnn$$&`3&ۊ>4 !KQύ#{ڡ]HW hǐH 84Z#Rc p 펐occ#M^E!k,CҎ!7wo4[[ ""#"K"B!ĴQFuLk}{:J՞Ҍ'a¼\bKiתRu )[8 ',&ǵ8բPkcW 3<.7椾!7뺏5CXj :IcU z: #;Μơ}Lt믑SʣeK8:95PԄy`q|[Ft ?ƝTjoI!453>@_uTX9"B?&B!Ti`!W#B%&mvcG-;;ica9X嗸̌ ȁxwҫ8wk5 nܨf*MN!&4$}zUV+ܱsR!a[7w3$J!BHSVVemtY+B!(4yQ{g߿.\ףwiV?f3yKGf!>.Ta4N<eh'GG늾ch!b{Ӧϯ%VLJJ@ vw!B!VhEz betB{ǭ|nZ:.>L&x<.͞Sm!5 dBs[1B!ݪF;~ gϝbD< t4T H$FnVB!˭?qc?2C# !XRG''n=s ðZeE͙Ȩ']- CKݪ1Et M9HMMUc"B]@QR9%Kiz !mڸ 1(*ý{`JB!RRi\siֽa>vX#.B!ltB >m1j_֮={p!ܸv @(ֈCF`#1p8ŊvXM 011tB!4ANNNxyr4p##r'%7LWssk?!B|EiZu16f}<!X4d (SQ)Dbgyrx+G89:obbbX !tKؼe+sK~\{C(Z92B};<)o.X,v(B!mK='X;B!tBBBaD ?N{Jb؊1VB!)S0g<@Zz:6mތ&Lrd<:y76vJ vhB!XV,,y!?=$7ڱBDI'B=P.hB*Bx{ O:qrr~CI'BHS멧)2R?^~222!B!B!M%Bi4-vIpsVB!xiJej?-_f!B!B!P !F|Mhu:+FS! $33iiiVB!5in4dVB!B!BttB!V:)Uq'%z'cni;BH޴i N~\b!B!B!%'Xyy1˳b$yN9cň!B!B!%'ZFB%b+FCK&yq|Nj';ފB!Ro:vvￃ #B!B!IFI't/=5I !?;VRDxeIff&ݳb4BLW^~E?NHH{!B!B!Nalݰ5Jh*I'qtt"!BHm0q"Zmň!B!By!r._bűJY<Rt4o?rT}B,X1"K3x{vJ B j՘!R3oMf˸ 6_n`B!B!<(X[0O,Zapi֬K Ytr W&PB!1lP߰ V\CA&Y92B!B!Bx3VIDu99:Y=UtiN$T?9sJJJO?b \ѝj3a:zde5܅:&5cY4dddUQcb@8~8``4peDDDDDDDDDw&nCmBnn|d~fQknQ;2*@ZhVUUaŗ_""""""""";C'dKJ'q9!Хm4skjjcǎvD$!""jpݻk\^޺W!%9Y߹];.]`ccK+&vJ$"=^1U#+W""" \ ݎg~Ayy9Ag\e貈8 Q+/+æE}vX" 5Jl6 ^Bii)bNMԴ4\B{WWWEDDDMϜV("#q! 7peDDDDDDDDDw~bOF-&295 Q$J׵ojBCEm[e=:'} Je<\鄌Zˢikj9刉O =@rr2޴ SLy8WhO>Xd """""" ‚|Q{А\.NIIFyy9,,, XQID!""5kLk7MS,*ڷoo4:!&qsw7P%D\*._F@VT#$(6o"+;..O=/.} _~]܂p㋈H$7C U.Q׵+dҚ_?ƳNXhP( T 5qcǢ{OV!''ǀ9 5wQ;7'N< K0Љ;:wkƎ5pUDDDt;$ /z}PZZo.}Y3a7fHkW+S ]N QsssTTTb"U.7pUDtIN $$lD(" \ 5` .>r?1k 2 ff=Q}LL ]Q5+kk8Q޾iT*+" OZ6`5b!A))6`5DDD\/z2 R/ \Q 9棝 =5kV4pEDtۥHrŀՈڊHUBDDD'NҴ݋hVDDDDDDDDD1tBFovv_*#Z[@gJu@B0`5DDDԜ\˗CVDDDDDDDDDԶ1tBmBW_\/J IDAT\_xrlߵ % Κv|B ѝ={ o6C@t+KypcUK++MxJp,j]a`̙R/_.DZqq: [IIIΆ|QGƍ|28&&󘈈 nVq5=Wӛ|7w&KDM_:7u 48DԎc T 5'kkk1Tq#fLfʈnCDD'ܾ<V#ֱcG )bN2iԴkpN""""""""b脈 _. Tn!AHVBDDD<_Vj&nCFǟEע6Νaaar7߯-۶ gggWEDDDeQ轶7bbb~ v.`脌4t DdR)vřgƻ҉ PDFbQۢgCsf7^3lQDDDDDDDDDm!""knmpww״#"ZBP߾6ta\NL4`EDDDDDDDDDm C'DDd0r\s;)9F[P߾ZʢgL&j`脈 Os[RݕŵILJB^^!""ݹ3s8mN`r9Қ_EƶNHH PDF"""j)O-\kkkM? m`脈 :i F'ڻj VCDDD- ?}9޳ǀ &.v(p9\AC1i8;{<dd$M8~l+23R'j(p.\8͛O xp)o£$"""""""$5tD:&̘ޤIm* ^E @IIq3UGDM/j:{yEӎP( X $TzR/(WώUxiDGl0pҐ+ؽW6EⱣ[ñ/ '9y&JDDDDDDDD-jϣXy) C>!!pw g1D\]\D[5#ZڈaѷOMիiߖUoR>LWCGM>ͭscii 7 D;H$oUWo_ M!W]]_yY+pbnnQc1&&KJqvn߆SDD*fJ<n_.W1oJYC Ǝ\|ptp0pUDDDR?f=A@yE[ljqq [VWL}JY"b7"I5["4l4zs_,P\\ӻƯu=Mt߁կ ޤsQb脌M" s/-{5FAq>ymdgk߰n&Lnn]:v$>!h  >€QK٣F ={6mބx]}} \yZ+|e+芰~co *qg À`iiS8 6 Ǘ+Cbuk?B`iiep{2zC:j3'u[QQ[vDtr?vFF X6ΝiG(" X [SSSJgnnߕKHI>/;=-'uг] uvv§c1|Č'YZZE_'PԯT#:j%""""""" 鸒VrNҗ!ɚ<;^| H5: FIpPvD€Qkر#Ni:r'lD8im+5jރq{ 68SS3̺VtFEDDDDDDDD͏Q;%jO9 =o>}УwoFݘrBJKJ`e噉 (//!,4UcΝnb `ઈ%=qlݺ %/c>jચ.'7CϷkoT8%%Eude#=-גQGYVS{Apsl2 J\@b梨(&2;k'kk{CIDD&|)wiy==m+ ]1Iβ(O^SR^e_Y J-LMY^1}jdjC>i Q1l+"""9_}F06&6U5(OԖJe030P5Jeh! 5pDӽ}J1$t4_M[Dޭi[YY訃8 ϝD~[쎱fcYlggN 5w5Dzצ!.f~&<Ҩ9 soqVd;N*{`?79m9ksvͯnS$.sv?5^1tmmŎn[#.Q Bß?wV[{8dR\ xyҊ7ܶ:4B|KP Dsmgou2WYH|?t~7<z5_in:[J-H~u}g.*pMjA0/{2! ZҜ5=Eky)MZ~"-B^gOl.̂! T^rW\|jG[~Z}wSlKTjA2/Y}duZvN%*¾'{?diQjV QUU\&675OJV[P Ed#Naan'/дV8x9;i?4Nee9r8;ȹs𫫫p&ufTWinn;$ ͭ?/7^zǴu*U5f ~ϕRV 8=>|QTVtDDDmi&`}f_y#)޿O^w7mg򖈤yAf@-itGILJ$#{HVOwDn\^ZD&U.|\X HԂPHhy(Tu߶/VSߘ.l_p}ϕT"IRfὓ{YAqw 6Qst ̌ tj3]e^"jmJĤ$3g׍¥wv .'&af&E=EnaZ}_ɝhWkAhh9IwF7s:Q  KK[gmmA=pYsJBff2.?}{GJyqXn6^Á⭉,-1l wf쫈9igb``wZv""fdg[^*(}jA0U*N]Jww>vj3ζVUkVYxo>Sin6 yzC&Ud=&+&)+rfAX~qy 5w]wwkgky:LLJh3J-Hv>f&2iq1'q((2yWz_H˽V@*`7w8K^s}&R~[)~<]UjA=2mK~gWT\o**4ﻝs?C'd\ڋ9zf>z涉 e^"jRḸ8 ׬tVaC""""j 2=,>OVC"^QɃ)Rփ7CM@hCSUر}!#ZCB'I琖O/_\Bn;n L52 ň3}OX͖O991u3z=!s zsk-#FBۗD{ӗ㉈`cZi7}˙%WVQ))SRfԿNW:ؘd5ofͷkwlxJ[&}9wآ>tt+|Tx6RiܥS4^In}+󳭊啪F`p,nuxDsG»%?-YYZe*:?.AZۂ\7pbgy9tUI%!>_Wb+YEnޟp--O oIDw$nCFwp0$7AM;WoQ=kkktQӎO7`5xV@-"Raj5 GXhؑdDc ql<:7> }(2P7 ΉFzZƽG~x|;t1Ｗ]o.D }ӟ0mYyy)~^{`,YRg6SS3<'[ _6{DDDw+z9XgZAgR{ӿ[v7-zmR>W^?8ѥWώ_-J=tdr V߭rv•1VIftr:Ό'`'uZ=;g_7]ɽG2 P\δ9vͯZI]O~ʼvD#*)0tBF~vQa!-} %M3D}a4y>"j>rv\N$ B5툈VCDDDmѳjY]- 3*]ƿ>aႁbPTj?:ީOy%)ç ZUj=Y>I˼3q|89iHJs.<= 4m +<01+Dy ˗bV"";Ls?p:c+Ui9E*.; [-[ܯvOz[_eکv;eCRe} FH*+pڞ1>}8gT(TuXw4Ϋ>9I-MdҢ=:Ƅsk9nY U=ry过ћ9a,[DӾp (Yk}{+* 6nO~ҒMNܬ5QؽgA5`}oUQk={!:;&;x_GQW[pi ǔBZƢ<|!!>J/i6h@;o׳+SuGyDk-[DD&ë/5tiعS U+W㪕Zc'={Tj5~a( WYQ;fN5v=8wAL*3O=56&6ЮxE [#F{>ZU?56 @{޴ yyP &N[k쑣G Hxdl.^ĉ'<NN֑[d&2X[YwZoƍZv}߳w/ D}NNN>L{ǖ)))'`)Zc?ri q)ݻwGGf hޛSN ( /,LkqUQD"#Ʀ#-=Rꑭ;{Owݡ؄%h&o:G$nz.{ _ (,is)ZA-y333}iZc`pWPPsAw!5UjZ۽ֶ{$\$ݫIB7o \?KZ\" IDATc{:jcMMMuN޼I+hѫgOGh=>/⧕A ciNu3t>;s _[:Sgd=ZA'L3tAjN233u}7B' `oi9}ɷ8Q_=tNnۆ -2TgtVZt,Zط-C{P ;c4t{U}zi]ןk;ֱ'ꆳW~1)O}\w+{xmתCήv[&Xw,ʮZަҊ*Ҋ*kyţvG:Y)&wn}t075^ZQ}DZP56wDK?8X\^f W:9=v~[Λ̮e\_ҹ%Z~?Y31bY+t+y@דH0tBm«＋gõtU7bcq.6`jf[[[XZYAVXDR&Nh_!BD!qqF:ggg޸z5B`脈? #baaI`|9gbӸ|)ee% +jٽiiqX/jp*S Ã,W)IT~( T#*r3sݡ' sl=u1y$d爷nwos적`_{WZ{~]⾩S5wUWyit+lgnWw{K@XWG{uv=RTVʲ @%TZtgz^upO/lw1ط&tӝVlEw*lgN*ZPm;cM{+=eYlU$ySXRѮBT鼢7\V*m9 WDȤiG۫ѨYmGDd0 P?^}&~cy@~M=ϼ /sss}%>>#j$HԷfպ.E r#Pr=3 p)!.BJyE/Ǣ'p&{`+!#A}2' R&[Ngǯū :827MlsW'u4:7cKP{Ҋ*篼twjg쌻 ]QE~w &R VlS ^0Qf",\X^[wkcsejAh2*_lE_ -XS*.T*/ވ C'f{xO~MCjڪvNx1(|HHDB.kٍOh քNT*ak{G Hnm-23Rc*(TOBtA;TTXZb`j{Et30r`nh0tRwk~^Fw߼EĞ\KuUma Wc˦oeRTWWĴY#""S8yYt/TRlcӵÉ{ºٳsvKF}wG&ыOALK*zd>5/V[]lgj`1F] \l-OfjYn3tR D[x7sU7:$WY_ڭ&UMyJ VϬo|cT|,NM137X^-5os&u>-T\05Y䘚JeIL*%Ӌ*J+:ڎjUCv NMjcE󸞙bJ%LLMakk [;{xy{?٫\^ 5jYۥ 4{G( BߞxxDq TTܼqAPo^c[E^x_`mmׁ!hׯi܀zYk{? Dk.zK+p"1{`۷kvBʪ;/tRw;\[[Gtˑ[J>Q}^X}hؾԥ ȤEl-}";9WNCݜ!ݒ ǽgNq-8 IVA]7+B#/g}}-Yw_R;<FkݱΧV90u 8ZGuu<_l[aCΧ\mPa*Z%5H?`<'gg 6E89$r1r{93}R52D4W<N6E좲~;9\5YQw;lnf" X_6mqDDԶ0tBDDFQQQg| քNT*akm7A.NhmAױo~_Z9sd~/\?R ss}iDDaaEkӧwAj.ة+f޿Xɍr{;R TT1fqIŊډGY}>"""j]*BAЮ-սW|.={jy8AlkD',hz볭 M褼R'&`Z,C(H*,G.^]kgevᗧǭmLUfPJT*}ZnUU7|DDw"])U"""di'jaTj5 X Q벲@V.ÞݽknLkk =qx+Çītv.U76۾$%f`i)w//+i* yz.j"-5Q$"""=r,n wry^{wr{8exqË8ZG׾OY^%"EdkaPV:1YՉ[msSnQvګ#B~Q]SX\a٘9Ҳ,Uj2.v罼R3&}cIDt'b脈N-v3t5D(" X Q*ұ>aAocN)nn^xmZ886[)|TQ;*r?|RHž7H\kסQ"9\i*KKEWu|j=? 2xӧZ?&]/5׻?-}g<+ Gۊ#{q9sK['睵W\W>uoHeu(bgu1mHr/ԘcB&RT2%Q5 L5csN";C'DDdtr?ĤDTUU$ 5ӊVCDDDԺΞ9&jK$vqkV;~k~@hhQࢪǏm?5W--m6Zkբ3QUUѨ *Uui*7΢vRq`FB`];WQѭq߀ۖ'ӾGW@T"+.n>>>DyR VlR Ώ٫T&{qRi} aTUS'>K23 s3~_|[+3{gre49""0tBF/)1G|꫷5_Qa!O'hJ^餪 III~!Aq/BT"""<ΟyބdQww884x_?m?ڹx7ٹeV /*;D_)=% ;tƖ:0p_INӰewz]>SPYYױii8XǤ{|FCDDDR2 -Ղ Z7/z8C{ޮVk$gV^[+`f"՟|0urO{m-Dݤg QVrɊݮ7CuZQrYyN 6X|Mۚ  >ZIM>.8 VՈn`4a%'[f7f *rVLj:׾`]ggw7shtz2>Iׁ6i[$%c[TgklES'wʕK<0?^ШjnW>|lSkEy-' t=+:k~}jޟhgaڏZy#"""%"̊I˲mon81VHP=9"F"6r9%}rxXyJ{r[@;;KJi9Q["ne 6|hjU?v<q 7fkMpRIRf!Zh /cS\~[$"2^&BdX^n{ j:z|8Z <<9^Ԉ]kp6h sxxbԘ=ߎ+yӷ>D3G8 7/:tk5ˢ1:O޷Q󆆍 _h*|5oLCˡI1Yw:VU [UvKrBsZ?08 1p8)ޛm ćمo=:@K|\ժv JJUjqL;+6s3YsZd##;ؘU&/;8sUj;DR-BI&K&loUjsgX _^> Vw&5'!Sokee%Z7W?'o\kLA@0ɹ=*+ˑu1qj{=1d&<ƑH$xWs5} `/gZgg7T*eSP*kVg1D)!.q\h7x() '!> =acjUJKԔ HOOh>DDDߢV i9i9q7/4dmdcicm.+̊++] ˂TjˤEjzLdjoW= gɹQ BU+Tu⟘rw>komWY2),(ir'gg5D5җꖜI͞;?[FY媡6).r-.Rmn/w[3ʧ1yJߏŽ[9/>OlgyJ*v%]*ꬲ"8 Q  7'{}WS $%&BVC&SD_.] -wEpp&trEGAPڵ$*^̸ T.R Û}y"55׮&jA'qzsrr˯M:oS DJe>NVqÆOIפ{n#N)/7ǎniҼDDDDԂUAIE ^7I tLo|&xS ]I%ߔyߚ5WRV[,Swڲ>p~tSg»^+JvW2(ym+'vpY*;־ZZ^ky-!1'dԮ]LgÛ7ߒ7fڀKle2,IRfft%4;l3iV͆l2 $1{ʶaYd[u{t9=jGlWVVhWQi]XNS˖-b5y^ 'T||CNRRo]tRicc[ؘ*9_kOll2ǟ9OԽ~)鞇_I^t#]ˮSW]}a߷o4͹]]vJLQFOֵ?%t^Cz% C9oR¿]2771~mG֞K%!&I>3O\wjFjCۤHWMq=Ǽ;{(# %FY϶=7b+7qA=_ 3V zG4fн[ NЩUVll4$&zuSeERRS;ٜ5 f PRRKgqǶB@0G(z'vi]6nX;7h&>'CPZE2טSe4ZC&Jqe IDATsRRtC$xw.^sC>^[4j$Qu{;_ԚK՗5?e##cԫW,#u bt;W8{$m~OP\߱ST?Aw|o-_P;ohK NS.Urσai\ Y57y֌)]<ZYDEZC*-͢&iԨJH@w_[TDp؂#dTkps_K 3b"6&Ů9չ^YCnٲsc\s87is i?uݿˑwd//:vlIڨ]}cV:~gמ2ӎ.{xR߰_/kXb<w?jFgȬ})`d֯JRFJRk7]<)vSQYr~i 7b·&FZR{,X˲! İfJ CCjJɢ:l{ZvO?qZ  p'quګ rE-W;U3Foz+Gg ?%[r3gE.euVNQQMvI!R&(2swp](),L@8*Sddd2uZm߶^wl M2EO=DEk.*` YuOҚ褘vVFo/ H#zR4.+ܝ36ҿG{a[TD$S+&>&N,ٙLk+,Zm[v:;~:|0tve/[FsmA8:Sy(ϸL=a]\<לuҤú&##==]Ma]ek֨:Gtz\rySOr|buڹ}g.6.N8”>43;gIʶf{NXj# :'Mؐ7_M\Zܯk8}А>#P!Ԕn/b5mX,ooKj#u$$&ꚛnef>eKjr55qesW]bю;%uN'&QOooCtYq:gL3s$V(WXX(J.sY_~$)nr5m˶fyB'WVmm\ۈVTtzRt09s\VVݻwo'>њ9nllԲ5e V`@{,f׸3oc1B--v=:tzSS[옌FM{b{@g0d87t"IVU }+IZzjkkݢyZzIЍ56ZE%XfO$޹C'ㆆXRLĊR^^`@`0{mۦ*֍P\l$b ݋ tFN]bnׄXQL&&Lo-$r\8 :t InﴡIfY=VNQQQA i'S !,,,<%A%kȐ!*(($؃\Q۲VqCCV\I'"L&S8ڌ.0=;t2jHrm Vtɤqcyƹ6B' D. 222 %%%o>q~A3FQQQqNnntjNC,tB[hN~~~+OxxƍlA8v,s" Н$޽z{v{A߸~ztNЩm۶MzEIҌ3~i5j$TMMMס Ylc/EFFjўqntNЩr8 ^7 ݭIvޭg{D,f8?kl#I,8oR566Ni}Z[Iҥ_x}B' ͷaa6{R +<<3α}a.8 b{ Tf}駒${].KFcXFEEiԨQZ|$)ז_]|8UVV !,22R.IN"w:!st_s\SSm۷kPZZ+D:Y4ONK. ,[~ם.@:ez`$B'Qt:/9klۻL$jsJ*Q#G*"olN|;0][={Tqq[2}zτIR- [tPpt8tFNNxO"ЭYf}x$i]=/**JF+$I6~yŕA Gr_?ey`@ $n X,O$ߞjmNtd2\hgK2tc۷8;e"^BHh}͒a޽[eeA&0V縲Jv{B!f:55:Ngf*,`#2j:AHh н @ǢG?Bo *,f8ߞJ'ˈq-/ۢəUlL v]tfN;tbb%f5sl˳S ^!YDn:B9`褨HeeꑔĊmK,I*++ӆ1|xp.hwzQV~3>lW<?&iltGꝰ6@gC!N'@X,^もM81Hn„,F9pk%t:`UW9˖}:IM55{ӏ}@ℯ%}:b{ 2 H8ߞjɵقX p2'@0J63Ad[=yyytk@: ^BYk֬$e[zW$I%ڰq7 n޽U%%TH{ pQWW-שtJHHր3t8jcGJKvF[ JH詁i lr:ڶ5_{TSSdH~gs8vڢ=(Qd%'S2MG JR#*#N9p˄}+t k[_eoU꺆I%uvТ#}o}_Gކ){kqqQU)I1xG(NnNAM*zV3g$ÿMIq\, k=NVxUgAQY̗ Y\ճ1Zcë&Ŗ]490).گZQVU:]:W|p}*jΈ!}]|ehEFB' >@(1g=7nT}}"""XQ`d2t$I6 Y >{M|g&g'_~bb[~Aoe IDATR{YXP >:tf^x&dclҼzb[M"<[6}mm㮉ʪV6dtIz-z'|w NRv%s^bz_V֍wCђGټ~srRU]0Ik~G\Ԋ{q֋nYa~@߸̗:߿.8sH}ҧpw\iwi NWR,]=:?r@P^]xҏ I=轟df.htjiMɹX8a@tWNt69nllBh2l6ku<. W%UX3٫޽뜱㎓$7twVW/(O;F{٧{faj=lM?R͚}鶴zpo~RfK_6/<"5ZZ|]~]:UYYg 9=ivT-@ǟpf;[1>>8s|wjhtCaŃ & Nys[U\Y~ΒmkH~zͩ( vWw\rZr#+k?]9{qεΰa;t5>MFk[;19=%r&&M5:]^G'~ޤϙIaWG\nWyf7TԏxsIK۷\'?, ]n_tݑeՎ̯Wo\R/y軯>ڍ_޺ʶt8~+6?>-thgm4<2?=eǩSS NWSo₏n?Rc$ 2~b5&ۚ91Ôoӽs.o3pԞ=tߜ+U^O-g}+~lƭ[8iHsD?Iz{ 4P}߫m[ ;o7pҔoќ/SEEaQv@ċ펴muùPW2]Gw8i~=ڷν4?n[Ny;?<̂Wws^b}{mNop{?<|xi>[;/v'?*j 4WWLyOI;YeU]^|F+2zUv'M%}3.ݾ7pj: $kh֭${=.j+~UTRZMJ}zkT__'I{&O9STBBdios^qq^{>]G*7gsw2ǟ>}d Ӿ};Òzb{ϟ&O9SiՐ!40ͬDEFF^%Żq }ڷ=?if> y[oΨѓuq*-ͬ$5ZmܰRڿ ':`ǎ /Tuu|rr?M9,Yѣ#TQ^uZ;*..ݰ~u_^h::@ѿGA}^Fgŗ5 hl)).ԫqQ+zGꓸOBtir\LuѴ&qM{ʦV{yO9,ŊKVs`;!i5ĸ-+6PXTvFD'>{ؒcuXCw{vVF~G77 uq lPȈuJ2E%'W{~npŪ2R:y̠}GΎRQ.:Rti{Zi7,MX_T:nS]nwų߿~-JArJqhߤ>Lr,gYrRYcL{޺ʷ~ذcm0Wb-%!v {EWEF8j ۊ+zoS>b۞qݑ9)#7e+aW{GJش^z'VoWr;KNi &-ؿg<~r V><aڕ+ksj򚔤ؒpcҪ[)?i1s?ϼhmtFN| R!Ɯ ۻ^Ě%(k;>srmNoޕ`Egs½Lr>7=iBwkcч$KozBCӽו$M~⿚=;N{N7_f?QK3E&S+O N/.M~^9֦F4GwzyEDD17M4٧ꕗrꛯq5pGo L&gHH:ԧ_6GO|@(,ۦ]njǮ "&O){ux(go_+trq#?hI b"÷d 浧Y4r@6J}L?4}} Eef$׆*ϐ$PsƄ{\ N;Jtho֓ڶFI߳-/gEg9kyϫ!nΙzGxgϜwu~~”`U]EvѬfI;;ϛΟsKr<^iX`i|Kovν=s,F[u[Ko3_7?Yd4uggNz$eՎ!H'Kןf+=FMMۭENdzon%p"I{i&~tngqՉŕ5pu 2w7qi07)^.>v};r kz 3^73i\UW﹯xTs9>7'n=+l랊;B' >k YۗWVVjgQQ;lscr${)~ʥKK3k\q^s\{JLi^f=kpԪpvϋMlwMK&O,ɞ֒%yNmm[qǟ Y'u\ia355|^sW۽ї_7Zu]3ISr{+j'?'3EkgߣP:o31}gо/7+(*١1wwΜ޺0_fNyh46_lهz|jMIwی=oL>W'MYHIM_xIM$g4!}*ۻtrſd}{nf>N\~`voۆ]E'4';Λ̟{téEI[Vz2םM\5fSa=ƍNWp t`NP״Ӊ$Cg::)))ѦMX @v׷'2OX1r_秤 Q߾i^s7oXr?Wmmܹ] ;: 7_ڃoϹ:kLa:cw[neWj9m^VU~f 9w^]C$}tngi Ee1޻5/~&ڑtI/йg#R%U6*nm}'wqZΝ=mzΟ=mpܪ-{{C1r`/*;JG/Vp`;- g2ǎz+3\nwqx_n #129vM  t:@ׯz$%yAgʒx[w[^R3|&N f(.>5Tv72JѓԊzk'xwSj| ͽXRЃד.;joE%Eo{~7O JǙ0oExx϶)sZ75#4sN?苦c} >D nn:0|yWv]py{ti-wV@%&2|˥Ǎ^ >k{, qQ^(v@S77 oe$i[q娦Ęէ-~4 lz*w M@!I U׍it;BRH+2NT2? ^$11QÇfE^ wV~]_|d28aZ37t؀55ԵZʮͪQ+gMUU׸6lX5><3M6|l_XTݻQ$왢DUW ڹcΙ%O_5^\nuuΔ*flW1㣼C{'p}8T,ߺ'U[W54DU;c9oWiU{/O_*o7_πfFcvVF>[XRU7r܎s܆ֶNr4x]H{H'Fm7tIަf[.`19TvگAH"tDNPd6||gQ***е~Z,))͛5dȐ W@TQQ 7jڵZSd oϣP$ҧ:-` C댳bzſjWC:)I+qI-kO||VV>gKs-yshب 8::ZށۭJn:}J.kd2)6Jmm|w߭y[G𤩺zgJ wqQˆ&-9wP2/gc/vbhtthO丒W + 8Қ뇆*O{s_~`{Wi ?u.`0կglm 0JWO|& ʫ" WGsQ#:2T~QYOEJ龊N5IN|:Bln ʶfqF瓝eh˵[.Рe/X *) BttƺzK?{֟+O󸜍ڷo_CyG:R_vvT_ߠo-7o:쳽{9K.Wh ^s3W^Y;{5o|-˵}?w5|0˗+YmY{ŗo?k4w ZW>k~|_{M[f.q^s :y[}/Jm,kz}{ͅy}g|?}~]oo)ӧ{9NqY>kϞqZڲuu=!}F,\5g2kl}~! J~CګN{}wC3zg}~7zOր6mڤ{g/RN5t?gS4}أڱѠ4}7cNל`#=vzw}oVOMۺuIIRlLLa&I9gֺ\.s|eՙg3k]^sSSuկgZl6fG|/W߫߂b9ͯ1i^{88.>).=%i]O/8SzE.+rL)O.;joE oBgc>ʹ̵1aCvgkҟl NWi^Po4MFW}`Ir+>&a˯#QZ/n>"2ŵ_ŵ-YHR߾}U[٧w˯$衞=¡rݻŏZUUVbj9ڲh =;wiڵ~-))Y+I:xҎf IDATjkk[\[Z`u-=ztu\ʳ55-Fqcלdjq]|J-N*Z\<%Irق>=Ztxʷ{oq 7fC'yyy>Au*I?h:ٰٻʳ 𔼝xK%ٱI !@ ehQeJ(ZF;a$Ȃ8@HbmK+[-[X,Kvt_?ZQeY>WtU9*h{oɼCDsq&KhE~{rm_xyWX13we>n=TKcvBDvF䪹ɑp?[Ƹa;#OKᗎH$t K!dvxc [T"q|D:!{y~:Lb1=ku&e9MHDD f3lI_#!..D-dRq"D'y.x iNo08^T 'C[۩nz2=o]o:.ާ'A兌tT*ź>vzYww}v%_Х?T|Ֆwĉug7\~e˜wjTp=OR}ّ?O>8|qpUצ4s d>Ծ}ཷs<ի o柚H$:; ŗS)}L$D}:Y3/>cm?\y5u'[v>mx|\XBu} 7BᰯH#wy!#{:,_fHoɢEvwvozֺj|UUQK[{,UL^18fþ)A}G[1+jUPuQS[笾sH$$S~qIږq?}E<{[,g<-|f4\[.Ů}T,ڛ^Qam "u̿^qɶy_]K\ufaj3Ƿ;UL0ݢ|' ?%|޽ko1#=N:!;3'DKTB'D(2OGqIIw!t: 캗0BK Fr;<ݱ t-]# TUt|j 8U0tBDvdίgh/^^^~#|7td_!M/s˫A}NJILLtzߨ(DEF #\ufA03@$&&:1yd yakU^Dg&LL& g]Ծs1[e~yClI% IOsid#b*m['M+0Z,^x}[P2H'HJDVbmiix̍w^>[ӷ;=+ VXl4YlߣUhg贈qZzTEc ڟ y8S'DKL=.(,hn*#="ˉ;g3t('E3"W-TUV:t/9~ g׽DToH7}v16ݹr֝^f).:vzI1J`4]*UMDDD#;pRRz!'"`L ڳjnӱIW^y_2džձrb.A̷tt5uB'#57 =EX1qV:@w^]kǼږOkˀ-UvyUXz`h:!9hR)UFEEEP*nuHR(؟+.~FyDcL8e= m!\M. گ;{IRDjv/ n;*ĻegI3l۹9{5A.w.rVQ끬Xy-NADDDɠNn&byCѥkievE̱HLWOec rkۏ-VzJ舵ln%-#ur]kG]BkoԹ};9/g^ߑ[\j03c'd>^:C@Au<8 yX"OR)!u@N pۉ-t?kyh,Y!8 tuuѹEE./J4DDJBpP(UNޟ{Yt̜sOz24i2s'dmNϱ\:'̘.tEGp~"""YfUTQ[>~bHTVE5U%:LpY:CCoȥ?~;H0+ЅS=fs{nDJH n޶Xޏs;_H\g4Yov' t.,\>;c 7uo[,V7[mmpvr*ߟ{vQvCi:!{yN<_(T?qs&OK\Pdハ>סqq'?VyE wAV6=JKPPXh htt~ZxXsI8 {iCl7->HU^ju\:}fk7O43f.ġ6|2u1¢=(oȥs9KĆ_FGG_?D2$"": 8Ƅ~7gI'\7D;EiZj]JGܶv_H]kHˌfDm©/8%JjZW 툝zK~~L'?iwRWm*~ezbH/MGHcyΉ[b}Rŗ=[fajێ}/RTsnMe3!5Ϩlԟ;~_+,V!a#t^~1$N30tBD=S͈Ԝ9s:dee :gUyD"Nȣtw/H$C% ӧOGHKz_~SAG X1e5Ɔj߷sX6;w|]鼗eںttO\G'{\EE>!"gXvmcyx**a6DDDl <zۛX&JwY RYX\zC[<ng?f\3_Xcwuv;$ffr(ko_7~3_S #Y,κ4uo?dtٗ_ᒤG.7`K^ѽ- v@x#4NI8\m `[.kj5கI\Gkz,逡NT Je h5.5:^#I@~A`/Y9ummm()-^Ӣzw/IR( zR!A?{2c.|٧DbC J|ͻ"w2X"Z. 67&%@Aaλ;qn%ǠH>8t{3<n:!""rAr_/ML|߼}?]iwO?>:)ikw>pYwz^/o𖗷;w`LbjD_-}NYՁ~FaNذ-;=58xҹ >/nY=iL.ӿ9;S,n2^|`ns*uG`uȩ.N;Ձ"b-ž&<&]o~CAeӕоg|^ozvWwfOz>Y6fyW5jJ@ut\9.~liL+o]y3Mva7;`9^vE54 sΛC':!x1"ORzڊjDFFȰNF"""fiS"44t*':H$RV|X[[ 8s ̞s."#!ݏ~܌ _|?<9?8w+{)?uMhm 5c5{]D$ ӫxUhnBJlLqq*H y(.:xgT!|$5:tkZlXFgȯlTV7/jmRw?)+kc'O ejvŏ~rIjtȎ@?/CY>4aVI]y&n!ok:;.%~3b4YB*y,3*"H7aR@nܧ)Ϸ˯#Q]3$7:{LCԞ7cF%oނҦIKi>,aFy}N9{UL臹 ׸zoX&NeK̖; EMh'BYݢBdۣdڬjۇ0E?ydymnׇ^{wWѨPPyQܷK*Zںʆ]{rK{WZ%z<C'zgNgSvvbNÏ>ס qn&шҲ2dBѠϖHT Mu/INJ?w!݂#26f6<7R~p-v>i5Պ:4797'}) ؝ݸS ߟހy; }-/Lj~w0^\H]UVGʦ{htppy3vgW]p}.*~/Ҿt׮喥ֽE9}O^=yQ}q:&\?#qC7eYR۲eh=ϯbBR٨?QhhC D~۲o{um3z}Y0-!F%qA߿k{7Ҟbȩ֬UT pMoJi-r\}:Dz/ 'B`` ZZZXbg-j!5mVC'DD䠶ֹ{yb]^"o['MԴ4RDM"GécR/\?bŷa ]ᓏGcCuOƥ݁ο B{~~~t1z[hkkuvH3FRRϪ=+߸5j4GϻXb.o%G"{sn^R{.~ҕշt?{W?ꌤ#Q@B~ƍo:G[qCG9f(|džlDE+lێˢmJl Μ¶L@X{;;'j7GrA}bWo"?f~Apq7""^^>êY,Z|9.Zpwaʛu8|(ZMVKh(Us0u̜AA}KDDD,Hmj7ߖikX}zU}{k=WֶϳX0/nxҹn ƒPyI`2Έ ]=B}:dRW=;.U0%A~ia߾x9["(!v{E;MJ4:f tD,j Ć.%Μ'"lW":9.:X^n0ٞPy`DH%-9dΜ[TOo_"v,=;&=)eۣg.ٗ_Zޥ+4-Fwߴdg+`Ro{}$bx3[ߘ5pItf0$Q{Oذcw}ԯǼm.DRz=:X/Z{6%9eW|&FnzozRDK?y!^}^qI V^rm{n\v+""wsk{bbbW[\<'&O[پ7~ V<]ey}=D嗈rwYtjmmEAa8y0]lO,#220 2u6xx_vwYDD4L/V2'46t&=ƖP(kRLl8K5>H&5U ve%. ƌUs#]_ou-VœZt&_}p~^rd̄Ig9֎A56L֠ k8[.dCiLm[~59Zڼv)mi hh _i{tq#[7D%{L{'tBN7Uʩ[?^LƊ&==:Ayy9L檈hսX144\.G"ɮ{ZMHI2P#vcIӇ=D"CDDD4$曖(tgr?gEdSE]Gi4KO w@ߜRw"O y6 y:2j"//sf37= t3tBD4Aս$]]<#н$::KbvdAP("""""":]ΕlvxK^*vcIDv:!xDRmV3!C'!!!HHH@QQ +\vj7WEDD1(.)Aaa]Ȥ2Lԩ`"t.|mK.TnJDDDDD4x/saYnEϱȠ$bj"T G:DԛT*"QD=6 t[d}nzٽ{ytvv^ƚ饵K;MIX6_gQ?cH*_/%wtulnro"vt/(['77at/<=8sYʈ;Vq=rb8w'4q-TUV:t/9~˝g^P UBPP(UOD4pu(M|qS^zڅȓ1tBa{:!"*ʮCFa ݿ 8:Z,4mj15u@(ʮXxq*νb:cV-^|%\ b"Fd߆c~BattW*FrL=c,\ $bέ;,llJ1[~/ ͂C~Ʊ1tBA@u:!"@.#2"U6X梆(==_Fnh`6d4뎌id V+ ?[3pmg Wm]rzt.)((DQqR)b"Mu/QTf"b$#fJ2VV͵@[[ 2Yd DE+ yD"""""\7-M+iiZ!w}vYѲ.y%` ƒ[/MO. IMNJDcWL#8, R)ON=~MO?λl_w߯ eً͈qpTӄ6]'[;\cWa.|!~Rī‡U) N`anщpÚfOu qjKK.O[[[JJKQPXh httt%%d!*2ʽE#pJ5umAeh=Ѷjv~zW{;‹c6YP[Uػ5v;VY҄?_>{WPύr=W{.w>ܥMܘcDtHETwb4D"A\lNv.Q(>mBBBFr""""""""" 7ADRb{܌L<1HϰNߏU_ނ}Q^dv~z W}Q%Ŵ\p,/j~wggh7sC"tLk$t(.)u/),*DFf "Qa.%'UnuGٹGEccsr$)Qa""""""""""bT*fu/A]}seHN^Rw*'""""""""""wWoF;`RS?p/yݚo7ve?7o[>Z:e$4B0Ps)t;;\y;Y׷~t&ٶ-p+Ƣ+0cא#ו⵵cW_l>޻Fbt/(@vw璂BbDg%u% Dv/!c4vAkrwDtko׹""""""~1tB"R6ml6C,v8cvV{_vmȁTA"DA1mc?9:B'@6G XnRr\R?ߜ CkcHGյc_b9܌ \k4lFUUsIwȤE2Q)'ٶl """"""""r N#8NT[*%%#]`,M Gll,ʺq^uQ d6ι|]Џ%lExT誾B']*[ui]JR/1Z-ҨBؼ+ SO<H4<:vjra0\{Iq#y8N3"LIj6tsmwv:)30t2 [o9MYV<È7[,K)*.rT*EX'B& RU* yA`愈2'\^!""mX檆.=}>s'^f ca{%^B|1gqɼ1oy "6c\ou ۪շŗTIv7mGO< I#U[oM_mȹ,ŒŋqA%/w%D#+((SFqq.ȆB{:!>J[$Wus5sF\mcyk4!!:~v ŎhCov/xɠ+3Ԏ*AaCBhZulݶm J((,ę HJ`v/!Qs3ݷ#`<{yN* hr\L<hmmtLc^Ab~8gKt ajm_wd\Nj*ZB'PI[;}4Y͡O>?V]]]()-tp[Z4 { !N#0tBDP)ǍMMäp7V41=wmE Tj7f6YWae0!scfְ1qp{cݮgρ8OшrX,X Ap 7oT:?DDDDDDDDDDDam tBDN\&mkZ7V3|@ӣZF絶wcc3ώB ogρw\FNddh9>I!xﭷq]w1pBDDDDDDDDDDC'z I$''۶tcVB|#նmq)tPCwEQiE,C r @"*ԩ8|Ȱϡ#?< Eij5j5 $'%k?[DDDDDDDDDDD yЉ !q/Uy*tbX3fEbٍe,MVRۅNZ۱G!-Oּ0,??bK{~Ylin˯|cr?lY+S:""""""""""0tB!tNoɐH$0N,j:qA9vUa;gq"dA>7lcЉbž?C{듧^8j/V~@c6""6I#~RexlcN<t@S[тʹNB#hbvŀ2Dgq0s jڵغm[GA`_غ!''((,DvNKaX=_]}mc}uE>mBBBF G`)q=g>΅d/wiB>KDuvCPǗ˳<9hW㻝v}=>Ve2 \rE(99(,*DAA! E*"vJ,j<* AA#&<2ȃ-?/.+*owwD"#"M.:!;tN'D4eىҒ$&әˌ7dۍM՜; .Qc{lcō_ܑ;OO!~87 /NN[An{|L5I _ںr=J¿_xx7yWesziϞX+NG~~<\ ~1(75<,Ddg4 1GR;Lڳ/1) GD4ujݶ&/Ad-,WaRc\E/ "b+~r/{cRLb<=ъy㊠IN;&b۞&4׷j"x 87 3Cx-KoY~0?yES$O?n&ko`0o9P\&Y0{,ۘbAUe-vEٕ 2wgFc?3:α+XH(111< C'1:!"W*Љ&/,cMum \1Iw晶=vc6` twEISͮ(DDDDDDDDDD.c<1C'D e>>>nu^1PYn"\|S:Z XlWl;Wkkk]Q⑔R!,,lԞ逡=:"rJ=6[,iXUѥѥ7P[ڊ4ѡxJ!AxTsp)0b4QZV<Mc6QXT¢B]Q';$'%kԞD y uXM0V Mh L2FT*uE䢋luu'B(';d䠸H$-3mT"""""""""":!a:S'D48oo|jnjRx8&-ZŋPRZj<6O~1L}vE  -%%9RtԞ1tBþ C'D2vaQ iij5awEC]}m(ӧOGHp>/""""""""" y  T)Jlk6/"Uh+M2(lW4  M0 脡"rJ=@Yy9X_6`WEE+T*EXնyT*Fy C'9S'&h5 M_]Qtz=`0;huEٸym<<,Ddg4 EDDDDDDDDDC'1FNY!!! G]}@b\gr gYlcfUJwgǏeW.eG|\<*~~~zc<]脝N*u?hZ7WCDDX$BLL bbb컢t/(['77~jkkW3utqP3A$"""""rM:o>xfϱV9:X#`_~UЧ? <}ݣyNYMo} .sWP5]+g]7ʁ%":}0tBC"rRb{\[W""":>ڂ(]Qrrs9@W}~(ij5 ( (Duup߽ 7DD=?nFUU[ZWCCڶ}1k7VDDDDD#Nc  Ji1|7UCDD* Ϯ(%%(,,%WWLdyԩDjAmM٘LGDDt:je K9u{cϱG)QMhc2j6+%I,۫8iGVչt:sUt}K&SЏ :;RI?oNt2jH2X>Jeq-UEZTr4ɱh4TW_< PAa2JDJvk(=G'Nʊjl:%HQ&uTtK4tx:U=Cl6RBa{uh~Q͹rXh EmA%ŧj)00BCh1ԷH`QBu5PmP^c]ױU1"e-@.\.X**.&""Mֻ ri`vK"ث\7{}B('srX7bLaaaz),̦mPL'| t&ؐ!)8$cV dQL*)Ρ3TWw RB09jwxO>VukB:߾B#FNw{-ǑV{I9ٙtt udI n;ROԉ$ڟH{cÕ߹53ut#tUҩt7嵆uNv*ȥyDVm>Vdi1 jc W[㊫fo;qdOX8z;!t>é GJ?7]ksIJ, qa eȥVE>WMi_f}(IՋ**c;v8tk1H&ky?Snj5Ӗ}SdT|G%0 Cxnޭ htÍCR8{,Kh .&ODxw9I$/hi/8_FbtuNmd\qTY\L@$Spp8R}}5544β _TWWEKCM[qSD*\ AG6ukCQQ(mn=ĝcrOMG8Fgv(::$ shIɾCE*n0zg_7Хom)}b9NUR}+ 鉙/)/Dvޟ[G6 :TPuo߈Q=Gg ^O[f0Mc[NOh$nvtrGkޔUC@uܡV? *--X/RUF}#UEh5d4[UQ|@ 7ҏ?XOxR[s2(m<D#zTQ@@)dZ;o(//w޾^{l6+c}t.J!!I"NWK!(vGdZhm^E_ELf3>|d={Paх`H$"PY|)e$BÇ矾]lf_Q``(j7ҡ[ZmSӄal{8Ni͏Q3xJKhoh.bmczӌmAhѧ} ѓf_ LaDtJ^1OͼcM6|*)JyODDDGo N6œ[ 8zda"ƍfkl~e]l~eMj၊CI! ?OTg ?Y)q'n4[oW$E"R!m7TT(e:DȲ$2YAKF79C e ݃h SikW غ)凂32P3Yê뇘,Ljta 㕍/{3//|N|\$'~JXdXFSѢ"Ǩ87tP%vޔ}bs+oqgqbqfP˭zbӁ~"TEI &kh6Y(fk{xkX|AWFg6HX;kB`4:Sx%?=1˷rIp.t GV5Z-B'$?ͪ('sr ["H(g,׏UEVSHpp/\n> z}:FΑ|ͫ@I+Db1Z1ZJIO2YU)?}ݻss-7ZkW˜'ORJjZrNf/^3yF:{]^ii)̤}3iWz:L&ǹ)p2mTZ2DX*Ouu)'y i4I h90NGL#^6u?DYA ( w>tגiɴ{jxA(&Ū:~{qѽ/#Dʻ] RR`zOޥ}bL]4BQxD"1}SWѣ̓'MקUOrJ4/*(UT3dwsG$xnMyCmg;:Hߞa;6:,|E鮥,?xcvq8U "_iG-^aNJX Guq>:MɯwMj85{z}--UYYdcփ5::96ã3O錄>l,|ã/ӝye$1=Dڪ S74-GqߺgZ>|_I\7%%ou+;@#5i,nk32˱nB'3 +[8QMͅ\-MvC-UE56R^^=))2LcZUQ~[}<[_QG z^IF/]hNj5S0:l ͽo~MK|G+?l>k ݴ1 ztG?7⍍3]HdׯHz?;oIG/>{N𑖣z=dRUUEDj&-}2ctz筷8+ڟ?$ߞTSWСdI|sMЗ:l,$"J ySs~o,1,1Z^NPAݚ==j[;#*qcri۷s*axs/[s:{[Miͭ,fZtuJ=6'M %=Gd;w2m蔵v% ɜbJ{=4~Dz'iڵ j&-aw8+FmM%N_KIС5mٵs ko7~. 87:[Ht х5SnfZt^]8QXtcl T^8eW6.n,f`G.1 MoOBߜa ׏Jzqa97smY73,g/ ( Z8yW-" K-Ǒ˝'n:RCӳZۿzd r"}uKFr5pD$p?9_2IaqO7|-|S/6ZM{32Hxy5PH111ëRW_OZZRnn.jvt>MB*-\ J72'R' IDAT}͙{K} 8BC{P(AA=gir; U%.IӦFk|d۹g3vGpG,hdوq570yҪ/v#7XL Em*=O.'T>U;ڿhWxMpǁL޵C #uk9-Y{VF&#Gͤr7D_]y±P(0Y~SU{?2p;D <ڼۿH@ޓbQ {gg[daNku\ìT;(.⏛ƪ{}KWw~a""+Æ?T9kh%H!<<#5=/'?C'fu^wNWqjg(eDBy#۬ђg8pò_IkrOItq\ìiDndKVqxprVGܫ^`Vw.LM`YvGgM:כlP!@o^:BJmkZE+zD"QUQA/dZ:¥M:)/+c'v#b :lJ(0ϑfuȕԩ:4O?d2Й3ZΑW@@BbÆͥv۩cœB?7)}ߜb&>ǒN>DDz[-,V v*,,ݪ)uh5x}9Μђl䍵CKB%DmuH$"??2t1ǟDP(hkHo:ܧO;z4UUd(>.L&k`\\]iRq\*p -`XN3ǑbcY8RQzUa0QDkDl+KC'8D K mY\nE# e[Q0X-NiZXX(i[[^>  tw=|`"]x0B'EyU[BGCmX45:0:y:tBDt͠+N fkǛ{~O,nHutXLʫ d:MT% 8׬Ol DD ǪKz r{9:^^$hNR4856'=ҋ]M}R(&ۼӮkڽk1H"wˬV ?OdЙ3TVOfF}Šop t5z}zlb\{DC'DDuUD>:q$Hhԩ4mTbX4 ܵvA8#Pjex!˯("ʹDWGy5q^ L&-ZTFjO}]XϞI-پ=xZ9/t1hb/@,SXh(kty_}qߜ~zbgD+~khm;o﷌DtvE`x&IJBj\8y^wocYޮ[ߋ/640-RF5icȵFg=BO&qxYzgBQ=<#5=F5ilѢN*9nDŽl wŻFgSgjM&k,q~,˹yK-?041|^U) ?Q\x`qG T"1gχB' NDB!ILzk^^\N"B!.pv'@̾w=-VC$ǩ|y.j5~J© ]vzPرL&~ kB߯׏~*+/ ڷ?vd,wA_"»f:12i9@ٱ qK#n!%6B)̗ ="a}7 F7>9 j56h2:=#R$厡q?) q;~Чӑ0m ٔURuOviM?aJ?pl@:eu:_߬)N8ŹjCtdiM(5kjH )PhaYcZh/@|G SbZmh/Z2~V\ R?OnQg?cbPb U[[Io)Q,[ qK{L&u5уϛG#Ltڹ+*^T8:} yUֵNе&htn%):4X!)MYO6-s7p"';otߨL' |znx81vO`БsI" a*fXq8qIYlL^]dҀ͏vwS*;4jiY%*' R[_qrceqhUU;BS-N{Ng8W:Bs[PXHfd2|C JAGvv\bj5S7t@*+KxT)1qu p˝/DZ,FZlKJF Ȟd6n<O/@_P@)}w:=v*.)ﺓZ x\|l6y<2Әj&D\ }d2W;\rJe:+˥@Kx0)*Ca'R. ;WɝqD'/:R.P.@0 WQj]Pߡqx³ӈ)tRV4NtSET夸K?}daDž%H!=8 ?)2c |7\c]D]SSxwpi:!h{ >꫺:a ?'p%0q/tu|7՝gn%biHD_9Sd [Zh)q5S:ukk+!#޽)wo;I}{7JOb%/(4-8q|]yC :R(_cu~~$:6+ɱ*僟o_himP` ;;2!Py9x{c c”~>#U<ۥForN۹°"GBD!Fp}~&!2xMbdp'=Sor:93K. k2ߏaX^F fɔ[\9ߥ)s2>{牍SH$""**{\ V]Z$sV`ܝ-LƄl/jeuӉ:v[8񸡽Z糭X֝5rg6kIJ۽ˡ! Ymym<!tpz{ B'IjFJ-i@.w˯py]$/-$jsdB%$$Sl7b;];uƌCbĥu8̓821 m淲gf#1Knc/,C֯yRS'Qq{_vEtnR.ui'$yAKGȎo~⫇xTZ+N*ݪ8Rqȫ l!J˫7\/_:9wmJoB3mK][ml;Si2Iئv:yu:m~6W-X$зoKUOr瘎JxA4VŚ:<Нc"yeΝ7 O. sg@$⅋F}#yq5Ж 3'BYTZǻ-m.++x۵5nk_TYY1kEEvw؝;VZ "m$\b1њ5tMl}X1=c(uDئlkB"7yRTM۷76`X#ckаm㨶K+&ozw2RVݙ#_ft8N| 9VgjcǻsXVҏS]ݿ(>Yz:DZ`5Xу3SHB|[SgZ;J]ZT3H>plumf(mEj wg]O}>dazsLG *t6=7/hm^aLu'q8x;s@@|y%:NUb,_vO;:.V8olÇҮ?K\Fۮ:C.[[[Ixs]^ $^8,_9i虼[鿸=#ѭ/|ٽ]zq,x^''jiаH3w=4_iKjhŻ^"hu%*d~{~jPɥrDZ =ݙ#5[55 |-ۥrH5:?>׼=ϥ8WyW}pF-qlhbzO(:DiG1ɢ?ys+3͵OzM9ג)dư=W$@.Ϳ. 4Yoʱ[s<.լ! ZcbS׻rEgr[Y\0U;qw.Gw=SW[g}Ξ=:]mkf;^Hؖ[ʜ 2:W f-<`+w EҬO?GYڝrNfRaa6UF 9Қ9T*I)R ޱ:3?c4eu-׽ʰ|Ρʠ{xi%5w:ȥc:[ƬK NJϝ 0,'X)~ѕmoFcr4єґIQMwq@A357 w%g `_y_k]qͿcOн!Twq7~7ؚ`XCA|. uCg]l׽ktS_OimXRJ:ij2]J'W 7ҡ['2xDb;n[sd~6Fں{XQa6=ZpS4xD^( Wrz}~T;õ3#۷Fﾳ]nI$hSAqڗvXM Ð@ !C'CWDt-{n{ȄecO44p8Iog8#^@DDcW3ڶm[m[^ӳ˲XOg? yu7=ģS)./D2WSHA>)t.Nw37,C;D;5+>t#?\`-Ln&,Pq$@.I  uҧm lM濷+ZuARb#ӳ¾ۓ3H[ JD$*9fr(RdQ5,}tʡ̔b7W~0^y~"vQZ(bד.Q~KcP[_?wٷx|rnpt;r?EfhJ *mk1DD=Byzmڻ?jڮՙ8.lKpkMaM5jә,ldB=dTwOv J^E,ɈeYz3ץY63oD6qⵙo-^7kpMG 1[Q93W)xF7HDD\x߾[.?VruoqWY%K&1a& ;pD$1lrV&W9[Ͱ_7o::!NҨC'Z/2x$ 6ow׼CR}]}H,Pn=H,R]]yFF}{ypҸsiw:B IDAThaJ$G7-x JO=O?.={BEsDJ$Ix!{ߢcWM**ӯzoiw;JJOQI6OI@=dWvE~zݶyݪ0˞;"3ԙ K1Z_)j:YvGk_yy޻ƲyWC2J$6&ʰ!Dd! OL~훝9ϒޒ_n~lc" /̼"QH$ԛLò-ʍRGA笡 O*uuVm;DH`1aـ ^ad>Zup_>Qa_=͎QV4f4[{yJlrR 2+jcYrљCS7#<m%ą>pxP 'm~/$ 2Fm'N?ŲidaV=p!X$h  hXgJ'^Z\5T$T_{Lګdnk&SPP7l6+UVPiiS"6VE/m.b7iPJZqb亹vI5z&V모6'BZsG˖C&uRB3fER}Њ7єH$rfhh$w>'Mf̺xs S3pT<`ٱΡǿ :"mLw&bmi}TأwgyZ&m8mL7RD XG{{&5e5>\2@̖n爄6 6Y(8K%w%bÕ[[}DRƎ;>9^N6s'6Z9f[XۡAڲ 5>F;6_|1,jRM(Xb>u=Z.A7UVE.}nj{q'ieW._vlɔ,׷ēkh>Q[^`s:6Sʥy1a%lkn23צ<^uO_7bG my*zΉE!V9ᇨ ο};ClDi͓^xx'TвILR8mp'/usB.yjo-*f[ ,A iNB;&sHpxOX:m޾y u݋+a6j$>yɧhmyyUЙ6mLϽq܅3gE ny˺b DME" +`5 %?%6wՖJ>AԨ#((v;w82xsP e* ES[:IZ!?Gé[xRRysZXmPD~~-UcwNWG9'әZꨱ!BI z$PtL"%$$}jRz&{f =>翼,ˣnN'DZxхPHIe9os˛TҔ+;5d T!)d⺞ݔ%7WKh= !G ~K3|chf~ .߯b>{:,N'j۩dMyl 6Y@b( JEi\33۶(!5>& H RI}BZݧ{hӒ” ItNjj[rqmBV5OTk抄N.}lO{)%5^F-dK"X(#I=JVE(-9*h*DH'O$""Mn8.5 mBC#i| 4>nI(y~d @{,lh^\ f"N?ks:B'3P:Z: ::!NsT* jhhj:B'3+xi!pU:8^\ @C|@ݻ7d2Fj: \:Aö 1 nB'Yv;B@|mhGRX&b% u:c餺+*X @!t>î !tGl5d^3:߁u:wL<[jZ نNT$a(99<˳X @!t>v{NIRc lM,1?.(,$JjZN:":1LjZvNh_IIIc\jZ^L PB׮!t>!Љ &J͏er+hNgn x$Yb~CFɋB'33'@JN4 xC|mNzXr/U:ϰ B'BBB(:*<#t)N t RX&yC|:^*|Dl~|1+ˋ R'-*++)""‹@SKJh.|Xdd1g B'ɳ:JKK2%'%!tB'3!N;tL"T*d2~ ^ :xh:Ng x ád:{,ɲ^\?#]1DȜ@G N'x(E":#tp=I]i4*Z.Y u#IF!???/V A'y khPxp]@{tV'MRh2QvNpB'3B'^D\ε 2/V>Ng7:A?&$r{B'3l; xT"1?eg{!t>! :INr9L&/VNwv:AL*j*,*b5A|:HXNdr*pB'3l2'hu^F\.b5A|]BO"I6?!tNg`{舤k[d^ns9y[~Р'6K;}CcfMl>@GԵkWDL.b5C6:PRt.#xCqM5&X=}=9Ngu:!NcJЉL&r5)>,&: s`@$$_|4 y"Z'VsyT t>î 2'AH%RcDr)W+ 2 TPо]DخlkZvZi57g:=qIGǁBΛXB|]d"""<´vD:zgu^]7 1u8vž B'1S.]cy܋6"B:-vdmc^|:@G&$_۷<;L&q8ȆB:l[?XdRRrKtzU\S/|2+QE*'rK]mtvOkdJY]5:ax@BTXurfoZCf |4q鼲K1@@7oTJ;s1yũWk]k4]FSqF13&eX:A8[tYZZ7\*SW5cat~|^uHq洁=Mx%׶hP>3+(5hq">2L,*Կ˯YUXN7s5%glm-ի-u6ԥҴZ.F5H \E\H|g \iz}U!Zb߬+U}4(b0".򹜺@Ĩۇ%zyqUrEJL#s|N]lP@NL0A_g'rK){hHD h\2OP(,5"{pIv|Xs,۟5>Vd0M&V@2ϫK"ė5w>'@|C@eDTҕ+WŖ;M$ʭcLFId =. cv+n۹}|˩K4uO kd|o{A8 *_vvNdrS騰g,q̢"!`ިhbEN="+S\p` oj}yQ^i ;giMcmgTk5K;}#Oea'/ݧ7BRB9Tnc?û/)k7z旽eM&+ QPd{j/oNK,=,+#vznQ-U:4KV\=hbh'J|ٳGH?Wgp<7]w4eY+óKjh|6$@xnXr:ZN(yqJʲzV+Ǟ/ HYcjIeF*_wnj]EˉNӲ}Yڈ`Q[soX<@׶?|ѲZ>DD UTEɧ@?AȔe< NTRj,:/oWk6emE{2 "~;DZ,/GF\nHoM~ IDAT=oM/*76mV𷻥盻Ao^eZRr ˙:78W^RBdpO6a1(~?mY%eyTòuPF8<x}Rm:]yn;kF|JWSm\xa4\)+Y۫ڐ{GVqU@Il JXxQa CƱe[:qaT"!rH <'0Ix{6ݚW[ Z!H3D&c480XYaO  8U3M_]x?2ͧ* ?fAǎ'<.^' 8 Yd?4{ڣVE7udU(ppDB~^h_ eQ-w&H$':ܮN=w_2x|Gaޕ`032hTSMy(p"q+9bpzH)qt(t>&s t8d 9zdت!ib?2)5#\,{2k$obt"ק/7{$-963"u.UNm1 F9W7+$o0XfgF~壢UyNGNJ5īۊԫ %~rrd<W~!,eVLUiSx\N]f Kgm鼲/:3)#^5Wիuϭ>z׮,Na5BrSX^ɖ˯ާ5Kjx鷃Y9P[{;*cmٸ=%nxhR,k:[Xv3kT۲>?SX3q}z24]ǜ\~`4Pj{?dOO]j{.j9'Ǧvi~'blAd4̪ò.2 _*USz5u_g.`Y8fF߳SoK:wWyeA,VPnm !tKZD&yWϑN1g|zAm-#7SiiݱWʉͷtV:qˋ GR?g q EFv-ij:{f?]pҩ DFvI{>-f}} ؿL/hp62?4hD β,=_G3SC-7Ii6x"%&9@^}G9.׆rOXD<_z"zȠe[1pqOz]8ðu+ܯ^(_O ]kGW5V,viie}E/얠5#?p|/ &n  {G4<9nu,2~ؑeKTz 5:} R|.5Trv=ð g :ZRrZgl_m\.,'|ѽxrJO{fUƏ<[}czN XH+[p9%-1蜳zԦ9HD\ Y/sk , y;G Q9gfw]ozVU>[Oe-v =9eABL1\52஑)D$Cq.?J1kmm5 1n@b":pŝZЖ:M,1?.++BCBX@8koH3v>~uR*k멿Oo>$dkZ5]f떟/u9pbKӛq9pZ@~|t1_EpV5fd}kͦoyv޼\~TaGव>wj.12c7ȋmɹFmsF3N$9[hrjn i]^HAݿqemk\f9ʕIq5[]R5xC5:c\n?8bսEn9wn@ShF"W=YSRl9=z~N'3C'^*nG߭er 2U?4mX9 Qaԭ[/JYG%%ytV`ӆFS^C(44R.垣awdĔsuMH$N"eӧv^m++٧!>_/_ߖh504=BB#)$$BTT[[IEr=Gt2MeYT]mݙ?&6 Lq)((AiHVRqq.gQƹyuߩ?}/L_yjDyjUz]pj\XѴnG8u"68@QQ8BQʴAn 8Uo9q,MP'8\ʪ蔣+\HLs7VW:)=m?`0 _uZwA;,X=jΌ }0Zja84֙ ( ɑD&.d?7!Ah;W 񝮽i}T[[I??yr^&g6&yHxx,-|a %tlJe9NtMVV:e ޹xqMdY'i_KXG&l~yߝ'G4:cl^i̼ڙk5b3Iq!Gg NJ7}9zwv+ Rhp;$:#qjW'itj:_[FpZ9w0l\h^vwsW^iM_qXi|zgcCTzw-H'a'$"2XArKxwlp1דcj ƈza|Xh}HPT8Wv}3g'I+ܛYdn~]K^u6b ?JЉL.r5a0艈{L:_C_=kq\zE4|D9.3zAZ[y7#88Wiۖ[".8e}Vs=K;LxMx5gNY6h͸uKgL)=<>6:W42_EzXEz $*Ֆ}+ j!`4LFo;B_1|r5-U .&}qN^R^N.\~e褼Vݚl8`0ĖsݣC3=y O;YDn+u h:T\,tү[)cxV?L9;M2h:fU?UtX{۰cAG utDdR(]UudY+ucT:Rc.G}lYNTV[ѣFJ7o eY[+nA@&\.QIJ,D"w\~\0٭%.(:$鸧U޸wWPQ;Ao4<Љg I3xƪ:m-~Rgk%Rܢܡb-EU #ƾGrKU%X:) L[z}g.ߥPjD(.(7f;~bYRb)U(o\,ƍ/E̸^]#31;!k= ^Wk\}xUzCx(:t7 v!h:O*whKyy3-% Ӗ?N#.t+,ahϵ5'&+:6f{ࡓiǶe湜3NC':n.E'_q>{KӧYt: 9n;^x~{('7j|RmܴjN Й'.m}Gv֮VoLg]c?(n]wI/f=~ъڭ}h_Y ڿ{5kҢ/_'v˼I=jk/BSnjNӨc>s&=]]ϷKJEڭŴ}N9>G[6n[ifok֭\LFO?k_۳O?C'L34e-5t}ٝc SAa\RR;vk[ڷ˥Wحݾcv_ڥ\vNkvk?(F9Hb1wl<ȺӔd/Ynr=[who>:hӉK/W7:nۦmF+jE-:UU*Z%Z}gV-o@MnKĘ:O^ jޝaB󫛧3:rwz_[e5Jv*Z}Xn K Q5wOo{QP 9uf%]"LcǼQ)>_OC|mdN#$K2 vf4(==V]Cv"?]6"tKqݛ_B%TRbInAsUj5;tm``(q8\6CFL#GX=V7qsr_DzڽM!!8õ11;wONj[Bõq-!kl;4nn;[/  0õ>DDѤX"#م"ޠLDD5vk}juԝeYkmo7ˣl9%%Wŋ.[KD؇jõ59ecv NMe?OrU.T*.]ʳ;v:פÇA6,Kw[갎#Gmܧwoz .\;7!"IAa:~A"TWW5kNM Dr9v=ީC'N p9C'Y2U(6"Ҫ}EXvIvZB'I ]] ƈ+s~c rWyk?.u aEB~a_(9Ϸ_NsmE/1yiQşDZ],Vx>QkuvE5h/FZ͊: pu ;P/\ñ ?ܹXŦ?VL""ey5Jmò+<ܷk%'mn_?Ϝ[,8,Kj~Ĝ__Z"Eӂ]>m]gz综ou8˯Ы/on6֦J:]^KD~Z׾o;;ﰻ7P}¹ x<*8˖r䕗^sSm3g: ڿYakc|ވx5 OwC'MsF~yʏuUWm +ί{v~&K[RhKjM s՛k%0ZW9<ؽc{nܯ['  7Yh80g':<9>5gcG:zDlb0[eJۦusQ!BDbG=:أ-zpM9z{'N"A>]gSbɀWqMp ~\0ymʰӭU )USi $ b0N?65W?;㍐@~'n8x5JM/u͔+^Z~ /<:/n(W tNHRs2YκXb!xVmk +Rtt'KS{-}n^jIB':~_6zSll&ܰo+> =ΞGԧHw$%%'>_آkM$r~/0I@ ˵v):8(LXhp@?wqIəDQ\}w?Æui-0.%"g]|tܙ:wƸxajíYu-jg|SFƧ ;'^ <-#R3:5 C| IDATS۷mrBg-mXP !-9jk?PZHd2=bBN|иmyݖ QXQ/!9Sz8\rs7RKux7fݐNDDDg/?*UT=V5ѶIua~5 oρCzc%W]qTvu@QeZ.IJVvolj{]:a0K@$I[drbY7SD<˲ՇKݚw |q%z᧰v!t a{>H%RL.C\jE7|3͝=vں&pѺؿ.pri`xguMH8 'owcE ܺ&˥;zƏK;v#67˲$"g8=gt=QϞCwi5$&5R(*hگh44`X2~)L9ea"DcCg Jp l*t63A5:4lU7uPⅭ.X"?Sq$rKBimTYӖd]挐%qM!~U!s C^ )Zm>V"K%5#=Ws?&|B~ I.;IGIQ+;w[&kx|3v6;Zʺr!俏~nlsM,s7>m8" :5IP_Rjj/hNjjÒbA*.UΒlƇ*:aYj?HzN b~{9#[O׈={3̡ʃ~hެZ1s5Jm?Vð|^YQgh"w Bx,Y֣pB'3C'H@%INǎߝN5f:ڰq#UU9~ecW;fϡv::tR]]J8D1//..79߃{ЄqJQ?B9ghoiϹ|`J4M]mΗo4  s,*' ~ZT帠veh~;8ⰬޘuCzd/ѥ ة{t^/F<㞛Ka2GXYkn΢{N斺UiکsQ!vhtN:"$\-!BA!!!M{߰--t5GRz;wv?fMNu1S85`X{B7sTQ^vHƑ(zٯFZ}3z <k=rۇ.뙶iשuꡍcR{/4п2Bo (_jU_3wTMeyú{U3^D8si07K13-.,@BtJ]_^7AOl\+-Jm]Ò^}XQ>,\}qdJՏM{*68@:}υªQA&vokz7foHk0F}wn{tM: F=Iͯ q'jƇ*#+#*&' ʶ `|g Ui]ޮUiS\~Y爠zu:p(idY5,Cg猐ڮW!5Snb>"|zŊ=G,0 fI$Ng0d,;edA7G|^={k\LnƏO\uDh11])2UT\1ؾƎk5k{S\{/\S5bui`_ 5UNj-rrwIϰxp\ѣ]pdr/W\ww²&pDK[os^)f]regvzEDD٭㈈Μk5ṇ݅Գ?GJeeOZ%:Y 9'g[L+SܨcCTԂ%TMi~S;{_=4~ \wPR0wQP9A=yyCwNY;k QE*pƞ⌴-sFS2  ;קkg<#^[\_^p4xD@ H+hA$jmCB Ûw .U[` J*li-J>)X8]*nxag^^j!h4p*@/ćñcl-;8%jzwA7B8Bǜets wrv}cvΫJp?_36jTjTVcZʚΔ Ddxѝ:Di~Y0yA}RN/UIc` 2HrT<. 0RLJ^gpZI8mv-L˯uc 8\F(EqaSt?9mP;{Ӗ|<9G/Tՠ D<[Dpq.?{w湿ZZ %6׳m휹o]wuBRRhI  v/LEQQ.VE{5q*tRYqq>_-}3h Gpß Eeނgچ&gf<֡_C'6nu 5mryEkt2""jZ-WmWDѣFaڔ6lP;iwT`ٯFNSs<|j䄶mW>72 ?6cG:|,BFuă(t+X,)`gk\Yo8|dU =ʚ['!tB#=扏WDDDT7Wbͺv5 ǜ0s 5rTW݇h}ͳozO<쳷Wdb܆m脩"jr9td脈g̝= yN˯Xⷵ>fHH$^yvKX%;n1Ǝ[ iWP\|LFxy"(:ߡ}u}~3)̞$23q-+%%J=m"S ĐS1dTN4\hEah!ڡLP>n(.Giiѭ_@wT,)KX;;P^ev^}8DBIjbZNm0tBD͑B.]%L&OQ&d^e~}.h_.!оC01wf!""""ͅy_wkOx$7<U51M!""Qc`!fa$$$S*""jj*ZEEEv簫 NmX_ 57 :Q&(]\ 5jBDDDDDDDDD ֙:!fF.Ʈ=ʄWCDDv92oX}WH̜6]MYZZVeQ ը]]C:!a Q+_ڵk qaEDDդiHOKDzZ """"""""r9Nm6:a脈\nq;!1""7LWٳf!]M 3v5!""""""""抡r Q ͡e=t5 ӧNeW"""""""""j:!aEՑ"ZNJN^XT[  "a::!Ij.;"""Ʈ&DDDDDDDDD:!a9:D\(b ǔ JNYEW?W@RgjBDDDDDDDDD-C'6^^"j|}}.Yײ :E g̝3~~~\!Qa܆: QsP͡e+쉈~8&NĴ)SqGލ\!k0tB&t:V1tBnC`}1[Q v!;;ɓ&ֶ#r+.E`W"""""""""惡rX/  h9tLpq5DDcW"""""""""扡r60tBD-DBxWCD8sWhaW"""""""""rBDTѷ/(hݪ +""ZEWeGRr9]M_Fiyǽc^H⶗Lr seMU8\Zq[$N-k+ko3[L[n̏\Y)u9*]USCy䫝ӏ%]{⶯4; seMD:!a:S'D2(P*z(C'DԴ8d)h Y :DRu>>P% ⪈bl߱]MYVT*déAxD;rWDDD1tBnC`= ]p@BB+""wǮ&DDDDDD%_+q6cCaw1tBDDT5Nm d :Q&(]\ & ɗ/۝ cтҥ+$"ZFzXk3۷l>}@ŠJU 뿱= d. N%G__MKCYY !"w®&DAUC;Pd2/ŒF9ֵk)ذ+vM2tr`\N3 l"C'eL0C'DDDf>}$BDDMC'6lC'.*(母F#\X tjB~֯ W}֨`zL""""hxlXذC'`ꄈZ.@$`0\\4& Gիg^t:Մ}0tBn*suEd0wHHHDPP" //֯5nwNEW K΍\! C'6I"P(̡e vqE7]U@anŘ_"cyyJq΢޾2x#2OIoSOv 2өw(||KDDDDT[rk Fq Ym6TyBCӽcθ<}PQtH@Y2AM{KQPibC,,^ձM]!Zg]aǹ6jQTcS=/^[\mSѷjsHŜ٦6Ƕs.e ,*׶-dQT6;m t+o?OdHX^~;~E*M2_3$"(S};+jz˦)_Pdt,*ՄFO! K YwƓz_KI0{'Ss4h23Zɖ<6]R;Ά'Rsf4d8#d߾w)U._/;2 KGНqiVy~;8bםN5KԌ6{g+we;~zUjmv}~,<9wgXr؇ODp|'NOLc55u "P(,ntltV澸FfZ^uOOKy z!~ĩS#c6???̝3׬Ŋ`9 ݟm} M:N"S*IĢ9esv骱ElzN$ Ke| K5=ng럮"pbE9D/P 0L4zC7 %'?ؙc+bON^&x$)2(Vύ!e~mA?@'rd2ID$EL²}]ʸS YNS&I&ZV x϶-tXm9_^D @X>Ϥ<2磍8sLN} pAhӺ5rn) ^g83OKAA mjI܁V!cF *-TEjkUסצx;?^"Tπ]ڻN 6rf7;~(ʻ}! æ8}]mjՄZyEV%. PXҲbh4jH2x/"Q| c4PXxEC`P[H$ \Ӡ8%K _DDDtxeVbxװ, }#=@ow< ^"S\v릩]ޝ#*GDGK塮ewjpovq3uJ^FYӞ}&]UXQ1n4>ڸs&efވ 4Qm֏;{$V<~I L& []=1w̏{Ǧ(ZyL aA7ۦq=#r*3 Jdo:3pߥZCFohpS>aN%/1LJæFv] 6q*~w_Ԝ]u>c(3BDDsNS ?߭gzg\^탏'a!xY춼_Sq]TNDBj/w|ڔlS؞u=xH|=,CiUw_n}*%1:R5gͱ_?:v5䕔O8㥙^޿S;gw?=˿.eNPmHҵ<& J9{˰@_{wߟYPrlW~JkBR<zX(,?Ꝫ5+vKG/:޺KDK:DJRUL_gm]}LcwܐYP/v>[q_vav_tn눏4~Wd7hs3C'7ѭ'={ȘKrD(t_ZUxovE};p<ځ~NI|ݞiϞL>]b܆\ Q qAtb|ș ˣs;t(X=ڡsvXP ] z#>zr>X{7"cj\ޔR|-wC'  hȳcw t5*rK+3 >o); }[(WrCm@[8LsVF-zFhuƗzҒG}؍ Y3^;lY'Mag3! }N*[pkE_L~bL5/V^i4NK,|w )<ݞo4zC+0Mޟn:5'#jr{܆u脝N%o-++sߺl*oXsb-2S~ׅ$c?"R8Z?"BԐR^{FpPP?S&G;l'kblX+s0pBDM^~۶\e}ݣժNi4eX3|ރ.cﰳg%T8yKZsg8}wg8ro'owDDDԸ?=T6RMϸ9gi^˿x˕6Gm6Fम>X<7P`n \uq.VWd I{Fv[J/M&6Hq LV8Xk?C,mc{D|ܺ+)gͬ<%$`# SFewo{屸3ߜxE;PyzaYOT)BكcxH-։K͛Z|$8sc[nw$pR]B,oBVt, Љ !"j@ d+:[w9ܣ£[{"lVӷ=sߠU>IĻz:L@Z d0޾2Ahd<]]˘L@Fr.R PWP6>ֿ<$5m۱&zB1 IDATHs@ 0w5 /#~|bUPb@/,B.mt/$)JJ p\pWS-9sz~@*ǍX'un~o/PZZ+)q&tZ|QԹCڿo5%e{ 88z@ǎ1 NEt:W.ij|k[Z=^"""j˟O7#>= ?] r'OvCܾyhL$POޫfk]]#"z{XvťŌ~$"av9:Zk9kg'fD8ko.v a]ÜGvMͱO}[ hH tv?OMc}Vc2.PbVЂoK F7h6.d sH(({}m#۬;1Zeфsmd]x{Guz^M,k[n0@g0-;qψW1tBn&tW5兲2B'\Vǁ lu9Cx1) _o1¦6/Sicؿ"r2mY @;; nb,|x4J/mCۓctaݷDZg^t݈hZeŋ9ݍذa#VZLs1ct̝5:t;Ͽx{a1,?0L(ȿno J o9jz Q"+;CBo͠a~c#?b`X{رvfV|~#ꃈWS7ZNq}aD6̝4N؉x*U!h4࿟=>_@/5'LDOϋOϻ Z{ ouOV$;^/ʱtMLWRnUP g|<[qjm9tRU5Do rx"s(%A;$f|;KvovEWxirZ]1xrЃQ+L"-̭'gup6t6HXƙm633UZ%p|V+9ϥL2w`gyx=.䕔;̌e脚#N}py"rB8{fh4B(jlKDibç~7lJ {7tڛ'-K8%cvo:3;ˣ#+'3ѵbك[]R& Nd҉ SN^gzC{hR-GA϶LgUM]zN8sC6dhj" 1̝=cFX̗D)(^tqk,zO ?,ȻUO*YY;ϥ۰~5 TJW۽ri,s @]ph-V5ЉگYؓdC'1y&%J4xq XkޒOP^=v Ͽ nw@]pB۰#]MZjӦ Q-`4TNCYy94 .^x+޴;^T=nW%NN*x{??_nPVV//_A۟n+&O}ېyp@^I^Ǘ3w]1sY"""j"?3Džl &DEeظ9qWsiυ6~'N=xg!e [y)QYP"{C &kt@;}CZQU *S˵zʷ}(=d` ~Te::ZcxJVu+X>Emˢrj>DMC'6q%DD H.nӋw$bl0ٱȺ wTMDyV[\zR.{dMण5+/J-J3`g]TyʾZ6N|e32 >aVBݞqWL&~w,CF7_xzxbyڽm]MSk4j4Cј7G@5WZߊ9%%%5S$A(Xc+_Edd7\psޣNWU>Qx{;H$c;ܸsgvΝ{ڝ[ag`ͪq׉ň;wNtj?3{m]/L6bLl޵h1^~Ѷ̌ٳ|;\!o߾/m.y_زmŘT*{l\ Se?(.+b҄ cZ#ƌ;wl<36<RZ{O>fG|vYI$lZfWߣ"#",J<ܳ6sYN1^ӧA$y / -}X.]Kl~՗طr)QXfÏ?ڌ/}t %&%_H$x0d`qGfG¢ m\622,;GEF/d3ǟ¡ÖoD"ݟamhbii]0oo1f0_;d`̞9fÏ?Fֵ,x'mb8n1& l:|׮>Ïm۶s323`ԩݫŘhfn>}1y$-;k Ã?`3wƍ8sŘP 믾j3\\vsעh"ydgg?;;-bh4S;u=0fߝ_-Í\AHvX`܃DFx+,klTȄۆDT{Bfw{ۼX#}#Zt0Mݦ.ItzL(*JD"ulaMRk rOyS* 9:oX̖,KyIDg[tWZC& E"]][T,U)ϫABU`4YtQUjmؿVgp:ѐnτ ~̵7_ ԎV>NC,Nk}MW it+UBwQSOmXN鄈Z**{{y~A;*f^l퍂jv8{^h֤sBFXʥL6+`/lVcʼ'cSC [^ܡK+ SwZv:ߘ%7]+o<]Hx[0繡JUxױk.d¬3cjʲ&fϱP! x"boHE8⾲2G1rKhQ \|ЉP(ajXI#ˢ_pn褨(Y5שU٧زXC'NJevmY@ ;7 ~@m۶(W^PRաҦ6V^R Uٞ_h4v疖ڞ2Lvi?u92,K$de]Ko34je+ɱ3L8rxddp3\`}9˗Sl]U(;;;n]XX;v،2.hwnP,=Uzawŋm-}۹iiivX8oM$??+Wۣ{wЉd;W, ܵ XNN:eT N.~4aMFnݹmB'& [u:ٵ{V}|B'C{@|ZIɅج)) lB'gT]d2I4삈wV^ V񉽔5o|EF}ٖ3]{ahO,xHҽdbP-ʄBX\r-O%\"rPXH[?w1N0иWѯwN=xi!]I$\Hl^t^^4^g0D?oYklWC*YL6hlFSy. -fNH(V`2gexaKl[B ;aۻ?7&$*^tT+ԥZ?IPѽBٵMުDPG`sêo!x_.m.S?5NS>k>P9&P?@ Մl4n DMiPjM9z{[ s>Nhyb%"qFXrYs'-~%)1έIT'w/b&U[׮ؾyCsRsQ^yb{؞s`ǂcccq_͕Ju{JKK-:lTϧWMGRg?l9XUSNa?@Dwm;eڌD"sֱV[$/O} Ϸ|ѣGt:-fS'eBݹ|^ WnLlT:x0>^xXhXxvvfL(؝[= JJ,/:eMȥׯoFU&ջs![ {`.!v[Q2 啔۶ѪL,}||-#Q$F=*T|rD !7-S#3_C'^o]Cl8 <-ئ3kS;&qEن)!ǓJHXܽCkxlX^5G?A[ЉJrIH(Xϑ &9oY?OYtl NyQOɭX\M %C&CLjܼV 9{(7-Fώb60zNwIuNￂ~cl?r`pIuS5_yR5~aDm,OF8 >TtP֒HRvn~I3QRRJRZPj(-+Ao@qI FJT*uzABVC]VEii) [s U^K<==!HH??o-[ H  R ^^KP DAa!~]['ڿ)48sz݊qzF`uJK>nxIvt'ڝg$88y[nQ\_ 2Y| * ֤RiAk"&`b/pT݉*B U 2a'u\@\{АP]q{A:4W 8<Q:9СCAk?αs`Aۧ\vӵDmu )%d# /\]7+pbE|=FT^mj9GFktIL3t~卹Wi-bTd)C7O rJ[oT0B6qwM&HXƼO]vu+,jYϼT,;% Lbr7V'~yr`܊u {"J!C'nןԽb#խ-R.^7^פB'K4 yJpSULVʛO>BkO5wv:+\@aA.RT_F>UHlJUh..1;*ZӚJUX/!""g''!M >5HrI}.IQ[r L5xIQxutIVԜɞ[AARR̈́h\+P <֧S BXbi7oX2E,TlMD,*\[sIT ['%SD˱e͠|c,*T+dGͲmSkmX](+a}m*jj!%Ͳ8) 0tsW<{xIlg_gzs;FFt<ܳ5ڍx1fh-6pR uea* HrTA???U_??? ãA\׉dķ_=9g.\Rd2Loo CKJ.є<\jGH*X 'b#{W8JZc!3ۗ r~'gok aDT\UI,FqYwX&_ ك8s|(T UݦPjt}mљ?t)."ZNȽT>Y ` e7V1~[w:0P$5NkϠ7bڋ`}-\7rV!8wĻzuX:{bWy_ҹkCҵa-2tҹ{; wu&~v?v_!JTm 9޽ ߢjT* hn ލF䈦[?6HwBnBԶ{Uc˦TPXY{j !""rWN*o{dDG#w3\w\Sg+$^{!6h]uUKk[ZۺmþVkնv-q .#-0d|<Zu'U+wpچ+wu㩰xި;EG?طu?+zɶy=kG5?W4toLke:e2Jt(ҽRw.ݯe[]}kƶnt^rh*_Ӟ.}R"3 7,鄈vB'E!5a F>ZQO;Y[N{߿B dJ,*uQжkVAJqu*&Nz66ָq&bo99ڹj4[pttĝwn u ر;}mvŌVA vVyy_rs%:ë}RkPEDDDnn%??Ra#S9|)ӹn&(x5p*zsLQ˓WP wV{I5&ζgSy ]t&ec\?OWc{:vVR^olVúy~Y IDAT׮ "ēE1)iVx#>:jQk.K6\sjТR~n6v_/@c7o3s^5Ӎ2+FADTӜ`ee'k j.t{n_I67`l;R(trF nF'[XUʌu!=xcPڮ^W* RRS NV]5,k{RYT6@[[[E"XY[C"R&L&D"5Dblmm!akXk+kXAb!1tP$ D"=LV?{!9vt' NNRe~kR4/3xLf-"[[t4* =N 4V ٟة٩1ay5J 3 :C$1#)k (=O3<v9. ofUKljУ=goB'jew*oW;tQ+>-|'j_\rH{)!s7=ɄGkگﹼ|ơD,T`*mcK~gKDEO+suճg~J\eNWtpQtuFB}U <2K Ya"2' qB'ŻXJVm,}]0yD#.Hdžwp-F2=ai-re=b)D3ܹsZmvz,L u)Qq@d#"M/1[ Ǘ\ܻwJ߻nȵy $ ?_UrADDD+ $$W{ӝ5k Q9j}wf u_mYO~s1z1Tuzm!}>#VgW\9 R79tƞ hC,fIR{yÛ%gp+d_QMS <ǯ-{2;OǺm>~ݨCH( qoD-o;0DS$vZ V:`wej./r$0>-w\2+ 9@\|< 5!_A+F4Z̐Xrq/Pܻ\{Ҧ-@$4U:OU癳|5Se LHYٕ,L%c _iˮ7kޮRrpP Vkg[.u\pqv \DDDT-rEʇzLy_{ǔZ/:IUupݝ9.E9X8魡]WXtV{ohuF-y߱cJh|6?r%z赸.7اvebfCWڟ?>MW97P7"wɬ2tBD]p衅DZ3TDv%h${vJ5\=};w .Ѿ6m:EuRSv:!""s )SQY~TtTe^ȫqJo+\kR{Q={:U׽pZu|ڲb:ʮXIUV^{z^7<`a#&g2+=n%1gE@Ѻ\OHPbN6&wkNdim#I9ߞM"[=_wO/e8ZKJ%LPt|R]R끺D\1 ^baK:ˎ6XqQPAOn%d Tj(t׮qzI2?lӗw"Q^n~cjVZu)>5 ^\)GŽS<Te^ύW{u(],,M 6JI]o*^CFf&d2᤯F/~.DDGVߒTxn^^6ojwY_Fۖ6#ԱIa_ø~U/pQfkur%}>o׸ݟ.h.hVT4Ƚ'˽̭$c7dXf䩌8XʲKwEiݸʩ ,ĢE62 |<\{YebyYq6"@)ӬdI-ڝ]`Fu${=1bvvʻ`fkrTC~m+}iHWd.nP6 ` Q]2sbƣCʨn-&euEO¿{lF3~ѣ[wK>k[ht:=$" B$̲Z$[K5opmTV6p>ƒT,*ȼa^?o^3ec.Kohhz0B䀎~{ o^r֖^r?79+}Fg_kuzKP' Iv my^ݼBgx^ N' U^ǁЋFZyU9pTO8{8ְ`%\|fl/Lcߨ{]-[:ý3n=js siJ7BU%b1D"T*5߮ǰn* -+oݻ( :mtCCfarΝ;}aJ'O}:ug^O?.{|ڴ;{gd+q>w?i884,:~Gve޵ް///W?CWm..FS,&ˈ󇑗&Ӥ[Kn-]3Gc{i`OrCe:Cԁb*3AoTPf>*UX)Bڥn޷urו0ho'[Ya$j1 ~G>ǫ2AoRZ\$}Deq|1?[+WϪ<.v/9Du{d=*"- Y"p]$\IJbށo_&>6 ˦o%S> cúA >a,N.#`TGN?/=Tkg"/'h_7[-AP(YOohڷG` vii"Lf_+hY7ƍs ""&cUDЬY;l p \\{FOG@ _k`ii?2-16B7 4=n$fXŧeцAUBOꑢ]:!"[?$7dV|8w=Ě0sϥNyA|j'1hfgo{q^Ta-xqn~;;>:]˸[[ïsxnll+}M''W(el!0ɻnYKu_)da!?^ܛ+McGw"p(_;/'giizS~k0=vHlQXP Wط=PPft /*"K# Y 0rBDT5ۯ"_1\KTsB'Z}^Z` bO|g~s Eyǻza;~شCz=p`ErVGvBnڢA9g~ ߿+WVjnn0&._ABRiu::Qe 96hX]/>}Wz^AOd٘0qvu5=<`kkgaTyِɬnhޢ=Bb؈W+uwg}[汶maμߐ۷/###)EѺMWX[b,P~~#o$ s)) NZ H KKk4hn=ѰaJFݪ """"{tl`#{r(kӱn?|~Pz?xDD C'dVB'tBDT%ŗZZWP՟-Χ_s;[!355\pI4^Q*u oH,ĦjnWkJ]F俉V6?N#ɰjJ0aYY "cX Lyy* *4'_~KÆL Ƥ`gd "2a ; FS"Ͼ^^1lP4(1i٪٪/@ۣ7k^k#":!RtN*/>& }57do_g 0h_WFfiK[ l.hNlF*K7)Y8s0qYHKΆD*5:»_3pMZNڷ1tźTGnovtм=XO\KuƢ 9(HǨch 0蘣FÇ###P?Vf%&6k]5߮5P2-7HDDDDDDDd iy]zTI*g[Sc)D}j#":!N'DDO߰7CŵhW,w_s5z*sfܧ4pG%m{,#vÈ*][y&_yfJquۯ%faddd୙3$c+1סH%++ P/(LDDDDDDDT 5buԽ_{+9]R"7_ZPutz@  ,DB"6گ}3Sv1uDDO;Nȼ {okD՘ywExDxc۵+歛F \xK=zy~;;;CERɓS(:h$ow2"""""""" >.JI."L] 9dĄuDܭT}-LTy XghUȵ7舿n̷ކHd611/*~yyy^K&!.YX*6e/Y 6bҔɐO?Οg8""""""""""*2+\^+=L}WWYTkkk|b%lʹqQיWNbhh^ǖPuOݯԼYTCUL7o"?wӳĸ^^ _jj]t c_xoL KS@(ZCCP.ٳf!b:'##w;`ooѷOY~:d^J 1ʶ IDAT3M?嘭A.]n(sH$Sb/jR| 2 IIIO\ʇgb6ޘ2dffb Yaێ{zaJN'&ax{0?n;V$Ocf;2 gP_daaZwwwxLPԩ%?qύ-VP(D1=${vĶ?BмY2(J)h 3f`ێɩȴK 62* @ZrUh5Z8XAFI5VﾫxTwz}zƜ󌺛(8v8ϝGjZ`zHn L^EbccKRp,Jѳg/8 66ZNȬu=w/@`@@5VHJxx8|RǫjCE*W^.=DDDDDDDDDDTpy2+%0tBDDDuKN*= NJ./$55yM|8grssRSb/ l|l6//F@L<m܈C'dV ' %m߹ύgJ-M`Rp06 {hu::Ͼ(JDDDDDDDDDDTy\^ C'DDDT999aՊضc|999c +x;s&$Iح1&cRp0Gj%PG_.wgoFJDx "U.B:!RӉ """i#G]1g\&:6mĉ'OѮmZ@I@Dd$ =vx]g_|/O/6t(yxjDbc.!6撩 """"""""29NȬhN'DDDT5i?#6lڄ+B~~ح<*:D_y#ÑS(p1:'&6k]5߮5P<-Z\BYbJ\^;@Iݫ>\j8h۵8z(>]ԤC , GxD8#"R@ith߾'s 1NȬX^"""2-n:|wtc.`xͷ0q„j!RpI)rssKS4cCOMb; "2cNNN.T Ya脈̙X,͝;wT*|<-F#VL&C?@='N@B!;'9qqqذi#6lڈ&#0 z". b/ """""""":n'20tBDDDǻsglK0;Ga]&l2tD:_ˆaakcSlشLƠAqytz!"""""""""a2+%;""""Ipl 9pLTbGCX0wMXiP0{"559III(N׷rHT˯N'dV(N"""2s}z?J S(0b(GF gơϿ``4lа9iؾs99sp8<+'"""""""""z A C'DdtZ=亂 z-=9%T->[X4KII30v~o,--MXi (]|}1{,De}F\;}!?r_Ӄ2+%a脈Cfj. Zo2 ѵK_Ш^ǖP?q-Y__VYqb׮px8vޅ{:'++@E޽A|qy2+ y_W z*,7D"..N+PPP` F(C=;vb۟i!hѼysJ% |4w3f`ێyzU'v:!R_[6aU -CB0=$bbP L@LlLUj5#ER)z akcS ;Ϗ ۑhŠjNBbL]Ա#$xbZ? VY]T*i!xi#CS(p>|% v:djJ"""""2'God""""Hr?<(2+c׮_3lG:*͛`GFB>OдiSTVsqa)*wiFPΝ$cHP4hPKQ}  zQ$!8;;""""Zo⧟N3:fcmyƎ5Qu5+11R%H.KÆT)7 Q] q/+WDDDDK ax""#q(<GV}xPg]GsǏ "2cvg2D:!""2{Ϗ\1l>p^ BDDDTSsZ☓_&vgd "2a ; FS/O/hެY-TIOsxu.XVM.L"""+J MU IFtE'"""2X`8,Ôciii[˱hښҚÇc)8v J5߮Śo(CYSeB[DDDDDDDu C'dV(:]c"""'ׯܲ ?^ S(p%,ctD{{{CETGDd$JS<[SE-* e Y)t=1'''| )Xbdee%$&W^A xwLH$VZ{lmm J'O"L[ꜘޤ $>^4kzM]c* """"""*C'dV߬g"""$S3o>N>eدaF?q-]ڙ',Plj'PC)}Yxlش6mDcJ޴b2`脈 BS@T:!"""YcuX8o>d2ѱ<׮V3Q%JO,AġCX*;NeIHLM1id O?OVʉJbJ :!"""nƎG퍎iZv-&$ܹ{D ( ჇϿ``8;;9')) 6m+pFʉ NLT6❷ކXl煋1fXq# gơ  9'=#w7gC+'"""""""""s QmDxyTlWhJg_|BBX ܷ@iR朌"E:bDDDDDDDDDdn:!R [ՒN;"t;~JNNN-VMDDDDDDDDDC'dV:!"""2>{c۟aر%)9f4#MPӥ0mWUjJ`!ήŪ>T"tb:̝ Λ={aO`ob1x`eeeJ-2$CBCS(p>|P#! ѹ7r 2NNN\== ;%Ar9zl Ũcp9UtrwwǤ`l(φov!NQ#`L<m܈Z6 Y:DDDDu3V K?YRI\|<^zy*\UjҸ!HE(,`J3 ɵ\9= :!RNNꌑÇЭֵ~Nׯ_ĵLT@ ?xK?YD /bڵw^-WNDDDDDDDDDu&v:!"""ܛ4O?~ܨɍ71a$L)S@TF*#FÇ###ᑑS(pQh4u:._W`ͷk ͛ """""2#~8tmK8.&sߧ}6p[,4x)k"Cwv2f^6w:.-0tBDDDTBL Ɩ?mSXr)QM0rpY :XXX9'&6k]a#G`ĨQXv-bcckj""""""j-4:mV*$F/*3)mL]QEhbRuc2+%;""""*W- ftcQQQxw0nXVY:(J;~ñ~:0R% ׷'"""""z2y5{/z7y`KMmզk NZn[ʄ3uhʚjC'dfD"ƀ@|8wQwl,x1: aCVZ"H.G\ĉS(pA:'&611qz7i)'"""""k.ƥm>~mY}<'6a`nM߃)ܖEf6ޔ56NȬ ˖[BCE91b4`*dR)ZP>evvsaFlشc@` (DTaN!)ae+˄Qi:!R6C'DDDDO kkk,OdނH~p,-=o͜  ͇ +ߤE(8{c=HKK+uNBb!ҨQ#C@HT˯)a{:!"""XpFfkzbJ ;=}틭[B㏱~ca .\{B!HлW/ Ϛh)ثCJJJs`L]QixGJ :!"""z99:bS(2KLLW_1c!LX .F>QW32}l߹ }􁅅E-mïKqUv@87„Q} w:1Q!DDDDT-rt sS z=slRthބUٳf!*:#¡ط/uNff!bkk@,--k?o_K \C'd^Q_Э[ːg81ed9?\E(6n L=qR(JCE&gWt[XGtZ<7gee [ ޾AZF+j )Yŏ?ʱl[|+ Cn73r EMmTζVE~ѫ*skm l٣oi,'4˺dd7E^oy5>ErfN|]Nk%r,-DJg;YR6k{W$TÓ_p@ .=):{~"ZӖc׺f5L"RZI7Zߛ*ldov/:ZCzaX(w%nv.D}kħ+k\ M*QK$ct8ųQVy(ӱnǯǵOwhV t2Xi%gm|mb߶W<\T=g2~z T-v4ohO/}!/_-$"Jܤgx]k8|{Y_z/E鑝nE,ao3l_YȜ+bN @qcǢk.`\|pLq)|d)Z4onB -2$CB =a{qRǫT*G#<"?^={!H.)u=ҤIK| W*ԮFbK2""""aˑͿq懲';){Lr=rɋ!OflU~힭ܾn3z75[ߪs^K=P4thˉCXm%{l{m  Ofn~{^/-sppZ"V:9tޘ޻3*b=k{߶_~unXic)UmJ{~*O Y):у"""F$S_ѢE c*Wk!UH) lڍޟ _ߒPɓƍHMMʉ*fw̸5q:C'j]ebPi!fRl׺/~G5}:&ZJx5vM|?u>Z&%YFK">]iWk=ջ}ze^~Ҏ V{7Zb]K <} ;{#H. 96CMT˲3 U\%鰵suTP* `gWAʅ*/2KX[C$*>cR"[H++;dz0Jt:-22B$B"""2ƥg3?4u=iwi03n_=><6e~Ole -q3)oReXZվnnZ6rHPZ_KLs={AK HU$xvm;_k8F$1}kޛ5ʄ/:N!ޯpGD50$gT0CȤV%xB%Wre]]Zo7C Zˁ^.]tal 魲~ahş,wrF"Ȥ5|miwuOhgo?s;fBIJWŐ5# YtC'Lld2=͚4iS/-=gӧ0uRʏwn%&&đGePn@Ա#*xxX*/puVm8}j7ܾH.XB]755;^& dgؿag (fF;Kסps˿;qpZ\| Or% k4A6=ѪuBP45ܾztqq ]]+ (jiʨؽsSOc]| ߵp8:xV'q?Ǒ{qq)_ Ԩ뷅:v߷ ᧐Z &UD=]5o8Tw93'}f ХefU_bO߬wݤKNȲu:a脈4k6o cM} 0ct֦*$cxzzPq1ݷ'NJ&OoA:wꄷtѝ|ju6vl["k-V+DZt=6xlvQwݮ݆C&S)HKK2xll#ڹ#YTX6'0xZFՓzNN=PT*fշ8}j7R HRS:NߡOh׾o:Q ~.a-0q!lX]{8$'cXf/BGf+M#[ j Gdd8ٽCD]M%E^kv܏M}VtNܐ;ٝzogZz/Gۣi).VCۇM6G;z]wfce.ދ H"=ݴjԋ}n7'[lʞ7o7UrypB*i?o刟/S%"sʪc]v|5_S[?;-TEC+Ʋ"rti|?9./{6nJL NvǷ>O"{7FxCDT»9ciMnydRIwZ~>į_p~x91/_˹c3oxՇ:lE ptp)Sz]Mѧ`¤IP( .K #<9fM6w˒x[֣~^/-б[1w|'e >7pWFSsRR1}j|'nݼ3-sH<{iTDWrr~]2-$j\>~=!w\AfifdcԾNtigF'""t9Nsdy7t -'~ǹ4kڙiWIN^͗E̬jG{1i๬I- ~pjҭnWoZ݈Jm{acW#U͊K*Շ }<6&pc`>n]۳j4F _/ XrqX9k@/ ܮ.Qt;^pKٱ-/WCyN|ܤkšs/j!Si1s[y'9%e\+K*,: Y:~z6+_; 1gl4l q/v׮HMM#Gw>:} YYY dqn;wB@ WsV.y7vX*\QwW׽u~_UC.yAje1q1)hZ,]%GwCjYLܽ{n^>܏u)&,HPRuU}`g rE*kgTpP|EtaV\]-+y7\+TGJ/K&18Vݷe2; i?`8:B"==[ ~k3Aǧ*ׇ;TYx>¯,j n^"""d~lJwݢ̬7ތNXDf9ռ]Njx$nu[m*xHsO+s%2u-㦜G*Mcl` J:wmQIш*Yyǚzm747?B[9lƸ9KG;KU.Z= QZfV OWH-Z#误o9+y*9l߲4TrT1Yj;\2hu?1g;&Y\\+9=[0>sޱNg׽QּybSA˝{%g[]Eъ ѫ(m1>KpaX~#F}3kr_k=z\@}8=>oLfk8V۷.ѭi[ޔ۹&0><UћeNBؙcJ7.¨tM"""K,x^v@$FKh'Y=Xd] >|e+50-^ߖA]mcϗ|ЉeWGt~L ffт@X$R!H|N]֧8DD%ͻb/ /rUͪy%;Ȭ+m=sV} 'pQG+w:wW8VI~e֏22r+M[DU*8N+hxF"4{gI\V8kZ]jewؚ\W C'dQD 0sBDDDd 4)q=4 VY3ag0wKhYdccڴkm`r*N>CQ^QQQXf5VY oo}-*W.Ϙ^9 ų"C{FhΫ\F^7==66v8OVopF}4ш;~A3gXYǸaĞO45݆=FF[[G̞ Ukb 0}JGxqݿcF(\vov wvvDŽI+ sD^WOak`us'MOFRZNNn3'̚._{~0h4IDDdɌ Pf݊N˙[iN=kVTanje U?.w8A@dL<35KR'RĸBr4zmzXjPf.*>zm{}[Nnݏ+F!Omo\v2<D%U|`sYyۦ5m9$b92U&@$EnkR3j,FVi4&ŻOCt[^)k@ƁM__ X.NȢu:aꄈx{co˰zZ_@;wo|0l8FXlJedLOǾqQ>ͪ5<]B,@,hب 'AS %3̘?w,3cNrT:lؾܱ˗:7:p7?N7QԶlID"[Z`DKy?*K{1a|1RPk&_R&xC8$$vAjq<)Tj+}) eM#K7kRXECyfJ.*@Q'oDP)k=&fT6wœ+M-x2B]"[ԤZmIJłsh4YvJmgz,oh >BZUb;DSKR(.[kDl_LSqw`b` Y C'DDDDxw@4k_N7rT*d1N:9f׌RQС]{thYYY8=rDhZh4NL J^^Uж]o7knݺq6nY::ZCENا:+ ܿR3Ek*ƛQ-dg4d2>+_ w/LN\L7_]06 ld2F;LjG5j`~7>< mn߱,]7Ũ'"u="}qcǢCl |]w~C |85O2+ }QF1Fq7eٽw#F/Fܵ9awxXy|7칳?zFDXXbܷvE fΞ7qFx7Ɨ1O *`ؐzs7.^(¤/'ͽt2{Xo݁Q]v5k C \7NHmoNoի'=v8ni!azs#nɓ+Innn8V-["00P0jbJAzW`m??;8@"w!W/w#…6vV'+ 9ְgJ޹n?qh\R.jV]tVr}[  9#!rjRbZfbyQwkzUXIJ4)=3[Ki4ZSR~ b7YjakpKs+֛R)) eHBݢPj8OAbO]\LZn0ӳ~ؔnZe%)L\&T*=JJEHT :!N'DDDDUn,7,u)Ԛ\|={b̧΀vCJ55mfMػoۋx\)jl %jզD">W µS-(!??2HGjjݍ>V:;WJ$trX,o*ϖDjDfB'Oc`/.>Ɇ?~)ޔΑ7Ciizsg]YJr9Vkׯ׭S`w#aw|j~w^_bb:2+ szS/4 N>7^Ju\rn ;gdd{n޹ C1XB$''c}zZ h5s˕+gN6-ڵkzJg`;wq&}N έ:j4JR}M uj6:9wl*H$C'Xbxgpne??ЉV58߾۶oǍ7cCB N8[$bɥ˗1z-Z4 <58E/tj קɪ5k^_HZ>C놗>U* h\'% щB'/F~UM/G8ȕ!!j/ܻY_?|.%? ߫g}"(Zmc-Hbbi5l)%MmXRb$FEE}`+CR|}jlB/2$Nf-Jk8,RcmJg5p*"sa,NHH*QвE L4>633_ ?Y3f£CP%Q^=ԯWǍå(vBRrAz&Fc\zuust1FJUaoo:BRLJH$%Z~F]Z{ȵփDbZ!>m"(K*qCBpqZ[[=mR̙9 sfwq0΀Fͭ[.]6n^_~U Z=&b㌪wPt޸XHZ8u82Jd ͕JػkQ%?䱖 d IDATg|ݺuEV+Twz` 6oD"18NP w|L@;[[sGf/(ܮm[T\Yo\ c_H$s= |`)zAGG deOڢys݊ '~Ng ͭT|gHKwR`,q>e޸gO1oos_O,k|d5ӟ5Jpw;N 7Wvm=&wd˳}u֪T>o㍪yE:ռo75CyRAIre7Jin[yڡb"`i*WNn9}^OǦЉT,1RD2 d,vRí6MfYeNdVWЧeЙVA/u+ЉD$]FKP Y_R鄈Svmlٸ ~׮xIt'L[]PO'ұ}{ 9"xAfnr^&ͷ.M_i!  #45"!^܋ ǣG7M:y7\]Z,P[[Mی:!!''aobkk | H$prr1UD" n.8;E5+ <[*X>.TP话5mj\Hd\ -[)?ܩQsE"syfFm԰!5lh\Snnnj\Hd\ءCӪeKji{=AAzM7k2GZ> k诅eD,FevV=Yn b(AvӅNlࣨ9FK]-99h9TjtK+DBRFe3Vi"@w:U^4⼮IS$#wm؟_fl-1]a{kr:j? EA7tbBLѺU+L6OcwHKKpØ6yJOlR'!]r];_v},wKhF{6l/cbctM]T CVCHyzU.0}'DDD#cGk'u*{:罜 >񂄓qS'2܂˻U0|X%R85[%).5ô<}CvޯŷtRz0.[lyY> Zl'u!*:!N'DDDDT-7-[1kܵKo}p"fLn=5$׆XAjrtWQΓ?9  X?K"0Sϖztj+81=}9*H$xjlwZѱ5G;5KaI@l՛LlyslJ6:Eal;s'4eְ~LS$yŻO5Z;Jĩ*Ʃ$. ;D3cy >DZGmfګ⮻֮un*UjKb?͂wmˁFNSdwqU9\LHh3vN̈ vT.1!-I,> _6Q<HϚRF3~ݛ6KpFԭξ-V:^? 鄭NI$ 2ZIqJXOa4cDdnry`[&gaǎnFc= ;vzzJ>3WfSۻ*w;5%agYL>.z7f:J^_hsƢ;D'`hc* 6oG? OQ(ke(+ϥ%F{8ۅ[[fն)LؔFyo9ڜw=<4ﵩqvt~js}*UG~x>2;ٞzmȚO B'v6qX=xNΘߏK:ml {f/iccd#3,cjFVPsTZqZԗ9cZ-$"c?\κF@z=6UQ;=3; gX$RLv>[:hw"yzy_ujsYܙ O\[UXV;3˧(23^MTTYN8bݪ:d^Wg=q&3UGD`;66c33]A`9477apnP*3 UQiԬWλ JY#S4!Juvʐ[I/ޏ(Dy'; 8],hfz6:kΗucL,#4ܵch[HݧPfE%w7Q;I}Ƨ,W0pREC-RxʃWM!Eo7 V?na;w@ou/S{ީ+X6JNLRG #cC&0pB Y C'DDDDTd2Ǝ?WDJ>s|>If~ ~bYA[:Nbi3>`Û&ov,ߦ Qi5k@c5_,eh?睖.3_h= WyqW6;ט.{#4=T{RϹS3 mX,Ezim1qH$R|L*!kl^Xۯ2c6ַ?~'u|* w[m΋rQ\<ðM ɬԨveOd*.CE :!"""Qn=lZ͟d8: ڶ5SDRاcrӗ) Bčr+[C=Fepͅn@:nh׾I{8~|߻;vdd1Ypr.W9mKopu`J;:xnB+FQ2{Uj2H [KJJj~ζLnqCۇ)ɛQ3BjHle'^n׭c=?g۷KA>˕G`oo| ^\ L9>E튵o݊NLJttunux=~lwmk+IbAiRƒD"IFͧo7IȬҸj"lOy8h]ԸguZTrjJ$FZWڐ.?ݠJ/A^9lM: ^\m/7{.y$b/h)nnt.P\KNϐƤdʊ̂m渙zǗ_V4TG/_fquT0Ťֵ|Z|s:$طc8ssgA`3VIJ$Y0fm-gHbוH׵*bDC&3=[Ĉg4auB󬬬Ѭ[w ʗ_ͲBܾC4ogN6RS@v0&Yr0ej\r;az ۣ]p+j !T^áj)zȘeO YuH$BPԯ__NT*~Y'NYQόQqg{.١N6.,T\Y ^vUUfZm-vy"jZ+֭R~'DDc,^e.CDDDDfu?Jw1L^6h4ZĴi L9 L%c,3BDDDDdΝ:a-hӺ`\bM;.rj"""""""""*Y E]^""""*+E>e*0ha!T!YNȢN%"CCuf4__OVcӿn޼i Ȓ0tBE C'DDDDTT+0vXYY ݺ}}WF1SDDDDDDDDDd :! Q$1tlXAՃJ%GB"""""""""z1tB+&Z5/ 2WK.!o_lܴLѫ("NTQd;z \;|}}>sF~!T!:!S'DDDD*[.6[ޡz?8x*#""""""""WC'dQ3' ѫӧLŒG}II1; B"""""""""zUH]QIt Zl73pAp̞956SeW\c:e+,3Sa Y :!"""W+~X{3MDc _lllXirܺyeC'da鄈,ONP;$LAٰqV6…;{6j֨a*%;,C'dQ1S!DDDDD%4> IDAT +~ 6oEfffw!WEC8!""""""""'dQtC'L%Dɓpڵ}jW@XXΞ*+RÆ 1wDdʻ7w DDDDDDD1tBE?s Yk~,'T}Wڧ7>9  X,6c7>9e:,:`脈,D"!C?d*Bp>}jc,^脝N…ԪM6b!z]MN:{MTf """"RF&c%KKO30vHNN6SDDDDDDDDDT1tBN׬iSlۼCCݷzG2"""""""""*:!:a"""""!GL2 ..} O0a$( 3UHDDDDDDDDDC'dQ3' ҩcGl߲m_{MoߎGh/; #""""""""R(z뀡""""+W?sf͆`_Z+Vǽ{T!C'dQ:0sBDDDDT"*V?Vc`ee%~-+hT!,zNJD"!CaZ )Ja!>5111fL YN' @[C X,ޫ'6ndꈈX Eɜ`脈d2Ǝߖ,`_Zz:Ϝ1ERr*$""""""""0tBNJM`-o֣;oFDDDDDDDDDb, 6>e*~?..}x0ir*$"""""""""C:!L:`mh׶޾;F^8{*#"""""""""C:!uJ5777̙5}1xPdeeB"""""""""!5wD%I's Q)v׮h԰&NkZZϜs"8(ȌUObB O'v;"""""*.kyQ9v2C3gMns!O2g[*ȏ9kx-O?Ȍ%: E]^`脈e˰j_@ݻ7p>6#GDF9Άœ{%z[^ҩ5*>}(h4fSRelhfDM7g=T|2H6g=DC'dQD:DDDDDeH$»YӦ0i"GDSTeb8ysgρ+-=݆3{KuVbĄ$n;;{K)NNnpw6cEDDDT%gKםwwj9&3Yg#s=;թkΚ6Y1!-.gf񭂼YC'dQt;0tBDDDDT6T U߰ץPp 1 t8Wɮ˱k&MglƊ4ذn>۞w1dWfʢQqNK\^w᝷D&"s?{ŵN٥K ذbI4iR5$FS4k4v+ "E م]_M>+N @.!ް ^'OOѬߧ',gԮ}<]M2j{$rr^V!{Ҕ99X Yؖ)*mWHf8Ĉ􂲚?pDC1B'͑HD.ӛfϝkTD*{|@y琻g'NN:+tҧH=rZ]ig= xt-"pDcK{<2,;*4k=6jg^zrStQ; 8ayD"ϧ}I9W_?4CbZǣSiGёGj 7RҩSϨcvcQ(5,Qee)uZyQbaI͌+uN%''WT2F*UQ^n:R NKbw=(4,ZN i\tyϻI% I(4 EF'.נcj4*Jq nTZFrYqy|(P@@)9LFBARw!"p3?Qo뙛n - V(5n:= |IȓqgT`YCk<oƕV*|W$,w7y\Nܹ]$Y}8%XZBx9 rOpC:\s 1NC+On_")*I ;1|FC}or6ere "W5*kw^۾i..dWVʕ^Jޅq+ŠZ=ۯͦIEH]\IK}oLuvQoGJRwrI$j1}; 9&8qeaN-[67-KR(NK/8^xyzu+$8o_K]lЗ^ цбIV E6Nk]Liuu{&揪Pۚy "HEMp@/Q"w{۰O9S(-t̽\g[\ @Ӈ 8NzƌMݻu̦.ԼhʕtqeǙ6ojmuKofBaT*XZ i_3cJSקN6-b [ qXΖmwjGON;%1_orTORcK;[y`FeZhZctjD/SVkxN'ly+r,׬s֝b i: LI/w+zX_{/?aaûll^kwdJO7(պ_m;7l| _WK煞aDuaw7dUPU}&ؾܦRY)pͮ)9%S]qV okĐL{/gY Xc/N/xR٣-5Ֆq&/=tzk'<.GA&!i:ߏ,,+c)3<Cs/hƘۃxj{|U[ϊZ3tep ?sKyǰņS<CZ}өozh-Xv_XjK~ 8cMB'4 G/ND{f}@7n[WRKCGЂO?-[q͟TZJ.yz7=ڶN^~DDTROW.#OQDDj:}jwk1ij?$41ߡ|""ԽPiDN"*--̛T^Ql8ZQԪUƐXANN.騼2o&Sɝt.}rUәzz֗JO>@yyF>>4 ߓٕT*S҉oꚥp.б_cJZJEBB-[F͓zr};{)+ώd݋ز{v5Nic:И:heUYkDžz|i`BZ}8iNf)}ާmnK{ Z֝E."Afީ v4jvqӠx>[zU va>7 [x\VPbVhRF^a!NSsG.q\vqE\^y 7S-w QQ*WN>V0Ra~²Q?|tso>\ftv_ףcwL)Q):S웒WNϸȔ:֯]jxZðE$j⽽_) ]6N:;(D:aGt˷ߋmy=~m2r~zXZrkB\ծ5_cb[ֺvak{ao8rQ{I :HUTᛖ_ҖZ,O!һ tOru,S*U{VU |[^*ݫ6ph}Rg m>q!T[OGKS\XuHaZ;?viu9󙎻t![๳[T*RCoG\).Ri^+fLq&"u4J^ZAkWbߡp@ #e?@Qu.觟|ƌyYfkc搳بOxxuRf !Btk>^QtQ""j@XBF}BBc}~fi/C'#o]SfiT|7ϚUSǪJ V2(pphg|H$rvю}D*(ED>Omz~Q(IӋS>!ӨǻXOI =ivV m#>*<hO@Cte泋WOi}fBس[^ή w`tDDR]2z}@\]Z8ա ]#]6e3D~Ǫ"'vKTMT"*}+>%Laڏ^.VzB'~\Zo*[,BDq#G}S].Ҿ":9COI!n?{s6FvQӶ3oi&_\Æ}]<ӽb+YKB҄JlC>xza!mV?4MCT/шΗW?_=È~{y֘^Sl]6)9CT5E?+CV_-q>7ot/nQkg" x Ujf?"lXbxB":4󙎛juz7k;#:7JHg8s0p.!wW]o9Wv}~qݣ&y-p]j9)mi$m7?s{aY'.Dv_=د=ޡIWnI N ruo7,Ŵ 2'C$ћ3^?UD&ч|L -k>x^zsVह sW'uĹ'愇칫%%tZkWMFmcƾN81B2 TVkjo֟aGo,eN, ^_BnV3[t'$rKe_={w7 KwNXJNԺ< X60!lSmo*2B~2>󄵡 Ojz0l?^0r8i281; }ʤ.٦Cj]a[耥S~l|/x&摶_,eu<>e9MҴpލ6F*>d;ÿYЕS].Lz$=j*H%;/elkۡAa^1_uuד&O\&Q+m-yqƤNl[4pbC3#kB ;t fF IDATi߾=m\lUǎ1cA"iDO^ڴp4mzf5C']88mm$ѯZw{vQ^ozUӨ-$$&M8\həD>^UJ%O[a؂Ѿs6ϴz+ Pjq9̬1ݿpBB{&ryZćŁ u$5bᶞaD'emb)\׾}qNkT%2`5}Np.ec%ľ,cjv7"<6l;,ur.r%=?>5[bTIDjn6:=9qgao'cL&3:kaۅE $^+4lt]X5߬~>8k !tĮbp\q§kӛ3ߦJ;ͰyztH$rcЮjjhPzΝl|Qۨ13l>N#*QT}O%$ghܳ3I aUh"j'xxJn6񑶿z7v!R$S#,~?t1!!tN@^hƍ4k{QcRjjfS/ݺ?nqB&Few\dݛu8bb3SF>>ԡc?+&睑_7 bxrUw'ϥ!=ﵕ ʿEI޴<%vn߾[f1N<#qfnK^Q`p8ןxҖ<@Ou?WnK\Ov/8M'S|r>u?lqkRc\Up[$tlK-P.vV l;go^ᶛB -=ҺuBrrnP^MRHbU "b6CrYyx6\RSmnO\.^ 4z;I~hMnXV-:XbV]WNQX.[X.{Z^$n!I68iʀtG}Uts+ ]^P{(5VwiR2p[Hl%}<^vFgGNI]E OOqZvQrP@ 7z?  r*MhvvQeey2r3o( -l5Zcu%:=iK2^׮.\RUW, 1S"U*6m _>C1]cNڣS||͚3Μz0aXbCL*-=;)/ :1LVA۶X~jj闌r~:JJ oot5xR!JꨔWK.kr..b<8&U_w1{͉g +0쀉5j͡W'\?>:ŵJQ Z{dNMJч BԵFtzLn+T:7jF\}+_g,gW>Ts !;ζV䩍L1z*_kBeI7 #4l {  B'Pء;M@ZUoIz'18;7<D"փp69tpc>uwFݰC.RzZZr}_PXqX,M`,Vߗ_JyĨMӸϲ4&Oz>wFm[O?c?q*~:|Z>wl 1ʢg}?Q^)/Oe׷/Mxvz׮;EEFm~3C+Wߜ:Jr2?x>g8XxV];h@cW_r%-::zjߺm'd=q$>q$Vۍ7O>I>>ƿKJJC:vpVYmZNX26OO8` (33>fhVۭ[DD^n]QJJ:uu6ԲeKV}XNS6mX}O>MVmYUYnpv}0yӾ_L+(4m_0Qӧ$9}+5g$k˪D :DZչDZչ!ԲC'2cwqi@cB *@]\.=WϞYtu"yd' ="ߵʭ[~}yyPD\.0 >}_]tZVxZxV^VNFmmlɓfm.tz#l8AYb}[z71G ^ic6tkVɕdֵ++tr>cVys |'kG2:yrvQ[Xv Gźv|s^f +tGo|w[$xyѣFGs.^^aI.d܎sòV>aھ`|o։'S2mtM2yB젿Rɸ0 _TGK襻i;-}uMy<o뙛>J3[>O㖋b[AD䆁 uZ[Z=c!)-إ^Y+%ﮄqVnpyJ؏ZլfEnH/r9q5?{:^Pas +[Mz=zʕZ>nN0 8 xJ,jޚ֮ZM͟O7n Y]ǃ(Z>;  u2ZgN7tbz;00},Mhh,/ڴZMD!}VS4Xbvu6t8ɉ*qf _W^g|͠)/ 8у˾E{vb{zzڸ\پoDD˾4%ztfN2Ǝc5SAxV鯵X큁p2 "3k6-|/2Qۧ/-}C\'4,3\`+{/;}cTYiܘQ{WU֝^%y 67*2?3f{ADTVf406t(e^7Sǎf`5I7`EGG;~3J.Wп?Y0W3*Ԛ{?-|Zz{{ Ƙ^Nza"t' oR^KYTbolYgՍb)DVK/ YH DDz"rygVFǭ k712_ ؉VNp~=\OuLPk*y[_*hҡ>cUtJW 3#fI.pm^~ȜnNpxϣ}L'4:sˀV'-\-tyEL G|$.Ym"!hS4X(N ؀СCiD`ֺ5>_МyɧEP-{Khy%nFt1<;`I7b!P(1,h7ǖbW~0w\k- -̱iՊR`9|/.a-}- ~0kN*ݬGX}۶ic.88͍NDD9 KL~cXb5} +.B0o(N#=Ft<3]XQ{-;٣B2J2%F=V'/#hZײOEReVRWE&U'>1}3p[$L[<߻V}(rW)pٟV>[2fteT{[hv:*+`0RRM~S'DDfVnP'dle7xNN$IyG]I+'% H>$Lх[wn{K8!"̗DjBB~abJm~:d)m)7p[KΨE^-ov&mC5p>]Zbfu>O߹uQYIN/.\mxreFM[G!.C4+amH"1~꫅S픛N ӏ"#; m:TVޡuk{iC}kpT*/s:QYYJO?@Jg^)]>4ͥ9];W$a./?}@3ۏT*V1$ju:-}D:sz$BGz40aǏ5k%2rnXv~lE[_Ybɷ} -ҾMEBXcƊC_l;`NpHN-UiuDD\.\ߦC쬝;v09^ڀ_ q.ӿB.<ֳ #W|=\Z8|<0!c+ߟ 4Z/ϤԹLY/.=u?:ͭ- 1 N_s!EN59/ LHyw *:C-v_7䓍dU zp>Y]#5l&/yOYdߕ;Ϝuz0vrݦVd*M[ԶB.|ÐO=o嵍3 2X>HK|gu'm8W&ղ;<*90 sмBzdӴm˿Dɦo̰o~Gݺ?hs4ki2 C,R箃)(5 "*/+Kt1R9ŏe3m~:%gϤWO{Rف;\oktoG[0?VF{|ܜxLVբ\_*SgOD!XJAG.YXQe IDATagnTo7Tw'aO.WU:R-<`Ѥvɔ6V},%>|)IX ƽTlU.Wjtz"".mbr~k Uf磧{Nޥuᡀ 8vf$ȸlQ|B/tڼiQݻu.?3W,tBDB?,iTD͌+t3J ~_~EGo4zJFg졳uTLEii)?fݝ,ZܫMcriNq9̌':ŦSiueu{{[E$𹾳m93̶a,ȾJ~CK[|懩>>Q%{U'/}j*0 #(V>s+쏭R="`sbѲB &4-,4-~"}/&x, e˦/LF/D~+ *!Nj PzS~;neU7״:{aay.f9L۴tLB>kqM O~TDt5|y\N@Zʐ_~z 7D߬q9[onWkC_ \'q':f>el*k6E|^ј1~;ƞ9?^S'ӴqHZzvI MfyRv$LYyl<F.Š^wS._*u/R ]-$ULUA\x=M3%.|]{Y I7JrgXC\'u+*EΙw˫=Zqnx<חPiBh$<=bIZ[#pMB'P8J'мgRӤjvV %AUU.#wv!q VMo7nbQI$4Εrg~4*Qӻ &{͌c4,%­;j #/Ex\;"N`yhfn_~e'O%o8#K{[O9ݮLzbkݫNpX;M<,`W<WY+~<\bW}@S 8 R'ܸSl./P۸3kG?}F^;JZa}7˱A^gyTc xro]#6LT!tU:-@ FNN.$xXN9q9ڧN}ju[LÿU^^tz^,.!䥁w]/(>-qUTv N tMDIЬx>qA%4}JpŀCINp, tP/CB'v@3 8 R' 8V:NptyNp( tP?cAA t]Nh:b:!B>d9:`bv5R) 8. jr]MFp( t` : i p` p(tjCF4{ f!t4tB .$$fp=9AzA hCAa t:<9N*R' 8 JB'P8dB' 8: B'P:hcaN4fp(J' @} t$sR' 8. @} tB' 8vNh:b:!Np(X^a tcڀ @ tNB'P:hCaN4fp,B>:b9: 8R'ػﰦwN&A =qoawmV;{֮_wkVZ@" #2Ѣ '|?^oϝV8oT^yԙk_OixrN8z^JxM'gJuc{>m=1jٜYh\+wOmXcKbFq*."U8zFU4<8Fguk[n:ۯn%9iK1XwIVggѷ1{yͽtNh:oIji@+Lhŗ_vb6`qcǢ/ynuuzSps$gVjϵ3aqk&~3DSzS`Faeo":`'Z{R*shv|>ts?TLMs'J+{xsγ"ǵrߒsAIpD:; h!i\C:;Ndb/v5DX)DzuVzDtf\9zcRs'<<֚\$|wTR!1:ΨW:fF!YֵNo4o2IFc9)ܤɽ% BQy$x !N߭vz/WZ_n_e=+[ hd)nRQ0ZޯRlbYy9O|&hl-.IyP*{eɮ2q\*`pQk ~UPUIpCI餳6g9 ř;ܤgo37ŰcW1ү_1kKS>64lVQ}|o>貭s>|3WdUI|yјD"Lإu0[=Tnїa`Oߟ;i`hb^`N|z&s*k',&fwӞ &""1jxxo1nWTOx;Ȭ鐫Hh&/m%Nڻ'hIJ%.&eH\Z =V:"h:iG+V4}&N)^w]I>p7w%go8g~lɑYCC|ZU̷+T&FNj)4\6r\6)ʲIWrKk~=]xg(RIwz̚824<|KY;U$dxpϹ|Kcg.Bv 72y/o>:|"Pi81]߽Оs['LoUNT϶Ṋ3$5S+qbS=y%aܗL0?n4Y+ejɱKE1BFPٓQdsccZJG3 #gqtf-M#3K?uBڟa˿=/A @%h:NqRc蝕K[aYVl~0O7WsY$-4"xkB&IkjhZPqcjb9A{ db"jFX - ОB`bʥHDBI&εsX(+øMKD{_{ʰA5ځ:9,If.v fO7Yzeyg jP\&.s@jqtѽhǹ+׷ݓUZ}酋M'z c:(9@H[zWPjt}Ql~qZ"Ztsdn cNe5?қe9u»y\lMn6js? U1U*1 I!L2ruz-ՙ&"BD2Y٘Ri4Vj1 vGtB5>竩RO55F2XrwBB\)+EFST;Ahbqd  T,XB c{cr'x㸫.삑}-w'qYOw7DֱY_MҲ,wuiDtܞy͙06cpthc#eA#E ZO$Yw"ii*s_h8VgҦG$\."??)F#iho&//Wcg)& sӉJeﾻBlȡ+Wj>?2ӻь4`@_`Np4tR]3 +Wo0*\ܬOnϸs /<&\5>VRU;}I98͑TH5 cɹ=݋y"SP~jSEIfcz,ל9z])U1yISfmG.U7H~RBeNWaC׷nF#GJ22Դo_ }i~G<.m h䚞)17.pBD՚(.^"Mx:?VĻGTO-Y&G)տT\Y;m2s;'̶8| EA=XtV]+ȴԂs'r_*M,'x㷸M,f'`lsWJ&̒nj@٣1Sy#h: l\YV{"Hk8XJ?H#FΝXi96mʣۖSaSICPV"-VK/|;ܛBfXKGVe@55|YM:399Zvw-ZL|<\]-G*ehLt;`yS=ZN=~XreBD o 3QT;KEHF2PzUӱctX9 {"T,GbV*>s泘ߧqdƠ|X\=09lV7H$dj<\i*Gf}7?j4XnGⷛ]?<D]݆e_R y}/T.RO4X0Nf?.ryB&֘Xl!G|1~c՛OIK;,XEDt&C/, a0CVL luzSp\zѪwU$?}Qt+rT2)fovW$f ذrk^,_ٿԽ*%~}} RPB|%K{>hǐBѲ_YOO ۑ ,=L2L '7@>L~~W!nn"rsQp MOVjO1}:}f{k NZ3ai:}D}e9YjAŝw~2.oɴIαڹ\l)/>7q)T(S@duu$FUP Nxj?bB&IoU-A/.~\.gY{8DXԁOxlBf6L,՛l50nlDG?=6 \'dF͕Ntr۴9k.4yzkq79&L']w-wڵ{$ER)J@G±͛=9Xf赑t ]x>X%`> W =`=2@9=ݤ&~cw45~qtCoȒ1τ{ltHERè|-ݻ`KTxHX:4]/|\jZEc)}_W"! mw8MhGFIe1jyL:jiZDgd2._{rezHJOWw3}N, сW]-Kj觟s,bb:sz:H=wɭ')& /ݺR ʧ5tTZ#RO2 r!W֯&2kQzFzގe ,4nXO@ ՋcN#FC/T=X)\E7;;m`Hst FM +UZFodH`OWiYH7Eέ_qv-WBfޤaUz:e9LR"|NeN]W^T F^" | Wc q4Q;(>¢ᄈhmpҷg>acnN» qqk1Џ?fSOubfSQɢ ,z}iSLDD11%a{Ӌ/y2Fh??@''J vع^w׾tl9;p5<Dtٹ /tv짎 v`0ȊGC:a*^ÇyQ߾KZn}{!vɭ9dRV7!e˖<֮MpBDNѣsUxG6,hNu5^p\Jk2k8ЮFquc:U[k-)oͲ[H*e,s{A\ Qwh'eԴ/̤ }ƗN?}-qzJJ:)kI@ЄT[{m[n %Y7tml:I$ 0/Wlm[y^wzqhX 5F#G-?M9mS8|űϟ'E;uGOJGM?%7.QpFW@ujC-hfF޸[WYFŒmr2=l2qfb1CDǎNKstIAtt^DJ3?pŮkΙݝs{͛N옍92ao|u^u *1#Y66F^@PS||Elm=6ILw5qc.Y٦9ڣjDD9 h4t\#Lj\k[D_}5n99B` WYd4ڷB4~/;Vn?~f9FAA.4a/MGcxSh]@YCyĚ8ak򔋍[V{sɺ/Wܕ_qχ.z$_2>Ԙ>[Y:1U65M'ס[IitcE"-^LE襗H$h<[7/VTk =MzUy$$L>VSekE[m81ښ([J_e/ѴG=)(͛h<""!4b#յկM֬aS>^$"G_KxTY;hb݋+kWN=x>S$19蒫H'b5teҮ3F#G6[6,\Dbҥh)6Mk ww1eLl۱jkի5|'ۢkОi`&VViRz4Zp g7=4o蘚c{7{m@Kͯ)O|aӶYoҪgey:2xX#ijN311%TZZ^T; dٰj)0R(,j;V3ɓhIíbܹҲUGBC(fDALuk>͝w-kJ+~\ɻsz/x[cWA9x>G6M|OT>uz΁'י s,## %,'%'\=޷Jt'ux-[6ػTY[BnK*hW6tsв&uEwJџ ri(ӏ ӻ(h[}Lj55\EBv ޾Tx^X^Xt[BzlXwӷ8 c3CuLG11?K{4܅ W/osoc<ӱTWgd)G:2- ٖ-'*ҽM'BMOSQaaJjJJRRbbUW[ߞ@wޕ@=F jU6t,ItBdI=u/VN*VN:q\`!!<:kh\llz(8buяoiX4\G6oλ4Bj K7OJӧWc7vk >>'dbNǒVk|`e@?υ $""9%{>mؐKjs}̋󢧟GO}НΣÆ߯_O9s3|Oa/Ɩ_~۬GӁyŋрYV?X$>M;ɋϞ5G|-ض[|[W.]M7&LSjC>DA[Cz")j@~>}w5S߾}yO>*+-W @-۲T)jyiС?@yP[[K7644^ yo0m48a/no x׈8"GXko ضOJJJ۴9fր~Hj"Bm~ 6t͟7COB^y%ض_~Ԁ}KoOĝր[M2"j@``-A^<)9U6oB؊//kkx1[5 %[zr*X{k߻vѩSK!!=5 //{^3ԀCCdbmր_!!cʪ*OxcG/]ʋ۪ ϧCڷJLw͋[Z$[(w捵L6&ϋw(0_|m21[5 3+~^<::f;wMPmm^nËUJJ苯H._|%4UP};w1DDo7TFsOcGo_鞥:/җOlYYYVLJ[m:9z(?[ztb2YD՛MVZw$wyզ7Bzzùj.VNN%v߰_xBM'wE1??7JJK"Hp>{sfϱzi箿y^r7V6LVo8'$W5@0Vo8[.ڨGzi_l,jƏwH 8x=ǯXɻlw bF=5dDp"$׀ewebX^VhU-\df"rnvTj9{5@!^TLbf{)//"fo PVo6]x!5_?PkAVo88|Ν75Y:5`Vo6efeYщ8~ x孮99VYܒPP7iXE*Yl8v hP(lUL&&[NVo6U+mրt^ܞ0qM'i鎩O\ŻjRzcy8^Z 0V玊zGwߵ gks۬V{yy;};Yĺuf5kn g{j,9"U IDATg[D"7m֮m /n8۪&Ltb 4jɁC霕{j#l,tlD oEvՀ^l<ȷ$$Vw,ZlIPbd.VNΜ4lpwwwH HJZ`ԩVNJ5VcK[KD's""1Q-vsU76;"N˔j4Ȇ2U7A^ \l||/_|<81/~ nM9̂Q?Mlݾ8xU~!)kzԛ8u0 Xgxs/O)B!KU踅 kN.tLxڳ ?8v1,EEn2zCie9I,{RSϮ}choڳUMr9SM#GZP(7ݵ,῟ƍK}|>y%waí69zj57C7kVWQ ֝ ‹gfeZ}8d` Oĝ6h7̘ILZ>G#ųsr(R*/>0j TYM7}4-_KzƋ79ϧ ״?7$O2^|ʤɼ7L,KbpwcEEEt.fZ>}(<,?w?}6axy=n8Y}N9͋ i_ϋ{U F˭\d.4y.TQQA V>3"/RU1FE޼CH`Xl4RIq'y`[mYTjQБü~VH:R ˣ/m[bpAΨCݻOU׭#)'wF 8{,[͍߽w/v=ր /Z]cRG5 !͜17+ՀT;T ⋇=THDGlY,6Xіcz*p {\72& RxأrhJ[՛Ee8L0w3^PLMI 6e ~|#Mi[tbtј_RMn/F֣1mtRT!CcHH$Y%y^{6**-]fM$=w}v,z^M'DDF˖K^dQ[k'DEE񻢉(;q&O@6!&9M?jm >r>q FI98K@cws91b7枃u۷Y цM6βh8!"?ηцg4Ѓ̔~zsvTJv v5T7uuJH 6D&zF {t$OK22{Ntr]ذrY=\-olzWO(Z /ٖ23kK?@vͣ9h:ٿt:R,]XCW6=k-W1<=;Vs\fc͙R1@ZpL!W(Kh:.g آEA)qFӖ.AoJ&ӿ;/qѯr*W{TVλIl:ԓfl7N|~X4ЎxqpXcvd<:Kii*ĮhbƘg2#[;= 'X 8հU?*=M'ƍq%[N20ޗrǦMy 9)7WcZv1L`#h:o=Κ.I.oم 5c NΟ([|\%i8M mnJS>^Ʋ$kSr|k82Z_wľ^ %LTamt^B6=M'y=("-^ltRXXGZ=-.ohÆ\2X=j'zz\XXGO[~&Lh\ ݶ$1<:j#=L?={rsor6ߥ[r=A 'I2N=~"ISc|2zst҉8PJZ=۹4f@zdj=ܰ!!M'uu&1Pu.*:_INUZ/YE߫XJC&$3  h⫱GikhtH[Sc[ͷR֧22v唜\Mwޕ@=zҒ%dq0tVk﾿BｗFjʇt޲H-pk}fxqEI٥^.R#ZDgULR_#r:[+T֓7MpU$PmJ BIac1hB4("=;jlbГ Vѭ>t͘Ѻf2 :~2x23k23k;]L}zIQY._VNw^NOSK/][uD`Ǿ9yytt]FFzMF^V)7WCIIJ_k6!"rq' !mc|S2&ؐSzG {t$O MchQxUz̩XN՞~xt[X~WI`G–NLG{XƏoȳxqEӉ^֭a-bPZ/)_J;wSeKjj tLƎGϿX6ޖ1Zڱv촯6h4bx*{溻_rLTTMmtlz0gɒ-F [`=zi[B sڬD.Ѹq4^ ͛@nn3 @FGLצ_dZfҐ\.MV!&rqzxy8":|4ܹ֛GVoʚ5Ƴ#m^r1V5:fnZ۽xDxS.yyܗ`Jc7X~Ŭ:'$gj*'Dh:RRiϫnjh^C"a{޽+h($IJ1!,܍*<)nn"R(D$~~R.EFP-],?h L&W^Oݻ *)Ry<=%J4kVwrw6gYfoe4wn͝@55:tNc)-MEFc[n1覛h`߽Y_tL|/y`P/rV7X&9UK]"B @'qK|"4tZ_}9]Z\D־?1w:;""rwӭ[om*4gYn_̛HRv.gI4Zm$H.\!=\\\Z}t2NoMB!S"{I < TҟZlr"!g_Rc 꾪:}ɤ0LcJT\zePo꽓zƖ\+FA)êjth0dbLTT-eGM /sUJ6S>\UFǒ2ZPrCO+qqt?g# S{ο{ZA^ ߉Yݓ˃Jdb]g@oἑaEY6=u*xTJ3 F#dt!Sp>uS~Y/!36)/X"=XN_&^.S҆k nK"7sKt2հ:db$"R&VtphL F.h53aHP|˘>"j}IjtWwFϛ98Ԟ9*TgGR2Q&_$rLR88[ǜ278Ze4+{g6=tFTivwݡCamt%5$+8b]K{{f=Y{\7uWiTQ}'n~ƠвS6aeXZ|Ѹ7 ԴgsJ:F3 z""2Qz*ku_Y%U mWSsu1L *Xe5u ؞pY-?ͣhu{* zSrJT#YXh:"#S3o=t|Mjfc6喫_B|(r"mjrN&PC)>?]1 Ĭe#GF7 \5@J5qks|}fXJnۂ9:}Io{K54斉\Tw&tU~{c\ZJ#a#x N:r_|T3hj,G䗫fElԛK>k;Òw>^X9c5:Cƣ攩>){:7h*>K~4M'$3?tx9]JW4w^=H8J\CWL" pv.mRA_{FU$RHIDUu~w^e5 Fk\:ѲwmD$d^nTD4YWUFgEocinKk2pB#*cF#ۦ7'%e[k8nRqT"*"FYFozA:v)Ik=!#eLHX0`t=tFok>";<*9NO&4BK  U 6E],(".Fw+kAQPfCA@@JBH'u2CoBd <<NsyӨrZYy3GsH b|ĘzGjmAG- 3B$Z5Cn~Jk;$#4>HMGFT+ko/]ؼEN;9-~=H"y|t~Y};{)xexrmM9lmiܪ]Goɻx5+~Is3Z7 z]~_XliB!ytŎ37jego͝u-|6O8e/4Q&ڽ|`ny]W!F-bc?/"11!{>4qPw]p&QfDo;؝ >Zyj~Po+w\-^(4ڜ}rk=O/}7=Vy98ǧO]V:5YG0B{ ڈvO-N:QhFFw(p={]y1JR~*y/1"h{|yˀP\gtDBSŸY=֫j"Y=WniyVŗv˜qO8f#3_X`qJT fU25̺鬋Ԫ;.xZbLE!(?=ևl1զR^zI?6gÓyWI5Y3,<՝{EN$$2%D|l[7gSdSS+w4'u_l"K ޓ;/M;ש|t .Xj}tp;-;0!qwUVoRa}"wxؔCv>ǟ6I2P\=SҏyNthnEy.PJ)= {1}؁Uz_qIQ׎}IR _l?]mJ4o]ެ8z OǛ}U` o5EXoĴ&_k=!H۟5:5jLQ7zFU 4{I^]kbDWw1Rʍ{If:!D33:DV3QsJ̷IR#W8"yBj#]w+T2QbJ?dݒ[vj71@kE5wUJ-:aGIGmZU~p(H *Q7IWpZuDgٜԙ1P8HEmyV{WAjre]/N.Pw/qpס eϸsQ>zGOTbmkSDzBȘ~1c歲zӒg__^7n;I+ 3my/T^}oi Q vbs@uJp|y 3A 9[c]TkvFx]&7V?8!ߋkSˎiORdYU"6Y(nЧRpMnJ1`j)N-{sy߉{%99Fϩ>ZU-ILM~ TvrJXB7뜮x5; ۟eBB:QcCKUl1Z>%dWt G ?g t'N4~w絪*RnR%KG=z@շЩ9g\wL>X95=ʓu*kIG6/;~%ofOAlI!v !Zad:t"H>>`@lY>6-!`^_$w[wNї19eGBHxW<8ą&36ӫO :(z@!LH9~߉&I^LmBԝņU]Fې.J r R{+)Jg*3"6"gǖok{]#W4!x'c('5e*px«K_R^ZI=I\Kh_m/W>t-nO6Ovx w/os ij>.$P) Rg;/xwKTJILΩνflר$Ԙƶ%9::ů9"<]1Y2$1Ϳھؓ:rcѲ-+jkUIz^yߑ9Ξ/ٛg5:$਼]cwoZg tϋŮm1O\\CUz'xIm)uA׊\w%F39jkn ׍A[s + =kWJ!dG[{<:cr7U̓\}F^GfyjzbU9Fbއ[R{+!p%^KI1ȳ0JZז֙R?m_xoڬ?uèg~LpU5̘t*}8+J>|۸#n;ϣu ze)/C ?ֺ`tDebG>9u5o3sjzGGqiډoTZckxqKObkۚ/W\eu ?1xf<BIbªy3^\@&A3yRvAɪ#%.19:c7-1M+iqs#*˷<81vlO3i-SRkP=mϘl~~Qbo^1UV5|xߋ*E(I=Qy\s;^+J(cғ5ݶt\ee}!Ja׾0o-UNSY΄}ll;{pTJ#Y:bm̽As<>5Oe$2cDa; fZuD>[H8abBWZx{M~?+Bm1hqOO0f_~1 npW}^rKqLX/wҴ?sѵ]z -T^%)L2CGo-RzV՛"1*غ ҩ4(1H5YG4} 'A:UM\TfÓ*V.S[^vA)9J'<ઌo$&O;ǷPݙPk7+yi -(xޙnpBN w/qi?H%VX=S{sBWqz0jT' |ϔc䟦'Vm|r׍p\XO kr DkT">zKoyI?BH]]/󴱳c _שZx*Jf}YV.͏iiS 6̹}V\4*,-!Ó6&\syGS{NV(:_/}O@>{U)J=y?^/:~^T~FplK]>ȐQ Pgg_7oc bC%Gmm( ]+r)7=}]wN@USaz[:'!|,}^Fu}n%ρGVw,Gvg!DGV;9'N+)'GѪ)'֛1v J9N kKb{nDߜ(+՛NT{6vAsYI]PRr҈>u-U0*:sdGN}xnڵ&rG~ey_T:o9R\e|he5X-JNMsfN]x螢_ۑ[:lewqԡ9^* ѝJgpծrńĆ=~>sNxgs8yJmjeMp|\jܮykFcDՄuV14:[J"}W]ّ$D$I'U7M:!RT_OW-c]oV/Gy[CLCs5tR̹I*OYPl32Xpt7gN +h\a_%o30.) V+벇[|(ZW/e]5%UHЅK t>117 N3]B$JR`aUª˷9ʓ_TA6Am:%RJ3G{nHH?b1ccٳWhx.B K ,3s c$T&F7Vs_5uElqqvřˍŗt>G33%B#ikK wLIb=8 F;59*仇g7?&E#^VF)a葃λ8/(J Y/CIɌHZҝ,ߖxŀZsoD!TSJ0T%)>.5'1*}L*Z]aK :N!efrفz1p^%R }gf9t?9r m J 'p EᰅK/#8tٳWPY^(q EdƣKKW:bv.IDATyvNkYJUpjCh= .NOJ333g"ED+HIۖ @wuT:iI jG ?(3|ho?% N\Y|I}OƋ$tWH:qY}Pr:Qn'q ,Z7UVtB @wLUa0"XbTQ;.z<1IDZ3t 1w/;!!S[k]$8NaL28ƈdB#9TL٫V|D6BR#gbN4 %\VignetteEngine{knitr::rmarkdown} %\VignetteIndexEntry{Frequently Asked Questions} %!\VignetteEncoding{UTF-8} \usepackage[utf8]{inputenc} --- ```{r} set.seed(2564) library(ade4) library(adegraphics) ``` # How to personalize plots ## How to update title axes? ```{r} df <- data.frame(x = rep(1:10,1), y = rep(1:10, each = 10), ms_li = runif(100, min = -5, max = 4)) s.value(df[, 1:2], df$ms_li, paxes.draw = TRUE) ``` ### Size titles on axes `xlab.cex` and `ylab.cex` manage the size titles on the `x` and `y` axes. ```{r} s.value(df[, 1:2], df$ms_li, paxes.draw = TRUE, xlab = "Longitude", xlab.cex = 0.5, ylab = "Latitude", ylab.cex = 0.5 ) ``` ### Size labels on axes `scales.x.cex` and `scales.y.cex` manage the sizes labels on the `x` and `y` axes. ```{r} s.value(df[, 1:2], df$ms_li, paxes.draw = TRUE, scales.x.cex = 0.5, scales.y.cex = 0.5 ) ``` ### Margin of axis `layout.heights = list(bottom.padding = 1)` manages the margin of the bottom axis. This enlarges the space for a larger title axis. ```{r} s.value(df[, 1:2], df$ms_li, paxes.draw = TRUE, xlab = "Longitude", xlab.cex = 2, ylab = "Latitude", ylab.cex = 2, layout.heights = list(bottom.padding = 2) ) ``` ## How to update label's boxes ? ```{r} x0 <- runif(50, -2, 2) y0 <- runif(50, -2, 2) s.label(data.frame(x0, y0)) ``` ### Remove boxes around labels ```{r} s.label(data.frame(x0, y0), plabels.boxes.border = 0) s.label(data.frame(x0, y0), plabels.boxes.draw = FALSE, ppoints.cex = 0) ``` ### Color of label's boxes ```{r} s.label(data.frame(x0, y0), plabels.boxes.col = "orange") ``` ### Border of label's boxes ```{r} s.label(data.frame(x0, y0), plabels.boxes.border = "blue", plabels.boxes.lwd = 2) ``` adegraphics/inst/doc/adegraphics.Rmd0000644000176200001440000015643014572055321017201 0ustar liggesusers--- title: "The `adegraphics` package" author: "Alice Julien-Laferrière, Aurélie Siberchicot and Stéphane Dray" date: '`r Sys.Date()`' output: html_vignette: number_sections: yes toc: yes bibliography: adegraphics.bib vignette: > %\VignetteIndexEntry{The `adegraphics` package} %\VignetteEngine{knitr::rmarkdown} %\VignetteEncoding{UTF-8} \usepackage[utf8]{inputenc} ---


The `adegraphics` package [@Siberchicot2017] is a complete reimplementation of the graphical functionalities of the `ade4` package [@Dray2007]. The package has been initially designed to improve the representation of the outputs of multivariate analyses performed with `ade4` but as its graphical functionalities are very general, they can be used for other purposes. The `adegraphics` package provides a flexible environment to produce, edit and manipulate graphs. We adopted an *object oriented* approach (a graph is an object) using `S4` classes and methods and used the visualization system provided by the `lattice` [@Sarkar2008] and `grid` [@Murrell2005] packages. In `adegraphics`, graphs are R objects that can be edited, stored, combined, saved, removed, etc. Note that we tried to facilitate the handling of `adegraphics` by `ade4` users. Hence, the name of functions and parameters has been preserved in many cases. The main changes are listed in the appendix of this vignette so that it should be quite easy to use `adegraphics`. However, several new functionalities (graphical parameters, creation and manipulation of graphical objects, etc.) are now available and detailed in this vignette. The *adelist* mailing list can be used to send questions and/or comments on `adegraphics` (see )
An overview of object classes ============================= In `adegraphics`, a user-level function produces a plot that is stored (and returned) as an object. The class architecture of the objects created by `adegraphics` functions is described in [Figure 1](#classes).
Figure 1: Classes structure and user-level functions

This class management highlights a hierarchy with two parent classes: - `ADEg` for simple graphs. It contains the display of a single data set using only one kind of representation (e.g., arrows, points, lines, etc.) - `ADEgS` for multiple graphs. It contains a collection of at least two simple graphs (`ADEg`, `trellis` or `ADEgS`) The `ADEg` class has five child classes which are also subdivided in several child classes. Each of these five child classes is dedicated for a particular graphical data representation: - `ADEg.S1`: unidimensional graph of a numeric score - `ADEg.S2`: bidimensional graph of xy coordinates (`matrix` or `data.frame` object) - `ADEg.C1`: bidimensional graph of a numeric score (bar chart or curve) - `ADEg.T`: heat map-like representation of a data table (`matrix`, `data.frame`, `dist` or `table` object) - `ADEg.Tr`: ternary plot of xyz coordinates (`matrix` or `data.frame` object) The `ADEg` class and its five child classes are virtual: it is not allowed to create object belonging to these classes. Users can only create objects belonging to child classes by calls to user functions (see the [User functions](#user-functions) section). Simple graph (`ADEg` object) ============================ In the `adegraphics` package, a graph is created by a call to a user function and stored as an R object. These functions allow to display the raw data but also the outputs of a multivariate analysis. The following sections describe the different graphical functions available in the package. User functions -------------- Several user functions are available to create a simple graph (stored as an `ADEg` object in R). Each function creates an object of a given class (see [Figure 1](#classes)). [Table 1](#functionsADEg) lists the different functions, their corresponding classes and a short description. The `ade4` users would not be lost: many functions have kept their names in `adegraphics`. The main changes are listed in [Table 2](#functionsADEgchanged).
Table 1: Graphical functions available in `adegraphics` Function Class of the returned object Description --------- ------------------------------ -------------- `s1d.barchart` `C1.barchart` 1-D plot of a numeric score by bars `s1d.curve` `C1.curve` 1-D plot of a numeric score linked by curves `s1d.curves` `C1.curves` 1-D plot of multiple scores linked by curves `s1d.density` `C1.density` 1-D plot of a numeric score by density curves `s1d.dotplot` `C1.dotplot` 1-D plot of a numeric score by dots `s1d.gauss` `C1.gauss` 1-D plot of a numeric score by Gaussian curves `s1d.hist` `C1.hist` 1-D plot of a numeric score by bars `s1d.interval` `C1.interval` 1-D plot of the interval between two numeric scores `s1d.boxplot` `S1.boxplot` 1-D box plot of a numeric score partitioned in classes `s1d.class` `S1.class` 1-D plot of a numeric score partitioned in classes `s1d.distri` `S1.distri` 1-D plot of a numeric score by means/tandard deviations computed using an external table of weights `s1d.label` `S1.label` 1-D plot of a numeric score with labels `s1d.match` `S1.match` 1-D plot of the matching between two numeric scores `s.arrow` `S2.arrow` 2-D scatter plot with arrows `s.class` `S2.class` 2-D scatter plot with a partition in classes `s.corcircle` `S2.corcircle` Correlation circle `s.density` `S2.density` 2-D scatter plot with kernel density estimation `s.distri` `S2.distri` 2-D scatter plot with means/standard deviations computed using an external table of weights `s.image` `S2.image` 2-D scatter plot with loess estimation of an additional numeric score `s.label` `S2.label` 2-D scatter plot with labels `s.logo` `S2.logo` 2-D scatter plot with logos (pixmap objects) `s.match` `S2.match` 2-D scatter plot of the matching between two sets of coordinates `s.Spatial` `S2.label` Mapping of a `Spatial*` object `s.traject` `S2.traject` 2-D scatter plot with trajectories `s.value` `S2.value` 2-D scatter plot with proportional symbols `table.image` `T.image` Heat map-like representation with colored cells `table.value` `T.value` or `T.cont` Heat map-like representation with proportional symbols `triangle.class` `Tr.class` Ternary plot with a partition in classes `triangle.label` `Tr.label` Ternary plot with labels `triangle.match` `Tr.match` Ternary plot of the matching between two sets of coordinates `triangle.traject` `Tr.match` Ternary plot with trajectories
Table 2: Changes in functions names between `ade4` and `adegraphics` Function in `ade4` Equivalence in `adegraphics` ------------------------------------------- ------------------------------ `table.cont`, `table.dist`, `table.value` `table.value` [^1] `table.paint` `table.image` `sco.boxplot` `s1d.boxplot` `sco.class` `s1d.class` `sco.distri` `s1d.distri` `sco.gauss` `s1d.gauss` `sco.label` `s1d.label` `sco.match` `s1d.match` `sco.quant` no equivalence `s.chull` `s.class`[^2] `s.kde2d` `s.density` `s.match.class` superposition of `s.match` and `s.class` `triangle.biplot` `triangle.match` `triangle.plot` `triangle.label` `s.multinom` `triangle.multinom` [^1]: The `table.value` function is now generic and can handle `dist` or `table` objects as arguments. [^2]: Convex hulls are now drawn by the `s.class` function (argument `chullSize`.) Arguments --------- The list of arguments of a function are given by the `args` function. ```{r label=chunk1} library(ade4) library(adegraphics) args(s.label) ``` Some arguments are very general and present in all user functions: - `plot`: a logical value indicating if the graph should be displayed - `storeData`: a logical value indicating if the data should be stored in the returned object. If `FALSE`, only the names of the data are stored. This allows to reduce the size of the returned object but it implies that the data should not be modified in the environment to plot again the graph. - `add`: a logical value indicating if the graph should be superposed on the graph already displayed in the current device (it replaces the argument `add.plot` in `ade4`). - `pos`: an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if `storeData` is `FALSE`. - `…`: additional graphical parameters (see below) Some other arguments influence the graphical outputs and they are thus specific to the type of produced graph. [Figure 2](#gargsVSclass) summarizes some of these graphical parameters available for the different functions. We only reported the parameters stored in the `g.args` slot of the returned object (see the [Parameters in `g.args`](#gargs) section).
Figure 2: Specific arguments in each object class ```{r label=fig-gargsVSclass, include=TRUE, echo=FALSE, fig.width=7, fig.height=8} source("gargsVSclass.R") ```


The `ade4` users would note that the names of some arguments have been modified in `adegraphics`. The [Appendix](#appendix) gives a full list of these modifications. Slots and Methods ----------------- A call to a graphical function (see the [User functions](#user-functions) section) returns an `ADEg` object. Each object is defined by a number of slots and several methods are associated to this class. Let us consider the `olympic` data set available in the `ade4` package. A principal component analysis (PCA) is applied on the `olympic$tab` table that contains the results for 33 participating athletes at the 1988 summer olympic games: ```{r label=chunk2} data(olympic) pca1 <- dudi.pca(olympic$tab, scannf = FALSE) ``` The barplot of eigenvalues is then drawn and stored in `g1`: ```{r label=plot1, fig.height=4, fig.width=4} g1 <- s1d.barchart(pca1$eig, p1d.horizontal = F, ppolygons.col = "white") ```
The class of the `g1` object is `C1.barchart` which extends the `ADEg` class: ```{r label=chunk3} class(g1) showClass("C1.barchart") ```
This object contains different slots: ```{r label=chunk4} slotNames(g1) ```
These slots are defined for each `ADEg` object and contain different types of information. The package `adegraphics` uses the capabilities of the `lattice` package to display a graph (by generating a `trellis` object). Hence, several slots contain information that will be passed in the call to the `lattice` functions: - `data`: a list containing information about the data. - `trellis.par`: a list of graphical parameters that are directly passed to the `lattice` functions using the `par.settings` argument (see the [Parameters in `trellis.par`](#trellispar) section). - `adeg.par`: a list of graphical parameters defined in `adegraphics`. The list of parameters can be obtained using the `adegpar` function (see the [Parameters in `adeg.par`](#adegpar) section). - `lattice.call`: a list of two elements containing the information required to create the `trellis` object: `graphictype` (the name of the `lattice` functions that should be used) and `arguments` (the list of parameter values required to obtain the `trellis` object). - `g.args`: a list containing at least the different values of the graphical arguments described in [Figure 2](#gargsVSclass) (see the [Parameters in `g.args`](#gargs) section). - `stats`: a list of internal preliminary computations performed to display the graph. - `s.misc`: a list of other internal parameters. - `Call`: an object of class `call` containing the matched call.
These different slots can be extracted using the `@` operator: ```{r label=chunk5} g1@data ```
All these slots are automatically filled during the object creation. The `trellis.par`, `adeg.par` and `g.args` can also be modified *a posteriori* using the `update` method (see the [Customizing a graph](#update) section). This allows to customize graphs after their creation. We consider the correlation circle that depicts the correlation between PCA axes and the results for each event: ```{r label=plot2, fig.width=4, fig.height=4} g2 <- s.corcircle(pca1$co) ``` ```{r label=chunk6} class(g2) g2@g.args ```
The argument `fullcircle` can be updated *a posteriori* so that the original object is modified: ```{r label=plot3, fig.width=4, fig.height=4} update(g2, fullcircle = FALSE) g2@g.args ``` Several other methods have been defined for the `ADEg` class allowing to extract information, modify or combine objects: - `getcall`, `getlatticecall` and `getstats`: these accessor methods return respectively the `Call`, the `lattice.call` and the `stats` slots. - `getparameters`: this method returns the `trellis.par` and/or the `adeg.par` slots. - `show`, `print` and `plot`: these methods display the `ADEg` object in the current device or in a new one. - `gettrellis`: this method returns the `ADEg` object as a `trellis` object. It can then be exploited using the `lattice` and `latticeExtra` packages. - `superpose`, `+` and `add.ADEg`: these methods superpose two `ADEg` graphs. It returns a multiple graph object of class `ADEgS` (see the [The basic methods for superposition, juxtaposition and insertion](#superpose) section). - `insert`: this method inserts an `ADEg` graph in an existing one or in the current device. It returns an `ADEgS` object (see the [The basic methods for superposition, juxtaposition and insertion](#superpose) section). - `cbindADEg`, `rbindADEg`: these methods combine several `ADEg` graphs. It returns an `ADEgS` object (see the [The basic methods for superposition, juxtaposition and insertion](#superpose) section). - `update`: this method modifies the graphical parameters after the `ADEg` creation. It updates the current display and returns the modified `ADEg` (see the [Customizing a graph](#update) section). For instance: ```{r label=chunk7} getcall(g1) ## equivalent to g1@Call ``` A biplot-like graph can be obtained using the `superpose` method. The result is a multiple graph: ```{r label=plot4, fig.width=4, fig.height=4} g3 <- s.label(pca1$li) g4 <- s.arrow(5 * pca1$c1, add = TRUE) class(g4) ``` In addition, some object classes have specific methods. For instance, a `zoom` method is available for `ADEg.S1` and `ADEg.S2` classes. For the `ADEg.S2` class, the method `addhist` (see the [The basic methods for superposition, juxtaposition and insertion](#superpose) section) decorates a 2-D graph by adding marginal distributions as histograms and density lines (this method replaces and extends the `s.hist` function of `ade4`). ```{r label=plot5, fig.width=4, fig.height=4} zoom(g3, zoom = 2, center = c(2, -2)) ``` Multiple graph (`ADEgS` object) =============================== The `adegraphics` package provides class `ADEgS` to manage easily the combination of several graphs. This class allows to deal with the superposition, insertion or juxtaposition of several graphs in a single object. An object of this class is a list containing several graphical objects and information about their positioning. Different ways to generate `ADEgS` objects are described below. Slots and Methods ----------------- The class `ADEgS` is used to store multiple graphs. Different slots are associated to this class (use the symbol `@` to extract information): - `ADEglist`: a list of graphs stored as `trellis`, `ADEg` and/or `ADEgS` objects. - `positions`: a matrix containing the positions of the graphs. It has four columns and as many rows as the number of graphical objects in the `ADEglist` slot. For each graph (i.e. row), it contains the coordinates of the bottom-left and top-right corners in `npc` units (i.e. normalized parent coordinates varying between 0 and 1). - `add`: a square binary matrix with as many rows and columns as the number of graphical objects in the `ADEglist` slot. It allows to manage the superposition of graphs: the value at the i-th row and j-th column is equal to 1 if the j-th graphical object is superposed on the i-th. Otherwise, this value is equal to 0. - `Call`: an object of class `call` containing the matched call. Several methods have been implemented to obtain information, edit or modify `ADEgS` objects. Several methods are inspired from the management of `list` in R: - `[`, `[[` and `$`: these methods extract one or more elements from the `ADEgS` object. - `getpositions`, `getgraphics` and `getcall`: these methods return the `positions`, the `ADEglist` and the `Call` slots, respectively. - `names` and `length`: these methods return the names and number of graphs contained in the object. - `[[<-` and `names<-`: these methods replace a graph or its name in an `ADEgS` object (acts on the `ADEglist` slot). - `show`, `plot` and `print`: these methods display the `ADEgS` object in the current device or in a new one. - `superpose` and `+`: these methods superpose two graphs. It returns a multiple graph object of class `ADEgS` (see the [The basic methods for superposition, juxtaposition and insertion](#superpose) section). - `insert`: this method inserts a graph in an existing one or in the current device. It returns a multiple graph object of class `ADEgS` (see the [The basic methods for superposition, juxtaposition and insertion](#superpose) section). - `cbindADEg`, `rbindADEg`: these methods combine several graphs. It returns an `ADEgS` object (see the [The basic methods for superposition, juxtaposition and insertion](#superpose) section). - `update`: this method modifies the names and/or the `positions` of the graphs contained in an `ADEgS` object. It updates the current display and returns the modified `ADEgS`. We will show in the next sections how these methods can be used to deal with `ADEgS` objects. Creating an `ADEgS` object by hand ---------------------------------- The `ADEgS` objects can be created by easy manipulation of several simple graphs. Some methods (e.g., `insert`, `superpose`) can be used to create a compilation of graphs by hand. ### The basic methods for superposition, juxtaposition and insertion The functions `superpose`, `+` and `add.ADEg` allow the superposition of an `ADEg`/`ADEgS` object on an `ADEg`/`ADEgS` object. The vector `olympic$score` contains the total number of points computed for each participant. This vector is used to generate a `factor` partitioning the participants in two groups according to their final result (more or less than 8000 points): ```{r label=chunk8} fac.score <- factor(olympic$score < 8000, labels = c("MT8000", "LT8000")) ``` These two groups can be represented on the PCA factorial map using the `s.class` function: ```{r label=plot6, fig.width=4, fig.height=4} g5 <- s.class(pca1$li, fac.score, col = c("red", "blue"), chullSize = 1, ellipseSize = 0, plabels.cex = 2, pbackground.col = "grey85", paxes.draw = TRUE) ``` The graph with the labels (object `g3`) can then be superposed on this one: ```{r label=plot7, fig.width=4, fig.height=4} g6 <- superpose(g5, g3, plot = TRUE) ## equivalent to g5 + g3 class(g6) ``` In the case of a superposition, the graphical parameters (e.g., background and limits) of the first graph (the one below) are used as a reference and applied to the second one (the one above). Note that it is also possible to use the `add = TRUE` argument in the call of a simple user function (functions described in [Table 1](#functionsADEg)) to perform a superposition. The graph `g6` can also be obtained by: ```{r label=chunk9, eval=FALSE} g5 s.label(pca1$li, add = TRUE) ``` The functions `cbindADEg` and `rbindADEg` allows to combine several graphical objects (`ADEg`, `ADEgS` or `trellis`) by rows or by columns. The new created `ADEgS` contains the list of the reduced graphs: ```{r label=plot8, fig.width=6, fig.height=6} rbindADEg(cbindADEg(g2, g3), cbindADEg(g5, g6), plot = TRUE) ``` The function `insert` allows the insertion of a graphical object on another one (`ADEg` or `ADEgS`). It takes the position of the inserted graph as an argument: ```{r label=plot9, fig.width=4, fig.height=4} g7 <- insert(g2, g6, posi = c(0.65, 0.65, 0.95, 0.95)) class(g7) ``` The different methods associated to the `ADEgS` class allow to obtain information and to modify the multiple graph: ```{r label=chunk10} length(g7) names(g7) names(g7) <- c("chulls", "labels", "cor") class(g7[1]) class(g7[[1]]) class(g7$chulls) ``` The multiple graph contains three simple graphs. It can be easily updated. For instance, the size of the inserted graph can be modified: ```{r label=plot10, fig.width=4, fig.height=4} pos.mat <- getpositions(g7) pos.mat pos.mat[3,] <- c(0.1, 0.7, 0.3, 0.9) update(g7, positions = pos.mat) ``` The graphs themselves can be modified, without affecting the global structure of the `ADEgS` object. Here, we replace the correlation circle by the barplot of eigenvalues: ```{r label=plot11, fig.width=4, fig.height=4} g7[[3]] <- g1 g7 ``` The `addhist` method adds univariate marginal distributions around an `ADEg.S2` and returns an `ADEgS` object: ```{r label=plot12, fig.width=4, fig.height=4} addhist(g3) ``` More examples are available in the help page by typing `example(superpose)`, `example(insert)`, `example(add.ADEg)` and `example(addhist)` in the R session. ### The `ADEgS` function The `ADEgS` function provides the most elementary and flexible way to create an `ADEgS` object. The different arguments of the function are: - `adeglist`: a list of several `trellis`, `ADEg` and/or `ADEgS` objects. - `positions`: a matrix with four columns and as many rows as the number of graphical objects in the `ADEglist` slot. For each subgraph, i.e. in each row, the coordinates of the top-right and the bottom-left hand corners are given in `npc` units (i.e., normalized parent coordinates varying from 0 to 1). - `layout`: an alternative way to specify the positions of graphs. It could be a vector of length 2 indicating the number of rows and columns used to split the device (similar to `mfrow` parameter in basic graphs). It could also be a matrix specifying the location of the graphs: each value in this matrix should be 0 or a positive integer (similar to `layout` function for basic graphs). - `add`: a square matrix with as many rows and columns as the number of graphical objects in the `ADEglist` slot. The value at the i-th row and j-th column is equal to 1 if the j-th graphical object is superposed to i-th one. Otherwise, this value is equal to 0. - `plot`: a logical value indicating if the graphs should be displayed. When users fill only one argument among `positions`, `layout` and `add`, the other values are automatically computed to define the `ADEgS` object. We illustrate the different possibilities to create objects with the `ADEgS` function. Simple juxtaposition using a vector as layout: ```{r label=plot13, fig.width=6, fig.height=3} ADEgS(adeglist = list(g2, g3), layout = c(1, 2)) ``` Layout specified as a matrix: ```{r label=plot14, fig.width=5, fig.height=5} mlay <- matrix(c(1, 1, 0, 1, 1, 0, 0, 0, 2), byrow = T, nrow = 3) mlay ADEgS(adeglist = list(g6, g2), layout = mlay) ``` Using the matrix of positions offers a very flexible way to arrange the different graphs: ```{r label=plot15, fig.width=5, fig.height=5} mpos <- rbind(c(0, 0.3, 0.7, 1), c(0.5, 0, 1, 0.5)) ADEgS(adeglist = list(g3, g5), positions = mpos) ``` Lastly, superposition can also be specified using the `add` argument: ```{r label=plot16, fig.width=4, fig.height=4} ADEgS(list(g5, g3), add = matrix(c(0, 1, 0, 0), byrow = TRUE, ncol = 2)) ``` More examples are available in the help page by typing `example(ADEgS)` in the R session. Automatic collections --------------------- The package `adegraphics` contains functionalities to create collections of graphs. These collections are based on a simple graph repeated for different groups of individuals, variables or axes. The building process of these collections is quite simple (definition of arguments in the call of a user function) and leads to the creation of an `ADEgS` object. ### Partitioning the data (`facets`) The `adegraphics` package allows to split up the data by one variable (`factor`) and to plot the subsets of data together. This possibility of conditional plot is available for all user functions (except the `table.*` functions) by setting the `facets` argument. This is directly inspired by the functionalities offered in the `lattice` and `ggplot2` packages. Let us consider the `jv73` data set. The table `jv73$morpho` contains the measures of 6 variables describing the geomorphology of 92 sites. A PCA can be performed on this data set: ```{r label=plot17, fig.width=4, fig.height=4} data(jv73) pca2 <- dudi.pca(jv73$morpho, scannf = FALSE) s.label(pca2$li) ``` The sites are located on 12 rivers (`jv73$fac.riv`) and it is possible to represent the PCA scores for each river using the `facets` argument: ```{r label=plot18, fig.width=7, fig.height=5.2} g8 <- s.label(pca2$li, facets = jv73$fac.riv) length(g8) names(g8) ``` The `ADEgS` returned object contains the 12 plots. It is then possible to focus on a given river (e.g., the Doubs river) by considering only a subplot (e.g., type `g8$Doubs`). The `facets` functionality is very general and available for the majority of `adegraphics` functions. For instance, with the `s.class` function: ```{r label=plot19, fig.width=7, fig.height=5.2} s.class(pca2$li, fac = jv73$fac.riv, col = rainbow(12), facets = jv73$fac.riv) ``` ### Multiple axes All 2-D functions (i.e. `s.*`) returning an object inheriting from the `ADEg.S2` class have the `xax` et `yax` arguments. These arguments allow to choose which column of the main argument (i.e. `df`) should be plotted as x and y axes. As in `ade4`, these two arguments can be simple integers. In `adegraphics`, the user can also specify vectors as `xax` and/or `yax` arguments to obtain multiple graphs. Here, we represent the different correlation circles associated to the first four PCA axes of the olympic data set: ```{r label=plot20, fig.width=6, fig.height=6} pca1 <- dudi.pca(olympic$tab, scannf = FALSE, nf = 4) g9 <- s.corcircle(pca1$co, xax = 1:2, yax = 3:4) length(g9) names(g9) g9@positions ``` ### Multiple score All 1-D functions (i.e. `s1d.*`) returning an object inheriting from the `ADEg.C1` or `ADEg.S1` classes have the `score` argument. Usually, this argument should be a numeric vector but it is also possible to consider an object with several columns (`data.frame` or `matrix`). In this case, an `ADEgS` object is returned in which one graph by column is created. For instance for the `olympic` data set, we can represent the link between the global performance (`fac.score`) and the PCA scores on the first four axes (`pca1$li`): ```{r label=plot21, fig.width=6, fig.height=6} dim(pca1$li) s1d.boxplot(pca1$li, fac.score, col = c("red", "blue"), psub = list(position = "topleft", cex = 2)) ``` ### Multiple variable Some user functions (`s1d.density`, `s1d.gauss`, `s1d.boxplot`, `s1d.class`, `s.class`, `s.image`, `s.traject`, `s.value`, `triangle.class`) have an argument named `fac` or `z`. This argument can have several columns (`data.frame` or `matrix`) so that each column is used to create a separate graph. For instance, we can represent the distribution of the 6 environmental variables on the PCA factorial map of the `jv73$tab` data set: ```{r label=plot22, fig.width=6, fig.height=4} s.value(pca2$li, pca2$tab, symbol = "circle") ``` ### Outputs of the `ade4` package Lastly, we reimplemented all the graphical functions of the `ade4` package designed to represent the outputs of a multivariate analysis. The functions `ade4::plot.*`, `ade4::kplot.*`, `ade4::scatter.*` and `ade4::score.*` return `ADEgS` objects. It is now very easy to represent or modify these graphical outputs: ```{r label=plot23, fig.width=6, fig.height=6} data(meaudret) pca3 <- dudi.pca(meaudret$env, scannf = FALSE) pca4 <- dudi.pca(meaudret$spe, scale = FALSE, scannf = FALSE) coi1 <- coinertia(pca3, pca4, scannf = FALSE, nf = 3) g10 <- plot(coi1) class(g10) names(g10) g10@Call ``` Customizing a graph =================== Compared to the `ade4` package, the main advantage of `adegraphics` concerns the numerous possibilities to customize a graph using several graphical parameters. These parameters are stored in slots `trellis.par`, `adeg.par` and `g.args` (see the [Slots and Methods](#slots) section) of an `ADEg` object. These parameters can be defined during the creation of a graph or updated *a posteriori* (using the `update` method). Parameters in `trellis.par` --------------------------- The `trellis.par` slot is a list of parameters that are directly included in the call of functions of the `lattice` package. The name of parameters and their default value are given by the `trellis.par.get` function of `lattice`. ```{r label=chunk11} library(lattice) sort(names(trellis.par.get())) ``` Hence, modifications of some of these parameters will modify the graphical display of an `ADEg` object. For instance, margins are defined using `layout.widths` and `layout.heights` parameters, `clip` parameter allows to overpass panel boundaries and `axis.line` and `axis.text` allow to customize lines and text of axes. ```{r label=plot24, fig.width=7, fig.height=3.5} d <- scale(olympic$tab) g11 <- table.image(d, plot = FALSE) g12 <- table.image(d, axis.line = list(col = "blue"), axis.text = list(col = "red"), plot = FALSE) ADEgS(c(g11, g12), layout = c(1, 2)) ``` Parameters in `adeg.par` ------------------------ The `adeg.par` slot is a list of graphical parameters specific to the `adegraphics` package. The name of parameters and their default value are available using the `adegpar` function which is inspired by the `par` function of the `graphics` package. ```{r label=chunk12} names(adegpar()) ``` A description of these parameters is available in the help page of the function (`?adegpar`). Note that each `adeg.par` parameter starts by the letter ’p’ and its name relates to the type of graphical element considered (`ptable` is for tables display, `ppoints` for points, `parrows` for arrows, etc). Each element of this list can contain one or more sublists. Details on a sublist are obtained using its name either as a parameter of the `adegpar` function or after the `$` symbol. For example, if we want to know the different parameters to manage the display of points: ```{r label=chunk13} adegpar("ppoints") adegpar()$ppoints ``` The full list of available parameters is summarized in [Figure 3](#paramVSparam).
Figure 3: Parameters that can be set with the `adegpar` function. ```{r label=fig-paramVSparam, echo=FALSE, fig.width=7, fig.height=7} source("paramVSparam.R") ```

The ordinate represents the different sublists and the abscissa gives the name of the parameters available in each sublist. Note that some row names have two keys separated by a dot: the first key indicates the first level of the sublist, etc. For example `plabels.boxes` is the sublist `boxes` of the sublist `plabels`. The parameters `border`,`col`, `alpha`, `lwd`, `lty` and `draw` in `plabels.boxes` allow to control the aspect of the boxes around labels. According to the function called, only some of the full list of `adeg.par` parameters are useful to modify the graphical display. [Figure 4](#paramVSfunction) indicates which parameters can affect the display of an object created by a given user function. For example, the background (`pbackground` parameter) can be modified for all functions whereas the display of ellipses (`pellipses` parameter) affects only three functions.
Figure 4: Effect of `adeg.par` parameters in `adegraphics` functions. ```{r label=fig-paramVSfunction, echo=FALSE, fig.width=7, fig.height=10} source("paramVSfunction.R") ```

### Global assignment The `adegpar` function allows to modify globally the values of graphical parameters so that changes will affect all subsequent displays. For example, we update the size/color of labels and add axes to a plot: ```{r label=plot25, fig.width=6, fig.height=3} oldadegpar <- adegpar() adegpar("plabels") g13 <- s.label(dfxy = pca1$li, plot = FALSE) adegpar(plabels = list(col = "blue", cex = 1.5), paxes.draw = TRUE) adegpar("plabels") g14 <- s.label(dfxy = pca1$li, plot = FALSE) ADEgS(c(g13, g14), layout = c(1, 2)) ``` As the `adegpar` function can accept numerous graphical parameters, it can be used to define some graphical themes. The next releases of `adegraphics` will offer functionalities to easily create, edit and store graphical themes. Here, we reassign the original default parameters: ```{r label=chunk14} adegpar(oldadegpar) ``` ### Local assignment A second option is to update the graphical parameters locally so that the changes will only modify the object created. This is done using the dots (`...`) argument in the call to a user function. In this case, the default values of parameters in the global environment are not modified: ```{r label=plot26, fig.width=4, fig.height=4} adegpar("ppoints") s.label(dfxy = pca1$li, plabels.cex = 0, ppoints = list(col = c(2, 4, 5), cex = 1.5, pch = 15)) adegpar("ppoints") ``` In the previous example, we can see that parameters can be either specified using a ’`.`’ separator or a list. For instance, using `plabels.cex = 0` or `plabels = list(cex = 0)` is strictly equivalent. Moreover, partial names can be used if there is no ambiguity (such as `plab.ce = 0` in our example). Parameters in `g.args` ---------------------- The `g.args` slot is a list of parameters specific to the function used (and thus to the class of the returned object). Several parameters are very general and used in all `adegraphics` functions: - `xlim`, `ylim`: limits of the graph on the x and y axes - `main`, `sub`: main title and subtitle - `xlab`, `ylab`: labels of the x and y axes - `scales`: a list determining how the x and y axes (tick marks dans labels) are drawn; this is the `scales` parameter of the `xyplot` function of `lattice` The `ADEg.S2` objects can also contain spatial information (map stored as a `Spatial` object or neighborhood stored as a `nb` object): - `Sp`, `sp.layout`: objects from the `sp` package to display spatial objects, `Sp` for maps and `sp.layout` for spatial widgets as a North arrow, scale, etc. - `nbobject`: object of class `nb` or `listw` to display neighbor graphs. When the `facets` (see the [Partitioning the data (`facets`)](#facets) section) argument is used, users can modify the parameter `samelimits`: if it is `TRUE`, all graphs have the same limits whereas limits are computed for each subgraph independently when it is `FALSE`. For example, considering the `jv73` data set, each subgraph is computed with its own limits and labels are then more scattered: ```{r label=plot27, fig.width=7, fig.height=5.2} s.label(pca2$li, facets = jv73$fac.riv, samelimits = FALSE) ``` Several other `g.args` parameters can be updated according to the class of the created object (see [Figure 2](#gargsVSclass)). Parameters applied on a `ADEgS` ------------------------------- Users can either apply the changes to all graphs or to update only one graph. Of an `ADEgS`, to apply changes on all the graphs contained in an `ADEgS`, the syntax is similar to the one described for an `ADEg` object. For example, background color can be changed for all graphs in `g10` using the `pbackground.col` parameter. ```{r label=plot28, fig.width=6, fig.height=6} g15 <- plot(coi1, pbackground.col = "steelblue") ``` To change the parameters of a given graph, the name of the parameter must be preceded by the name of the subgraph. This supposes that the names of subgraphs are known. For example, to modify only two graphs: ```{r label=plot29, fig.width=6, fig.height=6} names(g15) plot(coi1, XYmatch.pbackground.col = "steelblue", XYmatch.pgrid.col = "red", eig.ppolygons.col = "orange") ``` Using `adegraphics` functions in your package ============================================= In this section, we illustrate how `adegraphics` functionalities can be used to implement graphical functions in your own package. We created an objet of class `track` that contains a vector of distance and time. ```{r label=chunk15} tra1 <- list() tra1$time <- runif(300) tra1$distance <- tra1$time * 5 + rnorm(300) class(tra1) <- "track" ``` For an object of the class `track`, we wish to represent different components of the data: - an histogram of distances - an histogram of speeds (i.e., distance / time) - a 2D plot representing the distance, the time and the line corresponding to the linear model that predict distance by time The corresponding multiple plot can be done using `adegraphics` functions: ```{r label=plot30, fig.width=7, fig.height=2.3} g1 <- s1d.hist(tra1$distance, psub.text = "distance", ppolygons.col = "blue", pgrid.draw = FALSE, plot = FALSE) g2 <- s1d.hist(tra1$distance / tra1$time, psub.text = "speed", ppolygons.col = "red", plot = FALSE) g31 <- s.label(cbind(tra1$time, tra1$distance), paxes = list(aspectratio = "fill", draw = TRUE), plot = FALSE) g32 <- xyplot(tra1$distance ~ tra1$time, aspect = g31@adeg.par$paxes$aspectratio, panel = function(x, y) {panel.lmline(x, y)}) g3 <- superpose(g31, g32) G <- ADEgS(list(g1, g2, g3)) ``` To facilitate the graphical representation of an object of class `track`, the simplest solution is to design a function `plot` for this class. We illustrate how to define such function with a particular emphasis on the management of graphical parameters. The function is provided below and we detail the different steps. ```{r label=chunk16} plot.track <- function(x, pos = -1, storeData = TRUE, plot = TRUE, ...) { ## step 1 : sort parameters for each graph graphsnames <- c("histDist", "histSpeed", "regression") sortparameters <- sortparamADEgS(..., graphsnames = graphsnames, nbsubgraphs = c(1, 1, 2)) ## step 2 : define default values for graphical parameters params <- list() params[[1]] <- list(psub = list(text = "distance"), ppolygons = list(col = "blue"), pgrid = list(draw = FALSE)) params[[2]] <- list(psub = list(text = "speed"), ppolygons = list(col = "red"), pgrid = list(draw = FALSE)) params[[3]] <- list() params[[3]]$l1 <- list(paxes = list(aspectratio = "fill", draw = TRUE)) params[[3]]$l2 <- list() names(params) <- graphsnames sortparameters <- modifyList(params, sortparameters, keep.null = TRUE) ## step 3 : create each individual plot (ADEg) g1 <- do.call("s1d.hist", c(list(score = substitute(x$distance), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[1]])) g2 <- do.call("s1d.hist", c(list(score = substitute(x$distance / x$time), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]])) g31 <- do.call("s.label", c(list(dfxy = substitute(cbind(x$time, x$distance)), plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]][[1]])) g32 <- xyplot(x$distance ~ x$time, aspect = g31@adeg.par$paxes$aspectratio, panel = function(x, y) {panel.lmline(x, y)}) g3 <- do.call("superpose", list(g31, g32)) g3@Call <- call("superpose", g31@Call, g32$call) ## step 4 : create the multiple plot (ADEgS) lay <- matrix(1:3, 1, 3) object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3), positions = layout2position(lay), add = matrix(0, ncol = 3, nrow = 3), Call = match.call()) names(object) <- graphsnames if(plot) print(object) invisible(object) } ``` In the first step, the arguments given by the user through the dots (…) argument are managed. A name is given to each subgraph and stored in the vector `graphnames`. Then, the function `sortparamADEgS` associates the graphical parameters of the dots (…) argument to each subgraph. If a prefix is specified and matches the name of a graph (e.g., `histDist.pbackground.col = grey`), the parameter is applied only to the graphic specified (e.g., called `histDist`). If no prefix is specified (e.g., `pbackground.col = grey`), the parameter is applied to all subgraphs. The function `sortparamADEgS` returns a list (length equal to the number of subgraph) of lists of graphical parameters.\ In the second step, default values for some graphical parameters are modified. The default parameters are stored in a list which has the same structure that the one produced by `sortparamADEgS` (i.e., names corresponding to those contained in `graphsnames`). Then, the `modifyList` function is applied to merge user and defaults values of paramaters (if a parameter is specified by the user and in the default, the value given by the user is used).\ In the third step, each subgraph is created. Here, we create two `C1.hist` objects and superpose a `S2.label` object and a `trellis` one. The functions `do.call` and `substitute` are used to provide a pretty call for each subgraph (stored in the `Call` slot).\ In a final step, the multiple graph is build through the creation of a new `ADEgS` object and possibly plotted.\ The `plot.track` function can then be used by: ```{r label=plot31, fig.width=7, fig.height=2.3} plot(tra1) ``` Graphical parameters can be modified by: ```{r label=plot32, fig.width=7, fig.height=2.3} plot(tra1, histDist.ppoly.col = "green", pbackground.col = "grey") ``` Examples ======== Labels customization -------------------- ```{r label=plot33, fig.width=6, fig.height=3} data(meaudret) g16 <- s.label(pca3$li, plot = FALSE) g17 <- s.label(pca3$li, ppoints.col= "red", plabels = list(box = list(draw = FALSE), optim = TRUE), plot = FALSE) ADEgS(c(g16, g17), layout = c(1, 2)) ``` Ellipses, stars and convex hulls -------------------------------- ```{r label=plot34, fig.width=6, fig.height=6} g18 <- s.class(pca3$li, fac = meaudret$design$season, plot = FALSE) g19 <- s.class(pca3$li, fac = meaudret$design$season, ellipseSize = 0, chullSize = 1, starSize = 0.5, col = TRUE, plot = FALSE) g20 <- s.class(pca3$li, fac = meaudret$design$season, pellipses.lwd = 2, pellipses.border = 2:5, pellipses.col = 2:5, plot = FALSE) g21 <- s.class(pca3$li, fac = meaudret$design$season, ellipseSize = 0, chullSize = 0, ppolygons.lwd = 2, plines.col = 2:5, starSize = 1.2, plot = FALSE) ADEgS(c(g18, g19, g20, g21), layout = c(2, 2)) ``` Values and legend ----------------- ```{r label=plot35, fig.width=6, fig.height=6} data(rpjdl) coa2 <- dudi.coa(rpjdl$fau, scannf = FALSE, nf = 3) g22 <- s.value(coa2$li, coa2$li[,3], plot = FALSE) g23 <- s.value(coa2$li, coa2$li[,3], method = "color", ppoints.cex = 0.8, plegend.size= 0.8, plot = FALSE) g24 <- s.value(coa2$li, coa2$li[,3], plegend.size = 0.8, ppoints.cex = 0.8, symbol = "square", method = "color", key = list(columns = 1), col = colorRampPalette(c("yellow", "blue"))(6), plot = FALSE) g25 <- s.value(coa2$li, coa2$li[, 3], center = 0, method = "size", ppoints.cex = 0.6, symbol = "circle", col = c("yellow", "red"), plot = FALSE) ADEgS(c(g22, g23, g24, g25), layout = c(2, 2)) ``` 1-D plot -------- ```{r label=plot36, fig.width=6, fig.height=6} score1 <- c(rnorm(1000, mean = -0.5, sd = 0.5), rnorm(1000, mean = 1)) fac1 <- rep(c("A", "B"), each = 1000) g26 <- s1d.density(score1, fac1, pback.col = "grey75", plot = FALSE) g27 <- s1d.density(score1, fac1, col = c(2, 4), plot = FALSE) g28 <- s1d.density(score1, fac1, col = c(2, 4), p1d.reverse = TRUE, p1d.horizontal = FALSE, p1d.rug.draw = FALSE, plot = FALSE) g29 <- s1d.density(score1, fac1, col = c(2, 4), ppolygons.alpha = 0.2, p1d = list(rug = list(tck = 1, line = FALSE)), plot = FALSE) ADEgS(c(g26, g27, g28, g29), layout = c(2, 2)) ``` Maps and neighbor graphs ------------------------ ```{r label=plot37, fig.width=6, fig.height=3} if(require(Guerry)) { library(sp) data(gfrance85) region.names <- data.frame(gfrance85)[, 5] col.region <- colors()[c(149, 254, 468, 552, 26)] g30 <- s.class(coordinates(gfrance85), region.names, porigin.include = FALSE, plot = FALSE) g31 <- s.class(coordinates(gfrance85), region.names, ellipseSize = 0, starSize = 0, Sp = gfrance85, pgrid.draw = FALSE, pSp.col = col.region[region.names], pSp.alpha = 0.4, plot = FALSE) ADEgS(c(g30, g31), layout = c(1, 2)) } ``` ```{r label=plot38, fig.width=6, fig.height=4} # if(require(Guerry)) { # s.Spatial(gfrance85[,7:12]) # } ``` ```{r label=plot39, fig.width=6, fig.height=3} data(mafragh, package = "ade4") g32 <- s.label(mafragh$xy, nb = mafragh$nb, plot = FALSE) g33 <- s.label(mafragh$xy, nb = mafragh$nb, pnb.ed.col = "red", plab.cex = 0, pnb.node = list(cex = 3, col = "blue"), ppoints.col = "green", plot = FALSE) ADEgS(c(g32, g33), layout = c(1, 2)) ``` Ternary plots ------------- ```{r label=plot40, fig.width=6, fig.height=3} data(euro123, package = "ade4") df <- rbind.data.frame(euro123$in78, euro123$in86, euro123$in97) row.names(df) <- paste(row.names(euro123$in78), rep(c(1, 2, 3), rep(12, 3)), sep = "") g34 <- triangle.label(df, label = row.names(df), showposition = TRUE, plot = FALSE) g35 <- triangle.label(euro123$in78, plabels.cex = 0, ppoints.cex = 2, addmean = TRUE, show = FALSE, plot = FALSE) ADEgS(c(g34, g35), layout = c(1, 2)) ``` Appendix ============================= This appendix summarizes the main changes between `ade4` and `adegraphics`. Each line corresponds to a graphical argument defined in `ade4` and its equivalent in `adegraphics` is given. | Arguments in `ade4` | Functions in `ade4` | `g.args` in `adegraphics` | `adeg.par` in `adegraphics` | | | ------------------- | ----------------------| ----------------------------| ------------------------------|---| | `abline.x` | `table.cont` | `ablineX` | | | | `abline.y` | `table.cont` | `ablineY` | | | | `abmean.x` | `table.cont` | `meanX` | | | | `abmean.y` | `table.cont` | `meanY` | | | | `addaxes` | `s.arrow`, `s.chull`, `s.class`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value`, `triangle.class`, `triangle.plot` | |`paxes.draw` | | | `area` | `s.arrow`, `s.chull`, `s.class`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value` | `Sp` | | a `Sp` object | | `axesell` | `s.class`, `s.distri`, `triangle.class` | | `pellipses.axes.draw` | | | `box` | `s.corcircle`, `triangle.plot` | | `pbackground.box` | | | `boxes` | `s.arrow`, `s.label`, `sco.class`, `sco.label`, `sco.match` | | `plabels.boxes.draw` | | | `cellipse` | `s.class`, `s.distri`, `triangle.class` | `ellipseSize` | | | | `cgrid` | `s.arrow`, `s.class`, `s.chull`, `s.corcircle`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value`, `sco.boxplot`, `sco.class`, `sco.distri`, `sco.gauss`, `sco.label`, `sco.match` | | `pgrid.nint` | both play on the grid mesh, but they are not strictly equivalent | | `clabel` | `s.arrow`, `s.class`, `s.chull`, `s.corcircle`, `s.distri`, `s.kde2d`, `s.label`, `s.match`, `s.traject`, `sco.boxplot`, `sco.class`, `sco.distri`, `sco.gauss`, `sco.label`, `sco.match`, `triangle.plot` | | `plabels.cex` | | | `clabel` | `table.dist` | | | `axis.text = list()` `lattice` parameter | | `clabel.col` | `table.cont`, `table.paint`, `table.value` | | | `axis.text = list()` `lattice` parameter | | `clabel.row` | `table.cont`, `table.paint`, `table.value` | | | `axis.text = list()` `lattice` parameter | | `clegend` | `s.value`, `table.cont`, `table.value` | | `plegend.size` `ppoints.cex` | parameters setting the legend size | | `clegend` | `table.paint` | | `plegend.size` | | | `clogo` | `s.logo` | | `ppoints.cex` | | | `cneig` | `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.value` | | `pnb.edge.lwd` | | | `col.labels` | `table.cont`, `table.paint`, `table.value` | `labelsy` | | | | `contour` | `s.arrow`, `s.class`, `s.chull`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value` | `Sp` | | a `Sp` object | | `contour.plot` | `s.image` | `region` | | | | `cpoints`, `cpoint` | `s.arrow`, `s.class`, `s.chull`, `s.distri`, `s.kde2d`, `s.label`, `s.match`, `s.traject`, `s.value`, `sco.class`, `sco.label`, `sco.match`, `triangle.class`, `triangle.plot` | | `ppoints.cex` | | | `csize` | `s.value`, `table.cont`, `table.dist`, `table.paint`, `table.value` | `ppoints.cex` | | | | `csize` | `sco.distri` | `sdSize` | | | | `cstar` | `s.class`, `s.distri`, `triangle.class` | `starSize` | | | | `csub` | `s.arrow`, `s.chull`, `s.class`, `s.corcircle`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value`, `sco.boxplot`, `sco.class`, `sco.distri`, `sco.gauss`, `sco.label`, `sco.match`, `triangle.class`, `triangle.plot` | | `psub.cex` | | | `draw.line` | `triangle.biplot`, `triangle.class`, `triangle.plot` | | `pgrid.draw` | | | `edge` | `s.arrow`, `s.match`, `s.traject` | | `parrows.length` | setting the length of the arrows to 0 is equivalent to `edge = FALSE` | | `grid` | `s.arrow`, `s.chull`, `s.class`, `s.corcircle`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value`, `sco.boxplot`, `sco.class`, `sco.distri`, `sco.gauss`, `sco.label`, `sco.match`, `table.cont`, `table.dist`, `table.value` | | `pgrid.draw` | | | `horizontal` | `sco.class`, `sco.gauss`, `sco.label`, `sco.match` | | `p1d.horizontal` | | | `image.plot` | `s.image` | `contour` | | | | `includeorigin`, `include.origin` | `s.arrow`, `s.chull`, `s.class`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value`, `sco.boxplot`, `sco.class`, `sco.distri`, `sco.gauss`, `sco.label`, `sco.match` | | `porigin.include` | | | `kgrid` | `s.image` | `gridsize` | | | | `klogo` | `s.logo` | | | no correspondence | | `labeltriangle` | `triangle.class` , `triangle.plot` | | | no correspondence | | `legen` | `sco.gauss` | `labelplot` | | | | `neig` | `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.value` | `nbobject` | | a `nb` object | | `optchull` | `s.chull` | `chullSize` | | | | `origin` | `s.arrow`, `s.chull`, `s.class`, `s.corcircle`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value`, `sco.boxplot`, `sco.class`, `sco.distri`, `sco.gauss`, `sco.label`, `sco.match` | | `porigin.origin` | | | `pch` | `s.arrow`, `s.chull`, `s.class`, `s.distri`, `s.kde2d`, `s.label`, `s.match`, `s.traject`, `s.value`, `sco.boxplot`, `sco.class`, `sco.label`, `sco.match`, `triangle.class`, `triangle.plot`, `table.cont` | | `ppoints.pch` | | | `pixmap` | `s.arrow`, `s.chull`, `s.class`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value` | | | no correspondence | | `pos.lab` | `sco.class`, `sco.label`, `sco.match` | | `p1d.labpos` | | | `possub` | `s.arrow`, `s.chull`, `s.class`, `s.corcircle`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value`, `sco.class`, `sco.gauss`, `sco.label`, `sco.match`, `triangle.class`, `triangle.plot` | | `psub.pos` | | | `rectlogo` | `s.logo` | `rect` | | | | `reverse` | `sco.class`, `sco.gauss`, `sco.label`, `sco.match` | | `p1d.reverse` | | | `row.labels` | `table.cont`, `table.paint`, `table.value` | `labelsx` | | | | `scale` | `triangle.class`, `triangle.plot` | `adjust` | | | | `show.position` | `triangle.class`, `triangle.plot` | `showposition` | | | | `sub` | `s.arrow`, `s.chull`, `s.class`, `s.corcircle`, `s.distri`, `s.image`, `s.kde2d`, `s.label`, `s.logo`, `s.match`, `s.traject`, `s.value`, `sco.boxplot`, `sco.class`, `sco.distri`, `sco.gauss`, `sco.label`, `sco.match`, `triangle.class`, `triangle.plot` | | `psub.text` | | | `y.rank` | `sco.distri` | `yrank` | | | | `zmax` | `s.value` | | | set to default max(abs(z)) | | | | | | | References =============================adegraphics/inst/doc/FAQ.html0000644000176200001440000036756614774707406015612 0ustar liggesusers Frequently Asked Questions

Frequently Asked Questions

Aurélie Siberchicot, Stéphane Dray, Jean Thioulouse

2025-04-07

set.seed(2564)
library(ade4)
library(adegraphics)
## Registered S3 methods overwritten by 'adegraphics':
##   method         from
##   biplot.dudi    ade4
##   kplot.foucart  ade4
##   kplot.mcoa     ade4
##   kplot.mfa      ade4
##   kplot.pta      ade4
##   kplot.sepan    ade4
##   kplot.statis   ade4
##   scatter.coa    ade4
##   scatter.dudi   ade4
##   scatter.nipals ade4
##   scatter.pco    ade4
##   score.acm      ade4
##   score.mix      ade4
##   score.pca      ade4
##   screeplot.dudi ade4
## 
## Attachement du package : 'adegraphics'
## Les objets suivants sont masqués depuis 'package:ade4':
## 
##     kplotsepan.coa, s.arrow, s.class, s.corcircle, s.distri, s.image,
##     s.label, s.logo, s.match, s.traject, s.value, table.value,
##     triangle.class

1 How to personalize plots

1.1 How to update title axes?

df <- data.frame(x = rep(1:10,1), 
                 y = rep(1:10, each = 10), 
                 ms_li = runif(100, min = -5, max = 4))
s.value(df[, 1:2], df$ms_li, 
        paxes.draw = TRUE)

1.1.1 Size titles on axes

xlab.cex and ylab.cex manage the size titles on the x and y axes.

s.value(df[, 1:2], df$ms_li, 
        paxes.draw = TRUE,
        xlab = "Longitude", xlab.cex = 0.5,
        ylab = "Latitude", ylab.cex = 0.5
        )

1.1.2 Size labels on axes

scales.x.cex and scales.y.cex manage the sizes labels on the x and y axes.

s.value(df[, 1:2], df$ms_li, 
        paxes.draw = TRUE,
        scales.x.cex = 0.5,
        scales.y.cex = 0.5
        )

1.1.3 Margin of axis

layout.heights = list(bottom.padding = 1) manages the margin of the bottom axis. This enlarges the space for a larger title axis.

s.value(df[, 1:2], df$ms_li, 
        paxes.draw = TRUE,
        xlab = "Longitude", xlab.cex = 2,
        ylab = "Latitude", ylab.cex = 2,
        layout.heights = list(bottom.padding = 2)
        )

1.2 How to update label’s boxes ?

x0 <- runif(50, -2, 2)
y0 <- runif(50, -2, 2)
s.label(data.frame(x0, y0))

1.2.1 Remove boxes around labels

s.label(data.frame(x0, y0), plabels.boxes.border = 0)

s.label(data.frame(x0, y0), plabels.boxes.draw = FALSE, ppoints.cex = 0)

1.2.2 Color of label’s boxes

s.label(data.frame(x0, y0), plabels.boxes.col = "orange")

1.2.3 Border of label’s boxes

s.label(data.frame(x0, y0), plabels.boxes.border = "blue", plabels.boxes.lwd = 2)

adegraphics/inst/doc/adegraphics.html0000644000176200001440001162600014774707431017432 0ustar liggesusers The adegraphics package

The adegraphics package

Alice Julien-Laferrière, Aurélie Siberchicot and Stéphane Dray

2025-04-07



The adegraphics package (Siberchicot et al. 2017) is a complete reimplementation of the graphical functionalities of the ade4 package (Dray and Dufour 2007). The package has been initially designed to improve the representation of the outputs of multivariate analyses performed with ade4 but as its graphical functionalities are very general, they can be used for other purposes.

The adegraphics package provides a flexible environment to produce, edit and manipulate graphs. We adopted an object oriented approach (a graph is an object) using S4 classes and methods and used the visualization system provided by the lattice (Sarkar 2008) and grid (Murrell 2005) packages. In adegraphics, graphs are R objects that can be edited, stored, combined, saved, removed, etc.

Note that we tried to facilitate the handling of adegraphics by ade4 users. Hence, the name of functions and parameters has been preserved in many cases. The main changes are listed in the appendix of this vignette so that it should be quite easy to use adegraphics. However, several new functionalities (graphical parameters, creation and manipulation of graphical objects, etc.) are now available and detailed in this vignette.

The adelist mailing list can be used to send questions and/or comments on adegraphics (see https://listes.univ-lyon1.fr/sympa/info/adelist)

1 An overview of object classes

In adegraphics, a user-level function produces a plot that is stored (and returned) as an object. The class architecture of the objects created by adegraphics functions is described in Figure 1.


Figure 1: Classes structure and user-level functions


This class management highlights a hierarchy with two parent classes:

  • ADEg for simple graphs. It contains the display of a single data set using only one kind of representation (e.g., arrows, points, lines, etc.)

  • ADEgS for multiple graphs. It contains a collection of at least two simple graphs (ADEg, trellis or ADEgS)

The ADEg class has five child classes which are also subdivided in several child classes. Each of these five child classes is dedicated for a particular graphical data representation:

  • ADEg.S1: unidimensional graph of a numeric score

  • ADEg.S2: bidimensional graph of xy coordinates (matrix or data.frame object)

  • ADEg.C1: bidimensional graph of a numeric score (bar chart or curve)

  • ADEg.T: heat map-like representation of a data table (matrix, data.frame, dist or table object)

  • ADEg.Tr: ternary plot of xyz coordinates (matrix or data.frame object)

The ADEg class and its five child classes are virtual: it is not allowed to create object belonging to these classes. Users can only create objects belonging to child classes by calls to user functions (see the User functions section).

2 Simple graph (ADEg object)

In the adegraphics package, a graph is created by a call to a user function and stored as an R object. These functions allow to display the raw data but also the outputs of a multivariate analysis. The following sections describe the different graphical functions available in the package.

2.1 User functions

Several user functions are available to create a simple graph (stored as an ADEg object in R). Each function creates an object of a given class (see Figure 1). Table 1 lists the different functions, their corresponding classes and a short description. The ade4 users would not be lost: many functions have kept their names in adegraphics. The main changes are listed in Table 2.


Table 1: Graphical functions available in adegraphics

Function Class of the returned object Description
s1d.barchart C1.barchart 1-D plot of a numeric score by bars
s1d.curve C1.curve 1-D plot of a numeric score linked by curves
s1d.curves C1.curves 1-D plot of multiple scores linked by curves
s1d.density C1.density 1-D plot of a numeric score by density curves
s1d.dotplot C1.dotplot 1-D plot of a numeric score by dots
s1d.gauss C1.gauss 1-D plot of a numeric score by Gaussian curves
s1d.hist C1.hist 1-D plot of a numeric score by bars
s1d.interval C1.interval 1-D plot of the interval between two numeric scores
s1d.boxplot S1.boxplot 1-D box plot of a numeric score partitioned in classes
s1d.class S1.class 1-D plot of a numeric score partitioned in classes
s1d.distri S1.distri 1-D plot of a numeric score by means/tandard deviations computed using an external table of weights
s1d.label S1.label 1-D plot of a numeric score with labels
s1d.match S1.match 1-D plot of the matching between two numeric scores
s.arrow S2.arrow 2-D scatter plot with arrows
s.class S2.class 2-D scatter plot with a partition in classes
s.corcircle S2.corcircle Correlation circle
s.density S2.density 2-D scatter plot with kernel density estimation
s.distri S2.distri 2-D scatter plot with means/standard deviations computed using an external table of weights
s.image S2.image 2-D scatter plot with loess estimation of an additional numeric score
s.label S2.label 2-D scatter plot with labels
s.logo S2.logo 2-D scatter plot with logos (pixmap objects)
s.match S2.match 2-D scatter plot of the matching between two sets of coordinates
s.Spatial S2.label Mapping of a Spatial* object
s.traject S2.traject 2-D scatter plot with trajectories
s.value S2.value 2-D scatter plot with proportional symbols
table.image T.image Heat map-like representation with colored cells
table.value T.value or T.cont Heat map-like representation with proportional symbols
triangle.class Tr.class Ternary plot with a partition in classes
triangle.label Tr.label Ternary plot with labels
triangle.match Tr.match Ternary plot of the matching between two sets of coordinates
triangle.traject Tr.match Ternary plot with trajectories


Table 2: Changes in functions names between ade4 and adegraphics

Function in ade4 Equivalence in adegraphics
table.cont, table.dist, table.value table.value1
table.paint table.image
sco.boxplot s1d.boxplot
sco.class s1d.class
sco.distri s1d.distri
sco.gauss s1d.gauss
sco.label s1d.label
sco.match s1d.match
sco.quant no equivalence
s.chull s.class2
s.kde2d s.density
s.match.class superposition of s.match and s.class
triangle.biplot triangle.match
triangle.plot triangle.label
s.multinom triangle.multinom

2.2 Arguments

The list of arguments of a function are given by the args function.

library(ade4)
library(adegraphics)
args(s.label)
## function (dfxy, labels = rownames(dfxy), xax = 1, yax = 2, facets = NULL, 
##     plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) 
## NULL

Some arguments are very general and present in all user functions:

  • plot: a logical value indicating if the graph should be displayed

  • storeData: a logical value indicating if the data should be stored in the returned object. If FALSE, only the names of the data are stored. This allows to reduce the size of the returned object but it implies that the data should not be modified in the environment to plot again the graph.

  • add: a logical value indicating if the graph should be superposed on the graph already displayed in the current device (it replaces the argument add.plot in ade4).

  • pos: an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if storeData is FALSE.

  • …: additional graphical parameters (see below)

Some other arguments influence the graphical outputs and they are thus specific to the type of produced graph. Figure 2 summarizes some of these graphical parameters available for the different functions. We only reported the parameters stored in the g.args slot of the returned object (see the Parameters in g.args section).


Figure 2: Specific arguments in each object class



The ade4 users would note that the names of some arguments have been modified in adegraphics. The Appendix gives a full list of these modifications.

2.3 Slots and Methods

A call to a graphical function (see the User functions section) returns an ADEg object. Each object is defined by a number of slots and several methods are associated to this class. Let us consider the olympic data set available in the ade4 package. A principal component analysis (PCA) is applied on the olympic$tab table that contains the results for 33 participating athletes at the 1988 summer olympic games:

data(olympic)
pca1 <- dudi.pca(olympic$tab, scannf = FALSE)

The barplot of eigenvalues is then drawn and stored in g1:

g1 <- s1d.barchart(pca1$eig, p1d.horizontal = F, ppolygons.col = "white")


The class of the g1 object is C1.barchart which extends the ADEg class:

class(g1)
## [1] "C1.barchart"
## attr(,"package")
## [1] "adegraphics"
showClass("C1.barchart")
## Class "C1.barchart" [package "adegraphics"]
## 
## Slots:
##                                                                        
## Name:          data  trellis.par     adeg.par lattice.call       g.args
## Class:         list         list         list         list         list
##                                              
## Name:         stats       s.misc         Call
## Class:         list         list         call
## 
## Extends: 
## Class "ADEg.C1", directly
## Class "ADEg", by class "ADEg.C1", distance 2
## Class "ADEgORtrellis", by class "ADEg.C1", distance 3
## Class "ADEgORADEgSORtrellis", by class "ADEg.C1", distance 3


This object contains different slots:

slotNames(g1)
## [1] "data"         "trellis.par"  "adeg.par"     "lattice.call" "g.args"      
## [6] "stats"        "s.misc"       "Call"


These slots are defined for each ADEg object and contain different types of information. The package adegraphics uses the capabilities of the lattice package to display a graph (by generating a trellis object). Hence, several slots contain information that will be passed in the call to the lattice functions:

  • data: a list containing information about the data.

  • trellis.par: a list of graphical parameters that are directly passed to the lattice functions using the par.settings argument (see the Parameters in trellis.par section).

  • adeg.par: a list of graphical parameters defined in adegraphics. The list of parameters can be obtained using the adegpar function (see the Parameters in adeg.par section).

  • lattice.call: a list of two elements containing the information required to create the trellis object: graphictype (the name of the lattice functions that should be used) and arguments (the list of parameter values required to obtain the trellis object).

  • g.args: a list containing at least the different values of the graphical arguments described in Figure 2 (see the Parameters in g.args section).

  • stats: a list of internal preliminary computations performed to display the graph.

  • s.misc: a list of other internal parameters.

  • Call: an object of class call containing the matched call.


These different slots can be extracted using the @ operator:

g1@data
## $score
##  [1] 3.4182381 2.6063931 0.9432964 0.8780212 0.5566267 0.4912275 0.4305952
##  [8] 0.3067981 0.2669494 0.1018542
## 
## $at
##  [1]  1  2  3  4  5  6  7  8  9 10
## 
## $frame
## [1] 34
## 
## $storeData
## [1] TRUE


All these slots are automatically filled during the object creation. The trellis.par, adeg.par and g.args can also be modified a posteriori using the update method (see the Customizing a graph section). This allows to customize graphs after their creation.

We consider the correlation circle that depicts the correlation between PCA axes and the results for each event:

g2 <- s.corcircle(pca1$co)

class(g2)
## [1] "S2.corcircle"
## attr(,"package")
## [1] "adegraphics"
g2@g.args
## $fullcircle
## [1] TRUE
## 
## $xlim
## [1] -1.2  1.2
## 
## $ylim
## [1] -1.2  1.2
## 
## $scales
## $scales$draw
## [1] FALSE


The argument fullcircle can be updated a posteriori so that the original object is modified:

update(g2, fullcircle = FALSE)

g2@g.args
## $fullcircle
## [1] FALSE
## 
## $xlim
## [1] -0.8815395  0.9544397
## 
## $ylim
## [1] -0.6344523  1.2015270
## 
## $scales
## $scales$draw
## [1] FALSE

Several other methods have been defined for the ADEg class allowing to extract information, modify or combine objects:

  • getcall, getlatticecall and getstats: these accessor methods return respectively the Call, the lattice.call and the stats slots.

  • getparameters: this method returns the trellis.par and/or the adeg.par slots.

  • show, print and plot: these methods display the ADEg object in the current device or in a new one.

  • gettrellis: this method returns the ADEg object as a trellis object. It can then be exploited using the lattice and latticeExtra packages.

  • superpose, + and add.ADEg: these methods superpose two ADEg graphs. It returns a multiple graph object of class ADEgS (see the The basic methods for superposition, juxtaposition and insertion section).

  • insert: this method inserts an ADEg graph in an existing one or in the current device. It returns an ADEgS object (see the The basic methods for superposition, juxtaposition and insertion section).

  • cbindADEg, rbindADEg: these methods combine several ADEg graphs. It returns an ADEgS object (see the The basic methods for superposition, juxtaposition and insertion section).

  • update: this method modifies the graphical parameters after the ADEg creation. It updates the current display and returns the modified ADEg (see the Customizing a graph section).

For instance:

getcall(g1) ## equivalent to g1@Call
## s1d.barchart(score = pca1$eig, p1d.horizontal = F, ppolygons.col = "white")

A biplot-like graph can be obtained using the superpose method. The result is a multiple graph:

g3 <- s.label(pca1$li)
g4 <- s.arrow(5 * pca1$c1, add = TRUE)

class(g4)
## [1] "ADEgS"
## attr(,"package")
## [1] "adegraphics"

In addition, some object classes have specific methods. For instance, a zoom method is available for ADEg.S1 and ADEg.S2 classes. For the ADEg.S2 class, the method addhist (see the The basic methods for superposition, juxtaposition and insertion section) decorates a 2-D graph by adding marginal distributions as histograms and density lines (this method replaces and extends the s.hist function of ade4).

zoom(g3, zoom = 2, center = c(2, -2))

3 Multiple graph (ADEgS object)

The adegraphics package provides class ADEgS to manage easily the combination of several graphs. This class allows to deal with the superposition, insertion or juxtaposition of several graphs in a single object. An object of this class is a list containing several graphical objects and information about their positioning. Different ways to generate ADEgS objects are described below.

3.1 Slots and Methods

The class ADEgS is used to store multiple graphs. Different slots are associated to this class (use the symbol @ to extract information):

  • ADEglist: a list of graphs stored as trellis, ADEg and/or ADEgS objects.

  • positions: a matrix containing the positions of the graphs. It has four columns and as many rows as the number of graphical objects in the ADEglist slot. For each graph (i.e. row), it contains the coordinates of the bottom-left and top-right corners in npc units (i.e. normalized parent coordinates varying between 0 and 1).

  • add: a square binary matrix with as many rows and columns as the number of graphical objects in the ADEglist slot. It allows to manage the superposition of graphs: the value at the i-th row and j-th column is equal to 1 if the j-th graphical object is superposed on the i-th. Otherwise, this value is equal to 0.

  • Call: an object of class call containing the matched call.

Several methods have been implemented to obtain information, edit or modify ADEgS objects. Several methods are inspired from the management of list in R:

  • [, [[ and $: these methods extract one or more elements from the ADEgS object.

  • getpositions, getgraphics and getcall: these methods return the positions, the ADEglist and the Call slots, respectively.

  • names and length: these methods return the names and number of graphs contained in the object.

  • [[<- and names<-: these methods replace a graph or its name in an ADEgS object (acts on the ADEglist slot).

  • show, plot and print: these methods display the ADEgS object in the current device or in a new one.

  • superpose and +: these methods superpose two graphs. It returns a multiple graph object of class ADEgS (see the The basic methods for superposition, juxtaposition and insertion section).

  • insert: this method inserts a graph in an existing one or in the current device. It returns a multiple graph object of class ADEgS (see the The basic methods for superposition, juxtaposition and insertion section).

  • cbindADEg, rbindADEg: these methods combine several graphs. It returns an ADEgS object (see the The basic methods for superposition, juxtaposition and insertion section).

  • update: this method modifies the names and/or the positions of the graphs contained in an ADEgS object. It updates the current display and returns the modified ADEgS.

We will show in the next sections how these methods can be used to deal with ADEgS objects.

3.2 Creating an ADEgS object by hand

The ADEgS objects can be created by easy manipulation of several simple graphs. Some methods (e.g., insert, superpose) can be used to create a compilation of graphs by hand.

3.2.1 The basic methods for superposition, juxtaposition and insertion

The functions superpose, + and add.ADEg allow the superposition of an ADEg/ADEgS object on an ADEg/ADEgS object.

The vector olympic$score contains the total number of points computed for each participant. This vector is used to generate a factor partitioning the participants in two groups according to their final result (more or less than 8000 points):

fac.score <- factor(olympic$score < 8000, labels = c("MT8000", "LT8000"))

These two groups can be represented on the PCA factorial map using the s.class function:

g5 <- s.class(pca1$li, fac.score, col = c("red", "blue"), chullSize = 1, ellipseSize = 0, 
              plabels.cex = 2, pbackground.col = "grey85", paxes.draw = TRUE)

The graph with the labels (object g3) can then be superposed on this one:

g6 <- superpose(g5, g3, plot = TRUE) ## equivalent to g5 + g3

class(g6)
## [1] "ADEgS"
## attr(,"package")
## [1] "adegraphics"

In the case of a superposition, the graphical parameters (e.g., background and limits) of the first graph (the one below) are used as a reference and applied to the second one (the one above). Note that it is also possible to use the add = TRUE argument in the call of a simple user function (functions described in Table 1) to perform a superposition. The graph g6 can also be obtained by:

g5
s.label(pca1$li, add = TRUE)

The functions cbindADEg and rbindADEg allows to combine several graphical objects (ADEg, ADEgS or trellis) by rows or by columns. The new created ADEgS contains the list of the reduced graphs:

rbindADEg(cbindADEg(g2, g3), cbindADEg(g5, g6), plot = TRUE)

The function insert allows the insertion of a graphical object on another one (ADEg or ADEgS). It takes the position of the inserted graph as an argument:

g7 <- insert(g2, g6, posi = c(0.65, 0.65, 0.95, 0.95))

class(g7)
## [1] "ADEgS"
## attr(,"package")
## [1] "adegraphics"

The different methods associated to the ADEgS class allow to obtain information and to modify the multiple graph:

length(g7)
## [1] 3
names(g7)
## [1] "g1" "g2" "X"
names(g7) <- c("chulls", "labels", "cor")
class(g7[1])
## [1] "ADEgS"
## attr(,"package")
## [1] "adegraphics"
class(g7[[1]])
## [1] "S2.class"
## attr(,"package")
## [1] "adegraphics"
class(g7$chulls)
## [1] "S2.class"
## attr(,"package")
## [1] "adegraphics"

The multiple graph contains three simple graphs. It can be easily updated. For instance, the size of the inserted graph can be modified:

pos.mat <- getpositions(g7)
pos.mat
##           [,1] [,2] [,3] [,4]
##           0.00 0.00 1.00 1.00
##           0.00 0.00 1.00 1.00
## positions 0.65 0.65 0.95 0.95
pos.mat[3,] <- c(0.1, 0.7, 0.3, 0.9)
update(g7, positions = pos.mat)

The graphs themselves can be modified, without affecting the global structure of the ADEgS object. Here, we replace the correlation circle by the barplot of eigenvalues:

g7[[3]] <- g1
g7

The addhist method adds univariate marginal distributions around an ADEg.S2 and returns an ADEgS object:

addhist(g3)

More examples are available in the help page by typing example(superpose), example(insert), example(add.ADEg) and example(addhist) in the R session.

3.2.2 The ADEgS function

The ADEgS function provides the most elementary and flexible way to create an ADEgS object. The different arguments of the function are:

  • adeglist: a list of several trellis, ADEg and/or ADEgS objects.

  • positions: a matrix with four columns and as many rows as the number of graphical objects in the ADEglist slot. For each subgraph, i.e. in each row, the coordinates of the top-right and the bottom-left hand corners are given in npc units (i.e., normalized parent coordinates varying from 0 to 1).

  • layout: an alternative way to specify the positions of graphs. It could be a vector of length 2 indicating the number of rows and columns used to split the device (similar to mfrow parameter in basic graphs). It could also be a matrix specifying the location of the graphs: each value in this matrix should be 0 or a positive integer (similar to layout function for basic graphs).

  • add: a square matrix with as many rows and columns as the number of graphical objects in the ADEglist slot. The value at the i-th row and j-th column is equal to 1 if the j-th graphical object is superposed to i-th one. Otherwise, this value is equal to 0.

  • plot: a logical value indicating if the graphs should be displayed.

When users fill only one argument among positions, layout and add, the other values are automatically computed to define the ADEgS object.

We illustrate the different possibilities to create objects with the ADEgS function. Simple juxtaposition using a vector as layout:

ADEgS(adeglist = list(g2, g3), layout = c(1, 2))

Layout specified as a matrix:

mlay <- matrix(c(1, 1, 0, 1, 1, 0, 0, 0, 2), byrow = T, nrow = 3)
mlay
##      [,1] [,2] [,3]
## [1,]    1    1    0
## [2,]    1    1    0
## [3,]    0    0    2
ADEgS(adeglist = list(g6, g2), layout = mlay)

Using the matrix of positions offers a very flexible way to arrange the different graphs:

mpos <- rbind(c(0, 0.3, 0.7, 1), c(0.5, 0, 1, 0.5))
ADEgS(adeglist = list(g3, g5), positions = mpos)

Lastly, superposition can also be specified using the add argument:

ADEgS(list(g5, g3), add = matrix(c(0, 1, 0, 0), byrow = TRUE, ncol = 2))

More examples are available in the help page by typing example(ADEgS) in the R session.

3.3 Automatic collections

The package adegraphics contains functionalities to create collections of graphs. These collections are based on a simple graph repeated for different groups of individuals, variables or axes. The building process of these collections is quite simple (definition of arguments in the call of a user function) and leads to the creation of an ADEgS object.

3.3.1 Partitioning the data (facets)

The adegraphics package allows to split up the data by one variable (factor) and to plot the subsets of data together. This possibility of conditional plot is available for all user functions (except the table.* functions) by setting the facets argument. This is directly inspired by the functionalities offered in the lattice and ggplot2 packages.

Let us consider the jv73 data set. The table jv73$morpho contains the measures of 6 variables describing the geomorphology of 92 sites. A PCA can be performed on this data set:

data(jv73)
pca2 <- dudi.pca(jv73$morpho, scannf = FALSE)
s.label(pca2$li)

The sites are located on 12 rivers (jv73$fac.riv) and it is possible to represent the PCA scores for each river using the facets argument:

g8 <- s.label(pca2$li, facets = jv73$fac.riv)

length(g8)
## [1] 12
names(g8)
##  [1] "Allaine"   "Audeux"    "Clauge"    "Cuisance"  "Cusancin"  "Dessoubre"
##  [7] "Doubs"     "Doulonnes" "Drugeon"   "Furieuse"  "Lison"     "Loue"

The ADEgS returned object contains the 12 plots. It is then possible to focus on a given river (e.g., the Doubs river) by considering only a subplot (e.g., type g8$Doubs). The facets functionality is very general and available for the majority of adegraphics functions. For instance, with the s.class function:

s.class(pca2$li, fac = jv73$fac.riv, col = rainbow(12), facets = jv73$fac.riv)

3.3.2 Multiple axes

All 2-D functions (i.e. s.*) returning an object inheriting from the ADEg.S2 class have the xax et yax arguments. These arguments allow to choose which column of the main argument (i.e. df) should be plotted as x and y axes. As in ade4, these two arguments can be simple integers. In adegraphics, the user can also specify vectors as xax and/or yax arguments to obtain multiple graphs. Here, we represent the different correlation circles associated to the first four PCA axes of the olympic data set:

pca1 <- dudi.pca(olympic$tab, scannf = FALSE, nf = 4)
g9 <- s.corcircle(pca1$co, xax = 1:2, yax = 3:4)

length(g9)
## [1] 4
names(g9)
## [1] "x1y3" "x2y3" "x1y4" "x2y4"
g9@positions
##      [,1] [,2] [,3] [,4]
## [1,]  0.0  0.5  0.5  1.0
## [2,]  0.5  0.5  1.0  1.0
## [3,]  0.0  0.0  0.5  0.5
## [4,]  0.5  0.0  1.0  0.5

3.3.3 Multiple score

All 1-D functions (i.e. s1d.*) returning an object inheriting from the ADEg.C1 or ADEg.S1 classes have the score argument. Usually, this argument should be a numeric vector but it is also possible to consider an object with several columns (data.frame or matrix). In this case, an ADEgS object is returned in which one graph by column is created. For instance for the olympic data set, we can represent the link between the global performance (fac.score) and the PCA scores on the first four axes (pca1$li):

dim(pca1$li)
## [1] 33  4
s1d.boxplot(pca1$li, fac.score, col = c("red", "blue"), 
  psub = list(position = "topleft", cex = 2))

3.3.4 Multiple variable

Some user functions (s1d.density, s1d.gauss, s1d.boxplot, s1d.class, s.class, s.image, s.traject, s.value, triangle.class) have an argument named fac or z. This argument can have several columns (data.frame or matrix) so that each column is used to create a separate graph. For instance, we can represent the distribution of the 6 environmental variables on the PCA factorial map of the jv73$tab data set:

s.value(pca2$li, pca2$tab, symbol = "circle")

3.3.5 Outputs of the ade4 package

Lastly, we reimplemented all the graphical functions of the ade4 package designed to represent the outputs of a multivariate analysis. The functions ade4::plot.*, ade4::kplot.*, ade4::scatter.* and ade4::score.* return ADEgS objects. It is now very easy to represent or modify these graphical outputs:

data(meaudret)
pca3 <- dudi.pca(meaudret$env, scannf = FALSE)
pca4 <- dudi.pca(meaudret$spe, scale = FALSE, scannf = FALSE)
coi1 <- coinertia(pca3, pca4, scannf = FALSE, nf = 3)
g10 <- plot(coi1)

class(g10)
## [1] "ADEgS"
## attr(,"package")
## [1] "adegraphics"
names(g10)
## [1] "Xax"       "Yax"       "eig"       "XYmatch"   "Yloadings" "Xloadings"
g10@Call
## plot.coinertia(x = coi1)

4 Customizing a graph

Compared to the ade4 package, the main advantage of adegraphics concerns the numerous possibilities to customize a graph using several graphical parameters. These parameters are stored in slots trellis.par, adeg.par and g.args (see the Slots and Methods section) of an ADEg object. These parameters can be defined during the creation of a graph or updated a posteriori (using the update method).

4.1 Parameters in trellis.par

The trellis.par slot is a list of parameters that are directly included in the call of functions of the lattice package. The name of parameters and their default value are given by the trellis.par.get function of lattice.

library(lattice)
sort(names(trellis.par.get()))
##  [1] "add.line"          "add.text"          "as.table"         
##  [4] "axis.components"   "axis.line"         "axis.text"        
##  [7] "background"        "box.3d"            "box.dot"          
## [10] "box.rectangle"     "box.umbrella"      "clip"             
## [13] "dot.line"          "dot.symbol"        "fontsize"         
## [16] "grid.pars"         "layout.heights"    "layout.widths"    
## [19] "panel.background"  "par.main.text"     "par.sub.text"     
## [22] "par.title.text"    "par.xlab.text"     "par.ylab.text"    
## [25] "par.zlab.text"     "plot.line"         "plot.polygon"     
## [28] "plot.symbol"       "reference.line"    "regions"          
## [31] "shade.colors"      "strip.background"  "strip.border"     
## [34] "strip.shingle"     "superpose.line"    "superpose.polygon"
## [37] "superpose.symbol"

Hence, modifications of some of these parameters will modify the graphical display of an ADEg object. For instance, margins are defined using layout.widths and layout.heights parameters, clip parameter allows to overpass panel boundaries and axis.line and axis.text allow to customize lines and text of axes.

d <- scale(olympic$tab)
g11 <- table.image(d, plot = FALSE)
g12 <- table.image(d, axis.line = list(col = "blue"), axis.text = list(col = "red"), 
  plot = FALSE)
ADEgS(c(g11, g12), layout = c(1, 2))

4.2 Parameters in adeg.par

The adeg.par slot is a list of graphical parameters specific to the adegraphics package. The name of parameters and their default value are available using the adegpar function which is inspired by the par function of the graphics package.

names(adegpar())
##  [1] "p1d"         "parrows"     "paxes"       "pbackground" "pellipses"  
##  [6] "pgrid"       "plabels"     "plegend"     "plines"      "pnb"        
## [11] "porigin"     "ppalette"    "ppoints"     "ppolygons"   "pSp"        
## [16] "psub"        "ptable"

A description of these parameters is available in the help page of the function (?adegpar). Note that each adeg.par parameter starts by the letter ’p’ and its name relates to the type of graphical element considered (ptable is for tables display, ppoints for points, parrows for arrows, etc). Each element of this list can contain one or more sublists. Details on a sublist are obtained using its name either as a parameter of the adegpar function or after the $ symbol. For example, if we want to know the different parameters to manage the display of points:

adegpar("ppoints")
## $ppoints
## $ppoints$alpha
## [1] 1
## 
## $ppoints$cex
## [1] 1
## 
## $ppoints$col
## [1] "black"
## 
## $ppoints$pch
## [1] 20
## 
## $ppoints$fill
## [1] "black"
adegpar()$ppoints
## $alpha
## [1] 1
## 
## $cex
## [1] 1
## 
## $col
## [1] "black"
## 
## $pch
## [1] 20
## 
## $fill
## [1] "black"

The full list of available parameters is summarized in Figure 3.


Figure 3: Parameters that can be set with the adegpar function.


The ordinate represents the different sublists and the abscissa gives the name of the parameters available in each sublist. Note that some row names have two keys separated by a dot: the first key indicates the first level of the sublist, etc. For example plabels.boxes is the sublist boxes of the sublist plabels. The parameters border,col, alpha, lwd, lty and draw in plabels.boxes allow to control the aspect of the boxes around labels.

According to the function called, only some of the full list of adeg.par parameters are useful to modify the graphical display. Figure 4 indicates which parameters can affect the display of an object created by a given user function. For example, the background (pbackground parameter) can be modified for all functions whereas the display of ellipses (pellipses parameter) affects only three functions.


Figure 4: Effect of adeg.par parameters in adegraphics functions.


4.2.1 Global assignment

The adegpar function allows to modify globally the values of graphical parameters so that changes will affect all subsequent displays. For example, we update the size/color of labels and add axes to a plot:

oldadegpar <- adegpar()
adegpar("plabels")
## $plabels
## $plabels$alpha
## [1] 1
## 
## $plabels$cex
## [1] 1
## 
## $plabels$col
## [1] "black"
## 
## $plabels$srt
## [1] "horizontal"
## 
## $plabels$optim
## [1] FALSE
## 
## $plabels$boxes
## $plabels$boxes$alpha
## [1] 1
## 
## $plabels$boxes$border
## [1] "black"
## 
## $plabels$boxes$col
## [1] "white"
## 
## $plabels$boxes$draw
## [1] TRUE
## 
## $plabels$boxes$lwd
## [1] 1
## 
## $plabels$boxes$lty
## [1] 1
g13 <- s.label(dfxy = pca1$li, plot = FALSE)
adegpar(plabels = list(col = "blue", cex = 1.5), paxes.draw = TRUE)
adegpar("plabels")
## $plabels
## $plabels$alpha
## [1] 1
## 
## $plabels$cex
## [1] 1.5
## 
## $plabels$col
## [1] "blue"
## 
## $plabels$srt
## [1] "horizontal"
## 
## $plabels$optim
## [1] FALSE
## 
## $plabels$boxes
## $plabels$boxes$alpha
## [1] 1
## 
## $plabels$boxes$border
## [1] "black"
## 
## $plabels$boxes$col
## [1] "white"
## 
## $plabels$boxes$draw
## [1] TRUE
## 
## $plabels$boxes$lwd
## [1] 1
## 
## $plabels$boxes$lty
## [1] 1
g14 <- s.label(dfxy = pca1$li, plot = FALSE)
ADEgS(c(g13, g14), layout = c(1, 2))

As the adegpar function can accept numerous graphical parameters, it can be used to define some graphical themes. The next releases of adegraphics will offer functionalities to easily create, edit and store graphical themes. Here, we reassign the original default parameters:

adegpar(oldadegpar)

4.2.2 Local assignment

A second option is to update the graphical parameters locally so that the changes will only modify the object created. This is done using the dots (...) argument in the call to a user function. In this case, the default values of parameters in the global environment are not modified:

adegpar("ppoints")
## $ppoints
## $ppoints$alpha
## [1] 1
## 
## $ppoints$cex
## [1] 1
## 
## $ppoints$col
## [1] "black"
## 
## $ppoints$pch
## [1] 20
## 
## $ppoints$fill
## [1] "black"
s.label(dfxy = pca1$li, plabels.cex = 0, ppoints = list(col = c(2, 4, 5), cex = 1.5, pch = 15))

adegpar("ppoints")
## $ppoints
## $ppoints$alpha
## [1] 1
## 
## $ppoints$cex
## [1] 1
## 
## $ppoints$col
## [1] "black"
## 
## $ppoints$pch
## [1] 20
## 
## $ppoints$fill
## [1] "black"

In the previous example, we can see that parameters can be either specified using a ’.’ separator or a list. For instance, using plabels.cex = 0 or plabels = list(cex = 0) is strictly equivalent. Moreover, partial names can be used if there is no ambiguity (such as plab.ce = 0 in our example).

4.3 Parameters in g.args

The g.args slot is a list of parameters specific to the function used (and thus to the class of the returned object). Several parameters are very general and used in all adegraphics functions:

  • xlim, ylim: limits of the graph on the x and y axes

  • main, sub: main title and subtitle

  • xlab, ylab: labels of the x and y axes

  • scales: a list determining how the x and y axes (tick marks dans labels) are drawn; this is the scales parameter of the xyplot function of lattice

The ADEg.S2 objects can also contain spatial information (map stored as a Spatial object or neighborhood stored as a nb object):

  • Sp, sp.layout: objects from the sp package to display spatial objects, Sp for maps and sp.layout for spatial widgets as a North arrow, scale, etc.

  • nbobject: object of class nb or listw to display neighbor graphs.

When the facets (see the Partitioning the data (facets) section) argument is used, users can modify the parameter samelimits: if it is TRUE, all graphs have the same limits whereas limits are computed for each subgraph independently when it is FALSE. For example, considering the jv73 data set, each subgraph is computed with its own limits and labels are then more scattered:

s.label(pca2$li, facets = jv73$fac.riv, samelimits = FALSE)

Several other g.args parameters can be updated according to the class of the created object (see Figure 2).

4.4 Parameters applied on a ADEgS

Users can either apply the changes to all graphs or to update only one graph. Of an ADEgS, to apply changes on all the graphs contained in an ADEgS, the syntax is similar to the one described for an ADEg object. For example, background color can be changed for all graphs in g10 using the pbackground.col parameter.

g15 <- plot(coi1, pbackground.col = "steelblue")

To change the parameters of a given graph, the name of the parameter must be preceded by the name of the subgraph. This supposes that the names of subgraphs are known. For example, to modify only two graphs:

names(g15)
## [1] "Xax"       "Yax"       "eig"       "XYmatch"   "Yloadings" "Xloadings"
plot(coi1, XYmatch.pbackground.col = "steelblue",  XYmatch.pgrid.col = "red", 
     eig.ppolygons.col = "orange")

5 Using adegraphics functions in your package

In this section, we illustrate how adegraphics functionalities can be used to implement graphical functions in your own package. We created an objet of class track that contains a vector of distance and time.

tra1 <- list()
tra1$time <- runif(300)
tra1$distance <- tra1$time * 5 + rnorm(300)
class(tra1) <- "track"

For an object of the class track, we wish to represent different components of the data:

  • an histogram of distances

  • an histogram of speeds (i.e., distance / time)

  • a 2D plot representing the distance, the time and the line corresponding to the linear model that predict distance by time

The corresponding multiple plot can be done using adegraphics functions:

g1 <- s1d.hist(tra1$distance, psub.text = "distance", ppolygons.col = "blue", 
               pgrid.draw = FALSE, plot = FALSE)
g2 <- s1d.hist(tra1$distance / tra1$time, psub.text = "speed", ppolygons.col = "red", 
               plot = FALSE)
g31 <- s.label(cbind(tra1$time, tra1$distance), paxes = list(aspectratio = "fill", 
               draw = TRUE), plot = FALSE)
g32 <- xyplot(tra1$distance ~ tra1$time, aspect = g31@adeg.par$paxes$aspectratio, 
              panel = function(x, y) {panel.lmline(x, y)})
g3 <- superpose(g31, g32)
G <- ADEgS(list(g1, g2, g3))

To facilitate the graphical representation of an object of class track, the simplest solution is to design a function plot for this class. We illustrate how to define such function with a particular emphasis on the management of graphical parameters. The function is provided below and we detail the different steps.

plot.track <- function(x, pos = -1, storeData = TRUE, plot = TRUE, ...) {
 
 ## step 1 : sort parameters for each graph
 graphsnames <- c("histDist", "histSpeed", "regression")
 sortparameters <- sortparamADEgS(..., graphsnames = graphsnames, 
                                  nbsubgraphs = c(1, 1, 2))
 
 ## step 2 : define default values for graphical parameters
 params <- list()
 params[[1]] <- list(psub = list(text = "distance"), ppolygons = list(col = "blue"), 
                     pgrid = list(draw = FALSE))
 params[[2]] <- list(psub = list(text = "speed"), ppolygons = list(col = "red"), 
                     pgrid = list(draw = FALSE))
 params[[3]] <- list()
 params[[3]]$l1 <- list(paxes = list(aspectratio = "fill", draw = TRUE))
 params[[3]]$l2 <- list()
 names(params) <- graphsnames
 sortparameters <- modifyList(params, sortparameters, keep.null = TRUE)
 
 ## step 3 : create each individual plot (ADEg)
 g1 <- do.call("s1d.hist", c(list(score = substitute(x$distance), plot = FALSE, 
               storeData = storeData, pos = pos - 2), sortparameters[[1]]))
 g2 <- do.call("s1d.hist", c(list(score = substitute(x$distance / x$time), 
               plot = FALSE, storeData = storeData, pos = pos - 2), sortparameters[[2]]))
 g31 <- do.call("s.label", c(list(dfxy = substitute(cbind(x$time, x$distance)), plot = 
               FALSE, storeData = storeData, pos = pos - 2), sortparameters[[3]][[1]]))
 g32 <- xyplot(x$distance ~ x$time, aspect = g31@adeg.par$paxes$aspectratio,
               panel = function(x, y) {panel.lmline(x, y)})
 g3 <- do.call("superpose", list(g31, g32))
 g3@Call <- call("superpose", g31@Call, g32$call)
 
 
 ## step 4 : create the multiple plot (ADEgS)
 lay <- matrix(1:3, 1, 3)
 object <- new(Class = "ADEgS", ADEglist = list(g1, g2, g3), positions = 
               layout2position(lay), add = matrix(0, ncol = 3, nrow = 3), 
               Call = match.call())
 names(object) <- graphsnames
 if(plot)
   print(object)
 invisible(object)
}

In the first step, the arguments given by the user through the dots (…) argument are managed. A name is given to each subgraph and stored in the vector graphnames. Then, the function sortparamADEgS associates the graphical parameters of the dots (…) argument to each subgraph. If a prefix is specified and matches the name of a graph (e.g., histDist.pbackground.col = grey), the parameter is applied only to the graphic specified (e.g., called histDist). If no prefix is specified (e.g., pbackground.col = grey), the parameter is applied to all subgraphs. The function sortparamADEgS returns a list (length equal to the number of subgraph) of lists of graphical parameters.

In the second step, default values for some graphical parameters are modified. The default parameters are stored in a list which has the same structure that the one produced by sortparamADEgS (i.e., names corresponding to those contained in graphsnames). Then, the modifyList function is applied to merge user and defaults values of paramaters (if a parameter is specified by the user and in the default, the value given by the user is used).

In the third step, each subgraph is created. Here, we create two C1.hist objects and superpose a S2.label object and a trellis one. The functions do.call and substitute are used to provide a pretty call for each subgraph (stored in the Call slot).

In a final step, the multiple graph is build through the creation of a new ADEgS object and possibly plotted.

The plot.track function can then be used by:

plot(tra1)

Graphical parameters can be modified by:

plot(tra1, histDist.ppoly.col = "green", pbackground.col = "grey")

6 Examples

6.1 Labels customization

data(meaudret)
g16 <- s.label(pca3$li, plot = FALSE)
g17 <- s.label(pca3$li, ppoints.col= "red", plabels = list(box = list(draw = FALSE), 
  optim = TRUE), plot = FALSE)
ADEgS(c(g16, g17), layout = c(1, 2))

6.2 Ellipses, stars and convex hulls

g18 <- s.class(pca3$li, fac = meaudret$design$season, plot = FALSE)
g19 <- s.class(pca3$li, fac = meaudret$design$season, ellipseSize = 0, 
  chullSize = 1, starSize = 0.5, col = TRUE, plot = FALSE)
g20 <- s.class(pca3$li, fac = meaudret$design$season, pellipses.lwd = 2, 
  pellipses.border = 2:5, pellipses.col = 2:5, plot = FALSE)
g21 <- s.class(pca3$li, fac = meaudret$design$season, ellipseSize = 0, 
  chullSize = 0, ppolygons.lwd = 2, plines.col = 2:5, starSize = 1.2, plot = FALSE)
ADEgS(c(g18, g19, g20, g21), layout = c(2, 2))

6.3 Values and legend

data(rpjdl)
coa2 <- dudi.coa(rpjdl$fau, scannf = FALSE, nf = 3)
g22 <- s.value(coa2$li, coa2$li[,3], plot = FALSE)
g23 <- s.value(coa2$li, coa2$li[,3], method = "color", ppoints.cex = 0.8, 
  plegend.size= 0.8, plot = FALSE)
g24 <- s.value(coa2$li, coa2$li[,3], plegend.size = 0.8, ppoints.cex = 0.8, 
  symbol = "square", method = "color", key = list(columns = 1), 
  col = colorRampPalette(c("yellow", "blue"))(6), plot = FALSE)
g25 <- s.value(coa2$li, coa2$li[, 3], center = 0, method = "size", ppoints.cex = 0.6, 
  symbol = "circle", col = c("yellow", "red"), plot = FALSE)
ADEgS(c(g22, g23, g24, g25), layout = c(2, 2))

6.4 1-D plot

score1 <- c(rnorm(1000, mean = -0.5, sd = 0.5), rnorm(1000, mean = 1))
fac1 <- rep(c("A", "B"), each = 1000)
g26 <- s1d.density(score1, fac1, pback.col = "grey75", plot = FALSE)
g27 <- s1d.density(score1, fac1, col = c(2, 4), plot = FALSE)
g28 <- s1d.density(score1, fac1, col = c(2, 4), p1d.reverse = TRUE, p1d.horizontal = FALSE, 
  p1d.rug.draw = FALSE, plot = FALSE)
g29 <- s1d.density(score1, fac1, col = c(2, 4), ppolygons.alpha = 0.2, 
  p1d = list(rug = list(tck = 1, line = FALSE)), plot = FALSE)
ADEgS(c(g26, g27, g28, g29), layout = c(2, 2))

6.5 Maps and neighbor graphs

if(require(Guerry)) {
  library(sp)
  data(gfrance85)
  region.names <- data.frame(gfrance85)[, 5]
  col.region <- colors()[c(149, 254, 468, 552, 26)]
  g30 <- s.class(coordinates(gfrance85), region.names, porigin.include = FALSE, plot = FALSE)
  g31 <- s.class(coordinates(gfrance85), region.names, ellipseSize = 0, starSize = 0,
                 Sp = gfrance85, pgrid.draw = FALSE, pSp.col = col.region[region.names], pSp.alpha = 0.4,
                 plot = FALSE)
  ADEgS(c(g30, g31), layout = c(1, 2))
}
## Le chargement a nécessité le package : Guerry

# if(require(Guerry)) {
#   s.Spatial(gfrance85[,7:12])
# }
data(mafragh, package = "ade4")
g32 <- s.label(mafragh$xy, nb = mafragh$nb, plot = FALSE)
g33 <- s.label(mafragh$xy, nb = mafragh$nb, pnb.ed.col = "red", plab.cex = 0, 
  pnb.node = list(cex = 3, col = "blue"), ppoints.col = "green", plot = FALSE)
ADEgS(c(g32, g33), layout = c(1, 2))

6.6 Ternary plots

data(euro123, package = "ade4")
df <- rbind.data.frame(euro123$in78, euro123$in86, euro123$in97)
row.names(df) <- paste(row.names(euro123$in78), rep(c(1, 2, 3), rep(12, 3)), sep = "")
g34 <- triangle.label(df, label = row.names(df), showposition = TRUE, plot = FALSE)
g35 <- triangle.label(euro123$in78, plabels.cex = 0, ppoints.cex = 2, addmean = TRUE, 
  show = FALSE, plot = FALSE)
ADEgS(c(g34, g35), layout = c(1, 2))

7 Appendix

This appendix summarizes the main changes between ade4 and adegraphics. Each line corresponds to a graphical argument defined in ade4 and its equivalent in adegraphics is given.

Arguments in ade4 Functions in ade4 g.args in adegraphics adeg.par in adegraphics
abline.x table.cont ablineX
abline.y table.cont ablineY
abmean.x table.cont meanX
abmean.y table.cont meanY
addaxes s.arrow, s.chull, s.class, s.distri, s.image, s.kde2d, s.label, s.logo, s.match, s.traject, s.value, triangle.class, triangle.plot paxes.draw
area s.arrow, s.chull, s.class, s.distri, s.image, s.kde2d, s.label, s.logo, s.match, s.traject, s.value Sp a Sp object
axesell s.class, s.distri, triangle.class pellipses.axes.draw
box s.corcircle, triangle.plot pbackground.box
boxes s.arrow, s.label, sco.class, sco.label, sco.match plabels.boxes.draw
cellipse s.class, s.distri, triangle.class ellipseSize
cgrid s.arrow, s.class, s.chull, s.corcircle, s.distri, s.image, s.kde2d, s.label, s.logo, s.match, s.traject, s.value, sco.boxplot, sco.class, sco.distri, sco.gauss, sco.label, sco.match pgrid.nint both play on the grid mesh, but they are not strictly equivalent
clabel s.arrow, s.class, s.chull, s.corcircle, s.distri, s.kde2d, s.label, s.match, s.traject, sco.boxplot, sco.class, sco.distri, sco.gauss, sco.label, sco.match, triangle.plot plabels.cex
clabel table.dist axis.text = list() lattice parameter
clabel.col table.cont, table.paint, table.value axis.text = list() lattice parameter
clabel.row table.cont, table.paint, table.value axis.text = list() lattice parameter
clegend s.value, table.cont, table.value plegend.size ppoints.cex parameters setting the legend size
clegend table.paint plegend.size
clogo s.logo ppoints.cex
cneig s.image, s.kde2d, s.label, s.logo, s.value pnb.edge.lwd
col.labels table.cont, table.paint, table.value labelsy
contour s.arrow, s.class, s.chull, s.distri, s.image, s.kde2d, s.label, s.logo, s.match, s.traject, s.value Sp a Sp object
contour.plot s.image region
cpoints, cpoint s.arrow, s.class, s.chull, s.distri, s.kde2d, s.label, s.match, s.traject, s.value, sco.class, sco.label, sco.match, triangle.class, triangle.plot ppoints.cex
csize s.value, table.cont, table.dist, table.paint, table.value ppoints.cex
csize sco.distri sdSize
cstar s.class, s.distri, triangle.class starSize
csub s.arrow, s.chull, s.class, s.corcircle, s.distri, s.image, s.kde2d, s.label, s.logo, s.match, s.traject, s.value, sco.boxplot, sco.class, sco.distri, sco.gauss, sco.label, sco.match, triangle.class, triangle.plot psub.cex
draw.line triangle.biplot, triangle.class, triangle.plot pgrid.draw
edge s.arrow, s.match, s.traject parrows.length setting the length of the arrows to 0 is equivalent to edge = FALSE
grid s.arrow, s.chull, s.class, s.corcircle, s.distri, s.image, s.kde2d, s.label, s.logo, s.match, s.traject, s.value, sco.boxplot, sco.class, sco.distri, sco.gauss, sco.label, sco.match, table.cont, table.dist, table.value pgrid.draw
horizontal sco.class, sco.gauss, sco.label, sco.match p1d.horizontal
image.plot s.image contour
includeorigin, include.origin s.arrow, s.chull, s.class, s.distri, s.image, s.kde2d, s.label, s.logo, s.match, s.traject, s.value, sco.boxplot, sco.class, sco.distri, sco.gauss, sco.label, sco.match porigin.include
kgrid s.image gridsize
klogo s.logo no correspondence
labeltriangle triangle.class , triangle.plot no correspondence
legen sco.gauss labelplot
neig s.image, s.kde2d, s.label, s.logo, s.value nbobject a nb object
optchull s.chull chullSize
origin s.arrow, s.chull, s.class, s.corcircle, s.distri, s.image, s.kde2d, s.label, s.logo, s.match, s.traject, s.value, sco.boxplot, sco.class, sco.distri, sco.gauss, sco.label, sco.match porigin.origin
pch s.arrow, s.chull, s.class, s.distri, s.kde2d, s.label, s.match, s.traject, s.value, sco.boxplot, sco.class, sco.label, sco.match, triangle.class, triangle.plot, table.cont ppoints.pch
pixmap s.arrow, s.chull, s.class, s.distri, s.image, s.kde2d, s.label, s.logo, s.match, s.traject, s.value no correspondence
pos.lab sco.class, sco.label, sco.match p1d.labpos
possub s.arrow, s.chull, s.class, s.corcircle, s.distri, s.image, s.kde2d, s.label, s.logo, s.match, s.traject, s.value, sco.class, sco.gauss, sco.label, sco.match, triangle.class, triangle.plot psub.pos
rectlogo s.logo rect
reverse sco.class, sco.gauss, sco.label, sco.match p1d.reverse
row.labels table.cont, table.paint, table.value labelsx
scale triangle.class, triangle.plot adjust
show.position triangle.class, triangle.plot showposition
sub s.arrow, s.chull, s.class, s.corcircle, s.distri, s.image, s.kde2d, s.label, s.logo, s.match, s.traject, s.value, sco.boxplot, sco.class, sco.distri, sco.gauss, sco.label, sco.match, triangle.class, triangle.plot psub.text
y.rank sco.distri yrank
zmax s.value set to default max(abs(z))

References

Dray, Stéphane, and Anne-Béatrice Dufour. 2007. “The ade4 Package: Implementing the Duality Diagram for Ecologists.” Journal of Statistical Software 22 (4): 1–20. https://doi.org/10.18637/jss.v022.i04.

Murrell, Paul. 2005. R Graphics. Chapman & Hall/CRC Press. https://www.e-reading.club/bookreader.php/137370/C486x_APPb.pdf.

Sarkar, Deepayan. 2008. Lattice: Multivariate Data Visualization with R. Springer. https://doi.org/10.1007/978-0-387-75969-2.

Siberchicot, Aurélie, Alice Julien-Laferrière, Anne-Béatrice Dufour, Jean Thioulouse, and Stéphane Dray. 2017. “adegraphics: An S4 Lattice-Based Package for the Representation of Multivariate Data.” The R Journal 9 (2): 198–212. https://journal.r-project.org/archive/2017/RJ-2017-042/index.html.

  1. The table.value function is now generic and can handle dist or table objects as arguments.↩︎

  2. Convex hulls are now drawn by the s.class function (argument chullSize.)↩︎

adegraphics/inst/doc/FAQ.R0000644000176200001440000000340414774707406015021 0ustar liggesusers## ----------------------------------------------------------------------------- set.seed(2564) library(ade4) library(adegraphics) ## ----------------------------------------------------------------------------- df <- data.frame(x = rep(1:10,1), y = rep(1:10, each = 10), ms_li = runif(100, min = -5, max = 4)) s.value(df[, 1:2], df$ms_li, paxes.draw = TRUE) ## ----------------------------------------------------------------------------- s.value(df[, 1:2], df$ms_li, paxes.draw = TRUE, xlab = "Longitude", xlab.cex = 0.5, ylab = "Latitude", ylab.cex = 0.5 ) ## ----------------------------------------------------------------------------- s.value(df[, 1:2], df$ms_li, paxes.draw = TRUE, scales.x.cex = 0.5, scales.y.cex = 0.5 ) ## ----------------------------------------------------------------------------- s.value(df[, 1:2], df$ms_li, paxes.draw = TRUE, xlab = "Longitude", xlab.cex = 2, ylab = "Latitude", ylab.cex = 2, layout.heights = list(bottom.padding = 2) ) ## ----------------------------------------------------------------------------- x0 <- runif(50, -2, 2) y0 <- runif(50, -2, 2) s.label(data.frame(x0, y0)) ## ----------------------------------------------------------------------------- s.label(data.frame(x0, y0), plabels.boxes.border = 0) s.label(data.frame(x0, y0), plabels.boxes.draw = FALSE, ppoints.cex = 0) ## ----------------------------------------------------------------------------- s.label(data.frame(x0, y0), plabels.boxes.col = "orange") ## ----------------------------------------------------------------------------- s.label(data.frame(x0, y0), plabels.boxes.border = "blue", plabels.boxes.lwd = 2) adegraphics/build/0000755000176200001440000000000014774707431013641 5ustar liggesusersadegraphics/build/vignette.rds0000644000176200001440000000036614774707431016205 0ustar liggesusersuP0&DOz ŋm*D^5ƛ_.0tvg2&i2ųۊϙsizqݡ iYXN-'^g'2^;~tAp1XvxFzsAsqH3J3ЂC*؆jG:B`o(9⡑ˇ6 K4o8B'QI3yD {<adegraphics/man/0000755000176200001440000000000014572562616013315 5ustar liggesusersadegraphics/man/adeg.panel.label.Rd0000644000176200001440000000511714354577564016672 0ustar liggesusers\name{adeg.panel.label} \alias{adeg.panel.label} \title{Panel function for adding labels.} \description{ Panel function for drawing labels into a \code{trellis} graphic (\code{lattice} package) with or without boxes around labels. } \usage{ adeg.panel.label(x, y, labels, plabels, pos = NULL) } \arguments{ \item{x}{a numeric vector, x-coordinates for the labels} \item{y}{a numeric vector, y-coordinates for the labels} \item{labels}{a vector of character string, the labels} \item{plabels}{ a list of parameters as an extract of \code{adegpar("plabels")}, used for labels' drawing. Each value can be a vector and will be recycled if necessary: \itemize{ \item{\code{alpha}, \code{cex}, \code{col}: drawing parameters for the text} \item{\code{srt}: orientation of the labels, \code{horizontal}, \code{vertical} or an angle indication (in degrees). Boxes are not rotated. If the orientation is not near to \code{horizontal}/\code{vertical} (0/90), it is best not to draw the boxes} \item{\code{optim}: logical. If TRUE, uses an algorithm trying to avoid labels' overlapping and outside limits} \item{\code{boxes}: concerns the label's boxes. a list: \itemize{ \item{\code{draw}: logical. If TRUE, labels are framed} \item{\code{alpha}, \code{border}, \code{col}, \code{lwd}, \code{lty}: rule transparency, border lines and background color} }}}} \item{pos}{a position specifier for the text, used in panel.text. Values of \code{1}, \code{2}, \code{3} and \code{4} respectively indicate positions below, to the left of, above and to the right of the specified coordinates.} } \value{ Draws the labels. } \references{ The algorithm used for labels positions optimization is inspired by the \code{pointLabel} function of the \code{car} package (since 2022-10-22, moved from the the \code{maptools} package, developed by Tom Short). } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{\link[car]{pointLabel}} \note{ For more information about the use of panel functions, please see the \code{lattice} package developed by Deepayan Sarkar. } \examples{ if(require(lattice, quietly = TRUE)) { param <- adegpar("plabels")[[1]] xyplot(1:10 ~ 1:10, panel = function(x, y, ...){ adeg.panel.label(x, y, LETTERS[1:10], plabels = param)}) } if(require(lattice, quietly = TRUE)) { param$boxes$draw <- FALSE param$col <- "blue" xyplot(1:10 ~ 1:10, panel = function(x, y, ...){ adeg.panel.label(x, y, LETTERS[1:10], plabels = param)}) } } \keyword{aplot} adegraphics/man/C1.gauss-class.Rd0000644000176200001440000000776213742303021016264 0ustar liggesusers\name{C1.gauss-class} \docType{class} \alias{C1.gauss} \alias{C1.gauss-class} \alias{prepare,C1.gauss-method} \alias{panel,C1.gauss-method} \title{Class \code{C1.gauss}} \description{ A class for the creation and display of a numeric score using gauss' curves. } \section{Objects from the Class}{ \code{C1.gauss} objects can be created by calls of the form \code{new("C1.gauss", ...)}. The regular usage in this package is to use the \code{s1d.gauss} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{score}: the displayed values in the form of a numeric vector, a name or a matching call.} \item{\code{fac}: a factor for \code{score} splitting in the form of a vector, a factor, a name or a matching call.} \item{\code{wt}: a vector of weights for \code{score}} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.C1} class. The specific slots for \code{C1.gauss} objects are: \itemize{ \item{\code{fill}: a logical to yield the gauss curves transparent.} \item{\code{col}: a logical, a color or a colors vector to color labels, rugs, lines and polygons.} \item{\code{steps}: a value for the number of segments used to draw Gauss curves.} }} \item{\code{stats}}{a list of internal preliminary calculations. The specific slots for \code{C1.gauss} objects are: \itemize{ \item{\code{means}: the weighted mean calculated for each \code{fac} value.} \item{\code{var}: the weighted variance calculated for each \code{fac} value.} \item{\code{gausscurves}: the density gauss curve calculated for each \code{fac} value.} }} \item{\code{s.misc}}{a list of some others internal parameters. The specific slot for \code{C1.gauss} objects is: \itemize{ \item{\code{rug}: an index value indicating where the rugs are drawn} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.C1}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.C1}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.C1}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.C1}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.C1"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{C1.gauss} are: \describe{ \item{prepare}{\code{signature(object = "C1.gauss")}: calls the parent method (\code{prepare} for \code{ADEg.C1}), modifies some graphical parameters used by default and calculates the Gauss curves according to the numeric score and the values' categories (using weighted mean and standard deviation).} \item{panel}{\code{signature(object = "C1.gauss")}: draws Gauss curves and level names of each curve.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.C1}} \code{\link{s1d.gauss}} } \examples{ showClass("C1.gauss") } \keyword{classes} adegraphics/man/s1d.interval.Rd0000644000176200001440000000460213742303021016075 0ustar liggesusers\name{s1d.interval} \alias{s1d.interval} \title{1-D plot of the interval between two numeric scores} \description{ This function represents the interval between two scores using either segments or filled areas. } \usage{ s1d.interval(score1, score2, at = 1:NROW(score1), method = c("bars", "area"), facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{score1}{a numeric vector (or a data frame) used to produce the plot} \item{score2}{a numeric vector with as many values as values (or rows) in \code{score1}} \item{at}{a numeric vector used as an index} \item{method}{a value, \code{bars} or \code{area}, to represent either segments or areasbetween scores.} \item{facets}{a factor splitting \code{score} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ Graphical parameters for polygons, lines and segment boundaries are available in respectively \code{ppolygons}, \code{plines} and \code{parrows} of \code{adegpar}. Some appropriated graphical parameters in \code{p1d} are also available. } \value{ An object of class \code{ADEg} (subclass \code{C1.interval}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or data frame for \code{score} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{C1.interval}} \code{\linkS4class{ADEg.C1}} } \examples{ set.seed(40) sc1 <- rnorm(10) sc2 <- rnorm(10) s1d.interval(sc1, sc2, method = "bars") s1d.interval(sc1, sc2, method = "area") } \keyword{aplot} \keyword{hplot} adegraphics/man/sortparamADEg.Rd0000644000176200001440000000323113742303021016251 0ustar liggesusers\name{sortparamADEg} \alias{sortparamADEg} \alias{sortparamADEgS} \title{ Sort a sequence of graphical parameters } \description{ Sort a sequence of graphical parameters in several lists. } \usage{ sortparamADEg(...) sortparamADEgS(..., graphsnames, nbsubgraphs = rep(1, length(graphsnames))) } \arguments{ \item{...}{a sequence of graphical parameters} \item{graphsnames}{a sequence containing the name of each simple graph of the ADEgS} \item{nbsubgraphs}{a sequence containing the number of sub-graphs in each graph named in \code{graphsnames}} } \value{ \code{sortparamADEg} return a list of four lists named \code{adepar}, \code{trellis}, \code{g.args} and \code{rest}. \code{sortparamADEgS} return a list of as many lists as the length of \code{graphsnames}, i.e., as the number of sub-graphs of the ADEgS. The names of the lists are \code{graphsnames} and each sub-list is the result of the \code{sortparamADEg} function aplly on each sub-graph. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \examples{ l1 <- sortparamADEg(xlab = "x-axis label", ylab = "y-axis label", plabels.cex = 1.5, porigin.include = FALSE) length(l1) names(l1) l2 <- sortparamADEgS(xlab = "x-axis label", eig.main = "Eigenvalues", row.ppoints.col = "red", porigin.include = FALSE, graphsnames = c("row", "col", "eig")) names(l2) names(l2$row) l3 <- sortparamADEgS(xlab = "x-axis label", eig.main = "Eigenvalues", row.ppoints.col = "pink", porigin.include = FALSE, graphsnames = c("row", "col", "eig"), nbsubgraphs = c(1, 2, 1)) names(l3) length(l3$row) length(l3$col) } \keyword{aplot} adegraphics/man/adeg.panel.join.Rd0000644000176200001440000000202513742303021016514 0ustar liggesusers\name{adeg.panel.join} \alias{adeg.panel.join} \title{Panel function for joining lines.} \description{ Panel function for drawing lines as part of a circle centred in (0, 0) into a \code{trellis} graphic (\code{lattice} package). } \usage{ adeg.panel.join(drawLines, params = list()) } \arguments{ \item{drawLines}{a vector containing the level values used as radius of the circle} \item{params}{graphical parameters : \code{plabels} and \code{add.line} (\code{lattice})} } \value{ Displays level lines and their values. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \note{ For more information about the use of panel functions, please see the \code{lattice} package developed by Deepayan Sarkar. } \examples{ if(require(lattice, quietly = TRUE)) { xyplot(0:20 ~ 0:20, drawLines = c(5, 10, 15), params = list(plabels.cex = 2), panel = function(drawLines, params){ adeg.panel.join(drawLines = drawLines, params = params)}) }} \keyword{aplot}adegraphics/man/S2.corcircle-class.Rd0000644000176200001440000000666313742303021017127 0ustar liggesusers\name{S2.corcircle-class} \docType{class} \alias{S2.corcircle} \alias{S2.corcircle-class} \alias{prepare,S2.corcircle-method} \alias{panel,S2.corcircle-method} \title{Class \code{S2.corcircle}} \description{ A class for creating and drawing a correlation circle. } \section{Objects from the Class}{ \code{S2.corcircle} objects can be created by calls of the form \code{new("S2.corcircle", ...)}. The regular usage in this package is to use the \code{s.corcircle} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{dfxy}: the displayed values in the form of a data frame, a name or a matching call.} \item{\code{xax}: an integer or a vector indicating the columns of \code{dfxy} kept for the x-axes.} \item{\code{yax}: an integer or a vector indicating the columns of \code{dfxy} kept for the y-axes.} \item{\code{labels}: a vector containing the points' labels.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S2} class. The specific slot for \code{S2.corcircle} objects is: \itemize{ \item{\code{fullcircle}: a logical to include the complete circle (limits are then c(-1, 1)).} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters: \itemize{ \item{\code{backgrid}: a list of elements for grid lines} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.S2}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.S2}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.S2}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.S2}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.S2"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{S2.corcircle} are: \describe{ \item{prepare}{\code{signature(object = "S2.corcircle")}: calls the parent method (\code{prepare} for \code{ADEg.S2}), modifies some graphical parameters used by default and prepares the drawn grid.} \item{panel}{\code{signature(object = "S2.corcircle")}: draws arrows, labels and axes.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.S2}} \code{\link{s.corcircle}} } \examples{ showClass("S2.corcircle") } \keyword{classes} adegraphics/man/ADEg.S1-class.Rd0000644000176200001440000001130213742303021015703 0ustar liggesusers\name{ADEg.S1-class} \docType{class} \alias{ADEg.S1} \alias{ADEg.S1-class} \alias{prepare,ADEg.S1-method} \alias{setlatticecall,ADEg.S1-method} \alias{gettrellis,ADEg.S1-method} \alias{panelbase,ADEg.S1-method} \title{Class \code{ADEg.S1}} \description{ An object of \code{ADEg.S1} class represents unidimensional data into one dimension. The \code{ADEg.S1} class is a virtual class, i.e. a class which is not possible to create objects but which have heirs. This class inherits from \code{ADEg} class and has five son classes : \code{S1.boxplot}, \code{S1.class}, \code{S1.distri}, \code{S1.label} and \code{S1.match}. } \section{Objects from the Class}{ None object of this class can be instantiated. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{score}: the displayed values in the form of a numeric vector, a name or a matching call.} \item{\code{at}: the index value.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list of two elements to create the \code{trellis} object: \itemize{ \item{\code{graphictype}: \code{xyplot}} \item{\code{arguments}: its parameters to obtain the \code{trellis} object} }} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S1} class.} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters: \itemize{ \item{\code{hori.update}: a logical indicating if the sense of direction of the graphics is updating} \item{\code{backgrid}: a list of two elements for grid lines. \code{backgrid$x} defines the coordinates of the lines (horizontal or vertical depending on the graphics orientation) and \code{backgrid$d} the grid mesh} \item{\code{rug}: an index value indicating where the rugs are drawn} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg}}, directly. } \section{Methods}{ \describe{ \item{prepare}{\code{signature(object = "ADEg.S1")}: performs the calculations before display the object (e.g. limits, grid and axis calculations)} \item{setlatticecall}{\code{signature(object = "ADEg.S1")}: prepares the \code{lattice.call} slot} \item{panelbase}{\code{signature(object = "ADEg.S1")}: defines the graphical background (e.g. grid, rugs and box)} \item{gettrellis}{\code{signature(object = "ADEg.S1")}: converts the graphic into a \code{trellis} object of \code{lattice} class} \item{zoom}{\code{signature(object = "ADEg.S1", zoom = "numeric", center = "missing")}: performs a zoom in (if zoom < 1) or out (if zoom > 1) centered, only in one-dimension} \item{zoom}{\code{signature(object = "ADEg.S1", zoom = "numeric", center = "numeric")}: performs a zoom in (if zoom < 1) or out (if zoom > 1) around the center passed in parameter, only in one-dimension} } } \note{ Various graphical parameters are used for display an ADEg.S1 object. The list \code{p1d} in \code{adegpar()} is thought specific for \code{ADEg.S1} objects. The \code{ADEg.S1} class and \code{ADEg.C1} class are both used to represent an unidimensional information (e.g. a score). The difference between these two classes is mainly ideological : an \code{ADEg.S1} object is a representation into one dimension (e.g. one line) while an \code{ADEg.C1} object is a representation into two dimensions (e.g. curves). } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\link{adegpar}} \code{\link{zoom}} \code{\linkS4class{S1.boxplot}} \code{\linkS4class{S1.class}} \code{\linkS4class{S1.distri}} \code{\linkS4class{S1.label}} \code{\linkS4class{S1.match}} \code{\linkS4class{ADEg}} } \examples{ showClass("ADEg.S1") adegpar("p1d") } \keyword{classes} adegraphics/man/s.corcircle.Rd0000644000176200001440000000436213742303021015774 0ustar liggesusers\name{s.corcircle} \alias{s.corcircle} \title{Correlation circle} \description{ This function produces a correlation circle. } \usage{ s.corcircle(dfxy, xax = 1, yax = 2, labels = row.names(as.data.frame(dfxy)), fullcircle = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{dfxy}{a data frame used to produce the plot} \item{labels}{a vector containing the points' labels} \item{xax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the x-axis} \item{yax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the y-axis} \item{fullcircle}{a logical to include the complete circle (limits are then c(-1, 1))} \item{facets}{a factor splitting the rows of \code{dfxy} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \value{ An object of class \code{ADEg} (subclass \code{S2.corcircle}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or vectors for \code{xax}/\code{yax} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{S2.corcircle}} \code{\linkS4class{ADEg.S2}} } \examples{ data (olympic, package = "ade4") dudi1 <- ade4::dudi.pca(olympic$tab, scannf = FALSE) g1 <- s.corcircle(dudi1$co) g2 <- s.corcircle(dudi1$co, fullcircle = FALSE, pback.col = "grey") } \keyword{aplot} \keyword{hplot} adegraphics/man/addline.Rd0000644000176200001440000000405314377601020015170 0ustar liggesusers\name{addline} \alias{addline} \alias{addline-methods} \alias{addline,ADEg-method} \alias{addline,ADEgS-method} \title{ Adds lines on graphics. } \description{ Adds a \code{trellis} object containing one or several lines on one or several graphical objects. } \usage{ addline(object, a = NULL, b = 0, h = NULL, v = NULL, plot = TRUE, ...) } \arguments{ \item{object}{an object of class \code{ADEg} or \code{ADEgS} } \item{a, b}{coefficients of the line to be added, passed to the \code{panel.abline} function of the \code{lattice} package } \item{h, v}{numeric vectors giving locations respectively of horizontal and vertical lines to be added to the plot, in native coordinates, passed to the \code{panel.abline} function of the \code{lattice} package } \item{plot}{a logical indicating if the graphics is displayed } \item{\dots}{Other arguments. Additional graphical parameters (see the \code{plines} list in \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}}). If \code{object} is an \code{ADEgS}, the argument \code{which} identify which \code{ADEg} is/are used for superposition. } } \value{ An object of class \code{ADEgS}. } \author{Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEgS}} \code{\link[lattice]{panel.abline}} } \examples{ # example extracted from the pedagogic file, here: http://pbil.univ-lyon1.fr/R/pdf/tdr65.pdf data(monde84, package = "ade4") dfX <- cbind.data.frame(lpib = log(monde84$pib), croipop = monde84$croipop) dfY <- cbind.data.frame(lmorta = log(monde84$morta), lanal = log(monde84$anal + 1), rscol = sqrt(100 - monde84$scol)) dfX0 <- ade4::scalewt(dfX) dfY0 <- ade4::scalewt(dfY) can1 <- cancor(dfX0, dfY0) varcanoX <- dfX0 \%*\% can1$xcoef[,1] varcanoY <- dfY0 \%*\% can1$ycoef[,1] g1 <- s.label(cbind(varcanoY,varcanoX), labels = row.names(monde84), plabel.cex = 0.8, plot = FALSE) addline(g1, 0, 1, plines.col = "red", plines.lwd = 0.5, plines.lty = 2) } \keyword{aplot} adegraphics/man/cbindADEg.Rd0000644000176200001440000000302313742303021015317 0ustar liggesusers\name{cbindADEg} \alias{cbindADEg} \alias{rbindADEg} \alias{cbindADEg-methods} \alias{rbindADEg-methods} \alias{cbindADEg,ADEgORADEgSORtrellis,ADEgORADEgSORtrellis-method} \alias{rbindADEg,ADEgORADEgSORtrellis,ADEgORADEgSORtrellis-method} \title{Combine \code{ADEg} objects by columns or rows} \description{ Take a sequence of \code{ADEg}, \code{ADEgS} or \code{trellis} arguments and combine by columns or rows, respectively. } \usage{ cbindADEg(g1, g2, ..., plot = FALSE) rbindADEg(g1, g2, ..., plot = FALSE) } \arguments{ \item{g1}{an object of class \code{ADEg}, \code{ADEgS} or \code{trellis}} \item{g2}{an object of class \code{ADEg}, \code{ADEgS} or \code{trellis}} \item{...}{other objects of class \code{ADEg}, \code{ADEgS} or \code{trellis}} \item{plot}{a logical indicating if the graphics is displayed} } \value{ an \code{ADEgS} object } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEgS}} \code{\link{ADEgS}} } \examples{ data(jv73, package = "ade4") pca1 <- ade4::dudi.pca(jv73$morpho, scannf = FALSE) g1 <- s.label(pca1$li, plabels.optim = TRUE, plot = FALSE) g2 <- s.class(pca1$li, jv73$fac.riv, starSize = 0, ellipseSize = 0, chullSize = 1, ppolygons.alpha = 0.4, col = rainbow(12), ppoints.cex = 0, plot = FALSE) g3 <- s.corcircle(pca1$co, pbackground.box = FALSE, plot = FALSE) g4 <- rbindADEg(cbindADEg(g1, g2), cbindADEg(superpose(g1, g2), g3), plot = TRUE) } \keyword{hplot} adegraphics/man/C1.hist-class.Rd0000644000176200001440000000712013742303021016075 0ustar liggesusers\name{C1.hist-class} \docType{class} \alias{C1.hist} \alias{C1.hist-class} \alias{prepare,C1.hist-method} \alias{panel,C1.hist-method} \title{Class \code{C1.hist}} \description{ A class for the creation and display of a numeric score using a histogram. } \section{Objects from the Class}{ \code{C1.hist} objects can be created by calls of the form \code{new("C1.hist", ...)}. The regular usage in this package is to use the \code{s1d.hist} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{score}: the displayed values in the form of a vector, a factor, a name or a matching call.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.C1} class. The specific slots for \code{C1.hist} objects are: \itemize{ \item{\code{breaks}: a vector of values to split \code{score}. If \code{NULL}, \code{pretty(score, nclass)} is used.} \item{\code{nclass}: an integer for the number of desired intervals, ignored if \code{breaks} is not missing.} \item{\code{type}: a value among \code{count}, \code{density}, \code{percent} to indicate the unit of the cell height.} \item{\code{right}: a logical indicating if the histogram cells are right-closed (left open) intervals.} }} \item{\code{stats}}{a list of internal preliminary calculations. The specific slots for \code{C1.hist} objects are: \itemize{ \item{\code{heights}: the cell height.} \item{\code{breaks}: the cell boundaries.} }} \item{\code{s.misc}}{a list of some others internal parameters} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.C1}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.C1}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.C1}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.C1}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.C1"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{C1.hist} are: \describe{ \item{prepare}{\code{signature(object = "C1.hist")}: calls the parent method (\code{prepare} for \code{ADEg.C1}), modifies some graphical parameters used by default and calculates the boundaries and the height of cells.} \item{panel}{\code{signature(object = "C1.hist")}: draws rectangles.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.C1}} \code{\link{s1d.hist}} } \examples{ showClass("C1.hist") } \keyword{classes} adegraphics/man/T.value-class.Rd0000644000176200001440000001061213742303021016202 0ustar liggesusers\name{T.value-class} \docType{class} \alias{T.value} \alias{T.value-class} \alias{prepare,T.value-method} \alias{panel,T.value-method} \title{Class \code{T.value}} \description{ A class for the representation of a matrix, a data frame, or a distance matrix using symbols, varying in size or color. } \section{Objects from the Class}{ \code{T.value} objects can be created by calls of the form \code{new("T.value", ...)}. The regular usage in this package is to use the \code{table.value} function. } \section{Slots}{ \describe{ \item{\code{data}:}{a list containing data or data's name. \itemize{ \item{\code{dftab}: the displayed values which can be \code{table}, \code{dist} or \code{matrix} in the form of a data frame, a name or a matching call} \item{\code{coordsx}: an integer or a vector indicating the columns of \code{dftab} kept} \item{\code{coordsy}: an integer or a vector indicating the rows of \code{dftab} kept} \item{\code{labelsx}: the columns' labels} \item{\code{labelsy}: the rows' labels} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.T} class. The specific slots for \code{T.value} objects are: \itemize{ \item{\code{breaks}: a vector of values to split \code{dftab}. If \code{NULL}, \code{pretty(dftab, nclass)} is used.} \item{\code{nclass}: an integer for the number of desired intervals, ignored if \code{breaks} is not missing.} \item{\code{col}: a \code{NULL} value, a color or a colors vector to color symbols.} \item{\code{method}: the method of representation for \code{dftab} (color shading or proportional size).} \item{\code{symbol}: the type of symbol (square or circle).} \item{\code{center}: a center value for method \code{size}.} \item{\code{centerpar}: a logical or a list to represent center value using elements in the \code{adegpar("ppoints")} list.} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters: \itemize{ \item{\code{breaks.update}: a logical indicating if the legend breaks is updating.} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.T}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.T}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.T}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.T}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.T"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{T.value} are: \describe{ \item{prepare}{\code{signature(object = "T.value")}: calls the parent method (\code{prepare} for \code{ADEg.T}) and modifies some graphical parameters used by default and calculates limits and grid.} \item{panel}{\code{signature(object = "T.value")}: draws symbols.} } } \note{ For the symbol size, if the method is \code{size}, we use perceptual scaling (Tanimura et al. 2006) . } \references{ Tanimura, S. and Kuroiwa, C. and Mizota, T. 2006 Proportional symbol mapping in R \emph{Journal of Statistical Software} \bold{15}, 1--7 } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.T}} \code{\linkS4class{T.cont}} \code{\link{table.value}} } \examples{ showClass("T.value") } \keyword{classes} adegraphics/man/S1.distri-class.Rd0000644000176200001440000000714113742303021016447 0ustar liggesusers\name{S1.distri-class} \docType{class} \alias{S1.distri} \alias{S1.distri-class} \alias{prepare,S1.distri-method} \alias{panel,S1.distri-method} \title{Class \code{S1.distri}} \description{ A class for the representation of a set of distributions on a numeric score. } \section{Objects from the Class}{ \code{S1.distri} objects can be created by calls of the form \code{new("S1.distri", ...)}. The regular usage in this package is to use the \code{s1d.distri} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{score}: the displayed values in the form of a numeric vector, a name or a matching call.} \item{\code{dfdistri}: the mass distribution in which each column is a class.} \item{\code{labels}: the labels' names drawn for each distribution.} \item{\code{at}: the index value.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S1} class. The specific slots for \code{S1.distri} objects are: \itemize{ \item{\code{sdSize}: the size of the standard deviation segments.} \item{\code{yrank}: a logical to draw the distributions sorted by means ascending order.} }} \item{\code{stats}}{a list of internal preliminary calculations. The specific slots for \code{S1.distri} objects are: \itemize{ \item{\code{means}: the weighted mean calculated for each distribution.} \item{\code{sds}: the weighted variance calculated for each distribution.} }} \item{\code{s.misc}}{a list of some others internal parameters} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.S1}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.S1}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.S1}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.S1}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.S1"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{S1.distri} are: \describe{ \item{prepare}{\code{signature(object = "S1.distri")}: calls the parent method (\code{prepare} for \code{ADEg.S1}), modifies some graphical parameters used by default and calculates weighted mean and standard deviation.} \item{panel}{\code{signature(object = "S1.distri")}: draws mean points and segments with matching labels.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.S1}} \code{\link{s1d.distri}} } \examples{ showClass("S1.distri") } \keyword{classes} adegraphics/man/S1.match-class.Rd0000644000176200001440000000613313742303021016245 0ustar liggesusers\name{S1.match-class} \docType{class} \alias{S1.match} \alias{S1.match-class} \alias{prepare,S1.match-method} \alias{panel,S1.match-method} \title{Class \code{S1.match}} \description{ A class for the creation and display of paired scores. } \section{Objects from the Class}{ \code{S1.match} objects can be created by calls of the form \code{new("S1.match", ...)}. The regular usage in this package is to use the \code{s1d.match} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{score}: the displayed values in the form of a numeric vector, a name or a matching call.} \item{\code{labels}: the labels' names drawn for each score.} \item{\code{at}: the index value.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S1} class.} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters. The specific slot for \code{S1.match} objects is: \itemize{ \item{\code{rug}: an index value indicating where the rugs are drawn.} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.S1}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.S1}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.S1}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.S1}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.S1"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{S1.match} are: \describe{ \item{prepare}{\code{signature(object = "S1.match")}: calls the parent method (\code{prepare} for \code{ADEg.S1}) and modifies some graphical parameters used by default.} \item{panel}{\code{signature(object = "S1.match")}: draws score points and matching segments and labels.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.S1}} \code{\link{s1d.match}} } \examples{ showClass("S1.match") } \keyword{classes} adegraphics/man/s1d.density.Rd0000644000176200001440000000573013742303021015733 0ustar liggesusers\name{s1d.density} \alias{s1d.density} \title{1-D plot of a numeric score by density curves} \description{ This function represents a score with a density curve for each level of a factor. } \usage{ s1d.density(score, fac = gl(1, NROW(score)), kernel = c("normal", "box", "epanech", "biweight", "triweight"), bandwidth = NULL, gridsize = 450, col = NULL, fill = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{score}{a numeric vector (or a data frame) used to produce the plot} \item{fac}{a factor (or a matrix of factors) to split \code{score}} \item{kernel}{the smoothing kernel used, see \code{\link[KernSmooth]{bkde}}} \item{bandwidth}{the kernel bandwidth smoothing parameter} \item{gridsize}{the number of equally spaced points at which to estimate the density} \item{col}{a logical, a color or a colors vector for labels, rugs, lines and polygons according to their factor level. Colors are recycled whether there are not one color by factor level.} \item{fill}{a logical to yield the polygons density curves filled} \item{facets}{a factor splitting \code{score} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ \code{kernel}, \code{bandwidth} and \code{gridsize} are passed as parameters to \code{\link[KernSmooth]{bkde}} function of the \code{KernSmooth} package. Graphical parameters for rugs are available in \code{plines} of \code{adegpar} and the ones for density curves filled in \code{ppolygons}. Some appropriated graphical parameters in \code{p1d} are also available. } \value{ An object of class \code{ADEg} (subclass \code{C1.density}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or data frame for \code{score} or data frame for \code{fac} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{C1.density}} \code{\linkS4class{ADEg.C1}} } \examples{ score <- c(rnorm(1000, mean = -0.5, sd = 0.5), rnorm(1000, mean = 1)) fac <- rep(c("A", "B"), each = 1000) s1d.density(score, fac, col = c(2, 4), p1d.reverse = TRUE) } \keyword{aplot} \keyword{hplot} adegraphics/man/addsegment.Rd0000644000176200001440000000535214377601020015706 0ustar liggesusers\name{addsegment} \alias{addsegment} \alias{addsegment-methods} \alias{addsegment,ADEg-method} \alias{addsegment,ADEgS-method} \title{ Adds segments on graphics. } \description{ Adds a \code{trellis} object containing one or several segments on one or several graphical objects. } \usage{ addsegment(object, x0 = NULL, y0 = NULL, x1, y1, plot = TRUE, ...) } \arguments{ \item{object}{an object of class \code{ADEg} or \code{ADEgS} } \item{x0, y0}{coordinates of points FROM which to draw, passed to the \code{panel.segments} function of the \code{lattice} package. See Details. } \item{x1, y1}{coordinates of points TO which to draw, passed to the \code{panel.segments} function of the \code{lattice} package. See Details. } \item{plot}{a logical indicating if the graphics is displayed } \item{\dots}{Other arguments. Additional graphical parameters (see the \code{plines} list in \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}}). If \code{object} is an \code{ADEgS}, the argument \code{which} identify which \code{ADEg} is/are used for superposition. } } \value{ An object of class \code{ADEgS}. } \details{ \code{x0}, \code{y0}, \code{x1} and \code{y1} can be vectors. A line segment is drawn, for each i, between the point (x0[i], y0[i]) and the point (x1[i], y1[i]). The coordinate vectors will be recycled to the length of the longest. } \author{Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEgS}} \code{\link[lattice]{panel.segments}} } \examples{ data(deug, package = "ade4") g11 <- s1d.density(deug$tab[, 1], plot = FALSE) g12 <- addsegment(g11, x0 = deug$cent[1], x1 = deug$cent[1], y0 = 0, y1 = 1, plines = list(col = "grey30", lwd = 3)) g13 <- addsegment(g11, x0 = deug$cent + seq(0, 1, length.out = length(deug$cent)), x1 = deug$cent + seq(0, 1, length.out = length(deug$cent)), y0 = 0, y1 = 1, plines = list(col = 1:length(deug$cent), lty = 1:length(deug$cent))) # example extracted from the pedagogic file, here: http://pbil.univ-lyon1.fr/R/pdf/tdr65.pdf data(monde84, package = "ade4") dfX <- cbind.data.frame(lpib = log(monde84$pib), croipop = monde84$croipop) dfY <- cbind.data.frame(lmorta = log(monde84$morta), lanal = log(monde84$anal + 1), rscol = sqrt(100 - monde84$scol)) dfX0 <- ade4::scalewt(dfX) dfY0 <- ade4::scalewt(dfY) can1 <- cancor(dfX0, dfY0) varcanoX <- dfX0 \%*\% can1$xcoef[,1] varcanoY <- dfY0 \%*\% can1$ycoef[,1] g21 <- s.label(cbind(varcanoY,varcanoX), labels = row.names(monde84), plabel.cex = 0.8, plot = FALSE) g22 <- addsegment(g21, -1.25, -1.25, 1.25, 1.25, plines.col = "purple", plines.lwd = 1.5, plines.lty = 2) } \keyword{aplot} adegraphics/man/s.distri.Rd0000644000176200001440000000547013742303021015326 0ustar liggesusers\name{s.distri} \alias{s.distri} \title{2-D scatter plot with means/standard deviations computed using an external table of weights} \description{ This function represents a two dimensional scatter plot of a frequency distribution. Class are defined by ellipses and/or stars. } \usage{ s.distri(dfxy, dfdistri, xax = 1, yax = 2, starSize = 1, ellipseSize = 1.5, col = NULL, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{dfxy}{a data frame used to produce the plot} \item{dfdistri}{a data frame containing the mass distribution in columns} \item{xax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the x-axis} \item{yax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the y-axis} \item{starSize}{\code{NULL} or number between 0 and 1 for the size of the stars segments joining the stars' center (centroids) and the matching points} \item{ellipseSize}{\code{NULL} or number between 0 and 1 for ellipse size} \item{col}{a color or a colors vector to color points, ellipses, labels, lines and polygons} \item{facets}{a factor splitting the rows of \code{dfxy} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \value{ An object of class \code{ADEg} (subclass \code{S2.distri}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or vectors for \code{xax}/\code{yax} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{S2.distri}} \code{\linkS4class{ADEg.S2}} } \examples{ data(rpjdl, package = "ade4") xy <- ade4::dudi.coa(rpjdl$fau, scan = FALSE)$li j <- c(1, 5, 8, 20, 21, 23, 26, 33, 36, 44, 47, 49) dfdistri <- rpjdl$fau[, j] coli <- colorRampPalette(c("blue", "red", "orange"))(49)[j] s.distri(xy, dfdistri, ellipseSize = 1, starSize = 0, porigin.include = FALSE, pellipses = list(col = coli, alpha = 0.3), plabels.cex = 0) } \keyword{aplot} \keyword{hplot} adegraphics/man/s1d.curve.Rd0000644000176200001440000000411713742303021015376 0ustar liggesusers\name{s1d.curve} \alias{s1d.curve} \title{1-D plot of a numeric score linked by curves} \description{ This function represents a score using points linked by curves. } \usage{ s1d.curve(score, at = 1:NROW(score), facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{score}{a numeric vector (or a data frame) used to produce the plot} \item{at}{a numeric vector used as an index} \item{facets}{a factor splitting \code{score} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ Graphical parameters for lines and points are available in \code{plines} and in \code{ppoints} of \code{adegpar}. Some appropriated graphical parameters in \code{p1d} are also available. } \value{ An object of class \code{ADEg} (subclass \code{C1.curve}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or data frame for \code{score} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{C1.curve}} \code{\linkS4class{ADEg.C1}} } \examples{ data(rpjdl, package = "ade4") rpjdl.coa <- ade4::dudi.coa(rpjdl$fau, scannf = FALSE, nf = 4) s1d.curve(rpjdl.coa$eig) set.seed(40) score1 <- rnorm(10) s1d.curve(score1) } \keyword{aplot} \keyword{hplot} adegraphics/man/triangle.class.Rd0000644000176200001440000000633613742303021016502 0ustar liggesusers\name{triangle.class} \alias{triangle.class} \title{Ternary plot with a partition in classes (levels of a factor)} \description{ This function represents a three dimensional scatter plot with a partition in classes (levels of a factor). } \usage{ triangle.class(dfxyz, fac, wt = rep(1, NROW(fac)), labels = levels(fac), col = NULL, ellipseSize = 1, starSize = 1, chullSize = NULL, adjust = TRUE, min3d = NULL, max3d = NULL, showposition = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{dfxyz}{a three columns data frame used to produce the plot} \item{fac}{a factor (or a matrix of factors) splitting the rows of \code{dfxyz}} \item{wt}{a vector of weights for \code{fac}} \item{labels}{a character vector containing the class' labels} \item{col}{a logical, a color or a colors vector to color points, ellipses, labels, lines and polygons} \item{ellipseSize}{a positive number for ellipse size} \item{starSize}{a number between 0 and 1 for the size of the stars segments joining the stars' center (centroids) and the matching points} \item{chullSize}{\code{NULL} or a vector of numbers between 0 and 1 for the fraction of points included in the convex hull} \item{adjust}{a logical to adjust the device with the limits of the smaller equilateral triangle containing the values} \item{min3d}{a vector of three values for triangular minimal limits} \item{max3d}{a vector of three values for triangular maximal limits} \item{showposition}{a logical indicating whether the used triangle should be shown in the complete one} \item{facets}{a factor splitting the rows of \code{dfxyz} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \value{ An object of class \code{ADEg} (subclass \code{Tr.class}) or \code{ADEgS} (if \code{showposition} is TRUE, if \code{add} is \code{TRUE} and/or if facets are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{Tr.class}} \code{\linkS4class{ADEg.Tr}} } \examples{ data(euro123, package = "ade4") fac1 <- euro123$plan$an df1 <- rbind.data.frame(euro123$in78, euro123$in86, euro123$in97) triangle.class(df1, fac = fac1, showposition = TRUE, col = c(1, 2, 3)) triangle.class(df1, fac = fac1, showposition = FALSE, plabels.cex = 0, col = c(1, 2, 3), key = list(space = "left")) } \keyword{hplot} \keyword{aplot} adegraphics/man/Tr.label-class.Rd0000644000176200001440000000731313742303021016333 0ustar liggesusers\name{Tr.label-class} \docType{class} \alias{Tr.label} \alias{Tr.label-class} \alias{prepare,Tr.label-method} \alias{panel,Tr.label-method} \title{Class \code{Tr.label}} \description{ A class for creating and drawing triangular plot with point label. } \section{Objects from the Class}{ \code{Tr.label} objects can be created by calls of the form \code{new("Tr.label", ...)}. The regular usage in this package is to use the \code{triangle.label} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{dfxyz}: the displayed values in the form of a three columns data frame, a name or a matching call.} \item{\code{labels}: a character vector containing labels for points.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.Tr} class. The specific slots for \code{Tr.class} objects are: \itemize{ \item{\code{addmean}: a logical to plot the mean.} \item{\code{addaxes}: a logical to draw the principal axes.} \item{\code{meanpar}: a list to represent mean points using \code{pch}, \code{cex} and \code{col}.} \item{\code{axespar}: a list to represent axes lines using \code{col}, \code{lwd} and \code{lty}.} \item{\code{max3d} and \code{min3d}: vectors of three values for triangular maximal and minimal limits.} \item{\code{adjust}: a logical to adjust the device with the limits of the smaller equilateral triangle containing the values.} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters: \itemize{ \item{\code{cornerp}: coordinates of the triangle extremities.} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.Tr}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.Tr}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.Tr}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.Tr}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.Tr"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{Tr.label} are: \describe{ \item{prepare}{\code{signature(object = "Tr.label")}: calls the parent method (\code{prepare} for \code{ADEg.Tr}), modifies some graphical parameters used by default and defines the mean point and the axes.} \item{panel}{\code{signature(object = "Tr.label")}: draws lines, labels and points.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.Tr}} \code{\link{triangle.label}} } \examples{ showClass("Tr.label") } \keyword{classes} adegraphics/man/plotEig.Rd0000644000176200001440000000500113742303021015160 0ustar liggesusers\name{plotEig} \alias{plotEig} \title{ Plot a barchart of eigen values } \description{ This function represents a simplified barchart adapted to display eigen values. The bar color depends on whether the axis is displayed, kept or not. } \usage{ plotEig(eigvalue, nf, xax = 1, yax = 2, col.plot = "black", col.kept = "grey", col = "white", facets = NULL, plot = TRUE, storeData = FALSE, pos = -1, ...) } \arguments{ \item{eigvalue}{a numeric vector of eigenvalues} \item{nf}{the number of retained factors, NULL if not provided} \item{xax}{an integer indicating which factor is plotted on the x-axis} \item{yax}{an integer indicating which factor is plotted on the y-axis} \item{col.plot}{a color value to fill the bar corresponding to the displayed factors} \item{col.kept}{a color value to fill the bar corresponding to the kept by not displayed factors} \item{col}{a color value to fill the bar corresponding to the other factors} \item{facets}{a factor splitting the rows of \code{dfxy} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \value{ An object of class \code{ADEg} (subclass \code{C1.barchart}).\cr The result is displayed if \code{plot} is \code{TRUE}. } \details{ Graphical parameters for bars are available in \code{ppolygons} of \code{adegpar}. Some appropriated graphical parameters in \code{p1d} are also available. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{C1.barchart}} \code{\linkS4class{ADEg.C1}} } \examples{ data(microsatt, package = "ade4") w <- ade4::dudi.coa(data.frame(t(microsatt$tab)), scann = FALSE, nf = 3) g1 <- s.label(w$co, plot = FALSE) g2 <- plotEig(w$eig, w$nf, psub = list(text = "Eigenvalues"), pbackground = list(box = TRUE), plot = FALSE) G <- insert(g2, g1, posi = "bottomright", ratio = 0.25) } \keyword{aplot} adegraphics/man/ADEg.C1-class.Rd0000644000176200001440000001011613742303021015665 0ustar liggesusers\name{ADEg.C1-class} \docType{class} \alias{ADEg.C1} \alias{ADEg.C1-class} \alias{panelbase,ADEg.C1-method} \alias{gettrellis,ADEg.C1-method} \alias{prepare,ADEg.C1-method} \alias{setlatticecall,ADEg.C1-method} \title{Class \code{ADEg.C1} } \description{ An object of \code{ADEg.C1} class represents unidimensional data into two dimensions. The \code{ADEg.C1} class is a virtual class, i.e. a class which is not possible to create objects but which have heirs. This class inherits from \code{ADEg} class and has three son classes : \code{C1.barchart}, \code{C1.curve}, \code{C1.density}, \code{C1.dotplot}, \code{C1.gauss}, \code{C1.hist}, \code{C1.interval} } \section{Objects from the Class}{ None object of this class can be instantiated. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{score}: the displayed values in the form of a numeric vector, a name or a matching call.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list of two elements to create the \code{trellis} object: \itemize{ \item{\code{graphictype}: \code{xyplot}} \item{\code{arguments}: its parameters to obtain the \code{trellis} object} }} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.C1} class} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters: \itemize{ \item{\code{hori.update}: a logical indicating if the sense of direction of the graphics is updating} \item{\code{backgrid}: a list of two elements for grid lines. \code{backgrid$x} defines the coordinates of the lines (horizontal or vertical depending on the graphics orientation) and \code{backgrid$d} the grid mesh} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg}}, directly. } \section{Methods}{ \describe{ \item{prepare}{\code{signature(object = "ADEg.C1")}: performs the calculations before display the object (e.g. limits, grid and axis calculations)} \item{setlatticecall}{\code{signature(object = "ADEg.C1")}: prepares the \code{lattice.call} slot} \item{panelbase}{\code{signature(object = "ADEg.C1")}: defines the graphical background (e.g. grid, rugs and box)} \item{gettrellis}{\code{signature(object = "ADEg.C1")}: converts the graphic into a \code{trellis} object of \code{lattice} class} } } \note{ The \code{ADEg.S1} class and \code{ADEg.C1} class are both used to represent an unidimensional information (e.g. a score). The difference between these two classes is mainly ideological : an \code{ADEg.S1} object is a representation into one dimension (e.g. one line) while an \code{ADEg.C1} object is a representation into two dimensions (e.g. curves). } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\link{adegpar}} \code{\linkS4class{C1.barchart}} \code{\linkS4class{C1.curve}} \code{\linkS4class{C1.density}} \code{\linkS4class{C1.dotplot}} \code{\linkS4class{C1.gauss}} \code{\linkS4class{C1.hist}} \code{\linkS4class{C1.interval}} \code{\linkS4class{ADEg}} } \examples{ showClass("ADEg.C1") } \keyword{classes} adegraphics/man/s.arrow.Rd0000644000176200001440000000544113742303021015160 0ustar liggesusers\name{s.arrow} \alias{s.arrow} \title{2-D scatter plot with arrows} \description{ This function represents a two dimensional scatter plot with arrows linking points to the origin. } \usage{ s.arrow(dfxy, xax = 1, yax = 2, labels = row.names(as.data.frame(dfxy)), facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{dfxy}{a data frame used to produce the plot} \item{xax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the x-axis} \item{yax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the y-axis} \item{labels}{a character vector containing labels for arrows} \item{facets}{a factor splitting the rows of \code{dfxy} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ An other origin for arrows can be specified using an \code{adegpar} parameters: \code{porigin}. Graphical parameters for points and arrows are available in \code{parrows} and \code{ppoints} of \code{adegpar}. } \value{ An object of class \code{ADEg} (subclass \code{S2.arrow}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or vectors for \code{xax}/\code{yax} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{S2.arrow}} \code{\linkS4class{ADEg.S2}} } \examples{ data(doubs, package = "ade4") dudi1 <- ade4::dudi.pca(doubs$env, scale = TRUE, scannf = FALSE, nf = 3) dudi2 <- ade4::dudi.pca(doubs$fish, scale = TRUE, scannf = FALSE, nf = 2) coin1 <- ade4::coinertia(dudi1, dudi2, scannf = FALSE, nf = 2) g11 <- s.arrow(coin1$l1, plabels.cex = 0.87, plot = FALSE) g12 <- s.arrow(coin1$c1, plabels.cex = 1, plabels.col = "red", plot = FALSE) g1 <- superpose(g12, g11, plot = TRUE) xy <- cbind(rnorm(50), rnorm(50)) g2 <- s.arrow(xy, plabels.cex = 0.9, plines = list(lwd = 1.5), parrows.angle = 20) update(g2, plines = list(col = rainbow(5))) } \keyword{aplot} \keyword{hplot} adegraphics/man/T.image-class.Rd0000644000176200001440000000730213742303021016152 0ustar liggesusers\name{T.image-class} \docType{class} \alias{T.image} \alias{T.image-class} \alias{prepare,T.image-method} \alias{panel,T.image-method} \title{Class \code{T.image}} \description{ A class for the representation of a matrix or table object in which values have different colors. } \section{Objects from the Class}{ \code{T.image} objects can be created by calls of the form \code{new("T.image", ...)}. The regular usage in this package is to use the \code{table.image} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{dftab}: the displayed values which can be \code{table}, \code{dist} or \code{matrix} in the form of a data frame, a name or a matching call} \item{\code{coordsx}: an integer or a vector indicating the columns of \code{dftab} kept} \item{\code{coordsy}: an integer or a vector indicating the rows of \code{dftab} kept} \item{\code{labelsx}: columns labels} \item{\code{labelsy}: rows labels} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.T} class. The specific slots for \code{T.image} objects are: \itemize{ \item{\code{breaks}: a vector of values to split \code{dftab}. If \code{NULL}, \code{pretty(dftab, nclass)} is used.} \item{\code{nclass}: an integer for the number of desired intervals, ignored if \code{breaks} is not missing.} \item{\code{col}: a \code{NULL} value, a color or a colors vector used for the cells.} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters: \itemize{ \item{\code{breaks.update}: a logical indicating if the legend breaks is updating.} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.T}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.T}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.T}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.T}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.T"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{T.image} are: \describe{ \item{prepare}{\code{signature(object = "T.image")}: calls the parent method (\code{prepare} for \code{ADEg.T}) and modifies some graphical parameters used by default and calculates limits and grid.} \item{panel}{\code{signature(object = "T.image")}: draws raster image.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.T}} \code{\link{table.image}} } \examples{ showClass("T.image") } \keyword{classes} adegraphics/man/setlimits1D.Rd0000644000176200001440000000364213742303021015770 0ustar liggesusers\name{setlimits1D} \alias{setlimits1D} \alias{setlimits2D} \title{ Computes limits for 1D and 2D displays. } \description{ Computes limits for 1D and 2D displays adding 10\% of margins around the extreme values. } \usage{ setlimits1D(mini, maxi, origin, includeOr) setlimits2D(minX, maxX, minY, maxY, origin = c(0, 0), aspect.ratio = "iso", includeOr) } \arguments{ \item{mini}{the smallest value of a unidimensional dataset} \item{maxi}{the largest value of a unidimensional dataset} \item{minX}{the smallest value of the first dimension of a bidimensional dataset} \item{maxX}{the largest value of the first dimension of a bidimensional dataset} \item{minY}{the smallest value of the second dimension of a bidimensional dataset} \item{maxY}{the largest value of the second dimension of a bidimensional dataset} \item{origin}{a value (in \code{setlimits1D}) or a two-length vector (in \code{setlimits2D}) indicating origin coordinate(s)} \item{aspect.ratio}{a character string to control physical aspect ratio of the graphic. \code{iso} for isometric scales, \code{fill} for drawing as big as possible or \code{xy} for banking rule} \item{includeOr}{a boolean value indicating whether the origin is included in the graphics window} } \value{ \code{setlimits1D} returns a two-length vector containing the limits of the graphics window on one axis. \cr \code{setlimits2D} returns a two-length list where the first element, named \code{xlim}, contains a two-length vector containing the limits of the graphics window on the first axis and the second, named \code{ylim}, contains the limits on the second axis. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \examples{ setlimits1D(mini = -2, maxi = 2, origin = 0, includeOr = TRUE) setlimits2D(minX = -2, maxX = 2, minY = -3, maxY = 4, origin = c(0, 0), includeOr = TRUE) } \keyword{aplot} adegraphics/man/S2.label-class.Rd0000644000176200001440000000615513742303021016235 0ustar liggesusers\name{S2.label-class} \docType{class} \alias{S2.label} \alias{S2.label-class} \alias{prepare,S2.label-method} \alias{panel,S2.label-method} \title{Class \code{S2.label}} \description{ A class for creating and drawing bi-dimensional plot with point label. } \section{Objects from the Class}{ \code{S2.label} objects can be created by calls of the form \code{new("S2.label", ...)}. The regular usage in this package is to use the \code{s.label} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{dfxy}: the displayed values in the form of a data frame, a name or a matching call.} \item{\code{labels}: a vector of character strings for the points' labels} \item{\code{xax}: an integer or a vector indicating the columns of \code{dfxy} kept for the x-axes.} \item{\code{yax}: an integer or a vector indicating the columns of \code{dfxy} kept for the y-axes.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S2} class.} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.S2}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.S2}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.S2}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.S2}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.S2"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{S2.label} are: \describe{ \item{prepare}{\code{signature(object = "S2.label")}: calls the parent method (\code{prepare} for \code{ADEg.S2}) and modifies some graphical parameters used by default.} \item{panel}{\code{signature(object = "S2.label")}: draws points and labels.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.S2}} \code{\link{s.label}} } \examples{ showClass("S2.label") } \keyword{classes} adegraphics/man/C1.curve-class.Rd0000644000176200001440000000663313742303021016262 0ustar liggesusers\name{C1.curve-class} \docType{class} \alias{C1.curve} \alias{C1.curve-class} \alias{prepare,C1.curve-method} \alias{panel,C1.curve-method} \alias{C1.curves} \alias{C1.curves-class} \alias{panel,C1.curves-method} \title{Class \code{C1.curve}} \description{ A class for the creation and display of a numeric score linked by curves. The \code{C1.curves} allows to deal with multiple scores. } \section{Objects from the Class}{ \code{C1.curve} objects can be created by calls of the form \code{new("C1.curve", ...)}. The regular usage in this package is to use the \code{s1d.curve} function. \code{C1.curves} objects can be created by calls of the form \code{new("C1.curves", ...)}. The regular usage in this package is to use the \code{s1d.curves} function. Class \code{\linkS4class{C1.curves}} extends \code{C1.curve} directly.\cr } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{score}: the displayed values in the form of a vector, a factor, a name or a matching call.} \item{\code{at}: the index value.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.C1} class.} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.C1}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.C1}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.C1}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.C1}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.C1"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{C1.curve} and \code{C1.curves} are: \describe{ \item{prepare}{\code{signature(object = "C1.curve")}: calls the parent method (\code{prepare} for \code{ADEg.C1}) and modifies some graphical parameters used by default.} \item{panel}{\code{signature(object = "C1.curve")}: draws points and curves.} \item{panel}{\code{signature(object = "C1.curves")}: draws points and curves.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.C1}} \code{\link{s1d.curve}} \code{\link{s1d.curves}} } \examples{ showClass("C1.curve") showClass("C1.curves") } \keyword{classes} adegraphics/man/S2.logo-class.Rd0000644000176200001440000000635513742303021016120 0ustar liggesusers\name{S2.logo-class} \docType{class} \alias{S2.logo} \alias{S2.logo-class} \alias{prepare,S2.logo-method} \alias{panel,S2.logo-method} \title{Class \code{S2.logo}} \description{ A class for the creation of a bi-dimensional plot with pictures for points representation. } \section{Objects from the Class}{ \code{S2.logo} objects can be created by calls of the form \code{new("S2.logo", ...)}. The regular usage in this package is to use the \code{s.logo} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{dfxy}: the displayed values in the form of a data frame, a name or a matching call.} \item{\code{logos}: a list containing the picture to use for each point.} \item{\code{xax}: an integer or a vector indicating the columns of \code{dfxy} kept for the x-axes.} \item{\code{yax}: an integer or a vector indicating the columns of \code{dfxy} kept for the y-axes.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S2} class. The specific slot for \code{S2.logo} objects is: \itemize{ \item{\code{rect}: a logical to frame \code{logos}.} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.S2}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.S2}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.S2}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.S2}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.S2"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{S2.class} are: \describe{ \item{prepare}{\code{signature(object = "S2.class")}: calls the parent method (\code{prepare} for \code{ADEg.S2}) and modifies some graphical parameters used by default.} \item{panel}{\code{signature(object = "S2.class")}: displays the logos.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.S2}} \code{\link{s.logo}} } \examples{ showClass("S2.logo") } \keyword{classes} adegraphics/man/adegraphics-package.Rd0000644000176200001440000000510714470610462017440 0ustar liggesusers\name{adegraphics-package} \alias{adegraphics-package} \alias{adegraphics} \docType{package} \title{Graphical objects for ade4 functions (and more)} \description{ This package was created to replace graphics functionalities of the \code{ade4} package and to offer customizable representations of data and result analysis. Graphics are objects of S4 class, which can be displayed but also stored for latter modifications. Those modifications can be graphical changes, but also superposition or juxtaposition of various graphical objects (creating an other type of object). Each object will contain graphical parameters and instructions for the display (calls, positions, etc.) and the data set used. Sometimes data is heavy, due to its size for example. Two storing systems exist: \itemize{ \item{full storage: data is assigned to an object's slot.} \item{names and position: data names (as a string, obtained using \code{deparse(substitute)}) and their frame position (using \code{sys.nframe()}) are stored. Then the full data can be retrieve with those two informations (and only if the data objects are still in the environment)} } This new system is based on the \code{lattice} package and \code{grid} graphics. } \details{ A lot of classes were implemented. Two superclass structures the architecture in class. Simple and complex graphics are distinguished in the former version: \itemize{ \item{\code{ADEg} class provides simple graphics using one kind of data (most of a time, only a data frame) and one representation method (points, labels, arrows...)} \item{\code{ADEgS} class provides complex graphics making juxtaposition, superposition and/or insertion of several simple graphics.} } 5 subclasses inherits from the superclass abstract \code{ADEg}: \itemize{ \item{\code{ADEg.S1}: one-dimensional plot} \item{\code{ADEg.S2}: bi-dimensional plot} \item{\code{ADEg.C1}: one-dimensional data plotted in 2-D} \item{\code{ADEg.T}: table plot} \item{\code{ADEg.Tr}: triangle plot} } } \references{ Aurélie Siberchicot, Alice Julien-Laferrière, Anne-Béatrice Dufour, Jean Thioulouse and Stéphane Dray (2017). adegraphics: An S4 Lattice-Based Package for the Representation of Multivariate Data. The R Journal. 9:2. 198--212. https://journal.r-project.org/archive/2017/RJ-2017-042/index.html } \keyword{package} \seealso{ \code{\link[lattice:lattice-package]{lattice}} \code{\linkS4class{ADEg}} \code{\linkS4class{ADEgS}} } \examples{ showClass("ADEg") showClass("ADEgS") } adegraphics/man/s.density.Rd0000644000176200001440000000632613742303021015510 0ustar liggesusers\name{s.density} \alias{s.density} \title{2-D scatter plot with kernel density estimation} \description{ This function represents a two dimensional scatter plot of points distribution. Densities' representation is based on the \code{levelplot} graphic in \code{lattice} (density's surface, filled with colors and/or contour lines). } \usage{ s.density(dfxy, xax = 1, yax = 2, bandwidth = NULL, gridsize = c(450L, 450L), nrpoints = 300, threshold = 0.1, col = NULL, contour = FALSE, region = !contour, nclass = 8, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{dfxy}{a data frame used to produce the plot} \item{xax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the x-axis} \item{yax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the y-axis} \item{bandwidth}{bandwidth for density calculations which is passed in parameters in the \code{bkde2D} function of the \code{KernSmooth} package} \item{gridsize}{grid dimension} \item{nrpoints}{number of points on the density image} \item{threshold}{a value between 0 and 1 to draw densities greater than this threshold. No density is visible whether it is equal to 1} \item{col}{a color or a colors vector to color densities} \item{contour}{a logical to draw contour lines} \item{region}{a logical to fill grid regions with \code{col}} \item{nclass}{number of class for density} \item{facets}{a factor splitting the rows of \code{dfxy} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ Density calculation is made using the \code{kde2d} function of the \code{KernSmooth} package. } \value{ An object of class \code{ADEg} (subclass \code{S2.density}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or vectors for \code{xax}/\code{yax} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{S2.density}} \code{\linkS4class{ADEg.S2}} } \examples{ xx2 <- c(rnorm(50000, 1, 1), rnorm(50000, -1, 1)) yy2 <- c(rnorm(50000, -1, 0.5), rnorm(50000, 1, 0.5)) s.density(cbind(xx2, yy2), paxes.draw = TRUE, gridsize = c(200, 200), region = TRUE, contour = TRUE, plabels.cex = 0, threshold = 0.05, nclass = 3, col = colorRampPalette(c("lightgrey", "black"))(100)) } \keyword{hplot} \keyword{aplot} adegraphics/man/Tr.match-class.Rd0000644000176200001440000000640613742303021016352 0ustar liggesusers\name{Tr.match-class} \docType{class} \alias{Tr.match} \alias{Tr.match-class} \alias{prepare,Tr.match-method} \alias{panel,Tr.match-method} \title{Class \code{Tr.match}} \description{ A class for the creation and display of paired coordinates in a triangular plot. } \section{Objects from the Class}{ \code{Tr.match} objects can be created by calls of the form \code{new("Tr.match", ...)}. The regular usage in this package is to use the \code{triangle.match} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{dfxyz}: the displayed values in the form of a three columns data frame, a name or a matching call.} \item{\code{labels}: a vector of character strings containing the matches' labels.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.Tr} class. The specific slots for \code{Tr.match} objects are: \itemize{ \item{\code{max3d} and \code{min3d}: vectors of three values for triangular maximal and minimal limits.} \item{\code{adjust}: a logical to adjust the device with the limits of the smaller equilateral triangle containing the values} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.Tr}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.Tr}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.Tr}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.Tr}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.Tr"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{Tr.match} are: \describe{ \item{prepare}{\code{signature(object = "Tr.match")}: calls the parent method (\code{prepare} for \code{ADEg.Tr}) and modifies some graphical parameters used by default.} \item{panel}{\code{signature(object = "Tr.match")}: draws arrows, labels and points.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.Tr}} \code{\link{triangle.match}} } \examples{ showClass("Tr.match") } \keyword{classes} adegraphics/man/s1d.class.Rd0000644000176200001440000000633513742303021015363 0ustar liggesusers\name{s1d.class} \alias{s1d.class} \title{1-D plot of a numeric score partitioned in classes (levels of a factor)} \description{ This function represents the link between scores values and their matching labeled classes. } \usage{ s1d.class(score, fac, wt = rep(1, NROW(fac)), labels = levels(fac), at = 0.5, poslabel = c("regular", "value"), col = NULL, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{score}{a numeric vector (or a data frame) used to produce the plot} \item{fac}{a factor (or a matrix of factors) to split \code{score}} \item{wt}{a vector of weights for \code{score}} \item{labels}{the labels' names drawn for each class} \item{at}{a numeric vector used as an index} \item{poslabel}{the label position of each class (each level of \code{fac}), it can be \code{regular} or \code{value}. If \code{regular}, labels are evenly spaced. If \code{value}, labels are placed on the weighted mean of their class.} \item{col}{a color or a colors vector for points, labels and lines according to their factor level. Colors are recycled whether there are not one color by factor level.} \item{facets}{a factor splitting \code{score} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ The weighted means of class are available in the object slot \code{stats} using \code{object@stats$means}. Graphical parameters for rugs are available in \code{plines} of \code{adegpar}. Some appropriated graphical parameters in \code{p1d} are also available. } \value{ An object of class \code{ADEg} (subclass \code{S1.class}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or data frame for \code{score} or data frame for \code{fac} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{S1.class}} \code{\linkS4class{ADEg.S1}} } \examples{ data(meau, package = "ade4") envpca <- ade4::dudi.pca(meau$env, scannf = FALSE) g1 <- s1d.class(envpca$li[, 1], meau$design$season, poslabel = "value", col = 1:4, plot = FALSE) g2 <- s1d.class(envpca$li[, 1], meau$design$season, poslabel = "regular", col = 1:6, p1d.reverse = TRUE, plot = FALSE) ADEgS(c(g1, g2), layout = c(2, 1)) g3 <- s1d.class(envpca$li[, 1], meau$design$season, poslabel = "value", col = 1:4, plabels.cex = 0, key = list(space = "bottom")) } \keyword{aplot} \keyword{hplot} adegraphics/man/S2.value-class.Rd0000644000176200001440000001102713742303021016264 0ustar liggesusers\name{S2.value-class} \docType{class} \alias{S2.value} \alias{S2.value-class} \alias{prepare,S2.value-method} \alias{panel,S2.value-method} \title{Class \code{S2.value}} \description{ A class for the creation and display of bi-dimensional plot with a third value represented (as a variable) by symbols. } \section{Objects from the Class}{ \code{S2.value} objects can be created by calls of the form \code{new("S2.value", ...)}. The regular usage in this package is to use the \code{s.value} function. } \section{Slots}{ \describe{ \item{\code{data}:}{a list containing data or data's name. \itemize{ \item{\code{dfxy}: the displayed values in the form of a data frame, a name or a matching call.} \item{\code{z}: a vector (or a matrix) with as many values as rows in \code{dfxy}.} \item{\code{xax}: an integer or a vector indicating the columns of \code{dfxy} kept for the x-axes.} \item{\code{yax}: an integer or a vector indicating the columns of \code{dfxy} kept for the y-axes.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S2} class. The specific slots for \code{S2.value} objects are: \itemize{ \item{\code{method}: the method of representation for \code{z} (color shading or proportional size).} \item{\code{symbol}: the type of symbol (square or circle).} \item{\code{center}: a center value for method \code{size}.} \item{\code{centerpar}: a logical or a list to represent center value using elements in the \code{adegpar("ppoints")} list.} \item{\code{breaks}: a vector containing the breaks used for splitting \code{z} value. If \code{NULL}, \code{pretty(z, n)} is used.} \item{\code{nclass}: an integer for the number of desired intervals, ignored if \code{breaks} is not missing.} \item{\code{col}: a \code{NULL} value, a color or a colors vector to color symbols.} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters: \itemize{ \item{\code{plegend.update}: a logical indicating if the legend parameters are updating} \item{\code{breaks.update}: a logical indicating if the legend breaks are updating} \item{\code{lim.update}: a logical indicating if the limits are updating} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.S2}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.S2}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.S2}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.S2}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.S2"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{S2.value} are: \describe{ \item{prepare}{\code{signature(object = "S2.value")}: calls the parent method (\code{prepare} for \code{ADEg.S2}), modifies some graphical parameters used by default and calculates limits.} \item{panel}{\code{signature(object = "S2.value")}: draws symbols.} } } \note{ For the symbol size, if the method is \code{size}, we use perceptual scaling (Tanimura et al. 2006). } \references{ Tanimura, S. and Kuroiwa, C. and Mizota, T. 2006. Proportional symbol mapping in R. \emph{Journal of Statistical Software}. \bold{15}, 1--7 } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.S2}} \code{\link{s.value}} } \examples{ showClass("S2.value") } \keyword{classes} adegraphics/man/prepare-methods.Rd0000644000176200001440000001534113742303021016664 0ustar liggesusers\name{prepare-methods} \docType{methods} \alias{prepare-methods} \alias{prepare} \title{Methods \code{prepare} for \code{ADEg} objects} \description{ The method \code{prepare} performs the first calculus needed for the display. } \section{Methods}{ \describe{ \item{\code{signature(object = "ADEg.C1")}}{ performs the calculations before display the object (e.g. limits, grid and axis calculations)} \item{\code{signature(object = "C1.barchart")}}{ calls the parent method (\code{prepare} for \code{ADEg.C1}) and modifies some graphical parameters used by default} \item{\code{signature(object = "C1.curve")}}{ calls the parent method (\code{prepare} for \code{ADEg.C1}) and modifies some graphical parameters used by default} \item{\code{signature(object = "C1.density")}}{ calls the parent method (\code{prepare} for \code{ADEg.C1}), modifies some graphical parameters used by default and calculates the density curves according to the numeric score and the values' categories} \item{\code{signature(object = "C1.dotplot")}}{ calls the parent method (\code{prepare} for \code{ADEg.C1}) and modifies some graphical parameters used by default} \item{\code{signature(object = "C1.gauss")}}{ calls the parent method (\code{prepare} for \code{ADEg.C1}), modifies some graphical parameters used by default and calculates the Gauss curves according to the numeric score and the values' categories (using weighted mean and standard deviation)} \item{\code{signature(object = "C1.hist")}}{ calls the parent method (\code{prepare} for \code{ADEg.C1}), modifies some graphical parameters used by default and calculates the boundaries and the height of cells} \item{\code{signature(object = "C1.interval")}}{ calls the parent method (\code{prepare} for \code{ADEg.C1}) and modifies some graphical parameters used by default} \item{\code{signature(object = "ADEg.S1")}}{ performs the calculations before display the object (e.g. limits, grid and axis calculations)} \item{\code{signature(object = "S1.boxplot")}}{ calls the parent method (\code{prepare} for \code{ADEg.S1}) and modifies some graphical parameters used by default} \item{\code{signature(object = "S1.class")}}{ calls the parent method (\code{prepare} for \code{ADEg.S1}) and modifies some graphical parameters used by default} \item{\code{signature(object = "S1.distri")}}{ calls the parent method (\code{prepare} for \code{ADEg.S1}), modifies some graphical parameters used by default and calculates weighted mean and standard deviation} \item{\code{signature(object = "S1.label")}}{ calls the parent method (\code{prepare} for \code{ADEg.S1}) and modifies some graphical parameters used by default} \item{\code{signature(object = "S1.match")}}{ calls the parent method (\code{prepare} for \code{ADEg.S1}) and modifies some graphical parameters used by default} \item{\code{signature(object = "ADEg.S2")}}{ performs the calculations before display the object (e.g. limits, grid and axis calculations)} \item{\code{signature(object = "S2.arrow")}}{ calls the parent method (\code{prepare} for \code{ADEg.S2}), modifies some graphical parameters used by default and calculates limits} \item{\code{signature(object = "S2.class")}}{ calls the parent method (\code{prepare} for \code{ADEg.S2}), modifies some graphical parameters used by default and calculates ellipses, convex hulls and centroids} \item{\code{signature(object = "S2.corcircle")}}{ calls the parent method (\code{prepare} for \code{ADEg.S2}), modifies some graphical parameters used by default and prepares the drawn grid} \item{\code{signature(object = "S2.density")}}{ calls the parent method (\code{prepare} for \code{ADEg.S2}), modifies some graphical parameters used by default and calculates densities} \item{\code{signature(object = "S2.distri")}}{ calls the parent method (\code{prepare} for \code{ADEg.S2}), modifies some graphical parameters used by default and calculates ellipses and centroids} \item{\code{signature(object = "S2.image")}}{ calls the parent method (\code{prepare} for \code{ADEg.S2}), modifies some graphical parameters used by default and calculates grid expansion and limits} \item{\code{signature(object = "S2.label")}}{ calls the parent method (\code{prepare} for \code{ADEg.S2}) and modifies some graphical parameters used by default} \item{\code{signature(object = "S2.logo")}}{ calls the parent method (\code{prepare} for \code{ADEg.S2}) and modifies some graphical parameters used by default} \item{\code{signature(object = "S2.match")}}{ calls the parent method (\code{prepare} for \code{ADEg.S2}) and modifies some graphical parameters used by default} \item{\code{signature(object = "S2.traject")}}{ calls the parent method (\code{prepare} for \code{ADEg.S2}) and modifies some graphical parameters used by default} \item{\code{signature(object = "S2.value")}}{ calls the parent method (\code{prepare} for \code{ADEg.S2}), modifies some graphical parameters used by default and calculates limits} \item{\code{signature(object = "ADEg.T")}}{ performs the calculations before display the object (e.g. limits, grid and axis calculations)} \item{\code{signature(object = "T.image")}}{ calls the parent method (\code{prepare} for \code{ADEg.T}) and modifies some graphical parameters used by default and calculates limits and grid} \item{\code{signature(object = "T.value")}}{ calls the parent method (\code{prepare} for \code{ADEg.T}) and modifies some graphical parameters used by default and calculates limits and grid} \item{\code{signature(object = "ADEg.Tr")}}{ performs the calculations before display the object (e.g. limits, grid and axis calculations)} \item{\code{signature(object = "Tr.class")}}{ calls the parent method (\code{prepare} for \code{ADEg.Tr}), modifies some graphical parameters used by default and calculated ellipses, convex hulls and centroids} \item{\code{signature(object = "Tr.label")}}{ calls the parent method (\code{prepare} for \code{ADEg.Tr}) and modifies some graphical parameters used by default} \item{\code{signature(object = "Tr.match")}}{ calls the parent method (\code{prepare} for \code{ADEg.Tr}), modifies some graphical parameters used by default and defines the mean point and the axis} \item{\code{signature(object = "Tr.traject")}}{ calls the parent method (\code{prepare} for \code{ADEg.Tr}) and modifies some graphical parameters used by default} }} \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \keyword{methods} adegraphics/man/s.Spatial.Rd0000644000176200001440000000405113742303021015417 0ustar liggesusers\name{s.Spatial} \alias{s.Spatial} \title{Mapping of a Spatial* object} \description{This function represents a background map linked with data or not. } \usage{ s.Spatial(spObj, col = TRUE, nclass = 5, scale = TRUE, plot = TRUE, storeData = TRUE, pos = -1, ...) } \arguments{ \item{spObj}{an object deriving from class \code{Spatial} (package \code{sp})} \item{col}{a logical or a color to fill the background color of \code{spObj}} \item{nclass}{if \code{spObj} contains data, the desired number of intervals splitting the data (using \code{pretty})} \item{scale}{a \code{logical} indicating if numeric variables should be scaled} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \value{ An object of class \code{ADEg} (subclass \code{S2.label}) or \code{ADEgS} (if \code{spObj} contains more than one column ).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{S2.label}} \code{\link[sp]{spplot}} \code{\link[sp]{sp.lines}} \code{\link[sp]{sp.polygons}} \code{\link[sp]{sp.grid}} } \examples{ data(elec88, package = "ade4") ## mapping without data g1 <- s.Spatial(elec88$Spatial) \dontrun{ if(require(sp, quietly = TRUE)) { ## mapping with data obj <- SpatialPolygonsDataFrame(Sr = elec88$Spatial, data = elec88$tab) g2 <- s.Spatial(obj) g3 <- s.Spatial(obj, nclass = 2, col = c("red", "blue")) } } } \keyword{hplot} adegraphics/man/addtext.Rd0000644000176200001440000000410113742303021015212 0ustar liggesusers\name{addtext} \alias{addtext} \alias{addtext-methods} \alias{addtext,ADEg-method} \alias{addtext,ADEgS-method} \alias{addtext,trellis-method} \title{ Adds labels on graphics. } \description{ Adds a \code{trellis} object containing one or several labels on one or several graphical objects. } \usage{ addtext(object, xcoord, ycoord, label, plot = TRUE, ...) } \arguments{ \item{object}{an object of class \code{ADEg}, \code{trellis} or \code{ADEgS} } \item{xcoord}{an integer (or a vector) indicating where \code{label} is(are) plotted on the x-axis, passed to the \code{adeg.panel.label} } \item{ycoord}{an integer (or a vector) indicating where \code{label} is(are) plotted on the y-axis, passed to the \code{adeg.panel.label} } \item{label}{a character string (or a vector) containing the label(s) displayed on \code{object} } \item{plot}{a logical indicating if the graphics is displayed } \item{\dots}{Other arguments. Additional graphical parameters (see the \code{plabels} list in \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}}). If \code{object} is an \code{ADEgS}, the argument \code{which} identify which \code{ADEg} is/are used for superposition. } } \value{ An object of class \code{ADEgS}. } \author{Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEgS}} \code{adeg.panel.label} } \examples{ data(dunedata, package = "ade4") afc1 <- ade4::dudi.coa(dunedata$veg, scannf = FALSE) g1 <- table.value(dunedata$veg, symbol = "circle", ppoints.cex = 0.5, plot = FALSE) addtext(g1, 1, 20, "A", plabels.srt = 45, plabels.box.draw = FALSE, plabels.col = "red") xy <- cbind.data.frame(x = runif(200, -1, 1), y = runif(200, -1, 1)) posi <- factor(xy$x > 0) : factor(xy$y > 0) g2 <- s.class(xy, fac = posi, facets = posi, pellipses.col = 1:4, plabels.cex = 0, plegend.drawKey = FALSE, psub.cex = 0, plot = FALSE) addtext(g2, c(0.5, 0.5, -0.5, -0.5), c(0.5, -0.5), levels(posi), plabels.cex = 2, plabels.col = 1:4) } \keyword{aplot} adegraphics/man/adeg.panel.hist.Rd0000644000176200001440000000341313742303021016526 0ustar liggesusers\name{adeg.panel.hist} \alias{adeg.panel.hist} \title{Panel function for adding histograms.} \description{ Panel function for displaying histograms into a \code{trellis} graphic (\code{lattice} package) and level lines. } \usage{ adeg.panel.hist(histValues, horizontal = TRUE, densi, drawLines, params = list(), identifier = "histogramADEg") } \arguments{ \item{histValues}{an object of class histogram. See \code{\link[graphics]{hist}}.} \item{horizontal}{a logical indicating if the plot is horizontal} \item{densi}{a list returns by the \code{\link[KernSmooth]{bkde}} containing the coordinates of the binned kernel density estimate of the probability density of the data} \item{drawLines}{a vector containing the level values} \item{params}{graphical parameters : \code{plot.polygon}, \code{add.line} and \code{plot.line} (\code{lattice}) } \item{identifier}{A character string that is prepended to the name of the grob that is created.} } \value{ Displays the histogram and level lines. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\link[KernSmooth]{bkde}} and \code{\link[graphics]{hist}} } \note{ For more information about the use of panel functions, please see the \code{lattice} package developed by Deepayan Sarkar. } \examples{ if(require(KernSmooth, quietly = TRUE) & require(lattice, quietly = TRUE)) { z <- round(rnorm(100, 30, 5)) h <- hist(z, plot = FALSE) d <- bkde(z, kernel = "normal", gridsize = 60) l <- c(10, 20, 30, 40) xyplot(1:50 ~ 1:50, histValues = h, densi = d, drawLines = l, panel = function(drawLines, histValues, densi){ adeg.panel.hist(histValues = histValues, drawLines = drawLines, densi = densi)}) } } \keyword{aplot}adegraphics/man/adeg.panel.values.Rd0000644000176200001440000000611513742303021017060 0ustar liggesusers\name{adeg.panel.values} \alias{adeg.panel.values} \title{Panel function drawing a third variable into a two-dimensional scatterplot} \description{ Panel function for drawing coordinates with variable representation. The values can be represented through symbols with proportional size or various colors. } \usage{ adeg.panel.values(x, y, z, method, symbol, ppoints, breaks, centerpar = NULL, center = 0) } \arguments{ \item{x}{a numeric vector, x-coordinates for the symbols} \item{y}{a numeric vector, y-coordinates for the symbols} \item{z}{a numeric vector, the third variable with one value per coordinates (x, y)} \item{method}{a character string equal to \code{color} or \code{size}.\cr If \code{color}, a palette of color is used for the symbols (one color per interval defined by \code{breaks}).\cr If \code{size}, symbols' area is proportional to the value. Area is 0 for values equals to \code{center}. Two colors are used, one for values smaller than center and the other for values larger than center.} \item{symbol}{a character string equal to \code{square} or \code{circle}.} \item{ppoints}{a list of parameters as an extract of \code{adegpar("ppoints")}, used for points' drawing. \itemize{ \item{\code{alpha}: transparency of points} \item{\code{cex}: size of points} \item{\code{col}: border color of points} \item{\code{pch}: symbol to use} \item{\code{fill}: filling color} }} \item{breaks}{a vector, the breaks used for splitting \code{z} if \code{method} is \code{color}} \item{centerpar}{a list to represent center value using elements in the \code{adegpar("ppoints")} list or \code{NULL} value. If the method is \code{size}, z-values equals to \code{center} have a size of zero. If \code{centerpar} is not \code{NULL}, those z-values are shown as points with the \code{centerpar} drawing parameters.} \item{center}{a center value for method \code{size}} } \value{ Draws the points. } \references{ Tanimura, S. and Kuroiwa, C. and Mizota, T. 2006 Proportional symbol mapping in R \emph{Journal of Statistical Software} \bold{15}, 1--7 } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \note{ For more information about the use of panel functions, please see the \code{lattice} package developed by Deepayan Sarkar. For the symbols size, the method is \code{size} uses perceptual scaling (Tanimura et al. 2006). } \examples{ if(require(lattice, quietly = TRUE)) { param <- adegpar("ppoints")[[1]] param$col <- adegpar("ppalette")[[1L]]$quanti(2) z <- rnorm(10) xyplot(1:10 ~ 1:10, panel = function(x, y, ...){ adeg.panel.values(x, y, z, method = "size", symbol = "square", ppoints = param, breaks = pretty(z, 4))}) } if(require(lattice, quietly = TRUE)) { param$col <- adegpar()$ppalette$quali((length(pretty(z, 2)) - 1)) xyplot(1:10 ~ 1:10, panel = function(x, y, ...){ adeg.panel.values(x, y, z, method = "color", symbol = "circle", ppoints = param, breaks = pretty(z, 2))}) } } \keyword{aplot} adegraphics/man/s1d.gauss.Rd0000644000176200001440000000551713742303021015401 0ustar liggesusers\name{s1d.gauss} \alias{s1d.gauss} \title{1-D plot of a numeric score by Gaussian curves} \description{ This function represents a score with a Gauss curve for each level of a factor. } \usage{ s1d.gauss(score, fac = gl(1, NROW(score)), wt = rep(1, NROW(score)), steps = 200, col = NULL, fill = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{score}{a numeric vector (or a data frame) used to produce the plot} \item{fac}{a factor (or a matrix of factors) to split \code{score}} \item{wt}{a vector of weights for \code{score}} \item{steps}{a value for the number of segments used to draw the Gauss curves} \item{col}{a logical, a color or a colors vector for labels, rugs, lines and polygons according to their factor level. Colors are recycled whether there are not one color by factor level.} \item{fill}{a logical to yield the polygons Gauss curves filled} \item{facets}{a factor splitting \code{score} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ Graphical parameters for rugs are available in \code{plines} of \code{adegpar} and the ones for Gauss curves filled in \code{ppolygons}. Some appropriated graphical parameters in \code{p1d} are also available. } \value{ An object of class \code{ADEg} (subclass \code{C1.gauss}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or data frame for \code{score} or data frame for \code{fac} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{C1.gauss}} \code{\linkS4class{ADEg.C1}} } \examples{ data(meau, package= "ade4") envpca <- ade4::dudi.pca(meau$env, scannf = FALSE) dffac <- cbind.data.frame(meau$design$season, meau$design$site) g1 <- s1d.gauss(envpca$li[, 1], fac = dffac, fill = TRUE, col = 1:6) update(g1, steps = 10) g2 <- s1d.gauss(envpca$li[, 1], dffac[, 2], ppoly.col = 1:4, paxes.draw = TRUE, ylim = c(0, 2), fill = TRUE, p1d.hori = FALSE) } \keyword{aplot} \keyword{hplot} adegraphics/man/C1.density-class.Rd0000644000176200001440000000760113742303021016611 0ustar liggesusers\name{C1.density-class} \docType{class} \alias{C1.density} \alias{C1.density-class} \alias{prepare,C1.density-method} \alias{panel,C1.density-method} \title{Class \code{C1.density}} \description{ A class for the creation and display of a numeric score using density curves. } \section{Objects from the Class}{ \code{C1.density} objects can be created by calls of the form \code{new("C1.density", ...)}. The regular usage in this package is to use the \code{s1d.density} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{score}: the displayed values in the form of a numeric vector, a name or a matching call.} \item{\code{fac}: a factor for \code{score} to split in the form of a vector, a factor, a name or a matching call.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.C1} class. The specific slots for \code{C1.density} objects are: \itemize{ \item{\code{kernel}, \code{bandwidth} and \code{gridsize}: passed in parameters in \code{bkde} function of the \code{KernSmooth} package.} \item{\code{fill}: a logical to yield the polygons density curves filled.} \item{\code{col}: a logical, a color or a colors vector to color labels, rugs, lines and polygons.} }} \item{\code{stats}}{a list of internal preliminary calculations. The specific slot for \code{C1.density} objects is: \itemize{ \item{\code{densit}: the values of density curve calculated for each factor in \code{fac} computes with the \code{bkde} function of the \code{KernSmooth} package.} }} \item{\code{s.misc}}{a list of some others internal parameters. The specific slot for \code{C1.density} objects is: \itemize{ \item{\code{rug}: an index value indicating where the rugs are drawn} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.C1}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.C1}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.C1}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.C1}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.C1"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{C1.density} are: \describe{ \item{prepare}{\code{signature(object = "C1.density")}: calls the parent method (\code{prepare} for \code{ADEg.C1}), modifies some graphical parameters used by default and calculates the density curves according to the numeric score and the values' categories.} \item{panel}{\code{signature(object = "C1.density")}: draws density curves.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.C1}} \code{\link{s1d.density}} } \examples{ showClass("C1.density") } \keyword{classes} adegraphics/man/insert.Rd0000644000176200001440000000634413742303021015074 0ustar liggesusers\name{insert} \alias{insert} \alias{insert-methods} \alias{insert,ADEgORtrellis,missing-method} \alias{insert,ADEgS,missing-method} \alias{insert,ADEgORtrellis,ADEg-method} \alias{insert,ADEgS,ADEg-method} \alias{insert,ADEgORtrellis,ADEgS-method} \alias{insert,ADEgS,ADEgS-method} \title{Insert a graphic into an existing one} \description{ This function inserts a first graphic into a previously created and/or a displayed one. } \usage{ insert(graphics, oldgraphics, posi = c("bottomleft", "bottomright", "topleft", "topright"), ratio = 0.2, inset = 0.0, plot = TRUE, which, dispatch = FALSE) } \arguments{ \item{graphics}{an object of class \code{ADEg}, \code{ADEgS} or \code{trellis}} \item{oldgraphics}{an object of class \code{ADEg}, \code{ADEgS} or \code{missing}. If \code{oldgraphics} is \code{missing}, \code{graphics} is added on the current device.} \item{posi}{a character value or a two-length numeric vector (in normalized parent coordinates \code{npc} from 0 to 1) indicating the position of \code{olgraphics} added into \code{graphics}} \item{ratio}{a numeric value from 0 to 1 indicating the size of \code{olgraphics} regarding the plot region} \item{inset}{the inset from which the graph is drawn regarding the plot region. It can be a two-length vector giving the inset in x and y. If atomic, same inset is used in x and y.} \item{plot}{a logical indicating if the graphics is displayed} \item{which}{a numeric value or a vector of values only used if \code{oldgraphics} is an \code{ADEgS} object, indicating the which-th sub-graphic of \code{oldgraphics} where \code{graphics} is added.} \item{dispatch}{a logical only used if both \code{graphics} and \code{oldgraphics} are \code{ADEgS} objects with same length, indicating if \code{graphics} is added one by one int \code{oldgraphics}. It is used when both \code{graphics} and \code{oldgraphics} are created with \code{facets} option.} } \value{ An object of class \code{"ADEgS"}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEgS}} } \examples{ data(deug, package = "ade4") dd1 <- ade4::dudi.pca(deug$tab, scannf = FALSE, nf = 4) g1 <- s.label(dfxy = dd1$li, labels = rownames(dd1$li), plabels = list(cex = 0.75), plot = FALSE) g2 <- s1d.barchart(score = dd1$eig, plot = FALSE, ppolygons = list(col = c(rep("black", 2), rep("grey", 2), rep("white", 5))), p1d = list(horizontal = FALSE), psub = list(position = "topright", text = "Eigenvalues"), pgrid = list(draw = FALSE), pbackground = list(box = TRUE), xlim = c(0.5, 9.5)) g1 g3 <- insert(g2, plot = FALSE) mat <- g3@positions mat[2, ] <- c(0.8, 0, 1, 0.2) update(g3, positions = mat, plot = FALSE) print(g3) ## square == NULL print(g3, square = TRUE) print(g3, square = FALSE) g4 <- insert(g2, g1, posi = "topleft") data(jv73, package = "ade4") pca1 <- ade4::dudi.pca(jv73$morpho, scannf = FALSE) g5 <- s.value(jv73$xy, pca1$li[, 1:2], porigin.include = FALSE, plot = FALSE) g6 <- s.corcircle(pca1$co, pbackground.box = FALSE, plot = FALSE) g7 <- insert(g6, g5, posi = c(0.3, 0.4, 0.5, 0.6)) } \keyword{hplot} \keyword{aplot} \keyword{methods} adegraphics/man/s1d.hist.Rd0000644000176200001440000000467713742303021015234 0ustar liggesusers\name{s1d.hist} \alias{s1d.hist} \title{1-D plot of a numeric score by bars} \description{ This function represents a score using a chart with rectangular bars. } \usage{ s1d.hist(score, breaks = NULL, nclass = round(log2(length(score)) + 1), type = c("count", "density", "percent"), right = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{score}{a numeric vector (or a data frame) used to produce the plot} \item{breaks}{a vector of values to split \code{score}. If \code{NULL}, \code{pretty(score, nclass)} is used.} \item{nclass}{an integer for the number of desired intervals, ignored if \code{breaks} is not missing.} \item{type}{a value among \code{count}, \code{density}, \code{percent} to indicate the unit of the cell height.} \item{right}{a logical indicating if the histogram cells are right-closed (left open) intervals.} \item{facets}{a factor splitting \code{score} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ Graphical parameters for polygons are available in \code{ppolygons} of \code{adegpar}. Some appropriated graphical parameters in \code{p1d} are also available. } \value{ An object of class \code{ADEg} (subclass \code{C1.hist}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or data frame for \code{score} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{C1.hist}} \code{\linkS4class{ADEg.C1}} \code{\link[graphics]{hist}} } \examples{ set.seed(40) score1 <- rnorm(1000) s1d.hist(score1) } \keyword{aplot} \keyword{hplot} adegraphics/man/S2.image-class.Rd0000644000176200001440000001017413742303021016234 0ustar liggesusers\name{S2.image-class} \docType{class} \alias{S2.image} \alias{S2.image-class} \alias{prepare,S2.image-method} \alias{panel,S2.image-method} \title{Class \code{S2.image}} \description{ A class for the creation of a bi-dimensional plot with a third value represented as a continuous colored surface. } \section{Objects from the Class}{ \code{S2.image} objects can be created by calls of the form \code{new("S2.image", ...)}. The regular usage in this package is to use the \code{s.image} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{dfxy}: the displayed values in the form of a data frame, a name or a matching call.} \item{\code{z}: a vector (or a matrix) of values on the \code{dfxy} rows.} \item{\code{xax}: an integer or a vector indicating the columns of \code{dfxy} kept for the x-axes.} \item{\code{yax}: an integer or a vector indicating the columns of \code{dfxy} kept for the y-axes.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S2} class. The specific slots for \code{S2.image} objects are: \itemize{ \item{\code{gridsize}: a 1 or 2-length vector indicating the cell numbers (horizontally and vertically) of the grid for the colored surface.} \item{\code{outsideLimits}: specific limits for the surface as a set of polygons. It must be an \code{SpatialPolygons} object. Hole are authorized.} \item{\code{span}: a value to control the degree of smoothing.} \item{\code{contour}: a logical to draw contour lines.} \item{\code{region}: a logical to fill inter-contour regions.} \item{\code{col}: a \code{NULL} value, a color or a colors vector used for the colored cells.} }} \item{\code{stats}}{a list of internal preliminary calculations. The specific slot for \code{S2.image} objects is: \itemize{ \item{\code{value}: a prediction value yielded by a local polynomial regression fitting.} }} \item{\code{s.misc}}{a list of some others internal parameters: \itemize{ \item{\code{newgrid}: the grid expansion calculated within the prepare method.} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.S2}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.S2}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.S2}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.S2}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.S2"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{S2.image} are: \describe{ \item{prepare}{\code{signature(object = "S2.image")}: calls the parent method (\code{prepare} for \code{ADEg.S2}), modifies some graphical parameters used by default and calculates grid expansion and limits.} \item{panel}{\code{signature(object = "S2.image")}: draws raster image.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.S2}} \code{\link{s.image}} } \examples{ showClass("S2.image") } \keyword{classes} adegraphics/man/s.match.Rd0000644000176200001440000000533313742303021015122 0ustar liggesusers\name{s.match} \alias{s.match} \title{2-D scatter plot of the matching between two sets of coordinates} \description{ This function represents a two dimensional scatter plot linking paired coordinates. } \usage{ s.match(dfxy1, dfxy2, xax = 1, yax = 2, labels = row.names(as.data.frame(dfxy1)), arrows = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{dfxy1}{a data frame, the first system of coordinates, used to produce the plot} \item{dfxy2}{a data frame, the second system of coordinates, with as many rows as \code{dfxy1}, used to produce the plot.} \item{labels}{a vector of character strings containing the matches' labels} \item{xax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the x-axis} \item{yax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the y-axis} \item{arrows}{a logical to draw arrows} \item{facets}{a factor splitting the rows of \code{dfxy} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \value{ An object of class \code{ADEg} (subclass \code{S2.match}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or vectors for \code{xax}/\code{yax} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{S2.match}} \code{\linkS4class{ADEg.S2}} } \examples{ X <- data.frame(x = runif(50, -1, 2), y = runif(50, -1, 2)) Y <- X + rnorm(100, sd = 0.3) g1 <- s.match(X, Y, arr = TRUE, ppoints.cex = 2, ppoints.col = c("blue", "green")) data(doubs, package = "ade4") dudi1 <- ade4::dudi.pca(doubs$env, scale = TRUE, scannf = FALSE, nf = 3) dudi2 <- ade4::dudi.pca(doubs$fish, scale = FALSE, scannf = FALSE, nf = 2) coin1 <- ade4::coinertia(dudi1, dudi2, scannf = FALSE, nf = 2) g2 <- s.match(dfxy1 = coin1$mX, dfxy2 = coin1$mY) } \keyword{aplot} \keyword{hplot} adegraphics/man/adeg.panel.Spatial.Rd0000644000176200001440000000553613742303021017164 0ustar liggesusers\name{adeg.panel.Spatial} \alias{adeg.panel.Spatial} \title{Panel function for adding spatial objects.} \description{ Panel function adapted from the \code{Sp} package for displaying all kind of spatial objects handled by \code{Sp} (for classes inherited from the superclass \code{Spatial}) into a \code{trellis} graphic (\code{lattice} package). } \usage{ adeg.panel.Spatial(SpObject, sp.layout = NULL, col = 1, border = 1, lwd = 1, lty = 1, alpha = 0.8, cex = 1, pch = 20, n = length(col), spIndex = 1, ...) } \arguments{ \item{SpObject}{an object of class \code{"SpatialPoints"}, \code{"SpatialPointsDataFrame"},\cr \code{"SpatialPixels"}, \code{"SpatialPixelsDataFrame"}, \code{"SpatialGrid"},\cr \code{"SpatialGridDataFrame"}, \code{"SpatialLines"}, \code{"SpatialLinesDataFrame"},\cr \code{"SpatialPolygons"} or \code{"SpatialPolygonsDataFrame"}} \item{sp.layout}{a list of layout items. See \code{spplot} for more information} \item{col}{background color (fill) of \code{Spobject}} \item{border}{border color} \item{lwd}{line width (border)} \item{lty}{line type (border)} \item{alpha}{background transparency of \code{Spobject}} \item{cex}{point size} \item{pch}{point type} \item{n}{if \code{SpObject} contains data, the _desired_ number of intervals splitting the data (using \code{pretty}).} \item{spIndex}{if the \code{SpObject} contains a data frame, its values are represented with a color code. Only the \code{spIndex} data frame is represented} \item{\dots}{for coherence with panel functions} } \value{ Draws the Spatial object and layout. } \references{ Package \code{Sp}. Author: Edzer Pebesma, Roger Bivand, Barry Rowlingson and Virgilo Gomez-Rubio. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \note{ If \code{SpObject} contains several maps, only the first one is selected. Also for objects containing more data (for classes \code{data.frame} with a slot \code{data}), this information is also shown. To do so, various colors can be used (according to the col arguments). For more information about the use of panel functions, please see the \code{lattice} package developed by Deepayan Sarkar. } \examples{ if(require(lattice, quietly = TRUE) & require(sp, quietly = TRUE)) { data(elec88, package = "ade4") xy <- elec88$xy arrow <- list("SpatialPolygonsRescale", offset = c(150000,1700000), layout.north.arrow(), scale = 100000) xyplot(xy[, 2] ~ xy[, 1], aspect = "iso", panel = function(...){ adeg.panel.Spatial(SpObject = elec88$Spatial, sp.layout = list(arrow), col = colorRampPalette(c("yellow", "blue"))(5), border = "transparent")}) } } \seealso{ \code{\link[sp]{spplot}} \code{\link[sp]{sp.lines}} \code{\link[sp]{sp.polygons}} \code{\link[sp]{sp.grid}} } \keyword{aplot} adegraphics/man/zoom.Rd0000644000176200001440000000243113742303021014545 0ustar liggesusers\name{zoom} \alias{zoom} \alias{zoom-methods} \alias{zoom,ADEg.S1,numeric,missing-method} \alias{zoom,ADEg.S1,numeric,numeric-method} \alias{zoom,ADEg.S2,numeric,missing-method} \alias{zoom,ADEg.S2,numeric,numeric-method} \title{Zoom in or out} \description{ This function performs a zoom on a \code{ADEg.S1} or \code{ADEg.S2} displayed object. } \usage{ zoom(object, zoom, center) } \arguments{ \item{object}{a \code{ADEg.S1} or \code{ADEg.S2} object} \item{zoom}{a numeric value to zoom in (if \code{zoom} > 1) or out (if \code{zoom} < 1)} \item{center}{a numeric value (if \code{object} is a \code{ADEg.S1} object) or a two-length vector (if \code{object} is a \code{ADEg.S2} object) as a reference point to zoom (in or out). If it is \code{missing}, the displayed center point is used.} } \value{ Updated display after zoom. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg.S2}} \code{\linkS4class{ADEg.S1}} } \examples{ data(olympic, package = "ade4") dudi1 <- ade4::dudi.pca(olympic$tab, scan = FALSE) g <- s.corcircle(dudi1$co, lab = names(olympic$tab), fullcircle = TRUE, psub.text = "data:olympic") zoom(g, 0.5) zoom(g, 2, center = c(-0.4, 0.8)) } \keyword{iplot} adegraphics/man/changelatticetheme.Rd0000644000176200001440000000224713742303021017404 0ustar liggesusers\name{changelatticetheme} \alias{changelatticetheme} \title{ Change the \code{lattice} theme used for \code{adegraphics} } \description{ This function allows to modify the default theme existing for \code{adegraphics} objects. The created theme also affects previously created objects. } \usage{ changelatticetheme(...) } \arguments{ \item{\dots}{\code{lattice} parameters, the same used in \code{trellis.par.set} and provided by \code{trellis.par.get}. If empty, reset the theme to the \code{adegraphics} one.} } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \note{ The \code{adegraphics} theme removes all margins, sets a transparent background and grey regions. A further development will be the creation of various themes for \code{adegraphics}. } \seealso{ \code{\link[lattice]{trellis.par.get}} \code{\link[lattice]{trellis.par.set}} \code{\link[lattice]{show.settings}} } \examples{ if(require(lattice, quietly = TRUE)) { show.settings() changelatticetheme(list(superpose.symbol = list(pch = c(21, 22, 35), cex = 1))) show.settings() show.settings()[1] } } \keyword{iplot} adegraphics/man/s1d.dotplot.Rd0000644000176200001440000000410213742303021015731 0ustar liggesusers\name{s1d.dotplot} \alias{s1d.dotplot} \title{1-D plot of a numeric score by dots} \description{ This function represents a score using dots. } \usage{ s1d.dotplot(score, at = 1:NROW(score), facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{score}{a numeric vector (or a data frame) used to produce the plot} \item{at}{a numeric vector used as an index} \item{facets}{a factor splitting \code{score} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ Graphical parameters for segments and dots are available in \code{plines} and in \code{ppoints} of \code{adegpar}. Some appropriated graphical parameters in \code{p1d} are also available. } \value{ An object of class \code{ADEg} (subclass \code{C1.dotplot}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or data frame for \code{score} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{C1.dotplot}} \code{\linkS4class{ADEg.C1}} } \examples{ data(rpjdl, package = "ade4") rpjdl.coa <- ade4::dudi.coa(rpjdl$fau, scannf = FALSE, nf = 4) s1d.dotplot(rpjdl.coa$eig) set.seed(40) score1 <- rnorm(10) s1d.dotplot(score1) } \keyword{aplot} \keyword{hplot} adegraphics/man/S1.class-class.Rd0000644000176200001440000000736513742303021016266 0ustar liggesusers\name{S1.class-class} \docType{class} \alias{S1.class} \alias{S1.class-class} \alias{prepare,S1.class-method} \alias{panel,S1.class-method} \title{Class \code{S1.class}} \description{ A class for the creation and display of a numeric score aggregated in class by an associated factor. } \section{Objects from the Class}{ \code{S1.class} objects can be created by calls of the form \code{new("S1.class", ...)}. The regular usage in this package is to use the \code{s1d.class} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{score}: the displayed values in the form of a numeric vector, a name or a matching call.} \item{\code{fac}: a factor for \code{score} splitting in the form of a vector, a factor, a name or a matching call.} \item{\code{wt}: a vector of weights for \code{score}} \item{\code{labels}: the labels' names drawn for each class.} \item{\code{at}: the index value.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S1} class. The specific slots for \code{S1.class} objects are: \itemize{ \item{\code{col}: a \code{NULL} value, a color or a colors vector to color points, labels and lines.} \item{\code{poslabel}: the label position of each class, it can be \code{regular} or \code{value}.} }} \item{\code{stats}}{a list of internal preliminary calculations. The specific slot for \code{S1.class} objects is: \itemize{ \item{\code{means}: the weighted mean calculated for each \code{fac} value.} }} \item{\code{s.misc}}{a list of some others internal parameters. The specific slot for \code{S1.class} objects is: \itemize{ \item{\code{rug}: an index value indicating where the rugs are drawn.} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.S1}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.S1}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.S1}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.S1}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.S1"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{S1.class} are: \describe{ \item{prepare}{\code{signature(object = "S1.class")}: calls the parent method (\code{prepare} for \code{ADEg.S1}) and modifies some graphical parameters used by default.} \item{panel}{\code{signature(object = "S1.class")}: draws labels and lines matching with score values.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.S1}} \code{\link{s1d.class}} } \examples{ showClass("S1.class") } \keyword{classes} adegraphics/man/C1.interval-class.Rd0000644000176200001440000000616213742303021016757 0ustar liggesusers\name{C1.interval-class} \docType{class} \alias{C1.interval} \alias{C1.interval-class} \alias{prepare,C1.interval-method} \alias{panel,C1.interval-method} \title{Class \code{C1.interval}} \description{ A class for the creation and display of an interval between two numeric scores. } \section{Objects from the Class}{ \code{C1.interval} objects can be created by calls of the form \code{new("C1.interval", ...)}. The regular usage in this package is to use the \code{s1d.interval} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{score}: the displayed values in the form of a vector, a factor, a name or a matching call.} \item{\code{at}: the index value.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.C1} class. The specific slot for \code{C1.density} objects is: \itemize{ \item{\code{method}: a value, \code{bars} or \code{area}, to represent either segments or areas between scores.} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.C1}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.C1}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.C1}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.C1}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.C1"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{C1.interval} are: \describe{ \item{prepare}{\code{signature(object = "C1.interval")}: calls the parent method (\code{prepare} for \code{ADEg.C1}) and modifies some graphical parameters used by default.} \item{panel}{\code{signature(object = "C1.interval")}: draws segments or polygons.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.C1}} \code{\link{s1d.interval}} } \examples{ showClass("C1.interval") } \keyword{classes} adegraphics/man/S2.traject-class.Rd0000644000176200001440000000710513742303021016606 0ustar liggesusers\name{S2.traject-class} \docType{class} \alias{S2.traject} \alias{S2.traject-class} \alias{prepare,S2.traject-method} \alias{panel,S2.traject-method} \title{Class \code{S2.traject}} \description{ A class for the creation of a bi-dimensional plot with trajectories linking the points. } \section{Objects from the Class}{ \code{S2.traject} objects can be created by calls of the form \code{new("S2.traject", ...)}. The regular usage in this package is to use the \code{s.traject} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{dfxy}: the displayed values in the form of a data frame, a name or a matching call.} \item{\code{fac}: a factor (or a matrix of factors) splitting the rows of \code{dfxy}.} \item{\code{labels}: a vector of character strings containing the trajectories' labels.} \item{\code{xax}: an integer or a vector indicating the columns of \code{dfxy} kept for the x-axes.} \item{\code{yax}: an integer or a vector indicating the columns of \code{dfxy} kept for the y-axes.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S2} class. The specific slots for \code{S2.traject} objects are: \itemize{ \item{\code{order}: a vector containing the drawing order of the trajectories. A vector of length equal to factor.} \item{\code{col}: a \code{NULL} value, a color or a colors vector to color points, labels and lines.} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.S2}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.S2}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.S2}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.S2}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.S2"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{S2.traject} are: \describe{ \item{prepare}{\code{signature(object = "S2.traject")}: calls the parent method (\code{prepare} for \code{ADEg.S2}) and modifies some graphical parameters used by default.} \item{panel}{\code{signature(object = "S2.traject")}: draws points, arrows and labels.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.S2}} \code{\link{s.traject}} } \examples{ showClass("S2.traject") } \keyword{classes} adegraphics/man/table.image.Rd0000644000176200001440000000522313742303021015733 0ustar liggesusers\name{table.image} \alias{table.image} \title{Heat map-like representation with colored cells} \description{ This function represents a two dimensional table plot in which cells are colored according with their value. } \usage{ table.image(dftab, coordsx = 1:ncol(as.matrix(dftab)), coordsy = nrow(as.matrix(dftab)):1, labelsx, labelsy, nclass = 3, breaks = NULL, col = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{dftab}{a data frame, matrix, contingency table or distance matrix used to produce the plot} \item{coordsx}{an integer or a vector indicating the columns of \code{dftab} kept} \item{coordsy}{an integer or a vector indicating the rows of \code{dftab} kept} \item{labelsx}{columns labels} \item{labelsy}{rows labels} \item{breaks}{a vector of values to split \code{dftab}. If \code{NULL}, \code{pretty(dftab, nclass)} is used.} \item{nclass}{an integer for the number of desired intervals, ignored if \code{breaks} is not missing.} \item{col}{a color or a colors vector used for the cells} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \value{ An object of class \code{ADEg} (subclass \code{T.image}) or \code{ADEgS} (if \code{add} is \code{TRUE}).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{T.image}} \code{\linkS4class{ADEg.T}} } \examples{ tab <- as.table(matrix(rnorm(900), ncol = 30)) g1 <- table.image(tab) # add a continuous color bar as legend # update(g1, plegend.drawColorKey = TRUE) g2 <- table.image(tab, n = 100, coordsx = c(30, 1:29), plegend.drawKey = FALSE) data(rpjdl, package = "ade4") X <- data.frame(t(rpjdl$fau)) Y <- data.frame(t(rpjdl$mil)) coa1 <- ade4::dudi.coa(X, scannf = FALSE) g3 <- table.image(Y, coordsx = rank(coa1$co[, 1]), coordsy = 1:8, nclas = 5, labelsx = "", plegend.drawKey = FALSE) } \keyword{aplot} \keyword{hplot} adegraphics/man/layout2position.Rd0000644000176200001440000000315113742303021016745 0ustar liggesusers\name{layout2position} \alias{layout2position} \title{Transform a layout matrix into a position one} \description{ This function transforms layout's informations into a position matrix useful for \code{ADEgS} and for \code{lattice} graphics. } \usage{ layout2position(mat, widths = rep(1, NCOL(mat)), heights = rep(1, NROW(mat)), ng, square = FALSE) } \arguments{ \item{mat}{a matrix indicating the location of figures to display (each value must be 0 or a positive integer) or a two-length vector indicating the number of rows and columns in the corresponding layout.} \item{widths}{a vector of relative values for the columns' widths on the device. Their sum must be equal to the number of columns.} \item{heights}{a vector of relative values for the rows' heights on the device. Their sum must be equal to the number of rows.} \item{ng}{a value for the number of positions needed (i.e. the number of graphics to plot)} \item{square}{a logical indicating if the graphics is an isometric plot} } \value{ A four-columns matrix indicating the coordinates (in normalized parent coordinates \code{npc}) of the top-right and bottom-left hand corners of each displayed figure on the device. } \note{ This function is strongly inspired by the \code{layout} function in \code{graphics} package. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\link{layout}} } \examples{ layout2position(mat = rbind(c(0, 0, 1), c(2, 2, 1))) layout2position(mat = cbind(c(0, 0, 1), c(2, 2, 1)), widths = c(0.5, 1.5)) } adegraphics/man/s1d.boxplot.Rd0000644000176200001440000000522713742303021015744 0ustar liggesusers\name{s1d.boxplot} \alias{s1d.boxplot} \title{1-D box plot of a numeric score partitioned in classes (levels of a factor)} \description{ This function represents the link between a variable and a set of qualitative variables using box-and-whisker plots. } \usage{ s1d.boxplot(score, fac = gl(1, NROW(score)), at = 1:nlevels(fac), col = NULL, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{score}{a numeric vector (or a data frame) used to produce the plot} \item{fac}{a factor (or a matrix of factors) to split \code{score}} \item{at}{a numeric vector used as an index} \item{col}{a color or a colors vector for points, labels, lines and polygons according to their factor level. Colors are recycled whether there are not one color by factor level.} \item{facets}{a factor splitting \code{score} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ Graphical parameters for rugs are available in \code{plines} of \code{adegpar} and the ones for boxes in \code{ppolygons}. Some appropriated graphical parameters in \code{p1d} are also available. } \value{ An object of class \code{ADEg} (subclass \code{S1.boxplot}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or data frame for \code{score} or data frame for \code{fac} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{S1.boxplot}} \code{\linkS4class{ADEg.S1}} } \examples{ data(banque, package = "ade4") banque.acm <- ade4::dudi.acm(banque, scan = FALSE, nf = 4) s1d.boxplot(banque.acm$l1[, 1], banque[, 2], psub.text = names(banque)[2], psub.position = "topleft", col = c("red", "blue", "green", "purple", "orange")) s1d.boxplot(banque.acm$l1[,1], banque[, 1:6], psub.position = "topleft") } \keyword{aplot} \keyword{hplot} adegraphics/man/addpoint.Rd0000644000176200001440000000313013742303021015360 0ustar liggesusers\name{addpoint} \alias{addpoint} \alias{addpoint-methods} \alias{addpoint,ADEg-method} \alias{addpoint,ADEgS-method} \title{ Adds points on graphics. } \description{ Adds a \code{trellis} object containing one or several points on one or several graphical objects. } \usage{ addpoint(object, xcoord, ycoord, plot = TRUE, ...) } \arguments{ \item{object}{an object of class \code{ADEg} or \code{ADEgS} } \item{xcoord}{an integer (or a vector) indicating where \code{label} is(are) plotted on the x-axis, passed to the \code{panel.points} function of the \code{lattice} package } \item{ycoord}{an integer (or a vector) indicating where \code{label} is(are) plotted on the y-axis, passed to the \code{panel.points} function of the \code{lattice} package } \item{plot}{a logical indicating if the graphics is displayed } \item{\dots}{Other arguments. Additional graphical parameters (see the \code{ppoints} list in \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}}). If \code{object} is an \code{ADEgS}, the argument \code{which} identify which \code{ADEg} is/are used for superposition. } } \value{ An object of class \code{"ADEgS"}. } \author{Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEgS}} \code{\link[lattice]{panel.points}} } \examples{ data(deug, package = "ade4") deug$cent[1] g1 <- s1d.density(deug$tab[, 1], plot = FALSE) addpoint(g1, xcoord = deug$cent[1], ycoord = 0, ppoints = list(col = "black", pch = "*", cex = 3)) } \keyword{aplot} adegraphics/man/Tr.class-class.Rd0000644000176200001440000001074213742303021016361 0ustar liggesusers\name{Tr.class-class} \docType{class} \alias{Tr.class} \alias{Tr.class-class} \alias{prepare,Tr.class-method} \alias{panel,Tr.class-method} \title{Class \code{Tr.class}} \description{ A class for group representation in triangular plot. } \section{Objects from the Class}{ \code{Tr.class} objects can be created by calls of the form \code{new("Tr.class", ...)}. The regular usage in this package is to use the \code{triangle.class} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{dfxyz}: the displayed values in the form of a data frame with three columns, a name or a matching call.} \item{\code{fac}: a factor partitionning the rows of \code{dfxyz}.} \item{\code{wt}: a vector of weights for \code{fac}.} \item{\code{labels}: a vector containing the class' labels.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.Tr} class. The specific slots for \code{Tr.class} objects are: \itemize{ \item{\code{ellipseSize}: a positive number for ellipse size.} \item{\code{starSize}: a number between 0 and 1 for star size.} \item{\code{chullSize}: \code{NULL} or a vector of numbers between 0 and 1 for the convex hulls.} \item{\code{col}: a \code{NULL} value, a color or a colors vector to color points, ellipses, labels, lines and polygons.} \item{\code{max3d} and \code{min3d}: vectors of three values for triangular maximal and minimal limits.} \item{\code{adjust}: a logical to adjust the device with the limits of the smaller equilateral triangle containing the values.} }} \item{\code{stats}}{a list of internal preliminary calculations. The specific slots for \code{S2.class} objects are: \itemize{ \item{\code{means}: a matrix containing the weighted mean calculated for each \code{fac} value.} \item{\code{mean2d}: a matrix containing the weighted mean calculated for each \code{fac} value on two-dimension.} \item{\code{covvar}: a list containing the weighted variance-covariance matrices calculated for each \code{fac} value.} \item{\code{covvar2d}: a list containing the weighted variance-covariance matrices calculated for each \code{fac} value on two-dimension.} }} \item{\code{s.misc}}{a list of some others internal parameters: \itemize{ \item{\code{ellipses}: ellipses' coordinates.} \item{\code{chullcoord}: convex hulls' coordinates.} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.Tr}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.Tr}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.Tr}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.Tr}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.Tr"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{Tr.class} are: \describe{ \item{prepare}{\code{signature(object = "Tr.class")}: calls the parent method (\code{prepare} for \code{ADEg.Tr}), modifies some graphical parameters used by default and calculates ellipses, convex hulls and centroids.} \item{panel}{\code{signature(object = "Tr.class")}: draws arrows, labels and points.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.Tr}} \code{\link{triangle.class}} } \examples{ showClass("Tr.class") } \keyword{classes} adegraphics/man/ADEg.T-class.Rd0000644000176200001440000000745713742303021015643 0ustar liggesusers\name{ADEg.T-class} \docType{class} \alias{ADEg.T} \alias{ADEg.T-class} \alias{gettrellis,ADEg.T-method} \alias{prepare,ADEg.T-method} \alias{setlatticecall,ADEg.T-method} \alias{panelbase,ADEg.T-method} \title{Class \code{ADEg.T}} \description{ An object of \code{ADEg.T} class represents table data. The \code{ADEg.T} class is a virtual class, i.e. a class which is not possible to create objects but which have heirs. This class inherits from \code{ADEg} class and has two son classes : \code{T.image} and \code{T.value}. } \section{Objects from the Class}{ None object of this class can be instantiated. } \section{Slots}{ \describe{ \item{\code{data}:}{a list containing data or data's name. \itemize{ \item{\code{dftab}: the displayed values which can be \code{table}, \code{dist} or \code{matrix} in the form of a data frame, a name or a matching call} \item{\code{coordsx}: an integer or a vector indicating the columns of \code{dftab} kept} \item{\code{coordsy}: an integer or a vector indicating the rows of \code{dftab} kept} \item{\code{labelsx}: the columns' labels} \item{\code{labelsy}: the rows' labels} \item{"\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list of two elements to create the \code{trellis} object: \itemize{ \item{\code{graphictype}: \code{xyplot}} \item{\code{arguments}: its parameters to obtain the \code{trellis} object} }} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.T} class: \itemize{ \item{\code{method}: only for \code{T.value} objects} \item{\code{symbol}: only for \code{T.value} objects} \item{\code{center}: only for \code{T.value} objects} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters: \itemize{ \item{\code{breaks.update}: a logical indicating if the legend breaks is updating} \item{\code{axes$dx} and \code{axes$dy}: intervals for the cell size} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg}}, directly. } \section{Methods}{ \describe{ \item{prepare}{\code{signature(object = "ADEg.T")}: performs the calculations before display the object (e.g. limits, grid and axis calculations)} \item{setlatticecall}{\code{signature(object = "ADEg.T")}: prepares the \code{lattice.call} slot} \item{panelbase}{\code{signature(object = "ADEg.T")}: defines the graphical background (e.g. axes, labels, ticks, box and grid)} \item{gettrellis}{\code{signature(object = "ADEg.T")}: converts the graphic into a \code{trellis} object of \code{lattice} class} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\link{adegpar}} \code{\linkS4class{T.image}} \code{\linkS4class{T.value}} \code{\linkS4class{ADEg}} } \examples{ showClass("ADEg.T") } \keyword{classes} adegraphics/man/plot.inertia.Rd0000644000176200001440000001147714520213615016207 0ustar liggesusers\name{plot.inertia} \alias{plot.inertia} \alias{score.inertia} \title{Display the decomposition of inertia which measure the contributions of rows/columns in mutivariate methods} \description{ S3 method to display the decomposition of inertia (\code{inertia} object) which measure the contributions of rows/columns in mutivariate methods (\code{dudi} objects from \code{ade4}) } \usage{ \method{plot}{inertia}(x, xax = 1, yax = 2, threshold = 0.1, contrib = c("abs", "rel"), type = c("label", "cross", "ellipse", "both"), ellipseSize = 1.5, posieig = "none", plot = TRUE, storeData = TRUE, pos = -1, \dots) \method{score}{inertia}(x, xax = 1, threshold = 0.1, contrib = c("abs", "rel"), posieig = "none", pos = -1, storeData = TRUE, plot = TRUE, \dots) } \arguments{ \item{x}{an object of the \code{dudi} class; it must be the output of a correspondance analysis (\code{coa} object).} \item{xax}{an integer indicating which column of \code{x} is plotted on the x-axis} \item{yax}{an integer indicating which column of \code{x} is plotted on the y-axis. If \code{yax} is equal to \code{xax}, a one-dimensional graph is display.} \item{threshold}{a numeric value containing the contribution threshold (between 0 and 1) at which points should be drawn on the graphic. Low contribution points will be represented by a grey point and without label. When the contributions are displayed on a single axis, a dotted line describes the contribution threshold.} \item{contrib}{a character value indicating which contributions are plotted: \code{abs} for absolute contributions (rows/columns involved in the factor axis/map construction) and \code{rel} for relative contribution (quality of rows/columns representation on the factor axis/map).} \item{type}{a character value indicating which type represents contribution. Labels size (\code{label}), crosses size(\code{cross}) or ellipses size (\code{ellipse}) can be proportional to the contributions. If \code{type} is \code{both}, crosses and ellipses both have sizes proportional to the contributions.} \item{ellipseSize}{a positive number for ellipse size when \code{type} is \code{ellipse}} \item{posieig}{a character value or a two-length numeric vector (in normalized parent coordinates \code{npc} from 0 to 1) or \code{none} value indicating the position of the eigenvalues bar plot.} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \value{ Returns an \code{ADEgS} object. The result is displayed if \code{plot} is \code{TRUE}. } \author{Clément Claustre, Anne-Béatrice Dufour, Aurélie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stéphane Dray } \examples{ # First example data(bf88, package = "ade4") coa1 <- ade4::dudi.coa(bf88$S1, scannf = FALSE, nf = 3) ###### row=T / col=F res11 <- ade4::inertia(coa1, row = TRUE, col = FALSE, nf = 3) g111 <- plot(res11, threshold = 0.06) g112 <- plot(res11, threshold = 0.06, xax = 1, yax = 3) g12 <- plot(res11, threshold = 0.06, plabels.boxes.draw = TRUE, plines.lwd = 0, light_row.ppoints.cex = 0, posieig = "bottomleft") g13 <- score(res11, threshold = 0.06) names(g13) g14 <- score(res11, xax = 2, threshold = 0.06) ###### row=F / col=T res12 <- ade4::inertia(coa1, row = FALSE, col = TRUE, nf = 2) res12$col.abs idx <- which(res12$col.abs[, 1]/100 >= 0.1 | res12$col.abs[, 2]/100 >= 0.1) rownames(res12$col.abs[idx, ]) coa1$co[idx, ] g15 <- plot(res12) g16 <- score(res12, threshold = 0.08) g17 <- score(res12, threshold = 0.07) ######################################## ######################################## # Second example data(housetasks, package = "ade4") coa2 <- ade4::dudi.coa(housetasks, scann = FALSE) ###### row=T / col=F res21 <- ade4::inertia(coa2, row = TRUE, col = FALSE) g21 <- plot(res21) g22 <- score(res21) g23 <- score(res21, xax = 2) ###### row=F / col=T res22 <- ade4::inertia(coa2, row = FALSE, col = TRUE) g24 <- plot(res22, plabels.cex = 2) names(g24) g25 <- plot(res22, posieig = "topleft") names(g25) g26 <- plot(res22, heavy_col.plabels.box.draw = TRUE, light_col.ppoints.col = "purple") g27 <- plot(res22, type = "both") g28 <- plot(res22, type = "ellipse", ellipseSize = 3, plabels.col = "black", pellipse.col = "purple", pellipses.border = "black") } \keyword{hplot} \keyword{methods} adegraphics/man/S2.arrow-class.Rd0000644000176200001440000000663213742303021016310 0ustar liggesusers\name{S2.arrow-class} \docType{class} \alias{S2.arrow} \alias{S2.arrow-class} \alias{prepare,S2.arrow-method} \alias{panel,S2.arrow-method} \title{Class \code{S2.arrow}} \description{ A class for creating and drawing bi-dimensional plot with arrows from the origin to the coordinates and labeled. } \section{Objects from the Class}{ \code{S2.arrow} objects can be created by calls of the form \code{new("S2.arrow", ...)}. The regular usage in this package is to use the \code{s.arrow} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{dfxy}: the displayed values in the form of a data frame, a name or a matching call.} \item{\code{xax}: an integer or a vector indicating the columns of \code{dfxy} kept for the x-axes.} \item{\code{yax}: an integer or a vector indicating the columns of \code{dfxy} kept for the y-axes.} \item{\code{labels}: a vector containing the arrows' labels.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S2} class. The specific slot for \code{S2.arrow} objects is: \itemize{ \item{\code{Sp}: a spatial object stem from \code{Sp} package.} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters: \itemize{ \item{\code{lim.update}: a logical indicating if the limits are updating} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.S2}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.S2}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.S2}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.S2}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.S2"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{S2.arrow} are: \describe{ \item{prepare}{\code{signature(object = "S2.arrow")}: calls the parent method (\code{prepare} for \code{ADEg.S2}), modifies some graphical parameters used by default and calculates limits.} \item{panel}{\code{signature(object = "S2.arrow")}: draws points, arrows and labels.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.S2}} \code{\link{s.arrow}} } \examples{ showClass("S2.arrow") } \keyword{classes} adegraphics/man/s.traject.Rd0000644000176200001440000000570313742303021015463 0ustar liggesusers\name{s.traject} \alias{s.traject} \title{2-D scatter plot with trajectories} \description{ This function represents a two dimensional scatter plot with trajectories. } \usage{ s.traject(dfxy, fac = gl(1, nrow(dfxy)), order, labels = levels(fac), xax = 1, yax = 2, col = NULL, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{dfxy}{a data frame used to produce the plot} \item{fac}{a factor (or a matrix of factors) splitting the rows of \code{dfxy}} \item{order}{a vector containing the drawing order of the trajectories. A vector of length equal to factor.} \item{labels}{a vector of character strings containing the trajectories' labels} \item{xax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the x-axis} \item{yax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the y-axis} \item{col}{a color or a colors vector to color points, labels and lines} \item{facets}{a factor splitting the rows of \code{dfxy} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ The \code{fac} factor is used to display several trajectories: each level of \code{fac} is a specific trajectory. } \value{ An object of class \code{ADEg} (subclass \code{S2.traject}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or multidimensional \code{fac} or vectors for \code{xax}/\code{yax} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{S2.traject}} \code{\linkS4class{ADEg.S2}} } \examples{ rw <- function(a) { x <- 0 for(i in 1:49) x <- c(x, x[length(x)] + runif(1, -1, 1)) x } x1 <- unlist(lapply(1:5, rw), use.names = FALSE) y1 <- unlist(lapply(1:5, rw), use.names = FALSE) z1 <- gl(5, 50) g1 <- s.traject(data.frame(x1, y1), z1, ppoints.pch = 19:23, plines.col = rainbow(5)) x2 <- unlist(lapply(1:2, rw), use.names = FALSE) y2 <- unlist(lapply(1:2, rw), use.names = FALSE) z2 <- gl(2, 50) g2 <- s.traject(data.frame(x2, y2), z2, ppoints.pch = 21:20, plines.col = 1:2) } \keyword{hplot} \keyword{aplot} adegraphics/man/s1d.curves.Rd0000644000176200001440000000366013742303021015563 0ustar liggesusers\name{s1d.curves} \alias{s1d.curves} \title{1-D plot of multiple scores linked by curves} \description{ This function represents multiple scores using points linked by curves. } \usage{ s1d.curves(score, at = 1:NROW(score), facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{score}{a numeric matrix (or a data frame) used to produce the plot} \item{at}{a numeric vector used as an index} \item{facets}{a factor splitting \code{score} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ Graphical parameters for lines and points are available in \code{plines} and in \code{ppoints} of \code{adegpar}. Some appropriated graphical parameters in \code{p1d} are also available. } \value{ An object of class \code{ADEg} (subclass \code{C1.curves}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{C1.curves}} \code{\linkS4class{ADEg.C1}} } \examples{ scores <- matrix(1:50, nrow = 10) s1d.curves(scores) } \keyword{aplot} \keyword{hplot} adegraphics/man/superpose.Rd0000644000176200001440000000777213742303021015623 0ustar liggesusers\name{superpose} \alias{superpose} \alias{superpose-methods} \alias{superpose,ADEgORtrellis,ADEgORtrellis,ANY,ANY-method} \alias{superpose,ADEgS,ADEgORtrellis,numeric,logical-method} \alias{superpose,ADEgS,ADEgORtrellis,numeric,ANY-method} \alias{superpose,ADEgS,ADEgORtrellis,missing,ANY-method} \alias{superpose,ADEgS,ADEgS,missing,ANY-method} \alias{+-methods} \alias{\S4method{+}{ADEg}} \alias{+,ADEg,ADEg-method} \alias{+,ADEg,ADEgS-method} \alias{+,ADEgS,ADEg-method} \title{Superpose two graphics} \description{ This function superposes two graphics and extends the graphical constraints of a first graphic to a second one. } \usage{ superpose(g1, g2, which, plot = FALSE) \S4method{+}{ADEg}(e1, e2) } \arguments{ \item{g1}{an object of class \code{ADEg}, \code{ADEgS} or \code{trellis}} \item{g2}{an object of class \code{ADEg}, \code{ADEgS} or \code{trellis} superposed on \code{g1}} \item{e1}{an object of class \code{ADEg} or \code{ADEgS}} \item{e2}{an object of class \code{ADEg} or \code{ADEgS} superposed on \code{e1}} \item{which}{if \code{g1} is an \code{ADEgS}, which \code{ADEg} is used as the base of superposition (\code{g2} is superposed on \code{g1[[which]]})} \item{plot}{a logical indicating if the graphics is displayed} } \details{ The created \code{ADEgS} object is a layout of two graphical objects. Each of the two objects superposed still have its graphical parameters in the created layout. However, the \code{ADEgS} displayed favour the graphical parameters of the object below : displayed limits, grid, legend and axes are those of \code{g1} (respectively \code{e1}) and \code{g2} (respectively \code{e2}) has transparent background and labels' boxes. The \code{superpose} method is defined for: \itemize{ \item{\code{signature(g1 = "ADEgS", g2 = "ADEg", which = "numeric", plot = "logical")}} \item{\code{signature(g1 = "ADEgS", g2 = "ADEg", which = "numeric", plot = "ANY")}} \item{\code{signature(g1 = "ADEgS", g2 = "ADEg", which = "missing", plot = "ANY")}: If \code{which} is \code{missing}, the last \code{ADEg} of \code{g1@ADEglist} is used as the base of superposition. In that case, \code{which = length(g1)}} \item{\code{signature(g1 = "ADEgORtrellis", g2 = "ADEgORtrellis", which = "ANY", plot = "ANY")}: If \code{g1} is an \code{ADEg} object, no \code{which} is needed.} \item{\code{signature(g1 = "ADEgS", g2 = "ADEgS", which = "missing", plot = "ANY")}} } The \code{+} method is defined for: \itemize{ \item{\code{signature(e1 = "ADEg", e2 = "ADEg")}: superpose e2 on e1} \item{\code{signature(e1 = "ADEg", e2 = "ADEgS")}: superpose e2 to e1} \item{\code{signature(e1 = "ADEgS", e2 = "ADEg")}: calls the \code{+} method with signature \code{(e1 = "ADEg", e2 = "ADEgS")}.} } } \value{ An object of class \code{"ADEgS"}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\link{add.ADEg}} \code{\linkS4class{ADEgS}} \code{\linkS4class{ADEg}} } \examples{ cha <- LETTERS[1:20] xy <- cbind.data.frame(runif(length(cha)), runif(length(cha))) g1 <- s.label(xy, labels = cha, ppoints.alpha = 0, pbackground.col = "grey85") g2 <- s.label(xy, labels = cha, plabels.cex = 0, paxes.draw = TRUE, ppoints.pch = 4, ppoints.col = "red") g3 <- superpose(g1, g2, plot = TRUE) g4 <- superpose(g2, g1, plot = TRUE) data(jv73, package = "ade4") pca1 <- ade4::dudi.pca(jv73$morpho, scannf = FALSE) g5 <- s.label(pca1$li, plabels.optim = TRUE) g6 <- s.class(pca1$li, jv73$fac.riv, starSize = 0, ellipseSize = 0, chullSize = 1, ppolygons.alpha = 0.4, col = rainbow(12), ppoints.cex = 0) g5 + g6 \dontrun{g7 <- s.label(pca1$li, plabels.optim = TRUE, facets = jv73$fac.riv, plot = FALSE) g8 <- s.class(pca1$li, jv73$fac.riv, facets = jv73$fac.riv, starSize = 0, chullSize = 1, ellipseSize = 0, ppolygons.alpha = 0.4, col = rainbow(12), ppoints.cex = 0, plot = FALSE) g9 <- superpose(g7, g8, plot = TRUE) } } \keyword{hplot} \keyword{methods} adegraphics/man/C1.barchart-class.Rd0000644000176200001440000000623313742303021016720 0ustar liggesusers\name{C1.barchart-class} \docType{class} \alias{C1.barchart} \alias{C1.barchart-class} \alias{prepare,C1.barchart-method} \alias{panel,C1.barchart-method} \title{Class \code{C1.barchart}} \description{ A class for the creation and display of a numeric score using barcharts. } \section{Objects from the Class}{ \code{C1.barchart} objects can be created by calls of the form \code{new("C1.barchart", ...)}. The regular usage in this package is to use the \code{s1d.barchart} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{score}: the displayed values in the form of a vector, a factor, a name or a matching call.} \item{\code{labels}: the labels' names drawn on the top of bars.} \item{\code{at}: the index value.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.C1} class. The specific slot for \code{C1.barchart} objects is: \itemize{ \item{\code{sort}: a logical indicating if \code{score} is sorted in ascending order.} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.C1}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.C1}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.C1}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.C1}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.C1"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{C1.barchart} are: \describe{ \item{prepare}{\code{signature(object = "C1.barchart")}: calls the parent method (\code{prepare} for \code{ADEg.C1}) and modifies some graphical parameters used by default.} \item{panel}{\code{signature(object = "C1.barchart")}: draws bar charts and labels.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.C1}} \code{\link{s1d.barchart}} } \examples{ showClass("C1.barchart") } \keyword{classes} adegraphics/man/ADEgS-class.Rd0000644000176200001440000002046213742303021015553 0ustar liggesusers\name{ADEgS-class} \docType{class} \alias{ADEgS-class} \alias{$,ADEgS-method} \alias{[,ADEgS,numeric,missing,logical-method} \alias{[,ADEgS,numeric,missing,missing-method} \alias{[[,ADEgS,numeric,missing-method} \alias{[[,ADEgS,character,missing-method} \alias{[[<-,ADEgS,numeric,missing,ADEg-method} \alias{[[<-,ADEgS,numeric,missing,ADEgS-method} \alias{getcall,ADEgS-method} \alias{getgraphics} \alias{getgraphics,ADEgS-method} \alias{getpositions} \alias{getpositions,ADEgS-method} \alias{length,ADEgS-method} \alias{names,ADEgS-method} \alias{names<-,ADEgS,character-method} \alias{show,ADEgS-method} \alias{plot,ADEgS-method} \alias{plot,ADEgS,ANY-method} \alias{print,ADEgS-method} \alias{update,ADEgS} \alias{update,ADEgS-method} \title{Class \code{"ADEgS"}} \description{ An object of \code{ADEgS} class is a complex graphic. This class allows the superposition, the insertion and/or the juxtaposition of several \code{ADEg}, \code{trellis} and/or \code{ADEgS} objects. The \code{ADEgS} class have neither father class nor son classes. } \section{Objects from the Class}{ \code{ADEgS} objects can be created by calls of the form \code{new("ADEgS", ...)}. The regular usage in this package is to use the \code{ADEgS}, \code{add.ADEg}, \code{superpose}, \code{insert} or \code{+} functions. } \section{Slots}{ \describe{ \item{\code{ADEglist}}{a list of several \code{trellis}, \code{ADEg} and/or \code{ADEgS} objects.} \item{\code{positions}}{a matrix with four columns and as many rows as the number of graphical objects in the \code{ADEglist} slot. For each simple graphic, i.e. in each row, the coordinates of the top-right and the bottom-left hand corners are in \code{npc} unit (normalized parent coordinates).} \item{\code{add}}{a square matrix with as many rows and columns as the number of graphical objects in the \code{ADEglist} slot. The value at the i-th row and j-th column is equal to 1 whether the j-th graphical object in the \code{ADEglist} slot is superpose to i-th graphical one. Otherwise, this value is equal to 0.} \item{\code{Call}}{an object of class \code{call}} } } \section{Methods}{ \describe{ \item{[}{\code{signature(x = "ADEgS", i = "numeric", j = "missing", drop = "logical")}: extracts the \code{i}-th sub-graphics in the \code{x@ADEglist}. \code{i} can be a vector. If \code{i} is a single number and if the extracted graphic in an \code{ADEg} object, the sub-selection is in the form of \code{ADEg} if \code{drop} is \code{TRUE} and in the form of \code{ADEgS} otherwise.} \item{[}{\code{signature(x = "ADEgS", i = "numeric", j = "missing", drop = "missing")}: the same than the previous method. \code{drop} is \code{FALSE} by default} \item{[[}{\code{signature(x = "ADEgS", i = "numeric", j = "missing")}: extracts one sub-graphic, the \code{i}-th one, in the \code{x@ADEglist}} \item{[[}{\code{signature(x = "ADEgS", i = "character", j = "missing")}: extracts one sub-graphic, named \code{i} in the \code{x@ADEglist}} \item{[[<-}{\code{signature(x = "ADEgS", i = "numeric", j = "missing", value = "ADEg")}: replaces one sub graphic, the \code{i}-th one, by an \code{ADEg} object in the \code{x@ADEglist}} \item{[[<-}{\code{signature(x = "ADEgS", i = "numeric", j = "missing", value = "ADEgS")}: replaces one sub graphic, the \code{i}-th one, by an \code{ADEgS} object in the \code{x@ADEglist}} \item{$}{\code{signature(x = "ADEgS")}: extracts one sub-graphic by its name in the \code{x@ADEglist}} \item{getpositions}{\code{signature(object = "ADEgS")}: returns the positions matrix of the object, i.e. \code{object@positions}} \item{getgraphics}{\code{signature(object = "ADEgS")}: returns the list of graphics of the object, i.e. \code{object@ADEglist}} \item{getcall}{\code{signature(object = "ADEgS")}: returns the call of the object, i.e. \code{object@Call}} \item{names}{\code{signature(object = "ADEgS")}: returns the graphics' names of the object, i.e. the names of \code{object@ADEglist}} \item{names<-}{\code{signature(object = "ADEgS")}: replaces the graphics' names of the object, i.e. the names of \code{object@ADEglist}} \item{length}{\code{signature(x = "ADEgS")}: returns the number of graphics into \code{x}, i.e. the length of \code{x@ADEglist}} \item{plot}{\code{signature(x = "ADEgS")}: same as \code{print}} \item{print}{\code{signature(x = "ADEgS")}: displays the graphical elements into one device using positions and superposition management (\code{x@add} matrix)} \item{show}{\code{signature(object = "ADEgS")}: same as \code{print}} \item{superpose}{\code{signature(g1 = "ADEgS", g2 = "ADEg", which = "numeric", plot = "logical")}: creates a new \code{"ADEgS"} object performing a superposition of \code{g2} on the which-th \code{ADEg} object of \code{g1}. This object is printed if \code{plot} is \code{TRUE}.} \item{superpose}{\code{signature(g1 = "ADEgS", g2 = "ADEg", which = "numeric", plot = "ANY")}: creates a new \code{"ADEgS"} object performing a superposition of \code{g2} on the which-th \code{ADEg} object of \code{g1}. This object is printed only if \code{plot} is \code{TRUE}.} \item{superpose}{\code{signature(g1 = "ADEgS", g2 = "ADEg", which = "missing", plot = "ANY")}: creates a new \code{"ADEgS"} object performing a superposition of \code{g2} on the last \code{ADEg} object of \code{g1}. This object is printed only if \code{plot} is \code{TRUE}.} \item{superpose}{\code{signature(g1 = "ADEgS", g2 = "ADEgS", which = "missing", plot = "ANY")}: creates a new \code{"ADEgS"} object performing a superposition between two \code{ADEgS} having the same length and the same \code{positions} slot. It is used when \code{g1} and \code{g2} are both created with a partition of individual groups, variables or analysis' axis.} \item{+}{\code{signature(e1 = "ADEg", e2 = "ADEgS")}: creates a new \code{"ADEgS"} object performing a superposition of \code{e1} on \code{e2}.} \item{+}{\code{signature(e1 = "ADEgS", e2 = "ADEg")}: creates a new \code{"ADEgS"} object performing a superposition of \code{e2} on \code{e1}.} \item{cbindADEg}{\code{signature(g1 = "ADEgORADEgS", g2 = "ADEgORADEgS")}: creates a new \code{"ADEgS"} object combining \code{g1} on \code{g2} by columns.} \item{rbindADEg}{\code{signature(g1 = "ADEgORADEgS", g2 = "ADEgORADEgS")}: creates a new \code{"ADEgS"} object combining \code{g1} on \code{g2} by rows.} \item{update}{\code{signature(object = "ADEgS")}: modifies the graphical parameters of each sub-graphics listed in \code{object@ADEglist} and/or the object's names (with the key word \code{names}) and/or the \code{object@positions} slot (with the key word \code{positions}), after creation of the \code{object}. The current display is updated and a modified object is returned.} \item{insert}{\code{signature(graphics = "ADEgS", oldgraphics = "missing", posi, ratio, inset, plot, which, dispatch)}: creates a new \code{"ADEgS"} object performing an insertion of \code{graphics} into the current device.} \item{insert}{\code{signature(graphics = "ADEgS", oldgraphics = "ADEg", posi, ratio, inset, plot)}: creates a new \code{"ADEgS"} object performing an insertion of \code{graphics} into \code{oldgraphics}.} \item{insert}{\code{signature(graphics = "ADEgORtrellis", oldgraphics = "ADEgS", posi, ratio, inset, plot, which)}: creates a new \code{"ADEgS"} object performing an insertion of \code{graphics} into \code{oldgraphics}.} \item{insert}{\code{signature(graphics = "ADEgS", oldgraphics = "ADEgS", posi, ratio, inset, plot, which, dispatch)}: creates a new \code{"ADEgS"} object performing an insertion of \code{graphics} into \code{oldgraphics}.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\link{ADEgS}} \code{\link{superpose}} \code{\link{insert}} } \examples{ showClass("ADEgS") } \keyword{classes} adegraphics/man/s1d.match.Rd0000644000176200001440000000432413742303021015346 0ustar liggesusers\name{s1d.match} \alias{s1d.match} \title{1-D plot of the matching between two numeric scores} \description{ This function represents paired scores with evenly spaced labels. } \usage{ s1d.match(score1, score2, labels = 1:NROW(score1), at = 0.5, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{score1}{a numeric vector (or a data frame) used to produce the plot} \item{score2}{a numeric vector used to produce the plot with as many values as values (or rows) in \code{score1}} \item{labels}{the labels' names drawn for each \code{score1} value} \item{at}{a numeric vector used as an index} \item{facets}{a factor splitting \code{score1} so that subsets % facets uniquement sur score1. quid de score2 of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ Graphical parameters for rugs are available in \code{plines} of \code{adegpar}. Some appropriated graphical parameters in \code{p1d} are also available. } \value{ An object of class \code{ADEg} (subclass \code{S1.match}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or data frame for \code{score} or data frame for \code{fac} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{S1.match}} \code{\linkS4class{ADEg.S1}} } \examples{ s1d.match(-5:5, 2 * (-5:5)) } \keyword{aplot} \keyword{hplot} adegraphics/man/s1d.label.Rd0000644000176200001440000000472413742303021015335 0ustar liggesusers\name{s1d.label} \alias{s1d.label} \title{1-D plot of a numeric score with labels} \description{ This function represents a numeric labeled score } \usage{ s1d.label(score, labels = 1:NROW(score), at = 0.5, poslabel = c("regular", "value"), facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{score}{a numeric vector (or a data frame) used to produce the plot} \item{labels}{the labels' names drawn for each \code{score} value} \item{at}{a numeric vector used as an index} \item{poslabel}{the label position, it can be \code{regular} or \code{value}. If \code{regular}, labels are evenly spaced. If \code{value}, labels are placed on the weighted mean of their class.} \item{facets}{a factor splitting \code{score} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ Graphical parameters for rugs are available in \code{plines} of \code{adegpar}. Some appropriated graphical parameters in \code{p1d} are also available. } \value{ An object of class \code{ADEg} (subclass \code{S1.label}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or data frame for \code{score} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{S1.label}} \code{\linkS4class{ADEg.S1}} } \examples{ data(meau, package = "ade4") envpca <- ade4::dudi.pca(meau$env, scannf = FALSE) g1 <- s1d.label(envpca$l1[, 1], row.names(envpca$l1), plot = FALSE) g2 <- s1d.label(envpca$co[, 1], row.names(envpca$co), p1d.reverse = TRUE, plot = FALSE) G <- ADEgS(c(g1, g2), layout = c(2, 1)) } \keyword{aplot} \keyword{hplot} adegraphics/man/S2.match-class.Rd0000644000176200001440000000637513742303021016256 0ustar liggesusers\name{S2.match-class} \docType{class} \alias{S2.match} \alias{S2.match-class} \alias{prepare,S2.match-method} \alias{panel,S2.match-method} \title{Class \code{S2.match}} \description{ A class for the creation and display of paired coordinates in a bi-dimensional plot. } \section{Objects from the Class}{ \code{S2.match} objects can be created by calls of the form \code{new("S2.match", ...)}. The regular usage in this package is to use the \code{s.match} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{dfxy}: the displayed values in the form of a data frame, a name or a matching call.} \item{\code{xax}: an integer or a vector indicating the columns of \code{dfxy} kept for the x-axes.} \item{\code{yax}: an integer or a vector indicating the columns of \code{dfxy} kept for the y-axes.} \item{\code{labels}: a vector of character strings containing the matches' labels.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S2} class. The specific slot for \code{S2.match} objects is: \itemize{ \item{\code{arrows}: a logical to draw arrows.} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.S2}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.S2}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.S2}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.S2}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.S2"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{S2.match} are: \describe{ \item{prepare}{\code{signature(object = "S2.match")}: calls the parent method (\code{prepare} for \code{ADEg.S2}) and modifies some graphical parameters used by default.} \item{panel}{\code{signature(object = "S2.match")}: draws arrows and labels.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.S2}} \code{\link{s.match}} } \examples{ showClass("S2.match") } \keyword{classes} adegraphics/man/S2.density-class.Rd0000644000176200001440000001006213742303021016625 0ustar liggesusers\name{S2.density-class} \docType{class} \alias{S2.density} \alias{S2.density-class} \alias{prepare,S2.density-method} \alias{panel,S2.density-method} \title{Class \code{S2.density}} \description{ A class for the creation and display of bi-dimensional plot with density estimation. } \section{Objects from the Class}{ \code{S2.density} objects can be created by calls of the form \code{new("S2.density", ...)}. The regular usage in this package is to use the \code{s.density} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{dfxy}: the displayed values in the form of a data frame, a name or a matching call.} \item{\code{xax}: an integer or a vector indicating the columns of \code{dfxy} kept for the x-axes.} \item{\code{yax}: an integer or a vector indicating the columns of \code{dfxy} kept for the y-axes.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S2} class. The specific slots for \code{S2.density} objects are: \itemize{ \item{\code{bandwidth}: bandwidth for density calculations which is passed in parameters in the \code{bkde2D} function of the \code{KernSmooth} package.} \item{\code{gridsize}: grid dimension.} \item{\code{threshold}: a value between 0 and 1 to draw densities greater than this threshold. No density is visible whether it is equal to 1.} \item{\code{col}: a \code{NULL} value, a color or a colors vector to color densities.} \item{\code{nrpoints}: number of points on the density image.} \item{\code{contour}: a logical to draw contour lines.} \item{\code{region}: a logical to fill grid regions with \code{col}.} \item{\code{nclass}: number of class for density.} }} \item{\code{stats}}{a list of internal preliminary calculations. The specific slot for \code{S2.density} objects is: \itemize{ \item{\code{densit}: a list containing the results of the \code{bkde2D} function.} }} \item{\code{s.misc}}{a list of some others internal parameters} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.S2}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.S2}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.S2}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.S2}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.S2"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{S2.density} are: \describe{ \item{prepare}{\code{signature(object = "S2.density")}: calls the parent method (\code{prepare} for \code{ADEg.S2}), modifies some graphical parameters used by default and calculates densities.} \item{panel}{\code{signature(object = "S2.density")}: draws densities and external points.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.S2}} \code{\link{s.density}} } \examples{ showClass("S2.density") } \keyword{classes} adegraphics/man/adegpar.Rd0000644000176200001440000002774413742303021015202 0ustar liggesusers\name{adegpar} \alias{adegpar} \title{Handling ADEg graphical parameters} \description{ \code{adegpar} can be used to set or query graphical parameters used in \code{ADEg} object display. It is inspired by the \code{par} function of \code{graphics} package. } \usage{ adegpar(...) } \arguments{ \item{\dots}{ If it is empty, the return value is a named list containing all the current settings. If it is a string of characters, the corresponding sub-list of parameters is return as information. If it is a list containing keys and values, the corresponding changes in current settings are made. } } \details{ The graphical parameters control apparency of the graphic. Calls can be made using either a list of list (e.g. \code{plabels = list(col = "red")}) or a list grouping both keys with "." (e.g. \code{plabels.col = "red"}). Parameters are re-used if needed in all \code{ADEg} object. If set globally, meaning using \code{adegpar}, all created objects afterwards will be affected. } \value{ Several parameters are used to create complete plot and accessible through \code{adegpar}. \describe{ \item{\code{p1d}:}{parameters for one-dimension graphic, object of class inherited from \code{"ADEg.S1"} or \code{"ADEg.C1"} \itemize{ \item{\code{horizontal}: a logical indicating if the plot is horizontal} \item{\code{reverse}: a logical indicating if the bottom of the plot is at the bottom (for \code{horizontal} as \code{TRUE}) or at the left of the device (for \code{horizontal} as \code{FALSE}). If FALSE, the graphical display bottom is at the top (for \code{horizontal} as \code{TRUE}) or at the right of the device (for \code{horizontal} as \code{FALSE}).} \item{\code{rug}: a list dedicated to tick marks \itemize{ \item{\code{draw}: a logical indicating if the rugs are drawn} \item{\code{tck}: size of the rug (ticks) in proportion from the reference line and the origin of the device (0.5 by default)} \item{\code{margin}: where to draw the reference line (0.07 by default)} \item{\code{line}: a logical indicating if the reference line is drawn using \code{porigin} arguments} }} }} \item{\code{parrows}:}{arrows' parameters. see \code{panel.arrows} for more information \itemize{ \item{\code{angle}: angle from the shaft of the arrow to the edge of the arrow head} \item{\code{ends}: kind of arrows to be drawn. Can be \code{first}, \code{last} or \code{both}} \item{\code{length}: length of the edges of the arrow head} }} \item{\code{paxes}:}{axis' parameters. Mostly inspired by \code{xyplot} function of \code{lattice} package \itemize{ \item{\code{aspectratio}: a character string to control physical aspect ratio of the graphic (drawing panel more specifically). \code{iso} for isometric scales, \code{fill} for drawing as big as possible or \code{xy} for banking rule} \item{\code{draw}: a logical indicating if axis (tick marks and labels) are drawn around the graphic} \item{\code{x}: a list used for the creation of x-axis in the \code{trellis} object. See \code{xyplot} for more information \itemize{ \item{\code{draw}: a logical indicating if x-axis (tick marks and labels) are drawn around the graphic} }} \item{\code{y}: the same list as for \code{x} with \code{draw} parameters} }} \item{\code{pbackground}:}{background's parameters \itemize{ \item{\code{col}: background color} \item{\code{box}: a logical indicating if a box is drawn surrounding the plot} }} \item{\code{pellipses}:}{ellipses' drawing parameters \itemize{ \item{\code{alpha}: a value between 0 and 1 controlling ellipses' background transparency} \item{\code{axes}: a list dedicated to ellipses' axis \itemize{ \item{\code{draw}: a logical indicating whether ellipses' axis are drawn} \item{\code{col}: ellipses' axis color} \item{\code{lty}: line type of ellipses' axis} \item{\code{lwd}: line width of ellipses' axis} }} \item{\code{border}: ellipses's border color} \item{\code{lty}: line type of ellipses' border} \item{\code{lwd}: line width of ellipses' border} \item{\code{col}: ellipses' background color} }} \item{\code{pgrid}:}{grid's drawing parameters \itemize{ \item{\code{draw}: a logical indicating if grid is drawn in the background} \item{\code{col}: grid's line color} \item{\code{lty}: line type of grid line} \item{\code{lwd}: line width of grid line} \item{\code{nint}: an integer indicating the number of grid intervals expected} \item{\code{text}: a list dedicated to grid legend text\itemize{ \item{\code{cex}: text size of grid legend} \item{\code{col}: text color of grid legend} \item{\code{pos}: a character string (\code{topright}, \code{topleft}, \code{bottomleft}, \code{bottomright}) or a vector of length 2 indicating text position of grid legend. If it is a vector, the default unit is \code{npc} (normalized parent coordinates).} }} }} \item{\code{plabels}:}{labels' drawing parameters \itemize{ \item{\code{alpha}: a value between 0 and 1 controlling label transparency} \item{\code{cex}: labels' text size} \item{\code{col}: labels' text color} \item{\code{srt}: labels' text orientation. It can be \code{horizontal}, \code{vertical} or an angle indication in degrees} \item{\code{optim}: a logical indicating if an algorithm is used to avoid labels' overlapping or outside limits} \item{\code{boxes}: label's boxes parameters \itemize{ \item{\code{draw}: a logical indicating if labels are framed} \item{\code{alpha}: a value between 0 and 1 controlling labels' boxes transparency} \item{\code{border}: boxes' border color} \item{\code{col}: boxes' background color} \item{\code{lty}: line type of boxes' border} \item{\code{lwd}: line width of boxes' border} }} }} \item{\code{plegend}:}{legend's drawing parameters (used for object of class inherited from \code{T.value} and \code{S2.value}) \itemize{ \item{\code{drawKey}: a logical indicating if the legend should be drawn. Legend can be provided by the \code{key} argument or is automatically generated for \code{*.class} and \code{*.value} functions} \item{\code{drawColorKey}: a logical indicating if the color legend should be drawn (only for \code{*.image} functions)} \item{\code{size}: size of the legend} }} \item{\code{plines}:}{lines' drawing parameters \itemize{ \item{\code{col}: lines color} \item{\code{lty}: lines type} \item{\code{lwd}: lines width} }} \item{\code{pnb}:}{drawing parameters for neighbourhood graph \itemize{ \item{\code{edge}: edge's drawing parameters \itemize{ \item{\code{col}: edge color} \item{\code{lty}: line type of edge} \item{\code{lwd}: line width of edge} }} \item{\code{node}: node's drawing parameters \itemize{ \item{\code{pch}: node's symbol type} \item{\code{cex}: node's symbol size} \item{\code{col}: node's symbol color} \item{\code{alpha}: a value between 0 and 1 controlling node's symbol transparency} }} }} \item{\code{porigin}:}{drawing parameters for origin's lines. See \code{panel.lines} for more information \itemize{ \item{\code{draw}: a logical indicating if vertical and horizontal lines are drawn to indicate origin} \item{\code{include}: a logical indicating if origin is included in the drawing limits} \item{\code{origin}: a two-length vector indicating origin coordinates} \item{\code{alpha}: a value between 0 and 1 controlling origin's lines transparency} \item{\code{col}: color of origin's lines} \item{\code{lty}: origin's line type} \item{\code{lwd}: origin's line width} }} \item{\code{ppalette}:}{a function taking one integer in argument indicating the number of expecting colors (for example using \code{colorRampPalette}) \itemize{ \item{\code{quanti}: \code{adegpar()$ppalette$quanti(n)} returns n colors shaded grey to white} \item{\code{quali}: \code{adegpar()$ppalette$quali(n, name)} returns \code{n} differentiated colors. \code{name} argument is passed to the \code{brewer.pal} function of the \code{RColorBrewer} package and must be \code{Accent}, \code{Dark2}, \code{Paired}, \code{Pastel1}, \code{Pastel2}, \code{Set1} (the default value), \code{Set2} or \code{Set3}. When \code{n} is equal to 2, values for 'white' and 'black' colors are returned and can be not quite visible on the display.} }} \item{\code{ppoints}:}{points' drawing paameters \itemize{ \item{\code{alpha}: a value between 0 and 1 controlling points transparency} \item{\code{cex}: points size} \item{\code{col}: points color} \item{\code{pch}: points type} \item{\code{fill}: points' background color (only for filled points type)} }} \item{\code{ppolygons}:}{polygons' drawing parameters (used for example to draw convex hull for \code{S2.class} or Gaussian curves for \code{C1.gauss} objects). See \code{lpolygon} for more information. \itemize{ \item{\code{border}: polygon's border color} \item{\code{col}: polygon's background color} \item{\code{lty}: line type of polygon border} \item{\code{lwd}: line width of polygon border} \item{\code{alpha}: a value between 0 and 1 controlling polygons' background transparency} }} \item{\code{pSp}:}{drawing parameters for spatial object \itemize{ \item{\code{col}: spatial object's background color} \item{\code{border}: spatial object's border color} \item{\code{lty}: line type of spatial object border} \item{\code{lwd}: line width of spatial object border} \item{\code{alpha}: a value between 0 and 1 controlling spatial object transparency} }} \item{\code{psub}:}{subtitle's drawing parameters \itemize{ \item{\code{cex}: text size of subtitle} \item{\code{col}: text color of subtitle} \item{\code{position}: a character string (\code{topright}, \code{topleft}, \code{bottomleft}, \code{bottomright}) or a vector of length 2 indicating text position of subtitle. If it is a vector, the default unit is \code{npc} (normalized parent coordinates).} \item{\code{text}: the character string to display} }} \item{\code{ptable}:}{for table graphic, object of class inherited from \code{ADEg.T} \itemize{ \item{\code{x}: x-axis parameters \itemize{ \item{\code{srt}: text rotation} \item{\code{pos}: position of the axis. It can be \code{top} or \code{bottom}. Otherwise axis and labels' axis are not drawn} \item{\code{tck}: ticks size} \item{\code{adj}: justification of labels} }} \item{\code{y}: same as \code{x} list, but for y-axis \itemize{ \item{\code{str}, \code{tck}, \code{adj}} \item{\code{pos}: position of the axis. It can be \code{left} or \code{right}. Otherwise axis and labels' axis are not drawn} }} \item{\code{margin}: margin surrounding the drawing panel. The numbers indicate the \code{bottom}, \code{left}, \code{top} and \code{right} margins. Results are obtained passing \code{margin} to padding argument in \code{lattice}. Please see \code{layout.heights} and \code{layout.widths} parameters in \code{lattice} package for more information} }} }} \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\link{par}} } \examples{ oldparamadeg <- adegpar() X <- data.frame(x = runif(50, -1, 2), y = runif(50, -1, 2)) s.label(X) names(adegpar()) adegpar("paxes.draw", "psub.cex") adegpar()$pback$col adegpar("paxes.draw" = TRUE, "psu.ce" = 3, "pback.col" = "grey85") s.label(X) adegpar(oldparamadeg) } \keyword{list} \keyword{color} adegraphics/man/getcall-methods.Rd0000644000176200001440000000114213742303021016633 0ustar liggesusers\name{getcall-methods} \docType{methods} \alias{getcall-methods} \alias{getcall} \title{Method for \code{ADEg} and \code{ADEgS} objects} \description{ \code{getcall} returns the call used to create the object. } \section{Methods}{ \describe{ \item{\code{signature(object = "ADEg")}}{ returns the slot \code{Call} of the object \code{ADEg}} \item{\code{signature(object = "ADEgS")}}{ returns the slot \code{Call} of the object \code{ADEgS}} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \keyword{methods} adegraphics/man/s.logo.Rd0000644000176200001440000000526413742303021014771 0ustar liggesusers\name{s.logo} \alias{s.logo} \title{2-D scatter plot with logos (bitmap objects)} \description{ This function represents a two dimensional scatter plot associating logos with points. } \usage{ s.logo(dfxy, logos, xax = 1, yax = 2, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{dfxy}{a data frame used to produce the plot} \item{logos}{a list containing the picture to use for each point} \item{xax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the x-axis} \item{yax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the y-axis} \item{facets}{a factor splitting the rows of \code{dfxy} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \value{ An object of class \code{ADEg} (subclass \code{S2.logo}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or vectors for \code{xax}/\code{yax} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{S2.logo}} \code{\linkS4class{ADEg.S2}} } \examples{ data(ggtortoises, package = "ade4") g1 <- s.logo(ggtortoises$pop, ggtortoises$ico[as.character(ggtortoises$pop$carap)], pori.incl = FALSE, ppoints.cex = 0.5) g1 <- s.label(ggtortoises$pop, add = TRUE, plabels.boxes.alpha = 0) g2 <- s.label(ggtortoises$misc, pgrid.draw = FALSE, porigin.include = FALSE, paxes.draw = FALSE, Sp = ggtortoises$Spatial, pback.col = "lightblue", pSp.col = "white") g2 <- s.logo(ggtortoises$pop, ggtortoises$ico[as.character(ggtortoises$pop$carap)], ppoints.cex = 0.5, add = TRUE) data(capitales, package = "ade4") g3 <- s.logo(capitales$xy[sort(rownames(capitales$xy)), ], capitales$logo, Sp = capitales$Spatial, pback.col = "lightblue", pSp.col = "white", pgrid.draw = FALSE) } \keyword{aplot} \keyword{hplot} adegraphics/man/S1.boxplot-class.Rd0000644000176200001440000000667713742303021016655 0ustar liggesusers\name{S1.boxplot-class} \docType{class} \alias{S1.boxplot} \alias{S1.boxplot-class} \alias{prepare,S1.boxplot-method} \alias{panel,S1.boxplot-method} \alias{setlatticecall,S1.boxplot-method} \title{Class \code{S1.boxplot}} \description{ A class for the representation of the link between a variable and a qualitative variable using box-and-whisker plots. } \section{Objects from the Class}{ \code{S1.boxplot} objects can be created by calls of the form \code{new("S1.boxplot", ...)}. The regular usage in this package is to use the \code{s1d.boxplot} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{score}: the displayed values in the form of a numeric vector, a name or a matching call.} \item{\code{fac}: a factor for \code{score} splitting in the form of a vector, a factor, a name or a matching call.} \item{\code{at}: the index value.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S1} class. The specific slot for \code{S1.boxplot} objects is: \itemize{ \item{\code{col}: a \code{NULL} value, a color or a colors vector to color points, labels, lines and polygons.} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.S1}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.S1}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.S1}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.S1}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.S1"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{S1.boxplot} are: \describe{ \item{prepare}{\code{signature(object = "S1.boxplot")}: calls the parent method (\code{prepare} for \code{ADEg.S1}) and modifies some graphical parameters used by default.} \item{panel}{\code{signature(object = "S1.boxplot")}: draws box-and-wiskers diagrams, mean points and labels.} \item{setlatticecall}{\code{signature(object = "S1.boxplot")}: prepares the \code{lattice.call} slot} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.S1}} \code{\link{s1d.boxplot}} } \examples{ showClass("S1.boxplot") } \keyword{classes} adegraphics/man/T.cont-class.Rd0000644000176200001440000000672513742303021016043 0ustar liggesusers\name{T.cont-class} \docType{class} \alias{T.cont} \alias{T.cont-class} \alias{panel,T.cont-method} \title{Class \code{T.cont}} \description{ A class for the representation of a contingency table object with statistical information (mean and regression lines). } \section{Objects from the Class}{ \code{T.cont} objects can be created by calls of the form \code{new("T.cont", ...)}. The regular usage in this package is to use the \code{table.value} function with a \code{table} object. } \section{Slots}{ \describe{ \item{\code{data}:}{a list containing data or data's name. \itemize{ \item{\code{dftab}: a contingency table object in the form of a data frame, a name or a matching call} \item{\code{coordsx}: an integer or a vector indicating the columns of \code{dftab} kept} \item{\code{coordsy}: an integer or a vector indicating the rows of \code{dftab} kept} \item{\code{labelsx}: the columns' labels} \item{\code{labelsy}: the rows' labels} \item{"\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{T.value} class. The specific slots for \code{T.cont} objects are: \itemize{ \item{\code{meanX}: a logical to represent columns' means by points.} \item{\code{meanY}: a logical to represent rows' means by points.} \item{\code{ablineX}: a logical to represent columns' regression lines.} \item{\code{ablineY}: a logical to represent columns' regression lines.} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{T.value}}, directly.\cr Class \code{\linkS4class{ADEg.T}}, by class \code{T.value}, distance 2.\cr Class \code{\linkS4class{ADEg}}, by class \code{T.value}, distance 3.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{T.value}, distance 4.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{T.value}, distance 4. } \section{Methods}{ The methods of the father classes \code{"T.value"}, \code{"ADEg.T"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{T.cont} are: \describe{ \item{panel}{\code{signature(object = "T.cont")}: draws mean points and regression lines.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.T}} \code{\linkS4class{T.value}} \code{\link{table.value}} } \examples{ showClass("T.cont") } \keyword{classes} adegraphics/man/S2.distri-class.Rd0000644000176200001440000000767713742303021016466 0ustar liggesusers\name{S2.distri-class} \docType{class} \alias{S2.distri} \alias{S2.distri-class} \alias{prepare,S2.distri-method} \alias{panel,S2.distri-method} \title{Class \code{S2.distri}} \description{ A class for distributions on a numeric score using a mean-standard deviation display. } \section{Objects from the Class}{ \code{S2.distri} objects can be created by calls of the form \code{new("S2.distri", ...)}. The regular usage in this package is to use the \code{s.distri} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{dfxy}: the displayed values in the form of a data frame, a name or a matching call.} \item{\code{dfdistri}: the mass distribution in which each column is a class.} \item{\code{xax}: an integer or a vector indicating the columns of \code{dfxy} kept for the x-axes.} \item{\code{yax}: an integer or a vector indicating the columns of \code{dfxy} kept for the y-axes.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S2} class. The specific slots for \code{S2.distri} objects are: \itemize{ \item{\code{ellipseSize}: \code{NULL} or number between 0 and 1 for ellipse size.} \item{\code{starSize}: \code{NULL} or number between 0 and 1 for star size.} \item{\code{col}: a \code{NULL} value, a color or a colors vector to color ellipses, labels, lines and polygons.} }} \item{\code{stats}}{a list of internal preliminary calculations. The specific slots for \code{S2.distri} objects are: \itemize{ \item{\code{means}: a matrix containing the weighted mean calculated for each class in\code{dfdistri}.} \item{\code{covvar}: a list containing the weighted variance-covariance matrices calculated for each class in\code{dfdistri}.} }} \item{\code{s.misc}}{a list of some others internal parameters: \itemize{ \item{\code{ellipses}: ellipses' coordinates.} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.S2}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.S2}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.S2}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.S2}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.S2"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{S2.distri} are: \describe{ \item{prepare}{\code{signature(object = "S2.distri")}: calls the parent method (\code{prepare} for \code{ADEg.S2}), modifies some graphical parameters used by default and calculates ellipses and centroids.} \item{panel}{\code{signature(object = "S2.distri")}: draws ellipses, stars, labels and points.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.S2}} \code{\link{s.distri}} } \examples{ showClass("S2.distri") } \keyword{classes} adegraphics/man/ADEg-class.Rd0000644000176200001440000001407213742303021015430 0ustar liggesusers\name{ADEg-class} \docType{class} \alias{ADEg} \alias{ADEg-class} \alias{add.ADEg,ADEg-method} \alias{getcall,ADEg-method} \alias{getlatticecall} \alias{getlatticecall,ADEg-method} \alias{getparameters} \alias{getparameters,ADEg-method} \alias{getstats} \alias{getstats-methods} \alias{getstats,ADEg-method} \alias{gettrellis} \alias{gettrellis-methods} \alias{gettrellis,ADEg-method} \alias{panelbase} \alias{panelbase-methods} \alias{panelbase,ADEg-method} \alias{printSuperpose,ADEgORtrellis,ADEgORtrellis-method} \alias{plot,ADEg-method} \alias{plot,ADEg,ANY-method} \alias{print,ADEg-method} \alias{show,ADEg-method} \alias{update,ADEg} \alias{update,ADEg-method} \title{Class \code{ADEg} } \description{ An object of \code{ADEg} class is a simple graphic. This object can be blended in with another one (superposition, insertion and/or juxtaposition) to form a more complex graphics (an \code{ADEgS} object). The \code{ADEg} class is a virtual class, i.e. a class which is not possible to create objects but which have heirs. This class has five son classes : \code{ADEg.S1}, \code{ADEg.S2}, \code{ADEg.C1}, \code{ADEg.T} and \code{ADEg.Tr}. } \section{Objects from the Class}{ None object of this class can be instantiated. } \section{Slots}{ \describe{ \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list of two elements to create the \code{trellis} object: \itemize{ \item{\code{graphictype}: the \code{lattice} function to use} \item{\code{arguments}: its parameters to obtain the \code{trellis} object} }} \item{\code{g.args}}{a list containing some parameters linked with the created object of \code{ADEg} class: \itemize{ \item{\code{xlim}, \code{ylim}} \item{\code{main}, \code{sub}} \item{\code{xlab}, \code{ylab}} \item{\code{samelimits}} \item{\code{scales}: a list of scales informations (ticks, marks and labels for the x-axis or the y-axis) in the form of the lattice argument \code{scales} in the \code{xyplot} function} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some other internal parameters} \item{\code{Call}}{an object of class \code{call}} } } \section{Methods}{ \describe{ \item{panelbase}{\code{signature(object = "ADEg")}: draws grid and text and produces graphical output from the graphical object} \item{getcall}{\code{signature(object = "ADEg")}: returns the \code{Call} slot} \item{getlatticecall}{\code{signature(object = "ADEg")}: returns the \code{lattice.call} slot} \item{getstats}{\code{signature(object = "ADEg")}: returns the \code{stats} slot} \item{getparameters}{\code{signature(object = "ADEg", number)}: if \code{number} is 1, returns the \code{trellis.par} slot, if it is 2, returns the \code{adeg.par} slot and if it is 0, returns the both slots} \item{add.ADEg}{\code{signature(object = "ADEg")}: superposes an ADEg on the current one plotted} \item{+}{\code{signature(e1 = "ADEg", e2 = "ADEg")}: superposes e2 on e1} \item{superpose}{\code{signature(g1 = "ADEgORtrellis", g2 = "ADEgORtrellis", which = "ANY", plot = "ANY")}: creates a new \code{ADEgS} object performing a superposition of \code{g2} on \code{g1}.} \item{printSuperpose}{\code{signature(g1 = "ADEgORtrellis", refg = "ADEgORtrellis")}: internal method, not for users.} \item{cbindADEg}{\code{signature(g1 = "ADEgORADEgS", g2 = "ADEgORADEgS")}: creates a new \code{"ADEgS"} object combining \code{g1} on \code{g2}.} \item{rbindADEg}{\code{signature(g1 = "ADEgORADEgS", g2 = "ADEgORADEgS")}: creates a new \code{"ADEgS"} object combining \code{g1} on \code{g2} by rows.} \item{insert}{\code{signature(graphics = "ADEgORtrellis", oldgraphics = "missing", posi, ratio, inset, plot, which)}: creates a new \code{ADEgS} object performing an insertion of \code{graphics} into the current device.} \item{insert}{\code{signature(graphics = "ADEgORtrellis", oldgraphics = "ADEg", posi, ratio, inset, plot)}: creates a new \code{ADEgS} object performing an insertion of \code{graphics} into \code{oldgraphics}.} \item{show}{\code{signature(x = "ADEg")}: prints the \code{ADEg} object} \item{plot}{\code{signature(x = "ADEg")}: prints the \code{ADEg} object} \item{print}{\code{signature(x = "ADEg")}: displays the \code{ADEg} object in the current device or in a new one} \item{update}{\code{signature(object = "ADEg")}: modifies graphical parameters after the \code{ADEg} creation, updates the current display and returns the modified \code{ADEg}} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \note{ For any \code{ADEg} creation, various graphical parameters can be passed into the dots (...) arguments. \itemize{ \item{the parameters listed in \code{adegpar()} can be changed, even if some of them do no modify the graphic representation chosen.} \item{the \code{lattice} parameters listed in \code{trellis.par.get()} can also be changed.} \item{limits, main and sub title, and axes labels can be changed using the keys \code{xlim}, \code{ylim}, \code{main}, \code{sub}, \code{xlab} and \code{ylab}.} \item{a neighbouring graph (object of class \code{nb} or \code{listw}) and a spatial one (object of class \code{sp}) can be display in the background using the keys \code{nbobject}, \code{Sp} and \code{sp.layout}.} } } \seealso{ \code{\linkS4class{ADEgS}} \code{\link{adegpar}} \code{\link{superpose}} \code{\link{insert}} } \examples{ showClass("ADEg") } \keyword{classes} adegraphics/man/triangle.traject.Rd0000644000176200001440000000647714572567100017053 0ustar liggesusers\name{triangle.traject} \alias{triangle.traject} \title{Ternary plot with trajectories} \description{ This function represents a three dimensional scatter plot with trajectories. } \usage{ triangle.traject(dfxyz, fac = gl(1, nrow(dfxyz)), order, labels = levels(fac), col = NULL, adjust = TRUE, min3d = NULL, max3d = NULL, showposition = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{dfxyz}{a three columns data frame, the first system of coordinates, used to produce the plot} \item{fac}{a factor (or a matrix of factors) splitting the rows of \code{dfxyz}} \item{order}{a vector containing the drawing order of the trajectories. A vector of length equal to factor.} \item{labels}{a vector of character strings containing the trajectories' labels} \item{col}{a color or a colors vector to color points, labels and lines} \item{adjust}{a logical to adjust the device with the limits of the smaller equilateral triangle containing the values} \item{min3d}{a vector of three values for triangular minimal limits} \item{max3d}{a vector of three values for triangular maximal limits} \item{showposition}{a logical indicating whether the used triangle should be shown in the complete one} \item{facets}{a factor splitting the rows of \code{dfxyz} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ The \code{fac} factor is used to display several trajectories: each level of \code{fac} is a specific trajectory. } \value{ An object of class \code{ADEg} (subclass \code{Tr.traject}) or \code{ADEgS} (if \code{showposition} is TRUE, if \code{add} is \code{TRUE} and/or if facets are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{Tr.traject}} \code{\linkS4class{ADEg.Tr}} } \examples{ exo1 <- matrix(c(51.88, 32.55, 15.57, 44.94, 34.59, 20.47, 25.95, 39.15, 34.9, 37.87, 43.19, 18.94, 34.2, 43.32, 22.48, 16.13, 42.18, 41.69, 7.76, 70.93, 21.31, 6.22, 65.96, 27.82, 6.44, 57.06, 36.5, 37.24, 32.45, 30.31, 16.09, 31.22, 52.69, 6.54, 24.68, 68.78), ncol = 3, byr = TRUE) exo1 <- as.data.frame(exo1) names(exo1) <- c("agr", "ouv", "ter") com <- as.factor(rep(c("Gig", "Lun", "Gan", "Mat"), c(3, 3, 3, 3))) rec <- as.factor(rep(c("68", "75", "82"), 4)) row.names(exo1) <- paste(com, rec, sep = "") tri1 <- triangle.traject(exo1, fac = com, showposition=FALSE, pgrid.draw = FALSE, col = TRUE, axis.text = list(cex = 0)) } \keyword{hplot} \keyword{aplot} adegraphics/man/plot.Rd0000644000176200001440000002525314511521731014553 0ustar liggesusers\name{plot} \alias{kplot} \alias{kplot.foucart} \alias{kplot.mcoa} \alias{kplot.mfa} \alias{kplot.mbpcaiv} \alias{kplot.pta} \alias{kplot.sepan} \alias{kplotsepan.coa} \alias{kplot.statis} \alias{plot} \alias{plot.acm} \alias{plot.betcoi} \alias{plot.betrlq} \alias{plot.betdpcoa} \alias{plot.betwitdpcoa} \alias{plot.between} \alias{plot.coinertia} \alias{plot.discrimin} \alias{plot.dpcoa} \alias{plot.fca} \alias{plot.foucart} \alias{plot.krandboot} \alias{plot.krandxval} \alias{plot.mcoa} \alias{plot.mfa} \alias{plot.multiblock} \alias{plot.multispati} \alias{plot.niche} \alias{plot.pcaiv} \alias{plot.procuste} \alias{plot.randboot} \alias{plot.randxval} \alias{plot.rlq} \alias{plot.pta} \alias{plot.sepan} \alias{plot.statis} \alias{plot.witcoi} \alias{plot.witdpcoa} \alias{plot.within} \alias{plot.witrlq} \alias{plot.bcaloocv} \alias{plot.discloocv} \alias{scatter} \alias{scatter.coa} \alias{scatter.dudi} \alias{scatter.nipals} \alias{scatter.pco} \alias{score} \alias{score.acm} \alias{score.mix} \alias{score.pca} \alias{screeplot} \alias{screeplot.dudi} \alias{biplot} \alias{biplot.dudi} \title{Methods to display the outputs of an analysis performed with \code{ade4}} \description{ S3 methods to display the outputs of an analysis performed with \code{ade4} } \usage{ \method{kplot}{foucart}(object, xax = 1, yax = 2, which.tab = 1:length(object$blo), pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{kplot}{mcoa}(object, xax = 1, yax = 2, which.tab = 1:nrow(object$cov2), option = c("points", "axis", "columns"), pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{kplot}{mfa}(object, xax = 1, yax = 2, which.tab = 1:length(object$blo), traject = FALSE, permute = FALSE, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{kplot}{mbpcaiv}(object, xax = 1, yax = 2, which.tab = 1:length(object$blo), pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{kplot}{pta}(object, xax = 1, yax = 2, which.tab = 1:nrow(object$RV), which.graph = 1:4, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{kplot}{sepan}(object, xax = 1, yax = 2, which.tab = 1:length(object$blo), permute = FALSE, traject = FALSE, posieig = "bottomleft", pos = -1, storeData = TRUE, plot = TRUE, \dots) kplotsepan.coa(object, xax = 1, yax = 2, which.tab = 1:length(object$blo), permute = FALSE, posieig = "bottomleft", pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{kplot}{statis}(object, xax = 1, yax = 2, which.tab = 1:length(object$tab.names), traject = FALSE, arrow = TRUE, class = NULL, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{acm}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{betcoi}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{betdpcoa}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{betwitdpcoa}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{betrlq}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{between}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{coinertia}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{discrimin}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{dpcoa}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{fca}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{foucart}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{krandboot}(x, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{krandxval}(x, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{mcoa}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{mfa}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{multiblock}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{multispati}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{niche}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{pcaiv}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{pta}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{procuste}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{randboot}(x, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{randxval}(x, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{rlq}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{sepan}(x, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{statis}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{witcoi}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{witdpcoa}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{within}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{witrlq}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{bcaloocv}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{plot}{discloocv}(x, xax = 1, yax = 2, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{scatter}{dudi}(x, xax = 1, yax = 2, permute = FALSE, posieig = "topleft", prop = FALSE, density.plot = ifelse(permute, ncol(x$tab) > 1000, nrow(x$tab) > 1000), plot = TRUE, storeData = TRUE, pos = -1, \dots) \method{scatter}{coa}(x, xax = 1, yax = 2, method = 1:3, posieig = "topleft", pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{scatter}{pco}(x, xax = 1, yax = 2, posieig = "topleft", pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{scatter}{nipals}(x, xax = 1, yax = 2, posieig = "topleft", pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{score}{acm}(x, xax = 1, which.var = NULL, type = c("points", "boxplot"), pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{score}{mix}(x, xax = 1, which.var = NULL, type = c("points", "boxplot"), pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{score}{pca}(x, xax = 1, which.var = NULL, pos = -1, storeData = TRUE, plot = TRUE, \dots) \method{screeplot}{dudi}(x, col.kept = "grey", col = "white", pos = -1, plot = TRUE, \dots) \method{biplot}{dudi}(x, pos = -1, plot = TRUE, \dots) } \arguments{ \item{object, x}{objects used to select a method} \item{xax}{an integer (or a vector) indicating which column(s) of \code{object} or \code{x} is(are) plotted on the x-axis} \item{yax}{an integer (or a vector) indicating which column(s) of \code{object} or \code{x} is(are) plotted on the y-axis} \item{which.tab}{a numeric vector (used in \code{kplot.*}) containing the numbers of the tables used for the analysis} \item{option}{a string of characters (only used in \code{kplot.mfa}) indicating the drawing option: \code{points} plot of the projected scattergram onto the co-inertia axes, \code{axis} projections of inertia axes onto the co-inertia axes, \code{columns} projections of variables onto the synthetic variables planes.} \item{which.graph}{an integer between 1 and 4 (only used in \code{kplot.pta}) indicating the drawing option. For each table of \code{which.tab}, are drawn: \code{1} the projections of the principal axes, \code{2} the projections of the rows, \code{3} the projections of the columns, \code{4} the projections of the principal components onto the planes of the compromise.} \item{permute}{a logical value (used in \code{kplot.sepan}, \code{kplotsepan.coa} and \code{scatter.dudi}). If \code{FALSE}, the rows are plotted by points or density surface and the columns by arrows. If \code{TRUE}, it is the opposite.} \item{traject}{a logical value (used in \code{kplot.sepan} and \code{kplot.statis}) indicating whether the trajectories between rows should be drawn in a natural order} \item{posieig}{a character value or a two-length numeric vector (in normalized parent coordinates \code{npc} from 0 to 1) or \code{none} value indicating the position of the eigenvalues bar plot (used in \code{kplot.sepan}, \code{kplotsepan.coa} and \code{scatter.*}).} \item{arrow}{a logical value (only used in \code{kplot.statis}) indicating whether the column factorial diagrams should be plotted} \item{class}{if not NULL, a factor of length equal to the number of the total columns of the K-tables (only used in \code{kplot.statis})} \item{prop}{a logical value (only used in \code{scatter.dudi}) indicating if the size of the arrows' labels is proportional to the analysis score.} \item{density.plot}{a logical value (only used in \code{scatter.dudi})indicating if the points are displayed as density surface (using \code{s.density}).} \item{method}{an integer between 1 and 3 (only used in \code{scatter.coa}) indicating the drawing option. Are drawn: \code{1} rows and columns with the coordinates of lambda variance, \code{2} rows variance 1 and columns by averaging, \code{3} columns variance 1 and rows by averaging.} \item{which.var}{the numbers of the kept columns for the analysis, otherwise all columns (used in \code{score.*})} \item{type}{a string of characters (only used in \code{score.acm} and \code{score.mix}) indicating if points (\code{points}) or boxplot (\code{boxplot}) are used to represent levels of factors} \item{col.kept}{one color value to color the kept axes in the barchart (used in \code{screeplot.dudi})} \item{col}{one color value to color the axes in the barchart (used in \code{screeplot.dudi})} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \value{ Returns an \code{ADEg} or an \code{ADEgS} object. The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \references{ See \code{ade4} website: } \examples{ cat("To run the example on 'topic'\n") cat("Type in your R console: example(topic, package = 'ade4') \n") } \keyword{hplot} \keyword{methods} \keyword{multivariate} adegraphics/man/triangle.match.Rd0000644000176200001440000000502614572562616016507 0ustar liggesusers\name{triangle.match} \alias{triangle.match} \title{Ternary plot of the matching between two sets of coordinates} \description{ This function represents a three dimensional scatter plot of paired coordinates. } \usage{ triangle.match(dfxyz1, dfxyz2, labels = row.names(as.data.frame(dfxyz1)), min3d = NULL, max3d = NULL, adjust = TRUE, showposition = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{dfxyz1}{a three columns data frame, the first system of coordinates, used to produce the plot} \item{dfxyz2}{a three columns data frame, the second system of coordinates, with as many rows as \code{dfxyz1}, used to produce the plot.} \item{labels}{a vector of character strings containing the matches' labels} \item{adjust}{a logical to adjust the device with the limits of the smaller equilateral triangle containing the values} \item{min3d}{a vector of three values for triangular minimal limits} \item{max3d}{a vector of three values for triangular maximal limits} \item{showposition}{a logical indicating whether the used triangle should be shown in the complete one} \item{facets}{a factor splitting the rows of \code{dfxyz} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \value{ An object of class \code{ADEg} (subclass \code{Tr.match}) or \code{ADEgS} (if \code{showposition} is TRUE, if \code{add} is \code{TRUE} and/or if facets are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{Tr.match}} \code{\linkS4class{ADEg.Tr}} } \examples{ data(euro123, package = "ade4") triangle.match(euro123$in78, euro123$in86, plabels.cex = 0.8) } \keyword{hplot} \keyword{aplot} adegraphics/man/s.label.Rd0000644000176200001440000000514013742303021015101 0ustar liggesusers\name{s.label} \alias{s.label} \title{2-D scatter plot with labels} \description{ This function represents a two dimensional scatter plot associating labels with points. } \usage{ s.label(dfxy, labels = rownames(dfxy), xax = 1, yax = 2, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{dfxy}{a data frame used to produce the plot} \item{labels}{a vector of character strings for the points' labels} \item{xax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the x-axis} \item{yax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the y-axis} \item{facets}{a factor splitting the rows of \code{dfxy} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \value{ An object of class \code{ADEg} (subclass \code{S2.label}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or vectors for \code{xax}/\code{yax} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{S2.label}} \code{\linkS4class{ADEg.S2}} } \examples{ x0 <- runif(50, -2, 2) y0 <- runif(50, -2, 2) z <- x0 ^ 2 + y0 ^ 2 g1 <- s.label(data.frame(x0, y0), label = as.character(z < 1), paxes.draw = TRUE, axis.text = list(col = "grey")) data(mafragh, package = "ade4") g2 <- s.label(mafragh$xy, nb = mafragh$nb, paxes.draw = FALSE) data(irishdata, package = "ade4") g3 <- s.label(irishdata$xy.utm, Sp = irishdata$Spatial.contour) ## update irishdata$xy.utm call to irishdata$xy \dontrun{data(atlas, package = "ade4") g4 <- s.label(atlas$xy, lab = atlas$names.district, Sp = atlas$Spatial.contour) g5 <- s.label(atlas$xy, lab = atlas$names.district, Sp = atlas$Spatial) } } \keyword{aplot} \keyword{hplot} adegraphics/man/adegraphics-internal.Rd0000644000176200001440000000113413742303021017644 0ustar liggesusers\name{internals} \alias{ADEgORtrellis} \alias{ADEgORtrellis-class} \alias{ADEgORADEgSORtrellis} \alias{ADEgORADEgSORtrellis-class} \alias{axis.L} \alias{setlatticecall} \alias{setlatticecall-methods} \alias{setvalueskey} \alias{printSuperpose} \alias{printSuperpose-methods} \alias{as.raster.pixmapGrey} \alias{as.raster.pixmapRGB} \alias{panel.symbols.grid} \title{For internal use only} \description{ Internal classes, methods and functions. Not for users. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \keyword{internal}adegraphics/man/C1.dotplot-class.Rd0000644000176200001440000000562413742303021016622 0ustar liggesusers\name{C1.dotplot-class} \docType{class} \alias{C1.dotplot} \alias{C1.dotplot-class} \alias{prepare,C1.dotplot-method} \alias{panel,C1.dotplot-method} \title{Class \code{C1.dotplot}} \description{ A class for the creation and display of a numeric score using dots. } \section{Objects from the Class}{ \code{C1.dotplot} objects can be created by calls of the form \code{new("C1.dotplot", ...)}. The regular usage in this package is to use the \code{s1d.dotplot} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{score}: the displayed values in the form of a vector, a factor, a name or a matching call.} \item{\code{at}: the index value.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.C1} class.} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.C1}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.C1}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.C1}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.C1}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.C1"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{C1.dotplot} are: \describe{ \item{prepare}{\code{signature(object = "C1.dotplot")}: calls the parent method (\code{prepare} for \code{ADEg.C1}) and modifies some graphical parameters used by default.} \item{panel}{\code{signature(object = "C1.dotplot")}: draws segments and dots.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.C1}} \code{\link{s1d.dotplot}} } \examples{ showClass("C1.dotplot") } \keyword{classes} adegraphics/man/Tr.traject-class.Rd0000644000176200001440000000721013742303021016704 0ustar liggesusers\name{Tr.traject-class} \docType{class} \alias{Tr.traject} \alias{Tr.traject-class} \alias{prepare,Tr.traject-method} \alias{panel,Tr.traject-method} \title{Class \code{Tr.traject}} \description{ A class for the creation and display of triangular plot with trajectories linking the points. } \section{Objects from the Class}{ \code{Tr.traject} objects can be created by calls of the form \code{new("Tr.traject", ...)}. The regular usage in this package is to use the \code{triangle.traject} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{dfxyz}: the displayed values in the form of a three columns data frame, a name or a matching call.} \item{\code{fac}: a factor (or a matrix of factors) splitting the rows of \code{dfxyz}.} \item{\code{labels}: a vector of character strings containing the trajectories' labels.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.Tr} class. The specific slots for \code{Tr.traject} objects are: \itemize{ \item{\code{max3d} and \code{min3d}: vectors of three values for triangular maximal and minimal limits.} \item{\code{adjust}: a logical to adjust the device with the limits of the smaller equilateral triangle containing the values} \item{\code{order}: a vector containing the drawing order of the trajectories. A vector of length equal to factor.} \item{\code{col}: a \code{NULL} value, a color or a colors vector to color points, labels and lines.} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.Tr}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.Tr}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.Tr}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.Tr}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.Tr"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{Tr.traject} are: \describe{ \item{prepare}{\code{signature(object = "Tr.traject")}: calls the parent method (\code{prepare} for \code{ADEg.Tr}) and modifies some graphical parameters used by default.} \item{panel}{\code{signature(object = "Tr.traject")}: draws arrows, labels and points.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.Tr}} \code{\link{triangle.traject}} } \examples{ showClass("Tr.traject") } \keyword{classes} adegraphics/man/ADEg.S2-class.Rd0000644000176200001440000001177713742303021015724 0ustar liggesusers\name{ADEg.S2-class} \docType{class} \alias{ADEg.S2} \alias{ADEg.S2-class} \alias{prepare,ADEg.S2-method} \alias{setlatticecall,ADEg.S2-method} \alias{gettrellis,ADEg.S2-method} \alias{panelbase,ADEg.S2-method} \title{Class \code{ADEg.S2}} \description{ An object of \code{ADEg.S2} class represents bi-dimensional data. The \code{ADEg.S2} class is a virtual class, i.e. a class which is not possible to create objects but which have heirs. This class inherits from \code{ADEg} class and has eleven son classes : \code{S2.arrow}, \code{S2.class}, \code{S2.corcircle}, \code{S2.density}, \code{S2.distri}, \code{S2.image}, \code{S2.label}, \code{S2.logo}, \code{S2.match}, \code{S2.traject} and \code{S2.value}. } \section{Objects from the Class}{ None object of this class can be instantiated. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{dfxy}: the displayed values in the form of a data frame, a name or a matching call.} \item{\code{xax}: an integer or a vector indicating the columns of \code{dfxy} kept for the x-axes.} \item{\code{yax}: an integer or a vector indicating the columns of \code{dfxy} kept for the y-axes.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list of two elements to create the \code{trellis} object: \itemize{ \item{\code{graphictype}: \code{xyplot}} \item{\code{arguments}: its parameters to obtain the \code{trellis} object} }} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S2} class: \itemize{ \item{\code{fullcircle}: only for \code{S2.corcircle} objects} \item{\code{method}: only for \code{S2.value} objects} \item{\code{symbol}: only for \code{S2.value} objects} \item{\code{center}: only for \code{S2.value} objects} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters: \itemize{ \item{\code{xfullcircle.update} and \code{yfullcircle.update}: a logical indicating if the circle size is updating (only for \code{S2.corcircle} objects)} \item{\code{plegend.update}: a logical indicating if the legend parameters are updating} \item{\code{breaks.update}: a logical indicating if the legend breaks are updating} \item{\code{backgrid}: a list of elements for grid lines} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg}}, directly. } \section{Methods}{ \describe{ \item{prepare}{\code{signature(object = "ADEg.S2")}: performs the calculations before display the object (e.g. limits, grid and axis calculations)} \item{setlatticecall}{\code{signature(object = "ADEg.S2")}: prepares the \code{lattice.call} slot} \item{panelbase}{\code{signature(object = "ADEg.S2")}: defines the graphical background (e.g. grid and box)} \item{gettrellis}{\code{signature(object = "ADEg.S2")}: converts the graphic into a \code{trellis} object of \code{lattice} class} \item{zoom}{\code{signature(object = "ADEg.S2", zoom = "numeric", center = "missing")}: performs a zoom in (if zoom < 1) or out (if zoom > 1) centered} \item{zoom}{\code{signature(object = "ADEg.S2", zoom = "numeric", center = "numeric")}: performs a zoom in (if zoom < 1) or out (if zoom > 1) around the center passed in parameter (center should be a two-length vector)} \item{addhist}{\code{signature(object = "ADEg.S2")}: adds histograms and density lines against a bi-dimensional graphics} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\link{addhist}} \code{\link{zoom}} \code{\link{adegpar}} \code{\linkS4class{S2.arrow}} \code{\linkS4class{S2.class}} \code{\linkS4class{S2.corcircle}} \code{\linkS4class{S2.density}} \code{\linkS4class{S2.distri}} \code{\linkS4class{S2.image}} \code{\linkS4class{S2.label}} \code{\linkS4class{S2.logo}} \code{\linkS4class{S2.match}} \code{\linkS4class{S2.traject}} \code{\linkS4class{S2.value}} \code{\linkS4class{ADEg}} } \examples{ showClass("ADEg.S2") } \keyword{classes} adegraphics/man/S2.class-class.Rd0000644000176200001440000001027113742303021016255 0ustar liggesusers\name{S2.class-class} \docType{class} \alias{S2.class-class} \alias{S2.class} \alias{prepare,S2.class-method} \alias{panel,S2.class-method} \title{Class \code{S2.class}} \description{ A class for group representation in bi-dimensional plot. } \section{Objects from the Class}{ \code{S2.class} objects can be created by calls of the form \code{new("S2.class", ...)}. The regular usage in this package is to use the \code{s.class} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{dfxy}: the displayed values in the form of a data frame, a name or a matching call.} \item{\code{fac}: a factor (or a matrix of factors) splitting the rows of \code{dfxy}.} \item{\code{xax}: an integer or a vector indicating the columns of \code{dfxy} kept for the x-axes.} \item{\code{yax}: an integer or a vector indicating the columns of \code{dfxy} kept for the y-axes.} \item{\code{wt}: a vector of weights for \code{fac}.} \item{\code{labels}: a vector containing the class' labels.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S2} class. The specific slots for \code{S2.class} objects are: \itemize{ \item{\code{ellipseSize}: a positive number for ellipse size.} \item{\code{starSize}: a number between 0 and 1 for star size.} \item{\code{chullSize}: \code{NULL} or a vector of numbers between 0 and 1 for the convex hulls.} \item{\code{col}: a logical or a vector of colors that apply to points, ellipses, labels, lines and polygons.} }} \item{\code{stats}}{a list of internal preliminary calculations. The specific slots for \code{S2.class} objects are: \itemize{ \item{\code{means}: a matrix containing the weighted mean calculated for each \code{fac} value.} \item{\code{covvar}: a list containing the weighted variance-covariance matrices calculated for each \code{fac} value.} }} \item{\code{s.misc}}{a list of some others internal parameters: \itemize{ \item{\code{ellipses}: ellipses' coordinates.} \item{\code{chullcoord}: convex hulls' coordinates.} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.S2}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.S2}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.S2}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.S2}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.S2"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{S2.class} are: \describe{ \item{prepare}{\code{signature(object = "S2.class")}: calls the parent method (\code{prepare} for \code{ADEg.S2}), modifies some graphical parameters used by default and calculates ellipses, convex hulls and centroids.} \item{panel}{\code{signature(object = "S2.class")}: draws ellipses, convex hulls, stars, labels and points.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.S2}} \code{\link{s.class}} } \examples{ showClass("S2.class") } \keyword{classes} adegraphics/man/addhist.Rd0000644000176200001440000000604113742303021015202 0ustar liggesusers\name{addhist} \alias{addhist} \alias{addhist-methods} \alias{addhist,ADEg.S2-method} \title{ Adds histograms and density lines against a bi-dimensional graphics. } \description{ Adds the two marginal histograms and density lines of each axis against an \code{ADEg.S2} object. } \usage{ addhist(object, bandwidth, gridsize = 60, kernel = "normal", cbreaks = 2, storeData = TRUE, plot = TRUE, pos = -1, ...) } \arguments{ \item{object}{an \code{ADEg.S2} object } \item{bandwidth}{used for the calculations of the density lines (see the \code{bkde} function of the \code{KernSmooth} package). } \item{gridsize}{used for the calculations of the density lines (see the \code{bkde} function of the \code{KernSmooth} package). } \item{kernel}{used for the calculations of the density lines (see the \code{bkde} function of the \code{KernSmooth} package). } \item{cbreaks}{number of cells for the histograms per interval of the grid of the bi-dimensional graphics. } \item{plot}{a logical indicating if the graphics is displayed } \item{storeData}{a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored } \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE} } \item{\dots}{Additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}}) } } \details{ Density is calculated using the function \code{bkde} of the \code{KernSmooth} package. } \value{ An \code{ADEgS} object, a list of four graphical objects, one \code{ADEg.S2} and three \code{trellis} (from \code{lattice}). Their names are: \item{\code{object}}{the \code{ADEg.S2} object} \item{\code{densX}}{top histogram, a \code{trellis} object} \item{\code{densY}}{right histogram, a \code{trellis} object} \item{\code{link}}{corner graphics linking the two histograms, a \code{trellis} object} } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \note{ Into the dots arguments, the usual parameters for the \code{s.label} can be given with the \code{object} key. Trellis parameters are used for the three remaining graphics. \code{plot.polygon} handles the histogram aspect, \code{add.line} the graduations lines and \code{plot.line} the density lines. Finally, for the \code{link} graphic, labels aspect can be changed using a \code{plabels} list, as for an \code{S2.label} object. } \seealso{ \code{\linkS4class{ADEg.S2}} \code{\linkS4class{ADEgS}} } \examples{ data(rpjdl, package = "ade4") coa1 <- ade4::dudi.coa(rpjdl$fau, scannf = FALSE, nf = 4) labli <- s.label(coa1$li) g1 <- addhist(labli) g2 <- addhist(labli, plabels.cex = 0, cbreaks = 3) labco <- s.label(coa1$co) g3 <- addhist(labco, plabels.cex = 0, cbreaks = 3) update(g3, pbackground.col = "grey85") } \keyword{aplot} adegraphics/man/s.class.Rd0000644000176200001440000001105013742303021015124 0ustar liggesusers\name{s.class} \alias{s.class} \title{2-D scatter plot with a partition in classes (levels of a factor)} \description{ This function represents a two dimensional scatter plot grouping points to the same class. Classes are represented by ellipses, stars and/or convex hulls. } \usage{ s.class(dfxy, fac, xax = 1, yax = 2, wt = rep(1, NROW(fac)), labels = levels(fac), ellipseSize = 1.5, starSize = 1, chullSize = NULL, col = NULL, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{dfxy}{a data frame used to produce the plot} \item{fac}{a factor (or a matrix of factors) splitting the rows of \code{dfxy}} \item{xax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the x-axis} \item{yax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the y-axis} \item{wt}{a vector of weights for \code{fac}} \item{labels}{a character vector containing the class' labels} \item{ellipseSize}{a positive number for ellipse size} \item{starSize}{a number between 0 and 1 for the size of the stars segments joining the stars' center (centroids) and the matching points} \item{chullSize}{\code{NULL} or a vector of numbers between 0 and 1 for the fraction of points included in the convex hull} \item{col}{a color or a colors vector to color points, ellipses, labels, lines and polygons} \item{facets}{a factor splitting the rows of \code{dfxy} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ Graphical parameters for ellipses, stars and convex hulls are available in \code{pellipses}, \code{plines} and \code{ppolygons} of \code{adegpar}. } \value{ An object of class \code{ADEg} (subclass \code{S2.class}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or multidimensional \code{fac} or vectors for \code{xax}/\code{yax} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{S2.class}} \code{\linkS4class{ADEg.S2}} } \examples{ xy <- cbind.data.frame(x = runif(200, -1, 1), y = runif(200, -1, 1)) posi <- factor(xy$x > 0) : factor(xy$y > 0) coul <- c("black", "red", "green", "blue") s.class(xy, fac = posi, col = coul, psub.text = "example s.class", pellipses.col = coul) s.class(xy, fac = posi, ppoints.cex = 1.5, ellipseSize = 0, starSize = 0, ppolygons = list(border = 4:1, col = 1:4, lty = 1:4, lwd = 2, alpha = 0.4), chullSize = c(1, 0.5)) s.class(xy, fac = posi, facets = posi, ppoints.cex = 1.5, ellipseSize = 0, starSize = 0, ppolygons = list(border = 4:1, col = 1:4, lty = 1:4, lwd = 2, alpha = 0.4), chullSize = c(1, 0.5)) \dontrun{ s.class(xy, fac = posi, col = coul, psub.text = "example s.class", pellipses.col = coul, plabels.cex = 0, key = list(space = "left")) data(banque, package = "ade4") dudi1 <- ade4::dudi.acm(banque, scannf = FALSE) col <- rainbow(length(levels(banque[, 20]))) g1 <- s.label(dudi1$li, psub = list(text = "Factorial map from ACM", cex = 1.5, position = "topleft"), plot = FALSE) g2 <- s.class(dudi1$li, banque[, 20], psub = list(text = names(banque)[20], cex = 1.5, position = "bottomright"), ellipseSize = 0, starSize = 0.5, pgrid.text.cex = 0, plot = FALSE) g3 <- s.class(dudi1$li, banque[, 20], starSize = 0, ellipseSize = 2, pgrid.text.cex = 0, plabels.cex = 1.5, plot = FALSE) g4 <- s.class(dudi1$li, banque[, 20], psub = list(text = names(banque)[20], position = "topright"), pgrid.text.cex = 0, col = col, pellipses.lwd = 1.5, plot = FALSE) G1 <- ADEgS(c(g1, g2, g3, g4), layout = c(2, 2)) G2 <- s.class(dudi1$li, banque, psub = list(position = "topleft"), pgrid.text.cex = 0, starSize = 0, ppoints.cex = 0) } } \keyword{aplot} \keyword{hplot} adegraphics/man/panel-methods.Rd0000644000176200001440000000617613742303021016333 0ustar liggesusers\name{panel-methods} \docType{methods} \alias{panel-methods} \alias{panel} \title{Methods \code{panel} for \code{ADEg} objects} \description{ The method \code{panel} displays all specific graphical components. } \section{Methods}{ \describe{ \item{\code{signature(object = "C1.barchart")}}{ draws bar charts and labels} \item{\code{signature(object = "C1.curve")}}{ draws points and curves} \item{\code{signature(object = "C1.curves")}}{ draws multiple points and curves} \item{\code{signature(object = "C1.density")}}{ draws density curves} \item{\code{signature(object = "C1.dotplot")}}{ draws segments and dots} \item{\code{signature(object = "C1.gauss")}}{ draws Gauss curves and level names of each curve} \item{\code{signature(object = "C1.hist")}}{ draws rectangles} \item{\code{signature(object = "C1.interval")}}{ draws segments or polygons} \item{\code{signature(object = "S1.boxplot")}}{ draws box-and-wiskers diagrams, mean points and labels} \item{\code{signature(object = "S1.class")}}{ draws labels and lines matching with score values} \item{\code{signature(object = "S1.distri")}}{ draws mean points and segments with matching labels} \item{\code{signature(object = "S1.label")}}{ draws labels and its links with score points} \item{\code{signature(object = "S1.match")}}{ draws score points and matching segments and labels} \item{\code{signature(object = "S2.arrow")}}{ draws points, arrows and labels} \item{\code{signature(object = "S2.class")}}{ draws ellipses, convex hulls, stars, labels and points} \item{\code{signature(object = "S2.corcircle")}}{ draws arrows, labels and axes} \item{\code{signature(object = "S2.density")}}{ draws densities and external points} \item{\code{signature(object = "S2.distri")}}{ draws ellipses, stars, labels and points} \item{\code{signature(object = "S2.image")}}{ draws raster image} \item{\code{signature(object = "S2.label")}}{ draws points and labels} \item{\code{signature(object = "S2.logo")}}{ displays the logos} \item{\code{signature(object = "S2.match")}}{ draws arrows and labels} \item{\code{signature(object = "S2.traject")}}{ draws points, arrows and labels} \item{\code{signature(object = "S2.value")}}{ draws symbols} \item{\code{signature(object = "T.cont")}}{ draws mean points and regression lines} \item{\code{signature(object = "T.image")}}{ draws raster image} \item{\code{signature(object = "T.value")}}{ draws symbols} \item{\code{signature(object = "Tr.class")}}{ draws arrows, labels and points} \item{\code{signature(object = "Tr.label")}}{ draws lines, labels and points} \item{\code{signature(object = "Tr.match")}}{ draws arrows, labels and points} \item{\code{signature(object = "Tr.traject")}}{ draws arrows, labels and points} }} \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \keyword{methods} adegraphics/man/adeg.panel.nb.Rd0000644000176200001440000000450613742303021016162 0ustar liggesusers\name{adeg.panel.nb} \alias{adeg.panel.nb} \alias{adeg.panel.edges} \title{Panel functions for adding graphs.} \description{ Panel function for representing a graph into a \code{trellis} graphic (\code{lattice} package).\cr Two types of graph objects can be used: \code{nb} or \code{listw} object (\code{spdep} package) or simple edges informations.\cr Directions associated with the edges are not displayed.\cr } \usage{ adeg.panel.nb(nbobject, coords, col.edge = "black", lwd = 1, lty = 1, pch = 20, cex = 1, col.node = "black", alpha = 1) adeg.panel.edges(edges, coords, col.edge = "black", lwd = 1, lty = 1, pch = 20, cex = 1, col.node = "black", alpha = 1) } \arguments{ \item{nbobject}{a object of class \code{nb} or \code{listw}} \item{edges}{a two columns matrix, representing the edges between the nodes. For a row i, x[i, 1] and x[i, 2] are linked, x[i, 1] and x[i, 2] being vertices number.} \item{coords}{a two columns matrix containing vertices' coordinates} \item{col.edge}{edges' color(s)} \item{lwd}{line width (edges). Can be a vector} \item{lty}{line type (edges). Can be a vector} \item{pch}{vertices' representation type (symbols). Can be a vector} \item{cex}{symbols' size(s) (vertices). Can be a vector} \item{col.node}{vertices' color(s). Can be a vector} \item{alpha}{symbols' transparency} } \value{ Displays the neighboring graph. } \references{ Package \code{spdep}. Author: Roger Bivand } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \note{ For more information about the use of panel functions, please see the \code{lattice} package developed by Deepayan Sarkar. } \examples{ if(require(lattice, quietly = TRUE) & require(spdep, quietly = TRUE)) { data(elec88, package = "ade4") coords <- elec88$xy xyplot(coords[, 2] ~ coords[, 1], panel = function(...){adeg.panel.nb(elec88$nb, coords, col.edge = c("blue", "red"))}) } if(require(lattice, quietly = TRUE)) { edges <- matrix(c(1, 2, 3, 2, 4, 1, 3, 4), byrow = TRUE, ncol = 2) coords <- matrix(c(0, 1, 1, 0, 0, -1, -1, 0), byrow = TRUE, ncol = 2) xyplot(coords[,2] ~ coords[,1], panel = function(...){adeg.panel.edges(edges, coords, lty = 1:4, cex = 5)}) } } \seealso{ \code{\link[spdep]{plot.nb}} } \keyword{aplot} adegraphics/man/s1d.distri.Rd0000644000176200001440000000675513742303021015562 0ustar liggesusers\name{s1d.distri} \alias{s1d.distri} \title{1-D plot of a numeric score by means/standard deviations computed using an external table of weights} \description{ This function represents a set of distributions on a numeric score using a mean-standard deviation display } \usage{ s1d.distri(score, dfdistri, labels = colnames(dfdistri), at = 1:NCOL(dfdistri), yrank = TRUE, sdSize = 1, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{score}{a numeric vector (or a data frame) used to produce the plot} \item{dfdistri}{a data frame containing the mass distribution in which each column is a class} \item{yrank}{a logical to draw the distributions sorted by means ascending order} \item{labels}{the labels' names drawn for each distribution} \item{at}{a numeric vector used as an index} \item{sdSize}{a numeric for the size of the standard deviation segments} \item{facets}{a factor splitting \code{score} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ Graphical parameters for rugs are available in \code{plines} of \code{adegpar}. Some appropriated graphical parameters in \code{p1d} are also available. The weighted means and standard deviations of class are available in the object slot \code{stats} using \code{object@stats$means} and \code{object@stats$sds}. } \value{ An object of class \code{ADEg} (subclass \code{S1.distri}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or data frame for \code{score} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{S1.distri}} \code{\linkS4class{ADEg.S1}} } \examples{ w <- seq(-1, 1, le = 200) distri <- data.frame(lapply(1:50, function(x) sample(200:1) * ((w >= (- x / 50)) & (w <= x / 50)))) names(distri) <- paste("w", 1:50, sep = "") g11 <- s1d.distri(w, distri, yrank = TRUE, sdS = 1.5, plot = FALSE) g12 <- s1d.distri(w, distri, yrank = FALSE, sdS = 1.5, plot = FALSE) G1 <- ADEgS(c(g11, g12), layout = c(1, 2)) data(rpjdl, package = "ade4") coa1 <- ade4::dudi.coa(rpjdl$fau, scannf = FALSE) G2 <- s1d.distri(coa1$li[,1], rpjdl$fau, labels = rpjdl$frlab, plabels = list(cex = 0.8, boxes = list(draw = FALSE))) \dontrun{ g31 <- s1d.distri(coa1$l1[,1], rpjdl$fau, plabels = list(cex = 0.8, boxes = list(draw = FALSE)), plot = FALSE) nsc1 <- ade4::dudi.nsc(rpjdl$fau, scannf = FALSE) g32 <- s1d.distri(nsc1$l1[,1], rpjdl$fau, plabels = list(cex = 0.8, boxes = list(draw = FALSE)), plot = FALSE) g33 <- s.label(coa1$l1, plot = FALSE) g34 <- s.label(nsc1$l1, plot = FALSE) G3 <- ADEgS(c(g31, g32, g33, g34), layout = c(2, 2)) } } \keyword{aplot} \keyword{hplot} adegraphics/man/ADEgS.Rd0000644000176200001440000000436613742303021014455 0ustar liggesusers\name{ADEgS} \alias{ADEgS} \title{Creation of \code{ADEgS} objects} \description{ Creates and displays an \code{"ADEgS"} object, a set of \code{ADEg}, \code{trellis} and/or \code{ADEgS} objects, managed by superposition, insertion and/or juxtaposition. } \usage{ ADEgS(adeglist, positions, layout, add = NULL, plot = TRUE) } \arguments{ \item{adeglist}{a list of several \code{trellis}, \code{ADEg} and/or \code{ADEgS} objects.} \item{positions}{a matrix with four columns and as many rows as the number of graphical objects in \code{ADEglist} slot. For each simple graphic, i.e. in each row, the coordinates of the top-right and the bottom-left hand corners are in \code{npc} unit (normalized parent coordinates).} \item{layout}{a layout indication in two possible forms: \itemize{ \item{a list containing arguments of the \code{layout} function} \item{a two-length vector containing rows' and columns' number of layout} }} \item{add}{a square matrix with as many rows and columns as the number of graphical objects in the \code{ADEglist} slot. The value at the i-th row and j-th column is equal to 1 whether the j-th graphical object in \code{ADEglist} slot is superpose to i-th graphical one. Otherwise, this value is equal to 0.} \item{plot}{a logical. If the graphics should be displayed} } \value{ an \code{ADEgS} object. If \code{plot = TRUE}, the created object is displayed. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEgS}} } \examples{ xy <- matrix(rnorm(20), ncol = 2) g1 <- s.label(xy) g2 <- s.class(xy, fac = as.factor(rep(LETTERS[1:2], length.out = 10)), ppoints.cex = 0, col = c("blue", "red")) g3 <- ADEgS(list(g1, g2), rbind(c(0, 0, 0.5, 1), c(0.5, 0, 1, 1))) g4 <- ADEgS(list(g1, g2), layout = c(2, 1)) g5 <- ADEgS(list(g1, g2)) g6 <- ADEgS(list(g1, g2), add = matrix(c(0, 1, 0, 0), byrow = TRUE, ncol = 2)) data(olympic, package = "ade4") dudi1 <- ade4::dudi.pca(olympic$tab, scan = FALSE) g7 <- s.arrow(dudi1$li) g8 <- s.corcircle(dudi1$co, lab = names(olympic$tab)) g9 <- ADEgS(list(g7, g8), rbind(c(0, 0, 0.5, 1), c(0.5, 0, 1, 1))) g9[[1]] g9[1, drop = FALSE] length(g9) } \keyword{hplot} adegraphics/man/table.value.Rd0000644000176200001440000001075113742303021015767 0ustar liggesusers\name{table.value} \alias{table.value} \title{Heat map-like representation with proportional symbols} \description{ This function represents a two dimensional table plot with proportional or colored squares or circles for each value. } \usage{ table.value(dftab, coordsx = 1:ncol(as.matrix(dftab)), coordsy = nrow(as.matrix(dftab)):1, labelsx, labelsy, breaks = NULL, method = c("size", "color"), symbol = c("square", "circle", "diamond", "uptriangle", "downtriangle"), col = NULL, nclass = 3, center = 0, centerpar = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{dftab}{a data frame, matrix, contingency table or distance matrix used to produce the plot} \item{coordsx}{an integer or a vector indicating the columns of \code{dftab} kept} \item{coordsy}{an integer or a vector indicating the rows of \code{dftab} kept} \item{labelsx}{columns labels} \item{labelsy}{rows labels} \item{breaks}{a vector of values to split \code{dftab}. If \code{NULL}, \code{pretty(dftab, nclass)} is used.} \item{method}{\code{color} or \code{size} value for represent \code{z}. If \code{color}, a palette of color is used for the symbols (one color per interval). If \code{size}, symbols of proportional area are used. Area is 0 for values equals to center (default 0). Two colors are used, for values less than center and larger than center.} \item{symbol}{value for symbol type} \item{col}{a color or a colors vector to color symbols. If \code{method} is \code{size}, a 2-length vector of color is expected. If \code{method} is \code{color}, it must have as many colors as the number of class} \item{nclass}{an integer for the number of desired intervals, ignored if \code{breaks} is not missing.} \item{center}{a center value for method \code{size}} \item{centerpar}{a logical or a list to represent center value using elements in the \code{adegpar("ppoints")} list} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \value{ An object of class \code{ADEg} (subclass \code{T.cont} if \code{dftab} is an \code{table} object, otherwise subclass \code{T.value}) or \code{ADEgS} (if \code{add} is \code{TRUE}).\cr The result is displayed if \code{plot} is \code{TRUE}. } \note{ For the symbol size, if the method is \code{size}, we use perceptual scaling (Tanimura et al. 2006) . } \references{ Tanimura, S. and Kuroiwa, C. and Mizota, T. 2006 Proportional symbol mapping in R \emph{Journal of Statistical Software} \bold{15}, 1--7 } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{T.value}} \code{\linkS4class{T.cont}} \code{\linkS4class{ADEg.T}} } \examples{ ## data.frame data(olympic, package = "ade4") w <- olympic$tab w <- data.frame(scale(w)) wpca <- ade4::dudi.pca(w, scann = FALSE) g1 <- table.value(w, ppoints.cex = 0.5, axis.line = list(col = "darkblue"), axis.text = list(col = "darkgrey")) # update the legend position update(g1, key = list(space = "left")) update(g1, key = list(columns = 1)) g2 <- table.value(w, coordsy = rank(wpca$li[, 1]), ppoints.cex = 0.5, axis.line = list(col = "darkblue"), axis.text = list(col = "darkgrey")) g3 <- table.value(w, coordsy = wpca$li[, 1], coordsx = wpca$co[, 1], ppoints.cex = 0.5, axis.line = list(col = "darkblue"), axis.text = list(col = "darkgrey")) ## distance data(eurodist) g5 <- table.value(eurodist, symbol = "circle", ptable.margin = list(bottom = 5, top = 16, left = 5, right = 16)) \dontrun{ ## table data(rpjdl, package = "ade4") w <- data.frame(t(rpjdl$fau)) wcoa <- ade4::dudi.coa(w, scann = FALSE) g6 <- table.value(as.table(as.matrix(w)), meanY = TRUE, coordsx = wcoa$c1[,1], coordsy = rank(wcoa$l1[,1]), ppoints.cex = 0.2, labelsx = "", col = "black") } } \keyword{aplot} \keyword{hplot} adegraphics/man/triangle.label.Rd0000644000176200001440000000637113742303021016453 0ustar liggesusers\name{triangle.label} \alias{triangle.label} \title{Ternary plot with labels} \description{ This function represents a three dimensional scatter plot with labels. } \usage{ triangle.label(dfxyz, labels = rownames(dfxyz), adjust = TRUE, min3d = NULL, max3d = NULL, addaxes = FALSE, addmean = FALSE, meanpar = NULL, axespar = NULL, showposition = TRUE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{dfxyz}{a three columns data frame used to produce the plot} \item{labels}{a character vector containing labels for points} \item{adjust}{a logical to adjust the device with the limits of the smaller equilateral triangle containing the values} \item{min3d}{a vector of three values for triangular minimal limits} \item{max3d}{a vector of three values for triangular maximal limits} \item{addaxes}{a logical to draw the principal axes} \item{addmean}{a logical to plot the mean} \item{meanpar}{a list to represent mean points using \code{pch}, \code{cex} and \code{col}} \item{axespar}{a list to represent axes lines using \code{col}, \code{lwd} and \code{lty}} \item{showposition}{a logical indicating whether the used triangle should be shown in the complete one} \item{facets}{a factor splitting the rows of \code{dfxyz} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \value{ An object of class \code{ADEg} (subclass \code{Tr.label}) or \code{ADEgS} (if \code{showposition} is TRUE, if \code{add} is \code{TRUE} and/or if facets are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{Tr.label}} \code{\linkS4class{ADEg.Tr}} } \examples{ data(euro123, package = "ade4") df <- rbind.data.frame(euro123$in78, euro123$in86, euro123$in97) row.names(df) <- paste(row.names(euro123$in78), rep(c(1, 2, 3), rep(12, 3)), sep = "") g1 <- triangle.label(df, label = row.names(df), showposition = TRUE, plot = FALSE) g2 <- triangle.label(euro123$in78, plabels.cex = 0, ppoints.cex = 2, addmean = TRUE, show = FALSE, plot = FALSE) g3 <- triangle.label(euro123$in86, labels = row.names(euro123$in78), plabels.cex = 0.8, plot = FALSE) g4 <- triangle.label(rbind.data.frame(euro123$in78, euro123$in86), plabels.cex = 0.8, addaxes = TRUE, psub.te = "Principal axis", psub.cex = 1.5, psub.pos = "topright", plot = FALSE) G <- ADEgS(c(g1, g2, g3, g4), layout = c(2, 2)) } \keyword{hplot} \keyword{aplot} adegraphics/man/add.ADEg.Rd0000644000176200001440000000224113742303021015047 0ustar liggesusers\name{add.ADEg} \alias{add.ADEg} \alias{add.ADEg-methods} \title{Superpose an new \code{ADEg} graph to the previous ones plotted} \description{ Adds an \code{ADEg} to the current \code{ADEg} or \code{ADEgS} plot. } \usage{ add.ADEg(object) } \arguments{ \item{object}{an \code{ADEg} object} } \details{ This function uses the last plotted \code{ADEg} or \code{ADEgS} object.\cr It calls \code{\link{superpose}}. } \value{ an \code{ADEgS} object } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\link{superpose}} \code{\linkS4class{ADEg}} \code{\linkS4class{ADEgS}} } \examples{ df1 <- cbind(rnorm(24), rnorm(24)) df2 <- cbind(rnorm(24), rnorm(24)) g1 <- s.label(df1, ppoints.col = "blue") g2 <- s.label(df2, ppoints.col = "red", plot = FALSE) add.ADEg(g2) data(jv73, package = "ade4") pca1 <- ade4::dudi.pca(jv73$morpho, scannf = FALSE) g5 <- s.label(pca1$li, plabels.optim = TRUE) g6 <- s.class(pca1$li, jv73$fac.riv, starSize = 0, ellipseSize = 0, chullSize = 1, ppolygons.alpha = 0.4, col = rainbow(12), ppoints.cex = 0, plot = FALSE) add.ADEg(g6) } \keyword{aplot} adegraphics/man/s.image.Rd0000644000176200001440000001040413742303021015103 0ustar liggesusers\name{s.image} \alias{s.image} \title{2-D scatter plot with loess estimation of an additional numeric score (levelplot)} \description{ This function represents a two dimensional scatter plot with a continuous convex colored surface and/or contour lines representing a third variable. } \usage{ s.image(dfxy, z, xax = 1, yax = 2, span = 0.5, gridsize = c(80L, 80L), contour = TRUE, region = TRUE, outsideLimits = NULL, breaks = NULL, nclass = 8, col = NULL, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{dfxy}{a data frame used to produce the plot} \item{z}{a vector (or a matrix) of values on the \code{dfxy} rows} \item{xax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the x-axis} \item{yax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the y-axis} \item{span}{a value to control the degree of smoothing} \item{gridsize}{a 1 or 2-length vector indicating the cell numbers (horizontally and vertically) of the grid for the colored surface} \item{contour}{a logical to draw contour lines} \item{region}{a logical to fill inter-contour regions} \item{breaks}{a vector of values to split \code{z}. If \code{NULL}, \code{pretty(z, nclass)} is used.} \item{nclass}{an integer for the number of desired intervals, ignored if \code{breaks} is not missing.} \item{outsideLimits}{specific limits for the surface as a set of polygons. It must be an \code{SpatialPolygons} object. Hole are authorized.} \item{col}{a color or a colors vector used for the colored cells} \item{facets}{a factor splitting the rows of \code{dfxy} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \value{ An object of class \code{ADEg} (subclass \code{S2.image}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or multidimensional \code{z} or vectors for \code{xax}/\code{yax} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{S2.image}} \code{\linkS4class{ADEg.S2}} } \examples{ df1 <- data.frame(expand.grid(-3:3, -3:3)) names(df1) <- c("x", "y") z1 <- (1 / sqrt(2)) * exp(-(df1$x ^ 2 + df1$y ^ 2) / 2) g1 <- s.image(df1, z1) # add a continuous color bar as legend # update(g1, plegend.drawColorKey = TRUE) g2 <- s.image(df1, z1, gridsize = 50) g3 <- s.image(df1, z1, gridsize = 100) ## g4 <- s.image(df1, z1, gridsize = 1000, plot = FALSE) \dontrun{ if(require(splancs, quietly = TRUE) & require(sp, quietly = TRUE)) { Sr1 <- Polygon(cbind(c(0, 1, 2, 1, 2, 0, -2, -1, -2, -1, 0), c(2.5, 1.5, 2, 0, -2, -1, -2, 0, 2, 1.5, 2.5))) Sr2 <- Polygon(cbind(c(-0.5, 0.5, 0.5, -0.5, -0.5), c(0, 0, 1 ,1, 0)), hole = TRUE) Srs2 <- Polygons(list(Sr1, Sr2), ID = "star and hole") SPp <- SpatialPolygons(list(Srs2)) df2 <- cbind(c(rnorm(2000, 1, 0.25), rnorm(3000, -1, 1.5)), c(rnorm(2000, 1, 0.5), rnorm(3000, -1, 3))) z2 <- c(rnorm(2000, 12, 1), rnorm(3000, 1, 2)) g5 <- s.image(df2, z2, outsideLimits = SPp, grid = 200, xlim = c(-2.5, 2.5), ylim = c(-2, 3), ppalette.quanti = colorRampPalette(c(grey(0.1), grey(0.9)))) data(t3012, package = "ade4") g6 <- s.image(t3012$xy, ade4::scalewt(t3012$temp), porigin.include = FALSE) g7 <- s.image(t3012$xy, ade4::scalewt(t3012$temp), outsideLimits = t3012$Spatial, Sp = t3012$Spatial) } } } \keyword{aplot} \keyword{hplot} adegraphics/man/S1.label-class.Rd0000644000176200001440000000644213742303021016233 0ustar liggesusers\name{S1.label-class} \docType{class} \alias{S1.label} \alias{S1.label-class} \alias{prepare,S1.label-method} \alias{panel,S1.label-method} \title{Class \code{S1.label}} \description{ A class for the creation and display of a numeric score with labels. } \section{Objects from the Class}{ \code{S1.label} objects can be created by calls of the form \code{new("S1.label", ...)}. The regular usage in this package is to use the \code{s1d.label} function. } \section{Slots}{ \describe{ \item{\code{data}}{a list containing data or data's name. \itemize{ \item{\code{score}: the displayed values in the form of a numeric vector, a name or a matching call.} \item{\code{labels}: the labels' names drawn for each \code{score} value.} \item{\code{at}: the index value.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list to create the \code{trellis} object.} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.S1} class. The specific slot for \code{S1.class} objects is: \itemize{ \item{\code{poslabel}: the label position of each \code{score} value, it can be "regular" or "value".} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters. The specific slot for \code{S1.label} objects is: \itemize{ \item{\code{rug}: an index value indicating where the rugs are drawn.} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg.S1}}, directly.\cr Class \code{\linkS4class{ADEg}}, by class \code{ADEg.S1}, distance 2.\cr Class \code{\linkS4class{ADEgORtrellis}}, by class \code{ADEg.S1}, distance 3.\cr Class \code{\linkS4class{ADEgORADEgSORtrellis}}, by class \code{ADEg.S1}, distance 3. } \section{Methods}{ The methods of the father classes \code{"ADEg.S1"} and \code{"ADEg"} can be used by inheritance. The specific methods for \code{S1.label} are: \describe{ \item{prepare}{\code{signature(object = "S1.label")}: calls the parent method (\code{prepare} for \code{ADEg.S1}) and modifies some graphical parameters used by default.} \item{panel}{\code{signature(object = "S1.label")}: draws labels and its links with score points.} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{ADEg}} \code{\linkS4class{ADEg.S1}} \code{\link{s1d.label}} } \examples{ showClass("S1.label") } \keyword{classes} adegraphics/man/ADEg.Tr-class.Rd0000644000176200001440000000737213742303021016021 0ustar liggesusers\name{ADEg.Tr-class} \docType{class} \alias{ADEg.Tr} \alias{ADEg.Tr-class} \alias{gettrellis,ADEg.Tr-method} \alias{prepare,ADEg.Tr-method} \alias{setlatticecall,ADEg.Tr-method} \alias{panelbase,ADEg.Tr-method} \title{Class \code{"ADEg.Tr"}} \description{ An object of \code{ADEg.Tr} class represents triangular coordinates in 2D. The \code{ADEg.Tr} class is a virtual class, i.e. a class which is not possible to create objects but which have heirs. This class inherits from \code{ADEg} class and has three son classes : \code{Tr.class}, \code{Tr.label}, \code{T.match} and \code{T.traject}. } \section{Objects from the Class}{ None object of this class can be instantiated. } \section{Slots}{ \describe{ \item{\code{data}:}{a list containing data or data's name. \itemize{ \item{\code{dfxyz}: the displayed values in the form of a data frame with three columns, a name or a matching call.} \item{\code{frame}: a positive or null integer. It is the number of the frame containing the data (used with \code{sys.frame(..., env = data$frame)}). Only if the data are not stored (i.e. \code{data$storeData = FALSE}).} \item{\code{storeData}: a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored.} }} \item{\code{trellis.par}}{a list of parameters for \code{lattice} call. It will be passed directly to \code{par.settings} arguments of the \code{lattice} function.} \item{\code{adeg.par}}{a list of graphical parameters, corresponding to the ones given by \code{adegpar()} function.} \item{\code{lattice.call}}{a list of two elements to create the \code{trellis} object: \itemize{ \item{\code{graphictype}: \code{xyplot}} \item{\code{arguments}: its parameters to obtain the \code{trellis} object} }} \item{\code{g.args}}{a list containing some method parameters linked with the created object of \code{ADEg.Tr} class: \itemize{ \item{\code{max3d} and \code{min3d}: triangular limits} \item{\code{adjust}: a logical to adjust the device with the limits} }} \item{\code{stats}}{a list of internal preliminary calculations} \item{\code{s.misc}}{a list of some others internal parameters: \itemize{ \item{\code{adjust.update}: a logical indicating if the \code{adjust} slot is updating} \item{\code{cornerp}: coordinates of the triangle extremities.} \item{\code{lgrid}: a list containing the three coordinates of the grid segments extremities(\code{pts1}, \code{pts2}, \code{pts3}) and the value of the division (\code{posgrid})} }} \item{\code{Call}}{an object of class \code{call}} } } \section{Extends}{ Class \code{\linkS4class{ADEg}}, directly. } \section{Methods}{ \describe{ \item{prepare}{\code{signature(object = "ADEg.Tr")}: performs the calculations before display the object (e.g. limits, grid and axis calculations)} \item{setlatticecall}{\code{signature(object = "ADEg.Tr")}: prepares the \code{lattice.call} slot} \item{panelbase}{\code{signature(object = "ADEg.Tr")}: defines the graphical background (e.g. triangle and grid)} \item{gettrellis}{\code{signature(object = "ADEg.Tr")}: converts the graphic into a \code{trellis} object of \code{lattice} class} } } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\link{adegpar}} \code{\linkS4class{Tr.class}} \code{\linkS4class{Tr.label}} \code{\linkS4class{Tr.match}} \code{\linkS4class{Tr.traject}} \code{\linkS4class{ADEg}} } \examples{ showClass("ADEg.Tr") } \keyword{classes} adegraphics/man/s1d.barchart.Rd0000644000176200001440000000443113742303021016037 0ustar liggesusers\name{s1d.barchart} \alias{s1d.barchart} \title{1-D plot of a numeric score by bars} \description{ This function represents a score using a chart with rectangular bars for which length is proportional to this score. } \usage{ s1d.barchart(score, labels = NULL, at = 1:NROW(score), sort = FALSE, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{score}{a numeric vector (or a data frame) used to produce the plot} \item{labels}{the labels' names drawn on the top of bars} \item{at}{a numeric vector used as an index} \item{sort}{a logical indicating if \code{score} is sorted in ascending order} \item{facets}{a factor splitting \code{score} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data are stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \details{ Graphical parameters for bars are available in \code{ppolygons} of \code{adegpar}. Some appropriated graphical parameters in \code{p1d} are also available. } \value{ An object of class \code{ADEg} (subclass \code{C1.barchart}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or data frame for \code{score} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{C1.barchart}} \code{\linkS4class{ADEg.C1}} } \examples{ data(rpjdl, package = "ade4") rpjdl.coa <- ade4::dudi.coa(rpjdl$fau, scannf = FALSE, nf = 4) s1d.barchart(rpjdl.coa$eig, p1d.horizontal = FALSE, ppolygons.col = "grey") } \keyword{aplot} \keyword{hplot} adegraphics/man/s.value.Rd0000644000176200001440000001065513742303021015145 0ustar liggesusers\name{s.value} \alias{s.value} \title{2-D scatter plot with proportional symbols (bubble plot)} \description{ This function represents a two dimensional scatter plot with a third value represented by symbols. } \usage{ s.value(dfxy, z, breaks = NULL, xax = 1, yax = 2, method = c("size", "color"), symbol = c("square", "circle", "diamond", "uptriangle", "downtriangle"), col = NULL, nclass = 4, center = 0, centerpar = NULL, facets = NULL, plot = TRUE, storeData = TRUE, add = FALSE, pos = -1, ...) } \arguments{ \item{dfxy}{a data frame used to produce the plot} \item{z}{a vector (or a matrix) with as many values as rows in \code{dfxy}} \item{breaks}{a vector containing the breaks used for splitting \code{z} value. If \code{NULL}, \code{pretty(z, n)} is used.} \item{xax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the x-axis} \item{yax}{an integer (or a vector) indicating which column(s) of \code{dfxy} is(are) plotted on the y-axis} \item{method}{\code{color} or \code{size} value for represent \code{z}. If \code{color}, a palette of color is used for the symbols (one color per interval). If \code{size}, symbols of proportional area are used. Area is 0 for values equals to center (default 0). Two colors are used, for values less than center and larger than center.} \item{symbol}{value for symbol type} \item{col}{a color or a colors vector to color symbols. If \code{method} is \code{size}, a 2-length vector of color is expected. If \code{method} is \code{color}, it must have as many colors as the number of class.} \item{nclass}{an integer for the number of desired intervals, ignored if \code{breaks} is not missing.} \item{center}{a center value for method \code{size}} \item{centerpar}{a logical or a list to represent center value using elements in the \code{adegpar("ppoints")} list} \item{facets}{a factor splitting the rows of \code{dfxy} so that subsets of the data are represented on different sub-graphics} \item{plot}{a logical indicating if the graphics is displayed} \item{storeData}{a logical indicating if the data should be stored in the returned object. If \code{FALSE}, only the names of the data arguments are stored} \item{add}{a logical. If \code{TRUE}, the graphic is superposed to the graphics already plotted in the current device} \item{pos}{an integer indicating the position of the environment where the data are stored, relative to the environment where the function is called. Useful only if \code{storeData} is \code{FALSE}} \item{\dots}{additional graphical parameters (see \code{\link{adegpar}} and \code{\link[lattice]{trellis.par.get}})} } \value{ An object of class \code{ADEg} (subclass \code{S2.value}) or \code{ADEgS} (if \code{add} is \code{TRUE} and/or if facets or multidimensional \code{z} or vectors for \code{xax}/\code{yax} are used).\cr The result is displayed if \code{plot} is \code{TRUE}. } \note{ For the symbol size, if the method is \code{size}, we use perceptual scaling (Tanimura et al. 2006) . } \references{ Tanimura, S. and Kuroiwa, C. and Mizota, T. 2006 Proportional symbol mapping in R \emph{Journal of Statistical Software} \bold{15}, 1--7 } \author{Alice Julien-Laferriere, Aurelie Siberchicot \email{aurelie.siberchicot@univ-lyon1.fr} and Stephane Dray } \seealso{ \code{\linkS4class{S2.value}} \code{\linkS4class{ADEg.S2}} } \examples{ data(rpjdl, package = "ade4") fau.coa <- ade4::dudi.coa(rpjdl$fau, scan = FALSE, nf = 3) g1 <- s.value(fau.coa$li, fau.coa$li[,3]) update(g1, key = list(space = "right", columns = 1)) g2 <- s.value(fau.coa$li, fau.coa$li[,3], method = "color", plegend.size = 0.8) g3 <- s.value(fau.coa$li, fau.coa$li[,3], plegend.size = 0.8, symbol = "square", method = "color", col = colorRampPalette(c("yellow", "blue"))(6)) g4 <- s.value(fau.coa$li, fau.coa$li[,3], plot = FALSE) g5 <- s.value(fau.coa$li, fau.coa$li[, 3], center = 0, method = "size", symbol = "circle", col = c("yellow", "red"), plot = FALSE) g6 <- ADEgS(c(g4, g5), positions = layout2position(matrix(c(1, 2), 1, 2)), add = matrix(0, ncol = 2, nrow = 2)) data(irishdata, package = "ade4") irq0 <- data.frame(scale(irishdata$tab, scale = TRUE)) g7 <- s.value(irishdata$xy.utm, irq0, Sp = irishdata$Spatial.contour, paxes.draw = FALSE, pgrid.draw = FALSE, pSp.alpha = 0.4) } \keyword{aplot} \keyword{hplot} adegraphics/DESCRIPTION0000644000176200001440000000453714774713152014256 0ustar liggesusersPackage: adegraphics Type: Package Title: An S4 Lattice-Based Package for the Representation of Multivariate Data Version: 1.0-22 Authors@R: c( person("Stéphane", "Dray", email = "stephane.dray@univ-lyon1.fr", role = "aut", comment = c(ORCID = "0000-0003-0153-1105")), person("Aurélie", "Siberchicot", role = c("aut", "cre"), email = "aurelie.siberchicot@univ-lyon1.fr", comment = c(ORCID = "0000-0002-7638-8318")), person("Jean", "Thioulouse", email = "jean.thioulouse@univ-lyon1.fr", role = "ctb", comment = c(ORCID = "0000-0001-7664-0598")), person("Alice", "Julien-Laferrière", role = "ctb") ) Description: Graphical functionalities for the representation of multivariate data. It is a complete re-implementation of the functions available in the 'ade4' package. Depends: R (>= 3.0.2) License: GPL (>= 2) Imports: ade4 (>= 1.7-13), graphics, grid, KernSmooth, lattice, latticeExtra, methods, RColorBrewer, sp (>= 1.1-1), stats Suggests: car, Guerry, knitr, markdown, pixmap, rmarkdown, spdep, splancs Collate: adeGsenv.R parameter.R utils.R utilstriangle.R genericMethod.R utilsclass.R panelfunctions.R ADEg.R ADEgS.R utilsADEgS.R ADEg.C1.R C1.barchart.R C1.curve.R C1.curves.R C1.density.R C1.gauss.R C1.dotplot.R C1.hist.R C1.interval.R ADEg.S1.R S1.boxplot.R S1.class.R S1.distri.R S1.label.R S1.match.R ADEg.S2.R S2.arrow.R S2.class.R S2.corcircle.R S2.density.R S2.distri.R S2.image.R S2.label.R S2.logo.R S2.match.R S2.traject.R S2.value.R ADEg.T.R T.image.R T.value.R T.cont.R ADEg.Tr.R Tr.class.R Tr.label.R Tr.match.R Tr.traject.R addhist.R addline.R addpoint.R addsegment.R addtext.R ade4-kplot.R ade4-scatter.R ade4-score.R ade4-plot.R multiplot.R s.Spatial.R utilskey.R URL: http://pbil.univ-lyon1.fr/ADE-4/ BugReports: https://github.com/adeverse/adegraphics/issues Encoding: UTF-8 VignetteBuilder: knitr NeedsCompilation: no Packaged: 2025-04-07 08:38:49 UTC; siberchicot Author: Stéphane Dray [aut] (), Aurélie Siberchicot [aut, cre] (), Jean Thioulouse [ctb] (), Alice Julien-Laferrière [ctb] Maintainer: Aurélie Siberchicot Repository: CRAN Date/Publication: 2025-04-07 09:10:02 UTC