vcd/0000755000175000017500000000000014133320412011151 5ustar nileshnileshvcd/demo/0000755000175000017500000000000012367374474012125 5ustar nileshnileshvcd/demo/00Index0000755000175000017500000000062611566471034013254 0ustar nileshnileshdiscrete Fitting and Graphing Discrete Distributions twoway 2-Way Contingency Tables mosaic Mosaic displays hcl Tcl/Tk-Demo for `hcl' colors hsv Tcl/Tk-Demo for `hsv' colors hls Tcl/Tk-Demo for `hls' colors strucplot Demo for new strucplot suite (assoc, mosaic, doubledeckerplot) mondrian Demo for (re)producing modern art using mosaic() hullternary Demo for adding data point hulls to a ternary plot vcd/demo/discrete.R0000755000175000017500000001357211566471034014053 0ustar nileshnilesh ################################################# ## Fitting and Graphing Discrete Distributions ## ################################################# data(HorseKicks) barplot(HorseKicks, col = 2, xlab = "Number of Deaths", ylab = "Number of Corps-Years", main = "Deaths by Horse Kicks") data(Federalist) barplot(Federalist, col = 2, xlab = "Occurrences of 'may'", ylab = "Number of Blocks of Text", main = "'may' in Federalist papers") data(WomenQueue) barplot(WomenQueue, col = 2, xlab = "Number of women", ylab = "Number of queues", main = "Women in queues of length 10") data(WeldonDice) barplot(WeldonDice, names = c(names(WeldonDice)[-11], "10+"), col = 2, xlab = "Number of 5s and 6s", ylab = "Frequency", main = "Weldon's dice data") data(Butterfly) barplot(Butterfly, col = 2, xlab = "Number of individuals", ylab = "Number of Species", main = "Butterfly species im Malaya") ############################ ## Binomial distributions ## ############################ par(mfrow = c(1,2)) barplot(dbinom(0:10, p = 0.15, size = 10), names = 0:10, col = grey(0.7), main = "p = 0.15", ylim = c(0,0.35)) barplot(dbinom(0:10, p = 0.35, size = 10), names = 0:10, col = grey(0.7), main = "p = 0.35", ylim = c(0,0.35)) par(mfrow = c(1,1)) mtext("Binomial distributions", line = 2, cex = 1.5) plot(0:10, dbinom(0:10, p = 0.15, size = 10), type = "b", ylab = "Density", ylim = c(0, 0.4), main = "Binomial distributions, N = 10", pch = 19) lines(0:10, dbinom(0:10, p = 0.35, size = 10), type = "b", col = 2, pch = 19) lines(0:10, dbinom(0:10, p = 0.55, size = 10), type = "b", col = 4, pch = 19) lines(0:10, dbinom(0:10, p = 0.75, size = 10), type = "b", col = 3, pch = 19) legend(3, 0.4, c("p", "0.15", "0.35", "0.55", "0.75"), lty = rep(1,5), col = c(0,1,2,4,3), bty = "n") ########################### ## Poisson distributions ## ########################### par(mfrow = c(1,2)) dummy <- barplot(dpois(0:12, 2), names = 0:12, col = grey(0.7), ylim = c(0,0.3), main = expression(lambda == 2)) abline(v = dummy[3], col = 2) diff <- (dummy[3] - dummy[2]) * sqrt(2)/2 lines(c(dummy[3] - diff, dummy[3] + diff), c(0.3, 0.3), col = 2) dummy <- barplot(dpois(0:12, 5), names = 0:12, col = grey(0.7), ylim = c(0,0.3), main = expression(lambda == 5)) abline(v = dummy[6], col = 2) diff <- (dummy[6] - dummy[5]) * sqrt(5)/2 lines(c(dummy[6] - diff, dummy[6] + diff), c(0.3, 0.3), col = 2) par(mfrow = c(1,1)) mtext("Poisson distributions", line = 2, cex = 1.5) ##################################### ## Negative binomial distributions ## ##################################### nbplot <- function(p = 0.2, size = 2, ylim = c(0, 0.2)) { plot(0:20, dnbinom(0:20, p = p, size = size), type = "h", col = grey(0.7), xlab = "Number of failures (k)", ylab = "Density", ylim = ylim, yaxs = "i", bty = "L") nb.mean <- size * (1-p)/p nb.sd <- sqrt(nb.mean/p) abline(v = nb.mean, col = 2) lines(nb.mean + c(-nb.sd, nb.sd), c(0.01, 0.01), col = 2) legend(14, 0.2, c(paste("p = ", p), paste("n = ", size)), bty = "n") } par(mfrow = c(3,2)) nbplot() nbplot(size = 4) nbplot(p = 0.3) nbplot(p = 0.3, size = 4) nbplot(p = 0.4, size = 2) nbplot(p = 0.4, size = 4) par(mfrow = c(1,1)) mtext("Negative binomial distributions for the number of trials to observe n = 2 or n = 4 successes", line = 3) ##################### ## Goodness of fit ## ##################### p <- weighted.mean(as.numeric(names(HorseKicks)), HorseKicks) p.hat <- dpois(0:4, p) expected <- sum(HorseKicks) * p.hat chi2 <- sum((HorseKicks - expected)^2/expected) pchisq(chi2, df = 3, lower = FALSE) ## or: HK.fit <- goodfit(HorseKicks) summary(HK.fit) ## Are the dice fair? p.hyp <- 1/3 p.hat <- dbinom(0:12, prob = p.hyp, size = 12) expected <- sum(WeldonDice) * p.hat expected <- c(expected[1:10], sum(expected[11:13])) chi2 <- sum((WeldonDice - expected)^2/expected) G2 <- 2*sum(WeldonDice*log(WeldonDice/expected)) pchisq(chi2, df = 10, lower = FALSE) ## Are the data from a binomial distribution? p <- weighted.mean(as.numeric(names(WeldonDice))/12, WeldonDice) p.hat <- dbinom(0:12, prob = p, size = 12) expected <- sum(WeldonDice) * p.hat expected <- c(expected[1:10], sum(expected[11:13])) chi2 <- sum((WeldonDice - expected)^2/expected) G2 <- 2*sum(WeldonDice*log(WeldonDice/expected)) pchisq(chi2, df = 9, lower = FALSE) ## or: WD.fit1 <- goodfit(WeldonDice, type = "binomial", par = list(prob = 1/3, size = 12)) WD.fit1$fitted[11] <- sum(predict(WD.fit1, newcount = 10:12)) WD.fit2 <- goodfit(WeldonDice, type = "binomial", par = list(size = 12), method = "MinChisq") summary(WD.fit1) summary(WD.fit2) F.fit1 <- goodfit(Federalist) F.fit2 <- goodfit(Federalist, type = "nbinomial") summary(F.fit1) par(mfrow = c(2,2)) plot(F.fit1, scale = "raw", type = "standing") plot(F.fit1, type = "standing") plot(F.fit1) plot(F.fit1, type = "deviation") par(mfrow = c(1,1)) plot(F.fit2, type = "deviation") summary(F.fit2) data(Saxony) S.fit <- goodfit(Saxony, type = "binomial", par = list(size = 12)) summary(S.fit) plot(S.fit) ############### ## Ord plots ## ############### par(mfrow = c(2,2)) Ord_plot(HorseKicks, main = "Death by horse kicks") Ord_plot(Federalist, main = "Instances of 'may' in Federalist papers") Ord_plot(Butterfly, main = "Butterfly species collected in Malaya") Ord_plot(WomenQueue, main = "Women in queues of length 10") par(mfrow = c(1,1)) ############### ## Distplots ## ############### distplot(HorseKicks, type = "poisson") distplot(HorseKicks, type = "poisson", lambda = 0.61) distplot(Federalist, type = "poisson") distplot(Federalist, type = "nbinomial") distplot(Saxony, type = "binomial", size = 12) vcd/demo/hullternary.R0000755000175000017500000000301211566471034014606 0ustar nileshnilesh###################################################### #### ternary plot demo #### Task: plotting data point hulls in a ternary plot #### data provided by Manuel Dominguez-Rodrigo ###################################################### library(vcd) ## data humans=matrix(c(18,19,17,21,7,9,8,62,70,53,69,81,73,71,20,10,30,10,12,18,19), ncol=3) colnames(humans)=c("young", "adult", "old") lions=matrix(c(41,59,62,49,45,21,12,5,11,13,38,29,33,40,42), ncol=3) colnames(lions)=c("young", "adult", "old") site=matrix(c(9,12,15,11,70,62,69,68,21,26,16,21), ncol=3) colnames(site)=c("young", "adult", "old") humans=matrix(c(18,19,17,21,7,9,8,62,70,53,69,81,73,71,20,10,30,10,12,18,19), ncol=3) ## regular ternary plot data = rbind(humans, lions, site) count = c(nrow(humans), nrow(lions), nrow(site)) rownames(data) = rep(c("humans", "lions", "site"), count) cols = rep(c("red", "green", "blue"), count) ternaryplot(data, col = cols) ## now try to draw hull prop2xy <- function(x) { x <- as.matrix(x) x <- x / rowSums(x) xp <- x[,2] + x[,3] / 2 yp <- x[,3] * sqrt(3) / 2 cbind(x = xp, y = yp) } hullpoints <- function(x) { ind <- chull(x) ind <- c(ind, ind[1]) x[ind,] } drawhull <- function(data, color) { hp <- hullpoints(prop2xy(data)) grid.lines(hp[,"x"], hp[,"y"], gp = gpar(col = color)) } ## setup plot region without data points ternaryplot(data, col = NA, pop = FALSE) ## grab plot viewport downViewport("plot") ## now plot hulls drawhull(humans, "blue") drawhull(site, "red") drawhull(lions, "green") vcd/demo/hsv.R0000755000175000017500000000373611566471034013052 0ustar nileshnileshif(require("tcltk")) { hue <- tclVar("hue") saturation <- tclVar("saturation") value <- tclVar("value") hue <- tclVar(0) hue.sav <- 0 saturation <- tclVar(1) saturation.sav <- 1 value <- tclVar(1) value.sav <- 1 replot <- function(...) { hue.sav <- my.h <- as.numeric(tclvalue(hue)) saturation.sav <- my.s <- as.numeric(tclvalue(saturation)) value.sav <- my.v <- as.numeric(tclvalue(value)) barplot(1, col = hsv(my.h, my.s, my.v), axes = FALSE) } replot.maybe <- function(...) { if(!((as.numeric(tclvalue(hue)) == hue.sav) && (as.numeric(tclvalue(saturation)) == saturation.sav) && (as.numeric(tclvalue(value)) == value.sav))) replot() } base <- tktoplevel() tkwm.title(base, "HSV Colors") spec.frm <- tkframe(base, borderwidth = 2) hue.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) saturation.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) value.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) tkpack(tklabel(hue.frm, text = "Hue")) tkpack(tkscale(hue.frm, command = replot.maybe, from = 0, to = 1, showvalue = TRUE, variable = hue, resolution = 0.01, orient = "horiz")) tkpack(tklabel(saturation.frm, text = "Saturation")) tkpack(tkscale(saturation.frm, command = replot.maybe, from = 0, to = 1, showvalue = TRUE, variable = saturation, resolution = 0.01, orient = "horiz")) tkpack(tklabel(value.frm, text = "Value")) tkpack(tkscale(value.frm, command = replot.maybe, from = 0, to = 1, showvalue = TRUE, variable = value, resolution = 0.01, orient = "horiz")) tkpack(hue.frm, saturation.frm, value.frm, fill="x") ## Bottom frame on base: q.but <- tkbutton(base, text = "Quit", command = function() tkdestroy(base)) tkpack(spec.frm, q.but) replot() } vcd/demo/strucplot.R0000755000175000017500000000413111566471034014277 0ustar nileshnileshdata("Titanic") data("UCBAdmissions") data("HairEyeColor") data("PreSex") mosaic(Titanic) mosaic(Titanic, shade = TRUE) mosaic(~ Sex + Class, data = Titanic, shade = TRUE) mosaic(~ Sex + Class + Survived, data = Titanic, shade = TRUE) mosaic(~ PremaritalSex + ExtramaritalSex | MaritalStatus + Gender, data = PreSex) mosaic(~ PremaritalSex + ExtramaritalSex | MaritalStatus + Gender, data = PreSex, labeling = labeling_conditional(abbreviate_varnames = TRUE)) mosaic(Titanic, spacing = spacing_increase()) mosaic(Titanic, spacing = spacing_equal()) mosaic(Titanic, labeling = labeling_border()) mosaic(Titanic, labeling = labeling_cells()) mosaic(Titanic, labeling = labeling_cells(abbreviate_labels = TRUE)) mosaic(Titanic, labeling = labeling_cells(abbreviate_varnames = TRUE)) mosaic(Titanic, labeling = labeling_cells(abbreviate_varnames = TRUE, abbreviate_labels = TRUE)) mosaic(Titanic, labeling = labeling_border(abbreviate = TRUE)) mosaic(Titanic, labeling = labeling_border(abbreviate = c(Survived = TRUE))) mosaic(Titanic, labeling = labeling_border(rot_labels = c(bottom = 45))) mosaic(Titanic, labeling = labeling_border(tl_labels = TRUE)) mosaic(Titanic, labeling = labeling_border(tl_labels = TRUE, tl_varnames = FALSE)) mosaic(Titanic, labeling = labeling_border(tl_labels = TRUE, tl_varnames = c(TRUE,TRUE,FALSE,FALSE), boxes = TRUE)) mosaic(Titanic, labeling = labeling_cboxed()) mosaic(Titanic, labeling = labeling_lboxed()) mosaic(Titanic, labeling = labeling_left()) mosaic(Titanic, labeling = labeling_list(), mar = c(2,2,4,2)) mosaic(Titanic, labeling = labeling_border(rep = FALSE)) mosaic(Titanic, labeling = labeling_border(labbl_varnames = c(TRUE,TRUE,FALSE,FALSE))) mosaic(~ Gender + Admit | Dept, data = UCBAdmissions, labeling = labeling_conditional(labels_varnames = TRUE, varnames = FALSE), keep_aspect_ratio = FALSE, split_vertical = c(Dept = TRUE)) doubledecker(Titanic) assoc(Hair ~ Eye, data = HairEyeColor) assoc(Hair ~ Eye, data = HairEyeColor, compress = FALSE) assoc(HairEyeColor, labeling = labeling_lboxed()) pairs(Titanic, shade = TRUE) pairs(Titanic, panel_upper = pairs_assoc, shade = TRUE) vcd/demo/twoway.R0000644000175000017500000001521212475147056013575 0ustar nileshnilesh ##################### ## Fourfold tables ## ##################### ### Berkeley Admission Data ### ############################### data(UCBAdmissions) ## unstratified ### no margin is standardized x <- margin.table(UCBAdmissions, 2:1) fourfold(x, std = "i", extended = FALSE) ### std. for gender fourfold(x, margin = 1, extended = FALSE) ### std. for both fourfold(x, extended = FALSE) ## stratified fourfold(UCBAdmissions, extended = FALSE) fourfold(UCBAdmissions) ## extended plots ## using cotabplot cotabplot(UCBAdmissions, panel = function(x, condlevels, ...) fourfold(co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]], newpage = F, return_grob = FALSE, ...) ) ### Coal Miners Lung Data ### ############################# data(CoalMiners) ## Fourfold display, both margins equated fourfold(CoalMiners, mfcol = c(3,3)) ## Log Odds Ratio Plot data(CoalMiners, package = "vcd") lor_CM <- loddsratio(CoalMiners) plot(lor_CM) lor_CM_df <- as.data.frame(lor_CM) # fit linear models using WLS age <- seq(20, 60, by = 5) lmod <- lm(LOR ~ age, weights = 1 / ASE^2, data = lor_CM_df) grid.lines(age, fitted(lmod), gp = gpar(col = "blue")) qmod <- lm(LOR ~ poly(age, 2), weights = 1 / ASE^2, data = lor_CM_df) grid.lines(age, fitted(qmod), gp = gpar(col = "red")) ## Fourfold display, strata equated fourfold(CoalMiners, std = "ind.max", mfcol = c(3,3)) #################### ## Sieve Diagrams ## #################### ### Hair Eye Color ### ###################### data(HairEyeColor) ## aggregate over `sex': (tab <- margin.table(HairEyeColor, 1:2)) ## plot expected values: sieve(t(tab), sievetype = "expected", shade = TRUE) ## plot sieve diagram: sieve(t(tab), shade = TRUE) ### Visual Acuity ### ##################### data(VisualAcuity) attach(VisualAcuity) sieve(Freq ~ right + left, data = VisualAcuity, subset = gender == "female", main = "Unaided distant vision data", labeling_args = list(set_varnames = c(left = "Left Eye Grade", right = "Right Eye Grade")), shade = TRUE ) detach(VisualAcuity) ### Berkeley Admission ### ########################## ## -> Larger tables: e.g., Cross factors ### Cross Gender and Admission data(UCBAdmissions) (tab <- xtabs(Freq ~ Dept + I(Gender : Admit), data = UCBAdmissions)) sieve(tab, labeling_args = list(set_varnames = c("I(Gender:Admit)" = "Gender:Admission", Dept = "Department")), main = "Berkeley Admissions Data", shade = TRUE ) ## or use extended sieve plots: sieve(UCBAdmissions, shade = TRUE) ###################### ## Association Plot ## ###################### ### Hair Eye Color ### ###################### data(HairEyeColor) assoc(margin.table(HairEyeColor, 1:2), labeling_args = list(set_varnames = c(Hair = "Hair Color", Eye = "Eye Color")), main = "Association Plot") #################### ## Agreement Plot ## #################### ### Sexual Fun ### ################## data(SexualFun) ## Kappa statistics Kappa(SexualFun) ## Agreement Chart agreementplot(t(SexualFun), weights = 1) ## Partial Agreement Chart and B-Statistics (agreementplot(t(SexualFun), xlab = "Husband's Rating", ylab = "Wife's Rating", main = "Husband's and Wife's Sexual Fun") ) ### MS Diagnosis data ### ######################### data(MSPatients) ## use e.g., X11(width = 12), or expand graphics device agreementplot(t(MSPatients[,,1]), main = "Winnipeg Patients") agreementplot(t(MSPatients[,,2]), main = "New Orleans Patients") ################## ## Ternary Plot ## ################## ### sample data ### ################### (x <- rbind(c(A=10,B=10,C=80), c(40,30,30), c(20,60,20) ) ) ternaryplot(x, cex = 2, col = c("black", "blue", "red"), coordinates = TRUE ) ### Arthritis Treatment Data ### ################################ data(Arthritis) ## Build table by crossing Treatment and Sex (tab <- as.table(xtabs(~ I(Sex:Treatment) + Improved, data = Arthritis))) ## Mark groups col <- c("red", "red", "blue", "blue") pch <- c(1, 19, 1, 19) ## plot ternaryplot( tab, col = col, pch = pch, cex = 2, bg = "lightgray", grid_color = "white", labels_color = "white", main = "Arthritits Treatment Data" ) ## legend grid_legend(0.8, 0.7, pch, col, rownames(tab), title = "GROUP") ### Baseball Hitters Data ### ############################# data(Hitters) attach(Hitters) colors <- c("black","red","green","blue","red","black","blue") pch <- substr(levels(Positions), 1, 1) ternaryplot( Hitters[,2:4], pch = as.character(Positions), col = colors[as.numeric(Positions)], main = "Baseball Hitters Data" ) grid_legend(0.8, 0.9, pch, colors, levels(Positions), title = "POSITION(S)") detach(Hitters) ### Lifeboats on the Titanic ### ################################ data(Lifeboats) attach(Lifeboats) ternaryplot( Lifeboats[,4:6], pch = ifelse(side=="Port", 1, 19), col = ifelse(side=="Port", "red", "blue"), id = ifelse(men/total > 0.1, as.character(boat), NA), dimnames_position = "edge", dimnames = c("Men of Crew", "Men passengers", "Women and Children"), main = "Lifeboats on the Titanic" ) grid_legend(0.8, 0.9, c(1, 19), c("red", "blue"), c("Port", "Starboard"), title = "SIDE") ## Load against time for Port/Starboard boats plot(launch, total, pch = ifelse(side == "Port", 1, 19), col = ifelse(side == "Port", "red", "darkblue"), xlab = "Launch Time", ylab = "Total loaded", main = "Lifeboats on the Titanic" ) legend(as.POSIXct("1912-04-15 01:48:00"), 70, legend = c("SIDE","Port","Starboard"), pch = c(NA, 1, 19), col = c(NA, "red", "darkblue") ) text(as.POSIXct(launch), total, labels = as.character(boat), pos = 3, offset = 0.3 ) abline(lm(total ~ as.POSIXct(launch), subset = side == "Port"), col = "red") abline(lm(total ~ as.POSIXct(launch), subset = side == "Starboard"), col = "darkblue") detach(Lifeboats) vcd/demo/hcl.R0000755000175000017500000000467211566471034013020 0ustar nileshnileshif(require("tcltk")) { hue <- tclVar("hue") chroma <- tclVar("chroma") luminance <- tclVar("luminance") fixup <- tclVar("fixup") hue <- tclVar(230) hue.sav <- 230 chroma <- tclVar(55) chroma.sav <- 55 luminance <- tclVar(75) luminance.sav <- 75 fixup <- tclVar(FALSE) replot <- function(...) { hue.sav <- my.h <- as.numeric(tclvalue(hue)) chroma.sav <- my.c <- as.numeric(tclvalue(chroma)) luminance.sav <- my.l <- as.numeric(tclvalue(luminance)) my.fixup <- as.logical(as.numeric(tclvalue(fixup))) barplot(1, col = hcl2hex(my.h, my.c, my.l, fixup = my.fixup), axes = FALSE) } replot.maybe <- function(...) { if(!((as.numeric(tclvalue(hue)) == hue.sav) && (as.numeric(tclvalue(chroma)) == chroma.sav) && (as.numeric(tclvalue(luminance)) == luminance.sav))) replot() } base <- tktoplevel() tkwm.title(base, "HCL Colors") spec.frm <- tkframe(base, borderwidth = 2) hue.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) chroma.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) luminance.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) fixup.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) tkpack(tklabel(hue.frm, text = "Hue")) tkpack(tkscale(hue.frm, command = replot.maybe, from = 0, to = 360, showvalue = TRUE, variable = hue, resolution = 1, orient = "horiz")) tkpack(tklabel(chroma.frm, text = "Chroma")) tkpack(tkscale(chroma.frm, command = replot.maybe, from = 0, to = 100, showvalue = TRUE, variable = chroma, resolution = 5, orient = "horiz")) tkpack(tklabel(luminance.frm, text = "Luminance")) tkpack(tkscale(luminance.frm, command = replot.maybe, from = 0, to = 100, showvalue = TRUE, variable = luminance, resolution = 5, orient = "horiz")) tkpack(tklabel(fixup.frm, text="Fixup")) for (i in c("TRUE", "FALSE") ) { tmp <- tkradiobutton(fixup.frm, command = replot, text = i, value = as.logical(i), variable = fixup) tkpack(tmp, anchor="w") } tkpack(hue.frm, chroma.frm, luminance.frm, fixup.frm, fill="x") ## Bottom frame on base: q.but <- tkbutton(base, text = "Quit", command = function() tkdestroy(base)) tkpack(spec.frm, q.but) replot() } vcd/demo/mondrian.R0000755000175000017500000000115011566471034014045 0ustar nileshnileshlibrary(vcd) ## shape foo1 <- c(3, 7, 3, 1.5) foo2 <- c(2, 6.5, 1.5) foo <- outer(foo1/sum(foo1), foo2/sum(foo2), "*") ## color mondrian <- rep("#EAE6E3", 12) mondrian[1] <- "#DE1024" mondrian[3] <- "#FFD83B" mondrian[12] <- "#032349" ## plot ## best visualized with resized display, e.g. using: ## get(getOption("device"))(width = 4.9, height = 7.5) grid.newpage() grid.rect(gp = gpar(fill = 1)) mondrianMosaic <- function(x, fill) mosaic(x, gp = gpar(col = rep(0, length(fill)), fill = fill), legend = FALSE, margins = 0, newpage = FALSE, keep_aspect_ratio = FALSE) mondrianMosaic(foo, mondrian) vcd/demo/mosaic.R0000755000175000017500000000651711566471034013525 0ustar nileshnilesh##################### ## Mosaic Displays ## ##################### ######################### ## Hair Eye Color Data ## ######################### data(HairEyeColor) ## Basic Mosaic Display ## HairEye <- margin.table(HairEyeColor, c(1,2)) mosaic(HairEye, main = "Basic Mosaic Display of Hair Eye Color data") ## Hair Mosaic Display with Pearson residuals ## Hair <- margin.table(HairEyeColor,1) Hair mHair <- as.table(rep(mean(margin.table(HairEyeColor, 1)), 4)) names(mHair) <- names(Hair) mHair ## Pearson residuals from Equiprobability model ## resid <- (Hair - mHair) / sqrt(mHair) resid ## First Step in a Mosaic Display ## mosaic(Hair, residuals = resid, main = "Hair Color Proportions") ## Hair Eye Mosais Display with Pearson residuals ## mosaic(HairEye, main = " Hair Eye Color with Pearson residuals") ## Show Pearson Residuals ## (HairEye - loglin(HairEye, c(1, 2), fit = TRUE)$fit) / sqrt(loglin(HairEye, c(1, 2), fit = TRUE)$fit) ################### ## UKSoccer Data ## ################### data(UKSoccer) ## UKSoccer Mosaic Display ## mosaic(UKSoccer, main = "UK Soccer Scores") ############################### ## Repeat Victimization Data ## ############################### data(RepVict) ## mosaic(RepVict[-c(4, 7), -c(4, 7)], main = "Repeat Victimization Data") ################## ## 3-Way Tables ## ################## ## Hair Eye Sex Mosais Display with Pearson residuals ## mosaic(HairEyeColor, main = "Hair Eye Color Sex" ) mosaic(HairEyeColor, expected = ~ Hair * Eye + Sex, main = "Model: (Hair Eye) (Sex)" ) mosaic(HairEyeColor, expected = ~ Hair * Sex + Eye*Sex, main = "Model: (Hair Sex) (Eye Sex)") #################### ## Premarital Sex ## #################### data(PreSex) ## Mosaic display for Gender and Premarital Sexual Expirience ## ## (Gender Pre) ## mosaic(margin.table(PreSex, c(3, 4)), legend = FALSE, main = "Gender and Premarital Sex") ## (Gender Pre)(Extra) ## mosaic(margin.table(PreSex,c(2,3,4)), legend = FALSE, expected = ~ Gender * PremaritalSex + ExtramaritalSex , main = "(PreMaritalSex Gender) (Sex)") ## (Gender Pre Extra)(Marital) ## mosaic(PreSex, expected = ~ Gender * PremaritalSex * ExtramaritalSex + MaritalStatus, legend = FALSE, main = "(PreMarital ExtraMarital) (MaritalStatus)") ## (GPE)(PEM) ## mosaic(PreSex, expected = ~ Gender * PremaritalSex * ExtramaritalSex + MaritalStatus * PremaritalSex * ExtramaritalSex, legend = FALSE, main = "(G P E) (P E M)") ############################ ## Employment Status Data ## ############################ data(Employment) ## Employment Status ## # mosaic(Employment, # expected = ~ LayoffCause * EmploymentLength + EmploymentStatus, # main = "(Layoff Employment) + (EmployStatus)") # mosaic(Employment, # expected = ~ LayoffCause * EmploymentLength + # LayoffCause * EmploymentStatus, # main = "(Layoff EmpL) (Layoff EmplS)") # ## Closure ## # mosaic(Employment[,,1], main = "Layoff : Closure") # ## Replaced ## # mosaic(Employment[,,2], main = "Layoff : Replaced") ##################### ## Mosaic Matrices ## ##################### data(UCBAdmissions) pairs(PreSex) pairs(UCBAdmissions) pairs(UCBAdmissions, type = "conditional") pairs(UCBAdmissions, type = "pairwise", gp = shading_max) vcd/demo/hls.R0000755000175000017500000000403211566471034013026 0ustar nileshnileshif(require("tcltk")) { hue <- tclVar("hue") luminance <- tclVar("luminance") saturation <- tclVar("saturation") hue <- tclVar(0) hue.sav <- 0 luminance <- tclVar(0.5) luminance.sav <- 0.5 saturation <- tclVar(1) saturation.sav <- 1 replot <- function(...) { hue.sav <- my.h <- as.numeric(tclvalue(hue)) saturation.sav <- my.s <- as.numeric(tclvalue(saturation)) luminance.sav <- my.l <- as.numeric(tclvalue(luminance)) barplot(1, col = hls(my.h, my.l, my.s), axes = FALSE) } replot.maybe <- function(...) { if(!((as.numeric(tclvalue(hue)) == hue.sav) && (as.numeric(tclvalue(saturation)) == saturation.sav) && (as.numeric(tclvalue(luminance)) == luminance.sav))) replot() } base <- tktoplevel() tkwm.title(base, "HLS Colors") spec.frm <- tkframe(base, borderwidth = 2) hue.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) saturation.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) luminance.frm <- tkframe(spec.frm, relief = "groove", borderwidth = 2) tkpack(tklabel(hue.frm, text = "Hue")) tkpack(tkscale(hue.frm, command = replot.maybe, from = 0, to = 1, showvalue = TRUE, variable = hue, resolution = 0.01, orient = "horiz")) tkpack(tklabel(luminance.frm, text = "Luminance")) tkpack(tkscale(luminance.frm, command = replot.maybe, from = 0, to = 1, showvalue = TRUE, variable = luminance, resolution = 0.01, orient = "horiz")) tkpack(tklabel(saturation.frm, text = "Saturation")) tkpack(tkscale(saturation.frm, command = replot.maybe, from = 0, to = 1, showvalue = TRUE, variable = saturation, resolution = 0.01, orient = "horiz")) tkpack(hue.frm, luminance.frm, saturation.frm, fill="x") ## Bottom frame on base: q.but <- tkbutton(base, text = "Quit", command = function() tkdestroy(base)) tkpack(spec.frm, q.but) replot() } vcd/MD50000644000175000017500000002156714133320412011474 0ustar nileshnilesh87fdee7ae6a9cb3f497b7334447908fb *DESCRIPTION d9d1b59e8b88b4ad346afc404ea475cc *NAMESPACE 3c097b80a9e49b4d417f0e5ea45427ce *R/Kappa.R 059845124a77cda96758bfe96e8fbb76 *R/Ord_plot.R 6ee698049c09955fbd88be265264393c *R/agreementplot.R 00a9c863579ce1da6cc72e59bbda6f02 *R/assoc.R 09d60e56dfbb1afa698177e7cf591bed *R/assocstats.R 25867b3cdcc6858e20cef7a9e67b540a *R/binregplot.R 4088faa0871130598e07ea26430a3c5a *R/cd_plot.R 3ea43d07743875dfce874f4cc067196c *R/co_table.R 1cfff0fdbfa0b20fe4e691b997a5a328 *R/coindep_test.R 6e1c60aa0e8afd51604702791d8947fb *R/cotabplot.R 1d404a765bea252806ae8a094d5be2e9 *R/distplot.R c230becde3443593da1fc18ac168592d *R/doubledeckerplot.R f8ce1d406efffcdef0af4078739ab7e3 *R/fourfold.R 40fa6290dea68cd3505166907731f742 *R/goodfit.R cb59d1ec73b001757a20e006a2c2c9d2 *R/grid_legend.R 2c061c5f3b6c7480155aca387cbae2bf *R/hls.R 1c0b3d8c2bfa9fa4686690a296297133 *R/labeling.R 1191c3c3b99fe33ffbfbce311977ccd5 *R/legends.R d73189e85cf671591cfffa975e807ebf *R/lodds.R 273d8ce40a5ea5302ab2351467b146a1 *R/loddsratio.R ee9268575c067494a320b412a7b94462 *R/mosaic.R e399eefbaf6b57cd9c0d63627e5e0960 *R/mplot.R e64948c0c3e16187701584d8ca54831d *R/oddsratioplot.R 311ff1419553616f7fa2876fb5f58c6c *R/pairsplot.R f429718cc703e950773811364d9335ed *R/plot.loglm.R d0d1334f8b9a76cd4e16923d70a1a9d3 *R/rootogram.R d15a403b0412ba22d07698e3861da6a5 *R/shadings.R 5844e6cfd389dc23e364496f6d1059fe *R/sieve.R fd79ebf9c8a9b483b500bad1f0b228e9 *R/spacings.R 8c1e69e46e0d3127ca572abc3b813924 *R/spine.R 87becefab44226b0cdb3f2eb83971c90 *R/strucplot.R f718c8633b0acb39d4018cf495a80d5c *R/structable.R 54abbe94cad0a0322a44327e62a810ca *R/tabletools.R bee629d8802f7f1d158a7975ec346c5f *R/ternaryplot.R d18de2cb6dca77a82c49edc57c1e5d9c *R/tile.R f1f0d3194326666f81dc1ef97623a911 *R/utils.R a54ac332c792d35e0846d4bf45d45bd8 *R/woolf_test.R d193361672b6fbd29bd61be69eb0942a *build/partial.rdb ccd660e2e37bb1c0e535a8b57c130651 *build/vignette.rds 1fcacdd810545176c5dfc8ad4be480d3 *data/Arthritis.rda af42b0e82f7602ef3a21ac54ba67071c *data/Baseball.rda 4956f3321e6fb5582e3f2ba8901012cd *data/BrokenMarriage.rda 4db232a9f37c6afe361051f4f3d425a5 *data/Bundesliga.rda 93e7f6208ec8c8db86401c1afc3320f6 *data/Bundestag2005.rda b1b20ebec4defc3873f701c6e5d0388c *data/Butterfly.rda f4e45bae788977b0bfb08529b9ecd604 *data/CoalMiners.rda aa7e80a1cd039d8fc05298dac9a2d0bf *data/DanishWelfare.rda 58a32adeec50a9db5407baa4f8700016 *data/Employment.rda 5aba2d189017c4954a77c1c0f3fea3e6 *data/Federalist.rda 59c4403257e7fdd114f70aedb279b9eb *data/Hitters.rda fd218dbc9c107e770b22d8c2f95a81c5 *data/HorseKicks.rda 1b412b81fec3a049c893c52c0f8195a3 *data/Hospital.rda 30aa94bd0a31ce461608ba6934ebe5ba *data/JobSatisfaction.rda c8f5e67eab217718fa29e5400dd45bf5 *data/JointSports.rda 472eb17e72b076b5ef8c2d1a61be7198 *data/Lifeboats.rda b9f5fb04a6ea55a51e649e4020e2ee11 *data/MSPatients.rda ba9681b79f4ebe1322cacaa081b968d8 *data/NonResponse.rda 134589af7ec903a3c3e00d4206dd1360 *data/OvaryCancer.rda bfd94454d2d26b8ce9b83847c0317937 *data/PreSex.rda f0935833b88518d4cec4cbd4cad1c93c *data/Punishment.rda 23b751a5c6800bdb2548e34b67b8d529 *data/RepVict.rda 146309bfbc60f0021fa2607cdab0d450 *data/Rochdale.rda 663f038140e4bbf086288f169ed16443 *data/Saxony.rda d9056090e3ef45162e3e61a33e9b1bc1 *data/SexualFun.rda a9971961ea92c34cfa6df11a2702ab57 *data/SpaceShuttle.rda 373578bdfcd066adcbde0f8d6d261135 *data/Suicide.rda 645187968a5775ec0f32c58b00fa416b *data/Trucks.rda ed6f7fcf22fd7da13c84a3fee7edc02c *data/UKSoccer.rda 203346753d583e64ebaae114e009466f *data/VisualAcuity.rda 7f1432aa827fde459adce4e66fcac287 *data/VonBort.rda c830965adaee9e106d2a90ea00b7230c *data/WeldonDice.rda 4c4d8441ae345c200d9811bd7e32c850 *data/WomenQueue.rda fea43b041738222b9ca05543c2103248 *demo/00Index 6446ca2edeae8ffaab647cbaf9badc92 *demo/discrete.R 7eb8e56560704b20fe6ca89df6a37843 *demo/hcl.R b96320b9a646b8fc6c63661f49b6aa6f *demo/hls.R 002ca3d1e79c9d84416d3b4e0bf8024e *demo/hsv.R 1da0bb6bdd21c0b13a1599b2121253be *demo/hullternary.R 32aefed96167152c94cf9f5c1a3708cf *demo/mondrian.R a61a25a7b48e3d172cc6353b956c9392 *demo/mosaic.R 7b08161f2cdc60d9e594f3aa76479272 *demo/strucplot.R baec36bb9bda9e52aa5467bd11c71f9d *demo/twoway.R 98cc2eeddf3eaf00b9bd8806bc48aea6 *inst/CITATION 17496d003f9c26c835551e2711c9302c *inst/NEWS.Rd 52b5ef0eb724854cf0795eecade77581 *inst/doc/residual-shadings.R 3849f36c1a503b821b4ba3e8f1286489 *inst/doc/residual-shadings.Rnw 9d513e3c8382c250b8a3c14e6ba864cc *inst/doc/residual-shadings.pdf 23a35b9e4ad98965a8b98c760e030f21 *inst/doc/strucplot.R 36cac2b2d77375961d3c9b940d83730c *inst/doc/strucplot.Rnw f01aec0f1b9fd7089cdd7452d03f48b1 *inst/doc/strucplot.pdf 52757bd94ba340a720830f6075f8b0fb *man/Arthritis.Rd 912a44043a40235b1800aae01d50042e *man/Baseball.Rd 1059d318cb78e6586c3b772ad941cc36 *man/BrokenMarriage.Rd d6bf3e6a57243a4fed61c3de50282738 *man/Bundesliga.Rd ef94e34057a5dfd7f7146e732afe6a34 *man/Bundestag2005.Rd d5d5c262a89021e918ad8ec488568ed5 *man/Butterfly.Rd 6ed74b82637f822590003c9ce61440c5 *man/CoalMiners.Rd 9a605318f578054afcff4fbe130450c2 *man/DanishWelfare.Rd a8fbbdb872f26bc25aa776061febbd36 *man/Employment.Rd 5e26cab32f3905b6b243f5688dd11cb3 *man/Federalist.Rd ceabf42729a57cb25fa2c707572ccbf1 *man/Hitters.Rd e559ebed2dae1632aa67296563f05b2b *man/HorseKicks.Rd 8e75757feb4d17a3c40a34a0dcc3ca81 *man/Hospital.Rd c533f38a41280541958fdec1520d2341 *man/JobSatisfaction.Rd df94bd111d97c846f201ad51626a0a97 *man/JointSports.Rd 428dc2a741a2c42b75697f2869dfd5ed *man/Kappa.Rd 0ab6cfcde586f29bb80ba421f7de5350 *man/Lifeboats.Rd 9df8dd04a6640b674d8058f056311849 *man/MSPatients.Rd aa707134c91334b4c6e9ad33af97a6b8 *man/NonResponse.Rd a361b8cb90c7fc63d59a07ac8fafa4a1 *man/Ord_plot.Rd 946497fa005b8f2ec4c6d43e667d7fc8 *man/OvaryCancer.Rd 3ffa16283546c87e5c81190cddd976f8 *man/PreSex.Rd c5cdc599551ae8d2f0a8dbf3a18363df *man/Punishment.Rd 35dd143e4e35bc2b72804ca99e6f746e *man/RepVict.Rd 7c9a39dcc04d539a98407436c5254c20 *man/Rochdale.Rd 250e3176df959f30b160b10b381ac598 *man/Saxony.Rd 57dbc598ae5f4a0b07023d97b9eac55c *man/SexualFun.Rd 57c0d552618bf1b43de02a34883d10a9 *man/SpaceShuttle.Rd 0135b1039084161d9304ac1e9f983467 *man/Suicide.Rd 0b3b7d616076bda3643fea65ec4792f6 *man/Trucks.Rd c4221305498c64d7cce56fd05d38c10b *man/UKSoccer.Rd 43a94ba83e261bac38c238ebc699796c *man/VisualAcuity.Rd 36eba659eb6ae3203f9103a86d41bf5b *man/VonBort.Rd ca83003c80bb9d41eeff4805c4f4df1c *man/WeldonDice.Rd 72e0e324020dbb52d40709c115b30ee4 *man/WomenQueue.Rd 375f4a4b57a06ec645e4072eb8d6154f *man/agreementplot.Rd 54c2063b019623820029897ecede1a4b *man/assoc.Rd e245640865a0d036e5ed49dfc6b22af0 *man/assocstats.Rd 71e4c5635afca020ba5db75d21f7f31d *man/binregplot.Rd 78359b5cf62d25114f272820302e1db8 *man/cd_plot.Rd 09171e763dcdae39764a92d5359965e2 *man/co_table.Rd 8afcfa8a19bab4beb4d92faf331e9582 *man/coindep_test.Rd 281f6312d43af9a9c42e8995fa6c780c *man/cotab_panel.Rd b5c4c80e0a6d00f1c35dcbeb58fcbdb5 *man/cotabplot.Rd bb5bfbce246384f79ff951a6b63437f4 *man/distplot.Rd 2de7a60f40c8eb93e948acfd3cf19641 *man/doubledecker.Rd b0568cd2e02a37d19c49192d2f3dc6d6 *man/fourfold.Rd 558a95508e38e92b2be107b82827549c *man/goodfit.Rd 24347c086dd30cecb12e4aacb1ec2079 *man/grid_barplot.Rd 6891014a51c9b278fe89225e9d251d49 *man/grid_legend.Rd f3084a15ca398a9835c9ba3eae26f773 *man/hls.Rd f9b406c3111ee9cacaa55124de6c9df8 *man/independence_table.Rd 481a6d9dd508a836ca873a394aae6a0d *man/labeling_border.Rd 3157b0cba5092513a78ffb56831d1dee *man/labeling_cells_list.Rd 27d4fe44ee070c974bb1e98308867cae *man/legends.Rd 38edfa781bdfeb423aa717b6a0582555 *man/lodds.Rd 7904c410ad3e24822f9f0d78dbcd628c *man/loddsratio.Rd 6166d08f94e23cb571c4d655eeaa66cd *man/mar_table.Rd 84ec3a3448ec2e133db0e91d616407ee *man/mosaic.Rd 081e08e1bba6835aa647e699797f72bf *man/mplot.Rd 85f62d7c3832f2dfd5ca47bf5461285e *man/pairs.table.Rd 46ebaef3333677ff2a97f125877761b6 *man/panel_pairs_diagonal.Rd af824945edd4d7522002a2b87f6ba31b *man/panel_pairs_off-diagonal.Rd ed140a424046a7e4cc86e10e5c38bdc3 *man/plot.loddsratio.Rd cbba00f8e1c60c89aaa51780b8874db8 *man/plot.loglm.Rd c501827395d3d2d7f5e9146fc66df5d1 *man/rootogram.Rd 7b4b5ec126293aef69413ee13d34dd6b *man/shadings.Rd e04f54efcecd2d29cf85551a75a65974 *man/sieve.Rd bbf41696d0954ad4c99d8dde210baf63 *man/spacings.Rd 9475ef38895fac17d95f0f4b736c6d66 *man/spine.Rd 2149a51497b4073eb51f916ea334130a *man/struc_assoc.Rd 611217513dcb7daf8b38e4943aa8f41a *man/struc_mosaic.Rd fc1960f9cc2480b9101a4b1768e5ddb5 *man/struc_sieve.Rd 518e39ea2ff0d6d0aeeb17c9d961ce50 *man/strucplot.Rd fa8fb60a64c4ac3348dd1c77115aae58 *man/structable.Rd 46c27c579666ca1f114d556cbda0b638 *man/table2d_summary.Rd b7b2ff805cf8f94c6ab19f5b62d5349c *man/ternaryplot.Rd 4324403cb1c03a8f6c228828eefcc56e *man/tile.Rd bec04ba65f65e48db59acafdd14e3caf *man/woolf_test.Rd 60b5a25113c95aef01c2793f797d69aa *tests/demos.R 3849f36c1a503b821b4ba3e8f1286489 *vignettes/residual-shadings.Rnw 0f08ab21c366ba4d4204fae211e89104 *vignettes/struc.pdf fe22f0d95f4098096281d58c459928f9 *vignettes/struc.sxi 36cac2b2d77375961d3c9b940d83730c *vignettes/strucplot.Rnw 2fbfedb02d39f168fb15d5720752d8f4 *vignettes/vcd.bib vcd/DESCRIPTION0000644000175000017500000000303614133320412012661 0ustar nileshnileshPackage: vcd Version: 1.4-9 Title: Visualizing Categorical Data Authors@R: c(person(given = "David", family = "Meyer", role = c("aut", "cre"), email = "David.Meyer@R-project.org"), person(given = "Achim", family = "Zeileis", role = "aut", email = "Achim.Zeileis@R-project.org", comment = c(ORCID = "0000-0003-0918-3766")), person(given = "Kurt", family = "Hornik", role = "aut"), person(given = "Florian", family = "Gerber", role = "ctb"), person(given = "Michael", family = "Friendly", role = "ctb")) Description: Visualization techniques, data sets, summary and inference procedures aimed particularly at categorical data. Special emphasis is given to highly extensible grid graphics. The package was package was originally inspired by the book "Visualizing Categorical Data" by Michael Friendly and is now the main support package for a new book, "Discrete Data Analysis with R" by Michael Friendly and David Meyer (2015). LazyLoad: yes LazyData: yes Depends: R (>= 2.4.0), grid Suggests: KernSmooth, mvtnorm, kernlab, HSAUR3, coin Imports: stats, utils, MASS, grDevices, colorspace, lmtest License: GPL-2 NeedsCompilation: no Packaged: 2021-10-18 15:46:50 UTC; meyer Author: David Meyer [aut, cre], Achim Zeileis [aut] (), Kurt Hornik [aut], Florian Gerber [ctb], Michael Friendly [ctb] Maintainer: David Meyer Repository: CRAN Date/Publication: 2021-10-18 16:30:02 UTC vcd/man/0000755000175000017500000000000014133263040011727 5ustar nileshnileshvcd/man/doubledecker.Rd0000755000175000017500000000623414133262412014660 0ustar nileshnilesh\name{doubledecker} \alias{doubledecker.default} \alias{doubledecker.formula} \alias{doubledecker} \title{Doubledecker Plot} \description{ This function creates a doubledecker plot visualizing a classification rule. } \usage{ \method{doubledecker}{formula}(formula, data = NULL, \dots, main = NULL) \method{doubledecker}{default}(x, depvar = length(dim(x)), margins = c(1,4, length(dim(x)) + 1, 1), gp = gpar(fill = rev(gray.colors(tail(dim(x), 1)))), labeling = labeling_doubledecker, spacing = spacing_highlighting, main = NULL, keep_aspect_ratio = FALSE, \dots) } \arguments{ \item{formula}{a formula specifying the variables used to create a contingency table from \code{data}. The dependent variable is used last for splitting.} \item{data}{either a data frame, or an object of class \code{"table"} or \code{"ftable"}.} \item{x}{a contingency table in array form, with optional category labels specified in the \code{dimnames(x)} attribute.} \item{depvar}{dimension index or character string specifying the dependent variable. That will be sorted last in the table.} \item{margins}{margins of the plot. Note that by default, all factor names (except the last one) and their levels are visualized \emph{as a block} under the plot.} \item{gp}{object of class \code{"gpar"} used for the tiles of the last variable.} \item{labeling}{labeling function or corresponding generating generating function (see \code{\link{strucplot}} for details).} \item{spacing}{spacing object, spacing function or corresponding generating function (see \code{\link{strucplot}} for details).} \item{main}{either a logical, or a character string used for plotting the main title. If \code{main} is \code{TRUE}, the name of the \code{data} object is used.} \item{keep_aspect_ratio}{logical indicating whether the aspect ratio should be maintained or not.} \item{\dots}{Further parameters passed to \code{mosaic}.} } \details{ Doubledecker plots visualize the the dependence of one categorical (typically binary) variable on further categorical variables. Formally, they are mosaic plots with vertical splits for all dimensions (antecedents) except the last one, which represents the dependent variable (consequent). The last variable is visualized by horizontal splits, no space between the tiles, and separate colors for the levels. } \value{ The \code{"structable"} visualized is returned invisibly. } \references{ H. Hoffmann (2001), Generalized odds ratios for visual modeling. \emph{Journal of Computational and Graphical Statistics}, \bold{10}, 4, 628--640. Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. Available as \code{vignette("strucplot", package = "vcd")}. \doi{10.18637/jss.v017.i03}. } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{strucplot}}, \code{\link{mosaic}} } \examples{ data("Titanic") doubledecker(Titanic) doubledecker(Titanic, depvar = "Survived") doubledecker(Survived ~ ., data = Titanic) } \keyword{hplot} vcd/man/Punishment.Rd0000755000175000017500000000274311150520606014361 0ustar nileshnilesh\name{Punishment} \alias{Punishment} \docType{data} \title{Corporal Punishment Data} \description{ Data from a study of the Gallup Institute in Denmark in 1979 about the attitude of a random sample of 1,456 persons towards corporal punishment of children. } \usage{ data("Punishment") } \format{ A data frame with 36 observations and 5 variables. \describe{ \item{Freq}{frequency.} \item{attitude}{factor indicating attitude: (no, moderate) punishment of children.} \item{memory}{factor indicating whether the person had memories of corporal punishment as a child (yes, no).} \item{education}{factor indicating highest level of education (elementary, secondary, high).} \item{age}{factor indicating age group in years (15-24, 25-39, 40-).} } } \note{Anderson (1991) erroneously indicates the total sum of respondents to be 783.} \references{ E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. 2nd edition. Springer-Verlag, Berlin. } \source{ E. B. Andersen (1991), The Statistical Analysis of Categorical Data, pages 207--208. } \examples{ data("Punishment", package = "vcd") pun <- xtabs(Freq ~ memory + attitude + age + education, data = Punishment) ## model: ~ (memory + attitude) * age * education ## use maximum sum-of-squares test/shading cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, n = 5000, type = "assoc", test = "maxchisq", interpolate = 1:2) } \keyword{datasets} vcd/man/Lifeboats.Rd0000755000175000017500000000275011150520606014135 0ustar nileshnilesh\name{Lifeboats} \alias{Lifeboats} \docType{data} \title{Lifeboats on the Titanic} \description{ Data from Mersey (1912) about the 18 (out of 20) lifeboats launched before the sinking of the S. S. Titanic. } \usage{data("Lifeboats")} \format{ A data frame with 18 observations and 8 variables. \describe{ \item{launch}{launch time in \code{"\link{POSIXt}"} format.} \item{side}{factor. Side of the boat.} \item{boat}{factor indicating the boat.} \item{crew}{number of male crew members on board.} \item{men}{number of men on board.} \item{women}{number of women (including female crew) on board.} \item{total}{total number of passengers.} \item{cap}{capacity of the boat.} } } \references{ L. Mersey (1912), Report on the loss of the \dQuote{Titanic} (S. S.). Parliamentary command paper 6452. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ M. Friendly (2000), Visualizing Categorical Data: \url{http://euclid.psych.yorku.ca/ftp/sas/vcd/catdata/lifeboat.sas} } \examples{ data("Lifeboats") attach(Lifeboats) ternaryplot( Lifeboats[,4:6], pch = ifelse(side == "Port", 1, 19), col = ifelse(side == "Port", "red", "blue"), id = ifelse(men / total > 0.1, as.character(boat), NA), prop_size = 2, dimnames_position = "edge", main = "Lifeboats on the Titanic" ) grid_legend(0.8, 0.9, c(1, 19), c("red", "blue"), c("Port", "Starboard"), title = "SIDE") detach(Lifeboats) } \keyword{datasets} vcd/man/table2d_summary.Rd0000655000175000017500000000232712456227164015333 0ustar nileshnilesh\name{table2d_summary} \alias{table2d_summary} \alias{print.table2d_summary} \title{Summary of a 2-way Table} \description{ Prints a 2-way contingency table along with percentages, marginal, and conditional distributions. } \usage{ table2d_summary(object, margins = TRUE, percentages = FALSE, conditionals = c("none", "row", "column"), chisq.test = TRUE, \dots) } \arguments{ \item{object}{a \eqn{r \times c}{r x c}-contingency table} \item{margins}{if \code{TRUE}, marginal distributions are computed.} \item{percentages}{if \code{TRUE}, relative frequencies are computed.} \item{conditionals}{if not \code{"none"}, the conditional distributions, given the row/column factor, are computed.} \item{chisq.test}{if \code{TRUE}, a chi-squared test of independence is carried out.} \item{\dots}{currently not used.} } \value{ Returns invisibly a \eqn{r \times c \times k}{r x c x k} table, \eqn{k} depending on the amount of choices (at most 3). } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{mar_table}}, \code{\link{prop.table}}, \code{\link{independence_table}} } \examples{ data("UCBAdmissions") table2d_summary(margin.table(UCBAdmissions, 1:2)) } \keyword{category} vcd/man/SpaceShuttle.Rd0000755000175000017500000000335611150520606014634 0ustar nileshnilesh\name{SpaceShuttle} \alias{SpaceShuttle} \docType{data} \title{Space Shuttle O-ring Failures} \description{ Data from Dalal et al. (1989) about O-ring failures in the NASA space shuttle program. The damage index comes from a discussion of the data by Tufte (1997). } \usage{ data("SpaceShuttle") } \format{ A data frame with 24 observations and 6 variables. \describe{ \item{FlightNumber}{Number of space shuttle flight.} \item{Temperature}{temperature during start (in degrees F).} \item{Pressure}{pressure.} \item{Fail}{did any O-ring failures occur? (no, yes).} \item{nFailures}{how many (of six) 0-rings failed?.} \item{Damage}{damage index.} } } \references{ S. Dalal, E. B. Fowlkes, B. Hoadly (1989), Risk analysis of the space shuttle: Pre-Challenger prediction of failure, \emph{Journal of the American Statistical Association}, \bold{84}, 945--957. E. R. Tufte (1997), \emph{Visual Explanations: Images and Quantities, Evidence and Narrative}. Graphics Press, Cheshire, CT. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data: \url{http://euclid.psych.yorku.ca/ftp/sas/vcd/catdata/orings.sas} } \examples{ data("SpaceShuttle") plot(nFailures/6 ~ Temperature, data = SpaceShuttle, xlim = c(30, 81), ylim = c(0,1), main = "NASA Space Shuttle O-Ring Failures", ylab = "Estimated failure probability", pch = 19, col = 4) fm <- glm(cbind(nFailures, 6 - nFailures) ~ Temperature, data = SpaceShuttle, family = binomial) lines(30 : 81, predict(fm, data.frame(Temperature = 30 : 81), type = "re"), lwd = 2) abline(v = 31, lty = 3) } \keyword{datasets} vcd/man/NonResponse.Rd0000755000175000017500000000164511150520606014500 0ustar nileshnilesh\name{NonResponse} \alias{NonResponse} \docType{data} \title{Non-Response Survey Data} \description{ Data about non-response for a Danish survey in 1965. } \usage{ data("NonResponse") } \format{ A data frame with 12 observations and 4 variables. \describe{ \item{Freq}{frequency.} \item{residence}{factor indicating whether residence was in Copenhagen, in a city outside Copenhagen or at the countryside (Copenhagen, City, Country).} \item{response}{factor indicating whether a response was given (yes, no).} \item{gender}{factor indicating gender (male, female).} } } \references{ E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. 2nd edition. Springer-Verlag, Berlin. } \source{ E. B. Andersen (1991), The Statistical Analysis of Categorical Data, Table 5.17. } \examples{ data("NonResponse") structable(~ ., data = NonResponse) } \keyword{datasets} vcd/man/DanishWelfare.Rd0000755000175000017500000000230011150520606014730 0ustar nileshnilesh\name{DanishWelfare} \alias{DanishWelfare} \docType{data} \title{Danish Welfare Study Data} \description{ Data from the Danish Welfare Study. } \usage{data("DanishWelfare")} \format{ A data frame with 180 observations and 5 variables. \describe{ \item{Freq}{frequency.} \item{Alcohol}{factor indicating daily alcohol consumption: less than 1 unit (<1), 1-2 units (1-2) or more than 2 units (>2). 1 unit is approximately 1 bottle of beer or 4cl 40\% alcohol.} \item{Income}{factor indicating income group in 1000 DKK (0-50, 50-100, 100-150, >150).} \item{Status}{factor indicating marriage status (Widow, Married, Unmarried).} \item{Urban}{factor indicating urbanization: Copenhagen (Copenhagen), Suburbian Copenhagen (SubCopenhagen), three largest cities (LargeCity), other cities (City), countryside (Country).} } } \references{ E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. 2nd edition. Springer-Verlag, Berlin. } \source{ E. B. Andersen (1991), The Statistical Analysis of Categorical Data, page 205. } \examples{ data("DanishWelfare") ftable(xtabs(Freq ~ ., data = DanishWelfare)) } \keyword{datasets} vcd/man/Trucks.Rd0000755000175000017500000000313012214055644013500 0ustar nileshnilesh\name{Trucks} \alias{Trucks} \docType{data} \title{Truck Accidents Data} \description{ Data from a study in England in two periods from November 1969 to October 1971 and November 1971 to October 1973. A new compulsory safety measure for trucks was introduced in October 1971. Therefore, the question is whether the safety measure had an effect on the number of accidents and on the point of collision on the truck. } \usage{ data("Trucks") } \format{ A data frame with 24 observations on 5 variables. \describe{ \item{Freq}{frequency of accidents involving trucks.} \item{period}{factor indicating time period (before, after) 1971-11-01.} \item{collision}{factor indicating whether the collision was in the back or forward (including the front and the sides) of the truck (back, forward).} \item{parked}{factor indicating whether the truck was parked (yes, no).} \item{light}{factor indicating light conditions: day light (daylight), night on an illuminated road (night, illuminate), night on a dark road (night, dark).} } } \references{ E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. 2nd edition. Springer-Verlag, Berlin. } \source{ E. B. Andersen (1991), The Statistical Analysis of Categorical Data, Table 6.8. } \examples{ library(MASS) data("Trucks") tab <- xtabs(Freq ~ period + collision + light + parked, data = Trucks) loglm(~ (collision + period) * parked * light, data = tab) doubledecker(collision ~ parked + light + period, data = tab) cotabplot(tab, panel = cotab_coindep) } \keyword{datasets} vcd/man/struc_assoc.Rd0000655000175000017500000000756514133262673014600 0ustar nileshnilesh\name{struc_assoc} \alias{struc_assoc} \title{Core-generating Function for Association Plots} \description{ Core-generating function for \code{strucplot} returning a function producing association plots. } \usage{ struc_assoc(compress = TRUE, xlim = NULL, ylim = NULL, yspace = unit(0.5, "lines"), xscale = 0.9, gp_axis = gpar(lty = 3)) } \arguments{ \item{compress}{logical; if \code{FALSE}, the space between the rows (columns) are chosen such that the \emph{total} heights (widths) of the rows (column) are all equal. If \code{TRUE}, the space between the rows and columns is fixed and hence the plot is more \dQuote{compressed}.} \item{xlim}{either a \eqn{2 \times k}{2 x k} matrix of doubles, \eqn{k} the number of total columns of the plot, or a recycled vector from which such a matrix will be constructed. The columns of \code{xlim} correspond to the columns of the association plot, the rows describe the column ranges (minimums in the first row, maximums in the second row). If \code{xlim} is \code{NULL}, the ranges are determined from the residuals according to \code{compress} (if \code{TRUE}: widest range from each column, if \code{FALSE}: from the whole association plot matrix).} \item{ylim}{either a \eqn{2 \times k}{2 x k} matrix of doubles, \eqn{k} the number of total rows of the plot, or a recycled vector from which such a matrix will be constructed. The columns of \code{ylim} correspond to the rows of the association plot, the rows describe the column ranges (minimums in the first row, maximums in the second row). If \code{ylim} is \code{NULL}, the ranges are determined from the residuals according to \code{compress} (if \code{TRUE}: widest range from each row, if \code{FALSE}: from the whole association plot matrix).} \item{xscale}{scale factor resizing the tile's width, thus adding additional space between the tiles. } \item{yspace}{object of class \code{"unit"} specifying additional space separating the rows.} \item{gp_axis}{object of class \code{"gpar"} specifying the visual aspects of the tiles' baseline.} } \details{ This function is usually called by \code{strucplot} (typically when called by \code{assoc}) and returns a function used by \code{strucplot} to produce association plots. } \value{ A function with arguments: \item{residuals}{table of residuals.} \item{observed}{not used by \code{struc_assoc}.} \item{expected}{table of expected frequencies.} \item{spacing}{object of class \code{"unit"} specifying the space between the tiles.} \item{gp}{list of \code{gpar} objects used for the drawing the tiles.} \item{split_vertical}{vector of logicals indicating, for each dimension of the table, the split direction.} } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{assoc}}, \code{\link{strucplot}}, \code{\link{structable}} } \references{ Cohen, A. (1980), On the graphical display of the significant components in a two-way contingency table. \emph{Communications in Statistics---Theory and Methods}, \bold{A9}, 1025--1041. Friendly, M. (1992), Graphical methods for categorical data. \emph{SAS User Group International Conference Proceedings}, \bold{17}, 190--200. \url{http://datavis.ca/papers/sugi/sugi17.pdf} Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. Available as \code{vignette("strucplot", package = "vcd")}. \doi{10.18637/jss.v017.i03}. } \examples{ ## UCB Admissions data("UCBAdmissions") ucb <- aperm(UCBAdmissions) ## association plot for conditional independence strucplot(ucb, expected = ~ Dept * (Admit + Gender), core = struc_assoc(ylim = c(-4, 4)), labeling_args = list(abbreviate = c(Admit = 3))) } \keyword{hplot} vcd/man/rootogram.Rd0000655000175000017500000001531412511045112014231 0ustar nileshnilesh\name{rootogram} \alias{rootogram} \alias{rootogram.default} \alias{rootogram.goodfit} \title{Rootograms} \description{ Rootograms of observed and fitted values. } \usage{ \method{rootogram}{default}(x, fitted, names = NULL, scale = c("sqrt", "raw"), type = c("hanging", "standing", "deviation"), shade = FALSE, legend = TRUE, legend_args = list(x = 0, y = 0.2, height = 0.6), df = NULL, rect_gp = NULL, rect_gp_args = list(), lines_gp = gpar(col = "red", lwd = 2), points_gp = gpar(col = "red"), pch = 19, xlab = NULL, ylab = NULL, ylim = NULL, main = NULL, sub = NULL, margins = unit(0, "lines"), title_margins = NULL, legend_width = NULL, main_gp = gpar(fontsize = 20), sub_gp = gpar(fontsize = 15), name = "rootogram", prefix = "", keep_aspect_ratio = FALSE, newpage = TRUE, pop = TRUE, return_grob = FALSE, \dots) } \arguments{ \item{x}{either a vector or a 1-way table of frequencies.} \item{fitted}{a vector of fitted frequencies.} \item{names}{a vector of names passed to \code{\link{grid_barplot}}, if set to \code{NULL} the names of \code{x} are used.} \item{scale}{a character string indicating whether the values should be plotted on the raw or square root scale.} \item{type}{a character string indicating if the bars for the observed frequencies should be \code{hanging} or \code{standing} or indicate the \code{deviation} between observed and fitted frequencies.} \item{shade}{logical specifying whether \code{rect_gp} should be set to colors corresponding to the pearson residuals, i.e., if a residual-based shading should be applied to the bars.} \item{legend}{either a legend-generating function, or a legend function (see details and \code{\link{legends}}), or a logical. If \code{legend} is \code{NULL} or \code{TRUE} and \code{gp} is a function, legend defaults to \code{\link{legend_resbased}}.} \item{legend_args}{list of arguments for the legend-generating function, if specified.} \item{df}{degrees of freedom passed to the shading functions used for inference.} \item{rect_gp}{a \code{"gpar"} object controlling the grid graphical parameters of the rectangles, shading function or a corresponding generating function (see \code{\link{shadings}}). If unspecified and no shading is applied, defaults to light grey fill color for the bars.} \item{rect_gp_args}{list of arguments for the shading-generating function, if specified for \code{rect_gp}.} \item{lines_gp}{a \code{"gpar"} object controlling the grid graphical parameters of the lines.} \item{points_gp}{a \code{"gpar"} object controlling the grid graphical parameters of the points.} \item{pch}{plotting character for the points.} \item{xlab}{a label for the x axis.} \item{ylab}{a label for the y axis.} \item{ylim}{limits for the y axis.} \item{main}{either a logical, or a character string used for plotting the main title. If \code{main} is a logical and \code{TRUE}, the name of the object supplied as \code{x} is used.} \item{sub}{a character string used for plotting the subtitle. If \code{sub} is a logical and \code{TRUE} and \code{main} is unspecified, the name of the object supplied as \code{x} is used.} \item{margins}{either an object of class \code{"unit"} of length 4, or a numeric vector of length 4. The elements are recycled as needed. The four components specify the top, right, bottom, and left margin of the plot, respectively. When a numeric vector is supplied, the numbers are interpreted as \code{"lines"} units. In addition, the unit or numeric vector may have named arguments (\samp{top}, \samp{right}, \samp{bottom}, and \samp{left}), in which case the non-named arguments specify the default values (recycled as needed), overloaded by the named arguments.} \item{title_margins}{either an object of class \code{"unit"} of length 2, or a numeric vector of length 2. The elements are recycled as needed. The two components specify the top and bottom \emph{title} margin of the plot, respectively. The default for each \emph{specified} title are 2 lines (and 0 else), except when a legend is plotted and \code{keep_aspect_ratio} is \code{TRUE}: in this case, the default values of both margins are set as to align the heights of legend and actual plot. When a numeric vector is supplied, the numbers are interpreted as \code{"lines"} units. In addition, the unit or numeric vector may have named arguments (\samp{top} and \samp{bottom}), in which case the non-named argument specify the default value (recycled as needed), overloaded by the named arguments.} \item{legend_width}{An object of class \code{"unit"} of length 1 specifying the width of the legend (if any). Default: 5 lines.} \item{main_gp, sub_gp}{object of class \code{"gpar"} containing the graphical parameters used for the main (sub) title, if specified.} \item{name}{name of the plotting viewport.} \item{keep_aspect_ratio}{logical indicating whether the aspect ratio should be fixed or not.} \item{prefix}{optional character string used as a prefix for the generated viewport and grob names.} \item{newpage}{logical. Should \code{\link{grid.newpage}} be called before plotting?} \item{pop}{logical. Should the viewport created be popped?} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{\dots}{further arguments passed to \code{\link{grid_barplot}}.} } \details{ The observed frequencies are displayed as bars and the fitted frequencies as a line. By default a sqrt scale is used to make the smaller frequencies more visible. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org}, David Meyer \email{David.Meyer@R-project.org} } \references{ J. W. Tukey (1977), \emph{Exploratory Data Analysis}. Addison Wesley, Reading, MA. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \seealso{\code{\link{grid_barplot}}} \examples{ ## Simulated data examples: dummy <- rnbinom(200, size = 1.5, prob = 0.8) observed <- table(dummy) fitted1 <- dnbinom(as.numeric(names(observed)), size = 1.5, prob = 0.8) * sum(observed) fitted2 <- dnbinom(as.numeric(names(observed)), size = 2, prob = 0.6) * sum(observed) rootogram(observed, fitted1) rootogram(observed, fitted2) ## Real data examples: data("HorseKicks") HK.fit <- goodfit(HorseKicks) summary(HK.fit) plot(HK.fit) ## or equivalently rootogram(HK.fit) data("Federalist") F.fit <- goodfit(Federalist, type = "nbinomial") summary(F.fit) plot(F.fit) ## (Pearson) residual-based shading data("Federalist") Fed_fit0 <- goodfit(Federalist, type = "poisson") plot(Fed_fit0, shade = TRUE) } \keyword{hplot} vcd/man/distplot.Rd0000644000175000017500000000763012610700606014070 0ustar nileshnilesh\name{distplot} \alias{distplot} \title{Diagnostic Distribution Plots} \description{ Diagnostic distribution plots: poissonness, binomialness and negative binomialness plots. } \usage{ distplot(x, type = c("poisson", "binomial", "nbinomial"), size = NULL, lambda = NULL, legend = TRUE, xlim = NULL, ylim = NULL, conf_int = TRUE, conf_level = 0.95, main = NULL, xlab = "Number of occurrences", ylab = "Distribution metameter", gp = gpar(cex = 0.8), lwd=2, gp_conf_int = gpar(lty = 2), name = "distplot", newpage = TRUE, pop =TRUE, return_grob = FALSE, \dots) } \arguments{ \item{x}{either a vector of counts, a 1-way table of frequencies of counts or a data frame or matrix with frequencies in the first column and the corresponding counts in the second column.} \item{type}{a character string indicating the distribution.} \item{size}{the size argument for the binomial and negative binomial distribution. If set to \code{NULL} and \code{type} is \code{"binomial"}, then \code{size} is taken to be the maximum count. If set to \code{NULL} and \code{type} is \code{"nbinomial"}, then \code{size} is estimated from the data.} \item{lambda}{parameter of the poisson distribution. If type is \code{"poisson"} and \code{lambda} is specified a leveled poissonness plot is produced.} \item{legend}{logical. Should a legend be plotted?} \item{xlim}{limits for the x axis.} \item{ylim}{limits for the y axis.} \item{conf_int}{logical. Should confidence intervals be plotted?} \item{conf_level}{confidence level for confidence intervals.} \item{main}{a title for the plot.} \item{xlab}{a label for the x axis.} \item{ylab}{a label for the y axis.} \item{gp}{a \code{"gpar"} object controlling the grid graphical parameters of the points.} \item{gp_conf_int}{a \code{"gpar"} object controlling the grid graphical parameters of the confidence intervals.} \item{lwd}{line width for the fitted line} \item{name}{name of the plotting viewport.} \item{newpage}{logical. Should \code{\link{grid.newpage}} be called before plotting?} \item{pop}{logical. Should the viewport created be popped?} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{\dots}{further arguments passed to \code{\link{grid.points}}.} } \details{ \code{distplot} plots the number of occurrences (counts) against the distribution metameter of the specified distribution. If the distribution fits the data, the plot should show a straight line. See Friendly (2000) for details. In these plots, the open points show the observed count metameters; the filled points show the confidence interval centers, and the dashed lines show the \code{conf_level} confidence intervals for each point. } \value{ Returns invisibly a data frame containing the counts (\code{Counts}), frequencies (\code{Freq}) and other details of the computations used to construct the plot. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \references{ D. C. Hoaglin (1980), A poissonness plot, \emph{The American Statistican}, \bold{34}, 146--149. D. C. Hoaglin & J. W. Tukey (1985), Checking the shape of discrete distributions. In D. C. Hoaglin, F. Mosteller, J. W. Tukey (eds.), \emph{Exploring Data Tables, Trends and Shapes}, chapter 9. John Wiley & Sons, New York. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \examples{ ## Simulated data examples: dummy <- rnbinom(1000, size = 1.5, prob = 0.8) distplot(dummy, type = "nbinomial") ## Real data examples: data("HorseKicks") data("Federalist") data("Saxony") distplot(HorseKicks, type = "poisson") distplot(HorseKicks, type = "poisson", lambda = 0.61) distplot(Federalist, type = "poisson") distplot(Federalist, type = "nbinomial", size = 1) distplot(Federalist, type = "nbinomial") distplot(Saxony, type = "binomial", size = 12) } \keyword{category} vcd/man/spacings.Rd0000755000175000017500000000631714133262637014052 0ustar nileshnilesh\name{spacings} \alias{spacings} \alias{spacing_highlighting} \alias{spacing_equal} \alias{spacing_dimequal} \alias{spacing_increase} \alias{spacing_conditional} \title{Spacing-generating Functions} \description{ These functions generate spacing functions to be used with \code{\link{strucplot}} to obtain customized spaces between the elements of a strucplot. } \usage{ spacing_equal(sp = unit(0.3, "lines")) spacing_dimequal(sp) spacing_increase(start = unit(0.3, "lines"), rate = 1.5) spacing_conditional(sp = unit(0.3, "lines"), start = unit(2, "lines"), rate = 1.8) spacing_highlighting(start = unit(0.2, "lines"), rate = 1.5) } \arguments{ \item{start}{object of class \code{"unit"} indicating the start value for increasing spacings.} \item{rate}{increase rate for spacings.} \item{sp}{object of class \code{"unit"} specifying a fixed spacing.} } \details{ These generating functions return a function used by \code{\link{strucplot}} to generate appropriate spaces between tiles of a strucplot, using the \code{dimnames} information of the visualized table. \code{spacing_equal} allows to specify one fixed space for \emph{all} dimensions. \code{spacing_dimequal} allows to specify a fixed space for \emph{each} dimension. \code{spacing_increase} creates increasing spaces for all dimensions, based on a starting value and an increase rate. \code{spacing_conditional} combines \code{spacing_equal} and \code{spacing_increase} to create fixed spaces for conditioned dimensions, and increasing spaces for conditioning dimensions. \code{spacing_highlighting} is essentially \code{spacing_conditional} but with the space of the last dimension set to 0. With a corresponding color scheme, this gives the impression of the last class being \sQuote{highlighted} in the penultimate class (as, e.g., in \code{\link{doubledecker}} plots). } \value{ A spacing function with arguments: \item{d}{\code{"dim"} attribute of a contingency table.} \item{condvars}{index vector of conditioning dimensions (currently only used by \code{spacing_conditional}).} This function computes a list of objects of class \code{"unit"}. Each list element contains the spacing information for the corresponding dimension of the table. The length of the \code{"unit"} objects is \eqn{k-1}, \eqn{k} number of levels of the corresponding factor. } \author{ David Meyer \email{David.Meyer@R-project.org} } \references{ Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. Available as \code{vignette("strucplot", package = "vcd")}. \doi{10.18637/jss.v017.i03}. } \seealso{ \code{\link{strucplot}}, \code{\link{doubledecker}} } \examples{ data("Titanic") strucplot(Titanic, spacing = spacing_increase(start = 0.5, rate = 1.5)) strucplot(Titanic, spacing = spacing_equal(1)) strucplot(Titanic, spacing = spacing_dimequal(1:4 / 4)) strucplot(Titanic, spacing = spacing_highlighting, gp = gpar(fill = c("light gray","dark gray"))) data("PreSex") strucplot(aperm(PreSex, c(1,4,2,3)), spacing = spacing_conditional, condvars = 2) } \keyword{hplot} vcd/man/Bundesliga.Rd0000655000175000017500000000415113731736014014307 0ustar nileshnilesh\name{Bundesliga} \alias{Bundesliga} \title{Ergebnisse der Fussball-Bundesliga} \description{ Results from the first German soccer league (1963-2008). } \usage{ data("Bundesliga") } \format{A data frame with 14018 observations and 7 variables. \describe{ \item{HomeTeam}{factor. Name of the home team.} \item{AwayTeam}{factor. Name of the away team.} \item{HomeGoals}{number of goals scored by the home team.} \item{AwayGoals}{number of goals scored by the away team.} \item{Round}{round of the game.} \item{Year}{year in which the season started.} \item{Date}{starting time of the game (in \code{"POSIXct"} format).} } } \details{ The data comprises all games in the first German soccer league since its foundation in 1963. The data have been queried online from the official Web page of the DFB and prepared as a data frame in R by Daniel Dekic, Torsten Hothorn, and Achim Zeileis (replacing earlier versions of the data in the package containing only subsets of years). Each year/season comprises 34 rounds (except 1963, 1964, 1991) so that all 18 teams play twice against each other (switching home court advantage). In 1963/64, there were only 16 teams, hence only 30 rounds. In 1991, after the German unification, there was one season with 20 teams and 38 rounds. } \source{ Homepage of the Deutscher Fussball-Bund (DFB, German Football Association): \url{https://www.dfb.de/index/} } \references{ Leonhard Knorr-Held (1999), Dynamic rating of sports teams. SFB 386 \dQuote{Statistical Analysis of Discrete Structures}, Discussion paper \bold{98}. } \seealso{ \code{\link{UKSoccer}} } \examples{ data("Bundesliga") ## number of goals per game poisson distributed? ngoals1 <- xtabs(~ HomeGoals, data = Bundesliga, subset = Year == 1995) ngoals2 <- xtabs(~ AwayGoals, data = Bundesliga, subset = Year == 1995) ngoals3 <- table(apply(subset(Bundesliga, Year == 1995)[,3:4], 1, sum)) gf1 <- goodfit(ngoals1) gf2 <- goodfit(ngoals2) gf3 <- goodfit(ngoals3) summary(gf1) summary(gf2) summary(gf3) plot(gf1) plot(gf2) plot(gf3) Ord_plot(ngoals1) distplot(ngoals1) } \keyword{datasets} vcd/man/Baseball.Rd0000755000175000017500000000455111235655776013760 0ustar nileshnilesh\name{Baseball} \alias{Baseball} \docType{data} \title{Baseball Data} \description{ Baseball data. } \usage{ data("Baseball") } \format{ A data frame with 322 observations and 25 variables. \describe{ \item{name1}{player's first name.} \item{name2}{player's last name.} \item{atbat86}{times at Bat: number of official plate appearances by a hitter. It counts as an official at-bat as long as the batter does not walk, sacrifice, get hit by a pitch or reach base due to catcher's interference.} \item{hits86}{hits.} \item{homer86}{home runs.} \item{runs86}{the number of runs scored by a player. A run is scored by an offensive player who advances from batter to runner and touches first, second, third and home base in that order without being put out.} \item{rbi86}{Runs Batted In: A hitter earns a run batted in when he drives in a run via a hit, walk, sacrifice (bunt or fly) fielder's choice, hit-batsman or on an error (when the official scorer rules that the run would have scored anyway).} \item{walks86}{A \dQuote{walk} (or \dQuote{base on balls}) is an award of first base granted to a batter who receives four pitches outside the strike zone.} \item{years}{Years in the Major Leagues. Seems to count all years a player has actually played in the Major Leagues, not necessarily consecutive.} \item{atbat}{career times at bat.} \item{hits}{career hits.} \item{homeruns}{career home runs.} \item{runs}{career runs.} \item{rbi}{career runs batted in.} \item{walks}{career walks.} \item{league86}{player's league.} \item{div86}{player's division.} \item{team86}{player's team.} \item{posit86}{player's position (see \code{\link{Hitters}}).} \item{outs86}{number of putouts (see \code{\link{Hitters}})} \item{assist86}{number of assists (see \code{\link{Hitters}})} \item{error86}{number of assists (see \code{\link{Hitters}})} \item{sal87}{annual salary on opening day (in USD 1000).} \item{league87}{league in 1987.} \item{team87}{team in 1987.} } } \references{ M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ SAS System for Statistical Graphics, First Edition, page A2.3 } \seealso{\code{\link{Hitters}}} \examples{ data("Baseball") } \keyword{datasets} vcd/man/legends.Rd0000644000175000017500000000743114133262532013651 0ustar nileshnilesh\name{legends} \alias{legends} \alias{legend_resbased} \alias{legend_fixed} \title{Legend Functions for Strucplots} \description{ These functions generate legend functions for residual-based shadings. } \usage{ legend_resbased(fontsize = 12, fontfamily = "", x = unit(1, "lines"), y = unit(0.1,"npc"), height = unit(0.8, "npc"), width = unit(0.7, "lines"), digits = 2, pdigits = max(1, getOption("digits") - 2), check_overlap = TRUE, text = NULL, steps = 200, ticks = 10, pvalue = TRUE, range = NULL) legend_fixed(fontsize = 12, fontfamily = "", x = unit(1, "lines"), y = NULL, height = NULL, width = unit(1.5, "lines"), steps = 200, digits = 1, space = 0.05, text = NULL, range = NULL) } \arguments{ \item{fontsize}{fontsize of title and p-value text.} \item{fontfamily}{fontfamily of all text.} \item{x, y}{objects of class \code{"unit"} indicating the coordinates of the title. For \code{legend_fixed}, the default for \code{y} is computed as to leave enough space for the specified \code{text}.} \item{height, width}{object of class \code{"unit"} indicating the height/width of the legend. For \code{legend_fixed}, the default for \code{y} is computed as to align upper margins of legend and actual plot.} \item{digits}{number of digits for the scale labels.} \item{pdigits}{number of digits for the p-value.} \item{check_overlap}{logical indicating whether overlap of scale labels should be inhibited or not.} \item{space}{For \code{legend_fixed} only: proportion of space between the tiles.} \item{text}{character string indicating the title of the legend.} \item{steps}{granularity of the color gradient.} \item{ticks}{number of scale ticks.} \item{pvalue}{logical indicating whether the \eqn{p}-value should be visualized under the scale or not.} \item{range}{Numeric vector of length 2 for setting the legend range. Computed from the residuals if omitted. \code{NA} values are replaced by the corresponding minimum / maximum of the residuals.} } \value{ A function with arguments: \item{residuals}{residuals from the fitted independence model to be visualized.} \item{shading}{shading function computing colors from residuals (see details).} \item{autotext}{character vector indicating the title to be used when no \code{text} argument is specified. Allows strucplot to generate sensible defaults depending on the residuals type.} } \details{ These functions generate legend functions for residual-based shadings, visualizing deviations from expected values of an hypothesized independence model. Therefore, the legend uses a supplied shading function to visualize the color gradient for the residuals range. \code{legend_fixed} is inspired by the legend used in \code{\link[graphics]{mosaicplot}}. For more details on the shading functions and their return values, see \code{\link{shadings}}. } \references{ Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. Available as \code{vignette("strucplot", package = "vcd")}. \doi{10.18637/jss.v017.i03}. Meyer, D., Zeileis, A., Hornik, K. (2003), Visualizing independence using extended association plots. \emph{Proceedings of the 3rd International Workshop on Distributed Statistical Computing}, K. Hornik, F. Leisch, A. Zeileis (eds.), ISSN 1609-395X. \url{https://www.R-project.org/conferences/DSC-2003/Proceedings/} } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{structable}}, \code{\link{shadings}} } \examples{ data("Titanic") mosaic(Titanic, shade = TRUE, legend = legend_resbased) mosaic(Titanic, shade = TRUE, legend = legend_fixed, gp = shading_Friendly) } \keyword{hplot} vcd/man/strucplot.Rd0000655000175000017500000002664514133262747014311 0ustar nileshnilesh\name{strucplot} \alias{strucplot} \title{Structured Displays of Contingency Tables} \description{ This modular function visualizes certain aspects of high-dimensional contingency tables in a hierarchical way. } \usage{ strucplot(x, residuals = NULL, expected = NULL, condvars = NULL, shade = NULL, type = c("observed", "expected"), residuals_type = NULL, df = NULL, split_vertical = NULL, spacing = spacing_equal, spacing_args = list(), gp = NULL, gp_args = list(), labeling = labeling_border, labeling_args = list(), core = struc_mosaic, core_args = list(), legend = NULL, legend_args = list(), main = NULL, sub = NULL, margins = unit(3, "lines"), title_margins = NULL, legend_width = NULL, main_gp = gpar(fontsize = 20), sub_gp = gpar(fontsize = 15), newpage = TRUE, pop = TRUE, return_grob = FALSE, keep_aspect_ratio = NULL, prefix = "", \dots) } \arguments{ \item{x}{a contingency table in array form, with optional category labels specified in the \code{dimnames} attribute.} \item{residuals}{optionally, an array of residuals of the same dimension as \code{x} (see details).} \item{expected}{optionally, an array of expected values of the same dimension as \code{x}, or alternatively the corresponding independence model specification as used by \code{\link[stats]{loglin}} or \code{\link[MASS]{loglm}} (see details).} \item{df}{degrees of freedom passed to the shading functions used for inference. Will be calculated (and overwritten if specified) if both \code{expected} and \code{residuals} are \code{NULL}, or if \code{expected} is given a formula.} \item{condvars}{number of conditioning variables, if any; those are expected to be ordered first in the table. This information is used for computing the expected values, and is also passed to the spacing functions (see \code{\link{spacings}}).} \item{shade}{logical specifying whether \code{gp} should be used or not (see \code{gp}). If \code{TRUE} and \code{expected} is unspecified, a default model is fitted: if \code{condvars} is specified, a corresponding conditional independence model, and else the total independence model.} \item{residuals_type}{a character string indicating the type of residuals to be computed when none are supplied. If \code{residuals} is \code{NULL}, \code{residuals_type} must be one of \code{"pearson"} (default; giving components of Pearson's chi-squared), \code{"deviance"} (giving components of the likelihood ratio chi-squared), or \code{"FT"} for the Freeman-Tukey residuals. The value of this argument can be abbreviated. If \code{residuals} are specified, the value of \code{residuals_type} is just passed \dQuote{as is} to the legend function.} \item{type}{a character string indicating whether the observed or the expected values of the table should be visualized.} \item{split_vertical}{vector of logicals of length \eqn{k}, where \eqn{k} is the number of margins of \code{x} (values are recycled as needed). A \code{TRUE} component indicates that the tile(s) of the corresponding dimension should be split vertically, \code{FALSE} means horizontal splits. Default is \code{FALSE.}} \item{spacing}{spacing object, spacing function, or a corresponding generating function (see details and \code{\link{spacings}}).} \item{spacing_args}{list of arguments for the spacing-generating function, if specified.} \item{gp}{object of class \code{"gpar"}, shading function or a corresponding generating function (see details and \code{\link{shadings}}). Components of \code{"gpar"} objects are recycled as needed along the last splitting dimension. Ignored if \code{shade = FALSE}.} \item{gp_args}{list of arguments for the shading-generating function, if specified.} \item{labeling}{either a logical, or a labeling function, or a corresponding generating function (see details and \code{\link{labelings}}. If \code{FALSE} or \code{NULL}, no labeling is produced.} \item{labeling_args}{list of arguments for the labeling-generating function, if specified.} \item{core}{either a core function, or a corresponding generating function (see details). Currently, generating functions for mosaic plots (\code{\link{struc_mosaic}}), association plots (\code{\link{struc_assoc}}), and sieve plots (\code{\link{struc_sieve}}) are provided.} \item{core_args}{list of arguments for the core-generating function, if specified.} \item{legend}{either a legend-generating function, or a legend function (see details and \code{\link{legends}}), or a logical. If \code{legend} is \code{NULL} or \code{TRUE} and \code{gp} is a function, legend defaults to \code{\link{legend_resbased}}.} \item{legend_args}{list of arguments for the legend-generating function, if specified.} \item{main}{either a logical, or a character string used for plotting the main title. If \code{main} is a logical and \code{TRUE}, the name of the object supplied as \code{x} is used.} \item{sub}{a character string used for plotting the subtitle. If \code{sub} is a logical and \code{TRUE} and \code{main} is unspecified, the name of the object supplied as \code{x} is used.} \item{margins}{either an object of class \code{"unit"} of length 4, or a numeric vector of length 4. The elements are recycled as needed. The four components specify the top, right, bottom, and left margin of the plot, respectively. When a numeric vector is supplied, the numbers are interpreted as \code{"lines"} units. In addition, the unit or numeric vector may have named arguments (\samp{top}, \samp{right}, \samp{bottom}, and \samp{left}), in which case the non-named arguments specify the default values (recycled as needed), overloaded by the named arguments.} \item{title_margins}{either an object of class \code{"unit"} of length 2, or a numeric vector of length 2. The elements are recycled as needed. The two components specify the top and bottom \emph{title} margin of the plot, respectively. The default for each \emph{specified} title are 2 lines (and 0 else), except when a legend is plotted and \code{keep_aspect_ratio} is \code{TRUE}: in this case, the default values of both margins are set as to align the heights of legend and actual plot. When a numeric vector is supplied, the numbers are interpreted as \code{"lines"} units. In addition, the unit or numeric vector may have named arguments (\samp{top} and \samp{bottom}), in which case the non-named argument specify the default value (recycled as needed), overloaded by the named arguments.} \item{legend_width}{An object of class \code{"unit"} of length 1 specifying the width of the legend (if any). Default: 5 lines.} \item{pop}{logical indicating whether the generated viewport tree should be removed at the end of the drawing or not.} \item{main_gp, sub_gp}{object of class \code{"gpar"} containing the graphical parameters used for the main (sub) title, if specified.} \item{newpage}{logical indicating whether a new page should be created for the plot or not.} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{keep_aspect_ratio}{logical indicating whether the aspect ratio should be fixed or not. If unspecified, the default is \code{TRUE} for two-dimensional tables and \code{FALSE} otherwise.} \item{prefix}{optional character string used as a prefix for the generated viewport and grob names.} \item{\dots}{For convenience, list of arguments passed to the labeling-generating function used.} } \details{ This function---usually called by higher-level functions such as \code{\link{assoc}} and \code{\link{mosaic}}---generates conditioning plots of contingency tables. First, it sets up a set of viewports for main- and subtitles, legend, and the actual plot region. Then, residuals are computed as needed from observed and expected frequencies, where the expected frequencies are optionally computed for a specified independence model. Finally, the specified functions for spacing, gp, main plot, legend, and labeling are called to produce the plot. The function invisibly returns the \code{"structable"} object visualized. Most elements of the plot, such as the core function, the spacing between the tiles, the shading of the tiles, the labeling, and the legend, are modularized in graphical appearance control (``grapcon'') functions and specified as parameters. For each element \emph{foo} (= \code{spacing}, \code{labeling}, \code{core}, or \code{legend}), \code{strucplot} takes two arguments: \var{foo} and \var{foo\_args}, which can be used to specify the parameters in the following alternative ways: \enumerate{ \item Passing a suitable function to \var{foo} which subsequently will be called from \code{strucplot} to compute shadings, labelings, etc. \item Passing a corresponding \emph{generating} function to \var{foo}, along with parameters passed to \var{foo\_args}, that generates such a function. Generating functions must inherit from classes \code{"grapcon_generator"} and \code{"}\var{foo}\code{"}. \item Except for the shading functions (\var{shading\_bar}), passing \var{foo(foo\_args)} to the \var{foo} argument. \item For shadings and spacings, passing the final parameter object itself; see the corresponding help pages for more details on the data structures. } If legends are drawn, a \sQuote{cinemascope}-like layout is used for the plot to preserve the 1:1 aspect ratio. If \code{type = "expected"}, the expected values are passed to the \code{observed} argument of the core function, and the observed values to the \code{expected} argument. Although the \code{gp} argument is typically used for shading, it can be used for arbitrary modifications of the tiles' graphics parameters (e.g., for highlighting particular cells, etc.). } \note{ The created viewports, as well as the tiles and bullets, are named and thus can conveniently modified after a plot has been drawn (and \code{pop = FALSE}). } \value{ Invisibly, an object of class \code{"structable"} corresponding to the plot. If \code{return_grob} is \code{TRUE}, additionally, the plot as a grob object is returned in a \code{grob} attribute. } \author{ David Meyer \email{David.Meyer@R-project.org} } \references{ Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. Available as \code{vignette("strucplot", package = "vcd")}. \doi{10.18637/jss.v017.i03}. } \seealso{ \code{\link{assoc}}, \code{\link{mosaic}}, \code{\link{sieve}}, \code{\link{struc_assoc}}, \code{\link{struc_sieve}}, \code{\link{struc_mosaic}}, \code{\link{structable}}, \code{\link{doubledecker}}, \code{\link{labelings}}, \code{\link{shadings}}, \code{\link{legends}}, \code{\link{spacings}} } \examples{ data("Titanic") strucplot(Titanic) strucplot(Titanic, core = struc_assoc) strucplot(Titanic, spacing = spacing_increase, spacing_args = list(start = 0.5, rate = 1.5)) strucplot(Titanic, spacing = spacing_increase(start = 0.5, rate = 1.5)) ## modify a tile's color strucplot(Titanic, pop = FALSE) grid.edit("rect:Class=1st,Sex=Male,Age=Adult,Survived=Yes", gp = gpar(fill = "red")) } \keyword{hplot} vcd/man/BrokenMarriage.Rd0000755000175000017500000000165311150520606015116 0ustar nileshnilesh\name{BrokenMarriage} \alias{BrokenMarriage} \docType{data} \title{Broken Marriage Data} \description{ Data from the Danish Welfare Study about broken marriages or permanent relationships depending on gender and social rank. } \usage{ data("BrokenMarriage") } \format{ A data frame with 20 observations and 4 variables. \describe{ \item{Freq}{frequency.} \item{gender}{factor indicating gender (male, female).} \item{rank}{factor indicating social rank (I, II, III, IV, V).} \item{broken}{factor indicating whether the marriage or permanent relationship was broken (yes, no).} } } \references{ E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. 2nd edition. Springer-Verlag, Berlin. } \source{ E. B. Andersen (1991), The Statistical Analysis of Categorical Data, page 177. } \examples{ data("BrokenMarriage") structable(~ ., data = BrokenMarriage) } \keyword{datasets} vcd/man/spine.Rd0000755000175000017500000001073711235655676013373 0ustar nileshnilesh\name{spine} \alias{spine} \alias{spine.default} \alias{spine.formula} \title{Spine Plots and Spinograms} \description{ Spine plots are a special cases of mosaic plots, and can be seen as a generalization of stacked (or highlighted) bar plots. Analogously, spinograms are an extension of histograms. } \usage{ spine(x, \dots) \method{spine}{default}(x, y = NULL, breaks = NULL, ylab_tol = 0.05, off = NULL, main = "", xlab = NULL, ylab = NULL, ylim = c(0, 1), margins = c(5.1, 4.1, 4.1, 3.1), gp = gpar(), name = "spineplot", newpage = TRUE, pop = TRUE, \dots) \method{spine}{formula}(formula, data = list(), breaks = NULL, ylab_tol = 0.05, off = NULL, main = "", xlab = NULL, ylab = NULL, ylim = c(0, 1), margins = c(5.1, 4.1, 4.1, 3.1), gp = gpar(), name = "spineplot", newpage = TRUE, pop = TRUE, \dots) } \arguments{ \item{x}{an object, the default method expects either a single variable (interpreted to be the explanatory variable) or a 2-way table. See details.} \item{y}{a \code{"factor"} interpreted to be the dependent variable} \item{formula}{a \code{"formula"} of type \code{y ~ x} with a single dependent \code{"factor"} and a single explanatory variable.} \item{data}{an optional data frame.} \item{breaks}{if the explanatory variable is numeric, this controls how it is discretized. \code{breaks} is passed to \code{\link{hist}} and can be a list of arguments.} \item{ylab_tol}{convenience tolerance parameter for y-axis annotation. If the distance between two labels drops under this threshold, they are plotted equidistantly.} \item{off}{vertical offset between the bars (in per cent). It is fixed to \code{0} for spinograms and defaults to \code{2} for spine plots.} \item{main, xlab, ylab}{character strings for annotation} \item{ylim}{limits for the y axis} \item{margins}{margins when calling \code{\link{plotViewport}}} \item{gp}{a \code{"gpar"} object controlling the grid graphical parameters of the rectangles. It should specify in particular a vector of \code{fill} colors of the same length as \code{levels(y)}. The default is to call \code{\link{gray.colors}}.} \item{name}{name of the plotting viewport.} \item{newpage}{logical. Should \code{\link{grid.newpage}} be called before plotting?} \item{pop}{logical. Should the viewport created be popped?} \item{\dots}{additional arguments passed to \code{\link{plotViewport}}.} } \details{ \code{spine} creates either a spinogram or a spine plot. It can be called via \code{spine(x, y)} or \code{spine(y ~ x)} where \code{y} is interpreted to be the dependent variable (and has to be categorical) and \code{x} the explanatory variable. \code{x} can be either categorical (then a spine plot is created) or numerical (then a spinogram is plotted). Additionally, \code{spine} can also be called with only a single argument which then has to be a 2-way table, interpreted to correspond to \code{table(x, y)}. Spine plots are a generalization of stacked bar plots where not the heights but the widths of the bars corresponds to the relative frequencies of \code{x}. The heights of the bars then correspond to the conditional relative frequencies of \code{y} in every \code{x} group. This is a special case of a mosaic plot with specific spacing and shading. Analogously, spinograms extend stacked histograms. As for the histogram, \code{x} is first discretized (using \code{\link{hist}}) and then for the discretized data a spine plot is created. } \value{ The table visualized is returned invisibly. } \seealso{ \code{\link{cd_plot}}, \code{\link{mosaic}}, \code{\link{hist}} } \references{ Hummel, J. (1996), Linked bar charts: Analysing categorical data graphically. \emph{Computational Statistics}, \bold{11}, 23--33. Hofmann, H., Theus, M. (2005), \emph{Interactive graphics for visualizing conditional distributions}, Unpublished Manuscript. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \examples{ ## Arthritis data (dependence on a categorical variable) data("Arthritis") (spine(Improved ~ Treatment, data = Arthritis)) ## Arthritis data (dependence on a numerical variable) (spine(Improved ~ Age, data = Arthritis, breaks = 5)) (spine(Improved ~ Age, data = Arthritis, breaks = quantile(Arthritis$Age))) (spine(Improved ~ Age, data = Arthritis, breaks = "Scott")) ## Space shuttle data (dependence on a numerical variable) data("SpaceShuttle") (spine(Fail ~ Temperature, data = SpaceShuttle, breaks = 3)) } \keyword{hplot} vcd/man/binregplot.Rd0000644000175000017500000002230512535260710014372 0ustar nileshnilesh\name{binreg_plot} \alias{binreg_plot} \alias{grid_abline} \title{Binary Regression Plot} \description{ Creates a display of observed and fitted values for a binary regression model with one numeric predictor, conditioned by zero or many co-factors. } \usage{ binreg_plot(model, main = NULL, xlab = NULL, ylab = NULL, xlim = NULL, ylim = NULL, pred_var = NULL, pred_range = c("data", "xlim"), group_vars = NULL, base_level = NULL, subset, type = c("response", "link"), conf_level = 0.95, delta = FALSE, pch = NULL, cex = 0.6, jitter_factor = 0.1, lwd = 5, lty = 1, point_size = 0, col_lines = NULL, col_bands = NULL, legend = TRUE, legend_pos = NULL, legend_inset = c(0, 0.1), legend_vgap = unit(0.5, "lines"), labels = FALSE, labels_pos = c("right", "left"), labels_just = c("left","center"), labels_offset = c(0.01, 0), gp_main = gpar(fontface = "bold", fontsize = 14), gp_legend_frame = gpar(lwd = 1, col = "black"), gp_legend_title = gpar(fontface = "bold"), newpage = TRUE, pop = FALSE, return_grob = FALSE) grid_abline(a, b, \dots) } \arguments{ \item{model}{a binary regression model fitted with \code{\link[stats]{glm}}.} \item{main}{user-specified main title.} \item{xlab}{x-axis label. Defaults to the name of the (first) numeric predictor.} \item{ylab}{y-axis label. Defaults to the name of the response - within either 'P(...)' or 'logit(...)', depending on the response type.} \item{xlim}{Range of the x-axis. Defaults to the range of the numeric predictor.} \item{ylim}{Range of the y-axis. Defaults to the unit interval on probability scale or the fitted values range on the link scale, depending on \code{type}.} \item{pred_var}{character string of length 1 giving the name of the numeric predictor. Defaults to the first one found in the data set.} \item{pred_range}{\code{"data"}, \code{"xlim"}, or a numeric vector. If \code{"data"}, the numeric predictor corresponds to the observed values. If \code{"xlim"}, 100 values are taken from the \code{"xlim"} range. A numeric vector will be interpreted as the values to be predicted.} \item{group_vars}{optional character string of conditioning variables. Defaults to all factors found in the data set, response excluded. If \code{FALSE}, no variables are used for conditioning.} \item{base_level}{vector of length one. If the response is a vector, this specifies the base ('no effect') value of the response variable (e.g., "Placebo", 0, FALSE, etc.) and defaults to the first level for factor responses, or 0 for numeric/binary variables. This controls which observations will be plotted on the top or the bottom of the display. If the response is a matrix with success and failure column, this specifies the one to be interpreted as failure (default: 2), either as an integer, or as a string (\code{"success"} or \code{"failure"}). The proportions of \emph{successes} will be plotted as observed values.} \item{subset}{an optional vector specifying a subset of the data rows. The value is evaluated in the data environment, so expressions can be used to select the data (see examples).} \item{type}{either "response" or "link" to select the scale of the fitted values. The y-axis will be adapted accordingly.} \item{conf_level}{confidence level used for calculating confidence bands.} \item{delta}{logical; indicates whether the delta method should be employed for calculating the limits of the confidence band or not (see details).} \item{pch}{character or numeric vector of symbols used for plotting the (possibly conditioned) observed values, recycled as needed.} \item{cex}{size of the plot symbols (in lines).} \item{jitter_factor}{argument passed to \code{\link[base]{jitter}} used for the points representing the observed values.} \item{lwd}{Line width for the fitted values.} \item{lty}{Line type for the fitted values.} \item{point_size}{size of points for the fitted values in char units (default: 0, so no points are plotted).} \item{col_lines, col_bands}{character vector specifying the colors of the fitted lines and confidence bands, by default chosen with \code{\link[colorspace]{rainbow_hcl}}. The confidence bands are using alpha blending with alpha = 0.2.} \item{legend}{logical; if \code{TRUE} (default), a legend is drawn.} \item{legend_pos}{numeric vector of length 2, specifying x and y coordinates of the legend, or a character string (e.g., \code{"topleft"}, \code{"center"} etc.). Defaults to \code{"topleft"} if the fitted curve's slope is positive, and \code{"topright"} else.} \item{legend_inset}{numeric vector or length 2 specifying the inset from the legend's x and y coordinates in npc units.} \item{legend_vgap}{vertical space between the legend's line entries.} \item{labels}{logical; if \code{TRUE}, labels corresponding to the factor levels are plotted next to the fitted lines.} \item{labels_pos}{either \code{"right"} or \code{"left"}, determining on which side of the fitted lines (start or end) the labels should be placed.} \item{labels_just}{character vector of length 2, specifying the relative justification of the labels to their coordinates. See the documentation of the \code{just} parameter of \code{\link[grid]{grid.text}} for more details.} \item{labels_offset}{numeric vector of length 2, specifying the offset of the labels' coordinates in npc units.} \item{gp_main}{object of class \code{"gpar"} used for the main title.} \item{gp_legend_frame}{object of class \code{"gpar"} used for the legend frame.} \item{gp_legend_title}{object of class \code{"gpar"} used for the legend title.} \item{newpage}{logical; if \code{TRUE}, the plot is drawn on a new page.} \item{pop}{logical; if \code{TRUE}, all newly generated viewports are popped after plotting.} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{a}{intercept; alternatively, a regression model from which coefficients can be extracted via \code{\link[stats]{coef}}.} \item{b}{slope.} \item{\dots}{Further arguments passed to \code{\link[grid]{grid.abline}}.} } \details{ The primary purpose of \code{binreg_plot()} is to visualize observed and fitted values for binary regression models (like the logistic or probit regression model) with one numeric predictor. If one or more categorical predictors are used in the model, the \emph{fitted} values are conditioned on them, i.e. separate curves are drawn corresponding to the factor level combinations. Thus, it shows a \emph{full-model plot}, not a conditional plot where several models would be fit to data subsets. The implementation relies on objects returned by \code{\link[stats]{glm}}, as it uses its \code{"terms"} and \code{"model"} components. The function tries to determine suitable values for the legend and/or labels, but depending on the data, this might require some tweaking. By default, the limits of the confidence band are determined for the linear predictor (i.e., on the link scale) and transformed to response scale (if this is the chosen plot type) using the inverse link function. If \code{delta} is \code{TRUE}, the limits are determined on the response scale. Note that the resulting band using the delta method is symmetric around the fitted mean, but may exceed the unit interval (on the response scale) and will be cut off. \code{grid_abline()} is a simple convenience wrapper for \code{\link[grid]{grid.abline}} with similar behavior than \code{\link[graphics]{abline}} in that it extracts coefficients from a regression model, if given instead of the intercept \code{a}. } \value{ if \code{return_grob} is \code{TRUE}, a grob object corresponding to the plot. \code{NULL} (invisibly) else. } \references{ Michael Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ ## Simple model with no conditioning variables art.mod0 <- glm(Improved > "None" ~ Age, data = Arthritis, family = binomial) binreg_plot(art.mod0, "Arthritis Data") binreg_plot(art.mod0, type = "link") ## logit scale ## one conditioning factor art.mod1 <- update(art.mod0, . ~ . + Sex) binreg_plot(art.mod1) binreg_plot(art.mod1, legend = FALSE, labels = TRUE, xlim = c(20, 80)) ## two conditioning factors art.mod2 <- update(art.mod1, . ~ . + Treatment) binreg_plot(art.mod2) binreg_plot(art.mod2, subset = Sex == "Male") ## subsetting ## some tweaking binreg_plot(art.mod2, gp_legend_frame = gpar(col = NA, fill = "white"), col_bands = NA) binreg_plot(art.mod2, legend = FALSE, labels = TRUE, labels_pos = "left", labels_just = c("left", "top")) ## model with grouped response data shuttle.mod <- glm(cbind(nFailures, 6 - nFailures) ~ Temperature, data = SpaceShuttle, na.action = na.exclude, family = binomial) binreg_plot(shuttle.mod, xlim = c(30, 81), pred_range = "xlim", ylab = "O-Ring Failure Probability", xlab = "Temperature (F)") } \keyword{category} \keyword{hplot} vcd/man/assoc.Rd0000655000175000017500000002255414133262215013343 0ustar nileshnilesh\name{assoc} \alias{assoc} \alias{assoc.default} \alias{assoc.formula} \title{Extended Association Plots} \description{ Produce an association plot indicating deviations from a specified independence model in a possibly high-dimensional contingency table. } \usage{ \method{assoc}{default}(x, row_vars = NULL, col_vars = NULL, compress = TRUE, xlim = NULL, ylim = NULL, spacing = spacing_conditional(sp = 0), spacing_args = list(), split_vertical = NULL, keep_aspect_ratio = FALSE, xscale = 0.9, yspace = unit(0.5, "lines"), main = NULL, sub = NULL, \dots, residuals_type = "Pearson", gp_axis = gpar(lty = 3)) \method{assoc}{formula}(formula, data = NULL, \dots, subset = NULL, na.action = NULL, main = NULL, sub = NULL) } \arguments{ \item{x}{a contingency table in array form with optional category labels specified in the \code{dimnames(x)} attribute, or an object inheriting from the \code{"ftable"} class (such as \code{"structable"} objects).} \item{row_vars}{a vector of integers giving the indices, or a character vector giving the names of the variables to be used for the rows of the association plot.} \item{col_vars}{a vector of integers giving the indices, or a character vector giving the names of the variables to be used for the columns of the association plot.} \item{compress}{logical; if \code{FALSE}, the space between the rows (columns) are chosen such that the \emph{total} heights (widths) of the rows (columns) are all equal. If \code{TRUE}, the space between rows and columns is fixed and hence the plot is more \dQuote{compressed}.} \item{xlim}{a \eqn{2 \times k}{2 x k} matrix of doubles, \eqn{k} number of total columns of the plot. The columns of \code{xlim} correspond to the columns of the association plot, the rows describe the column ranges (minimums in the first row, maximums in the second row). If \code{xlim} is \code{NULL}, the ranges are determined from the residuals according to \code{compress} (if \code{TRUE}: widest range from each column, if \code{FALSE}: from the whole association plot matrix).} \item{ylim}{a \eqn{2 \times k}{2 x k} matrix of doubles, \eqn{k} number of total rows of the plot. The columns of \code{ylim} correspond to the rows of the association plot, the rows describe the column ranges (minimums in the first row, maximums in the second row). If \code{ylim} is \code{NULL}, the ranges are determined from the residuals according to \code{compress} (if \code{TRUE}: widest range from each row, if \code{FALSE}: from the whole association plot matrix).} \item{spacing}{a spacing object, a spacing function, or a corresponding generating function (see \code{\link{strucplot}} for more information). The default is the spacing-generating function \code{\link{spacing_conditional}} that is (by default) called with the argument list \code{spacing_args} (see \code{spacings} for more details).} \item{spacing_args}{list of arguments for the spacing-generating function, if specified (see \code{\link{strucplot}} for more information).} \item{split_vertical}{vector of logicals of length \eqn{k}, where \eqn{k} is the number of margins of \code{x} (default: \code{FALSE}). Values are recycled as needed. A \code{TRUE} component indicates that the corresponding dimension is folded into the columns, \code{FALSE} folds the dimension into the rows.} \item{keep_aspect_ratio}{logical indicating whether the aspect ratio should be fixed or not.} \item{residuals_type}{a character string indicating the type of residuals to be computed. Currently, only Pearson residuals are supported.} \item{xscale}{scale factor resizing the tile's width, thus adding additional space between the tiles. } \item{yspace}{object of class \code{"unit"} specifying additional space separating the rows.} \item{gp_axis}{object of class \code{"gpar"} specifying the visual aspects of the tiles' baseline.} \item{formula}{a formula object with possibly both left and right hand sides specifying the column and row variables of the flat table.} \item{data}{a data frame, list or environment containing the variables to be cross-tabulated, or an object inheriting from class \code{table}.} \item{subset}{an optional vector specifying a subset of observations to be used. Ignored if \code{data} is a contingency table.} \item{na.action}{an optional function which indicates what should happen when the data contain \code{NA}s. Ignored if \code{data} is a contingency table.} \item{main, sub}{either a logical, or a character string used for plotting the main (sub) title. If logical and \code{TRUE}, the name of the \code{data} object is used.} \item{\dots}{other parameters passed to \code{\link{strucplot}}} } \details{ Association plots have been suggested by Cohen (1980) and extended by Friendly (1992) and provide a means for visualizing the residuals of an independence model for a contingency table. \code{assoc} is a generic function and currently has a default method and a formula interface. Both are high-level interfaces to the \code{\link{strucplot}} function, and produce (extended) association plots. Most of the functionality is described there, such as specification of the independence model, labeling, legend, spacing, shading, and other graphical parameters. For a contingency table, the signed contribution to Pearson's \eqn{\chi^2}{chi^2} for cell \eqn{\{ij\ldots k\}} is \deqn{d_{ij\ldots k} = \frac{(f_{ij\ldots k} - e_{ij\ldots k})}{ \sqrt{e_{ij\ldots k}}}}{d_\{ij\ldotsk\} = (f_\{ij\ldotsk\} - e_\{ij\ldotsk\}) / sqrt(e_\{ij\ldotsk\})} where \eqn{f_{ij\ldots k}}{f_\{ij\ldotsk\}} and \eqn{e_{ij\ldots k}}{e_\{ij\ldotsk\}} are the observed and expected counts corresponding to the cell. In the association plot, each cell is represented by a rectangle that has (signed) height proportional to \eqn{d_{ij\ldots k}}{d_\{ij\ldotsk\}} and width proportional to \eqn{\sqrt{e_{ij\ldots k}}}{sqrt(e_\{ij...k\})}, so that the area of the box is proportional to the difference in observed and expected frequencies. The rectangles in each row are positioned relative to a baseline indicating independence (\eqn{d_{ij\ldots k} = 0}{d_\{ij\ldotsk\} = 0}). If the observed frequency of a cell is greater than the expected one, the box rises above the baseline, and falls below otherwise. Additionally, the residuals can be colored depending on a specified shading scheme (see Meyer et al., 2003). Package \pkg{vcd} offers a range of \emph{residual-based} shadings (see the shadings help page). Some of them allow, e.g., the visualization of test statistics. Unlike the \code{\link[graphics]{assocplot}} function in the \pkg{graphics} package, this function allows the visualization of contingency tables with more than two dimensions. Similar to the construction of \sQuote{flat} tables (like objects of class \code{"ftable"} or \code{"structable"}), the dimensions are folded into rows and columns. The layout is very flexible: the specification of shading, labeling, spacing, and legend is modularized (see \code{\link{strucplot}} for details). } \value{ The \code{"structable"} visualized is returned invisibly. } \seealso{ \code{\link{mosaic}}, \code{\link{strucplot}}, \code{\link{structable}} } \references{ Cohen, A. (1980), On the graphical display of the significant components in a two-way contingency table. \emph{Communications in Statistics---Theory and Methods}, \bold{A9}, 1025--1041. Friendly, M. (1992), Graphical methods for categorical data. \emph{SAS User Group International Conference Proceedings}, \bold{17}, 190--200. \url{http://datavis.ca/papers/sugi/sugi17.pdf} Meyer, D., Zeileis, A., Hornik, K. (2003), Visualizing independence using extended association plots. \emph{Proceedings of the 3rd International Workshop on Distributed Statistical Computing}, K. Hornik, F. Leisch, A. Zeileis (eds.), ISSN 1609-395X. \url{https://www.R-project.org/conferences/DSC-2003/Proceedings/} Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. Available as \code{vignette("strucplot", package = "vcd")}. \doi{10.18637/jss.v017.i03}. } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("HairEyeColor") ## Aggregate over sex: (x <- margin.table(HairEyeColor, c(1, 2))) ## Ordinary assocplot: assoc(x) ## and with residual-based shading (of independence) assoc(x, main = "Relation between hair and eye color", shade = TRUE) ## Aggregate over Eye color: (x <- margin.table(HairEyeColor, c(1, 3))) chisq.test(x) assoc(x, main = "Relation between hair color and sex", shade = TRUE) # Visualize multi-way table assoc(aperm(HairEyeColor), expected = ~ (Hair + Eye) * Sex, labeling_args = list(just_labels = c(Eye = "left"), offset_labels = c(right = -0.5), offset_varnames = c(right = 1.2), rot_labels = c(right = 0), tl_varnames = c(Eye = TRUE)) ) assoc(aperm(UCBAdmissions), expected = ~ (Admit + Gender) * Dept, compress = FALSE, labeling_args = list(abbreviate = c(Gender = TRUE), rot_labels = 0) ) } \keyword{hplot} vcd/man/OvaryCancer.Rd0000755000175000017500000000373611150520606014446 0ustar nileshnilesh\name{OvaryCancer} \alias{OvaryCancer} \docType{data} \title{Ovary Cancer Data} \description{ Data from Obel (1975) about a retrospective study of ovary cancer carried out in 1973. Information was obtained from 299 women, who were operated for ovary cancer 10 years before. } \usage{ data("OvaryCancer") } \format{ A data frame with 16 observations and 5 variables. \describe{ \item{Freq}{frequency.} \item{stage}{factor indicating the stage of the cancer at the time of operation (early, advanced).} \item{operation}{factor indicating type of operation (radical, limited).} \item{survival}{factor indicating survival status after 10 years (yes, no).} \item{xray}{factor indicating whether X-ray treatment was received (yes, no).} } } \references{ E. B. Obel (1975), A Comparative Study of Patients with Cancer of the Ovary Who Have Survived More or Less Than 10 Years. \emph{Acta Obstetricia et Gynecologica Scandinavica}, \bold{55}, 429-439. E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. 2nd edition. Springer-Verlag, Berlin. } \source{ E. B. Andersen (1991), The Statistical Analysis of Categorical Data, Table 6.4. } \examples{ data("OvaryCancer") tab <- xtabs(Freq ~ xray + survival + stage + operation, data = OvaryCancer) ftable(tab, col.vars = "survival", row.vars = c("stage", "operation", "xray")) ## model: ~ xray * operation * stage + survival * stage ## interpretation: treat xray, operation, stage as fixed margins, ## the survival depends on stage, but not xray and operation. doubledecker(survival ~ stage + operation + xray, data = tab) mosaic(~ stage + operation + xray + survival, split = c(FALSE, TRUE, TRUE, FALSE), data = tab, keep = FALSE, gp = gpar(fill = rev(grey.colors(2)))) mosaic(~ stage + operation + xray + survival, split = c(FALSE, TRUE, TRUE, FALSE), data = tab, keep = FALSE, expected = ~ xray * operation * stage + survival*stage) } \keyword{datasets} vcd/man/SexualFun.Rd0000755000175000017500000000276611150520606014146 0ustar nileshnilesh\name{SexualFun} \alias{SexualFun} \docType{data} \title{Sex is Fun} \description{ Data from Hout et al. (1987) given by Agresti (1990) summarizing the responses of married couples to the questionnaire item: Sex is fun for me and my partner: (a) never or occasionally, (b) fairly often, (c) very often, (d) almost always. } \usage{ data("SexualFun") } \format{ A 2-dimensional array resulting from cross-tabulating the ratings of 91 married couples. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab Husband \tab Never Fun, Fairly Often, Very Often, Always Fun \cr 2 \tab Wife \tab Never Fun, Fairly Often, Very Often, Always Fun } } \references{ A. Agresti (1990), \emph{Categorical Data Analysis}. Wiley-Interscience, New York. M. Hout, O. D. Duncan, M. E. Sobel (1987), Association and heterogeneity: Structural models of similarities and differences, \emph{Sociological Methodology}, \bold{17}, 145-184. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ M. Friendly (2000), Visualizing Categorical Data, page 91. } \examples{ data("SexualFun") ## Kappa statistics Kappa(SexualFun) ## Agreement Chart agreementplot(t(SexualFun), weights = 1) ## Partial Agreement Chart and B-Statistics agreementplot(t(SexualFun), xlab = "Husband's Rating", ylab = "Wife's Rating", main = "Husband's and Wife's Sexual Fun") } \keyword{datasets} vcd/man/Rochdale.Rd0000755000175000017500000000233011150520606013740 0ustar nileshnilesh\name{Rochdale} \alias{Rochdale} \docType{data} \title{Rochdale Data} \description{ Information on 665 households of Rochdale, Lancashire, UK. The study was conducted to identify influence factors on economical activity of wives. } \usage{ data("Rochdale") } \format{ A 8-dimensional array resulting from cross-tabulating 665 observations on 8 variables. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab EconActive \tab yes, no \cr 2 \tab Age \tab <38, >38 \cr 3 \tab HusbandEmployed \tab yes, no \cr 4 \tab Child \tab yes, no \cr 5 \tab Education \tab yes, no \cr 6 \tab HusbandEducation \tab yes, no \cr 7 \tab Asian \tab yes, no \cr 8 \tab HouseholdWorking \tab yes, no \cr } } \note{ Many observations are missing: only 91 out of all 256 combinations contain information. } \source{ Whittaker (1990). } \references{ H. Hofmann (2003). Constructing and reading mosaicplots. \emph{Computational Statistics & Data Analysis}, \bold{43}, 4, 565--580. J. Whittaker (1990), \emph{Graphical Models on Applied Multivariate Statistics}, Wiley, New York. } \examples{ data("Rochdale") mosaic(Rochdale) } \keyword{datasets} vcd/man/WomenQueue.Rd0000755000175000017500000000231511150520606014314 0ustar nileshnilesh\name{WomenQueue} \alias{WomenQueue} \docType{data} \title{Women in Queues} \description{ Data from Jinkinson \& Slater (1981) and Hoaglin \& Tukey (1985) reporting the frequency distribution of females in 100 queues of length 10 in a London Underground station. } \usage{ data("WomenQueue") } \format{ A 1-way table giving the number of women in 100 queues of length 10. The variable and its levels are \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab nWomen \tab 0, 1, \dots, 10 \cr } } \references{ D. C. Hoaglin \& J. W. Tukey (1985), Checking the shape of discrete distributions. In D. C. Hoaglin, F. Mosteller, J. W. Tukey (eds.), \emph{Exploring Data Tables, Trends and Shapes}, chapter 9. John Wiley \& Sons, New York. R. A. Jinkinson \& M. Slater (1981), Critical discussion of a graphical method for identifying discrete distributions, \emph{The Statistician}, \bold{30}, 239--248. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ M. Friendly (2000), Visualizing Categorical Data, pages 19--20. } \examples{ data("WomenQueue") gf <- goodfit(WomenQueue, type = "binomial") summary(gf) plot(gf) } \keyword{datasets} vcd/man/fourfold.Rd0000644000175000017500000001517512531710554014056 0ustar nileshnilesh\name{fourfold} \alias{fourfold} \title{Fourfold Plots} \description{ Creates an (extended) fourfold display of a \eqn{2 \times 2 \times k}{2 x 2 x k} contingency table, allowing for the visual inspection of the association between two dichotomous variables in one or several populations (strata). } \usage{ fourfold(x, color = c("#99CCFF", "#6699CC", "#FFA0A0", "#A0A0FF", "#FF0000", "#000080"), conf_level = 0.95, std = c("margins", "ind.max", "all.max"), margin = c(1, 2), space = 0.2, main = NULL, sub = NULL, mfrow = NULL, mfcol = NULL, extended = TRUE, ticks = 0.15, p_adjust_method = p.adjust.methods, newpage = TRUE, fontsize = 12, default_prefix = c("Row", "Col", "Strata"), sep = ": ", varnames = TRUE, return_grob = FALSE) } \arguments{ \item{x}{a \eqn{2 \times 2 \times k}{2 x 2 x k} contingency table in array form, or a \eqn{2 \times 2}{2 x 2} matrix if \eqn{k} is 1. If \code{length(dim(x)>3}, dimensions \code{3:length(dim(x)} are silently raveled into a combined strata dimension with \code{k=prod(dim(x)[-(1:2)]))}.} \item{color}{a vector of length 6 specifying the colors to use for the smaller and larger diagonals of each \eqn{2 \times 2}{2 x 2} table. The first pair is used for the standard (non-extended) plots, the other two for the extended version: the second/third pair is used for tables with non-significant/significant log-odds ratios, respectively, the latter being visualized in brighter colors.} \item{conf_level}{confidence level used for the confidence rings on the odds ratios. Must be a single non-negative number less than 1; if set to 0, confidence rings are suppressed.} \item{std}{a character string specifying how to standardize the table. Must be one of \code{"margins"}, \code{"ind.max"}, or \code{"all.max"}, and can be abbreviated by the initial letter. If set to \code{"margins"}, each \eqn{2 \times 2}{2 x 2} table is standardized to equate the margins specified by \code{margin} while preserving the odds ratio. If \code{"ind.max"} or \code{"all.max"}, the tables are either individually or simultaneously standardized to a maximal cell frequency of 1.} \item{margin}{a numeric vector with the margins to equate. Must be one of \code{1}, \code{2}, or \code{c(1, 2)} (the default), which corresponds to standardizing only the row, only column, or both row and column in each \eqn{2 \times 2}{2 x 2} table. Only used if \code{std} equals \code{"margins"}.} \item{space}{the amount of space (as a fraction of the maximal radius of the quarter circles) used for the row and column labels.} \item{main, sub}{character string for the fourfold plot title/subtitle.} \item{mfrow, mfcol}{a numeric vector with two components: \var{nr} and \var{nc}, indicating that the displays for the \eqn{2 \times 2}{2 x 2} tables should be arranged in an \var{nr} by \var{nc} layout, filled by rows/columns. The defaults are calculated to give a collection of plots in landscape orientation when \var{k} is not a perfect square.} \item{extended}{logical; if \code{TRUE}, extended plots are plotted, i.e., colors are brighter for significant log-odds ratios, and ticks are plotted showing the direction of association for positive log-odds.} \item{ticks}{the length of the ticks. If set to 0, no ticks are plotted.} \item{p_adjust_method}{method to be used for p-value adjustments for multi-stratum plots, as provided by \code{link[stats]{p.adjust}}. Use \code{p_adjust_method="none"} to disable this adjustment. The p-values are used for the \sQuote{visual} significance tests of the odds ratios.} \item{newpage}{logical; if \code{TRUE}, \code{grid.newpage()} is called before plotting.} \item{fontsize}{fontsize of main title. Other labels are scaled relative to this.} \item{default_prefix}{character vector of length 3 with default labels for possibly missing row/column/strata variable names.} \item{sep}{default separator between variable names and levels for labels.} \item{varnames}{Logical; should the variable names be printed in the labeling of stratifed plots?} \item{return_grob}{Logical; shall a snapshot of the display be returned as a grob object?} } \details{ The fourfold display is designed for the display of \eqn{2 \times 2 \times k}{2 x 2 x k} tables. Following suitable standardization, the cell frequencies \eqn{f_{ij}}{f[i,j]} of each \eqn{2 \times 2}{2 x 2} table are shown as a quarter circle whose radius is proportional to \eqn{\sqrt{f_{ij}}}{sqrt(f[i,j])} so that its area is proportional to the cell frequency. An association (odds ratio different from 1) between the binary row and column variables is indicated by the tendency of diagonally opposite cells in one direction to differ in size from those in the other direction; color is used to show this direction. Confidence rings for the odds ratio allow a visual test of the null of no association; the rings for adjacent quadrants overlap iff the observed counts are consistent with the null hypothesis. Typically, the number \eqn{k} corresponds to the number of levels of a stratifying variable, and it is of interest to see whether the association is homogeneous across strata. The fourfold display visualizes the pattern of association. Note that the confidence rings for the individual odds ratios are not adjusted for multiple testing. } \references{ Friendly, M. (1994), \emph{A fourfold display for 2 by 2 by \eqn{k} tables}. Technical Report 217, York University, Psychology Department, \url{http://datavis.ca/papers/4fold/4fold.pdf}. Friendly, M. (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \seealso{ \code{\link{mosaic}}, \code{\link{assoc}} \code{link[stats]{p.adjust}} for methods of p value adjustment } \examples{ data("UCBAdmissions") ## Use the Berkeley admission data as in Friendly (1995). x <- aperm(UCBAdmissions, c(2, 1, 3)) dimnames(x)[[2]] <- c("Yes", "No") names(dimnames(x)) <- c("Sex", "Admit?", "Department") ftable(x) ## Fourfold display of data aggregated over departments, with ## frequencies standardized to equate the margins for admission ## and sex. ## Figure 1 in Friendly (1994). fourfold(margin.table(x, c(1, 2))) ## Fourfold display of x, with frequencies in each table ## standardized to equate the margins for admission and sex. ## Figure 2 in Friendly (1994). fourfold(x) cotabplot(x, panel = cotab_fourfold) ## Fourfold display of x, with frequencies in each table ## standardized to equate the margins for admission. but not ## for sex. ## Figure 3 in Friendly (1994). fourfold(x, margin = 2) } \keyword{hplot} vcd/man/struc_mosaic.Rd0000655000175000017500000000614014133262723014723 0ustar nileshnilesh\name{struc_mosaic} \alias{struc_mosaic} \title{Core-generating Function for Mosaic Plots} \description{ Core-generating function for \code{strucplot} returning a function producing mosaic plots. } \usage{ struc_mosaic(zero_size = 0.5, zero_split = FALSE, zero_shade = TRUE, zero_gp = gpar(col = 0), panel = NULL) } \arguments{ \item{zero_size}{size of the bullets used for zero-entries in the contingency table (if 0, no bullets are drawn).} \item{zero_split}{logical controlling whether zero cells should be further split. If \code{FALSE} and \code{zero_shade} is \code{FALSE}, only one bullet is drawn (centered) for unsplit zero cells. If \code{FALSE} and \code{zero_shade} is \code{TRUE}, a bullet for each zero cell is drawn to allow, e.g., residual-based shadings to be effective also for zero cells.} \item{zero_shade}{logical controlling whether zero bullets should be shaded.} \item{zero_gp}{object of class \code{"gpar"} used for zero bullets in case they are \emph{not} shaded.} \item{panel}{Optional function with arguments: \code{residuals}, \code{observed}, \code{expected}, \code{index}, \code{gp}, and \code{name} called by the \code{struc_mosaic} workhorse for each tile that is drawn in the mosaic. \code{index} is an integer vector with the tile's coordinates in the contingency table, \code{gp} a \code{gpar} object for the tile, and \code{name} a label to be assigned to the drawn grid object.} } \details{ This function is usually called by \code{\link{strucplot}} (typically when called by \code{\link{mosaic}}) and returns a function used by \code{\link{strucplot}} to produce mosaic plots. } \value{ A function with arguments: \item{residuals}{table of residuals.} \item{observed}{table of observed values.} \item{expected}{not used by \code{struc_mosaic}.} \item{spacing}{object of class \code{"unit"} specifying the space between the tiles.} \item{gp}{list of \code{gpar} objects used for the drawing the tiles.} \item{split_vertical}{vector of logicals indicating, for each dimension of the table, the split direction.} } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{mosaic}}, \code{\link{strucplot}}, \code{\link{structable}} } \references{ Cohen, A. (1980), On the graphical display of the significant components in a two-way contingency table. \emph{Communications in Statistics---Theory and Methods}, \bold{A9}, 1025--1041. Friendly, M. (1992), Graphical methods for categorical data. \emph{SAS User Group International Conference Proceedings}, \bold{17}, 190--200. \url{http://datavis.ca/papers/sugi/sugi17.pdf} Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. Available as \code{vignette("strucplot", package = "vcd")}. \doi{10.18637/jss.v017.i03}. } \examples{ ## Titanic data data("Titanic") ## mosaic plot with large zeros strucplot(Titanic, core = struc_mosaic(zero_size = 1)) } \keyword{hplot} vcd/man/Kappa.Rd0000655000175000017500000000556412445040314013267 0ustar nileshnilesh\name{Kappa} \alias{Kappa} \alias{print.Kappa} \alias{confint.Kappa} \alias{summary.Kappa} \alias{print.summary.Kappa} \title{Cohen's Kappa and Weighted Kappa} \description{ Computes two agreement rates: Cohen's kappa and weighted kappa, and confidence bands. } \usage{ Kappa(x, weights = c("Equal-Spacing", "Fleiss-Cohen")) \S3method{print}{Kappa}(x, digits=max(getOption("digits") - 3, 3), CI=FALSE, level=0.95, ...) \S3method{confint}{Kappa}(object, parm, level = 0.95, ...) \S3method{summary}{Kappa}(object, ...) \S3method{print}{summary.Kappa}(x, ...) } \arguments{ \item{x}{For \code{Kappa}: a confusion matrix. For the print methods: object of class \code{"Kappa"} or \code{"summary.Kappa"}} \item{weights}{either one of the character strings given in the default value, or a user-specified matrix with same dimensions as \code{x}.} \item{digits}{minimal number of significant digits.} \item{CI}{logical; shall confidence limits be added to the output?} \item{level}{confidence level between 0 and 1 used for the confidence interval.} \item{object}{object of class \code{"Kappa"}.} \item{parm}{Currently, ignored.} \item{\dots}{Further arguments passed to the default print method.} } \details{ Cohen's kappa is the diagonal sum of the (possibly weighted) relative frequencies, corrected for expected values and standardized by its maximum value. The equal-spacing weights are defined by \eqn{1 - |i - j| / (r - 1)}{1 - abs(i - j) / (r - 1)}, \eqn{r} number of columns/rows, and the Fleiss-Cohen weights by \eqn{1 - |i - j|^2 / (r - 1)^2}{1 - abs(i - j)^2 / (r - 1)^2}. The latter one attaches greater importance to near disagreements. } \value{ An object of class \code{"Kappa"} with three components: \item{Unweighted}{numeric vector of length 2 with the kappa statistic (\code{value} component), along with Approximate Standard Error (\code{ASE} component)} \item{Weighted}{idem for the weighted kappa.} \item{Weights}{numeric matrix with weights used.} } \note{ The \code{summary} method also prints the weights. There is a \code{confint} method for computing approximate confidence intervals. } \references{ Cohen, J. (1960), A coefficient of agreement for nominal scales. \emph{Educational and Psychological Measurement}, \bold{20}, 37--46. Everitt, B.S. (1968), Moments of statistics kappa and weighted kappa. \emph{The British Journal of Mathematical and Statistical Psychology}, \bold{21}, 97--103. Fleiss, J.L., Cohen, J., and Everitt, B.S. (1969), Large sample standard errors of kappa and weighted kappa. \emph{Psychological Bulletin}, \bold{72}, 332--327. } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{agreementplot}}, \code{\link{confint}} } \examples{ data("SexualFun") K <- Kappa(SexualFun) K confint(K) summary(K) print(K, CI = TRUE) } \keyword{category} vcd/man/coindep_test.Rd0000755000175000017500000000753512214055406014716 0ustar nileshnilesh\name{coindep_test} \alias{coindep_test} \alias{fitted.coindep_test} \title{Test for (Conditional) Independence} \description{ Performs a test of (conditional) independence of 2 margins in a contingency table by simulation from the marginal distribution of the input table under (conditional) independence. } \usage{ coindep_test(x, margin = NULL, n = 1000, indepfun = function(x) max(abs(x)), aggfun = max, alternative = c("greater", "less"), pearson = TRUE) } \arguments{ \item{x}{a contingency table.} \item{margin}{margin index(es) or corresponding name(s) of the conditioning variables. Each resulting conditional table has to be a 2-way table.} \item{n}{number of (conditional) independence tables to be drawn.} \item{indepfun}{aggregation function capturing independence in (each conditional) 2-way table.} \item{aggfun}{aggregation function aggregating the test statistics computed by \code{indepfun}.} \item{alternative}{a character string specifying the alternative hypothesis; must be either \code{"greater"} (default) or \code{"less"} (and may be abbreviated.)} \item{pearson}{logical. Should the table of Pearson residuals under independence be computed and passed to \code{indepfun} (default) or the raw table of observed frequencies?} } \details{ If \code{margin} is \code{NULL} this computes a simple independence statistic in a 2-way table. Alternatively, \code{margin} can give several conditioning variables and then conditional independence in the resulting conditional table is tested. By default, this uses a (double) maximum statistic of Pearson residuals. By changing \code{indepfun} or \code{aggfun} a (maximum of) Pearson Chi-squared statistic(s) can be computed or just the usual Pearson Chi-squared statistics and so on. Other statistics can be computed by changing \code{pearson} to \code{FALSE}. The function uses \code{\link{r2dtable}} to simulate the distribution of the test statistic under the null. } \value{ A list of class \code{"coindep_test"} inheriting from \code{"htest"} with following components: \item{statistic}{the value of the test statistic.} \item{p.value}{the \eqn{p} value for the test.} \item{method}{a character string indicating the type of the test.} \item{data.name}{a character string giving the name(s) of the data.} \item{observed}{observed table of frequencies} \item{expctd}{expected table of frequencies} \item{residuals}{corresponding Pearson residuals} \item{margin}{the \code{margin} used} \item{dist}{a vector of size \code{n} with simulated values of the distribution of the statistic under the null.} \item{qdist}{the corresponding quantile function (for computing critical values).} \item{pdist}{the corresponding distribution function (for computing \eqn{p} values).} } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \seealso{ \code{\link{chisq.test}}, \code{\link{fisher.test}}, \code{\link{r2dtable}} } \examples{ library(MASS) TeaTasting <- matrix(c(3, 1, 1, 3), nr = 2, dimnames = list(Guess = c("Milk", "Tea"), Truth = c("Milk", "Tea")) ) ## compute maximum statistic coindep_test(TeaTasting) ## compute Chi-squared statistic coindep_test(TeaTasting, indepfun = function(x) sum(x^2)) ## use unconditional asymptotic distribution chisq.test(TeaTasting, correct = FALSE) chisq.test(TeaTasting) data("UCBAdmissions") ## double maximum statistic coindep_test(UCBAdmissions, margin = "Dept") ## maximum of Chi-squared statistics coindep_test(UCBAdmissions, margin = "Dept", indepfun = function(x) sum(x^2)) ## Pearson Chi-squared statistic coindep_test(UCBAdmissions, margin = "Dept", indepfun = function(x) sum(x^2), aggfun = sum) ## use unconditional asymptotic distribution loglm(~ Dept * (Gender + Admit), data = UCBAdmissions) } \keyword{htest} vcd/man/plot.loddsratio.Rd0000644000175000017500000001526612554433622015363 0ustar nileshnilesh\name{plot.loddsratio} \alias{plot.loddsratio} \alias{lines.loddsratio} \title{Plotting (Log) Odds Ratios} \description{ Produces a (conditional) line plot of extended (log) odds ratios. } \usage{ \method{plot}{loddsratio}(x, baseline = TRUE, gp_baseline = gpar(lty = 2), lines = TRUE, lwd_lines = 3, confidence = TRUE, conf_level = 0.95, lwd_confidence = 2, whiskers = 0, transpose = FALSE, col = NULL, cex = 0.8, pch = NULL, bars = NULL, gp_bars = gpar(fill = "lightgray", alpha = 0.5), bar_width = unit(0.05, "npc"), legend = TRUE, legend_pos = "topright", legend_inset = c(0, 0), legend_vgap = unit(0.5, "lines"), gp_legend_frame = gpar(lwd = 1, col = "black"), gp_legend_title = gpar(fontface = "bold"), gp_legend = gpar(), legend_lwd = 1, legend_size = 1, xlab = NULL, ylab = NULL, xlim = NULL, ylim = NULL, main = NULL, gp_main = gpar(fontsize = 12, fontface = "bold"), newpage = TRUE, pop = FALSE, return_grob = FALSE, add = FALSE, prefix = "", \dots) \method{lines}{loddsratio}(x, legend = FALSE, confidence = FALSE, cex = 0, \dots) } \arguments{ \item{x}{an object of class \code{loddsratio}.} \item{baseline}{if \code{TRUE}, a dashed line is plotted at a value of 1 (in case of odds) or 0 (in case of log-odds).} \item{gp_baseline}{object of class \code{"gpar"} used for the baseline.} \item{lines}{if \code{TRUE}, the points are connected by lines (only sensible if the variable represented by the x-axis is ordinal).} \item{lwd_lines}{Width of the connecting lines (in \code{char} units).} \item{confidence}{logical; shall confindence intervals be plotted?} \item{conf_level}{confidence level used for confidence intervals.} \item{lwd_confidence}{Line width of the confidence interval bars (in \code{char} units).} \item{whiskers}{width of the confidence interval whiskers.} \item{transpose}{if \code{TRUE}, the plot is transposed.} \item{col}{character vector specifying the colors of the fitted lines, by default chosen with \code{\link[colorspace]{rainbow_hcl}}.} \item{cex}{size of the plot symbols (in lines).} \item{pch}{character or numeric vector of symbols used for plotting the (possibly conditioned) observed values, recycled as needed.} \item{bars}{logical; shall bars be plotted additionally to the points? Defaults to \code{TRUE} in case of only one conditioning variable.} \item{gp_bars}{object of class \code{"gpar"} used for the bars.} \item{bar_width}{Width of the bars, if drawn.} \item{legend}{logical; if \code{TRUE} (default), a legend is drawn.} \item{legend_pos}{numeric vector of length 2, specifying x and y coordinates of the legend, or a character string (e.g., \code{"topleft"}, \code{"center"} etc.). Defaults to \code{"topleft"} if the fitted curve's slope is positive, and \code{"topright"} else.} \item{legend_inset}{numeric vector or length 2 specifying the inset from the legend's x and y coordinates in npc units.} \item{legend_vgap}{vertical space between the legend's line entries.} \item{gp_legend_frame}{object of class \code{"gpar"} used for the legend frame.} \item{gp_legend_title}{object of class \code{"gpar"} used for the legend title.} \item{gp_legend}{object of class \code{"gpar"} used for the legend defaults.} \item{legend_lwd}{line width used in the legend for the different groups.} \item{legend_size}{size used for the group symbols (in char units).} \item{xlab}{label for the x-axis. Defaults to \code{"Strata"} if \code{transpose} is \code{FALSE}.} \item{ylab}{label for the y-axis. Defaults to \code{"Strata"} if \code{transpose} is \code{TRUE}.} \item{xlim}{x-axis limits. Ignored if \code{transpose} is \code{FALSE}.} \item{ylim}{y-axis limits. Ignored if \code{transpose} is \code{TRUE}.} \item{main}{user-specified main title.} \item{gp_main}{object of class \code{"gpar"} used for the main title.} \item{newpage}{logical; if \code{TRUE}, the plot is drawn on a new page.} \item{pop}{logical; if \code{TRUE}, all newly generated viewports are popped after plotting.} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{add}{logical; should the plot added to an existing log odds ratio plot?} \item{prefix}{character string used as prefix for the viewport name.} \item{\dots}{other graphics parameters (see \code{\link{par}}).} } \value{ if \code{return_grob} is \code{TRUE}, a grob object corresponding to the plot. \code{NULL} (invisibly) else. } \details{ The function basically produces conditioned line plots of the (log) odds ratios structure provided in \code{x}. The \code{lines} method can be used to overlay different plots (for example, observed and expected values). \code{\link{cotabplot}} can be used for stratified analyses (see examples). } \references{ M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{loddsratio}} } \examples{ ## 2 x 2 x k cases data(CoalMiners, package = "vcd") lor_CM <- loddsratio(CoalMiners) plot(lor_CM) lor_CM_df <- as.data.frame(lor_CM) # fit linear models using WLS age <- seq(20, 60, by = 5) lmod <- lm(LOR ~ age, weights = 1 / ASE^2, data = lor_CM_df) grid.lines(seq_along(age), fitted(lmod), gp = gpar(col = "blue", lwd = 2), default.units = "native") qmod <- lm(LOR ~ poly(age, 2), weights = 1 / ASE^2, data = lor_CM_df) grid.lines(seq_along(age), fitted(qmod), gp = gpar(col = "red", lwd = 2), default.units = "native") ## 2 x k x 2 lor_Emp <-loddsratio(Employment) plot(lor_Emp) ## 4 way tables data(Punishment, package = "vcd") mosaic(attitude ~ age + education + memory, data = Punishment, highlighting_direction="left", rep = c(attitude = FALSE)) # visualize the log odds ratios, by education plot(loddsratio(~ attitude + memory | education, data = Punishment)) # visualize the log odds ratios, by age plot(loddsratio(~ attitude + memory | age, data = Punishment)) # visualize the log odds ratios, by age and education plot(loddsratio(~ attitude + memory | age + education, data = Punishment)) # same, transposed plot(loddsratio(~ attitude + memory | age + education, data = Punishment), transpose = TRUE) # alternative visualization methods image(loddsratio(Freq ~ ., data = Punishment)) tile(loddsratio(Freq ~ ., data = Punishment)) ## cotabplots for more complex tables cotabplot(Titanic, cond = c("Age","Sex"), panel = cotab_loddsratio) cotabplot(Freq ~ opinion + grade + year | gender, data = JointSports, panel = cotab_loddsratio) cotabplot(Freq ~ opinion + grade | year + gender, data = JointSports, panel = cotab_loddsratio) } \keyword{category} vcd/man/HorseKicks.Rd0000755000175000017500000000250011150520606014263 0ustar nileshnilesh\name{HorseKicks} \alias{HorseKicks} \docType{data} \title{Death by Horse Kicks} \description{ Data from von Bortkiewicz (1898), given by Andrews \& Herzberg (1985), on number of deaths by horse or mule kicks in 10 (of 14 reported) corps of the Prussian army. 4 corps were not considered by Fisher (1925) as they had a different organization. This data set is a popular subset of the \code{\link{VonBort}} data. } \usage{ data("HorseKicks") } \format{ A 1-way table giving the number of deaths in 200 corps-years. The variable and its levels are \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab nDeaths \tab 0, 1, \dots, 4 \cr } } \references{ D. F. Andrews & A. M. Herzberg (1985), \emph{Data: A Collection of Problems from Many Fields for the Student and Research Worker}. Springer-Verlag, New York, NY. R. A. Fisher (1925), \emph{Statistical Methods for Research Workers}. Oliver \& Boyd, London. L. von Bortkiewicz (1898), \emph{Das Gesetz der kleinen Zahlen}. Teubner, Leipzig. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data, page 18. } \seealso{ \code{\link{VonBort}} } \examples{ data("HorseKicks") gf <- goodfit(HorseKicks) summary(gf) plot(gf) } \keyword{datasets} vcd/man/cotab_panel.Rd0000644000175000017500000000745514133262321014501 0ustar nileshnilesh\name{cotab_panel} \alias{cotab_mosaic} \alias{cotab_assoc} \alias{cotab_sieve} \alias{cotab_loddsratio} \alias{cotab_agreementplot} \alias{cotab_coindep} \alias{cotab_fourfold} \title{Panel-generating Functions for Contingency Table Coplots} \description{ Panel-generating functions visualizing contingency tables that can be passed to \code{cotabplot}. } \usage{ cotab_mosaic(x = NULL, condvars = NULL, \dots) cotab_assoc(x = NULL, condvars = NULL, ylim = NULL, \dots) cotab_sieve(x = NULL, condvars = NULL, \dots) cotab_loddsratio(x = NULL, condvars = NULL, \dots) cotab_agreementplot(x = NULL, condvars = NULL, \dots) cotab_fourfold(x = NULL, condvars = NULL, \dots) cotab_coindep(x, condvars, test = c("doublemax", "maxchisq", "sumchisq"), level = NULL, n = 1000, interpolate = c(2, 4), h = NULL, c = NULL, l = NULL, lty = 1, type = c("mosaic", "assoc"), legend = FALSE, ylim = NULL, \dots) } \arguments{ \item{x}{a contingency tables in array form.} \item{condvars}{margin name(s) of the conditioning variables.} \item{ylim}{y-axis limits for \code{assoc} plot. By default this is computed from \code{x}.} \item{test}{character indicating which type of statistic should be used for assessing conditional independence.} \item{level,n,h,c,l,lty,interpolate}{variables controlling the HCL shading of the residuals, see \code{\link{shadings}} for more details.} \item{type}{character indicating which type of plot should be produced.} \item{legend}{logical. Should a legend be produced in each panel?} \item{\dots}{further arguments passed to the plotting function (such as \code{\link{mosaic}} or \code{\link{assoc}} or \code{\link{sieve}} respectively).} } \details{ These functions of class \code{"panel_generator"} are panel-generating functions for use with \code{\link{cotabplot}}, i.e., they return functions with the interface \code{panel(x, condlevels)} required for \code{cotabplot}. The functions produced by \code{cotab_mosaic}, \code{cotab_assoc} and \code{cotab_sieve} essentially only call \code{co_table} to produce the conditioned table and then call \code{\link{mosaic}}, \code{\link{assoc}} or \code{\link{sieve}} respectively with the arguments specified. The function \code{cotab_coindep} is similar but additionally chooses an appropriate residual-based shading visualizing the associated conditional independence model. The conditional independence test is carried out via \code{\link{coindep_test}} and the shading is set up via \code{\link{shading_hcl}}. A description of the underlying ideas is given in Zeileis, Meyer, Hornik (2005). } \seealso{ \code{\link{cotabplot}}, \code{\link{mosaic}}, \code{\link{assoc}}, \code{\link{sieve}}, \code{\link{co_table}}, \code{\link{coindep_test}}, \code{\link{shading_hcl}} } \references{ Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. Available as \code{vignette("strucplot", package = "vcd")}. \doi{10.18637/jss.v017.i03}. Zeileis, A., Meyer, D., Hornik K. (2007), \emph{Residual-based shadings for visualizing (conditional) independence}, \emph{Journal of Computational and Graphical Statistics}, \bold{16}, 507--525. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \examples{ data("UCBAdmissions") cotabplot(~ Admit + Gender | Dept, data = UCBAdmissions) cotabplot(~ Admit + Gender | Dept, data = UCBAdmissions, panel = cotab_assoc) cotabplot(~ Admit + Gender | Dept, data = UCBAdmissions, panel = cotab_fourfold) ucb <- cotab_coindep(UCBAdmissions, condvars = "Dept", type = "assoc", n = 5000, margins = c(3, 1, 1, 3)) cotabplot(~ Admit + Gender | Dept, data = UCBAdmissions, panel = ucb) } \keyword{hplot} vcd/man/goodfit.Rd0000655000175000017500000001217412511041104013651 0ustar nileshnilesh\name{goodfit} \alias{goodfit} \alias{summary.goodfit} \alias{plot.goodfit} \alias{predict.goodfit} \alias{fitted.goodfit} \alias{residuals.goodfit} \alias{print.goodfit} \title{Goodness-of-fit Tests for Discrete Data} \description{ Fits a discrete (count data) distribution for goodness-of-fit tests. } \usage{ goodfit(x, type = c("poisson", "binomial", "nbinomial"), method = c("ML", "MinChisq"), par = NULL) \method{predict}{goodfit}(object, newcount = NULL, type = c("response", "prob"), \dots) \method{residuals}{goodfit}(object, type = c("pearson", "deviance", "raw"), \dots) \method{print}{goodfit}(x, residuals_type = c("pearson", "deviance", "raw"), \dots) } \arguments{ \item{x}{either a vector of counts, a 1-way table of frequencies of counts or a data frame or matrix with frequencies in the first column and the corresponding counts in the second column.} \item{type}{character string indicating: for \code{goodfit}, which distribution should be fit; for \code{predict}, the type of prediction (fitted response or probabilities); for \code{residuals}, either \code{"pearson"}, \code{"deviance"} or \code{"raw"}.} \item{residuals_type}{character string indicating the type of residuals: either \code{"pearson"}, \code{"deviance"} or \code{"raw"}.} \item{method}{a character string indicating whether the distribution should be fit via ML (Maximum Likelihood) or Minimum Chi-squared.} \item{par}{a named list giving the distribution parameters (named as in the corresponding density function), if set to \code{NULL}, the default, the parameters are estimated. If the parameter \code{size} is not specified if \code{type} is \code{"binomial"} it is taken to be the maximum count. If \code{type} is \code{"nbinomial"}, then parameter \code{size} can be specified to fix it so that only the parameter \code{prob} will be estimated (see the examples below).} \item{object}{an object of class \code{"goodfit"}.} \item{newcount}{a vector of counts. By default the counts stored in \code{object} are used, i.e., the fitted values are computed. These can also be extracted by \code{fitted(object)}.} \item{\dots}{\emph{currently not used}.} } \details{ \code{goodfit} essentially computes the fitted values of a discrete distribution (either Poisson, binomial or negative binomial) to the count data given in \code{x}. If the parameters are not specified they are estimated either by ML or Minimum Chi-squared. To fix parameters, \code{par} should be a named list specifying the parameters \code{lambda} for \code{"poisson"} and \code{prob} and \code{size} for \code{"binomial"} or \code{"nbinomial"}, respectively. If for \code{"binomial"}, \code{size} is not specified it is not estimated but taken as the maximum count. The corresponding Pearson Chi-squared or likelihood ratio statistic, respectively, is computed and given with their \eqn{p} values by the \code{summary} method. The \code{summary} method always prints this information and returns a matrix with the printed information invisibly. The \code{plot} method produces a \code{\link{rootogram}} of the observed and fitted values. In case of count distribtions (Poisson and negative binomial), the minimum Chi-squared approach is somewhat ad hoc. Strictly speaking, the Chi-squared asymptotics would only hold if the number of cells were fixed or did not increase too quickly with the sample size. However, in \code{goodfit} the number of cells is data-driven: Each count is a cell of its own. All counts larger than the maximal count are merged into the cell with the last count for computing the test statistic. } \value{ A list of class \code{"goodfit"} with elements: \item{observed}{observed frequencies.} \item{count}{corresponding counts.} \item{fitted}{expected frequencies (fitted by ML).} \item{type}{a character string indicating the distribution fitted.} \item{method}{a character string indicating the fitting method (can be either \code{"ML"}, \code{"MinChisq"} or \code{"fixed"} if the parameters were specified).} \item{df}{degrees of freedom.} \item{par}{a named list of the (estimated) distribution parameters.} } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \references{ M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \seealso{\code{\link{rootogram}}} \examples{ ## Simulated data examples: dummy <- rnbinom(200, size = 1.5, prob = 0.8) gf <- goodfit(dummy, type = "nbinomial", method = "MinChisq") summary(gf) plot(gf) dummy <- rbinom(100, size = 6, prob = 0.5) gf1 <- goodfit(dummy, type = "binomial", par = list(size = 6)) gf2 <- goodfit(dummy, type = "binomial", par = list(prob = 0.6, size = 6)) summary(gf1) plot(gf1) summary(gf2) plot(gf2) ## Real data examples: data("HorseKicks") HK.fit <- goodfit(HorseKicks) summary(HK.fit) plot(HK.fit) data("Federalist") ## try geometric and full negative binomial distribution F.fit <- goodfit(Federalist, type = "nbinomial", par = list(size = 1)) F.fit2 <- goodfit(Federalist, type = "nbinomial") summary(F.fit) summary(F.fit2) plot(F.fit) plot(F.fit2) } \keyword{category} vcd/man/structable.Rd0000755000175000017500000001223614133263040014375 0ustar nileshnilesh\name{structable} \alias{structable.default} \alias{structable.formula} \alias{structable} \alias{Extract.structable} \alias{aperm.structable} \alias{t.structable} \alias{is.structable} \alias{cbind.structable} \alias{rbind.structable} \alias{length.structable} \alias{is.na.structable} \alias{as.matrix.structable} \alias{as.vector.structable} \alias{dim.structable} \alias{dimnames.structable} \alias{as.table.structable} \title{Structured Contingency Tables} \description{ This function produces a \sQuote{flat} representation of a high-dimensional contingency table constructed by recursive splits (similar to the construction of mosaic displays). } \usage{ \method{structable}{formula}(formula, data, direction = NULL, split_vertical = NULL, \dots, subset, na.action) \method{structable}{default}(\dots, direction = NULL, split_vertical = FALSE) } \arguments{ \item{formula}{a formula object with possibly both left and right hand sides specifying the column and row variables of the flat table.} \item{data}{a data frame, list or environment containing the variables to be cross-tabulated, or an object inheriting from class \code{table}.} \item{subset}{an optional vector specifying a subset of observations to be used. Ignored if \code{data} is a contingency table.} \item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. Ignored if \code{data} is a contingency table} \item{\dots}{\R objects which can be interpreted as factors (including character strings), or a list (or data frame) whose components can be so interpreted, or a contingency table object of class \code{"table"} or \code{"ftable"}.} \item{split_vertical}{logical vector indicating, for each dimension, whether it should be split vertically or not (default: \code{FALSE}). Values are recycled as needed. If the argument is of length 1, the value is alternated for all dimensions. Ignored if \code{direction} is provided.} \item{direction}{character vector alternatively specifying the splitting direction (\code{"h"} for horizontal and \code{"v"} for vertical splits). Values are recycled as needed. If the argument is of length 1, the value is alternated for all dimensions.} } \details{ This function produces textual representations of mosaic displays, and thus \sQuote{flat} contingency tables. The formula interface is quite similar to the one of \code{\link{ftable}}, but also accepts the \code{\link{mosaic}}-like formula interface (empty left-hand side). Note that even if the \code{\link{ftable}} interface is used, the \code{split_vertical} or \code{direction} argument is needed to specify the \emph{order} of the horizontal and vertical splits. If pretabulated data with a \code{Freq} column is used, than the left-hand side should be left empty---the \code{Freq} column will be handled correctly. \code{"structable"} objects can be subset using the \code{[} and \code{[[} operators, using either level indices or names (see examples). The corresponding replacement functions are available as well. In addition, appropriate \code{\link{aperm}}, \code{\link{cbind}}, \code{\link{rbind}}, \code{\link{length}}, \code{\link{dim}}, and \code{\link{is.na}} methods do exist. } \value{ An object of class \code{"structable"}, inheriting from class \code{"ftable"}, with the splitting information (\code{"split_vertical"}) as additional attribute. } \author{ David Meyer \email{David.Meyer@R-project.org} } \references{ Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. Available as \code{vignette("strucplot", package = "vcd")}. \doi{10.18637/jss.v017.i03}. } \seealso{ \code{\link{strucplot}}, \code{\link{mosaic}}, \code{\link[stats]{ftable}} } \examples{ structable(Titanic) structable(Titanic, split_vertical = c(TRUE, TRUE, FALSE, FALSE)) structable(Titanic, direction = c("h","h","v","v")) structable(Sex + Class ~ Survived + Age, data = Titanic) ## subsetting of structable objects (hec <- structable(aperm(HairEyeColor))) ## The "[" operator treats structables as a block-matrix and selects parts of the matrix: hec[1] hec[2] hec[1,c(2,4)] hec["Male",c("Blue","Green")] ## replacement funcion: tmp <- hec (tmp[1,2:3] <- tmp[2,c(1,4)]) ## In contrast, the "[[" operator treats structables as two-dimensional ## lists. Indexing conditions on specified levels and thus reduces the dimensionality: ## seek subtables conditioning on levels of the first dimension: hec[[1]] hec[[2]] ## Seek subtable from the first two dimensions, given the level "Male" ## of the first variable, and "Brown" from the second ## (the following two commands are equivalent): hec[["Male"]][["Brown"]] hec[[c("Male","Brown")]] ## Seeking subtables by conditioning on row and/or column variables: hec[["Male","Hazel"]] hec[[c("Male","Brown"),]] hec[[c("Male","Brown"),"Hazel"]] ## a few other operations t(hec) dim(hec) dimnames(hec) as.matrix(hec) length(hec) cbind(hec[,1],hec[,3]) as.vector(hec) ## computed on the _multiway_ table as.vector(unclass(hec)) } \keyword{hplot} vcd/man/plot.loglm.Rd0000755000175000017500000000505212214055504014314 0ustar nileshnilesh\name{plot.loglm} \alias{plot.loglm} \alias{assoc.loglm} \alias{mosaic.loglm} \title{Visualize Fitted Log-linear Models} \description{ Visualize fitted \code{"loglm"} objects by mosaic or association plots. } \usage{ \method{plot}{loglm}(x, panel = mosaic, type = c("observed", "expected"), residuals_type = c("pearson", "deviance"), gp = shading_hcl, gp_args = list(), \dots) } \arguments{ \item{x}{a fitted \code{"loglm"} object, see \code{\link{loglm}}.} \item{panel}{a panel function for visualizing the observed values, residuals and expected values. Currently, \code{\link{mosaic}} and \code{\link{assoc}} in \pkg{vcd}.} \item{type}{a character string indicating whether the observed or the expected values of the table should be visualized.} \item{residuals_type}{a character string indicating the type of residuals to be computed.} \item{gp}{object of class \code{"gpar"}, shading function or a corresponding generating function (see details and \code{\link{shadings}}). Ignored if \code{shade = FALSE}.} \item{gp_args}{list of arguments for the shading-generating function, if specified.} \item{\dots}{Other arguments passed to the \code{panel} function.} } \details{ The \code{plot} method for \code{"loglm"} objects by default visualizes the model using a mosaic plot (can be changed to an association plot by setting \code{panel = assoc}) with a shading based on the residuals of this model. The legend also reports the corresponding p value of the associated goodness-of-fit test. The \code{mosaic} and \code{assoc} methods are simple convenience interfaces to this \code{plot} method, setting the \code{panel} argument accordingly. } \value{ The \code{"structable"} visualized is returned invisibly. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \seealso{ \code{\link{loglm}}, \code{\link{assoc}}, \code{\link{mosaic}}, \code{\link{strucplot}} } \examples{ library(MASS) ## mosaic display for PreSex model data("PreSex") fm <- loglm(~ PremaritalSex * ExtramaritalSex * (Gender + MaritalStatus), data = aperm(PreSex, c(3, 2, 4, 1))) fm ## visualize Pearson statistic plot(fm, split_vertical = TRUE) ## visualize LR statistic plot(fm, split_vertical = TRUE, residuals_type = "deviance") ## conditional independence in UCB admissions data data("UCBAdmissions") fm <- loglm(~ Dept * (Gender + Admit), data = aperm(UCBAdmissions)) ## use mosaic display plot(fm, labeling_args = list(abbreviate = c(Admit = 3))) ## and association plot plot(fm, panel = assoc) assoc(fm) } \keyword{hplot} vcd/man/assocstats.Rd0000655000175000017500000000300012504622200014375 0ustar nileshnilesh\name{assocstats} \alias{assocstats} \alias{summary.assocstats} \alias{print.assocstats} \alias{print.summary.assocstats} \title{Association Statistics} \description{ Computes the Pearson chi-Squared test, the Likelihood Ratio chi-Squared test, the phi coefficient, the contingency coefficient and Cramer's V for possibly stratified contingency tables. } \usage{ assocstats(x) } \arguments{ \item{x}{a contingency table, with possibly more than 2 dimensions. In this case, all dimensions except the first two ones are considered as strata.} } \value{ In case of a 2-dimensional table, a list with components: \item{chisq_tests}{a \eqn{2 \times 3}{2 x 3} table with the chi-squared statistics.} \item{phi}{The \emph{absolute value} of the phi coefficient (only defined for \eqn{2 \times 2}{2 x 2} tables).} \item{cont}{The contingency coefficient.} \item{cramer}{Cramer's V.} In case of higher-dimensional tables, a list of the above mentioned structure, each list component representing one stratum defined by the combinations of all levels of the stratum dimensions. } \references{ Michael Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. Fleiss, J. L. (1981). \emph{Statistical methods for rates and proportions} (2nd ed). New York: Wiley } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("Arthritis") tab <- xtabs(~Improved + Treatment, data = Arthritis) summary(assocstats(tab)) assocstats(UCBAdmissions) } \keyword{category} vcd/man/loddsratio.Rd0000644000175000017500000002426312535321266014402 0ustar nileshnilesh\name{loddsratio} \alias{loddsratio} \alias{oddsratio} \alias{loddsratio.default} \alias{loddsratio.formula} \alias{coef.loddsratio} \alias{confint.loddsratio} \alias{dim.loddsratio} \alias{dimnames.loddsratio} \alias{print.loddsratio} \alias{vcov.loddsratio} \alias{as.matrix.loddsratio} \alias{as.array.loddsratio} \alias{aperm.loddsratio} \alias{t.loddsratio} \alias{as.data.frame.loddsratio} \title{ Calculate Generalized Log Odds Ratios for Frequency Tables } \description{ Computes (log) odds ratios and their asymptotic variance covariance matrix for R x C (x strata) tables. Odds ratios are calculated for two array dimensions, separately for each level of all stratifying dimensions. See Friendly et al. (2011) for a sketch of a general theory. } \usage{ loddsratio(x, \dots) \method{loddsratio}{default}(x, strata = NULL, log = TRUE, ref = NULL, correct = any(x == 0L), \dots) \method{loddsratio}{formula}(formula, data = NULL, \dots, subset = NULL, na.action = NULL) oddsratio(x, stratum = NULL, log = TRUE) \method{coef}{loddsratio}(object, log = object$log, \dots) \method{vcov}{loddsratio}(object, log = object$log, \dots) \method{print}{loddsratio}(x, log = x$log, \dots) \method{confint}{loddsratio}(object, parm, level = 0.95, log = object$log, \dots) %as.array(x, \dots) \method{as.array}{loddsratio}(x, log=x$log, \dots) \method{t}{loddsratio}(x) \method{aperm}{loddsratio}(a, perm, \dots) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{an object. For the default method a k-way matrix/table/array of frequencies. The number of margins has to be at least 2.} \item{strata, stratum}{Numeric or character indicating the margins of a $k$-way table \code{x} (with $k$ greater than 2) that should be employed as strata. By default all dimensions except the first two are used.} \item{ref}{numeric or character. Reference categories for the (non-stratum) row and column dimensions that should be employed for computing the odds ratios. By default, odds ratios for profile contrasts (or sequential contrasts, i.e., successive differences of adjacent categories) are used. See details below.} \item{formula}{a formula specifying the variables used to create a contingency table from \code{data}. A conditioning formula can be specified; the conditioning variables will then be used as strata variables.} \item{data}{either a data frame, or an object of class \code{"table"} or \code{"ftable"}.} \item{subset}{an optional vector specifying a subset of observations to be used.} \item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. Ignored if \code{data} is a contingency table.} \item{log}{logical. Should the results be displayed on a log scale or not? All internal computations are always on the log-scale but the results are transformed by default if \code{log = TRUE}.} \item{correct}{logical or numeric. Should a continuity correction be applied before computing odds ratios? If \code{TRUE}, 0.5 is added to all cells; if numeric (or an array conforming to the data) that value is added to all cells. By default, this not employed unless there are any zero cells in the table, but this correction is often recommended to reduce bias when some frequencies are small (Fleiss, 1981).} \item{a, object}{an object of class \code{loddsratio} as computed by \code{loddsratio}.} \item{perm}{numeric or character vector specifying a permutation of strata.} \item{\dots}{arguments passed to methods.} \item{parm}{a specification of which parameters are to be given confidence intervals, either a vector of numbers or a vector of names. If missing, all parameters are considered.} \item{level}{the confidence level required for the \code{confint} method.} } \details{ For an R x C table, (log) odds ratios are formed for the set of (R-1) x (C-1) 2 x 2 tables, corresponding to some set of contrasts among the row and column variables. The \code{ref} argument allows these to be specified in a general way. \code{ref = NULL} (default) corresponds to \dQuote{profile contrasts} (or sequential contrasts or successive differences) for ordered categories, i.e., R1--R2, R2--R3, R3--R4, etc., and similarly for the column categories. These are sometimes called \dQuote{local odds ratios}. \code{ref = 1} gives contrasts with the first category; \code{ref = dim(x)} gives contrasts with the last category; \code{ref = c(2, 4)} or \code{ref = list(2, 4)} corresponds to the reference being the second category in rows and the fourth in columns. Combinations like \code{ref = list(NULL, 3)} are also possible, as are character vectors, e.g., \code{ref = c("foo", "bar")} also works ("foo" pertaining again to the row reference and "bar" to column reference). Note that all such parameterizations are equivalent, in that one can derive all other possible odds ratios from any non-redundant set, but the interpretation of these values depends on the parameterization. Note also that these reference level parameterizations only have meaning when the primary (non-strata) table dimensions are larger than 2x2. In the 2x2 case, the odds ratios are defined by the order of levels of those variables in the table, so you can achieve a desired interpretation by manipulating the table. See the help page of \code{\link{plot.loddsratio}} for visualization methods. } \value{ An object of class \code{loddsratio}, with the following components: \item{coefficients}{A named vector, of length (R-1) x (C-1) x \code{prod(dim(x)[strata])} containing the log odds ratios. Use the \code{coef} method to extract these from the object, and the \code{confint} method for confidence intervals. For a two-way table, the names for the log odds ratios are constructed in the form Ri:Rj/Ci:Cj using the table names for rows and columns. For a stratified table, the names are constructed in the form Ri:Rj/Ci:Cj|Lk. } \item{vcov}{Variance covariance matrix of the log odds ratios.} \item{dimnames}{Dimension names for the log odds ratios, considered as a table of size (R-1, C-1, \code{dim(x)[strata]}). Use the \code{dim} and \code{dimnames} methods to extract these and manipulate the log odds ratios in relation to the original table.} \item{dim}{Corresponding dimension vector.} \item{contrasts}{A matrix C, such that \code{C \%*\% as.vector(log(x))} gives the log odds ratios. Each row corresponds to one log odds ratio, and is all zero, except for 4 elements of \code{c(1, -1, -1, 1)} for a given 2 x 2 subtable.} \item{log}{A logical, indicating the value of \code{log} in the original call.} } \references{ A. Agresti (2013), \emph{Categorical Data Analysis}, 3rd Ed. New York: Wiley. Fleiss, J. L. (1981). \emph{Statistical Methods for Rates and Proportions}. 2nd Edition. New York: Wiley. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. Friendly, M., Turner, H,, Firth, D., Zeileis, A. (2011). \emph{Advances in Visualizing Categorical Data Using the vcd, gnm and vcdExtra Packages in R}. Correspondence Analysis and Related Methods (CARME 2011). \url{http://www.datavis.ca/papers/adv-vcd-4up.pdf} } \author{ Achim Zeileis, Michael Friendly and David Meyer. } \note{ The method of calculation is an example of the use of the delta method described by Agresti (2013), Section 16.1.6, giving estimates of log odds ratios and their asymptotic covariance matrix. The \code{coef} method returns the \code{coefficients} component as a vector of length (R-1) x (C-1) x \code{prod(dim(x)[strata])}. The \code{dim} and \code{dimnames} methods provide the proper attributes for treating the \code{coefficients} vector as an (R-1) x (C-1) x strata array. \code{as.matrix} and \code{as.array} methods are also provided for this purpose. The \code{confint} method computes confidence intervals for the log odds ratios (or for odds ratios, with \code{log = FALSE}). The \code{\link[lmtest]{coeftest}} method (\code{summary} is an alias) prints the asymptotic standard errors, z tests (standardized log odds ratios), and the corresponding p values. \emph{Structural zeros}: In addition to the options for zero cells provided by \code{correct}, the function allows for structural zeros to be represented as \code{NA} in the data argument. \code{NA} in the data yields \code{NA} as the \code{LOR} estimate, but does not affect other cells. \code{oddsratio} is just an alias to \code{loddsratio} for backward compatibility. } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ %%\code{\link[vcd]{oddsratio}}, \code{\link{plot.loddsratio}} for some plotting methods; \code{\link[stats]{confint}} for confidence intervals; \code{\link[lmtest]{coeftest}} for z-tests of significance } \examples{ ## artificial example set.seed(1) x <- matrix(rpois(5 * 3, 7), ncol = 5, nrow = 3) dimnames(x) <- list(Row = head(letters, 3), Col = tail(letters, 5)) x_lor <- loddsratio(x) coef(x_lor) x_lor confint(x_lor) summary(x_lor) ## 2 x 2 x k cases #data(CoalMiners, package = "vcd") lor_CM <- loddsratio(CoalMiners) lor_CM coef(lor_CM) confint(lor_CM) confint(lor_CM, log = FALSE) ## 2 x k x 2 lor_Emp <-loddsratio(Employment) lor_Emp confint(lor_Emp) ## 4 way tables data(Punishment, package = "vcd") lor_pun <- loddsratio(Freq ~ memory + attitude | age + education, data = Punishment) lor_pun confint(lor_pun) summary(lor_pun) # fit linear model using WLS lor_pun_df <- as.data.frame(lor_pun) pun_mod1 <- lm(LOR ~ as.numeric(age) * as.numeric(education), data = lor_pun_df, weights = 1 / ASE^2) anova(pun_mod1) ## illustrate ref levels VA.fem <- xtabs(Freq ~ left + right, subset=gender=="female", data=VisualAcuity) VA.fem loddsratio(VA.fem) # profile contrasts loddsratio(VA.fem, ref=1) # contrasts against level 1 loddsratio(VA.fem, ref=dim(VA.fem)) # contrasts against level 4 } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{category} %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line vcd/man/CoalMiners.Rd0000644000175000017500000000420312475151440014260 0ustar nileshnilesh\name{CoalMiners} \alias{CoalMiners} \title{Breathlessness and Wheeze in Coal Miners} \description{ Data from Ashford & Sowden (1970) given by Agresti (1990) on the association between two pulmonary conditions, breathlessness and wheeze, in a large sample of coal miners who were smokers with no radiological evidence of pneumoconlosis, aged between 20--64 when examined. This data is frequently used as an example of fitting models for bivariate, binary responses. } \usage{ data("CoalMiners") } \format{ A 3-dimensional table of size 2 x 2 x 9 resulting from cross-tabulating variables for 18,282 coal miners. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab Breathlessness \tab B, NoB \cr 2 \tab Wheeze \tab W, NoW \cr 3 \tab Age \tab 20-24, 25-29, 30-34, \dots, 60-64 } } \details{ In an earlier version of this data set, the first group, aged 20-24, was inadvertently omitted from this data table and the breathlessness variable was called wheeze and vice versa. } \references{ A. Agresti (1990), \emph{Categorical Data Analysis}. Wiley-Interscience, New York, Table 7.11, p. 237 J. R. Ashford and R. D. Sowdon (1970), Multivariate probit analysis, \emph{Biometrics}, \bold{26}, 535--546. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data, pages 82--83, 319--322. } \examples{ data("CoalMiners") ftable(CoalMiners, row.vars = 3) ## Fourfold display, both margins equated fourfold(CoalMiners[,,2:9], mfcol = c(2,4)) ## Fourfold display, strata equated fourfold(CoalMiners[,,2:9], std = "ind.max", mfcol = c(2,4)) ## Log Odds Ratio Plot lor_CM <- loddsratio(CoalMiners) summary(lor_CM) plot(lor_CM) lor_CM_df <- as.data.frame(lor_CM) # fit linear models using WLS age <- seq(20, 60, by = 5) lmod <- lm(LOR ~ age, weights = 1 / ASE^2, data = lor_CM_df) grid.lines(age, fitted(lmod), gp = gpar(col = "blue")) qmod <- lm(LOR ~ poly(age, 2), weights = 1 / ASE^2, data = lor_CM_df) grid.lines(age, fitted(qmod), gp = gpar(col = "red")) } \keyword{datasets} vcd/man/tile.Rd0000655000175000017500000001237012466747674013213 0ustar nileshnilesh\name{tile} \alias{tile} \alias{tile.default} \alias{tile.formula} \title{Tile Plot} \description{ Plots a tile display. } \usage{ \method{tile}{default}(x, tile_type = c("area", "squaredarea", "height", "width"), halign = c("left", "center", "right"), valign = c("bottom", "center", "top"), split_vertical = NULL, shade = FALSE, spacing = spacing_equal(unit(1, "lines")), set_labels = NULL, margins = unit(3, "lines"), keep_aspect_ratio = FALSE, legend = NULL, legend_width = NULL, squared_tiles = TRUE, main = NULL, sub = NULL, ...) \method{tile}{formula}(formula, data, \dots, main = NULL, sub = NULL, subset = NULL, na.action = NULL) } \arguments{ \item{x}{a contingency table, or an object coercible to one.} \item{formula}{a formula specifying the variables used to create a contingency table from \code{data}}. \item{data}{either a data frame, or an object of class \code{"table"} or \code{"ftable"}.} \item{subset}{an optional vector specifying a subset of observations to be used.} \item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. Ignored if \code{data} is a contingency table.} \item{tile_type}{character string indicating how the tiles should reflect the table frequencies (see details).} \item{halign, valign}{character string specifying the horizontal and vertical alignment of the tiles.} \item{split_vertical}{vector of logicals of length \eqn{k}, where \eqn{k} is the number of margins of \code{x} (values are recycled as needed). A \code{TRUE} component indicates that the tile(s) of the corresponding dimension should be split vertically, \code{FALSE} means horizontal splits. Default is \code{FALSE.}} \item{spacing}{spacing object, spacing function, or corresponding generating function (see \code{\link{strucplot}} for more information).} \item{set_labels}{An optional character vector with named components replacing the so-specified variable names. The component names must exactly match the variable names to be replaced.} \item{shade}{logical specifying whether shading should be enabled or not (see \code{\link{strucplot}}).} \item{margins}{either an object of class \code{"unit"} of length 4, or a numeric vector of length 4. The elements are recycled as needed. The four components specify the top, right, bottom, and left margin of the plot, respectively. When a numeric vector is supplied, the numbers are interpreted as \code{"lines"} units. In addition, the unit or numeric vector may have named arguments (\samp{top}, \samp{right}, \samp{bottom}, and \samp{left}), in which case the non-named arguments specify the default values (recycled as needed), overloaded by the named arguments.} \item{legend}{either a legend-generating function, or a legend function (see details and \code{\link{legends}}), or a logical. If \code{legend} is \code{NULL} or \code{TRUE} and \code{gp} is a function or missing, legend defaults to \code{\link{legend_resbased}}. } \item{legend_width}{An object of class \code{"unit"} of length 1 specifying the width of the legend (if any). Default: 5 lines.} \item{keep_aspect_ratio}{logical indicating whether the aspect ratio should be fixed or not. The default is \code{FALSE} to enable the creation of squared tiles.} \item{squared_tiles}{logical indicating whether white space should be added as needed to rows or columns to obtain squared tiles in case of an unequal number of row and column labels.} \item{main, sub}{either a logical, or a character string used for plotting the main (sub) title. If logical and \code{TRUE}, the name of the \code{data} object is used.} \item{\dots}{Other arguments passed to \code{\link{strucplot}}} } \details{ A tile plot is a matrix of tiles. For each tile, either the \code{"width"}, \code{"height"}, \code{"area"}, or squared area is proportional to the corresponding entry. The first three options allow column-wise, row-wise and overall comparisons, respectively. The last variant allows to compare the tiles both column-wise and row-wise, considering either the width or the height, respectively. In contrast to other high-level strucplot functions, \code{tile} also accepts a table with duplicated levels (see examples). In this case, artificial dimnames will be created, and the actual ones are drawn using \code{set_labels}. Note that multiway-tables are first \dQuote{flattened} using \code{structable}. } \value{ The \code{"structable"} visualized is returned invisibly. } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{assoc}}, \code{\link{strucplot}}, \code{\link{mosaic}}, \code{\link{structable}}, } \examples{ data("Titanic") ## default plot tile(Titanic) tile(Titanic, type = "expected") tile(Titanic, shade = TRUE) ## some variations tile(Titanic, tile_type = "squaredarea") tile(Titanic, tile_type = "width", squared_tiles = FALSE) tile(Titanic, tile_type = "height", squared_tiles = FALSE) tile(Titanic, tile_type = "area", halign = "center", valign = "center") ## repeat levels tile(Titanic[,,,c(1,2,1,2)]) } \keyword{hplot} vcd/man/Employment.Rd0000755000175000017500000000342011150520606014351 0ustar nileshnilesh\name{Employment} \alias{Employment} \docType{data} \title{Employment Status} \description{ Data from a 1974 Danish study given by Andersen (1991) on the employees who had been laid off. The workers are classified by their employment status on 1975-01-01, the cause of their layoff and the length of employment before they were laid off. } \usage{ data("Employment") } \format{ A 3-dimensional array resulting from cross-tabulating variables for 1314 employees. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab EmploymentStatus \tab NewJob, Unemployed \cr 2 \tab EmploymentLength \tab <1Mo, 1-3Mo, 3-12Mo, 1-2Yr, 2-5Yr, >5Yr \cr 3 \tab LayoffCause \tab Closure, Replaced } } \references{ E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. Springer-Verlag, Berlin. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data, pages 126--129. } \examples{ data("Employment") ## Employment Status mosaic(Employment, expected = ~ LayoffCause * EmploymentLength + EmploymentStatus, main = "Layoff*EmployLength + EmployStatus") mosaic(Employment, expected = ~ LayoffCause * EmploymentLength + LayoffCause * EmploymentStatus, main = "Layoff*EmployLength + Layoff*EmployStatus") ## Stratified view grid.newpage() pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) ## Closure mosaic(Employment[,,1], main = "Layoff: Closure", newpage = FALSE) popViewport(1) pushViewport(viewport(layout.pos.col = 2)) ## Replaced mosaic(Employment[,,2], main = "Layoff: Replaced", newpage = FALSE) popViewport(2) } \keyword{datasets} vcd/man/shadings.Rd0000644000175000017500000002557014133215104014025 0ustar nileshnilesh\name{shadings} \alias{shadings} \alias{shading_hsv} \alias{shading_hcl} \alias{shading_max} \alias{shading_Friendly} \alias{shading_Friendly2} \alias{shading_Marimekko} \alias{shading_diagonal} \alias{shading_sieve} \alias{shading_binary} \alias{hcl2hex} \encoding{UTF-8} \title{Shading-generating Functions for Residual-based Shadings} \description{ Shading-generating functions for computing residual-based shadings for mosaic and association plots. } \usage{ shading_hcl(observed, residuals = NULL, expected = NULL, df = NULL, h = NULL, c = NULL, l = NULL, interpolate = c(2, 4), lty = 1, eps = NULL, line_col = "black", p.value = NULL, level = 0.95, \dots) shading_hsv(observed, residuals = NULL, expected = NULL, df = NULL, h = c(2/3, 0), s = c(1, 0), v = c(1, 0.5), interpolate = c(2, 4), lty = 1, eps = NULL, line_col = "black", p.value = NULL, level = 0.95, \dots) shading_max(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = NULL, c = NULL, l = NULL, lty = 1, eps = NULL, line_col = "black", level = c(0.9, 0.99), n = 1000, \dots) shading_Friendly(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = c(2/3, 0), lty = 1:2, interpolate = c(2, 4), eps = 0.01, line_col = "black", \dots) shading_Friendly2(observed = NULL, residuals = NULL, expected = NULL, df = NULL, lty = 1:2, interpolate = c(2, 4), eps = 0.01, line_col = "black", \dots) shading_sieve(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = c(260, 0), lty = 1:2, interpolate = c(2, 4), eps = 0.01, line_col = "black", \dots) shading_binary(observed = NULL, residuals = NULL, expected = NULL, df = NULL, col = NULL) shading_Marimekko(x, fill = NULL, byrow = FALSE) shading_diagonal(x, fill = NULL) hcl2hex(h = 0, c = 35, l = 85, fixup = TRUE) } \arguments{ \item{observed}{contingency table of observed values} \item{residuals}{contingency table of residuals} \item{expected}{contingency table of expected values} \item{df}{degrees of freedom of the associated independence model.} \item{h}{hue value in the HCL or HSV color description, has to be in [0, 360] for HCL and in [0, 1] for HSV colors. The default is to use blue and red for positive and negative residuals respectively. In the HCL specification it is \code{c(260, 0)} by default and for HSV \code{c(2/3, 0)}.} \item{c}{chroma value in the HCL color description. This controls the maximum chroma for significant and non-significant results respectively and defaults to \code{c(100, 20)}.} \item{l}{luminance value in the HCL color description. Defaults to \code{c(90, 50)} for small and large residuals respectively.} \item{s}{saturation value in the HSV color description. Defaults to \code{c(1, 0)} for large and small residuals respectively.} \item{v}{saturation value in the HSV color description. Defaults to \code{c(1, 0.5)} for significant and non-significant results respectively.} \item{interpolate}{a specification for mapping the absolute size of the residuals to a value in [0, 1]. This can be either a function or a numeric vector. In the latter case, a step function with steps of equal size going from 0 to 1 is used.} \item{lty}{a vector of two line types for positive and negative residuals respectively. Recycled if necessary.} \item{eps}{numeric tolerance value below which absolute residuals are considered to be zero, which is used for coding the border color and line type. If set to \code{NULL} (default), all borders have the default color specified by \code{line\_col}. If set to a numeric value, all border colors corresponding to residuals with a larger absolute value are set to the full positive or negative color, respectively; borders corresponding to smaller residuals are are drawn with \code{line\_col} and \code{lty[1]}}. This is used principally in \code{shading\_Friendly}. \item{line_col}{default border color (for \code{shading_sieve}: default sieve color).} \item{p.value}{the \eqn{p} value associated with the independence model. By default, this is computed from a Chi-squared distribution with \code{df} degrees of freedom. \code{p.value} can be either a scalar or a \code{function(observed, residuals, expected, df)} that computes the \eqn{p} value from the data. If set to \code{NA} no inference is performed.} \item{level}{confidence level of the test used. If \code{p.value} is smaller than \code{1 - level}, bright colors are used, otherwise dark colors are employed. For \code{shading_max} a vector of levels can be supplied. The corresponding critical values are then used as \code{interpolate} cut-offs.} \item{n}{number of permutations used in the call to \code{coindep_test}.} \item{col}{a vector of two colors for positive and negative residuals respectively.} \item{fixup}{logical. Should the color be corrected to a valid RGB value before correction?} \item{x}{object of class \code{table} used to determine the dimension.} \item{fill}{Either a character vector of color codes, or a palette function that generates such a vector. Defaults to \code{\link[colorspace]{rainbow_hcl}}} \item{byrow}{logical; shall tiles be filled by row or by column?} \item{\dots}{Other arguments passed to \code{\link{hcl2hex}} or \code{\link{hsv}}, respectively.} } \details{ These shading-generating functions can be passed to \code{strucplot} to generate residual-based shadings for contingency tables. \code{strucplot} calls these functions with the arguments \code{observed}, \code{residuals}, \code{expected}, \code{df} which give the observed values, residuals, expected values and associated degrees of freedom for a particular contingency table and associated independence model. The shadings \code{shading_hcl} and \code{shading_hsv} do the same thing conceptually, but use HCL or HSV colors respectively. The former is usually preferred because they are perceptually based. Both shadings visualize the \emph{sign} of the residuals of an independence model using two hues (by default: blue and red). The \emph{absolute size} of the residuals is visualized by the colorfulness and the amount of grey, by default in three categories: very colorful for large residuals (> 4), less colorful for medium sized residuals (< 4 and > 2), grey/white for small residuals (< 2). More categories or a continuous scale can be specified by setting \code{interpolate}. Furthermore, the result of a significance test can be visualized by the amount of grey in the colors. If significant, a colorful palette is used, if not, the amount of color is reduced. See Zeileis, Meyer, and Hornik (2007) and \code{\link[colorspace]{diverge_hcl}} for more details. The shading \code{shading_max} is applicable in 2-way contingency tables and uses a similar strategy as \code{shading_hcl}. But instead of using the cut-offs 2 and 4, it employs the critical values for the maximum statistic (by default at 90\% and 99\%). Consequently, color in the plot signals a significant result at 90\% or 99\% significance level, respectively. The test is carried out by calling \code{\link{coindep_test}}. The shading \code{shading_Friendly} is very similar to \code{shading_hsv}, but additionally codes the sign of the residuals by different line types. See Friendly (1994) for more details. \code{shading_Friendly2} and \code{shading_sieve} are similar, but use HCL colors. The shading \code{shading_binary} just visualizes the sign of the residuals by using two different colors (default: blue HCL(260, 50, 70) and red HCL(0, 50, 70)). \code{shading_Marimekko} is a simple generating function for producing, in conjunction with \code{\link{mosaic}}, so-called \emph{Marimekko-charts}, which paint the tiles of each columns of a mosaic display in the same color to better display departures from independence. \code{shading_diagonal} generates a color shading for basically square matrices (or arrays having the first two dimensons of same length) visualizing the diagonal cells, and the off-diagonal cells 1, 2, \dots steps removed. The color implementations employed are \code{\link{hsv}} from base R and \code{\link[colorspace]{polarLUV}} from the \pkg{colorspace} package, respectively. To transform the HCL coordinates to a hexadecimal color string (as returned by \code{hsv}), the function \code{\link[colorspace]{hex}} is employed. A convenience wrapper \code{hcl2hex} is provided. } \references{ Friendly M. (1994), Mosaic Displays for Multi-Way Contingency Tables. \emph{Journal of the American Statistical Association}, \bold{89}, 190--200. Meyer D., Zeileis A., and Hornik K. (2006), The Strucplot Framework: Visualizing Multi-Way Contingency Tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17}(3), 1--48. \doi{10.18637/jss.v017.i03}. See also \code{vignette("strucplot", package = "vcd")}. Zeileis A., Meyer D., Hornik K. (2007), Residual-Based Shadings for Visualizing (Conditional) Independence. \emph{Journal of Computational and Graphical Statistics}, \bold{16}, 507--525. Zeileis A., Hornik K. and Murrell P. (2008), Escaping RGBland: Selecting Colors for Statistical Graphics. \emph{Computational Statistics & Data Analysis}, \bold{53}, 3259--3270. Preprint available from \url{https://www.zeileis.org/papers/Zeileis+Hornik+Murrell-2009.pdf}. } \value{A shading function which takes only a single argument, interpreted as a vector/table of residuals, and returns a \code{"gpar"} object with the corresponding vector(s)/table(s) of graphical parameter(s). } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \seealso{ \code{\link[colorspace]{hex}}, \code{\link[colorspace]{polarLUV}}, \code{\link{hsv}}, \code{\link{mosaic}}, \code{\link{assoc}}, \code{\link{strucplot}}, \code{\link[colorspace]{diverge_hcl}} } \examples{ ## load Arthritis data data("Arthritis") art <- xtabs(~Treatment + Improved, data = Arthritis) ## plain mosaic display without shading mosaic(art) ## with shading for independence model mosaic(art, shade = TRUE) ## which uses the HCL shading mosaic(art, gp = shading_hcl) ## the residuals are too small to have color, ## hence the cut-offs can be modified mosaic(art, gp = shading_hcl, gp_args = list(interpolate = c(1, 1.8))) ## the same with the Friendly palette ## (without significance testing) mosaic(art, gp = shading_Friendly, gp_args = list(interpolate = c(1, 1.8))) ## assess independence using the maximum statistic ## cut-offs are now critical values for the test statistic mosaic(art, gp = shading_max) ## association plot with shading as in base R assoc(art, gp = shading_binary(col = c(1, 2))) ## Marimekko Chart hec <- margin.table(HairEyeColor, 1:2) mosaic(hec, gp = shading_Marimekko(hec)) mosaic(HairEyeColor, gp = shading_Marimekko(HairEyeColor)) ## Diagonal cells shading ac <- xtabs(VisualAcuity) mosaic(ac, gp = shading_diagonal(ac)) } \keyword{hplot} vcd/man/co_table.Rd0000755000175000017500000000162011264574714014007 0ustar nileshnilesh\name{co_table} \alias{co_table} \title{Compute Conditional Tables} \description{ For a contingency table in array form, compute a list of conditional tables given some margins. } \usage{ co_table(x, margin, collapse = ".") } \arguments{ \item{x}{a contingency table in array form.} \item{margin}{margin index(es) or corresponding name(s) of the conditioning variables.} \item{collapse}{character used when collapsing level names (if more than 1 \code{margin} is specified).} } \details{ This is essentially an interface to \code{\link[base]{[}} which is more convenient for arrays of arbitrary dimension. } \value{ A list of the resulting conditional tables. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \examples{ data("HairEyeColor") co_table(HairEyeColor, 1) co_table(HairEyeColor, c("Hair", "Eye")) co_table(HairEyeColor, 1:2, collapse = "") } \keyword{array} vcd/man/WeldonDice.Rd0000755000175000017500000000223611150520606014241 0ustar nileshnilesh\name{WeldonDice} \alias{WeldonDice} \docType{data} \title{Weldon's Dice Data} \description{ Data from Pearson (1900) about the frequency of 5s and 6s in throws of 12 dice. Weldon tossed the dice 26,306 times and reported his results in a letter to Francis Galton on 1894-02-02. } \usage{ data("WeldonDice") } \format{ A 1-way table giving the frequency of a 5 or a 6 in 26,306 throws of 12 dice where 10 indicates \sQuote{10 or more} 5s or 6s. The variable and its levels are \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab n56 \tab 0, 1, \dots, 10 \cr } } \references{ K. Pearson (1900), On the criterion that a given system of deviations from the probable in the case of a correlated system of variables is such that it can be reasonably supposed to have arisen by random sampling, \emph{Philosophical Magazine}, \bold{50} (5th series), 157--175. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ M. Friendly (2000), Visualizing Categorical Data, pages 20--21. } \examples{ data("WeldonDice") gf <- goodfit(WeldonDice, type = "binomial") summary(gf) plot(gf) } \keyword{datasets} vcd/man/UKSoccer.Rd0000755000175000017500000000174411150520606013705 0ustar nileshnilesh\name{UKSoccer} \alias{UKSoccer} \docType{data} \title{UK Soccer Scores} \description{ Data from Lee (1997), on the goals scored by Home and Away teams in the Premier Football League, 1995/6 season. } \usage{ data("UKSoccer") } \format{ A 2-dimensional array resulting from cross-tabulating the number of goals scored in 380 games. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab Home \tab 0, 1, \dots, 4 \cr 2 \tab Away \tab 0, 1, \dots, 4 } } \references{ A. J. Lee (1997), Modelling scores in the Premier League: Is Manchester United really the best?, \emph{Chance}, \bold{10}(1), 15--19. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ M. Friendly (2000), Visualizing Categorical Data, page 27. } \seealso{ \code{\link{Bundesliga}} } \examples{ data("UKSoccer") mosaic(UKSoccer, gp = shading_max, main = "UK Soccer Scores") } \keyword{datasets} vcd/man/woolf_test.Rd0000755000175000017500000000214611150520606014411 0ustar nileshnilesh\name{woolf_test} \alias{woolf_test} \title{Woolf Test} \description{ Test for homogeneity on \eqn{2 \times 2 \times k}{2 x 2 x k} tables over strata (i.e., whether the log odds ratios are the same in all strata). } \usage{ woolf_test(x) } \arguments{ \item{x}{A \eqn{2 \times 2 \times k}{2 x 2 x k} table.} } \value{ A list of class \code{"htest"} containing the following components: \item{statistic}{the chi-squared test statistic.} \item{parameter}{degrees of freedom of the approximate chi-squared distribution of the test statistic.} \item{p.value}{\eqn{p}-value for the test.} \item{method}{a character string indicating the type of test performed.} \item{data.name}{a character string giving the name(s) of the data.} \item{observed}{the observed counts.} \item{expected}{the expected counts under the null hypothesis.} } \seealso{ \code{\link{mantelhaen.test}} } \references{ Woolf, B. 1955. On estimating the relation between blood group and disease. \emph{Ann. Human Genet.} (London) \bold{19}, 251-253. } \examples{ data("CoalMiners") woolf_test(CoalMiners) } \keyword{htest} vcd/man/PreSex.Rd0000755000175000017500000000347011150520606013433 0ustar nileshnilesh\name{PreSex} \alias{PreSex} \docType{data} \title{Pre-marital Sex and Divorce} \description{ Data from Thornes \& Collard (1979), reported in Gilbert (1981), on pre- and extra-marital sex and divorce. } \usage{ data("PreSex") } \format{ A 4-dimensional array resulting from cross-tabulating 1036 observations on 4 variables. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab MaritalStatus \tab Divorced, Married \cr 2 \tab ExtramaritalSex \tab Yes, No \cr 3 \tab PremaritalSex \tab Yes, No \cr 4 \tab Gender \tab Women, Men } } \references{ G. N. Gilbert (1981), \emph{Modelling Society: An Introduction to Loglinear Analysis for Social Researchers}. Allen and Unwin, London. B. Thornes \& J. Collard (1979), \emph{Who Divorces?}. Routledge \& Kegan, London. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data: \url{http://euclid.psych.yorku.ca/ftp/sas/vcd/catdata/marital.sas} } \examples{ data("PreSex") ## Mosaic display for Gender and Premarital Sexual Experience ## (Gender Pre) mosaic(margin.table(PreSex, c(3,4)), main = "Gender and Premarital Sex") ## (Gender Pre)(Extra) mosaic(margin.table(PreSex, c(2,3,4)), expected = ~Gender * PremaritalSex + ExtramaritalSex , main = "PreMaritalSex*Gender +Sex") ## (Gender Pre Extra)(Marital) mosaic(PreSex, expected = ~Gender*PremaritalSex*ExtramaritalSex + MaritalStatus, main = "PreMarital*ExtraMarital + MaritalStatus") ## (GPE)(PEM) mosaic(PreSex, expected = ~ Gender * PremaritalSex * ExtramaritalSex + MaritalStatus * PremaritalSex * ExtramaritalSex, main = "G*P*E + P*E*M") } \keyword{datasets} vcd/man/Hitters.Rd0000755000175000017500000000327611150520606013653 0ustar nileshnilesh\name{Hitters} \alias{Hitters} \docType{data} \title{Hitters Data} \description{ This data set is deduced from the \code{\link{Baseball}} fielding data set: fielding performance basically includes the numbers of Errors, Putouts and Assists made by each player. In order to reduce the number of observations, the was compressed by calculating the mean number of errors, putouts and assists for each team and for only 6 positions (1B, 2B, 3B, C, OF, SS and UT). In addition, each of these three variables was scaled to a common range by dividing each variable by the maximum of the variable. } \usage{data("Hitters")} \format{ A data frame with 154 observations and 4 variables. \describe{ \item{Positions}{factor indicating the field position (1B=first baseman, 2B=second baseman, 3B=third baseman, C=catcher, OF=outfielder, SS=Short Stop, UT=Utility Players).} \item{Putouts}{occur when a fielder causes an opposing player to be tagged or forced out.} \item{Assists}{are credited to other fielders involved in making that putout.} \item{Errors}{count the errors made by a player.} } } \references{ M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ SAS System for Statistical Graphics, First Edition, Page A2.3 } \examples{ data("Hitters") attach(Hitters) colors <- c("black","red","green","blue","red","black","blue") pch <- substr(levels(Positions), 1, 1) ternaryplot(Hitters[,2:4], pch = as.character(Positions), col = colors[as.numeric(Positions)], main = "Baseball Hitters Data") grid_legend(0.8, 0.9, pch, colors, levels(Positions), title = "POSITION(S)") detach(Hitters) } \keyword{datasets} vcd/man/hls.Rd0000755000175000017500000000132111150520606013004 0ustar nileshnilesh\name{hls} \alias{hls} \title{HLS Color Specification} \description{ Create a HLS color from specifying hue, luminance and saturation. } \usage{ hls(h = 1, l = 0.5, s = 1) } \arguments{ \item{h}{hue value in [0, 1].} \item{l}{luminance value in [0, 1].} \item{s}{saturation value in [0, 1].} } \details{ HLS colors are a similar specification of colors as HSV colors, but using hue/luminance/saturation rather that hue/saturation/value. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \seealso{ \code{\link{hsv}}, \code{\link{hcl2hex}}, \code{\link[colorspace]{polarLUV}} } \examples{ ## an HLS color wheel pie(rep(1, 12), col = sapply(1:12/12, function(x) hls(x))) } \keyword{hplot} vcd/man/independence_table.Rd0000755000175000017500000000126111150520606016011 0ustar nileshnilesh\name{independence_table} \alias{independence_table} \title{Independence Table} \description{ Computes table of expected frequencies (under the null hypotheses of independence) from an \eqn{n}-way table. } \usage{ independence_table(x, frequency = c("absolute", "relative")) } \arguments{ \item{x}{a table.} \item{frequency}{indicates whether absolute or relative frequencies should be computed.} } \value{ A table with either absolute or relative frequencies. } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("MSPatients") independence_table(MSPatients) independence_table(MSPatients, frequency = "relative") } \keyword{category} \keyword{array} vcd/man/Arthritis.Rd0000755000175000017500000000235711150520606014201 0ustar nileshnilesh\name{Arthritis} \alias{Arthritis} \docType{data} \title{Arthritis Treatment Data} \description{ Data from Koch \& Edwards (1988) from a double-blind clinical trial investigating a new treatment for rheumatoid arthritis. } \usage{data("Arthritis")} \format{ A data frame with 84 observations and 5 variables. \describe{ \item{ID}{patient ID.} \item{Treatment}{factor indicating treatment (Placebo, Treated).} \item{Sex}{factor indicating sex (Female, Male).} \item{Age}{age of patient.} \item{Improved}{ordered factor indicating treatment outcome (None, Some, Marked).} } } \references{ G. Koch \& S. Edwards (1988), Clinical efficiency trials with categorical data. In K. E. Peace (ed.), \emph{Biopharmaceutical Statistics for Drug Development}, 403--451. Marcel Dekker, New York. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data: \url{http://euclid.psych.yorku.ca/ftp/sas/vcd/catdata/arthrit.sas} } \examples{ data("Arthritis") art <- xtabs(~ Treatment + Improved, data = Arthritis, subset = Sex == "Female") art mosaic(art, gp = shading_Friendly) mosaic(art, gp = shading_max) } \keyword{datasets} vcd/man/grid_barplot.Rd0000655000175000017500000000301112444613362014674 0ustar nileshnilesh\name{grid_barplot} \alias{grid_barplot} \title{Barplot} \description{ Bar plots of 1-way tables in grid. } \usage{ grid_barplot(height, width = 0.8, offset = 0, names = NULL, xlim = NULL, ylim = NULL, xlab = "", ylab = "", main = "", gp = gpar(fill = "lightgray"), name = "grid_barplot", newpage = TRUE, pop = FALSE, return_grob = FALSE) } \arguments{ \item{height}{either a vector or a 1-way table of frequencies.} \item{width}{width of the bars (recycled if needed to the number of bars).} \item{offset}{offset of the bars (recycled if needed to the number of bars).} \item{names}{a vector of names for the bars, if set to \code{NULL} the names of \code{height} are used.} \item{xlim}{limits for the x axis.} \item{ylim}{limits for the y axis.} \item{xlab}{a label for the x axis.} \item{ylab}{a label for the y axis.} \item{main}{a title for the plot.} \item{gp}{a \code{"gpar"} object controlling the grid graphical parameters of the rectangles.} \item{name}{name of the plotting viewport.} \item{newpage}{logical. Should \code{\link{grid.newpage}} be called before plotting?} \item{pop}{logical. Should the viewport created be popped?} \item{return_grob}{logical. Shall the plot be returned as a grob object?} } \details{ \code{grid_barplot} mimics (some of) the features of \code{\link{barplot}}, but currently it only supports 1-way tables. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \examples{ grid_barplot(sample(1:6), names = letters[1:6]) } \keyword{hplot} vcd/man/Saxony.Rd0000755000175000017500000000176511150520606013513 0ustar nileshnilesh\name{Saxony} \alias{Saxony} \docType{data} \title{Families in Saxony} \description{ Data from Geissler, cited in Sokal & Rohlf (1969) and Lindsey (1995) on gender distributions in families in Saxony in the 19th century. } \usage{ data("Saxony") } \format{ A 1-way table giving the number of male children in 6115 families of size 12. The variable and its levels are \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab nMales \tab 0, 1, \dots, 12 \cr } } \references{ J. K. Lindsey (1995), \emph{Analysis of Frequency and Count Data}. Oxford University Press, Oxford, UK. R. R. Sokal & F. J. Rohlf (1969), \emph{Biometry. The Principles and Practice of Statistics}. W. H. Freeman, San Francisco, CA. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ M. Friendly (2000), Visualizing Categorical Data, pages 40--42. } \examples{ data("Saxony") gf <- goodfit(Saxony, type = "binomial") summary(gf) plot(gf) } \keyword{datasets} vcd/man/JobSatisfaction.Rd0000755000175000017500000000224211150520606015303 0ustar nileshnilesh\name{JobSatisfaction} \alias{JobSatisfaction} \docType{data} \title{Job Satisfaction Data} \description{ Data from Petersen (1968) about the job satisfaction of 715 blue collar workers, selected from Danish Industry in 1968. } \usage{ data("JobSatisfaction") } \format{ A data frame with 8 observations and 4 variables. \describe{ \item{Freq}{frequency.} \item{management}{factor indicating quality of management (bad, good).} \item{supervisor}{factor indicating supervisor's job satisfaction (low, high).} \item{own}{factor indicating worker's own job satisfaction (low, high).} } } \references{ E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. 2nd edition. Springer-Verlag, Berlin. E. Petersen (1968), \emph{Job Satisfaction in Denmark}. (In Danish). Mentalhygiejnisk Forlag, Copenhagen. } \source{ E. B. Andersen (1991), The Statistical Analysis of Categorical Data, Table 5.4. } \examples{ data("JobSatisfaction") structable(~ ., data = JobSatisfaction) mantelhaen.test(xtabs(Freq ~ own + supervisor + management, data = JobSatisfaction)) } \keyword{datasets} vcd/man/labeling_border.Rd0000755000175000017500000002526614133262450015352 0ustar nileshnilesh\name{labeling_border} \alias{labeling_border} \alias{labeling_conditional} \alias{labeling_left} \alias{labeling_left2} \alias{labeling_cboxed} \alias{labeling_lboxed} \alias{labeling_doubledecker} \alias{labeling_values} \alias{labeling_residuals} \alias{labelings} \title{Labeling Functions for Strucplots} \description{ These functions generate labeling functions used for strucplots. } \usage{ labeling_border(labels = TRUE, varnames = labels, set_labels = NULL, set_varnames = NULL, tl_labels = NULL, alternate_labels = FALSE, tl_varnames = NULL, gp_labels = gpar(fontsize = 12), gp_varnames = gpar(fontsize = 12, fontface = 2), rot_labels = c(0, 90, 0, 90), rot_varnames = c(0, 90, 0, 90), pos_labels = "center", pos_varnames = "center", just_labels = "center", just_varnames = pos_varnames, boxes = FALSE, fill_boxes = FALSE, offset_labels = c(0, 0, 0, 0), offset_varnames = offset_labels, labbl_varnames = NULL, labels_varnames = FALSE, sep = ": ", abbreviate_labs = FALSE, rep = TRUE, clip = FALSE, \dots) labeling_values(value_type = c("observed", "expected", "residuals"), suppress = NULL, digits = 1, clip_cells = FALSE, \dots) labeling_residuals(suppress = NULL, digits = 1, clip_cells = FALSE, \dots) labeling_conditional(\dots) labeling_left(rep = FALSE, pos_varnames = "left", pos_labels = "left", just_labels = "left", \dots) labeling_left2(tl_labels = TRUE, clip = TRUE, pos_varnames = "left", pos_labels = "left", just_labels = "left", \dots) labeling_cboxed(tl_labels = TRUE, boxes = TRUE, clip = TRUE, pos_labels = "center", \dots) labeling_lboxed(tl_labels = FALSE, boxes = TRUE, clip = TRUE, pos_labels = "left", just_labels = "left", labbl_varnames = FALSE, \dots) labeling_doubledecker(lab_pos = c("bottom", "top"), dep_varname = TRUE, boxes = NULL, clip = NULL, labbl_varnames = FALSE, rot_labels = rep.int(0, 4), pos_labels = c("left", "center", "left", "center"), just_labels = c("left", "left", "left", "center"), varnames = NULL, gp_varnames = gpar(fontsize = 12, fontface = 2), offset_varnames = c(0, -0.6, 0, 0), tl_labels = NULL, \dots) } \arguments{ \item{labels}{vector of logicals indicating whether labels should be drawn for a particular dimension.} \item{varnames}{vector of logicals indicating whether variable names should be drawn for a particular dimension.} \item{set_labels}{An optional character vector with named components replacing the so-specified variable names. The component names must exactly match the variable names to be replaced.} \item{set_varnames}{An optional list with named components of character vectors replacing the labels of the so-specified variables. The component names must exactly match the variable names whose labels should be replaced.} \item{tl_labels}{vector of logicals indicating whether labels should be positioned on top (column labels) / left (row labels) for a particular dimension.} \item{alternate_labels}{vector of logicals indicating whether labels should be alternated on the top/bottom (left/right) side of the plot for a particular dimension.} \item{tl_varnames}{vector of logicals indicating whether variable names should be positioned on top (column labels) / on left (row labels) for a particular dimension.} \item{gp_labels}{list of objects of class \code{"gpar"} used for drawing the labels.} \item{gp_varnames}{list of objects of class \code{"gpar"} used for drawing the variable names.} \item{rot_labels}{vector of rotation angles for the labels for each of the four sides of the plot.} \item{rot_varnames}{vector of rotation angles for the variable names for each of the four sides of the plot.} \item{pos_labels}{character string of label positions (\code{"left"}, \code{"center"}, \code{"right"}) for each of the variables.} \item{pos_varnames}{character string of variable names positions (\code{"left"}, \code{"center"}, \code{"right"}) for each of the four sides of the plot.} \item{just_labels}{character string of label justifications (\code{"left"}, \code{"center"}, \code{"right"}) for each of the variables.} \item{just_varnames}{character string of variable names justifications (\code{"left"}, \code{"center"}, \code{"right"}) for each of the four sides of the plot.} \item{boxes}{vector of logicals indicating whether boxes should be drawn around the labels for a particular dimension.} \item{fill_boxes}{Either a vector of logicals, or a vector of characters, or a list of such vectors, specifying the fill colors for the boxes. \code{"TRUE"} and \code{"FALSE"} values are transformed into \code{"grey"} and \code{"white"}, respectively. If \code{fill_boxes} is atomic, each component specifies a basic color for the corresponding dimension. This color is transformed into its HSV representation, and the value is varied from 50\% to 100\% to give a sequential color palette for the levels. For \code{NA} components, no palette is produced (no fill color). If \code{fill_boxes} is a list of vectors, each vector specifies the level colors of the corresponding dimension.} \item{offset_labels, offset_varnames}{numeric vector of length 4 indicating the offset of the labels (variable names) for each of the four sides of the plot.} \item{labbl_varnames}{vector of logicals indicating whether variable names should be drawn on the left (column variables) / on top (row variables) of the corresponding labels.} \item{labels_varnames}{vector of logicals indicating, for each dimension, whether the variable name should be added to the corresponding labels or not.} \item{sep}{separator used if any component of \code{"labels_varnames"} is \code{TRUE}.} \item{abbreviate_labs}{vector of integers or logicals indicating, for each dimension, the number of characters the labels should be abbreviated to. \code{TRUE} means 1 character, \code{FALSE} causes no abbreviation. Values are recycled as needed.} \item{rep}{vector of logicals indicating, for each dimension, whether labels should be repeated for all conditioning strata, or appear only once.} \item{clip}{vector of integers indicating, for each dimension, whether labels should be clipped to not overlap.} \item{lab_pos}{character string switching between \code{"top"} or \code{"bottom"} position of the labels (only used for \code{labeling_doubledecker}).} \item{dep_varname}{logical or character string. If logical, this is indicating whether the name of the dependent variable should be printed or not. A character string will be printed instead of the variable name taken from the dimnames.} \item{value_type}{character string specifying which values should be displayed in the cells.} \item{suppress}{numeric vector of length 2 specifying an interval of values that are not displayed. 0 values are never displayed. A single number, \var{k}, is treated as \code{c(-\var{k}, \var{k})}. The default for labeling residuals is \code{c(-2,2)}. Use \code{suppress = 0} to show all non-zero values.} \item{digits}{integer specifying the number of digits used for rounding.} \item{clip_cells}{logical indicating whether the values should be clipped at the cell borders.} \item{\dots}{only used for \code{labeling_conditional} and \code{labeling_doubledecker}: parameters passed to \code{labeling_cells} and \code{labeling_border}.} } \details{ These functions generate labeling functions called by \code{\link{strucplot}} for their side-effect of adding labels to the plot. They suppose that a strucplot has been drawn and the corresponding viewport structure is pushed, since the positions of the viewports are used for the label positioning. Note that the functions can also be used \sQuote{stand-alone} as shown in the examples. All values supplied to vectorized arguments can be \sQuote{abbreviated} by using named components which override the default component values. In addition, these defaults can be overloaded by the sequence of non-named components which are recycled as needed (see examples). This help page only documents \code{labeling_border} and derived functions, more functions are described on the help page for \code{\link{labeling_cells}} and \code{\link{labeling_list}}. \code{labeling_left}, \code{labeling_left2}, \code{labeling_cboxed}, and \code{labeling_lboxed} are really just wrappers to \code{labeling_border}, and good examples for the parameter usage. \code{labeling_residuals} is a trivial wrapper for \code{labeling_values}, which in turn calls \code{labeling_border} by additionally adding the observed or expected frequencies or residuals to the cells. } \value{ A function with arguments: \item{d}{\code{"dimnames"} attribute from the visualized contingency table, or the visualized table itself from which the \code{"dimnames"} attributes will then be extracted.} \item{split_vertical}{vector of logicals indicating the split directions.} \item{condvars}{integer vector of conditioning dimensions.} } \author{ David Meyer \email{David.Meyer@R-project.org} } \references{ Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. Available as \code{vignette("strucplot", package = "vcd")}. \doi{10.18637/jss.v017.i03}. } \seealso{ \code{\link{labeling_cells}}, \code{\link{labeling_list}}, \code{\link{structable}}, \code{\link[grid]{grid.text}} } \examples{ data("Titanic") mosaic(Titanic) mosaic(Titanic, labeling = labeling_left) labeling_left mosaic(Titanic, labeling = labeling_cboxed) labeling_cboxed mosaic(Titanic, labeling = labeling_lboxed) labeling_lboxed data("PreSex") mosaic(~ PremaritalSex + ExtramaritalSex | Gender + MaritalStatus, data = PreSex, labeling = labeling_conditional) ## specification of vectorized arguments mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = TRUE))) mosaic(Titanic, labeling_args = list(clip = TRUE, boxes = TRUE, fill_boxes = c(Survived = "green", "red"))) mosaic(Titanic, labeling_args = list(clip = TRUE, boxes = TRUE, fill_boxes = list(Sex = "red", "green"))) mosaic(Titanic, labeling_args = list(clip = TRUE, boxes = TRUE, fill_boxes = list(Sex = c(Male = "red", "blue"), "green"))) ## change variable names mosaic(Titanic, labeling_args = list(set_varnames = c(Sex = "Gender"))) ## change labels mosaic(Titanic, labeling_args = list(set_varnames = c(Survived = "Status"), set_labels = list(Survived = c("Survived", "Not Survived")), rep = FALSE)) ## show frequencies mosaic(Titanic, labeling = labeling_values) } \keyword{hplot} vcd/man/sieve.Rd0000644000175000017500000001550414133262612013342 0ustar nileshnilesh\name{sieve} \alias{sieve} \alias{sieve.default} \alias{sieve.formula} \title{Extended Sieve Plots} \encoding{UTF-8} \description{ (Extended) sieve displays for n-way contingency tables: plots rectangles with areas proportional to the expected cell frequencies and filled with a number of squares equal to the observed frequencies. Thus, the densities visualize the deviations of the observed from the expected values. } \usage{ \method{sieve}{default}(x, condvars = NULL, gp = NULL, shade = NULL, legend = FALSE, split_vertical = NULL, direction = NULL, spacing = NULL, spacing_args = list(), sievetype = c("observed","expected"), gp_tile = gpar(), scale = 1, main = NULL, sub = NULL, \dots) \method{sieve}{formula}(formula, data, \dots, main = NULL, sub = NULL, subset = NULL) } \arguments{ \item{x}{a contingency table in array form, with optional category labels specified in the \code{dimnames(x)} attribute.} \item{condvars}{vector of integers or character strings indicating conditioning variables, if any. The table will be permuted to order them first.} \item{formula}{a formula specifying the variables used to create a contingency table from \code{data}. For convenience, conditioning formulas can be specified; the conditioning variables will then be used first for splitting. Formulas for sieve displays (unlike those for doubledecker plots) have no response variable.} \item{data}{either a data frame, or an object of class \code{"table"} or \code{"ftable"}.} \item{subset}{an optional vector specifying a subset of observations to be used.} \item{shade}{logical specifying whether \code{gp} should be used or not (see \code{gp}). If \code{TRUE} and \code{expected} is unspecified, a default model is fitted: if \code{condvars} is specified, a corresponding conditional independence model, and else the total independence model. If \code{shade} is \code{NULL} (default), \code{gp} is used if specified.} \item{sievetype}{logical indicating whether rectangles should be filled according to \code{observed} or \code{expected} frequencies.} \item{gp}{object of class \code{"gpar"}, shading function or a corresponding generating function (see details of \code{\link{strucplot}} and \code{\link{shadings}}). Components of \code{"gpar"} objects are recycled as needed along the last splitting dimension. The default is a modified version of \code{\link{shading_Friendly}}: if \code{sievetype} is \code{"observed"}, cells with positive residuals are painted with a red sieve, and cells with negative residuals with a blue one. If \code{sievetype} is \code{"expected"}, the sieves' color is gray. Ignored if \code{shade = FALSE}.} \item{gp_tile}{object of class \code{"gpar"}, controlling the appearance of all \emph{static} elements of the cells (e.g., border and fill color).} \item{scale}{scaling factor for the sieve.} \item{legend}{either a legend-generating function, a legend function (see details of \code{\link{strucplot}} and \code{\link{legends}}), or a logical value. If \code{legend} is \code{NULL} or \code{TRUE} and \code{gp} is a function, legend defaults to \code{\link{legend_resbased}}.} \item{split_vertical}{vector of logicals of length \eqn{k}, where \eqn{k} is the number of margins of \code{x} (default: \code{FALSE}). Values are recycled as needed. A \code{TRUE} component indicates that the tile(s) of the corresponding dimension should be split vertically, \code{FALSE} means horizontal splits. Ignored if \code{direction} is not \code{NULL}.} \item{direction}{character vector of length \eqn{k}, where \eqn{k} is the number of margins of \code{x} (values are recycled as needed). For each component, a value of \code{"h"} indicates that the tile(s) of the corresponding dimension should be split horizontally, whereas \code{"v"} indicates vertical split(s).} \item{spacing}{spacing object, spacing function, or corresponding generating function (see \code{\link{strucplot}} for more information). The default is no spacing at all if \code{x} has two dimensions, and \code{spacing_increase} for more dimensions.} \item{spacing_args}{list of arguments for the generating function, if specified (see \code{\link{strucplot}} for more information).} \item{main, sub}{either a logical, or a character string used for plotting the main (sub) title. If logical and \code{TRUE}, the name of the \code{data} object is used.} \item{\dots}{Other arguments passed to \code{\link{strucplot}}} } \details{ \code{sieve} is a generic function which currently has a default method and a formula interface. Both are high-level interfaces to the \code{\link{strucplot}} function, and produce (extended) sieve displays. Most of the functionality is described there, such as specification of the independence model, labeling, legend, spacing, shading, and other graphical parameters. The layout is very flexible: the specification of shading, labeling, spacing, and legend is modularized (see \code{\link{strucplot}} for details). } \value{ The \code{"structable"} visualized is returned invisibly. } \note{To be faithful to the original definition by Riedwyl & Schüpbach, the default is to have no spacing between the tiles for two-way tables.} \references{ H. Riedwyl & M. Schüpbach (1994), Parquet diagram to plot contingency tables. In F. Faulbaum (ed.), \emph{Softstat '93: Advances in Statistical Software}, 293--299. Gustav Fischer, New York. M. Friendly (2000), Visualizing Categorical Data, SAS Institute, Cary, NC. Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. Available as \code{vignette("strucplot", package = "vcd")}. \doi{10.18637/jss.v017.i03}. } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{assoc}}, \code{\link{strucplot}}, \code{\link{mosaic}}, \code{\link{structable}}, \code{\link{doubledecker}} } \examples{ data("HairEyeColor") ## aggregate over 'sex': (haireye <- margin.table(HairEyeColor, c(2,1))) ## plot expected values: sieve(haireye, sievetype = "expected", shade = TRUE) ## plot observed table: sieve(haireye, shade = TRUE) ## plot complete diagram: sieve(HairEyeColor, shade = TRUE) ## example with observed values in the cells: sieve(haireye, shade = TRUE, labeling = labeling_values, gp_text = gpar(fontface = 2)) ## example with expected values in the cells: sieve(haireye, shade = TRUE, labeling = labeling_values, value_type = "expected", gp_text = gpar(fontface = 2)) ## an example for the formula interface: data("VisualAcuity") sieve(Freq ~ right + left, data = VisualAcuity) } \keyword{hplot} vcd/man/lodds.Rd0000644000175000017500000002472112566042766013353 0ustar nileshnilesh\name{lodds} \alias{lodds} \alias{odds} \alias{lodds.default} \alias{lodds.formula} \alias{coef.lodds} \alias{confint.lodds} \alias{dim.lodds} \alias{dimnames.lodds} \alias{print.lodds} \alias{vcov.lodds} \alias{as.matrix.lodds} \alias{as.array.lodds} \alias{aperm.lodds} \alias{t.lodds} \alias{as.data.frame.lodds} \title{ Calculate Generalized Log Odds for Frequency Tables } \description{ Computes (log) odds and their asymptotic variance covariance matrix for R (by strata) tables. Odds are calculated for pairs of levels of one array dimension (typically a response or focal variable) separately for each level of all stratifying dimensions. See Friendly et al. (2011) for a sketch of a general theory. } \usage{ lodds(x, \dots) \method{lodds}{default}(x, response = NULL, strata = NULL, log = TRUE, ref = NULL, correct = any(x == 0), \dots) \method{lodds}{formula}(formula, data = NULL, \dots, subset = NULL, na.action = NULL) odds(x, log = FALSE, \dots) \method{coef}{lodds}(object, log = object$log, \dots) \method{vcov}{lodds}(object, log = object$log, \dots) \method{print}{lodds}(x, log = x$log, \dots) \method{confint}{lodds}(object, parm, level = 0.95, log = object$log, \dots) \method{dim}{lodds}(x, ...) \method{dimnames}{lodds}(x, ...) %as.array(x, \dots) \method{as.array}{lodds}(x, log=x$log, \dots) \method{t}{lodds}(x) \method{aperm}{lodds}(a, perm, \dots) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{an object. For the default method a k-way matrix/table/array of frequencies. The number of margins has to be at least 2.} \item{response}{Numeric or character indicating the margin of a $k$-way table \code{x} (with $k$ greater than 2) that should be employed as the response variable. By default the first dimension is used.} \item{strata}{Numeric or character indicating the margins of a $k$-way table \code{x} (with $k$ greater than 2) that should be employed as strata. Ignored if \code{response} is specified. By default all dimensions except the first are used as strata.} \item{ref}{numeric or character. Reference categories for the (non-stratum) row and column dimensions that should be employed for computing the odds. By default, odds for profile contrasts (or sequential contrasts, i.e., successive differences of adjacent categories) are used. See details below.} \item{formula}{a formula specifying the variables used to create a contingency table from \code{data}. A conditioning formula can be specified; the conditioning variables will then be used as strata variables.} \item{data}{either a data frame, or an object of class \code{"table"} or \code{"ftable"}.} \item{subset}{an optional vector specifying a subset of observations to be used.} \item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. Ignored if \code{data} is a contingency table.} \item{log}{logical. Should the results be displayed on a log scale or not? All internal computations are always on the log-scale but the results are transformed by default if \code{log = TRUE}.} \item{correct}{logical or numeric. Should a continuity correction be applied before computing odds? If \code{TRUE}, 0.5 is added to all cells; if numeric (or an array conforming to the data) that value is added to all cells. By default, this not employed unless there are any zero cells in the table, but this correction is often recommended to reduce bias when some frequencies are small (Fleiss, 1981).} \item{a, object}{an object of class \code{lodds} as computed by \code{lodds}.} \item{perm}{numeric or character vector specifying a permutation of strata.} \item{\dots}{arguments passed to methods.} \item{parm}{a specification of which parameters are to be given confidence intervals, either a vector of numbers or a vector of names. If missing, all parameters are considered.} \item{level}{the confidence level required for the \code{confint} method.} } \details{ For an n-way table with the \code{response} variable containing R levels, (log) odds are formed (by default) for the set of (R-1) contrasts among the response levels. The \code{ref} argument allows these to be specified in a general way. \code{ref = NULL} (default) corresponds to \dQuote{profile contrasts} (or sequential contrasts or successive differences) for ordered categories, i.e., R1--R2, R2--R3, R3--R4, etc., and similarly for the column categories. These are sometimes called \dQuote{local odds} or \dQuote{adjacent odds}. \code{ref = 1} gives contrasts with the first category; \code{ref = dim(x)} gives contrasts with the last category. %\code{ref = c(2, 4)} or \code{ref = list(2, 4)} %corresponds to the reference being the second category in rows and %the fourth in columns. %Combinations like \code{ref = list(NULL, 3)} are also possible, as are character %vectors, e.g., \code{ref = c("foo", "bar")} also works ("foo" pertaining again to the % row reference and "bar" to column reference). Note that all such parameterizations are equivalent, in that one can derive all other possible odds from any non-redundant set, but the interpretation of these values depends on the parameterization. %Note also that these reference level parameterizations only have meaning when the %primary (non-strata) table dimensions are larger than 2x2. In the 2x2 case, %the odds are defined by the order of levels of those variables in the table, %so you can achieve a desired interpretation by manipulating the table. See the help page of \code{\link{plot.loddsratio}} for related visualization methods. There is as yet no plot method for \code{lodds} objects. } \value{ An object of class \code{lodds}, with the following components: \item{coefficients}{A named vector, of length (R-1) x (C-1) x \code{prod(dim(x)[strata])} containing the log odds. Use the \code{coef} method to extract these from the object, and the \code{confint} method for confidence intervals. For a two-way table, the names for the log oddsare constructed in the form Ri:Rj using the table names for rows and columns. For a stratified table, the names are constructed in the form Ri:Rj|Lk. } \item{vcov}{Variance covariance matrix of the log odds.} \item{dimnames}{Dimension names for the log odds, considered as a table of size (R-1, C-1, \code{dim(x)[strata]}). Use the \code{dim} and \code{dimnames} methods to extract these and manipulate the log odds in relation to the original table.} \item{dim}{Corresponding dimension vector.} \item{contrasts}{A matrix C, such that \code{C \%*\% as.vector(log(x))} gives the log odds ratios. Each row corresponds to one log odds, and is all zero, except for 2 elements of \code{c(1, -1)} for a given 2 x 1 subtable.} \item{log}{A logical, indicating the value of \code{log} in the original call.} } \references{ A. Agresti (2013), \emph{Categorical Data Analysis}, 3rd Ed. New York: Wiley. Fleiss, J. L. (1981). \emph{Statistical Methods for Rates and Proportions}. 2nd Edition. New York: Wiley. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. Friendly, M., Turner, H,, Firth, D., Zeileis, A. (2011). \emph{Advances in Visualizing Categorical Data Using the vcd, gnm and vcdExtra Packages in R}. Correspondence Analysis and Related Methods (CARME 2011). \url{http://www.datavis.ca/papers/adv-vcd-4up.pdf} } \author{ Achim Zeileis, Michael Friendly and David Meyer. } \note{ The method of calculation is an example of the use of the delta method described by Agresti (2013), Section 16.1.6, giving estimates of log odds ratios and their asymptotic covariance matrix. The \code{coef} method returns the \code{coefficients} component as a vector of length (R-1) x \code{prod(dim(x)[strata])}. The \code{dim} and \code{dimnames} methods provide the proper attributes for treating the \code{coefficients} vector as an (R-1) x strata array. \code{as.matrix} and \code{as.array} methods are also provided for this purpose. The \code{confint} method computes confidence intervals for the log odds (or for odds, with \code{log = FALSE}). The \code{\link[lmtest]{coeftest}} method (\code{summary} is an alias) prints the asymptotic standard errors, z tests (standardized log odds), and the corresponding p values. \emph{Structural zeros}: In addition to the options for zero cells provided by \code{correct}, the function allows for structural zeros to be represented as \code{NA} in the data argument. \code{NA} in the data yields \code{NA} as the \code{LOR} estimate, but does not affect other cells. \code{odds} is just an alias to \code{lodds} with the default \code{log=FALSE} for convenience. } %% ~Make other sections like Warning with \section{Warning }{....} ~ \seealso{ %%\code{\link[vcd]{oddsratio}}, \code{\link{loddsratio}} for log odds \emph{ratios}; %\code{\link{plot.lodds}} for some plotting methods; \code{\link[stats]{confint}} for confidence intervals; \code{\link[lmtest]{coeftest}} for z-tests of significance } \examples{ ## artificial example set.seed(1) x <- matrix(rpois(5 * 3, 7), ncol = 5, nrow = 3) dimnames(x) <- list(Row = head(letters, 3), Col = tail(letters, 5)) x_lodds <- lodds(x) coef(x_lodds) x_lodds confint(x_lodds) summary(x_lodds) ### 2 x 2 x k cases ##data(CoalMiners, package = "vcd") #lor_CM <- loddsratio(CoalMiners) #lor_CM #coef(lor_CM) #confint(lor_CM) #confint(lor_CM, log = FALSE) # ### 2 x k x 2 #lor_Emp <-loddsratio(Employment) #lor_Emp #confint(lor_Emp) # ### 4 way tables #data(Punishment, package = "vcd") #lor_pun <- loddsratio(Freq ~ memory + attitude | age + education, data = Punishment) #lor_pun #confint(lor_pun) #summary(lor_pun) # ## fit linear model using WLS #lor_pun_df <- as.data.frame(lor_pun) #pun_mod1 <- lm(LOR ~ as.numeric(age) * as.numeric(education), # data = lor_pun_df, weights = 1 / ASE^2) #anova(pun_mod1) # ### illustrate ref levels #VA.fem <- xtabs(Freq ~ left + right, subset=gender=="female", data=VisualAcuity) #VA.fem #loddsratio(VA.fem) # profile contrasts #loddsratio(VA.fem, ref=1) # contrasts against level 1 #loddsratio(VA.fem, ref=dim(VA.fem)) # contrasts against level 4 # } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{category} %\keyword{ ~kwd2 }% __ONLY ONE__ keyword per line vcd/man/grid_legend.Rd0000644000175000017500000001164212535260462014476 0ustar nileshnilesh\name{grid_legend} \alias{grid_legend} \title{Legend Function for grid Graphics} \description{ This function can be used to add legends to \emph{grid-based} plots. } \usage{ grid_legend(x, y, pch = NA, col = par('col'), labels, frame = TRUE, hgap = unit(0.8, "lines"), vgap = unit(0.8, "lines"), default_units = "lines", gp = gpar(), draw = TRUE, title = NULL, just = 'center', lwd = NA, lty = NA, size = 1, gp_title = NULL, gp_labels = NULL, gp_frame = gpar(fill = "transparent"), inset = c(0, 0)) } \arguments{ \item{x}{character string \code{"topright"}, \code{"topleft"}, \code{"bottomright"}, \code{"bottomleft"}, \code{"top"}, \code{"bottom"}, \code{"left"}, \code{"right"}, \code{"center"} or x coordinate of the legend.} \item{y}{y coordinates of the legend.} \item{pch}{integer vector of plotting symbols, if any.} \item{col}{character vector of colors for the symbols.} \item{labels}{character vector of labels corresponding to the symbols.} \item{frame}{logical indicating whether the legend should have a border or not.} \item{hgap}{object of class \code{"unit"} specifying the space between symbols and labels.} \item{vgap}{object of class \code{"unit"} specifying the space between the lines.} \item{default_units}{character string indicating the default unit.} \item{gp}{object of class \code{"gpar"} used for the legend.} \item{draw}{logical indicating whether the legend be drawn or not.} \item{title}{character string indicating the plot's title.} \item{just}{justification of the legend relative to its (x, y) location. see ?viewport for more details.} \item{lwd}{positive number to set the line width. if specified lines are drawn.} \item{lty}{line type. if specified lines are drawn.} \item{size}{size of the group symbols (in char units).} \item{gp_title}{object of class \code{"gpar"} used for the title.} \item{gp_labels}{object of class \code{"gpar"} used for the labels.} \item{gp_frame}{object of class \code{"gpar"} used for the frame.} \item{inset}{numeric vector of length 2 specifying the inset of the legend in npc units, relative to the specified x and y coordinates.} } \value{ Invisibly, the legend as a \code{"grob"} object. } \author{ David Meyer \email{David.Meyer@R-project.org} Florian Gerber \email{florian.gerber@math.uzh.ch} } \seealso{ \code{\link[graphics]{legend}} } \examples{ data("Lifeboats") attach(Lifeboats) ternaryplot(Lifeboats[,4:6], pch = ifelse(side == "Port", 1, 19), col = ifelse(side == "Port", "red", "blue"), id = ifelse(men / total > 0.1, as.character(boat), NA), prop_size = 2, dimnames_position = "edge", main = "Lifeboats on Titanic") grid_legend(0.8, 0.9, c(1, 19), c("red", "blue"), c("Port", "Starboard"), title = "SIDE") grid.newpage() pushViewport(viewport(height = .9, width = .9 )) grid.rect(gp = gpar(lwd = 2, lty = 2)) grid_legend(x = unit(.05,'npc'), y = unit(.05,'npc'), just = c(0,0), pch = c(1,2,3), col = c(1,2,3), lwd=NA, lty=NA, labels = c("b",'r','g'), title = NULL, gp=gpar(lwd=2, cex=1), hgap = unit(.8, "lines"), vgap = unit(.9, "lines")) grid_legend(x = unit(1,'npc'), y = unit(1,'npc'), just = c(1,1), pch = NA, col = c(1,2,3,4), lwd=c(1,1,1,3), lty=c(1,2,1,3), labels = c("black",'red','green','blue'), gp_labels = list(gpar(col = 1), gpar(col = 2), gpar(col = 3), gpar(col = 4)), title = NULL, gp=gpar(lwd=2, cex=1), hgap = unit(.8, "lines"), vgap = unit(.9, "lines")) grid_legend(x = 'topleft', pch = c(1,NA,2,NA), col = c(1,2,3,4), lwd=NA, lty=c(NA,2,NA,3), labels = c("black",'red','green','blue'), title = 'Some LONG Title', gp_title = gpar(col = 3), gp_frame = gpar(col = 4, lty = 2, fill = "transparent"), gp_labels = gpar(col = 6), gp=gpar(lwd=2, cex=2, col = 1), hgap = unit(.8, "lines"), vgap = unit(.9, "lines")) grid_legend(x = .7, y = .7, pch = c(1,NA,2,NA), col = c(1,2,3,4), lwd=1, lty=c(NA,2,NA,3), labels = c("black",'red','green','blue'), title = 'short T', gp=gpar(lwd=1, cex=.7,col = 1), hgap = unit(.8, "lines"), vgap = unit(.9, "lines")) grid_legend(x = 'bottomright', pch = c(1,NA,2,NA), col = c(2), lwd=NA, lty=c(NA,2,NA,3), labels = c("black",'red','green','blue'), title = NULL, gp=gpar(lwd=2, cex=1,col = 1), hgap = unit(.8, "lines"), vgap = unit(.9, "lines")) } \keyword{hplot} vcd/man/mplot.Rd0000644000175000017500000000404112535317336013364 0ustar nileshnilesh\name{mplot} \alias{mplot} \title{Multiple Grid plots} \description{ combines severals grid-based plots in a multi-panel-layout. } \usage{ mplot(..., .list = list(), layout = NULL, cex = NULL, main = NULL, gp_main = gpar(fontsize = 20), sub = NULL, gp_sub = gpar(fontsize = 15), keep_aspect_ratio = TRUE) } \arguments{ \item{\dots, .list}{A list of objects inheriting from class \code{"grob"}, or having a \code{"grob"} attribute containing such an object.} \item{layout}{integer vector of length 2 giving the number of rows and columns. If \code{NULL}, the values will be guessed using some heuristics from the number of objects supplied in \dots.} \item{cex}{Scaling factor for the fonts in the subplots. If \code{NULL}, the value is calculated as the inverse square root of the row number.} \item{main, sub}{Optional main and sub title, respectively.} \item{gp_main, gp_sub}{Optional objects of class \code{"gpar"} specifying the graphical parameters for the main and sub title, respectively.} \item{keep_aspect_ratio}{logical; should the aspect ratio of the plots be fixed?} } \value{ None. } \details{ This is a convenience function for producing multi-panel plots from grid-based displays, especially those produced by the vcd methods. The layout (number of rows and columns) is guessed from the amount of supplied objects, if not supplied. Currently, the vcd plotting functions do not return grob objects by default---this might change in the future. Also, some of them will return the grob object as a \code{"grob"} attribute, attached to the currently returned object. } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ mplot(mosaic(Titanic, return_grob = TRUE), assoc(Titanic), return_grob = TRUE) A = mosaic(Titanic, return_grob = TRUE) B = mosaic(Titanic, type = "expected", return_grob = TRUE) mplot(A, B) mplot(sieve(SexualFun, return_grob = TRUE), agreementplot(SexualFun, return_grob = TRUE), main = "Sexual Fun") mplot(A, grid.circle()) }vcd/man/VonBort.Rd0000755000175000017500000000256611150520606013623 0ustar nileshnilesh\name{VonBort} \alias{VonBort} \docType{data} \title{Von Bortkiewicz Horse Kicks Data} \description{ Data from von Bortkiewicz (1898), given by Andrews \& Herzberg (1985), on number of deaths by horse or mule kicks in 14 corps of the Prussian army. } \usage{ data("VonBort") } \format{ A data frame with 280 observations and 4 variables. \describe{ \item{deaths}{number of deaths.} \item{year}{year of the deaths.} \item{corps}{factor indicating the corps.} \item{fisher}{factor indicating whether the corresponding corps was considered by Fisher (1925) or not.} } } \references{ D. F. Andrews \& A. M. Herzberg (1985), \emph{Data: A Collection of Problems from Many Fields for the Student and Research Worker}. Springer-Verlag, New York, NY. R. A. Fisher (1925), \emph{Statistical Methods for Research Workers}. Oliver & Boyd, London. L. von Bortkiewicz (1898), \emph{Das Gesetz der kleinen Zahlen}. Teubner, Leipzig. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data: \url{http://euclid.psych.yorku.ca/ftp/sas/vcd/catdata/vonbort.sas} } \seealso{ \code{\link{HorseKicks}} for a popular subsample. } \examples{ data("VonBort") ## HorseKicks data xtabs(~ deaths, data = VonBort, subset = fisher == "yes") } \keyword{datasets} vcd/man/Bundestag2005.Rd0000644000175000017500000000565213210522155014451 0ustar nileshnilesh\name{Bundestag2005} \alias{Bundestag2005} \title{Votes in German Bundestag Election 2005} \description{ Number of votes by province in the German Bundestag election 2005 (for the parties that eventually entered the parliament). } \usage{ data("Bundestag2005") } \format{ A 2-way \code{"table"} giving the number of votes for each party (\code{Fraktion}) in each of the 16 German provinces (\code{Bundesland}): \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab Bundesland \tab Schleswig-Holstein, Mecklenburg-Vorpommern, \dots \cr 2 \tab Fraktion \tab SPD, CDU/CSU, Gruene, FDP, Linke } } \details{ In the election for the German parliament \dQuote{Bundestag}, five parties obtained enough votes to enter the parliament: the social democrats SPD, the conservative CDU/CSU, the liberal FDP, the green party \dQuote{Die Gruenen} and the leftist party \dQuote{Die Linke}. The table \code{Bundestag2005} gives the number of votes for each party (\code{Fraktion}) in each of the 16 German provinces (\code{Bundesland}). The provinces are ordered from North to South. The data have been obtained from the German statistical office (Statistisches Bundesamt) from the Web page given below. Note that the number of seats in the parliament cannot be computed from the number of votes alone. The examples below show the distribution of seats that resulted from the election. } \source{ Der Bundeswahlleiter, Statistisches Bundesamt. \url{https://www.bundeswahlleiter.de/bundestagswahlen/2005.html} } \examples{ library(colorspace) ## The outcome of the election in terms of seats in the ## parliament was: seats <- structure(c(226, 61, 54, 51, 222), .Names = c("CDU/CSU", "FDP", "Linke", "Gruene", "SPD")) ## Hues are chosen as metaphors for the political parties ## CDU/CSU: blue, FDP: yellow, Linke: purple, Gruene: green, SPD: red ## using the respective hues from a color wheel with ## chroma = 60 and luminance = 75 parties <- rainbow_hcl(6, c = 60, l = 75)[c(5, 2, 6, 3, 1)] names(parties) <- names(seats) parties ## The pie chart shows that neither the SPD+Gruene coalition nor ## the opposition of CDU/CSU+FDP could assemble a majority. ## No party would enter a coalition with the leftists, leading to a ## big coalition. pie(seats, clockwise = TRUE, col = parties) ## The regional distribution of the votes, stratified by province, ## is shown in a mosaic display: first for the 10 Western then the ## 6 Eastern provinces. data("Bundestag2005") votes <- Bundestag2005[c(1, 3:5, 9, 11, 13:16, 2, 6:8, 10, 12), c("CDU/CSU", "FDP", "SPD", "Gruene", "Linke")] mosaic(votes, gp = gpar(fill = parties[colnames(votes)]), spacing = spacing_highlighting, labeling = labeling_left, labeling_args = list(rot_labels = c(0, 90, 0, 0), pos_labels = "center", just_labels = c("center","center","center","right"), varnames = FALSE), margins = unit(c(2.5, 1, 1, 12), "lines"), keep_aspect_ratio = FALSE) } \keyword{datasets} vcd/man/JointSports.Rd0000755000175000017500000000233412214055144014523 0ustar nileshnilesh\name{JointSports} \alias{JointSports} \docType{data} \title{Opinions About Joint Sports} \description{ Data from a Danish study in 1983 and 1985 about sports activities and the opinion about joint sports with the other gender among 16--19 year old high school students. } \usage{ data("JointSports") } \format{ A data frame with 40 observations and 5 variables. \describe{ \item{Freq}{frequency.} \item{opinion}{factor indicating opinion about sports joint with the other gender (very good, good, indifferent, bad, very bad).} \item{year}{factor indicating year of study (1983, 1985).} \item{grade}{factor indicating school grade (1st, 3rd).} \item{gender}{factor indicating gender (Boy, Girl).} } } \references{ E. B. Andersen (1991), \emph{The Statistical Analysis of Categorical Data}. 2nd edition. Springer-Verlag, Berlin. } \source{ E. B. Andersen (1991), The Statistical Analysis of Categorical Data, page 210. } \examples{ library(MASS) data("JointSports") tab <- xtabs(Freq ~ gender + opinion + grade + year, data = JointSports) doubledecker(opinion ~ gender + year + grade, data = tab) loglm(~ opinion* (gender + grade+ year) + gender*year*grade, data = tab) } \keyword{datasets} vcd/man/VisualAcuity.Rd0000655000175000017500000000231212472413512014645 0ustar nileshnilesh\name{VisualAcuity} \alias{VisualAcuity} \docType{data} \title{Visual Acuity in Left and Right Eyes} \description{ Data from Kendall & Stuart (1961) on unaided vision among 3,242 men and 7,477 women, all aged 30-39 and employed in the U.K. Royal Ordnance factories 1943-1946. } \usage{ data("VisualAcuity") } \format{ A data frame with 32 observations and 4 variables. \describe{ \item{Freq}{frequency of visual acuity measurements.} \item{right}{visual acuity on right eye.} \item{left}{visual acuity on left eye.} \item{gender}{factor indicating gender of patient.} } } \references{ M. G. Kendall & A. Stuart (1961), \emph{The Advanced Theory of Statistics}, Vol. 2. Griffin, London. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ M. Friendly (2000), Visualizing Categorical Data: \url{http://euclid.psych.yorku.ca/ftp/sas/vcd/catdata/vision.sas} } \examples{ data("VisualAcuity") structable(~ gender + left + right, data = VisualAcuity) sieve(Freq ~ left + right | gender, data = VisualAcuity, shade = TRUE) cotabplot(Freq ~ left + right | gender, data = VisualAcuity, panel = cotab_agreementplot) } \keyword{datasets} vcd/man/struc_sieve.Rd0000655000175000017500000000416514133262776014600 0ustar nileshnilesh\name{struc_sieve} \alias{struc_sieve} \title{Core-generating Function for Sieve Plots} \encoding{UTF-8} \description{ Core-generating function for \code{strucplot} returning a function producing sieve plots. } \usage{ struc_sieve(sievetype = c("observed","expected"), gp_tile = gpar(), scale = 1) } \arguments{ \item{sievetype}{logical indicating whether rectangles should be filled according to \code{observed} or \code{expected} frequencies.} \item{gp_tile}{object of class \code{"gpar"}, controlling the appearance of all \emph{static} elements of the cells (e.g., border and fill color).} \item{scale}{Scaling factor for the sieve.} } \details{ This function is usually called by \code{\link{strucplot}} (typically when called by \code{\link{sieve}}) and returns a function used by \code{\link{strucplot}} to produce sieve plots. } \value{ A function with arguments: \item{residuals}{table of residuals.} \item{observed}{table of observed values.} \item{expected}{not used by \code{struc_sieve}.} \item{spacing}{object of class \code{"unit"} specifying the space between the tiles.} \item{gp}{list of \code{gpar} objects used for the drawing the tiles.} \item{split_vertical}{vector of logicals indicating, for each dimension of the table, the split direction.} } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{sieve}}, \code{\link{strucplot}}, \code{\link{structable}} } \references{ Riedwyl, H., and Schüpbach, M. (1994), Parquet diagram to plot contingency tables. In F. Faulbaum (ed.), \emph{Softstat '93: Advances in Statistical Software}, 293--299. Gustav Fischer, New York. Friendly, M. (2000), Visualizing Categorical Data, SAS Institute, Cary, NC. Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. Available as \code{vignette("strucplot", package = "vcd")}. \doi{10.18637/jss.v017.i03}. } \examples{ ## Titanic data data("Titanic") strucplot(Titanic, core = struc_sieve) } \keyword{hplot} vcd/man/Hospital.Rd0000755000175000017500000000241611235655730014022 0ustar nileshnilesh\name{Hospital} \alias{Hospital} \docType{data} \title{Hospital data} \description{ The table relates the length of stay (in years) of 132 long-term schizophrenic patients in two London mental hospitals with the frequency of visits. } \usage{ data("Hospital") } \format{ A 2-dimensional array resulting from cross-tabulating 132 patients. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab Visit Frequency \tab Regular, Less than monthly, Never \cr 2 \tab Length of Stay \tab 2--9 years, 10--19 years, 20+ years } } \references{ J.K. Wing (1962): Institutionalism in mental hospitals. British Journal of Social Clinical Psychology, 1:38--51. } \source{ S.J Haberman (1974): Log-linear models for frequency tables with ordered classifications. Biometrics, 30:689--700. } \details{ Wing (1962) who collected this data concludes that the longer the length of stay in hospital, the less frequent the visits. Haberman (1974) notes that this pattern does not increase from the "Less than monthly" to the "Never" group, which are homogeneous. } \examples{ data("Hospital") mosaic(t(Hospital), shade = TRUE) mosaic(Hospital, shade = TRUE) sieve(Hospital, shade = TRUE) assoc(Hospital, shade = TRUE) } \keyword{datasets} vcd/man/Ord_plot.Rd0000644000175000017500000001122212445061132014000 0ustar nileshnilesh\name{Ord_plot} \alias{Ord_plot} \alias{Ord_estimate} \title{Ord Plots} \description{ Ord plots for diagnosing discrete distributions. } \usage{ Ord_plot(obj, legend = TRUE, estimate = TRUE, tol = 0.1, type = NULL, xlim = NULL, ylim = NULL, xlab = "Number of occurrences", ylab = "Frequency ratio", main = "Ord plot", gp = gpar(cex = 0.5), lwd = c(2,2), lty=c(2,1), col=c("black", "red"), name = "Ord_plot", newpage = TRUE, pop = TRUE, return_grob = FALSE, \dots) Ord_estimate(x, type = NULL, tol = 0.1) } \arguments{ \item{obj}{either a vector of counts, a 1-way table of frequencies of counts or a data frame or matrix with frequencies in the first column and the corresponding counts in the second column.} \item{legend}{logical. Should a legend be plotted?.} \item{estimate}{logical. Should the distribution and its parameters be estimated from the data? See details.} \item{tol}{tolerance for estimating the distribution. See details.} \item{type}{a character string indicating the distribution, must be one of \code{"poisson"}, \code{"binomial"}, \code{"nbinomial"} or \code{"log-series"} or \code{NULL}. In the latter case the distribution is estimated from the data. See details.} \item{xlim}{limits for the x axis.} \item{ylim}{limits for the y axis.} \item{xlab}{a label for the x axis.} \item{ylab}{a label for the y axis.} \item{main}{a title for the plot.} \item{gp}{a \code{"gpar"} object controlling the grid graphical parameters of the points.} \item{lwd, lty}{vectors of length 2, giving the line width and line type used for drawing the OLS line and the WLS lines.} \item{col}{vector of length 2 giving the colors used for drawing the OLS and WLS lines.} \item{name}{name of the plotting viewport.} \item{newpage}{logical. Should \code{\link{grid.newpage}} be called before plotting?} \item{pop}{logical. Should the viewport created be popped?} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{\dots}{further arguments passed to \code{\link{grid.points}}.} \item{x}{a vector giving intercept and slope for the (fitted) line in the Ord plot.} } \details{ The Ord plot plots the number of occurrences against a certain frequency ratio (see Friendly (2000) for details) and should give a straight line if the data comes from a poisson, binomial, negative binomial or log-series distribution. The intercept and slope of this straight line conveys information about the underlying distribution. \code{Ord_plot} fits a usual OLS line (black) and a weighted OLS line (red). From the coefficients of the latter the distribution is estimated by \code{Ord_estimate} as described in Table 2.10 in Friendly (2000). To judge whether a coefficient is positive or negative a tolerance given by \code{tol} is used. If none of the distributions fits well, no parameters are estimated. Be careful with the conclusions from \code{Ord_estimate} as it implements just some simple heuristics! } \value{ A vector giving the intercept and slope of the weighted OLS line. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \references{ J. K. Ord (1967), Graphical methods for a class of discrete distributions, \emph{Journal of the Royal Statistical Society}, \bold{A 130}, 232--238. Michael Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \examples{ ## Simulated data examples: dummy <- rnbinom(1000, size = 1.5, prob = 0.8) Ord_plot(dummy) ## Real data examples: data("HorseKicks") data("Federalist") data("Butterfly") data("WomenQueue") \dontrun{ grid.newpage() pushViewport(viewport(layout = grid.layout(2, 2))) pushViewport(viewport(layout.pos.col=1, layout.pos.row=1)) Ord_plot(HorseKicks, main = "Death by horse kicks", newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col=1, layout.pos.row=2)) Ord_plot(Federalist, main = "Instances of 'may' in Federalist papers", newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col=2, layout.pos.row=1)) Ord_plot(Butterfly, main = "Butterfly species collected in Malaya", newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col=2, layout.pos.row=2)) Ord_plot(WomenQueue, main = "Women in queues of length 10", newpage = FALSE) popViewport(2) } ## same mplot( Ord_plot(HorseKicks, return_grob = TRUE, main = "Death by horse kicks"), Ord_plot(Federalist, return_grob = TRUE, main = "Instances of 'may' in Federalist papers"), Ord_plot(Butterfly, return_grob = TRUE, main = "Butterfly species collected in Malaya"), Ord_plot(WomenQueue, return_grob = TRUE, main = "Women in queues of length 10") ) } \keyword{category} vcd/man/Suicide.Rd0000755000175000017500000000211711150520606013607 0ustar nileshnilesh\name{Suicide} \alias{Suicide} \docType{data} \title{Suicide Rates in Germany} \description{ Data from Heuer (1979) on suicide rates in West Germany classified by age, sex, and method of suicide. } \usage{ data("Suicide") } \format{ A data frame with 306 observations and 6 variables. \describe{ \item{Freq}{frequency of suicides.} \item{sex}{factor indicating sex (male, female).} \item{method}{factor indicating method used.} \item{age}{age (rounded).} \item{age.group}{factor. Age classified into 5 groups.} \item{method2}{factor indicating method used (same as \code{method} but some levels are merged).} } } \references{ J. Heuer (1979), \emph{Selbstmord bei Kindern und Jugendlichen}. Ernst Klett Verlag, Stuttgart. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data: \url{http://euclid.psych.yorku.ca/ftp/sas/vcd/catdata/suicide.sas} } \examples{ data("Suicide") structable(~ sex + method2 + age.group, data = Suicide) } \keyword{datasets} vcd/man/panel_pairs_off-diagonal.Rd0000655000175000017500000000464512532005530017133 0ustar nileshnilesh\name{Pairs plot panel functions for off-diagonal cells} \alias{pairs_strucplot} \alias{pairs_mosaic} \alias{pairs_assoc} \alias{pairs_sieve} \title{Off-diagonal Panel Functions for Table Pairs Plot} \description{ Off-diagonal panel functions for \code{\link{pairs.table}}. } \usage{ pairs_strucplot(panel = mosaic, type = c("pairwise", "total", "conditional", "joint"), legend = FALSE, margins = c(0, 0, 0, 0), labeling = NULL, \dots) pairs_assoc(\dots) pairs_mosaic(\dots) pairs_sieve(\dots) } \arguments{ \item{panel}{function to be used for the plots in each cell, such as \code{\link{pairs_assoc}}, \code{\link{pairs_mosaic}}, and \code{\link{pairs_sieve}}.} \item{type}{character string specifying the type of independence model visualized in the cells.} \item{legend}{logical specifying whether a legend should be displayed in the cells or not.} \item{margins}{margins inside each cell (see \code{\link{strucplot}}).} \item{labeling}{labeling function or labeling-generating function (see \code{\link{strucplot}}).} \item{\dots}{\code{pairs_mosaic}, \code{\link{pairs_assoc}}, and \code{pairs_sieve}: parameters passed to \code{pairs_strucplot}. \code{pairs_strucplot}: other parameters passed to panel function.} } \details{ These functions really just wrap \code{\link{assoc}}, \code{\link{sieve}}, and \code{\link{mosaic}} by basically inhibiting labeling and legend-drawing and setting the margins to 0. } \value{ A function with arguments: \item{x}{contingency table.} \item{i, j}{cell coordinates.} } \seealso{ \code{\link{pairs.table}}, \code{\link{pairs_text}}, \code{\link{pairs_barplot}}, \code{\link{assoc}}, \code{\link{mosaic}} } \references{ Cohen, A. (1980), On the graphical display of the significant components in a two-way contingency table. \emph{Communications in Statistics---Theory and Methods}, \bold{A9}, 1025--1041. Friendly, M. (1992), Graphical methods for categorical data. \emph{SAS User Group International Conference Proceedings}, \bold{17}, 190--200. \url{http://datavis.ca/papers/sugi/sugi17.pdf} } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("UCBAdmissions") data("PreSex") pairs(PreSex) pairs(UCBAdmissions) pairs(UCBAdmissions, upper_panel_args = list(shade = FALSE)) pairs(UCBAdmissions, lower_panel = pairs_mosaic(type = "conditional")) pairs(UCBAdmissions, upper_panel = pairs_assoc) } \keyword{hplot} vcd/man/Federalist.Rd0000755000175000017500000000204311150520606014302 0ustar nileshnilesh\name{Federalist} \alias{Federalist} \docType{data} \title{`May' in Federalist Papers} \description{ Data from Mosteller & Wallace (1984) investigating the use of certain keywords (\sQuote{may} in this data set) to identify the author of 12 disputed \sQuote{Federalist Papers} by Alexander Hamilton, John Jay and James Madison. } \usage{ data("Federalist") } \format{ A 1-way table giving the number of occurrences of \sQuote{may} in 262 blocks of text. The variable and its levels are \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab nMay \tab 0, 1, \dots, 6 \cr } } \references{ F. Mosteller & D. L. Wallace (1984), \emph{Applied Bayesian and Classical Inference: The Case of the Federalist Papers}. Springer-Verlag, New York, NY. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data, page 19. } \examples{ data("Federalist") gf <- goodfit(Federalist, type = "nbinomial") summary(gf) plot(gf) } \keyword{datasets} vcd/man/agreementplot.Rd0000655000175000017500000001145113607022764015103 0ustar nileshnilesh\name{agreementplot} \alias{agreementplot} \alias{agreementplot.default} \alias{agreementplot.formula} \title{Bangdiwala's Observer Agreement Chart} \description{ Representation of a \eqn{k \times k}{k by k} confusion matrix, where the observed and expected diagonal elements are represented by superposed black and white rectangles, respectively. The function also computes a statistic measuring the strength of agreement (relation of respective area sums). } \usage{ \method{agreementplot}{default}(x, reverse_y = TRUE, main = NULL, weights = c(1, 1 - 1/(ncol(x) - 1)^2), margins = par("mar"), newpage = TRUE, pop = TRUE, xlab = names(dimnames(x))[2], ylab = names(dimnames(x))[1], xlab_rot = 0, xlab_just = "center", ylab_rot = 90, ylab_just = "center", fill_col = function(j) gray((1 - (weights[j]) ^ 2) ^ 0.5), line_col = "red", xscale = TRUE, yscale = TRUE, return_grob = FALSE, prefix = "", \dots) \method{agreementplot}{formula}(formula, data = NULL, ..., subset) } \arguments{ \item{x}{a confusion matrix, i.e., a table with equal-sized dimensions.} \item{reverse_y}{if \code{TRUE}, the y axis is reversed (i.e., the rectangles' positions correspond to the contingency table).} \item{main}{user-specified main title.} \item{weights}{vector of weights for successive larger observed areas, used in the agreement strength statistic, and also for the shading. The first element should be 1.} \item{margins}{vector of margins (see \code{\link[graphics]{par}}).} \item{newpage}{logical; if \code{TRUE}, the plot is drawn on a new page.} \item{pop}{logical; if \code{TRUE}, all newly generated viewports are popped after plotting.} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{xlab, ylab}{labels of x- and y-axis.} \item{xlab_rot, ylab_rot}{rotation angle for the category labels.} \item{xlab_just, ylab_just}{justification for the category labels.} \item{fill_col}{a function, giving the fill colors used for exact and partial agreement} \item{line_col}{color used for the diagonal reference line} \item{formula}{a formula, such as \code{y ~ x}. For details, see \code{\link{xtabs}}.} \item{data}{a data frame (or list), or a contingency table from which the variables in \code{formula} should be taken.} \item{subset}{an optional vector specifying a subset of the rows in the data frame to be used for plotting.} \item{xscale, yscale}{logicals indicating whether the marginals should be added on the x-axis/y-axis, respectively.} \item{prefix}{character string used as prefix for the viewport name} \item{\dots}{further graphics parameters (see \code{\link{par}}).} } \details{ Weights can be specified to allow for partial agreement, taking into account contributions from off-diagonal cells. Partial agreement is typically represented in the display by lighter shading, as given by \code{fill_col(j)}, corresponding to \code{weights[j]}. A weight vector of length 1 means strict agreement only, each additional element increases the maximum number of disagreement steps. \code{\link{cotabplot}} can be used for stratified analyses (see examples). } \value{ Invisibly returned, a list with components \item{Bangdiwala}{the unweighted agreement strength statistic.} \item{Bangdiwala_Weighted}{the weighted statistic.} \item{weights}{the weight vector used.} } \references{ Bangdiwala, S. I. (1988). The Agreement Chart. Department of Biostatistics, University of North Carolina at Chapel Hill, Institute of Statistics Mimeo Series No. 1859, \url{https://repository.lib.ncsu.edu/bitstream/handle/1840.4/3827/ISMS_1988_1859.pdf} Bangdiwala, S. I., Ana S. Haedo, Marcela L. Natal, and Andres Villaveces. The agreement chart as an alternative to the receiver-operating characteristic curve for diagnostic tests. \emph{Journal of Clinical Epidemiology}, 61 (9), 866-874. Michael Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("SexualFun") agreementplot(t(SexualFun)) data("MSPatients") \dontrun{ ## best visualized using a resized device, e.g. using: ## get(getOption("device"))(width = 12) pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) agreementplot(t(MSPatients[,,1]), main = "Winnipeg Patients", newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 2)) agreementplot(t(MSPatients[,,2]), main = "New Orleans Patients", newpage = FALSE) popViewport(2) dev.off() } ## alternatively, use cotabplot: cotabplot(MSPatients, panel = cotab_agreementplot) } \keyword{category} \keyword{hplot} vcd/man/pairs.table.Rd0000644000175000017500000001457114133262555014444 0ustar nileshnilesh\name{pairs.table} \alias{pairs.table} \alias{pairs.structable} \title{Pairs Plot for Contingency Tables} \description{ Produces a matrix of strucplot displays. } \usage{ \method{pairs}{table}(x, upper_panel = pairs_mosaic, upper_panel_args = list(), lower_panel = pairs_mosaic, lower_panel_args = list(), diag_panel = pairs_diagonal_mosaic, diag_panel_args = list(), main = NULL, sub = NULL, main_gp = gpar(fontsize = 20), sub_gp = gpar(fontsize = 15), space = 0.3, newpage = TRUE, pop = TRUE, return_grob = FALSE, margins = unit(1, "lines"), \dots) } \arguments{ \item{x}{a contingency table in array form, with optional category labels specified in the \code{dimnames(x)} attribute.} \item{upper_panel}{function for the upper triangle of the matrix, or corresponding generating function. If \code{NULL}, no panel is drawn.} \item{upper_panel_args}{list of arguments for the generating function, if specified.} \item{lower_panel}{function for the lower triangle of the matrix, or corresponding generating function. If \code{NULL}, no panel is drawn.} \item{lower_panel_args}{list of arguments for the panel-generating function, if specified.} \item{diag_panel}{function for the diagonal of the matrix, or corresponding generating function. If \code{NULL}, no panel is drawn.} \item{diag_panel_args}{list of arguments for the generating function, if specified.} \item{main}{either a logical, or a character string used for plotting the main title. If \code{main} is a logical and \code{TRUE}, the name of the object supplied as \code{x} is used.} \item{sub}{a character string used for plotting the subtitle. If \code{sub} is a logical and \code{TRUE} and \code{main} is unspecified, the name of the object supplied as \code{x} is used.} \item{main_gp, sub_gp}{object of class \code{"gpar"} containing the graphical parameters used for the main (sub) title, if specified.} \item{space}{double specifying the distance between the cells.} \item{newpage}{logical controlling whether a new grid page should be created.} \item{pop}{logical indicating whether all viewports should be popped after the plot has been drawn.} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{margins}{either an object of class \code{"unit"} of length 4, or a numeric vector of length 4. The elements are recycled as needed. The four components specify the top, right, bottom, and left margin of the plot, respectively. When a numeric vector is supplied, the numbers are interpreted as \code{"lines"} units. In addition, the unit or numeric vector may have named arguments (\samp{top}, \samp{right}, \samp{bottom}, and \samp{left}), in which case the non-named arguments specify the default values (recycled as needed), overloaded by the named arguments.} \item{\dots}{For convenience, list of arguments for the panel-generating functions of upper and lower panels, if specified.} } \details{ This is a \code{\link[graphics]{pairs}} method for objects inheriting from class \code{"table"} or \code{"structable"}. It plots a matrix of pairwise mosaic plots. Four independence types are distinguished: \code{"pairwise"}, \code{"total"}, \code{"conditional"} and \code{"joint"}. The pairwise mosaic matrix shows bivariate marginal relations, collapsed over all other variables. The total independence mosaic matrix shows mosaic plots for mutual independence, i.e., for marginal and conditional independence among all pairs of variables. The conditional independence mosaic matrix shows mosaic plots for conditional independence for each pair of variables, given all other variables. The joint independence mosaic matrix shows mosaic plots for joint independence of all pairs of variables from the others. This method uses panel functions called for each cell of the matrix which can be different for upper matrix, lower matrix, and diagonal cells. Correspondingly, for each panel parameter \var{foo} (= \samp{upper}, \samp{lower}, or \samp{diag}), \code{pairs.table} takes two arguments: \var{foo\_panel} and \var{foo\_panel\_args}, which can be used to specify the parameters as follows: \enumerate{ \item Passing a suitable panel function to \var{foo\_panel} which subsequently is called for each cell with the corresponding coordinates. \item Passing a corresponding \emph{generating function} (of class \code{"panel_generator"}) to \var{foo\_panel}, along with parameters passed to \var{foo\_panel\_args}, that generates such a function. } Hence, the second approach is equivalent to the first if \var{foo\_panel(foo\_panel\_args)} is passed to \var{foo\_panel}. } \seealso{ \code{\link{pairs_mosaic}}, \code{\link{pairs_assoc}}, \code{\link{pairs_sieve}}, \code{\link{pairs_diagonal_text}}, \code{\link{pairs_diagonal_mosaic}}, \code{\link{pairs_text}}, \code{\link{pairs_barplot}}, \code{\link{assoc}}, \code{\link{sieve}}, \code{\link{mosaic}} } \references{ Cohen, A. (1980), On the graphical display of the significant components in a two-way contingency table. \emph{Communications in Statistics---Theory and Methods}, \bold{A9}, 1025--1041. Friendly, M. (1992), Graphical methods for categorical data. \emph{SAS User Group International Conference Proceedings}, \bold{17}, 190--200. \url{http://datavis.ca/papers/sugi/sugi17.pdf} Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. Available as \code{vignette("strucplot", package = "vcd")}. \doi{10.18637/jss.v017.i03}. } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("UCBAdmissions") data("PreSex") data(HairEyeColor) hec = structable(Eye ~ Sex + Hair, data = HairEyeColor) pairs(PreSex) pairs(UCBAdmissions) pairs(UCBAdmissions, upper_panel_args = list(shade = TRUE)) pairs(UCBAdmissions, lower_panel = pairs_mosaic(type = "conditional")) pairs(UCBAdmissions, diag_panel = pairs_text) pairs(UCBAdmissions, upper_panel = pairs_assoc, shade = TRUE) pairs(hec, highlighting = 2, diag_panel_args = list(fill = grey.colors)) pairs(hec, highlighting = 2, diag_panel = pairs_diagonal_mosaic, diag_panel_args = list(fill = grey.colors, alternate_labels =TRUE)) } \keyword{hplot} vcd/man/mar_table.Rd0000755000175000017500000000057511150520606014156 0ustar nileshnilesh\name{mar_table} \alias{mar_table} \title{Table with Marginal Sums} \description{ Adds row and column sums to a two-way table. } \usage{ mar_table(x) } \arguments{ \item{x}{a two-way table.} } \value{ A table with row and column totals added. } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("SexualFun") mar_table(SexualFun) } \keyword{category} vcd/man/RepVict.Rd0000755000175000017500000000264411150520606013603 0ustar nileshnilesh\name{RepVict} \alias{RepVict} \docType{data} \title{Repeat Victimization Data} \description{ Data from Reiss (1980) given by Fienberg (1980) about instances of repeat victimization for households in the U.S. National Crime Survey. } \usage{ data("RepVict") } \format{ A 2-dimensional array resulting from cross-tabulating victimization. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab First Victimization \tab Rape, Assault, Robbery, Pickpocket, Personal Larceny, \cr \tab \tab Burglary, Household Larceny, Auto Theft \cr 2 \tab Second Victimization \tab Rape, Assault, Robbery, Pickpocket, Personal Larceny,\cr \tab \tab Burglary, Household Larceny, Auto Theft } } \references{ S. E. Fienberg (1980), \emph{The Analysis of Cross-Classified Categorical Data}, MIT Press, Cambridge, 2nd edition. A. J. J. Reiss (1980), Victim proneness by type of crime in repeat victimization. In S. E. Fienberg & A. J. J. Reiss (eds.), \emph{Indicators of Crime and Criminal Justice}. U.S. Government Printing Office, Washington, DC. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data, page 113. } \examples{ data("RepVict") mosaic(RepVict[-c(4,7),-c(4,7)], gp = shading_max, main = "Repeat Victimization Data") } \keyword{datasets} vcd/man/cd_plot.Rd0000655000175000017500000000760312445056524013665 0ustar nileshnilesh\name{cd_plot} \alias{cd_plot} \alias{cd_plot.default} \alias{cd_plot.formula} \title{Conditional Density Plots} \description{ Computes and plots conditional densities describing how the distribution of a categorical variable \code{y} changes over a numerical variable \code{x}. } \usage{ cd_plot(x, \dots) \method{cd_plot}{default}(x, y, plot = TRUE, ylab_tol = 0.05, bw = "nrd0", n = 512, from = NULL, to = NULL, main = "", xlab = NULL, ylab = NULL, margins = c(5.1, 4.1, 4.1, 3.1), gp = gpar(), name = "cd_plot", newpage = TRUE, pop = TRUE, return_grob = FALSE, \dots) \method{cd_plot}{formula}(formula, data = list(), plot = TRUE, ylab_tol = 0.05, bw = "nrd0", n = 512, from = NULL, to = NULL, main = "", xlab = NULL, ylab = NULL, margins = c(5.1, 4.1, 4.1, 3.1), gp = gpar(), name = "cd_plot", newpage = TRUE, pop = TRUE, return_grob = FALSE, \dots) } \arguments{ \item{x}{an object, the default method expects either a single numerical variable.} \item{y}{a \code{"factor"} interpreted to be the dependent variable} \item{formula}{a \code{"formula"} of type \code{y ~ x} with a single dependent \code{"factor"} and a single numerical explanatory variable.} \item{data}{an optional data frame.} \item{plot}{logical. Should the computed conditional densities be plotted?} \item{ylab_tol}{convenience tolerance parameter for y-axis annotation. If the distance between two labels drops under this threshold, they are plotted equidistantly.} \item{bw, n, from, to, \dots}{arguments passed to \code{\link{density}}} \item{main, xlab, ylab}{character strings for annotation} \item{margins}{margins when calling \code{\link{plotViewport}}} \item{gp}{a \code{"gpar"} object controlling the grid graphical parameters of the rectangles. It should specify in particular a vector of \code{fill} colors of the same length as \code{levels(y)}. The default is to call \code{\link{gray.colors}}.} \item{name}{name of the plotting viewport.} \item{newpage}{logical. Should \code{\link{grid.newpage}} be called before plotting?} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{pop}{logical. Should the viewport created be popped?} } \details{ \code{cd_plot} computes the conditional densities of \code{x} given the levels of \code{y} weighted by the marginal distribution of \code{y}. The densities are derived cumulatively over the levels of \code{y}. This visualization technique is similar to spinograms (see \code{\link{spine}}) but they do not discretize the explanatory variable, but rather use a smoothing approach. Furthermore, the original x axis and not a distorted x axis (as for spinograms) is used. This typically results in conditional densities that are based on very few observations in the margins: hence, the estimates are less reliable there. } \value{ The conditional density functions (cumulative over the levels of \code{y}) are returned invisibly. } \seealso{ \code{\link{spine}}, \code{\link{density}} } \references{ Hofmann, H., Theus, M. (2005), \emph{Interactive graphics for visualizing conditional distributions}, Unpublished Manuscript. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \examples{ ## Arthritis data data("Arthritis") cd_plot(Improved ~ Age, data = Arthritis) cd_plot(Improved ~ Age, data = Arthritis, bw = 3) cd_plot(Improved ~ Age, data = Arthritis, bw = "SJ") ## compare with spinogram spine(Improved ~ Age, data = Arthritis, breaks = 3) ## Space shuttle data data("SpaceShuttle") cd_plot(Fail ~ Temperature, data = SpaceShuttle, bw = 2) ## scatter plot with conditional density cdens <- cd_plot(Fail ~ Temperature, data = SpaceShuttle, bw = 2, plot = FALSE) plot(I(-1 * (as.numeric(Fail) - 2)) ~ jitter(Temperature, factor = 2), data = SpaceShuttle, xlab = "Temperature", ylab = "Failure") lines(53:81, cdens[[1]](53:81), col = 2) } \keyword{hplot} vcd/man/cotabplot.Rd0000644000175000017500000001244214133262364014220 0ustar nileshnilesh\name{cotabplot} \alias{cotabplot} \alias{cotabplot.default} \alias{cotabplot.formula} \title{Coplot for Contingency Tables} \description{ \code{cotabplot} is a generic function for creating trellis-like coplots (conditional plots) for contingency tables. } \usage{ cotabplot(x, \dots) \method{cotabplot}{default}(x, cond = NULL, panel = cotab_mosaic, panel_args = list(), margins = rep(1, 4), layout = NULL, text_gp = gpar(fontsize = 12), rect_gp = gpar(fill = grey(0.9)), pop = TRUE, newpage = TRUE, return_grob = FALSE, \dots) \method{cotabplot}{formula}(formula, data = NULL, \dots) } \arguments{ \item{x}{an object. The default method can deal with contingency tables in array form.} \item{cond}{margin index(es) or corresponding name(s) of the conditioning variables.} \item{panel}{panel function applied for each conditioned plot, see details.} \item{panel_args}{list of arguments passed to \code{panel} if this is a panel-generating function inheriting from class \code{"grapcon_generator"}.} \item{margins}{either an object of class \code{"unit"} of length 4, or a numeric vector of length 4. The elements are recycled as needed. giving the margins around the whole plot.} \item{layout}{integer vector (of length two), giving the number of rows and columns for the panel.} \item{text_gp}{object of class \code{"gpar"} used for the text in the panel titles.} \item{rect_gp}{object of class \code{"gpar"} used for the rectangles with the panel titles.} \item{pop}{logical indicating whether the generated viewport tree should be removed at the end of the drawing or not.} \item{newpage}{logical controlling whether a new grid page should be created.} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{\dots}{further arguments passed to the panel-generating function.} \item{formula}{a formula specifying the variables used to create a contingency table from \code{data}. It has to be of type \code{~ x + y | z} where \code{z} is/are the conditioning variable(s) used.} \item{data}{either a data frame, or an object of class \code{"table"} or \code{"ftable"}.} } \details{ \code{cotabplot} is a generic function designed to create coplots or conditional plots (see Cleveland, 1993, and Becker, Cleveland, Shyu, 1996) similar to \code{\link{coplot}} but for contingency tables. \code{cotabplot} takes on computing the conditioning information and setting up the trellis display, and then relies on a panel function to create plots from the full table and the conditioning information. A simple example would be a contingency table \code{tab} with margin names \code{"x"}, \code{"y"} and \code{"z"}. To produce this plot either the default interface can be used or the formula interface via \code{cotabplot(tab, "z")} \code{cotabplot(~ x + y | z, data = tab)} The panel function needs to be of the form \code{panel(x, condlevels)} where \code{x} is the \emph{full} table (\code{tab} in the example above) and \code{condlevels} is a named vector with the levels (e.g., \code{c(z = "z1")} in the example above). Alternatively, \code{panel} can also be a panel-generating function of class \code{"grapcon_generator"} which creates a function with the interface described above. The panel-generating function is called with the interface \code{panel(x, condvars, \dots)} where again \code{x} is the full table, \code{condvars} is now only a vector with the names of the conditioning variables (and not their levels, e.g., \code{"z"} in the example above). Further arguments can be passed to the panel-generating function via \code{\dots} which also includes the arguments set in \code{panel_args}. Suitable panel-generating functions for mosaic, association and sieve plots can be found at \code{\link{cotab_mosaic}}. A description of the underlying ideas is given in Zeileis, Meyer, Hornik (2005). } \seealso{ \code{\link{cotab_mosaic}}, \code{\link{cotab_coindep}}, \code{\link{co_table}}, \code{\link{coindep_test}} } \references{ Becker, R.A., Cleveland, W.S., Shyu, M.-J. (1996), The visual design and control of trellis display. \emph{Journal of Computational and Graphical Statistics}, \bold{5}, 123--155. Cleveland, W.S. (1993), \emph{Visualizing Data}, Summit, New Jersey: Hobart Press. Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. Available as \code{vignette("strucplot", package = "vcd")}. \doi{10.18637/jss.v017.i03}. Zeileis, A., Meyer, D., Hornik K. (2007), \emph{Residual-based shadings for visualizing (conditional) independence}, \emph{Journal of Computational and Graphical Statistics}, \bold{16}, 507--525. } \author{ Achim Zeileis \email{Achim.Zeileis@R-project.org} } \examples{ data("UCBAdmissions") cotabplot(~ Admit + Gender | Dept, data = UCBAdmissions) cotabplot(~ Admit + Gender | Dept, data = UCBAdmissions, panel = cotab_assoc) ucb <- cotab_coindep(UCBAdmissions, condvars = "Dept", type = "assoc", n = 5000, margins = c(3, 1, 1, 3)) cotabplot(~ Admit + Gender | Dept, data = UCBAdmissions, panel = ucb) } \keyword{hplot} vcd/man/Butterfly.Rd0000755000175000017500000000163511150520606014206 0ustar nileshnilesh\name{Butterfly} \alias{Butterfly} \docType{data} \title{Butterfly Species in Malaya} \description{ Data from Fisher et al. (1943) giving the number of tokens found for each of 501 species of butterflies collected in Malaya. } \usage{ data("Butterfly") } \format{ A 1-way table giving the number of tokens for 501 species of butterflies. The variable and its levels are \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab nTokens \tab 0, 1, \dots, 24 \cr } } \references{ R. A. Fisher, A. S. Corbet, C. B. Williams (1943), The relation between the number of species and the number of individuals, \emph{Journal of Animal Ecology}, \bold{12}, 42--58. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{ Michael Friendly (2000), Visualizing Categorical Data, pages 21--22. } \examples{ data("Butterfly") Ord_plot(Butterfly) } \keyword{datasets} vcd/man/MSPatients.Rd0000655000175000017500000000351412472413270014260 0ustar nileshnilesh\name{MSPatients} \alias{MSPatients} \docType{data} \title{Diagnosis of Multiple Sclerosis} \description{ Data from Westlund \& Kurland (1953) on the diagnosis of multiple sclerosis (MS): two samples of patients, one from Winnipeg and one from New Orleans, were each rated by two neurologists (one from each city) in four diagnostic categories. } \usage{ data("MSPatients") } \format{ A 3-dimensional array resulting from cross-tabulating 218 observations on 3 variables. The variables and their levels are as follows: \tabular{rll}{ No \tab Name \tab Levels \cr 1 \tab New Orleans Neurologist \tab Certain, Probable, Possible, Doubtful \cr 2 \tab Winnipeg Neurologist \tab Certain, Probable, Possible, Doubtful \cr 3 \tab Patients \tab Winnipeg, New Orleans } } \references{ K. B. Westlund \& L. T. Kurland (1953), Studies on multiple sclerosis in Winnipeg, Manitoba and New Orleans, Louisiana, \emph{American Journal of Hygiene}, \bold{57}, 380--396. M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \source{M. Friendly (2000), Visualizing Categorical Data: \url{http://euclid.psych.yorku.ca/ftp/sas/vcd/catdata/msdiag.sas} } \examples{ data("MSPatients") \dontrun{ ## best visualized using a resized device, e.g. using: ## get(getOption("device"))(width = 12) pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) popViewport() pushViewport(viewport(layout.pos.col = 2)) popViewport(2) dev.off() } ## alternative, more convenient way mplot( agreementplot(t(MSPatients[,,1]), return_grob = TRUE, main = "Winnipeg Patients"), agreementplot(t(MSPatients[,,2]), return_grob = TRUE, main = "New Orleans Patients") ) ## alternatively, use cotabplot: cotabplot(MSPatients, panel = cotab_agreementplot) } \keyword{datasets} vcd/man/panel_pairs_diagonal.Rd0000755000175000017500000001313314133212714016357 0ustar nileshnilesh\name{Pairs plot panel functions for diagonal cells} \alias{pairs_barplot} \alias{pairs_text} \alias{pairs_diagonal_text} \alias{pairs_diagonal_mosaic} \title{Diagonal Panel Functions for Table Pairs Plot} \description{ Diagonal panel functions for \code{\link{pairs.table}}. } \usage{ pairs_barplot(gp_bars = NULL, gp_vartext = gpar(fontsize = 17), gp_leveltext = gpar(), gp_axis = gpar(), just_leveltext = c("center", "bottom"), just_vartext = c("center", "top"), rot = 0, abbreviate = FALSE, check_overlap = TRUE, fill = "grey", var_offset = unit(1, "npc"), \dots) pairs_text(dimnames = TRUE, gp_vartext = gpar(fontsize = 17), gp_leveltext = gpar(), gp_border = gpar(), \dots) pairs_diagonal_text(varnames = TRUE, gp_vartext = gpar(fontsize = 17, fontface = "bold"), gp_leveltext = gpar(), gp_border = gpar(), pos = c("right","top"), distribute = c("equal","margin"), rot = 0, \dots) pairs_diagonal_mosaic(split_vertical = TRUE, margins = unit(0, "lines"), offset_labels = -0.4, offset_varnames = 0, gp = NULL, fill = "grey", labeling = labeling_values, alternate_labels = TRUE, ...) } \arguments{ \item{dimnames}{vector of logicals indicating whether the factor levels should be displayed (only used for \code{pairs_text}).} \item{varnames}{vector of logicals indicating whether the variable names should be displayed (only used for \code{pairs_text_diagonal}).} \item{gp_bars}{object of class \code{"gpar"} used for bars (only used for \code{pairs_barplot}). If unspecified, the default is to set the \code{fill} component of this object to the \code{fill} argument.} \item{gp_vartext}{object of class \code{"gpar"} used for the factor names.} \item{gp_leveltext}{object of class \code{"gpar"} used for the factor levels.} \item{gp_axis}{object of class \code{"gpar"} used for the y axis.} \item{gp_border}{object of class \code{"gpar"} used for the border (only used for \code{pairs_text}).} \item{gp}{object of class \code{"gpar"} used for the tiles (only used for \code{pairs_diagonal_mosaic}). If unspecified, the default is to set the \code{fill} component of this object to the \code{fill} argument.} \item{fill}{color vector or palette function used for the fill colors of bars (for \code{pairs_barplot}) or tiles (for \code{pairs_diagonal_mosaic}).} \item{labeling}{labeling function, passed to \code{mosaic()}} \item{alternate_labels}{should labels alternate top/bottom?} \item{just_leveltext, just_vartext}{character string indicating the justification for variable names and levels.} \item{pos}{character string of length 2 controlling the horizontal and vertical position of the variable names (only used for \code{pairs_text_diagonal}).} \item{rot}{rotation angle for the variable levels.} \item{distribute}{character string indicating whether levels should be distributed equally or according to the margins (only used for \code{pairs_text_diagonal}).} \item{abbreviate}{integer or logical indicating the number of characters the labels should be abbreviated to. \code{TRUE} means 1 character, \code{FALSE} causes no abbreviation.} \item{check_overlap}{If \code{TRUE}, some levels will suppressed to avoid overlapping, if any.} \item{split_vertical}{vector of logicals of length \eqn{k}, where \eqn{k} is the number of margins of \code{x} (values are recycled as needed). A \code{TRUE} component indicates that the tile(s) of the corresponding dimension should be split vertically, \code{FALSE} means horizontal splits. Default is \code{FALSE.}} \item{margins}{either an object of class \code{"unit"} of length 4, or a numeric vector of length 4. The elements are recycled as needed. The four components specify the top, right, bottom, and left margin of the plot, respectively. When a numeric vector is supplied, the numbers are interpreted as \code{"lines"} units. In addition, the unit or numeric vector may have named arguments (\samp{top}, \samp{right}, \samp{bottom}, and \samp{left}), in which case the non-named arguments specify the default values (recycled as needed), overloaded by the named arguments.} \item{offset_labels, offset_varnames}{numeric vector of length 4 indicating the offset of the labels (variable names) for each of the four sides of the plot.} \item{var_offset}{object of class \code{"unit"} specifying the offset of variable names from the bottom of the bar plots created by \code{pairs_barplot}. If numeric, the unit defaults to "npc".} \item{\dots}{other parameters passed to the underlying graphics functions.} } \details{ In the diagonal cells, the pairsplot visualizes statistics or information for each dimension (that is: the single factors) alone. \code{\link{pairs_text}} displays the factor's name, and optionally also the factor levels. \code{\link{pairs_barplot}} produces a bar plot of the corresponding factor, along with the factor's name. } \value{ A function with one argument: the marginal table for the corresponding dimension. } \seealso{ \code{\link{pairs.table}}, \code{\link{pairs_assoc}}, \code{\link{pairs_mosaic}} } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("UCBAdmissions") pairs(UCBAdmissions) # pairs_barplot is default pairs(UCBAdmissions, diag_panel = pairs_text) pairs(UCBAdmissions, diag_panel = pairs_diagonal_text) pairs(Titanic, diag_panel = pairs_diagonal_text) pairs(Titanic, diag_panel = pairs_diagonal_text(distribute = "margin")) pairs(Titanic, diag_panel = pairs_diagonal_text(distribute = "margin", rot = 45)) } \keyword{hplot} vcd/man/ternaryplot.Rd0000655000175000017500000001067613210517334014620 0ustar nileshnilesh\name{ternaryplot} \alias{ternaryplot} \title{Ternary Diagram} \description{ Visualizes compositional, 3-dimensional data in an equilateral triangle. } \usage{ ternaryplot(x, scale = 1, dimnames = NULL, dimnames_position = c("corner","edge","none"), dimnames_color = "black", dimnames_rot = c(-60, 60, 0), id = NULL, id_color = "black", id_just = c("center", "center"), coordinates = FALSE, grid = TRUE, grid_color = "gray", labels = c("inside", "outside", "none"), labels_color = "darkgray", labels_rot = c(120, -120, 0), border = "black", bg = "white", pch = 19, cex = 1, prop_size = FALSE, col = "red", main = "ternary plot", newpage = TRUE, pop = TRUE, return_grob = FALSE, \dots) } \arguments{ \item{x}{a matrix with three columns.} \item{scale}{row sums scale to be used.} \item{dimnames}{dimension labels (defaults to the column names of \code{x}).} \item{dimnames_position, dimnames_color}{position and color of dimension labels.} \item{dimnames_rot}{Numeric vector of length 3, specifying the angle of the dimension labels.} \item{id}{optional labels to be plotted below the plot symbols. \code{coordinates} and \code{id} are mutual exclusive.} \item{id_color}{color of these labels.} \item{id_just}{character vector of length 1 or 2 indicating the justification of these labels.} \item{coordinates}{if \code{TRUE}, the coordinates of the points are plotted below them. \code{coordinates} and \code{id} are mutual exclusive.} \item{grid}{if \code{TRUE}, a grid is plotted. May optionally be a string indicating the line type (default: \code{"dotted"}).} \item{grid_color}{grid color.} \item{labels, labels_color}{position and color of the grid labels.} \item{labels_rot}{Numeric vector of length 3, specifying the angle of the grid labels.} \item{border}{color of the triangle border.} \item{bg}{triangle background.} \item{pch}{plotting character. Defaults to filled dots.} \item{cex}{a numerical value giving the amount by which plotting text and symbols should be scaled relative to the default. Ignored for the symbol size if \code{prop_size} is not \code{FALSE}.} \item{prop_size}{if \code{TRUE}, the symbol size is plotted proportional to the row sum of the three variables, i.e., represents the weight of the observation.} \item{col}{plotting color.} \item{main}{main title.} \item{newpage}{if \code{TRUE}, the plot will appear on a new graphics page.} \item{pop}{logical; if \code{TRUE}, all newly generated viewports are popped after plotting.} \item{return_grob}{logical. Should a snapshot of the display be returned as a grid grob?} \item{\dots}{additional graphics parameters (see \code{par})} } \details{ A points' coordinates are found by computing the gravity center of mass points using the data entries as weights. Thus, the coordinates of a point \eqn{P(a,b,c)}, \eqn{a + b + c = 1}, are: \eqn{P(b + c/2, c \sqrt{3}/2)}{P(b + c/2, c * sqrt(3)/2)}. } \references{ M. Friendly (2000), \emph{Visualizing Categorical Data}. SAS Institute, Cary, NC. } \author{ David Meyer \email{David.Meyer@R-project.org} } \examples{ data("Arthritis") ## Build table by crossing Treatment and Sex tab <- as.table(xtabs(~ I(Sex:Treatment) + Improved, data = Arthritis)) ## Mark groups col <- c("red", "red", "blue", "blue") pch <- c(1, 19, 1, 19) ## plot ternaryplot( tab, col = col, pch = pch, prop_size = TRUE, bg = "lightgray", grid_color = "white", labels_color = "white", main = "Arthritis Treatment Data" ) ## legend grid_legend(0.8, 0.7, pch, col, rownames(tab), title = "GROUP") ## Titanic data("Lifeboats") attach(Lifeboats) ternaryplot( Lifeboats[,4:6], pch = ifelse(side == "Port", 1, 19), col = ifelse(side == "Port", "red", "blue"), id = ifelse(men / total > 0.1, as.character(boat), NA), prop_size = 2, dimnames_position = "edge", main = "Lifeboats on Titanic" ) grid_legend(0.8, 0.9, c(1, 19), c("red", "blue"), c("Port", "Starboard"), title = "SIDE") ## Hitters data("Hitters") attach(Hitters) colors <- c("black","red","green","blue","red","black","blue") pch <- substr(levels(Positions), 1, 1) ternaryplot( Hitters[,2:4], pch = as.character(Positions), col = colors[as.numeric(Positions)], main = "Baseball Hitters Data" ) grid_legend(0.8, 0.9, pch, colors, levels(Positions), title = "POSITION(S)") } \keyword{hplot} vcd/man/labeling_cells_list.Rd0000755000175000017500000001205514133262477016233 0ustar nileshnilesh\name{labeling_cells_list} \alias{labeling_list} \alias{labeling_cells} \title{Labeling Functions for Strucplots} \description{ These functions generate labeling functions that produce labels for strucplots. } \usage{ labeling_cells(labels = TRUE, varnames = TRUE, abbreviate_labels = FALSE, abbreviate_varnames = FALSE, gp_text = gpar(), lsep = ": ", lcollapse = "\n", just = "center", pos = "center", rot = 0, margin = unit(0.5, "lines"), clip_cells = TRUE, text = NULL, \dots) labeling_list(gp_text = gpar(), just = "left", pos = "left", lsep = ": ", sep = " ", offset = unit(c(2, 2), "lines"), varnames = TRUE, cols = 2, \dots) } \arguments{ \item{labels}{vector of logicals indicating, for each dimension, whether labels for the factor levels should be drawn or not. Values are recycled as needed.} \item{varnames}{vector of logicals indicating, for each dimension, whether variable names should be drawn. Values are recycled as needed.} \item{abbreviate_labels}{vector of integers or logicals indicating, for each dimension, the number of characters the labels should be abbreviated to. \code{TRUE} means 1 character, \code{FALSE} causes no abbreviation. Values are recycled as needed.} \item{abbreviate_varnames}{vector of integers or logicals indicating, for each dimension, the number of characters the variable (i.e., dimension) names should be abbreviated to. \code{TRUE} means 1 character, \code{FALSE} causes no abbreviation. Values are recycled as needed.} \item{gp_text}{object of class \code{"gpar"} used for the text drawn.} \item{lsep}{character that separates variable names from the factor levels.} \item{sep}{character that separates the factor levels (only used for \code{labeling_list}).} \item{offset}{object of class \code{"unit"} of length 2 specifying the offset in x- and y-direction of the text block drawn under the strucplot (only used for \code{labeling_list}).} \item{cols}{number of text columns (only used for \code{labeling_list}).} \item{lcollapse}{character that separates several variable name/factor level-combinations. Typically a line break. (Only used for \code{labeling_cells}.)} \item{just, pos}{character string of length 1 (\code{labeling_list}) or at most 2 (\code{labeling_cells}) specifying the labels' horizontal position and justification (horizontal and vertical for \code{labeling_cells}).} \item{rot}{rotation angle in degrees, used for all labels (only used for \code{labeling_cells}).} \item{margin}{object of class \code{"unit"} (a numeric value is converted to \code{"lines"}) specifying an offset from the cell borders (only used for \code{labeling_cells}).} \item{clip_cells}{logical indicating whether text should be clipped at the cell borders (only used for \code{labeling_cells}).} \item{text}{Optionally, a character table of the same dimensions than the contingency table whose entries will then be used instead of the labels. \code{NA} entries are not drawn. This allows custom cell annotations (see examples). Only used for \code{labeling_cells}.} \item{\dots}{Currently not used.} } \details{ These functions generate labeling functions that can add different kinds of labels to an existing plot. Typically they are supplied to \code{\link{strucplot}} which then generates and calls the labeling function. They assume that a strucplot has been drawn and the corresponding viewport structure is pushed, so that by navigating through the viewport tree the labels can be positioned appropriately. This help page only documents \code{labeling_list} and \code{labeling_cells}; more functions are described on the help page for \code{\link{labeling_border}}. The functions can also be used \sQuote{stand-alone} as shown in the examples. Using \code{labeling_list} will typically necessitate a bottom margin adjustment. } \value{ A function with arguments: \item{d}{\code{"dimnames"} attribute from the visualized contingency table, or the visualized table itself from which the \code{"dimnames"} attributes will then be extracted.} \item{split_vertical}{vector of logicals indicating the split directions.} \item{condvars}{integer vector of conditioning dimensions} } \author{ David Meyer \email{David.Meyer@R-project.org} } \references{ Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. Available as \code{vignette("strucplot", package = "vcd")}. \doi{10.18637/jss.v017.i03}. } \seealso{ \code{\link{labeling_border}}, \code{\link{structable}}, \code{\link[grid]{grid.text}} } \examples{ data("Titanic") mosaic(Titanic, labeling = labeling_cells) mosaic(Titanic, labeling = labeling_list) ## A more complex example, adding the observed frequencies ## to a mosaic plot: tab <- ifelse(Titanic < 6, NA, Titanic) mosaic(Titanic, pop = FALSE) labeling_cells(text = tab, margin = 0)(Titanic) } \keyword{hplot} vcd/man/mosaic.Rd0000644000175000017500000002404714133214736013510 0ustar nileshnilesh\name{mosaic} \alias{mosaic} \alias{mosaic.default} \alias{mosaic.formula} \title{Extended Mosaic Plots} \description{ Plots (extended) mosaic displays. } \usage{ \method{mosaic}{default}(x, condvars = NULL, split_vertical = NULL, direction = NULL, spacing = NULL, spacing_args = list(), gp = NULL, expected = NULL, shade = NULL, highlighting = NULL, highlighting_fill = rev(gray.colors(tail(dim(x), 1))), highlighting_direction = NULL, zero_size = 0.5, zero_split = FALSE, zero_shade = NULL, zero_gp = gpar(col = 0), panel = NULL, main = NULL, sub = NULL, \dots) \method{mosaic}{formula}(formula, data, highlighting = NULL, \dots, main = NULL, sub = NULL, subset = NULL, na.action = NULL) } \arguments{ \item{x}{a contingency table in array form, with optional category labels specified in the \code{dimnames(x)} attribute, or an object of class \code{"structable"}.} \item{condvars}{vector of integers or character strings indicating conditioning variables, if any. The table will be permuted to order them first.} \item{formula}{a formula specifying the variables used to create a contingency table from \code{data}. For convenience, conditioning formulas can be specified; the conditioning variables will then be used first for splitting. If any, a specified response variable will be highlighted in the cells.} \item{data}{either a data frame, or an object of class \code{"table"} or \code{"ftable"}.} \item{subset}{an optional vector specifying a subset of observations to be used.} \item{na.action}{a function which indicates what should happen when the data contain \code{NA}s. Ignored if \code{data} is a contingency table.} \item{zero_size}{size of the bullets used for zero entries (if 0, no bullets are drawn).} \item{zero_split}{logical controlling whether zero cells should be further split. If \code{FALSE} and \code{zero_shade} is \code{FALSE}, only one bullet is drawn (centered) for unsplit zero cells. If \code{FALSE} and \code{zero_shade} is \code{TRUE}, a bullet for each zero cell is drawn to allow, e.g., residual-based shadings to be effective also for zero cells.} \item{zero_shade}{logical controlling whether zero bullets should be shaded. The default is \code{TRUE} if \code{shade} is \code{TRUE} or \code{expected} is not null or \code{gp} is not null, and \code{FALSE} otherwise.} \item{zero_gp}{object of class \code{"gpar"} used for zero bullets in case they are \emph{not} shaded.} \item{split_vertical}{vector of logicals of length \eqn{k}, where \eqn{k} is the number of margins of \code{x} (default: \code{FALSE}). Values are recycled as needed. A \code{TRUE} component indicates that the tile(s) of the corresponding dimension should be split vertically, \code{FALSE} means horizontal splits. Ignored if \code{direction} is not \code{NULL}.} \item{direction}{character vector of length \eqn{k}, where \eqn{k} is the number of margins of \code{x} (values are recycled as needed). For each component, a value of \code{"h"} indicates that the tile(s) of the corresponding dimension should be split horizontally, whereas \code{"v"} indicates vertical split(s).} \item{spacing}{spacing object, spacing function, or corresponding generating function (see \code{\link{strucplot}} for more information). The default is \code{spacing_equal} if \code{x} has two dimensions, \code{spacing_increase} for more dimensions, and \code{spacing_conditional} if conditioning variables are specified using \code{condvars} or the formula interface.} \item{spacing_args}{list of arguments for the generating function, if specified (see \code{\link{strucplot}} for more information).} \item{gp}{object of class \code{"gpar"}, shading function or a corresponding generating function (see details and \code{\link{shadings}}). Components of \code{"gpar"} objects are recycled as needed along the last splitting dimension. Ignored if \code{shade = FALSE}.} \item{shade}{logical specifying whether \code{gp} should be used or not (see \code{gp}). If \code{TRUE} and \code{expected} is unspecified, a default model is fitted: if \code{condvars} (see \code{\link{strucplot}}) is specified, a corresponding conditional independence model, and else the total independence model.} \item{expected}{optionally, an array of expected values of the same dimension as \code{x}, or alternatively the corresponding independence model specification as used by \code{\link[stats]{loglin}} or \code{\link[MASS]{loglm}} (see \code{\link{strucplot}}).} \item{highlighting}{character vector or integer specifying a variable to be highlighted in the cells.} \item{highlighting_fill}{color vector or palette function used for a highlighted variable, if any.} \item{highlighting_direction}{Either \code{"left"}, \code{"right"}, \code{"top"}, or \code{"bottom"} specifying the direction of highlighting in the cells.} \item{panel}{Optional function with arguments: \code{residuals}, \code{observed}, \code{expected}, \code{index}, \code{gp}, and \code{name} called by the \code{struc_mosaic} workhorse for each tile that is drawn in the mosaic. \code{index} is an integer vector with the tile's coordinates in the contingency table, \code{gp} a \code{gpar} object for the tile, and \code{name} a label to be assigned to the drawn grid object.} \item{main, sub}{either a logical, or a character string used for plotting the main (sub) title. If logical and \code{TRUE}, the name of the \code{data} object is used.} \item{\dots}{Other arguments passed to \code{\link{strucplot}}} } \details{ Mosaic displays have been suggested in the statistical literature by Hartigan and Kleiner (1984) and have been extended by Friendly (1994). \code{\link[graphics]{mosaicplot}} is a base graphics implementation and \code{mosaic} is a much more flexible and extensible grid implementation. \code{mosaic} is a generic function which currently has a default method and a formula interface. Both are high-level interfaces to the \code{\link{strucplot}} function, and produce (extended) mosaic displays. Most of the functionality is described there, such as specification of the independence model, labeling, legend, spacing, shading, and other graphical parameters. A mosaic plot is an area proportional visualization of a (possibly higher-dimensional) table of expected frequencies. It is composed of tiles (corresponding to the cells) created by recursive vertical and horizontal splits of a square. The area of each tile is proportional to the corresponding cell entry, \emph{given} the dimensions of previous splits. An \emph{extended} mosaic plot, in addition, visualizes the fit of a particular log-linear model. Typically, this is done by residual-based shadings where color and/or outline of the tiles visualize sign, size and possibly significance of the corresponding residual. The layout is very flexible: the specification of shading, labeling, spacing, and legend is modularized (see \code{\link{strucplot}} for details). In contrast to the \code{\link[graphics]{mosaicplot}} function in \pkg{graphics}, the splits start with the \emph{horizontal} direction by default to match the printed output of \code{\link{structable}}. } \value{ The \code{"structable"} visualized is returned invisibly. } \references{ Hartigan, J.A., and Kleiner, B. (1984), A mosaic of television ratings. \emph{The American Statistician}, \bold{38}, 32--35. Emerson, J. W. (1998), Mosaic displays in S-PLUS: A general implementation and a case study. \emph{Statistical Computing and Graphics Newsletter (ASA)}, \bold{9}, 1, 17--23. Friendly, M. (1994), Mosaic displays for multi-way contingency tables. \emph{Journal of the American Statistical Association}, \bold{89}, 190--200. Meyer, D., Zeileis, A., and Hornik, K. (2006), The strucplot framework: Visualizing multi-way contingency tables with \pkg{vcd}. \emph{Journal of Statistical Software}, \bold{17(3)}, 1-48. Available as \code{vignette("strucplot", package = "vcd")}. \doi{10.18637/jss.v017.i03}. The home page of Michael Friendly (\url{http://datavis.ca}) provides information on various aspects of graphical methods for analyzing categorical data, including mosaic plots. In particular, there are many materials for his course \dQuote{Visualizing Categorical Data with SAS and R} at \url{http://datavis.ca/courses/VCD/}. } \author{ David Meyer \email{David.Meyer@R-project.org} } \seealso{ \code{\link{assoc}}, \code{\link{strucplot}}, \code{\link{mosaicplot}}, \code{\link{structable}}, \code{\link{doubledecker}} } \examples{ library(MASS) data("Titanic") mosaic(Titanic) ## Formula interface for tabulated data plus shading and legend: mosaic(~ Sex + Age + Survived, data = Titanic, main = "Survival on the Titanic", shade = TRUE, legend = TRUE) data("HairEyeColor") mosaic(HairEyeColor, shade = TRUE) ## Independence model of hair and eye color and sex. Indicates that ## there are significantly more blue eyed blond females than expected ## in the case of independence (and too few brown eyed blond females). mosaic(HairEyeColor, shade = TRUE, expected = list(c(1,2), 3)) ## Model of joint independence of sex from hair and eye color. Males ## are underrepresented among people with brown hair and eyes, and are ## overrepresented among people with brown hair and blue eyes, but not ## "significantly". ## Formula interface for raw data: visualize crosstabulation of numbers ## of gears and carburettors in Motor Trend car data. data("mtcars") mosaic(~ gear + carb, data = mtcars, shade = TRUE) data("PreSex") mosaic(PreSex, condvars = c(1,4)) mosaic(~ ExtramaritalSex + PremaritalSex | MaritalStatus + Gender, data = PreSex) ## Highlighting: mosaic(Survived ~ ., data = Titanic) data("Arthritis") mosaic(Improved ~ Treatment | Sex, data = Arthritis, zero_size = 0) mosaic(Improved ~ Treatment | Sex, data = Arthritis, zero_size = 0, highlighting_direction = "right") } \keyword{hplot} vcd/vignettes/0000755000175000017500000000000014133313352013166 5ustar nileshnileshvcd/vignettes/struc.sxi0000755000175000017500000002162011720273432015062 0ustar nileshnileshPKJS3Xmimetypeapplication/vnd.sun.xml.impressPKJS3 content.xml\[~ϯ ReWZ/SJuص$O$2HF3 yIIN7!GGt>Ǖ/<{ap-H8kK7o~ۻ|As!WnW$H&N$WoV'釈8 b:}wNHew 􇿊>+޼iz8WiﵸLj: 55$IZn'0=f1zaS1:Z+xH0-: A(ϙp=7oޅwW`n$Y< RCDxAΈ4H,a~AuN&5FY8'qxxxlfxA+ /(7IzWԭ{5|Z 8/!IY{ZyY9q{sY 2۶UeN!WC?qB{R YKb?ˀ<ɨOL6E[,s^heΪh!6 =Vmh6_XBWV` sKBd~; # 1 IXFYd Ɇ.Đ_zOOR\> XFiD$U#l!~)zA|L:R5 QHzeuc?Ï[Jȕj8/rZ#,/d qsQuww2Q[d{y|h)v>Vs8A7mԭm+L %H鮹0V4{ -)mwn+YPs)~mdAB=ƋK4lC#~.ijmsDZU LDkӱ4wM`1W}Qw^+xx}GkauνGn":ETm,Zl5)i WOq2,@!@L$adt3swp6*Įߤo$_W8ObL]^YX&1[>I2횰cȟL?=faaW@Psʬ,4Ji\8!CNG؁'yHIy+}kڅ;>{XH/vyء t(:'!+]bꃎLU 1䗠KRRkoQGn(KeUdjrG9)(32J T8!nf.~ҏr T$Ea@ x$pYPO0(np16ۀ0eaSC <a"8ς~ a q=;B6tu hH95őXLv 'x dl:\򁒰dժ+VeYzmd8sYevϵA}G;RtR&}x"&VoviyvC-P_ LI<1qz&ux<c!j3`pct2~^%tzʼxjs;:MnS J> ogVY%3$̗8И:}:S^@cpLq}ė˯eg˯{-3a*cR!L!!k>,IIS;p34OoPXZI$d᭖ܧw_9I\fZmFxmeˬM6N7e9T|}FPy-+u$)reHBn[:*FѲN] }746-L7ZN}PKF1D *\PKJS3 styles.xml][6~_J޸ v&dk3S=UGd vw>_ .6`Ʒf|^@zqh".K0rGe,pۿ?Kh6]x!w(U5ˏ$+i OTJE\%>k$hϿʒ.z'6\k%7r"/tyiw1u]o9k@[S .—U`T{1XJ8\z^kJh|亼~QrhNaܮ HAe  Ҳ,N3snq;Tviy\#h@g=J8l8scٮ9 噧?_a,G ~!Z0b7>\^&.钩K1 -LY׽ l2C7_;DO~ ?P"V(;F0݉O]q PJ?0$M@e+0E0.ZEiuXwK ~/#k4zV6% `jJP7̔*+p@O`Q,hV-U.SBR,Ⱦu#Er銆e'r⓫T18x%)\u8*!J:Uh`6=6/x"Xu"j̻mk"Ϊk@W?^gaRa=,&EDbpV Y_,~OayMљOWU]gfU ɴ&84=S5Ϊ.l%9֦i;vPA:})S:HӐD ZnyXfbͷ3Pͫ6>U?8|Sa[Wm@<3߾ju>C?eFRu5$MnS [F纜8_{U6hj 2|٫+ڹ2ÿ*kad(8f|O|C³`2fdq6e|V-Ϗ;H)^OF1vVU{6U}s&쵻 8ccKXTuAd^yAd^yAOKS݉W*ݲͶmnoUlkmܖ[3u6 l溎sr܊5fW숀j4+Jd {ͼ.`n &`n &˼xXY7%L6Ra&6;=ni _/Z~)̯;R짘B~w=FPP@mUeg-ԮTz0@y&-]p~Wىy:N7uqd^ՈV#jZXk5|ǵ CT#Xb-̞g- j r[ZkEZkeLu#t)aS&oS/`l[RF{:>F矆"~̞'~ jJ.]D 蟠 '蟠Y8`')c2΢/wvQW=Isq?{IθwG;v{3@nwΏntιjv~xfǧl?Mő>U8NfvDZ]m7nImeK1.r"+,鼍aVۆ޾Z Ϫ6Z[mPjvY֞X^~ZϠKt} jt u>ku}@uTPj}Sj#eI>WD'Ų2 J;$6'+,tl2} `g>LWGzT0ma[3&v~nXUxmQvz=!ꑁ`T.sLC8Ů2xD_|g8'.X\Lmj['[#Vqǵw:f/2wK1v'/o}A,n6cLQgv_VTKP&Ed)]3n{ō.bHd!S96`d!{b56D42J[-Lp? Ucmߑ:ܑO%S|}ҍ#25(dJ | <;zԦ]U~yiUyOҗa2h9E/ձQ9gXial"e}T齆|$*ޔekZgۊ(gXi7PָɼL} HZ|lTaxG%PlGO(tޥ#TݟXNIwܿN[ILmwhJ7q^!w7?PK 8PKJS3*meta.xml OpenOffice.org 1.1.4 (Linux)2005-09-18T14:10:532005-10-19T11:22:15en-US8PT1H47M45SPKJS3 settings.xmlZ[W8~_u(.9I'I_?i/XӚYli}{d_' xhD]a:0?Ne0V cn#*Rn6*4;d!3tNauﬧiVFXz3.w+)8[=0Rg{)Ye'y|EQ2X.fhPP&d<`Z\ 16|cg7^D~lk }eGgisގa\!Ҹ<8*q~ d*xh}ύ~=9O?*Os_!<_*}8> 0PXY|Q+O0.c(fDc!؂2F$qFm.y!h}߅3Ԃ|ЧCiL"WָRV,]N]rtI( Dp{cUiDT 1uY&fk/$Ҏ7ʪ{.K^&\~l+!Ҹ4?wzM:!%HdyE1CX60ދ{!A|oɎ7* o9jd7}DԉK"q^6J- "Vv$M "cQ"gLU\Q5hLZ7L-($L7|PJY\1r_*|{'1.@|Q7ނ,L-12&0)}t_^w˞N1J[\qUVdxsc'b߷Cq(g{Qd,9A="b*݂]C6aДA5=]m5+W7!OZ ˡ@܁~}&acn05wt0AgЛ3>RIy5c3T2E0:/9lM.r ^a~r%ԗVI]Qw7XsRyB0$R ֗iSy>@~qSKaJ&Y'w61| ^~bq43Bz{ L&e[+(]{s5 NP~ +C]}HZ6c v7BG51 z+ttI_\+݀$HBIWI GZ UXwiz 0 ԑבXqTP㉟J)*_ajɞUi׌`}_W I6)O1E2 ee.0/_RJ9:cdu}aΚGh Zu0=ohyCh4Ok6_ƽzSJoQF:/['W-+~Y=awd?:!/KHwPZ kp㻠Dqt@*Qt͸Tӣ޶c- P^=Ұ0o՞3-ŲΫ޼B4tjjbATէ D+4--Wbyj_M5y~ So^e5>ndJm[z5T=-E,n*'NxJDڬݫXxw9[2^b*k~XM-ᥨq 7ZvSiJT-پ2CPKOץ1)PKJS3META-INF/manifest.xmlұj0Onө;)ڃ3t49Ȓ!~BI_piq+kRX6S8+l7Osʟb/ʨ<(o;bmj?"fe&`#A$n fe‰٭m Yj Ԩ*Q sZ_4FRu'aj#W)|h}P5aȣӅ1dphĢQ_툫sko6k PKI\zPKJS3XmimetypePKJS3F1D *\ Econtent.xmlPKJS3 8 3 styles.xmlPKJS3*meta.xmlPKJS3Oץ1) settings.xmlPKJS3I\z META-INF/manifest.xmlPKZ "vcd/vignettes/strucplot.Rnw0000644000175000017500000031176312445055730015737 0ustar nileshnilesh\documentclass[nojss]{jss} %% need no \usepackage{Sweave} %% omit thumbpdf at the moment due to problems on some systems %% \usepackage{thumbpdf} %% almost as usual \author{David Meyer, Achim Zeileis, \textnormal{and} Kurt Hornik\\Wirtschaftsuniversit\"at Wien, Austria} \title{The Strucplot Framework:\\ Visualizing Multi-way Contingency Tables with \pkg{vcd}} %% for pretty printing and a nice hypersummary also set: \Plainauthor{David Meyer, Achim Zeileis, Kurt Hornik} %% comma-separated \Shorttitle{The Strucplot Framework} %% a short title (if necessary) \Plaintitle{The Strucplot Framework: Visualizing Multi-way Contingency Tables with vcd} %% an abstract and keywords \Abstract{ This paper has been published in the Journal of Statistical Software \citep{vcd:Meyer+Zeileis+Hornik:2006b} and describes the ``strucplot'' framework for the visualization of multi-way contingency tables. Strucplot displays include hierarchical conditional plots such as mosaic, association, and sieve plots, and can be combined into more complex, specialized plots for visualizing conditional independence, GLMs, and the results of independence tests. The framework's modular design allows flexible customization of the plots' graphical appearance, including shading, labeling, spacing, and legend, by means of ``graphical appearance control'' functions. The framework is provided by the \proglang{R} package \pkg{vcd}. } \Keywords{contingency tables, mosaic plots, association plots, sieve plots, categorical data, independence, conditional independence, HSV, HCL, residual-based shading, \pkg{grid}, \proglang{R}} \Plainkeywords{contingency tables, mosaic plots, association plots, sieve plots, categorical data, independence, conditional independence, HSV, HCL, residual-based shading, grid, R} \Address{ David Meyer\\ E-mail: \email{David.Meyer@R-project.org}\\ Achim Zeileis\\ E-mail: \email{Achim.Zeileis@R-project.org}\\ Kurt Hornik\\ E-mail: \email{Kurt.Hornik@R-project.org}\\ } \SweaveOpts{engine=R,eps=TRUE,height=6,width=7,results=hide,fig=FALSE,echo=TRUE,eps=FALSE} \setkeys{Gin}{width=0.7\textwidth} %\VignetteIndexEntry{The Strucplot Framework: Visualizing Multi-way Contingency Tables with vcd} %\VignetteDepends{vcd,grid} %\VignetteKeywords{contingency tables, mosaic plots, association plots, sieve plots, categorical data, independence, conditional independence, HSV, HCL, residual-based shading, grid, R} %\VignettePackage{vcd} <>= set.seed(1071) library(grid) library(vcd) data(Titanic) data(HairEyeColor) data(PreSex) data(Arthritis) art <- xtabs(~Treatment + Improved, data = Arthritis) @ \newcommand{\var}[1]{\textit{\texttt{#1}}} \newcommand{\data}[1]{\texttt{#1}} \newcommand{\class}[1]{\textsf{#1}} %% \code without `-' ligatures \def\nohyphenation{\hyphenchar\font=-1 \aftergroup\restorehyphenation} \def\restorehyphenation{\hyphenchar\font=`-} {\catcode`\-=\active% \global\def\code{\bgroup% \catcode`\-=\active \let-\codedash% \Rd@code}} \def\codedash{-\discretionary{}{}{}} \def\Rd@code#1{\texttt{\nohyphenation#1}\egroup} \newcommand{\codefun}[1]{\code{#1()}} %% end of declarations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \begin{document} %% include your article here, just as usual %% Note that you should use the \pkg{}, \proglang{} and \code{} commands. \section[Introduction]{Introduction} %% Note: If there is markup in \(sub)section, then it has to be escape as above. In order to explain multi-dimensional categorical data, statisticians typically look for (conditional) independence structures. Whether the task is purely exploratory or model-based, techniques such as mosaic and association plots offer good support for visualization. Both visualize aspects of (possibly higher-dimensional) contingency tables, with several extensions introduced over the last two decades, and implementations available in many statistical environments. A \emph{mosaic plot} \citep{vcd:Hartigan+Kleiner:1984} is basically an area-proportional visualization of (typically, observed) frequencies, composed of tiles (corresponding to the cells) created by recursive vertical and horizontal splits of a rectangle. Thus, the area of each tile is proportional to the corresponding cell entry \emph{given} the dimensions of previous splits. An \emph{association plot} \citep{vcd:Cohen:1980} visualizes the standardized deviations of observed frequencies from those expected under a certain independence hypothesis. Each cell is represented by a rectangle that has (signed) height proportional to the residual and width proportional to the square root of the expected counts, so that the area of the box is proportional to the difference in observed and expected frequencies. Extensions to these techniques have mainly focused on the following aspects. \begin{enumerate} \item Varying the shape of bar plots and mosaic displays to yield, e.g., double-decker plots \citep{vcd:hofmann:2001}, spine plots, or spinograms \citep{vcd:hofmann+theus}. \item Using residual-based shadings to visualize log-linear models \citep{vcd:Friendly:1994,vcd:Friendly:2000} and significance of statistical tests \citep{vcd:Meyer+Zeileis+Hornik:2003,vcd:Zeileis+Meyer+Hornik:2007}. \item Using pairs plots and trellis-like layouts for marginal, conditional and partial views \citep{vcd:Friendly:1999}. \item Adding direct user interaction, allowing quick exploration and modification of the visualized models \citep{vcd:Unwin+Hawkins+Hofmann:1996,vcd:Theus:2003}. \item Providing a modular and flexible implementation to easily allow user extensions \citep{vcd:Meyer+Zeileis+Hornik:2003,vcd:Meyer+Zeileis+Hornik:2006b}. \end{enumerate} \noindent Current implementations of mosaic displays can be found, e.g., for \proglang{SAS} \citep{vcd:SAS:2005}, \pkg{ViSta} \citep{vcd:young:1996}, \pkg{MANET} \citep{vcd:Unwin+Hawkins+Hofmann:1996}, \pkg{Mondrian} \citep{vcd:Theus:2003}, \proglang{R} \citep{vcd:R:2006}, and \proglang{S-PLUS} \citep{vcd:SPLUS:2005}. For \proglang{R}, currently three implementations do exist in the packages \pkg{graphics} (in base \proglang{R}), \pkg{vcd} \citep{vcd:Meyer+Zeileis+Hornik:2006b}, and \pkg{iplots} \citep{vcd:urbanek+wichtrey:2006}, respectively. Table \ref{tab:compare} gives an overview of the available functionality in these systems. Most environments are available on Windows, MacOS, and Linux/Unix variants, except \pkg{MANET} which is only available for the Macinthosh platforms. \begin{table}[h] \centering \begin{tabular}{|l|c|c|c|c|c|c|c|c|c|} \hline & & &\multicolumn{3}{c|}{} & & &\\ & \proglang{SAS} & \proglang{S-PLUS} &\multicolumn{3}{c|}{\proglang{R}} & \pkg{ViSta} & \pkg{MANET} & \pkg{Mondrian}\\ & & &\pkg{base}&\pkg{vcd} &\pkg{iplots}& & &\\\hline Basic functionality & $\times$ & $\times$ & $\times$ &$\times$ &$\times$ & $\times$ & $\times$& $\times$\\ Shape & & & &$\times$ && $\times$ & $\times$&\\ Res.-based shadings & $\times$ & & $\times$ & $\times$ & ($\times$) & &($\times$)& ($\times$)\\ Highlighting & & & &$\times$ &$\times$ & $\times$ & $\times$& $\times$\\ Conditional views & $\times$ & & &$\times$ & & $\times$ & $\times$&\\ Interaction & & & & &$\times$ & $\times$ & $\times$& $\times$\\ Linking & & & & &$\times$ & $\times$ & $\times$& $\times$\\ Extensible design & & & &$\times$ & & & &\\ Language & \proglang{SAS} & \proglang{S} & \proglang{R} & \proglang{R} & \proglang{R}/\proglang{Java} & \proglang{XLisp} & \proglang{C++} & \proglang{Java}\\ \hline \end{tabular} \caption{Comparison of current software environments.} \label{tab:compare} \end{table} Figures \ref{fig:arthritis} to \ref{fig:titanic} illustrate some of these extensions. Figure~\ref{fig:arthritis} shows the results from a double-blind clinical trial investigating a new treatment for rheumatoid arthritis, using an extended mosaic plot with residual-based shading based on the maximum statistic: clearly, the new treatment is effective. The dark blue cell indicates that the rate of treated patients showing marked improvement is significant at the 1\% level. Figure \ref{fig:ucbadmissions} visualizes the well-known UCB admissions data by means of a conditional association plot. The panels show the residuals from a conditional independence model (independence of gender and admission, given department), stratified by department. Clearly, the situation in department A (more women/less men accepted than would be expected under the null hypothesis) causes the rejection of the hypothesis of conditional independence. Figure~\ref{fig:presex} illustrates the conditional independence of premarital and extramarital sex, given gender and marital status. The $\chi^2$ test of independence, based on the permutation distribution, rejects the null hypothesis: possibly, because the tendency of people to have extramarital sex when they had premarital sex is particularly marked among married people? The rate of such women and men ist significant at the 0.01 and 0.1 level, respectively. Finally, Figure~\ref{fig:titanic} visualizes the ``Survival on the Titanic'' data using a double-decker plot. Here, a binary response (survival of the disaster) is to be explained by other factors (class, gender, and age). The gray boxes represent the proportion of survived passengers in a particular stratum. The proportions of saved women and children are indeed higher than those of men, but they clearly decrease from the 1st to the 3rd class. In addition, the proportion of saved men in the 1st class is higher than in the others. \setkeys{Gin}{width=0.7\textwidth} \begin{figure}[p] \begin{center} <>= mosaic(art, gp = shading_max, split_vertical = TRUE) @ \caption{Mosaic plot for the \data{Arthritis} data.} \label{fig:arthritis} \end{center} \end{figure} \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= cotabplot(UCBAdmissions, panel = cotab_coindep, shade = TRUE, legend = FALSE, type = "assoc") @ \caption{Conditional association plot for the \data{UCBAdmissions} data.} \label{fig:ucbadmissions} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \begin{figure}[p] \begin{center} <>= presextest <- coindep_test(PreSex, margin = c(1,4), indepfun = function(x) sum(x^2), n = 5000) mosaic(PreSex, condvars = c(1, 4), shade = TRUE, gp_args = list(p.value = presextest$p.value)) @ \caption{Mosaic plot for the \data{PreSex} data.} \label{fig:presex} \end{center} \end{figure} \setkeys{Gin}{width=0.8\textwidth} \begin{figure}[p] \begin{center} <>= doubledecker(Survived ~ ., data = Titanic, labeling_args = list(set_varnames = c(Sex = "Gender"))) @ \caption{Double-decker plot for the \data{Titanic} data.} \label{fig:titanic} \end{center} \end{figure} This paper describes the strucplot framework provided by the \pkg{vcd} package for the \proglang{R} environment for statistical computing and graphics, available from the Comprehensive \proglang{R} Archive Network (\url{http://CRAN.R-project.org/}). The framework integrates displays such as mosaic, association, and sieve plots by their unifying property of being flat representations of contingency tables. These basic plots, as well as specialized displays for conditional independence, can be used both for exploratory visualization and model-based analysis. Exploratory techniques include specialized displays for the bivariate case, as well as pairs and trellis-type displays for higher-dimensional tables. Model-based tools include methods suitable for the visualization of conditional independence tests (including permutation tests), as well as for the visualization of particular GLMs (logistic regression, log-linear models). Additionally, two of the framework's further strengths are its flexibility and extensibility: graphical appearance aspects such as shading, labeling, and spacing are modularized by means of ``\underline{\vphantom{g}gr}aphical \underline{\vphantom{g}ap}pearance \underline{\vphantom{g}con}trol'' (\emph{grapcon}) functions, allowing fine-granular customization and user-level extensions. The remainder of the paper is organized as follows. In Section \ref{sec:strucplot}, we give an overview of the strucplot framework, describing the hierarchy of the main components and the basic functionality. In Section \ref{sec:shading}, we demonstrate how (residual-based) shadings support the visualization of log-linear models and the results of independence tests. Also, we explain step-by-step how the concepts of generating and grapcon functions can be combined to provide a flexible customization of complex graphical displays as created by the strucplot framework. Sections \ref{sec:labeling} and \ref{sec:spacing} discuss in detail the labeling and spacing features, respectively. Section \ref{sec:example} exemplifies the framework in the analysis of a four-way data set. Section \ref{sec:conclusion} concludes the work. \section[The strucplot framework]{The strucplot framework} \label{sec:strucplot} The strucplot framework in the \proglang{R} package \pkg{vcd}, used for visualizing multi-way contingency tables, integrates techniques such as mosaic displays, association plots, and sieve plots. The main idea is to visualize the tables' cells arranged in rectangular form. For multi-way tables, the variables are nested into rows and columns using recursive conditional splits, given the margins. The result is a ``flat'' representation that can be visualized in ways similar to a two-dimensional table. This principle defines a class of conditional displays which allows for granular control of graphical appearance aspects, including: \begin{itemize} \item the content of the tiles \item the split direction for each dimension \item the graphical parameters of the tiles' content \item the spacing between the tiles \item the labeling of the tiles \end{itemize} The strucplot framework is highly modularized: Figure~\ref{fig:struc} shows the hierarchical relationship between the various components. On the lowest level, there are several groups of workhorse and parameter functions that directly or indirectly influence the final appearance of the plot (see Table \ref{tab:grapcons} for an overview). These are examples of grapcon functions. They are created by generating functions (\emph{grapcon generators}), allowing flexible parameterization and extensibility (Figure~\ref{fig:struc} only shows the generators). The generator names follow the naming convention \code{\textit{group\_foo}()}, where \code{\textit{group}} reflects the group the generators belong to (strucplot core, labeling, legend, shading, or spacing). The workhorse functions (created by \code{struc\_\textit{foo}()}, \code{labeling\_\textit{foo}()}, and \code{legend\_\textit{foo}()}) directly produce graphical output (i.e., ``add ink to the canvas''), whereas the parameter functions (created by \code{spacing\_\textit{foo}()} and \code{shading\_\textit{foo}()}) compute graphical parameters used by the others. The grapcon functions returned by \code{struc\_\textit{foo}()} implement the core functionality, creating the tiles and their content. On the second level of the framework, a suitable combination of the low-level grapcon functions (or, alternatively, corresponding generating functions) is passed as ``hyperparameters'' to \codefun{strucplot}. This central function sets up the graphical layout using grid viewports (see Figure~\ref{fig:layout}), and coordinates the specified core, labeling, shading, and spacing functions to produce the plot. On the third level, we provide several convenience functions such as \codefun{mosaic}, \codefun{sieve}, \codefun{assoc}, and \codefun{doubledecker} which interface \codefun{strucplot} through sensible parameter defaults and support for model formulae. Finally, on the fourth level, there are ``related'' \pkg{vcd} functions (such as \codefun{cotabplot} and the \codefun{pairs} methods for table objects) arranging collections of plots of the strucplot framework into more complex displays (e.g., by means of panel functions). \begin{table} \begin{tabular}{|l|l|l|} \hline \textbf{Group} & \textbf{Grapcon generator} & \textbf{Description}\\\hline strucplot & \codefun{struc\_assoc} & core function for association plots\\ core & \codefun{struc\_mosaic} & core function for mosaic plots\\ & \codefun{struc\_sieve} & core function for sieve plots\\\hline\hline labeling & \codefun{labeling\_border} & border labels\\ & \codefun{labeling\_cboxed} & centered labels with boxes, all labels clipped,\\ && and on top and left border\\ & \codefun{labeling\_cells} & cell labels\\ & \codefun{labeling\_conditional} & border labels for conditioning variables\\ && and cell labels for conditioned variables\\ & \codefun{labeling\_doubledecker} & draws labels for doubledecker plot\\ & \codefun{labeling\_lboxed} & left-aligned labels with boxes\\ & \codefun{labeling\_left} & left-aligned border labels\\ & \codefun{labeling\_left2} & left-aligned border labels, all labels on top and left border\\ & \codefun{labeling\_list} & draws a list of labels under the plot\\\hline\hline shading & \codefun{shading\_binary} & visualizes the sign of the residuals\\ & \codefun{shading\_Friendly} & implements Friendly shading (based on HSV colors)\\ & \codefun{shading\_hcl} & shading based on HCL colors\\ & \codefun{shading\_hsv} & shading based on HSV colors\\ & \codefun{shading\_max} & shading visualizing the maximum test statistic\\ && (based on HCL colors)\\ & \codefun{shading\_sieve} & implements Friendly shading customized for sieve plots\\ && (based on HCL colors)\\\hline\hline spacing & \codefun{spacing\_conditional} & increasing spacing for conditioning variables,\\&& equal spacing for conditioned variables\\ & \codefun{spacing\_dimequal} & equal spacing for each dimension\\ & \codefun{spacing\_equal} & equal spacing for all dimensions\\ & \codefun{spacing\_highlighting} & increasing spacing, last dimension set to zero\\ & \codefun{spacing\_increase} & increasing spacing\\\hline\hline legend & \codefun{legend\_fixed} & creates a fixed number of bins (similar to \codefun{mosaicplot})\\ & \codefun{legend\_resbased} & suitable for an arbitrary number of bins\\&& (also for continuous shadings)\\\hline \end{tabular} \caption{Available grapcon generators in the strucplot framework} \label{tab:grapcons} \end{table} \begin{figure}[h] \begin{center} \includegraphics[width=0.8\textwidth]{struc} \caption{Components of the strucplot framework.} \label{fig:struc} \end{center} \end{figure} \setkeys{Gin}{width=0.6\textwidth} \begin{figure}[h] \begin{center} <>= pushViewport(vcd:::vcdViewport(legend = T, mar =4)) seekViewport("main") grid.rect(gp = gpar(lwd = 3)) grid.text("main", gp = gpar(fontsize = 20)) seekViewport("sub") grid.rect(gp = gpar(lwd = 3)) grid.text("sub", gp = gpar(fontsize = 20)) seekViewport("plot") grid.rect(gp = gpar(lwd = 3)) grid.text("plot", gp = gpar(fontsize = 20)) seekViewport("legend") grid.text("legend", rot = 90, gp = gpar(fontsize = 20)) grid.rect(gp = gpar(lwd = 3)) seekViewport("legend_sub") grid.rect(gp = gpar(lwd = 3)) grid.text("[F]", gp = gpar(fontsize = 20)) seekViewport("legend_top") grid.rect(gp = gpar(lwd = 3)) grid.text("[E]", gp = gpar(fontsize = 20)) seekViewport("margin_top") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_top", gp = gpar(fontsize = 20)) seekViewport("margin_bottom") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_bottom", gp = gpar(fontsize = 20)) seekViewport("margin_right") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_right", rot = 90, gp = gpar(fontsize = 20)) seekViewport("margin_left") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_left", rot = 90, gp = gpar(fontsize = 20)) seekViewport("corner_top_left") grid.rect(gp = gpar(lwd = 3)) grid.text("[A]", gp = gpar(fontsize = 20)) seekViewport("corner_top_right") grid.rect(gp = gpar(lwd = 3)) grid.text("[B]", gp = gpar(fontsize = 20)) seekViewport("corner_bottom_left") grid.rect(gp = gpar(lwd = 3)) grid.text("[C]", gp = gpar(fontsize = 20)) seekViewport("corner_bottom_right") grid.rect(gp = gpar(lwd = 3)) grid.text("[D]", gp = gpar(fontsize = 20)) @ \caption{Viewport layout for strucplot displays with their names. [A] = ``corner\_top\_left'', [B] = ``corner\_top\_right'', [C] = ``corner\_bottom\_left'', [D] = ``corner\_bottom\_right'', [E] = ``legend\_top'', [F] = ``legend\_sub''.} \label{fig:layout} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \subsection{Mosaic, association, and sieve plots} As an example, consider the \data{HairEyeColor} data containing two polytomous variables (hair and eye color), as well as one (artificial) dichotomous gender variable (\code{Sex}). The ``flattened'' contingency table can be obtained using the \codefun{structable} function (quite similar to \codefun{ftable} in base \proglang{R}, but allowing the specification of split directions): <>= (HEC <- structable(Eye ~ Sex + Hair, data = HairEyeColor)) @ Let us first visualize the contingency table by means of a mosaic plot. % \citep{vcd:Hartigan+Kleiner:1984} which is basically % an area-proportional visualization of (typically, observed) frequencies, composed % of tiles (corresponding to the cells) created by recursive % vertical and horizontal splits of a square. Thus, the area of each tile % is proportional to the corresponding cell entry \emph{given} the % dimensions of previous splits. The effect of <>= mosaic(HEC) @ \noindent equivalent to <>= mosaic(~ Sex + Eye + Hair, data = HairEyeColor) @ %\setkeys{Gin}{width=0.75\textwidth} \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{HairEyeColor} data.} \label{fig:observed} \end{center} \end{figure} \noindent depicts the observed frequencies of the \code{HairEyeColor} data. If there are zero entries, tiles have zero area and are, additionally, marked by small bullets (see, e.g, Figure~\ref{fig:titanic}). By default, these cells are not split further. The bullets help distinguishing very small cells from zero entries, and are particularly useful when color shadings come into play (see the example using the \data{Bundesliga} data in Section \ref{sec:overview}). Note that in contrast to, e.g., \codefun{mosaicplot} in base \proglang{R}, the default split direction and level ordering in all strucplot displays correspond to the textual representation produced by the print methods. It is also possible to visualize the expected values instead of the observed values (see Figure~\ref{fig:expected}): <>= mosaic(HEC, type = "expected") @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{HairEyeColor} data (expected values).} \label{fig:expected} \end{center} \end{figure} %\setkeys{Gin}{width=0.7\textwidth} \noindent In order to compare observed and expected values, a sieve plot \citep{vcd:riedwyl+schuepbach:1994} could be used (see Figure~\ref{fig:sieve}): <>= sieve(~ Sex + Eye + Hair, data = HEC, spacing = spacing_dimequal(c(2,0,0))) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{Sieve plot for the \data{HairEyeColor} data visualizing simultaneously observed and expected values.} \label{fig:sieve} \end{center} \end{figure} \noindent where \code{spacing\_dimequal} is used to set the spacing of the second and third dimension to zero. Alternatively, we can directly inspect the residuals. The Pearson residuals (standardized deviations of observed from expected values) are conveniently visualized using association plots \citep{vcd:Cohen:1980}. In contrast to \codefun{assocplot} in base \proglang{R}, \pkg{vcd}'s \codefun{assoc} function scales to more than two variables (see Figure~\ref{fig:residuals}): <>= assoc(HEC, compress = FALSE) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Association plot for the \data{HairEyeColor} data.} \label{fig:residuals} \end{center} \end{figure} \noindent where the \code{compress} argument keeps distances between tiles equal. For both mosaic plots and association plots, the splitting of the tiles can be controlled using the \code{split\_vertical} argument. The default is to alternate splits starting with a horizontal one (see Figure~\ref{fig:split}): <>= options(width=60) @ <>= mosaic(HEC, split_vertical = c(TRUE, FALSE, TRUE), labeling_args = list(abbreviate_labs = c(Eye = 3))) @ <>= options(width=70) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{HairEyeColor} data---alternative splitting.} \label{fig:split} \end{center} \end{figure} \noindent (Note that \code{HEC}, a \class{structable} object, already includes a splitting information which simply gets overloaded in this example.) For compatibility with \codefun{mosaicplot} in base \proglang{R}, the \codefun{mosaic} function also allows the use of a \code{direction} argument taking a vector of \code{"h"} and \code{"v"} characters: <>= mosaic(HEC, direction = c("v","h","v")) @ By a suitable combination of splitting, spacing, and labeling settings, the functions provided by the strucplot framework can be customized in a quite flexible way. For example, the default method for \codefun{doubledecker} is simply a wrapper for \codefun{strucplot}, setting the right defaults. Most default settings such as colors, spacing, and labeling are specified via the parameters and passed through to \codefun{strucplot}. The additional code just handles the dependent variable information, and in particular permutes the table to have the dependent variable as the last dimension as required for the doubledecker plot. Figure~\ref{fig:titanic} shows a doubledecker plot of the \data{Titanic} data, explaining the probability of survival (``survived'') by age, given sex, given class. It is created by: <>= doubledecker(Titanic) @ \noindent equivalent to: <>= doubledecker(Survived ~ Class + Sex + Age, data = Titanic) @ \subsection{Conditional and partial views} So far, we have visualized either full or collapsed tables, as suggested by the analysis task at hand. Subtables can be selected in a similar way as for objects of class \class{table} using indexing. Note, however, that subsetting of \class{structable} objects is more restrictive because of their inherent conditional structure. Since the variables on both the row and the columns side are nested, subsetting is only possible ``outside-in'', that is, indexing operates on blocks defined by the variable levels. In the following, we use the Titanic data again, this time collapsed over \code{Survived} to investigate the structure of crew and passengers (and having the \code{Child} and \code{Age} labels of the \code{Age} variable swapped for optical clarity): <>= options(width=75) @ <>= (STD <- structable(~ Sex + Class + Age, data = Titanic[,,2:1,])) STD["Male",] STD["Male", c("1st","2nd","3rd")] @ <>= options(width=70) @ \noindent \emph{Conditioning} on levels (i.e., choosing a table subset for fixed levels of the conditioning variable(s)) is done using the \code{[[} operator. %]] Here again, the sequence of conditioning levels is restricted by the hierarchical structure of the \class{structable} object. In the following examples, note that compared to subsetting, the first dimension(s) are dropped: <>= STD[["Male",]] STD[[c("Male", "Adult"),]] STD[["Male","1st"]] @ \noindent Now, there are several ways for visualizing conditional independence structures. The ``brute force'' method is to draw separate plots for the strata. The following example compares the association between hair and eye color, given gender, by using subsetting on the flat table and \pkg{grid}'s viewport framework to visualize the two groups besides each other: <>= pushViewport(viewport(layout = grid.layout(ncol = 2))) @ <>= pushViewport(viewport(layout.pos.col = 1)) mosaic(STD[["Male"]], margins = c(left = 2.5, top = 2.5, 0), sub = "Male", newpage = FALSE) popViewport() @ <>= pushViewport(viewport(layout.pos.col = 2)) mosaic(STD[["Female"]], margins = c(top = 2.5, 0), sub = "Female", newpage = FALSE) popViewport(2) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= <> <> <> @ \caption{Two mosaic displays put side-by-side, visualizing the distribution of class and age, given gender. The marginal distribution of gender cannot be seen.} \label{fig:parttable} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent Note the use of the \code{margins} argument: it takes a vector with up to four values whose unnamed components are recycled, but ``overruled'' by the named arguments. Thus, in the second example, only the top margin is set to 2.5 lines, and all other to 0. This idea applies to almost all vectorized arguments in the strucplot framework (with \code{split\_vertical} as a prominent exception). The \codefun{cotabplot} function does a much better job on this task: it arranges stratified strucplot displays in a lattice-like layout, conditioning on variable \emph{levels}. The plot in Figure~\ref{fig:cotabplot} shows class and age group, given sex: <>= cotabplot(~ Class + Age | Sex, data = STD, split_vertical = TRUE) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= <> @ \caption{Conditional table plot for the \data{Titanic} data, again visualizing the distribution of age and class, given gender, using separate mosaic displays like the ``manual'' plot in Figure~\ref{fig:parttable}.} \label{fig:cotabplot} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} %\noindent The \code{labeling\_args} argument modifies the labels' %appearance: here, to be left-aligned and unclipped %(see Section \ref{sec:labeling}). \noindent Visualizing the strata separately ``hides'' the distribution of the conditioning variable(s) which may or may not be appropriate or sensible in a particular analysis step. If we wish to keep the information on the marginal distribution(s), we can use one single mosaic for the stratified plot since mosaic displays are ``conditional plots'' by definition. We just need to make sure that conditioning variables are used first for splitting. Both the default and the formula interface of \codefun{mosaic} allow the specification of conditioning variables (see Figure~\ref{fig:conditioning}): <>= mosaic(STD, condvars = "Sex", split_vertical = c(TRUE, TRUE, FALSE)) @ <>= mosaic(~ Class + Age | Sex, data = STD, split_vertical = c(TRUE, TRUE, FALSE)) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[h] \begin{center} <>= <> @ \caption{Mosaic plot again visualizing the distribution of class and age, given gender, this time using a single mosaic plot. In contrast to Figures~\ref{fig:parttable} and \ref{fig:cotabplot}, this plot also visualizes the marginal distribution of gender.} \label{fig:conditioning} \end{center} \end{figure} \setkeys{Gin}{width=0.7} \noindent The effect of using this is that conditioning variables are permuted ahead of the the conditioned variables in the table, and that \codefun{spacing\_conditional} is used as default to better distinguish conditioning from conditioned dimensions. This spacing uses equal space between tiles of conditioned variables, and increasing space between tiles of conditioning variables (See Section~\ref{sec:spacing}). Another set of high-level functions for visualizing conditional independence models are the \codefun{pairs} methods for \class{table} and \class{structable} objects. In contrast to \codefun{cotabplot} which conditions on variables, the \codefun{pairs} methods create pairwise views of the table. They produce, by default, a plot matrix having strucplot displays in the off-diagonal panels, and the variable names (optionally, with univariate displays) in the diagonal cells. Figure~\ref{fig:pairs} shows a pairs display for the \data{Titanic} data with univariate mosaics in the diagonal, and mosaic plots visualizing the corresponding bivariate mosaics in the upper and lower triangles. Due to the inherent asymmetry of mosaic displays, the corresponding plots in the upper and lower triangle differ depending on which variable is used first for splitting---inspecting both views might help detecting patterns in a data set. Additionally, we are using a special spacing and shading normally used to `highlight' %' the second variable in the first (as will be discussed in Section \ref{sec:spacing}): here, the intention of the spacing is to emphasize the conditional distributions of the second variable, given the first one, and the shading helps identifying the factor levels in the second variable. <>= pairs(STD, highlighting = 2, diag_panel = pairs_diagonal_mosaic, diag_panel_args = list(fill = grey.colors)) @ %\setkeys{Gin}{width=\textwidth} \setkeys{Gin}{width=0.7\textwidth} \begin{figure}[h] \begin{center} <>= <> @ \caption{Pairs plot for the \data{Titanic} data.} \label{fig:pairs} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent The labels of the variables are to be read from left to right and from top to bottom. In addition, the levels can be matched by position within the columns and by shading within the rows. In plots produced by \codefun{pairs}, each panel's row and column define two variables $X$ and $Y$ used for the specification of four different types of independence: pairwise, total, conditional, and joint. The pairwise mosaic matrix shows bivariate marginal relations between $X$ and $Y$, collapsed over all other variables. The total independence mosaic matrix shows mosaic plots for mutual independence, i.e., for marginal and conditional independence among all pairs of variables. The conditional independence mosaic matrix shows mosaic plots for marginal independence of $X$ and $Y$, given all other variables. The joint independence mosaic matrix shows mosaic plots for joint independence of all pairs ($X$, $Y$) of variables from the others. Upper and lower parts can independently be used to display different types of independence models, or different strucplot displays (mosaic, association, or sieve plots). The available panel functions (\codefun{pairs\_assoc}, \codefun{pairs\_mosaic}, and \codefun{pairs\_sieve}) are simple wrappers to \codefun{assoc}, \codefun{mosaic}, and \codefun{sieve}, respectively. Obviously, seeing patterns in strucplot matrices becomes increasingly difficult with higher dimensionality. Therefore, this plot is typically used with a suitable residual-based shading (see Section \ref{sec:shading}). \subsection{Interactive plot modifications} All strucplot core functions are supposed to produce conditional hierarchical plots by the means of nested viewports, corresponding to the provided splitting information. Thus, at the end of the plotting, each tile is associated with a particular viewport. Each of those viewports has to be conventionally named, enabling other strucplot modules, in particular the labeling functions, to access specific tiles after they have been plotted. The naming convention for the viewports is: \begin{center} \code{\emph{[Optional prefix]}cell:\emph{Variable1}=\emph{Level1},\emph{Variable2}=\emph{Level2}} \dots \end{center} \noindent Clearly, these names depend on the splitting. The following example shows how to access parts of the plot after it has been drawn (see Figure~\ref{fig:afterplot}): <>= mosaic(~ Hair + Eye, data = HEC, pop = FALSE) seekViewport("cell:Hair=Blond") grid.rect(gp = gpar(col = "red", lwd = 4)) seekViewport("cell:Hair=Blond,Eye=Blue") grid.circle(r = 0.2, gp = gpar(fill = "cyan")) @ \noindent Note that the viewport tree is removed by default. Therefore, the \texttt{pop} argument has to be set to \texttt{FALSE} when viewports shall be accessed. \setkeys{Gin}{width=0.6\textwidth} \begin{figure}[h] \begin{center} <>= <> @ \caption{Adding elements to a mosaic plot after drawing.} \label{fig:afterplot} \end{center} \end{figure} In addition to the viewports, the main graphical elements get names following a similar construction method. This allows to change graphical parameters of plot elements \emph{after} the plotting (see Figure~\ref{fig:changeplot}): <>= assoc(Eye ~ Hair, data = HEC, pop = FALSE) getNames()[1:6] grid.edit("rect:Hair=Blond,Eye=Blue", gp = gpar(fill = "red")) @ %% code-chunk reuse does not work with parameter changing \begin{figure}[h] \begin{center} <>= x <- tab <- margin.table(HairEyeColor, 1:2) x[] <- "light gray" x["Blond","Blue"] <- "Red" assoc(tab, gp = gpar(fill = x)) @ \caption{Changing graphical parameters of elements after drawing.} \label{fig:changeplot} \end{center} \end{figure} \subsection{Performance issues} \label{sec:performance} As stated above, the implementation of strucplot displays is based on creating and nesting \pkg{grid} viewports. The main time-consuming steps performed by the core functions are the following: \begin{enumerate} \item recursively, split the table until the individual cells are reached \item during the splits, add viewports to the plot \item for the individual cells, add plot-specific content (rectangles for mosaics, bars for association plots, etc.) \end{enumerate} \noindent All these operations scale linearly with the amount of created viewports. For a $d$-dimensional table with $k_i$ levels, $i=1 \dots d$, the total number of needed viewports $T_d$ can roughly be estimated as \begin{equation} \label{eq:numbervp} T_d \quad = \quad k_1 + k_1k_2 + \cdots + k_1 \cdots k_d \quad =\quad \sum_{i=1}^d \prod_{j \le i} k_j \end{equation} \noindent since we first push the $k_1$ viewports for the levels of the first dimension, then, for \emph{each} of these, the $k_2$ levels of the second dimension, etc. If the number of levels is equal ($k$) for all dimensions, $T_d$ simplifies to \begin{equation} \label{eq:equalvp} T_d \quad = \quad \sum_{i=1}^d k^i = \frac{k(k^d-1)}{k-1} \end{equation} \noindent and so the time complexity for drawing a strucplot display is of order $k^d$. \section{Shadings} \label{sec:shading} Unlike other graphics functions in base \proglang{R}, the strucplot framework allows almost full control over the graphical parameters of all plot elements. In particular, in association plots, mosaic plots, and sieve plots, the user can modify the graphical appearance of each tile individually. Built on top of this functionality, the framework supplies a set of shading functions choosing colors appropriate for the visualization of log-linear models. The tiles' graphical parameters are set using the \code{gp} argument of the functions of the strucplot framework. This argument basically expects an object of class \class{gpar} whose components are arrays of the same shape (length and dimensionality) as the data table (see Section \ref{sec:gp}). For convenience, however, the user can also supply a grapcon function that computes such an object given a vector of residuals, or, alternatively, a generating function that takes certain arguments and returns such a grapcon function (see Section \ref{sec:shadingcustom}). We provide several shading functions, including support for both HSV and HCL colors, and the visualization of significance tests (see Section \ref{sec:overview}). \subsection{Specifying graphical parameters of strucplot displays} \label{sec:gp} As an example, consider the \data{UCBAdmissions} data. In the table aggregated over departments, we would like to highlight the (incidentally wrong) impression that there were too many male students accepted compared to the presumably discriminated female students (see Figure~\ref{fig:ucb}): <>= (ucb <- margin.table(UCBAdmissions, 1:2)) (fill_colors <- matrix(c("dark cyan","gray","gray","dark magenta"), ncol = 2)) mosaic(ucb, gp = gpar(fill = fill_colors, col = 0)) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{UCBAdmissions} data with highlighted cells.} \label{fig:ucb} \end{center} \end{figure} \noindent As the example shows, we create a fourfold table with appropriate colors (dark cyan for admitted male students and dark magenta for rejected female students) and supply them to the \code{fill} component of the \class{gpar} object passed to the \code{gp} argument of \codefun{mosaic}. For visual clarity, we additionally hide the tiles' borders by setting the \code{col} component to 0 (transparent). If the parameters specified in the \class{gpar} object are ``incomplete'', they will be recycled along the last splitting dimension. In the following example based on the \data{Titanic} data, we will highlight all cells corresponding to survived passengers (see Figure~\ref{fig:recycling}): <>= mosaic(Titanic, gp = gpar(fill = c("gray","dark magenta")), spacing = spacing_highlighting, labeling_args = list(abbreviate_labs = c(Age = 3), rep = c(Survived = FALSE)) ) @ \noindent Note that \codefun{spacing\_highlighting} sets the spaces between tiles in the last dimension to 0. The \code{labeling\_args} argument ensures that labels do not overlap (see Section \ref{sec:labeling}). \begin{figure}[h] \begin{center} <>= <> @ \caption{Recycling of parameters, used for highlighting the survived passengers in the \data{Titanic} data.} \label{fig:recycling} \end{center} \end{figure} \subsection{Customizing residual-based shadings} \label{sec:shadingcustom} This flexible way of specifying graphical parameters is the basis for a suite of shading functions that modify the tiles' appearance with respect to a vector of residuals, resulting from deviations of observed from expected frequencies under a given log-linear model. The idea is to visualize at least sign and absolute size of the residuals, but some shadings, additionally, indicate overall significance. One particular shading, the maximum shading \citep{vcd:Meyer+Zeileis+Hornik:2003,vcd:Zeileis+Meyer+Hornik:2007}, even allows to identify the cells that cause the rejection of the null hypothesis. Conceptually, the strucplot framework offers three alternatives to add residual-based shading to plots: \begin{enumerate} \item Precomputing the graphical parameters (e.g., fill colors), encapsulating them into an object of class \class{gpar} as demonstrated in the previous section, and passing this object to the \code{gp} argument. \item Providing a grapcon function to the \code{gp} argument that takes residuals as input and returns an object as described in alternative 1. \item Providing a grapcon generator taking parameters and returning a function as described in alternative~2. \end{enumerate} \noindent For each of these approaches, we will demonstrate the necessary steps to obtain a binary shading that visualizes the sign of the residuals by a corresponding fill color (for simplicity, we will treat 0 as positive). \subsubsection*{Alternative 1: Precomputed \class{gpar} object} The first method is precomputing the graphical parameters ``by hand''. We will use \code{royalblue4} color for positive and \code{mediumorchid4} color for negative residuals (see Figure~\ref{fig:binary}): <>= expected <- independence_table(ucb) (x <- (ucb - expected) / sqrt(expected)) (shading1_obj <- ifelse(x > 0, "royalblue4", "mediumorchid4")) mosaic(ucb, gp = gpar(fill = shading1_obj)) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{Binary shading visualizing the sign of the residuals.} \label{fig:binary} \end{center} \end{figure} \subsubsection*{Alternative 2: Grapcon function} For implementing alternative 2, we need to create a ``shading function'' that computes \class{gpar} objects from residuals. For that, we can just reuse the code from the previous step: <>= shading2_fun <- function(x) gpar(fill = ifelse(x > 0, "royalblue4", "mediumorchid4")) @ \noindent To create a mosaic display with binary shading, it now suffices to specify the data table along with \codefun{shading2\_fun}: <>= mosaic(ucb, gp = shading2_fun) @ \noindent \codefun{mosaic} internally calls \codefun{strucplot} which computes the residuals from the specified independence model (total independence by default), passes them to \codefun{shading2\_fun}, and uses the \class{gpar} object returned to finally create the plot. Our \codefun{shading2\_fun} function might be useful, but can still be improved: the hard-wired colors should be customizable. We cannot simply extend the argument list to include, e.g., a \code{fill = c("royalblue4", "mediumorchid4")} argument because \codefun{strucplot} will neither know how to handle it, nor let us change the defaults. In fact, the interface of shading functions is fixed, they are expected to take exactly one argument: a table of residuals. This is where generating functions (alternative 3) come into play. \subsubsection*{Alternative 3: Grapcon generator} We simply wrap our grapcon shading function in another function that takes all additional arguments it needs to use, possibly preprocesses them, and returns the actual shading function. This returned function will have access to the parameters since in \proglang{R}, nested functions are lexically scoped. Thus, the grapcon generator returns (``creates'') a ``parameterized'' shading function with the minimal standard interface \codefun{strucplot} requires. The following example shows the necessary extensions for our running example: <>= shading3a_fun <- function(col = c("royalblue4", "mediumorchid4")) { col <- rep(col, length.out = 2) function(x) gpar(fill = ifelse(x > 0, col[1], col[2])) } @ \noindent The first statement just makes sure that exactly two colors are specified. In the call to \codefun{mosaic}, using the new \codefun{shading3a\_fun} function, we can now simply change the colors: <>= mosaic(ucb, gp = shading3a_fun(c("royalblue4","mediumorchid4"))) @ \noindent (figure not shown). The procedure described so far is a rather general concept, applicable to a wide family of user-level \pkg{grid} graphics. Indeed, the customization of other components of the strucplot framework (labeling, spacing, legend, and core functions) follows the same idea. Now for the shading functions, more customization is needed. Note that \codefun{shading3a\_fun} needs to be evaluated by the user, even if the defaults are to be used. It is a better idea to let \codefun{strucplot} call the generating function, which, in particular, allows the passing of arguments that are computed by \codefun{strucplot}. Since shading functions can be used for visualizing significance (see Section \ref{sec:overview}), it makes sense for generating functions to have access to the model, i.e., observed and expected values, residuals, and degrees of freedom. For example, the \codefun{shading\_max} generating function computes a permutation distribution of the maximum statistic and $p$ values for specified significance levels based on the observed table to create data-driven cut-off points. If this was done in the shading function itself, the permutation statistic would be recomputed every time the shading function is called, resulting in possibly severe performance loss and numerical inconsistencies. Therefore, generating functions for shadings are required to take at least the parameters \code{observed}, \code{expected}, \code{residuals}, and \code{df} (these are provided by the strucplot framework), followed by other parameters controlling the shading appearance (to be specified by the user): <>= shading3b_fun <- function(observed = NULL, residuals = NULL, expected = NULL, df = NULL, col = c("royalblue4", "mediumorchid4")) { col <- rep(col, length.out = 2) function(x) gpar(fill = ifelse(x > 0, col[1], col[2])) } class(shading3b_fun) <- "grapcon_generator" @ Note that in this simple binary shading example, the first four parameters are not used. In some sense, generating functions for shadings are parameterized both by the user and the strucplot framework. For shading functions that require model information, the user-specified parameters are to be passed to the \code{gp\_args} argument instead, and for this to work, the generating function needs a class attribute to be distinguishable from the ``normal'' shading functions. For others (like our simple \codefun{shading3b\_fun}) this is optional, but recommended for consistency: <>= mosaic(ucb, gp = shading3b_fun, gp_args = list(col = c("red","blue"))) @ \noindent The final \codefun{shading3b\_fun} pretty much resembles \codefun{shading\_binary}, one of the standard shading functions provided by the \pkg{vcd} package. \subsection[An overview of the shading functions in vcd]{An overview of the shading functions in \pkg{vcd}} \label{sec:overview} \cite{vcd:Friendly:1994} suggested a residual-based shading for the mosaic tiles that can also be applied to the rectangles in association plots \citep{vcd:Meyer+Zeileis+Hornik:2003}. Apart from \codefun{shading\_binary}, there are currently two basic shadings available in \pkg{vcd}: \codefun{shading\_hcl} and \codefun{shading\_hsv}, as well as two derived functions: \codefun{shading\_Friendly} building upon \codefun{shading\_hsv}, and \codefun{shading\_max} building upon \codefun{shading\_hcl}. \codefun{shading\_hsv} and \codefun{shading\_hcl} provide the same conceptual tools, but use different color spaces: the Hue-Saturation-Value (HSV) and the Hue-Chroma-Luminance (HCL) scheme, respectively. We will first expose the basic concept of these shading functions using HSV space, and then briefly explain the differences to HCL space \citep[a detailed discussion can be found in][]{vcd:Zeileis+Meyer+Hornik:2007}. Color palettes in HCL space are preferable to palettes derived from HSV space from a perceptual point of view. Functions for creating palettes (see, e.g., \codefun{diverge\_hcl}) are provided with the \pkg{vcd} package. In HSV space, colors are specified in three dimensions: Hue, Saturation (``colorfulness''), and Value (``lightness'', amount of gray). These three dimensions are used by \codefun{shading\_hsv} to visualize information about the residuals and the underlying independence model. The hue indicates the residuals' sign: by default, blue for positive, and red for negative residuals. The saturation of a residual is set according to its size: high saturation for large, and low saturation for small residuals. Finally, the overall lightness is used to indicate the significance of a test statistic: light colors for significant, and dark colors for non-significant results. As an example, we will visualize the association of hair and eye color in the \data{HairEyeColor} data set (see Figure~\ref{fig:haireye}, top): <>= haireye <- margin.table(HairEyeColor, 1:2) mosaic(haireye, gp = shading_hsv) @ \noindent As introduced before, the default shading scheme is not \codefun{shading\_hsv} but \codefun{shading\_hcl} due to the better perceptual characteristics of HCL color space. The following example again illustrates the \data{HairEyeColor} data, this time with HCL colors: <>= mosaic(haireye, gp = shading_hcl) @ <>= mosaic(haireye, gp = shading_hcl, gp_args = list(h = c(130, 43), c = 100, l = c(90, 70))) @ \noindent In Figure~\ref{fig:haireye}, the plot in the middle depicts the default palette, and the bottom plot an alternative setting for Hue (\code{h}), Chroma (\code{c}), and Luminance (\code{l}). \setkeys{Gin}{width=0.5\textwidth} \begin{figure}[htbp] \begin{center} <>= mosaic(haireye, gp = shading_hsv, margin = c(bottom = 1), keep_aspect_ratio = FALSE) @ <>= mosaic(haireye, gp = shading_hcl, margin = c(bottom = 1), keep_aspect_ratio = FALSE) @ <>= mosaic(haireye, gp = shading_hcl, margin = c(bottom = 1), gp_args = list(h = c(130, 43), c = 100, l = c(90, 70)), keep_aspect_ratio = FALSE) @ \caption{Three mosaic plots for the \data{HairEyeColor} data using different color palettes. Top: default HSV color palette. Middle: default HCL color palette. Bottom: a custom HCL color palette.} \label{fig:haireye} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent Large positive residuals (greater than $4$) can be found for brown eyes/black hair and blue eyes/blond hair, and are colored in deep blue. On the other hand, there is a large negative residual (less than $-4$) for brown eyes/blond hair, colored deep red. There are also three medium-sized positive (negative) residuals between 2 and 4 ($-2$ and $-4$): the colors for them are less saturated. Residuals between $-2$ and $2$ are shaded in white (gray for HCL-shading). The heuristic for choosing the cut-off points $2$ and $4$ is that the Pearson residuals are approximately standard normal which implies that the highlighted cells are those with residuals \emph{individually} significant at approximately the $\alpha = 0.05$ and $\alpha = 0.0001$ levels, respectively. These default cut-off points can be changed to alternative values using the \code{interpolate} argument (see Figure~\ref{fig:interpolatecontinuous}): <>= mosaic(haireye, shade = TRUE, gp_args = list(interpolate = 1:4)) @ \noindent The elements of the numeric vector passed to \code{interpolate} define the knots of an interpolating step function used to map the absolute residuals to saturation levels. The \code{interpolate} argument also accepts a user-defined function, which then is called with the absolute residuals to get a vector of cut-off points. Thus, it is possible to automatically choose the cut-off points in a data-driven way. For example, one might think that the extension from four cut-off points to a continuous shading---visualizing the whole range of residuals---could be useful. We simply need a one-to-one mapping from the residuals to the saturation values: <>= ipol <- function(x) pmin(x/4, 1) @ \noindent Note that this \codefun{ipol} function maps residuals greater than 4 to a saturation level of 1. However, the resulting plot (Figure~\ref{fig:interpolatecontinuous}, right) is deceiving: <>= mosaic(haireye, shade = TRUE, gp_args = list(interpolate = ipol), labeling_args = list(abbreviate_labs = c(Sex = TRUE))) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[htbp] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) mosaic(haireye, gp_args = list(interpolate = 1:4), margin = c(right = 1), keep_aspect_ratio= FALSE,newpage = FALSE,legend_width=5.5,shade = TRUE) popViewport(1) pushViewport(viewport(layout.pos.col = 2)) mosaic(haireye, gp_args = list(interpolate = ipol), margin = c(left=3,right = 1), keep_aspect_ratio = FALSE, newpage = FALSE, shade = TRUE) popViewport(2) @ \caption{\label{fig:interpolatecontinuous}The \data{HairEyeColor} data. Left: shading with 4 cut-off points. Right: continuous shading.} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent Too much color makes it difficult to interpret the image, and the subtle color differences are hard to catch. Therefore, we only included shadings with discrete cut-off points. The third remaining dimension, the value, is used for visualizing the significance of a test statistic. The user can either directly specify the $p$ value, or, alternatively, a function that computes it, to the \code{p.value} argument. Such a function must take observed and expected values, residuals, and degrees of freedom (used by the independence model) as arguments. If nothing is specified, the $p$ value is computed from a $\chi^2$ distribution with \code{df} degrees of freedom. The \code{level} argument is used to specify the confidence level: if \code{p.value} is smaller than \code{1 - level}, light colors are used, otherwise dark colors are employed. The following example using the \data{Bundesliga} data shows the relationship of home goals and away goals of Germany's premier soccer league in 1995: although there are two ``larger'' residuals (one greater than 2, one less then $-2$), the $\chi^2$ test does not reject the null hypothesis of independence. Consequently, the colors appear dark (see Figure~\ref{fig:bundesliga}, left): <>= BL <- xtabs(~ HomeGoals + AwayGoals, data = Bundesliga, subset = Year == 1995) mosaic(BL, shade = TRUE) @ \noindent Note that in extended mosaic plots, bullets drawn for zero cells are shaded, too, bringing out non-zero residuals, if any. A shading function building upon \codefun{shading\_hsv} is \codefun{shading\_Friendly}, implementing the shading introduced by \cite{vcd:Friendly:1994}. In addition to the defaults of the HSV shading, it uses the border color and line type to redundantly code the residuals' sign. The following example again uses the \data{Bundesliga} data from above, this time using the Friendly scheme and, in addition, an alternative legend (see Figure~\ref{fig:bundesliga}, right): <>= mosaic(BL, gp = shading_Friendly, legend = legend_fixed, zero_size = 0) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[htbp] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) mosaic(BL, margin = c(right = 1), keep_aspect_ratio= FALSE, newpage = FALSE, legend_width=5.5, shade = TRUE) popViewport(1) pushViewport(viewport(layout.pos.col = 2)) mosaic(BL, gp = shading_Friendly, legend = legend_fixed, zero_size = 0, margin = c(right = 1), keep_aspect_ratio= FALSE, newpage = FALSE, legend_width=5.5) popViewport(2) @ \caption{The \data{Bundesliga} data for 1995. Left: Non-significant $\chi^2$ test. Right: using the Friendly shading and a legend with fixed bins.} \label{fig:bundesliga} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent (The \code{zero\_size = 0} argument removes the bullets indicating zero observed values. This feature is not provided in the original \proglang{SAS} implementation of the Friendly mosaic plots.) % Figure~\ref{fig:shadingHSVHCL} depicts % HSV space in the upper panel and HCL space in the lower panel. % On the left (right) side, we see the color scales for red (blue) % hue, respectively. The $x$-axis represents the colorfulness, and the % $y$-axis the brightness. % The boxes represent the diverging color palettes used for the shadings. % For HSV space, we can see that the effect of changing the % level of brightness (`value') is not the same for different levels of % saturation, and again not the same for the two different hues. % In fact, in HSV space all dimensions are confounded, which % obviously is problematic for coding information. In contrast, HCL color % space offers perceptually uniform colors: as can be seen from the lower panel, % the chroma is homogeneous for different levels of luminance. % Unfortunately, this comes at the % price of the space being irregularly shaped, making it difficult to automatically select % diverging color palettes. % <>= % hue.slice <- function(hue, grid.n = 101, type = c("HCL", "HSV"), plot = TRUE, fixup = FALSE) % { % type <- match.arg(type) % if(type == "HCL") { % chroma = seq(0, 100, length = grid.n) % luminance = seq(0, 100, length = grid.n) % nc <- length(chroma) % nl <- length(luminance) % color.slice <- outer(chroma, luminance, function(y, x) hcl(hue, x, y, fixup = fixup)) % xlab <- "chroma" % ylab <- "luminance" % main <- paste("hue =", round(hue, digits = 0)) % } else { % chroma = seq(0, 1, length = grid.n) % luminance = seq(0, 1, length = grid.n) % nc <- length(chroma) % nl <- length(luminance) % color.slice <- outer(chroma, luminance, function(y, x) hsv(hue, x, y)) % xlab <- "saturation" % ylab <- "value" % main <- paste("hue =", round(hue, digits = 3)) % } % if(plot) { % plot(0.5, 0.5, xlim = range(chroma), ylim = range(luminance), type = "n", axes = FALSE, % xlab = xlab, ylab = ylab, yaxs = "i", xaxs = "i", main = main) % for(i in 1:(nc-1)) { % rect(chroma[i], luminance[-nl], chroma[i] + 100/(nc-1), luminance[-1], border = color.slice[,i+1], col = color.slice[,i+1]) % } % axis(1) % axis(2) % box() % } % colnames(color.slice) <- chroma % rownames(color.slice) <- luminance % attr(color.slice, "type") <- type % class(color.slice) <- "slice" % invisible(color.slice) % } % @ % \setkeys{Gin}{width=.8\textwidth} % \begin{figure}[p] % \begin{center} % <>= % ## generate colors % hue23 <- hue.slice(2/3, grid.n = 101, plot = FALSE, type = "HSV") % hue0 <- hue.slice(0, grid.n = 101, plot = FALSE, type = "HSV") % saturation <- as.numeric(colnames(hue23)) % value <- as.numeric(rownames(hue23)) % ## select those with value >= 0.5 % hue23 <- hue23[value >= .5, ] % hue0 <- hue0[value >= .5, ] % value <- value[value >= .5] % nl <- nrow(hue23) % nc <- ncol(hue23) % ## plot 2 slides from HSV space % plot(0.5, 0.5, xlim = c(-1, 1), ylim = c(0, 1), type = "n", axes = FALSE, % xlab = "", ylab = "", yaxs = "i", xaxs = "i", main = "") % for(i in 1:(nc-1)) { % rect(saturation[i], value[-nl], saturation[i] + 1/(nc-1), value[-1], border = hue23[,i+1], col = hue23[,i+1]) % } % for(i in 1:(nc-1)) { % rect(-saturation[i], value[-nl], -(saturation[i] + 1/(nc-1)), value[-1], border = hue0[,i+1], col = hue0[,i+1]) % } % axis(2, at = c(50, 75, 100)/100, labels = c(0.5, 0.75, 1)) % axis(4, at = c(50, 75, 100)/100, labels = c(0.5, 0.75, 1)) % axis(3, at = -4:4*.25, labels=c(4:0*.25, 1:4*.25)) % mtext(c("hue = 0", "hue = 2/3"), side = 3, at = c(-.5, .5), line = 3, cex = 1.2) % mtext("saturation", side = 3, at = 0, line = 2) % mtext("value", side = 2, at = .75, line = 2) % mtext("value", side = 4, at = .75, line = 2) % lines(c(-1, 1), c(.5, .5)) % ## significant colors % rect(-1, 0.95, -.90, 1, col = hsv(0, 1, 1)) % rect(-0.45, 0.95, -.55, 1, col = hsv(0, 0.5, 1)) % rect(-.05, .95, .05, 1, col = hsv(2/3, 0, 1)) % rect(0.45, 0.95, .55, 1, col = hsv(2/3, 0.5, 1)) % rect(.90, .95, 1, 1, col = hsv(2/3, 1, 1)) % text(-1, .33, "significant", pos = 4, cex = 1.2) % rect(-1, .20, -.80, .30, col = hsv(0, 1, 1)) % rect(-.40, .20, -0.6, .30, col = hsv(0, 0.5, 1)) % rect(-.20, .20, 0, .30, col = hsv(0, 0, 1)) % rect(0, .20, .20, .30, col = hsv(2/3, 0, 1)) % rect(0.4, .20, .60, .30, col = hsv(2/3, .5, 1)) % rect(.80, .20, 1, .30, col = hsv(2/3, 1, 1)) % lines(c(-.9, -.55), c(0.975, .975), lty = 2) % lines(c(-.45, -.05), c(0.975, .975), lty = 2) % lines(c(.45, .05), c(0.975, .975), lty = 2) % lines(c(.9, .55), c(0.975, .975), lty = 2) % ## non-significant colors % rect(-1, 0.5, -.90, 0.55, col = hsv(0, 1, 0.5)) % rect(-0.4, 0.5, -.55, 0.55, col = hsv(0, 0.5, 0.5)) % rect(-.05, .5, .05, 0.55, col = hsv(2/3, 0, 0.5)) % rect(0.45, 0.5, .55, 0.55, col = hsv(2/3, 0.5, 0.5)) % rect(.90, .5, 1, 0.55, col = hsv(2/3, 1, 0.5)) % text(-1, .13, "non-significant", pos = 4, cex = 1.2) % rect(-1, 0, -.80, .10, col = hsv(0, 1, 0.5)) % rect(-.60, 0, -.4, .10, col = hsv(0, 0.5, 0.5)) % rect(-.20, 0, 0, .10, col = hsv(0, 0, 0.5)) % rect(0, 0, .20, .10, col = hsv(2/3, 0, 0.5)) % rect(0.4, 0, .60, .1, col = hsv(2/3, .5, 0.5)) % rect(.80, 0, 1, .10, col = hsv(2/3, 1, 0.5)) % lines(c(-.9, -.55), c(0.525, .525), lty = 2) % lines(c(-.45, -.05), c(0.525, .525), lty = 2) % lines(c(.45, .05), c(0.525, .525), lty = 2) % lines(c(.9, .55), c(0.525, .525), lty = 2) % @ % <>= % ## generate colors % hue260 <- hue.slice(260, grid.n = 101, plot = FALSE) % hue360 <- hue.slice(360, grid.n = 101, plot = FALSE) % mychroma <- as.numeric(colnames(hue260)) % luminance <- as.numeric(rownames(hue260)) % ## select those with lumincance >= 50 % hue260 <- hue260[luminance >= 50, ] % hue360 <- hue360[luminance >= 50, ] % luminance <- luminance[luminance >= 50] % nc <- ncol(hue260) % nl <- nrow(hue260) % ## plot 2 slides from HCL space % plot(0.5, 0.5, xlim = c(-100, 100), ylim = c(0, 100), type = "n", axes = FALSE, % xlab = "", ylab = "", yaxs = "i", xaxs = "i", main = "") % for(i in 1:(nc-1)) { % rect(mychroma[i], luminance[-nl], mychroma[i] + 100/(nc-1), luminance[-1], border = hue260[,i+1], col = hue260[,i+1]) % } % for(i in 1:(nc-1)) { % rect(-mychroma[i], luminance[-nl], -(mychroma[i] + 100/(nc-1)), luminance[-1], border = hue360[,i+1], col = hue360[,i+1]) % } % axis(2, at = c(50, 70, 90, 100), labels = c(50, 70, 90, 100)) % axis(4, at = c(50, 70, 90, 100), labels = c(50, 70, 90, 100)) % axis(3, at = -4:4*25, labels=c(4:0*25, 1:4*25)) % mtext(c("hue = 0", "hue = 260"), side = 3, at = c(-50, 50), line = 3, cex = 1.2) % mtext("chroma", side = 3, at = 0, line = 2) % mtext("luminance", side = 2, at = 75, line = 2) % mtext("luminance", side = 4, at = 75, line = 2) % lines(c(-100, 100), c(50, 50)) % ## significant colors % rect(-100, 47.5, -90, 52.5, col = hcl(0, 100, 50)) % rect(-55, 67.5, -45, 72.5, col = hcl(0, 50, 70)) % rect(-5, 95, 5, 100, col = hcl(260, 0, 100)) ## grey vs. white % rect(-5, 87.5, 5, 92.5, col = hcl(260, 0, 90)) ## grey vs. white % rect(45, 67.5, 55, 72.5, col = hcl(260, 50, 70)) % rect(90, 47.5, 100, 52.5, col = hcl(260, 100, 50)) % text(-100, 33, "significant", pos = 4, cex = 1.2) % rect(-100, 20, -80, 30, col = hcl(0, 100, 50)) % rect(-60, 20, -40, 30, col = hcl(0, 50, 70)) % rect(-20, 20, 0, 30, col = hcl(0, 0, 90)) % rect(0, 20, 20, 30, col = hcl(260, 0, 90)) % #white# rect(-20, 20, 0, 30, col = hcl(0, 0, 100)) % #white# rect(0, 20, 20, 30, col = hcl(260, 0, 100)) % rect(40, 20, 60, 30, col = hcl(260, 50, 70)) % rect(80, 20, 100, 30, col = hcl(260, 100, 50)) % lines(c(-45, -5), c(72.5, 87.5), lty = 2) % lines(c(45, 5), c(72.5, 87.5), lty = 2) % lines(c(-95, -55), c(52.5, 67.5), lty = 2) % lines(c(95, 55), c(52.5, 67.5), lty = 2) % ## non-significant colors % rect(-25, 47.5, -15, 52.5, col = hcl(0, 20, 50)) % rect(-15, 67.5, -5, 72.5, col = hcl(0, 10, 70)) % rect(5, 67.5, 15, 72.5, col = hcl(260, 10, 70)) % rect(25, 47.5, 15, 52.5, col = hcl(260, 20, 50)) % text(-100, 13, "non-significant", pos = 4, cex = 1.2) % rect(-60, 0, -40, 10, col = hcl(0, 20, 50)) % rect(-40, 0, -20, 10, col = hcl(0, 10, 70)) % rect(-20, 0, 0, 10, col = hcl(0, 0, 90)) % rect(0, 0, 20, 10, col = hcl(260, 0, 90)) % rect(20, 0, 40, 10, col = hcl(260, 10, 70)) % rect(40, 0, 60, 10, col = hcl(260, 20, 50)) % lines(c(-18.75, -11.25), c(52.5, 67.5), lty = 2) % lines(c(-8.75, -1.25), c(72.5, 87.5), lty = 2) % lines(c(18.75, 11.75), c(52.5, 67.5), lty = 2) % lines(c(8.75, 1.25), c(72.5, 87.5), lty = 2) % @ % \caption{Residual-based shadings in HSV (upper) and HCL space (lower).} % \label{fig:shadingHSVHCL} % \end{center} % \end{figure} A more ``advanced'' function building upon \codefun{shading\_hcl} is \codefun{shading\_max}, using the maximum statistic both to conduct the independence test and to visualize significant \emph{cells} causing the rejection of the independence hypothesis \citep{vcd:Meyer+Zeileis+Hornik:2003,vcd:Zeileis+Meyer+Hornik:2007}. The \code{level} argument of \codefun{shading\_max} then can be used to specify several confidence levels from which the corresponding cut-off points are computed. By default, two cut-off points are computed corresponding to confidence levels of $90\%$ and $99\%$, respectively. In the following example, we investigate the effect of a new treatment for rheumatoid arthritis on a group of female patients using the maximum shading (see Figure~\ref{fig:maximum}): <>= set.seed(4711) mosaic(~ Treatment + Improved, data = Arthritis, subset = Sex == "Female", gp = shading_max) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{The \data{Arthritis} data (female patients) with significant maximum test.} \label{fig:maximum} \end{center} \end{figure} \noindent The maximum test is significant although the residuals are all in the $\left[-2,2\right]$ interval. The \codefun{shading\_hcl} function with default cut-off points would not have shown any color. In addition, since the test statistic is the maximum of the absolute Pearson residuals, \emph{each} colored residual violates the null hypotheses of independence, and thus, the ``culprits'' can immediately be identified. \clearpage \section[Labeling]{Labeling} \label{sec:labeling} One of the major enhancements in package \pkg{vcd} compared to \codefun{mosaicplot} and \codefun{assocplot} in base \proglang{R} is the labeling in the strucplot framework which offers more features and greater flexibility. Like shading, spacing, and drawing of legend and core plot, labeling is now carried out by grapcon functions, rendering labeling completely modular. The user supplies either a labeling function, or, alternatively, a generating function that parameterizes a labeling function, to \codefun{strucplot} which then draws the labels. Labeling is well-separated from the actual plotting that occurs in the low-level core functions. It only relies on the viewport tree produced by them, and the \code{dimnames} attribute of the visualized table. Labeling functions are grapcons that ``add ink to the canvas'': the drawing of the labels happens after the actual plot has been drawn by the core function. Thus, it is possible to supply one's own labeling function, or to combine some of the basic functions to produce a more complex labeling. In the following, we describe the three basic modules (\codefun{labeling\_text}, \codefun{labeling\_list}, and \codefun{labeling\_cells}) and derived functions that build upon them. \subsection[Labels in the borders]{Labels in the borders: \texttt{labeling\_text()}} \codefun{labeling\_text} is the default for all strucplot displays. It plots labels in the borders similar to the \codefun{mosaicplot} function in base \proglang{R}, but is much more flexible: it is not limited to 4 dimensions, and the positioning and graphical parameters of levels and variable names are customizable. In addition, the problem of overlapping labels can be handled in several ways. As an example, again consider the \data{Titanic} data: by default, the variable names and levels are plotted ``around'' the plot in a counter-clockwise way (see Figure~\ref{fig:labels1}, top left): <>= mosaic(Titanic) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{Mosaic plot for the \data{Titanic} data with default settings % for labeling.} % \label{fig:defaults} % \end{center} % \end{figure} \noindent Note that the last two levels of the \code{survived} variable do overlap, as well as some adult and child labels of the \code{age} Variable. This issue can be addressed in several ways. The ``brute force'' method is to enable clipping for these dimensions (see Figure~\ref{fig:labels1}, top right): <>= mosaic(Titanic, labeling_args = list(clip = c(Survived = TRUE, Age = TRUE))) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{The effect of clipping.} % \label{fig:clipping} % \end{center} % \end{figure} \noindent The \code{clip} parameter is passed to the labeling function via the \code{labeling\_args} argument which takes a list of parameters. \code{clip} itself takes a vector of logicals (one for each dimension). % as mentioned before Almost all vectorized arguments in the strucplot framework can be abbreviated in the following way: unnamed components (or the defaults, if there are none) are recycled as needed, but overridden by the named components. Here, the default is \code{FALSE}, and therefore clipping is enabled only for the \code{survived} and \code{age} variables. A more sensible solution to the overlap problem is to abbreviate the levels (see Figure~\ref{fig:labels1}, middle left): <>= mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = TRUE, Age = 3))) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Abbreviating.} % \label{fig:abbreviating} % \end{center} % \end{figure} \noindent The \code{abbreviate} argument takes a vector of integers indicating the number of significant characters the levels should be abbreviated to (\code{TRUE} is interpreted as 1, obviously). Abbreviation is performed using the \codefun{abbreviate} function in base \proglang{R}. Another possibility is to rotate the levels (see Figure~\ref{fig:labels1}, bottom): <>= mosaic(Titanic, labeling_args = list(rot_labels = c(bottom = 90, right = 0), offset_varnames = c(right = 1), offset_labels = c(right = 0.3)), margins = c(right = 4, bottom = 3)) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{Rotating labels.} % \label{fig:rotating} % \end{center} % \end{figure} \noindent Finally, we could also inhibit the output of repeated levels (see Figure~\ref{fig:labels1}, middle right): <>= mosaic(Titanic, labeling_args = list(rep = c(Survived = FALSE, Age = FALSE))) @ \setkeys{Gin}{width=0.9\textwidth} \begin{figure}[p] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2,nrow=3))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(Titanic, newpage = FALSE, keep = TRUE, margin = c(right = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(clip = c(Survived = TRUE, Age = TRUE)), newpage = FALSE, keep = TRUE, margin = c(left = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = TRUE, Age = 2)), newpage = FALSE, keep = TRUE, margin = c(right = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(rep = c(Survived = FALSE, Age = FALSE)), newpage = FALSE, keep = TRUE, margin = c(left = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1:2, layout.pos.row = 3)) pushViewport(viewport(width = 0.55)) mosaic(Titanic, labeling_args = list(rot_labels = c(bottom = 90, right = 0), offset_varnames = c(right = 1), offset_labels = c(right = 0.3)), margins = c(right = 4, bottom = 3), newpage = FALSE, keep = FALSE, gp_labels = gpar(fontsize = 10)) popViewport(3) @ \caption{Examples for possible labeling strategies for the Titanic data mosaic. Top left: default labeling (many labels overlap). Top right: with clipping turned on. Middle left: \texttt{Age} and \texttt{Survived} labels abbreviated. Middle right: \texttt{Age} labels not repeated. Bottom: \texttt{Age} and \texttt{Survived} labels rotated.} \label{fig:labels1} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} We now proceed with a few more ``cosmetic'' features (which do not all produce satisfactory results for our sample data). A first simple, but effectful modification is to position all labels and variables left-aligned (see Figure~\ref{fig:labels2}, top left): <>= mosaic(Titanic, labeling_args = list(pos_varnames = "left", pos_labels = "left", just_labels = "left", rep = FALSE)) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Left-aligning.} % \label{fig:left} % \end{center} % \end{figure} \noindent Note that obviously we need to change the justification to \code{"left"} as well. We can achieve the same effect by using the convenience function \codefun{labeling\_left}: <>= mosaic(Titanic, labeling = labeling_left) @ \noindent Next, we show how to put all levels to the bottom and right margins, and all variable names to the top and left margins (see Figure~\ref{fig:labels2}, top right): <>= mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, abbreviate_labs = c(Survived = 1, Age = 3))) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{Changes in the margins.} % \label{fig:margins} % \end{center} % \end{figure} \noindent The tl\_\var{foo} (``top left'') arguments are \code{TRUE} by default. Now, we will add boxes to the labels and additionally enable clipping (see Figure~\ref{fig:labels2}, bottom left): <>= mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, boxes = TRUE, clip = TRUE)) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{Boxes and Clipping.} % \label{fig:boxes} % \end{center} % \end{figure} \noindent The values to \code{boxes} and \code{clip} are recycled for all dimensions. The result is pretty close to what calling \codefun{mosaic} with the \codefun{labeling\_cboxed} wrapper does, except that variables and levels, by default, are put to the top and to the left of the plot: <>= mosaic(Titanic, labeling = labeling_cboxed) @ \noindent Another variant is to put the variable names into the same line as the levels (see Figure~\ref{fig:labels2}, bottom right---clipping for \code{Survived} and \code{Age} is, additionally, disabled, and \code{Age} abbreviated): <>= mosaic(Titanic, labeling_args = list(tl_labels = TRUE, boxes = TRUE, clip = c(Survived = FALSE, Age = FALSE, TRUE), abbreviate_labs = c(Age = 4), labbl_varnames = TRUE), margins = c(left = 4, right = 1, 3)) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Variable names beneath levels, and clipping disabled for the % survival variable.} % \label{fig:labbl} % \end{center} % \end{figure} \noindent \code{labbl\_varnames} (``variable names to the bottom/left of the labels'') is a vector of logicals indicating the side for the variable names. The resulting layout is close to what \codefun{labeling\_lboxed} produces, except that variables and levels, by default, are left-aligned and put to the bottom and to the right of the plot: <>= mosaic(Titanic, labeling = labeling_lboxed, margins = c(right = 4, left = 1, 3)) @ \noindent A similar design is used by the \codefun{doubledecker} function. \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(pos_varnames = "left", pos_labels = "left", just_labels = "left", rep = FALSE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, abbreviate_labs = c(Survived = 1, Age = 3)), newpage = FALSE, keep = TRUE, margins = c(left = 4, right = 1, 3), gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, boxes = TRUE, clip = TRUE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(tl_labels = TRUE, boxes = TRUE, clip = c(Survived = FALSE, Age = FALSE, TRUE), labbl_varnames = TRUE, abbreviate_labs = c(Age = 4)), margins = c(left = 4, right = 1, 3), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport(2) @ \caption{Advanced strategies for labeling of the Titanic data. Top left: left aligning of both variable names and labels. Top right: changes in the margins (all variable names are in the top and left margins, and all labels in the bottom and right margins). Bottom left: clipping turned on, and boxes used. Bottom right: variable names beneath levels, clipping disabled for the survival and age variables, and \texttt{Age} abbreviated.} \label{fig:labels2} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \subsection[Labels in the cells]{Labels in the cells: \texttt{labeling\_cells()}} This labeling draws both variable names and levels in the cells. As an example, we use the \data{PreSex} data on pre- and extramarital sex and divorce (see Figure~\ref{fig:labels3}, top left): <>= mosaic(~ MaritalStatus + Gender, data = PreSex, labeling = labeling_cells) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Cell labeling for the \data{PreSex} data.} % \label{fig:cell} % \end{center} % \end{figure} \noindent In the case of narrow cells, it might be useful to abbreviate labels and/or variable names and turn off clipping (see Figure~\ref{fig:labels3}, top right): <>= mosaic(~ PremaritalSex + ExtramaritalSex, data = PreSex, labeling = labeling_cells(abbreviate_labels = TRUE, abbreviate_varnames = TRUE, clip = FALSE)) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Cell labeling for the \data{PreSex} data, labels abbreviated.} % \label{fig:cell2} % \end{center} % \end{figure} \noindent For some data, it might be convenient to combine cell labeling with border labeling as done by \codefun{labels\_conditional} (see Figure~\ref{fig:labels3}, bottom left): <>= mosaic(~ PremaritalSex + ExtramaritalSex | MaritalStatus + Gender, data = PreSex, labeling = labeling_conditional(abbreviate_varnames = TRUE, abbreviate_labels = TRUE, clip = FALSE, gp_text = gpar(col = "red"))) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Conditional labeling for the \data{PreSex} data, labels (in % red for clarity) abbreviated.} % \label{fig:conditional} % \end{center} % \end{figure} \noindent Additionally, the cell labeling allows the user to add arbitrary text to the cells by supplying a character array in the same shape as the data array to the \code{text} argument (cells with missing values are ignored). In the following example using the \code{Titanic} data, this is used to add all observed values greater than 5 to the cells after the mosaic has been plotted (see Figure~\ref{fig:labels3}, bottom right): <>= mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = 1, Age = 4)), pop = FALSE) tab <- ifelse(Titanic < 6, NA, Titanic) labeling_cells(text = tab, clip = FALSE)(Titanic) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{User-supplied text (observed frequencies exceeding 5) % added to a mosaic display of the \data{Titanic} data.} % \label{fig:text} % \end{center} % \end{figure} \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= grid.newpage() pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(~ MaritalStatus + Gender, data = PreSex, labeling = labeling_cells, newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(~ PremaritalSex + ExtramaritalSex, data = PreSex, labeling = labeling_cells(abbreviate_labels = TRUE, abbreviate_varnames = TRUE, clip = FALSE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(~ PremaritalSex + ExtramaritalSex | MaritalStatus + Gender, data = PreSex, labeling = labeling_conditional(abbreviate_varnames = TRUE, abbreviate_labels = TRUE, clip = FALSE, gp_text = gpar(col = "red")), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = 1, Age = 3)), pop = FALSE, newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) tab <- ifelse(Titanic < 6, NA, Titanic) labeling_cells(text = tab, clip = FALSE)(Titanic) @ \caption{Cell labeling. Top left: default labeling using the \data{PreSex} data. Top right: abbreviated labels. Bottom left: conditional labeling (labels abbreviated and in red for clarity). Bottom right: user-supplied text (observed frequencies exceeding 5) added to a mosaic display of the \data{Titanic} data. Note that clipping is on by default (top left), and has explicitly been turned off for the three other plots.} \label{fig:labels3} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \subsection[A simple list of labels]{A simple list of labels: \texttt{labeling\_list()}} If problems with overlapping labels cannot satisfactorily resolved, the last remedy could be to simply list the levels below the plot (see Figure~\ref{fig:list}): <>= mosaic(Titanic, labeling = labeling_list, margins = c(bottom = 5)) @ \setkeys{Gin}{width=0.7\textwidth} \begin{figure}[p] \begin{center} <>= mosaic(Titanic, labeling = labeling_list, margins = c(bottom = 5), keep = TRUE) @ \caption{Labels indicated below the plot.} \label{fig:list} \end{center} \end{figure} \noindent The number of columns can be specified. \section{Spacing} \label{sec:spacing} Spacing of strucplot displays is customizable in a similar way than shading. The \code{spacing} argument of the \codefun{strucplot} function takes a list of \class{unit} vectors, one for each dimension, specifying the space between the tiles corresponding to the levels. Consider again the introductory example of the \data{Arthritis} data (Figure~\ref{fig:arthritis}). Since we are interested in the effect of the medicament in the placebo and treatment groups, a mosaic plot is certainly appropriate to visualize the three levels of \code{Improved} in the two \code{Treatment} strata. Another conceptual approach is to use spine plots with highlighting \citep{vcd:hummel:1996}. A spine plot is a variation of a bar plot where the heights of the bars are held constant, whereas the widths are used to represent the number of cases in each category. This is equivalent to a mosaic plot for a one-way table. If a second (indicator) variable is highlighted in a spine plot, we obtain a display equivalent to a simple mosaic display for a two-way table, except that no space between the levels of the highlighted variable is used. In the \data{Arthritis} example, we will highlight patients with \code{Marked} improvement in both groups. To obtain such a display within the strucplot framework, it suffices to set the space between the \code{Improved} tiles to 0 (see Figure~\ref{fig:artspine}): <>= (art <- structable(~Treatment + Improved, data = Arthritis, split_vertical = TRUE)) (my_spacing <- list(unit(0.5, "lines"), unit(c(0, 0), "lines"))) my_colors <- c("lightgray", "lightgray", "black") mosaic(art, spacing = my_spacing, gp = gpar(fill = my_colors, col = my_colors)) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Spine plot for the \data{Arthritis} data using the strucplot framework.} \label{fig:artspine} \end{center} \end{figure} \noindent Note that the default and formula methods for \codefun{mosaic} provide a convenience interface for highlighting. A similar plot (with slightly different shading) than the previous one can be obtained using: <>= mosaic(Improved ~ Treatment, data = Arthritis, split_vertical = TRUE) @ \noindent The strucplot framework also provides a set of spacing grapcon generators which compute suitable spacing objects for typical applications. The simplest spacing is \codefun{spacing\_equal} that uses the same space between all tiles (see Figure~\ref{fig:spacing}, top left): <>= mosaic(art, spacing = spacing_equal(unit(2, "lines"))) @ \noindent \codefun{spacing\_equal} is the default grapcon generator for two-dimensional tables. Slightly more flexible is \codefun{spacing\_dimequal} that allows an individual setting for each dimension (see Figure~\ref{fig:spacing}, top right): <>= mosaic(art, spacing = spacing_dimequal(unit(1:2, "lines"))) @ \noindent The default for multi-way contingency tables is \codefun{spacing\_increase} which uses increasing spaces for the dimensions. The user can specify a start value and the increase factor (see Figure~\ref{fig:spacing}, bottom left): <>= mosaic(art, spacing = spacing_increase(start = unit(0.5, "lines"), rate = 1.5)) @ \noindent For the arthritis example above, we could as well have used \codefun{spacing\_highlighting} which is similar to \codefun{spacing\_increase} but sets the spacing in the last splitting dimension to 0 (see Figure~\ref{fig:spacing}, bottom right): <>= mosaic(art, spacing = spacing_highlighting, gp = my_colors) @ \noindent Finally, \codefun{spacing\_conditional} can be used for visualizing conditional independence: it combines \codefun{spacing\_equal} (for the conditioned dimensions) and \codefun{spacing\_increase} (for the conditioning dimensions). As an example, consider Figure~\ref{fig:presex}: the spacing clearly allows to better distinguish the conditioning variables (\code{Gender} and \code{MaritalStatus}) from the conditioned variables (\code{PremaritalSex} and \code{ExtramaritalSex}). This spacing is the default when conditional variables are specified for a strucplot display (see Section \ref{sec:strucplot}). \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(art, spacing = spacing_equal(unit(2, "lines")), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(art, spacing = spacing_dimequal(unit(c(0.5, 2), "lines")), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(art, spacing = spacing_increase(start = unit(0.3, "lines"), rate = 2.5), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(art, spacing = spacing_highlighting, keep = TRUE, newpage = FALSE) popViewport(2) @ \caption{Varying spacing for the Arthritis data. Top left: equal spacing for all dimensions. Top right: different spacings for individial dimensions. Bottom left: increasing spacing. Bottom right: spacing used for highlighting.} \label{fig:spacing} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \section{Example: Ovarian cancer survival} \label{sec:example} In the following, we demonstrate some of the described techniques in analyzing a data set originating from \citep{vcd:obel:1975} \cite[taken from][]{vcd:andersen:1991} about a retrospective study of ovary cancer carried out in 1973. Information was obtained from 299 women, who were operated for ovary cancer 10 years before. The data consists of four binary variables: the \code{stage} of the cancer at the time of operation (levels: \code{early}, \code{advanced}), the type of \code{operation} performed (\code{radical}, \code{limited}), the \code{survival} status after 10 years (\code{yes}, \code{no}), and \code{xray} indicating whether X-ray treatment was received (\code{yes}, \code{no}). The dataset in \pkg{vcd} comes pretabulated in a data frame, so we first create the four-way table: <>= tab <- xtabs(Freq ~ stage + operation + xray + survival, data = OvaryCancer) @ \noindent A ``flattened'' textual representation can be obtained using \codefun{structable}: <>= structable(survival ~ ., data = tab) @ \noindent A first overview can be obtained using a pairs plot (Figure~\ref{fig:ocpairs}): <>= dpa <- list(var_offset = 1.2, rot = -30, just_leveltext= "left") pairs(tab, diag_panel = pairs_barplot, diag_panel_args = dpa) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{Pairs plot for the \data{OvaryCancer} data showing mosaic displays for all pairwise distributions and bar plots for all marginal distributions.} \label{fig:ocpairs} \end{center} \end{figure} \noindent The pairs plot, by default, creates mosaic displays for all pairwise variable combinations, and bar plots in the diagonal to visualize the absolute frequencies of the variables. The \texttt{var\_offset} argument modifies the offset of the (centered) variable names to avoid overlap with the bars. Additionally, we use the \texttt{rot} and the \texttt{just\_leveltext} arguments to rotate the level names, again to avoid their overlap. First, we consider the marginal distributions. The study design involved (nearly) the same number of survived (150) and deceased (149) patients. Similarly balanced, 158 cases were in an advanced and 141 in an early stage. Most patients (251, 84\%) were treated with a radical operation, and 186 (62\%) were submitted to X-ray treatment. Next, we inspect the two-way interaction of the influencing factors (\code{stage}, \code{operation}, and \code{xray}): the corresponding mosaics exhibit symmetric, regular shapes with aligned tiles, which indicate no marginal interaction between these variables. The same is true for the interactions of \code{survival} with \code{operation} and \code{xray}, respectively. Only the stage seems to influence survival: here, the tiles are ``shifted''. A different view on the data, focused on the influence of the explanatory variables on \code{Survival}, can be obtained using a doubledecker plot (Figure~\ref{fig:ocdoubledecker}): <>= doubledecker(survival ~ stage + operation + xray, data = tab) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{Doubledecker plot for the \data{OvaryCancer} data showing the conditional distribution of X-ray, given operation, given stage, and with survival highlighted.} \label{fig:ocdoubledecker} \end{center} \end{figure} \noindent From a technical point of view, the display is constructed as a mosaic plot showing the conditional distribution of \code{survival}, given \code{xray}, given \code{operation}, given \code{stage}, with vertical splits for the conditioning variables and horizontal ones for \code{survival}. Additionally, there is zero space between the tiles of the last dimension and a binary shading is used for survived and deceased patients. Conceptually, this plot is interpreted as a mosaic plot of just the influencing variables, with \code{survival} highlighted in the tiles. Thus, the plot really shows the influence of the explanatory variables on \code{survival}. Clearly, the survival rate is higher among patients in an early stage, but neither radical operation nor X-ray treatment seem to improve the situation. From this exploratory phase, the survival rate seems to be slightly higher for patients who received a limited operation only, whereas the effect for X-ray treatment is less marked. To visualize inference results, we can make use of residual-based shadings, investigating log-linear models for the four-way table. Figure~\ref{fig:ocmosaicnull} visualizes the null model, where survival is independent from the combined effect of operation, X-ray treatment, and stage: <>= split <- c(TRUE, TRUE, TRUE, FALSE) mosaic(tab, expected = ~ survival + operation * xray * stage, split_vertical = split) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{OvaryCancer} data, with residual-based shading for the (clearly rejected) null model (survival)(operation, X-ray, stage).} \label{fig:ocmosaicnull} \end{center} \end{figure} \noindent The model is clearly rejected ($p$-value: 0.000). From the exploratory phase of our analysis, we (only) suspect \code{stage} to be influential on the survival rate. A corresponding hypothesis is that \code{survival} be independent of \code{xray} and \code{operation}, given \code{stage}. The model is specified using the \texttt{expected} argument, either using the \codefun{loglin} interface or the \codefun{loglm} formula interface (the resulting mosaic plot is shown in Figure \ref{fig:ocmosaicstage}): <>= mosaic(tab, expected = ~ (survival + operation * xray) * stage, split_vertical = split) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{OvaryCancer} data, with residual-based shading for the hypothesis of survival being independent of X-ray and operation, given stage. The hypothesis is not rejected.} \label{fig:ocmosaicstage} \end{center} \end{figure} \noindent Thus, based on this data, only pre-diagnosis seems to matter in ovarian cancer therapy. \section{Conclusion} \label{sec:conclusion} In this paper, we describe the ``strucplot'' framework for the visualization of multi-way contingency tables. Strucplot displays include popular basic plots such as mosaic, association, and sieve plots, integrated in a unified framework: all can be seen as visualizations of hierarchical conditional flat tables. Additionally, these core strucplot displays can be combined into more complex, specialized plots, such as pairs and trellis-like displays for visualizing conditional independence. Residual-based shadings permit the visualization of log-linear models and the results of independence tests. The framework's modular design allows flexible customization of the plots' graphical appearance, including shading, labeling, spacing, and legend, by means of graphical appearance control (``grapcon'') functions. These ``graphical hyperparameters'' are customized and created by generating functions. Our work includes a set of predefined grapcon generators for typical analysis tasks, and user-level extensions can easily be added. \bibliography{vcd} \begin{appendix} \section{Data sets} \label{sex:data} The data set names in the paper are those from the \proglang{R} system. In the following, we give a short description of each data set. \begin{description} \item[\texttt{Arthritis}] Data from a double-blind clinical trial investigating a new treatment for rheumatoid arthritis. Source: \cite{vcd:Koch+Edwards:1988}. Taken from: \cite{vcd:Friendly:2000}. Package: \pkg{vcd}. \item[\texttt{Bundesliga}] Results from the first German soccer league in the years 1995/6 \citep{vcd:Knorr-Held:1999} and 2001/2 (Collected by: Achim Zeileis). Package: \pkg{vcd}. \item[\texttt{HairEyeColor}] Distribution of hair and eye color and gender in 592 statistics students. The gender information is artificial. Source: \cite{vcd:Snee:1974}. Taken from: \cite{vcd:Friendly:2000}. Package: \pkg{datasets} (included in base \proglang{R}). \item[\texttt{OvaryCancer}] Data about a retrospective study of ovary cancer carried out in 1973. Information was obtained from 299 women, who were operated for ovary cancer 10 years before. Source: \cite{vcd:obel:1975}. Taken fromn: \cite{vcd:andersen:1991}. Package: \pkg{vcd}. \item[\texttt{PreSex}] Data on pre- and extra-marital sex and divorce. Source: \cite{vcd:thornes+collard:1979}. Taken from \cite{vcd:gilbert:1981}. Package: \pkg{vcd}. \item[\texttt{Titanic}] Information on the fate of passengers on the fatal maiden voyage of the ocean liner ``Titanic'', summarized according to economic status (class), gender (\code{Sex}), age and survival. Data originally collected by the British Board of Trade in their investigation of the sinking. Taken from: \cite{vcd:dawson:1995}. Package: \pkg{datasets} (included in base \proglang{R}). \item[\texttt{UCBAdmissions}] Aggregate data on applicants to graduate school at Berkeley for the six largest departments in 1973 classified by admission and gender. Source: \cite{vcd:Bickel+Hammel+O'Connell:1975}. Taken from: \cite{vcd:Friendly:2000}. Package: \pkg{datasets} (included in base \proglang{R}). \end{description} \end{appendix} \end{document} vcd/vignettes/struc.pdf0000755000175000017500000000622011720273432015027 0ustar nileshnilesh%PDF-1.4 % 1 0 obj << /Length 2 0 R /Filter /FlateDecode >> stream xZn7 ?l99Hrv$ ?;A /=CɥZIP "ݬ.6əˋ Ya!jU_ȿvy!"LN//Y,6Hh ƶNيȽŝpX470/kj4~r-.eQCx4 |6RIᢾaBZ[F$'%8+[~U[uR[K@L]tcҡú7Ӵ6VgwBu(HqkWiK1uґF[K@o$T'j2kHA6ĢĐNWd#@c6ZJl`)cVٸF0@еXh>NuA?Q`~E[JJ) -b-[yy ƕҀ~L~iiuuPiIn00-ݨJ.jS~#S(^" YQm"PSvg[*C3*Ne ~*=zKek08-RzY cAm3yAF3s),>7l^Z")h&n ٣LIkkFr^Z3%E%vmk(;,*XK憣Ξn?ⅅ3LӷҜ9E#:{h5lg!䰩\j鷣mN1,#QFvhMBp[cl嚢((.)oW좵ۀٷXw";!B%x5*Z-tM^?푉׫[wHδe!]=Wix09Es{kp5 R.l'DodP"!YFh-UdYrB;qڣaJSvR(AT^ -,na&Qr!t  \\UӸDtPt-3ݘslHAVsF@{Tf!.Sڳ 埝'n5n']y<,i|-xѰ&ؒl9ǩs5K( gsņaqRR$+ܕ< zֺ'-]{=`_Cby3?a:H}22Ԉ+cMBܘ0>5 Q 1DN!S=A”Duibj/VZT_f~5@Mx#CkƸF+sG/h<,p @4^SL2:QI'4#w}Ǘ v35 O kڻq:2H/k:o^a{ͣQ'}nLQ˟+?YgX< ݨy:,Ҩ1);mG@cEI7%.`4ڨUҏyB3|SWS܉1mZ@X#d~TƔJ_&endstream endobj 2 0 obj 1891 endobj 4 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Courier /Encoding /WinAnsiEncoding >> endobj 5 0 obj << /Type /Font /Subtype /Type1 /BaseFont /Helvetica /Encoding /WinAnsiEncoding >> endobj 6 0 obj << /F1 5 0 R /F2 4 0 R >> endobj 7 0 obj << /Font 6 0 R /ProcSet [ /PDF ] >> endobj 8 0 obj << /Type /Page /Parent 3 0 R /Resources 7 0 R /MediaBox [ 0 0 794 595 ] /Contents 1 0 R >> endobj 3 0 obj << /Type /Pages /Resources 7 0 R /MediaBox [ 0 0 595 842 ] /Kids [ 8 0 R ] /Count 1 >> endobj 9 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 10 0 obj << /Creator /Producer /CreationDate (D:20051019112228+02'00') >> endobj xref 0 11 0000000000 65535 f 0000000017 00000 n 0000001993 00000 n 0000002495 00000 n 0000002020 00000 n 0000002133 00000 n 0000002248 00000 n 0000002302 00000 n 0000002367 00000 n 0000002631 00000 n 0000002690 00000 n trailer << /Size 11 /Root 9 0 R /Info 10 0 R >> startxref 2901 %%EOF vcd/vignettes/vcd.bib0000644000175000017500000006167413553245010014436 0ustar nileshnilesh%% general graphics & original methods @Article{vcd:Cohen:1980, author = {A. Cohen}, title = {On the Graphical Display of the Significant Components in a Two-Way Contingency Table}, journal = {Communications in Statistics---Theory and Methods}, year = {1980}, volume = {A9}, pages = {1025--1041} } @InProceedings{vcd:Hartigan+Kleiner:1981, author = {J. A. Hartigan and B. Kleiner}, title = {Mosaics for Contingency Tables}, booktitle = {Computer Science and Statistics: Proceedings of the 13th Symposium on the Interface}, pages = {268--273}, year = {1981}, editor = {W. F. Eddy}, address = {New York}, publisher = {Springer-Verlag} } @Article{vcd:Hartigan+Kleiner:1984, author = {J. A. Hartigan and B. Kleiner}, title = {A Mosaic of Television Ratings}, journal = {The American Statistician}, year = {1984}, volume = {38}, pages = {32--35} } @TechReport{vcd:Young:1996, author = {Forrest W. Young}, title = {{\pkg{ViSta}}: The Visual Statistics System}, institution = {UNC L.~L.~Thurstone Psychometric Laboratory Research Memorandum}, year = 1996, number = {94--1(c)} } @Book{vcd:Cleveland:1993, author = {William S. Cleveland}, title = {Visualizing Data}, publisher = {Hobart Press}, year = 1993, address = {Summit, New Jersey} } @Article{vcd:Becker+Cleveland+Shyu:1996, author = {Richard A. Becker and William S. Cleveland and Ming-Jen Shyu}, title = {The Visual Design and Control of Trellis Display}, journal = {Journal of Computational and Graphical Statistics}, year = {1996}, volume = {5}, pages = {123--155} } @InProceedings{vcd:Riedwyl+Schuepbach:1994, author = {H. Riedwyl and M. Sch{\"u}pbach}, title = {Parquet Diagram to Plot Contingency Tables}, booktitle = {Softstat '93: Advances in Statistical Software}, pages = {293--299}, year = 1994, editor = {F. Faulbaum}, address = {New York}, publisher = {Gustav Fischer} } %% color @InProceedings{vcd:Ihaka:2003, author = {Ross Ihaka}, title = {Colour for Presentation Graphics}, booktitle = {Proceedings of the 3rd International Workshop on Distributed Statistical Computing, Vienna, Austria}, editor = {Kurt Hornik and Friedrich Leisch and Achim Zeileis}, year = {2003}, url = {http://www.ci.tuwien.ac.at/Conferences/DSC-2003/Proceedings/}, note = {{ISSN 1609-395X}}, } @Article{vcd:Lumley:2006, author = {Thomas Lumley}, title = {Color Coding and Color Blindness in Statistical Graphics}, journal = {ASA Statistical Computing \& Graphics Newsletter}, year = {2006}, volume = {17}, number = {2}, pages = {4--7} } @Book{vcd:Munsell:1905, author = {Albert H. Munsell}, title = {A Color Notation}, publisher = {Munsell Color Company}, year = {1905}, address = {Boston, Massachusetts} } @Article{vcd:Harrower+Brewer:2003, author = {Mark A. Harrower and Cynthia A. Brewer}, title = {\pkg{ColorBrewer.org}: An Online Tool for Selecting Color Schemes for Maps}, journal = {The Cartographic Journal}, year = {2003}, volume = {40}, pages = {27--37} } @InProceedings{vcd:Brewer:1999, author = {Cynthia A. Brewer}, title = {Color Use Guidelines for Data Representation}, booktitle = {Proceedings of the Section on Statistical Graphics, American Statistical Association}, address = {Alexandria, VA}, year = {1999}, pages = {55--60} } @Article{vcd:Cleveland+McGill:1983, author = {William S. Cleveland and Robert McGill}, title = {A Color-caused Optical Illusion on a Statistical Graph}, journal = {The American Statistician}, year = {1983}, volume = {37}, pages = {101--105} } @Book{vcd:CIE:2004, author = {{Commission Internationale de l'\'Eclairage}}, title = {Colorimetry}, edition = {3rd}, publisher = {Publication CIE 15:2004}, address = {Vienna, Austria}, year = {2004}, note = {{ISBN} 3-901-90633-9} } @InProceedings{vcd:Moretti+Lyons:2002, author = {Giovanni Moretti and Paul Lyons}, title = {Tools for the Selection of Colour Palettes}, booktitle = {Proceedings of the New Zealand Symposium On Computer-Human Interaction (SIGCHI 2002)}, address = {University of Waikato, New Zealand}, month = {July}, year = {2002} } @Article{vcd:MacAdam:1942, author = {D. L. MacAdam}, title = {Visual Sensitivities to Color Differences in Daylight}, journal = {Journal of the Optical Society of America}, year = {1942}, volume = {32}, number = {5}, pages = {247--274}, } @Book{vcd:Wyszecki+Stiles:2000, author = {G\"unter Wyszecki and W. S. Stiles}, title = {Color Science}, edition = {2nd}, publisher = {Wiley}, year = {2000}, note = {{ISBN} 0-471-39918-3} } @Misc{vcd:Poynton:2000, author = {Charles Poynton}, title = {Frequently-Asked Questions About Color}, year = {2000}, howpublished = {URL \url{http://www.poynton.com/ColorFAQ.html}}, note = {Accessed 2006-09-14}, } @Misc{vcd:Wiki+HSV:2006, author = {Wikipedia}, title = {{HSV} Color Space --- {W}ikipedia{,} The Free Encyclopedia}, year = {2006}, howpublished = {URL \url{http://en.wikipedia.org/w/index.php?title=HSV_color_space&oldid=74735552}}, note = {Accessed 2006-09-14}, } @Misc{vcd:Wiki+LUV:2006, author = {Wikipedia}, title = {{Lab} Color Space --- {W}ikipedia{,} The Free Encyclopedia}, year = {2006}, howpublished = {URL \url{http://en.wikipedia.org/w/index.php?title=Lab_color_space&oldid=72611029}}, note = {Accessed 2006-09-14}, } @Article{vcd:Smith:1978, author = {Alvy Ray Smith}, title = {Color Gamut Transform Pairs}, journal = {Computer Graphics}, pages = {12--19}, year = {1978}, volume = {12}, number = {3}, note = {ACM SIGGRAPH 78 Conference Proceedings}, } %% url = {http://www.alvyray.com/}, @Article{vcd:Meier+Spalter+Karelitz:2004, author = {Barbara J. Meier and Anne Morgan Spalter and David B. Karelitz}, title = {Interactive Color Palette Tools}, journal = {{IEEE} Computer Graphics and Applications}, volume = {24}, number = {3}, year = {2004}, pages = {64--72}, } %% url = {http://graphics.cs.brown.edu/research/color/} @InCollection{vcd:Mollon:1995, author = {J. Mollon}, editor = {T. Lamb and J. Bourriau}, booktitle = {Colour: Art and Science}, title = {Seeing Color}, publisher = {Cambridge Univesity Press}, year = 1995 } %% Friendly publications @Article{vcd:Friendly:1994, author = {Michael Friendly}, title = {Mosaic Displays for Multi-Way Contingency Tables}, journal = {Journal of the American Statistical Association}, year = {1994}, volume = {89}, pages = {190--200} } @Article{vcd:Friendly:1999, author = {Michael Friendly}, title = {Extending Mosaic Displays: Marginal, Conditional, and Partial Views of Categorical Data}, journal = {Journal of Computational and Graphical Statistics}, year = {1999}, volume = {8}, number = {3}, pages = {373--395} } @Book{vcd:Friendly:2000, author = {Michael Friendly}, title = {Visualizing Categorical Data}, publisher = {\textsf{SAS} Insitute}, year = {2000}, address = {Carey, NC}, URL = {http://www.datavis.ca/books/vcd/} } %% Augsburg publications @Article{vcd:Theus+Lauer:1999, author = {Martin Theus and Stephan R. W. Lauer}, title = {Visualizing Loglinear Models}, journal = {Journal of Computational and Graphical Statistics}, year = 1999, volume = 8, number = 3, pages = {396--412} } @Article{vcd:Hofmann:2003, author = {Heike Hofmann}, title = {Constructing and Reading Mosaicplots}, journal = {Computational Statistics \& Data Analysis}, year = {2003}, volume = {43}, pages = {565--580} } @Article{vcd:Hofmann:2001, author = {Heike Hofmann}, title = {Generalized Odds Ratios for Visual Modelling}, journal = {Journal of Computational and Graphical Statistics}, year = {2001}, volume = {10}, pages = {1--13} } @Article{vcd:Theus:2003, author = {Martin Theus}, title = {Interactive Data Visualization Using \pkg{Mondrian}}, journal = {Journal of Statistical Software}, volume = 7, number = 11, pages = {1--9}, year = 2003, url = {http://www.jstatsoft.org/v07/i11/}, } @Unpublished{vcd:Hofmann+Theus, author = {Heike Hofmann and Martin Theus}, title = {Interactive Graphics for Visualizing Conditional Distributions}, note = {Unpublished Manuscript}, year = {2005} } @Article{vcd:Hummel:1996, author = {J. Hummel}, title = {Linked Bar Charts: Analysing Categorical Data Graphically}, journal = {Computational Statistics}, year = 1996, volume = 11, pages = {23--33} } @Article{vcd:Unwin+Hawkins+Hofmann:1996, author = {Antony R. Unwin and G. Hawkins and Heike Hofmann and B. Siegl}, title = {Interactive Graphics for Data Sets with Missing Values -- \pkg{MANET}}, journal = {Journal of Computational and Graphical Statistics}, year = 1996, pages = {113--122}, volume = 4, number = 6 } @Manual{vcd:Urbanek+Wichtrey:2006, title = {\pkg{iplots}: Interactive Graphics for \textsf{R}}, author = {Simon Urbanek and Tobias Wichtrey}, year = {2006}, note = {\textsf{R} package version 1.0-3}, url = {http://www.rosuda.org/iPlots/} } %% Software @Manual{vcd:R:2006, title = {\textsf{R}: {A} Language and Environment for Statistical Computing}, author = {{\textsf{R} Development Core Team}}, organization = {\textsf{R} Foundation for Statistical Computing}, address = {Vienna, Austria}, year = {2006}, note = {{ISBN} 3-900051-00-3}, url = {http://www.R-project.org/} } @Article{vcd:Murrell:2002, author = {Paul Murrell}, title = {The \pkg{grid} Graphics Package}, journal = {\proglang{R} News}, year = 2002, volume = 2, number = 2, pages = {14--19}, month = {June}, url = {http://CRAN.R-project.org/doc/Rnews/} } @Book{vcd:Murrell:2006, author = {Paul Murrell}, title = {\textsf{R} Graphics}, publisher = {Chapmann \& Hall/CRC}, address = {Boca Raton, Florida}, year = {2006}, } @Book{vcd:Venables+Ripley:2002, author = {William N. Venables and Brian D. Ripley}, title = {Modern Applied Statistics with \textsf{S}}, edition = {4th}, publisher = {Springer-Verlag}, address = {New York}, year = {2002}, note = {{ISBN} 0-387-95457-0}, url = {http://www.stats.ox.ac.uk/pub/MASS4/} } @Manual{vcd:Ihaka:2006, title = {\pkg{colorspace}: Colorspace Manipulation}, author = {Ross Ihaka}, year = {2006}, note = {\textsf{R} package version 0.95} } @Manual{vcd:Meyer+Zeileis+Hornik:2006, title = {\pkg{vcd}: Visualizing Categorical Data}, author = {David Meyer and Achim Zeileis and Kurt Hornik}, year = {2006}, note = {\textsf{R} package version 1.0-6} } @article{vcd:Ligges+Maechler:2003, title = {\pkg{scatterplot3d} -- An {R} Package for Visualizing Multivariate Data}, author = {Uwe Ligges and Martin M{\"a}chler}, journal = {Journal of Statistical Software}, year = 2003, pages = {1--20}, number = 11, volume = 8, url = {http://www.jstatsoft.org/v08/i11/} } @Manual{vcd:SAS:2005, title = {\proglang{SAS/STAT} Version 9}, author = {\proglang{SAS} Institute Inc.}, year = {2005}, address = {Cary, NC} } @Manual{vcd:SPLUS:2005, title = {\proglang{S-PLUS} 7}, author = {{Insightful Inc.}}, year = {2005}, address = {Seattle, WA} } %% data @Article{vcd:Azzalini+Bowman:1990, author = {A. Azzalini and A. W. Bowman}, title = {A Look at Some Data on the {O}ld {F}aithful Geyser}, journal = {Applied Statistics}, year = {1990}, volume = {39}, pages = {357--365}, } @Article{vcd:Obel:1975, author = {E.B. Obel}, title = {A Comparative Study of Patients with Cancer of the Ovary Who Have Survived More or Less Than 10 Years}, journal = {Acta Obstetricia et Gynecologica Scandinavica}, year = 1975, volume = 55, pages = {429--439} } @InCollection{vcd:Koch+Edwards:1988, author = {G. Koch and S. Edwards}, title = {Clinical Efficiency Trials with Categorical Data}, booktitle = {Biopharmaceutical Statistics for Drug Development}, editor = {K. E. Peace}, publisher = {Marcel Dekker}, address = {New York}, year = {1988}, pages = {403--451} } @TechReport{vcd:Knorr-Held:1999, author = {Leonhard Knorr-Held}, title = {Dynamic Rating of Sports Teams}, institution = {SFB 386 ``Statistical Analysis of Discrete Structures''}, year = {1999}, type = {Discussion Paper}, number = {98}, url = {http://www.stat.uni-muenchen.de/sfb386/} } @Article{vcd:Snee:1974, author = {R. D. Snee}, title = {Graphical Display of Two-Way Contingency Tables}, journal = {The American Statistician}, year = 1974, volume = 28, pages = {9--12} } @Article{vcd:Bickel+Hammel+O'Connell:1975, author = {P. J. Bickel and E. A. Hammel and J. W. O'Connell}, title = {Sex Bias in Graduate Admissions: Data from {B}erkeley}, journal = {Science}, year = 1975, volume = 187, pages = {398--403} } @Book{vcd:Gilbert:1981, author = {G. N. Gilbert}, title = {Modelling Society: An Introduction to Loglinear Analysis for Social Researchers}, publisher = {Allen and Unwin}, year = 1981, address = {London} } @Book{vcd:Thornes+Collard:1979, author = {B. Thornes and J. Collard}, title = {Who Divorces?}, publisher = {Routledge \& Kegan}, year = 1979, address = {London} } @Article{vcd:Dawson:1995, author = {Robert J. MacG Dawson}, title = {The ``Unusual Episode'' Data Revisited}, journal = {Journal of Statistics Education}, year = 1995, volume = 3, url = {http://www.amstat.org/publications/jse/v3n3/datasets.dawson.html} } @Article{vcd:Haberman:1974, author = {S. J. Haberman}, title = {Log-linear Models for Frequency Tables with Ordered Classifications}, journal = {Biometrics}, year = 1974, volume = 30, pages = {689--700} } @Article{vcd:Wing:1962, author = {J. K. Wing}, title = {Institutionalism in Mental Hospitals}, journal = {British Journal of Social Clinical Psychology}, year = 1962, volume = 1, pages = {38--51} } @Book{vcd:Andersen:1991, author = {E. B. Andersen}, title = {The Statistical Analysis of Categorical Data}, publisher = {Springer-Verlag}, year = {1991}, address = {Berlin}, edition = {2nd} } @Article{vcd:Haberman:1973, author = {S. J. Haberman}, title = {The Analysis of Residuals in Cross-classified Tables}, journal = {Biometrics}, year = {1973}, volume = {29}, pages = {205--220} } @Book{vcd:Everitt+Hothorn:2006, author = {Brian S. Everitt and Torsten Hothorn}, title = {A Handbook of Statistical Analyses Using \textsf{R}}, publisher = {Chapman \& Hall/CRC}, address = {Boca Raton, Florida}, year = {2006} } @Article{vcd:Salib+Hillier:1997, author = {Emad Salib and Valerie Hillier}, title = {A Case-Control Study of Smoking and {A}lzheimer's Disease}, journal = {International Journal of Geriatric Psychiatry}, year = {1997}, volume = {12}, pages = {295--300} } %% inference @Book{vcd:Agresti:2002, author = {Alan Agresti}, title = {Categorical Data Analysis}, publisher = {John Wiley \& Sons}, year = {2002}, address = {Hoboken, New Jersey}, edition = {2nd} } @Book{vcd:Mazanec+Strasser:2000, author = {Josef A. Mazanec and Helmut Strasser}, title = {A Nonparametric Approach to Perceptions-based Market Segmentation: Foundations}, publisher = {Springer-Verlag}, year = {2000}, address = {Berlin} } @Article{vcd:Strasser+Weber:1999, author = {Helmut Strasser and Christian Weber}, title = {On the Asymptotic Theory of Permutation Statistics}, journal = {Mathematical Methods of Statistics}, volume = {8}, pages = {220--250}, year = {1999} } @Book{vcd:Pesarin:2001, author = {Fortunato Pesarin}, title = {Multivariate Permutation Tests}, year = {2001}, publisher = {John Wiley \& Sons}, address = {Chichester} } @Article{vcd:Ernst:2004, author = {Michael D. Ernst}, title = {Permutation Methods: A Basis for Exact Inference}, journal = {Statistical Science}, volume = {19}, year = {2004}, pages = {676--685} } @Article{vcd:Patefield:1981, author = {W. M. Patefield}, title = {An Efficient Method of Generating $R \times C$ Tables with Given Row and Column Totals}, note = {{A}lgorithm AS 159}, journal = {Applied Statistics}, volume = {30}, year = {1981}, pages = {91--97} } %% own @InProceedings{vcd:Meyer+Zeileis+Hornik:2003, author = {David Meyer and Achim Zeileis and Kurt Hornik}, title = {Visualizing Independence Using Extended Association Plots}, booktitle = {Proceedings of the 3rd International Workshop on Distributed Statistical Computing, Vienna, Austria}, editor = {Kurt Hornik and Friedrich Leisch and Achim Zeileis}, year = {2003}, url = {http://www.ci.tuwien.ac.at/Conferences/DSC-2003/Proceedings/}, note = {{ISSN 1609-395X}}, } @TechReport{vcd:Zeileis+Meyer+Hornik:2005, author = {Achim Zeileis and David Meyer and Kurt Hornik}, title = {Residual-based Shadings for Visualizing (Conditional) Independence}, institution = {Department of Statistics and Mathematics, Wirtschaftsuniversit\"at Wien, Research Report Series}, year = {2005}, type = {Report}, number = {20}, month = {August}, url = {http://epub.wu-wien.ac.at/dyn/openURL?id=oai:epub.wu-wien.ac.at:epub-wu-01_871} } @Article{vcd:Zeileis+Meyer+Hornik:2007, author = {Achim Zeileis and David Meyer and Kurt Hornik}, title = {Residual-based Shadings for Visualizing (Conditional) Independence}, journal = {Journal of Computational and Graphical Statistics}, year = {2007}, volume = {16}, number = {3}, pages = {507--525}, doi = {10.1198/106186007X237856} } @TechReport{vcd:Meyer+Zeileis+Hornik:2005a, author = {David Meyer and Achim Zeileis and Kurt Hornik}, title = {The Strucplot Framework: Visualizing Multi-Way Contingency Tables with \pkg{vcd}}, institution = {Department of Statistics and Mathematics, Wirtschaftsuniversit\"at Wien, Research Report Series}, year = {2005}, type = {Report}, number = {22}, month = {November}, url = {http://epub.wu-wien.ac.at/dyn/openURL?id=oai:epub.wu-wien.ac.at:epub-wu-01_8a1} } @Article{vcd:Meyer+Zeileis+Hornik:2006b, author = {David Meyer and Achim Zeileis and Kurt Hornik}, title = {The Strucplot Framework: Visualizing Multi-way Contingency Tables with \pkg{vcd}}, year = {2006}, journal = {Journal of Statistical Software}, volume = {17}, number = {3}, pages = {1--48}, url = {http://www.jstatsoft.org/v17/i03/} } @InCollection{vcd:Meyer+Zeileis+Hornik:2006a, author = {David Meyer and Achim Zeileis and Kurt Hornik}, title = {Visualizing Contingency Tables}, editor = {Chun-Houh Chen and Wolfang H\"ardle and Antony Unwin}, booktitle = {Handbook of Data Visualization}, series = {Springer Handbooks of Computational Statistics}, year = {2006}, publisher = {Springer-Verlag}, address = {New York}, note = {{ISBN} 3-540-33036-4, to appear} } @Article{vcd:Hothorn+Hornik+VanDeWiel:2006, author = {Torsten Hothorn and Kurt Hornik and Mark A. van de Wiel and Achim Zeileis}, title = {A {L}ego System for Conditional Inference}, journal = {The American Statistician}, year = {2006}, volume = {60}, number = {3}, pages = {257--263}, doi = {10.1198/000313006X118430} } @TechReport{vcd:Zeileis+Hornik:2006, author = {Achim Zeileis and Kurt Hornik}, title = {Choosing Color Palettes for Statistical Graphics}, institution = {Department of Statistics and Mathematics, Wirtschaftsuniversit\"at Wien, Research Report Series}, year = {2006}, type = {Report}, number = {41}, month = {October}, url = {http://epub.wu-wien.ac.at/} } @Article{vcd:Zeileis+Hornik+Murrell:2009, author = {Achim Zeileis and Kurt Hornik and Paul Murrell}, title = {Escaping {RGB}land: Selecting Colors for Statistical Graphics}, journal = {Computational Statistics \& Data Analysis}, year = {2009}, volume = {53}, number = {9}, pages = {3259--3270}, doi = {10.1016/j.csda.2008.11.033}, } %% bad color examples @Article{vcd:Gneiting+Sevcikova+Percival:2006, author = {Tilmann Gneiting and Hana \v{S}ev\v{c}\'ikov\'a and Donald B. Percival and Martin Schlather and Yindeng Jiang}, title = {Fast and Exact Simulation of Large Gaussian Lattice Systems in {$\mathbb{R}^2$}: Exploring the Limits}, year = {2006}, journal = {Journal of Computational and Graphical Statistics}, volume = {15}, number = {3}, pages = {483--501}, note = {Figures~1--4} } @Article{vcd:Yang+Buckley+Dudoit:2002, author = {Yee Hwa Yang and Michael J. Buckley and Sandrine Dudoit and Terence P. Speed}, title = {Comparison of Methods for Image Analysis on {cDNA} Microarray Data}, year = {2002}, journal = {Journal of Computational and Graphical Statistics}, volume = {11}, number = {1}, pages = {108--136}, note = {Figure~4a} } @Article{vcd:Kneib:2006, author = {Thomas Kneib}, title = {Mixed Model-based Inference in Geoadditive Hazard Regression for Interval-censored Survival Times}, year = {2006}, journal = {Computational Statistics \& Data Analysis}, volume = {51}, pages = {777--792}, note = {Figure~5 (left)} } @Article{vcd:Friendly:2002, author = {Michael Friendly}, title = {A Brief History of the Mosaic Display}, year = {2002}, journal = {Journal of Computational and Graphical Statistics}, volume = {11}, number = {1}, pages = {89--107}, note = {Figure~11 (left, middle)} } @Article{vcd:Celeux+Hurn+Robert:2000, author = {Gilles Celeux and Merrilee Hurn and Christian P. Robert}, title = {Computational and Inferential Difficulties with Mixture Posterior Distributions}, year = {2000}, journal = {Journal of the American Statistical Association}, volume = {95}, number = {451}, pages = {957--970}, note = {Figure~3} } %% pointers from Hadley @article{cleveland:1987, Author = {Cleveland, William and McGill, Robert}, Journal = {Journal of the Royal Statistical Society A}, Number = {3}, Pages = {192-229}, Title = {Graphical Perception: The Visual Decoding of Quantitative Information on Graphical Displays of Data}, Volume = {150}, Year = {1987}} @article{cleveland:1984, Author = {Cleveland, William S. and McGill, M. E.}, Journal = {Journal of the American Statistical Association}, Number = 387, Pages = {531-554}, Title = {Graphical Perception: Theory, Experimentation and Application to the Development of Graphical Methods}, Volume = 79, Year = 1984} @article{huang:1997, Author = {Huang, Chisheng and McDonald, John Alan and Stuetzle, Werner}, Journal = {Journal of Computational and Graphical Statistics}, Pages = {383--396}, Title = {Variable resolution bivariate plots}, Volume = {6}, Year = {1997}} @article{carr:1987, Author = {Carr, D. B. and Littlefield, R. J. and Nicholson, W. L. and Littlefield, J. S.}, Journal = {Journal of the American Statistical Association}, Number = {398}, Pages = {424-436}, Title = {Scatterplot Matrix Techniques for Large N}, Volume = {82}, Year = {1987}} @book{cleveland:1994, Author = {Cleveland, William}, Publisher = {Hobart Press}, Title = {The Elements of Graphing Data}, Year = {1994}} @book{chambers:1983, Author = {Chambers, John and Cleveland, William and Kleiner, Beat and Tukey, Paul}, Publisher = {Wadsworth}, Title = {Graphical methods for data analysis}, Year = {1983}} @book{bertin:1983, Address = {Madison, WI}, Author = {Bertin, Jacques}, Publisher = {University of Wisconsin Press}, Title = {Semiology of Graphics}, Year = {1983}} @book{wilkinson:2006, Author = {Wilkinson, Leland}, Publisher = {Springer-Verlag}, Series = {Statistics and Computing}, Title = {The Grammar of Graphics}, Year = {2005}} vcd/vignettes/residual-shadings.Rnw0000644000175000017500000003711613731705707017310 0ustar nileshnilesh\documentclass[nojss]{jss} %% need no \usepackage{Sweave} \usepackage{rotating} \newcommand{\given}{\, | \,} \title{Residual-Based Shadings in \pkg{vcd}} \Plaintitle{Residual-Based Shadings in vcd} \author{Achim Zeileis, David Meyer, \textnormal{and} Kurt Hornik\\Wirtschaftsuniversit\"at Wien, Austria} \Plainauthor{Achim Zeileis, David Meyer, Kurt Hornik} \Abstract{ This vignette is a companion paper to \cite{vcd:Zeileis+Meyer+Hornik:2007} which introduces several extensions to residual-based shadings for enhancing mosaic and association plots. The paper introduces (a)~perceptually uniform Hue-Chroma-Luminance (HCL) palettes and (b)~incorporates the result of an associated significance test into the shading. Here, we show how the examples can be easily reproduced using the \pkg{vcd} package. } \Keywords{association plots, conditional inference, contingency tables, HCL colors, HSV colors, mosaic plots} \Address{ Achim Zeileis\\ E-mail: \email{Achim.Zeileis@R-project.org}\\ David Meyer\\ E-mail: \email{David.Meyer@R-project.org}\\ Kurt Hornik\\ E-mail: \email{Kurt.Hornik@R-project.org}\\ } \begin{document} %\VignetteIndexEntry{Residual-Based Shadings in vcd} %\VignetteDepends{vcd,colorspace,MASS,grid,HSAUR3,grid} %\VignetteKeywords{association plots, conditional inference, contingency tables, HCL colors, HSV colors, mosaic plots} %\VignettePackage{vcd} \SweaveOpts{engine=R,eps=FALSE} \section{Introduction} \label{sec:intro} In this vignette, we show how all empirical examples from \cite{vcd:Zeileis+Meyer+Hornik:2007} can be reproduced in \proglang{R}\citep[\mbox{\url{http://www.R-project.org/}}]{vcd:R:2006}, in particular using the package \pkg{vcd} \citep{vcd:Meyer+Zeileis+Hornik:2006}. Additionally, the pakcages \pkg{MASS} \citep[see][]{vcd:Venables+Ripley:2002}, \pkg{grid} \citep[see][]{vcd:Murrell:2002} and \pkg{colorspace} \citep{vcd:Ihaka:2004} are employed. All are automatically loaded together with \pkg{vcd}: <>= library("grid") library("vcd") rseed <- 1071 @ Furthermore, we define a \code{rseed} which will be used as the random seed for making the results of the permutation tests (conditional inference) below exactly reproducible. In the following, we focus on the \proglang{R} code and output---for background information on the methods and the data sets, please consult \cite{vcd:Zeileis+Meyer+Hornik:2007}. \section{Arthritis data} \label{sec:arthritis} First, we take a look at the association of treatment type and improvement in the \code{Arthritis} data. The data set can be loaded and brought into tabular form via: <>= data("Arthritis", package = "vcd") (art <- xtabs(~ Treatment + Improved, data = Arthritis, subset = Sex == "Female")) @ Two basic explorative views of such a 2-way table are mosaic plots and association plots. They can be generated via \code{mosaic()} and \code{assoc()} from \pkg{vcd}, respectively. For technical documentation of these functions, please see \cite{vcd:Meyer+Zeileis+Hornik:2006b}. When no further arguments are supplied as in <>= mosaic(art) assoc(art) @ this yields the plain plots without any color shading, see Figure~\ref{fig:classic}. Both indicate that there are more patients in the treatment group with marked improvement and less without improvement than would be expected under independence---and vice versa in the placebo group. \setkeys{Gin}{width=\textwidth} \begin{figure}[b!] \begin{center} <>= grid.newpage() pushViewport(viewport(layout = grid.layout(1, 2))) pushViewport(viewport(layout.pos.col=1, layout.pos.row=1)) mosaic(art, newpage = FALSE, margins = c(2.5, 4, 2.5, 3)) popViewport() pushViewport(viewport(layout.pos.col=2, layout.pos.row=1)) assoc(art, newpage = FALSE, margins = c(5, 2, 5, 4)) popViewport(2) @ \caption{Classic mosaic and association plot for the arthritis data.} \label{fig:classic} \end{center} \end{figure} For 2-way tables, \cite{vcd:Zeileis+Meyer+Hornik:2007} suggest to extend the shading of \cite{vcd:Friendly:1994} to also visualize the outcome of an independence test---either using the sum of squares of the Pearson residuals as the test statistic or their absolute maximum. Both statistics and their corresponding (approximate) permutation distribution can easily be computed using the function \code{coindep_test()}. Its arguments are a contingency table, a specification of margins used for conditioning (only for conditional independence models), a functional for aggregating the Pearson residuals (or alternatively the raw counts) and the number of permutations that should be drawn. The conditional table needs to be a 2-way table and the default is to compute the maximum statistic (absolute maximum of Pearson residuals). For the Arthritis data, both, the maximum test <>= set.seed(rseed) (art_max <- coindep_test(art, n = 5000)) @ and the sum-of-squares test, indicate a significant departure from independence. <>= ss <- function(x) sum(x^2) set.seed(rseed) coindep_test(art, n = 5000, indepfun = ss) @ Thus, it can be concluded that the treatment is effective and leads to significantly more improvement than the placebo. The classic views from Figure~\ref{fig:classic} and the inference above can also be combined, e.g., using the maximum shading that highlights the cells in an association or mosaic plot when the associated residuals exceed critical values of the maximum test (by default at levels 90\% and 99\%). To compare this shading (using either HSV or HCL colors) with the Friendly shading (using HSV colors), we generate all three versions of the mosaic plot: <>= mosaic(art, gp = shading_Friendly(lty = 1, eps = NULL)) mosaic(art, gp = shading_hsv, gp_args = list( interpolate = art_max$qdist(c(0.9, 0.99)), p.value = art_max$p.value)) set.seed(rseed) mosaic(art, gp = shading_max, gp_args = list(n = 5000)) @ the results are shown in the upper row of Figure~\ref{fig:shadings}. The last plot could hae also been generated analogously to the second plot using \code{shading_hcl()} instead of \code{shading_hsv()}---\code{shading_max()} is simply a wrapper function which performs the inference and then visualizes it based on HCL colors. \section{Piston rings data} \label{sec:arthritis} Instead of bringing out the result of the maximum test in the shading, we could also use a sum-of-squares shading that visualizes the result of the sum-of-squares test. As an illustration, we use the \code{pistonrings} data from the \code{HSAUR3} \citep{vcd:Everitt+Hothorn:2006} package giving the number of piston ring failurs in different legs of different compressors at an industry plant: <>= data("pistonrings", package = "HSAUR3") pistonrings @ \begin{sidewaysfigure}[p] \begin{center} <>= mymar <- c(1.5, 0.5, 0.5, 2.5) grid.newpage() pushViewport(viewport(layout = grid.layout(2, 3))) pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1)) mosaic(art, margins = mymar, newpage = FALSE, gp = shading_Friendly(lty = 1, eps = NULL)) popViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2)) mosaic(art, gp = shading_hsv, margins = mymar, newpage = FALSE, gp_args = list(interpolate = art_max$qdist(c(0.9, 0.99)), p.value = art_max$p.value)) popViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 3)) set.seed(rseed) mosaic(art, gp = shading_max, margins = mymar, newpage = FALSE, gp_args = list(n = 5000)) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 1)) mosaic(pistonrings, margins = mymar, newpage = FALSE, gp = shading_Friendly(lty = 1, eps = NULL, interpolate = c(1, 1.5))) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 2)) mosaic(pistonrings, gp = shading_hsv, margins = mymar, newpage = FALSE, gp_args = list(p.value = 0.069, interpolate = c(1, 1.5))) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 3)) mosaic(pistonrings, gp = shading_hcl, margins = mymar, newpage = FALSE, gp_args = list(p.value = 0.069, interpolate = c(1, 1.5))) popViewport(2) @ \includegraphics[width=.9\textwidth,keepaspectratio]{residual-shadings-shadings} \caption{Upper row: Mosaic plot for the arthritis data with Friendly shading (left), HSV maximum shading (middle), HCL maximum shading (right). Lower row: Mosaic plot for the piston rings data with fixed user-defined cut offs 1 and 1.5 and Friendly shading (left), HSV sum-of-squares shading (middle), HCL sum-of-squares shading (right).} \label{fig:shadings} \end{center} \end{sidewaysfigure} Although there seems to be some slight association between the leg (especially center and South) and the compressor (especially numbers 1 and 4), there is no significant deviation from independence: <>= set.seed(rseed) coindep_test(pistonrings, n = 5000) set.seed(rseed) (pring_ss <- coindep_test(pistonrings, n = 5000, indepfun = ss)) @ This can also be brought out graphically in a shaded mosaicplot by enhancing the Friendly shading (based on the user-defined cut-offs 1 and 1.5, here) to use a less colorful palette, either based on HSV or HCL colors: <>= mosaic(pistonrings, gp = shading_Friendly(lty = 1, eps = NULL, interpolate = c(1, 1.5))) mosaic(pistonrings, gp = shading_hsv, gp_args = list(p.value = pring_ss$p.value, interpolate = c(1, 1.5))) mosaic(pistonrings, gp = shading_hcl, gp_args = list(p.value = pring_ss$p.value, interpolate = c(1, 1.5))) @ The resulting plots can be found in the lower row of Figure~\ref{fig:shadings}. The default in \code{shading_hcl()} and \code{shading_hsv()} is to use the asymptotical $p$~value, hence we set it explicitely to the permtuation-based $p$~value computed above. \section{Alzheimer and smoking} \label{sec:alzheimer} For illustrating that the same ideas can be employed for visualizing (conditional) independence in multi-way tables, \cite{vcd:Zeileis+Meyer+Hornik:2007} use a 3-way and a 4-way table. The former is taken from a case-control study of smoking and {A}lzheimer's disease (stratified by gender). The data set is available in \proglang{R} in the package \pkg{coin} \cite{vcd:Hothorn+Hornik+VanDeWiel:2006}. <>= data("alzheimer", package = "coin") alz <- xtabs(~ smoking + disease + gender, data = alzheimer) alz @ \begin{figure}[b!] \begin{center} <>= set.seed(rseed) cotabplot(~ smoking + disease | gender, data = alz, panel = cotab_coindep, n = 5000) @ \caption{Conditional mosaic plot with double maximum shading for conditional independence of smoking and disease given gender.} \label{fig:alz} \end{center} \end{figure} To assess whether smoking behaviour and disease status are conditionally independent given gender, \cite{vcd:Zeileis+Meyer+Hornik:2007} use three different types of test statistics: double maximum (maximum of maximum statistics in the two strata), maximum sum of squares (maximum of sum-of-squares statistics), and sum of squares (sum of sum-of-squares statistics). All three can be computed and assessed via permutation methods using the function \code{coindep_test()}: <>= set.seed(rseed) coindep_test(alz, 3, n = 5000) set.seed(rseed) coindep_test(alz, 3, n = 5000, indepfun = ss) set.seed(rseed) coindep_test(alz, 3, n = 5000, indepfun = ss, aggfun = sum) @ The conditional mosaic plot in Figure~\ref{fig:alz} shows clearly that the association of smoking and disease is present only in the group of male patients. The double maximum shading employed allows for identification of the male heavy smokers as the cells `responsible' for the dependence: other dementias are more frequent and Alzheimer's disease less frequent in this group than expected under independence. Interestingly, there seems to be another large residual for the light smoker group ($<$10 cigarettes) and Alzheimer's disease---however, this is only significant at 10\% and not at the 1\% level as the other two cells. <>= <> @ \section{Corporal punishment of children} As a 4-way example, data from a study of the Gallup Institute in Denmark in 1979 about the attitude of a random sample of 1,456 persons towards corporal punishment of children is used. The contingency table comprises four margins: memory of punishments as a child (yes/no), attitude as a binary variable (approval of ``moderate'' punishment or ``no'' approval), highest level of education (elementary/secondary/high), and age group (15--24, 25--39, $\ge$40 years). <>= data("Punishment", package = "vcd") pun <- xtabs(Freq ~ memory + attitude + age + education, data = Punishment) ftable(pun, row.vars = c("age", "education", "memory")) @ It is of interest whether there is an association between memories of corporal punishments as a child and attitude towards punishment of children as an adult, controlling for age and education. All three test statistics already used above confirm that memories and attitude are conditionally associated: \setkeys{Gin}{width=\textwidth} \begin{figure}[t!] \begin{center} <>= set.seed(rseed) cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, n = 5000, type = "assoc", test = "maxchisq", interpolate = 1:2) @ \caption{Conditional association plot with maximum sum-of-squares shading for conditional independence of memory and attitude given age and education.} \label{fig:pun} \end{center} \end{figure} \setkeys{Gin}{width=\textwidth} \begin{figure}[t!] \begin{center} <>= set.seed(rseed) cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, n = 5000, type = "mosaic", test = "maxchisq", interpolate = 1:2) @ \caption{Conditional mosaic plot with maximum sum-of-squares shading for conditional independence of memory and attitude given age and education.} \label{fig:pun2} \end{center} \end{figure} <>= set.seed(rseed) coindep_test(pun, 3:4, n = 5000) set.seed(rseed) coindep_test(pun, 3:4, n = 5000, indepfun = ss) set.seed(rseed) coindep_test(pun, 3:4, n = 5000, indepfun = ss, aggfun = sum) @ Graphically, this dependence can be brought out using conditional association or mosaic plots as shown in Figure~\ref{fig:pun} and \ref{fig:pun2}, respectively. Both reveal an association between memories and attitude for the lowest education group (first column) and highest age group (last row): experienced violence seems to engender violence again as there are less adults that disapprove punishment in the group with memories of punishments than expected under independence. For the remaining four age-education groups, there seems to be no association: all residuals of the conditional independence model are very close to zero in these cells. The figures employ the maximum sum-of-squares shading with user-defined cut offs 1 and 2, chosen to be within the range of the residuals. The full-color palette is used only for those strata associated with a sum-of-squares statistic significant at (overall) 5\% level, the reduced-color palette is used otherwise. This highlights that the dependence pattern is significant only for the middle and high age group in the low education column. The other panels in the first column and last row also show a similar dependence pattern, however, it is not significant at 5\% level and hence graphically down-weighted by using reduced color. <>= <> @ <>= <> @ \bibliography{vcd} \end{document} vcd/build/0000755000175000017500000000000014133313347012261 5ustar nileshnileshvcd/build/vignette.rds0000644000175000017500000000067214133313347014625 0ustar nileshnileshSMO1]XDEIPd͛B#1,[`ڒm" NtfޛN?jAJC4&.UBq &7zLc#:ڨ)$ywTD6 3S1'KC~T;c41p9iKaɀ~&\8ϸ$g~dsf:P̣=՘LʸE*/Qwڋ'ֹwU?ZKԀ$];1d0M \asVI赟I!cD>r-5f|Nf?g܃>  ./O8.k}W55/WsOWadWQ9[wSB* 6kTS{.p:V2mbl ~qY.mF,ZFe}k Gq\vcd/build/partial.rdb0000644000175000017500000037564714133313326014431 0ustar nileshnileshy|ٖ&@ $^&HIpADbdzx/1/" ^uukm[-ɖٲ-ydْ-lbY-Yg<{zxg֛87ȼ@~ 8_s_OR={R$s8$YSOo{~j|w]|C㠀xh|WUN^y({J&R%dn=@HmR' ,r0IEsŨ7s̱7no=uc׋ornFO_@~ cKz4Evm)j[?-[?>4U*z!u‡j z0opK2gp[_grL{?ހ|C%O٤݄~-/;cU6݌ouo×st/@8y^e:%r NbOũ_*m;ݐL*V۪93/M?hL>ޢzZ1lʼn!i+T-#M$lA=H}<&L}TڵѵR?\^2q^Rxrrw]KO1ZB; ϱӈGѮMj\( YmE('rцf3> '<\]_6H%f5q2^7I5,ٸYJ%*ʓickv GC?Ӭ~2 w=BydnB02se׭^]wEQ+z}GI d_GBIuЫR &ݬD8$$s*Ls.*,لV$L jM;lM. 4Fg:~.^DmYb [.QpOٲ^5Rev1YD prVl: Ǔ&˲8DaM Q2 ^{2 QlSeD d^y V̚Fa HNaOBoAV#.WRdȭvRŀ!_׶5ԐʺQB֟9L.̃a%8 3JYD'|D4{Mx4iP;rG*f8tK~8p(J}|ákx>Q  }á0%FYG4Jtflp(i |ڵPR?+`2áSQáDBSwڱiQ|a0Rw8YɅiD|z>z,t PeBG @(x` T6~Sd \q ԝ~Do(h(л|adŨ@Nnx0M!u9TmP;ITZLfO "Oȑi toֆ0(3{8e_F(/'Q٨r ٨UݎFū@0"dU*;R+ YЋ3\ v] {RS|Gufx)O!g6Y̲} LxZ~ybxl( /AnWːjR; Bx^;/~Q86L8 yZ2G VIP/"t#oDj'ԾB2q|" 6f)dΰt$ģI񓿃Ѱºu?)݅ d4Z=?qU@6 Rw?swe13b!DC)!ͪi}JS N@~m!Tm.ӫT0JUrV Mh LQ8I>":#>~`B|~L꺁!+q7-UOvhq7,!;8CXgU֣%acbF 7<TҍZ$.W!+ 9Ai7U}|f7Y"nO +'Qw4tS~ !oJߑx:J߇`U?,{˥-cŕǽ>gN맵xa̫.'_321? | Y[>~>a}];oG-$C_#I5w떏(e @ټvPǃ2L䶕XZLw ,Y6WS=|Rw8 Yi\Ӽ{4c"e=V5">KG(fp09Z H:< B!2$~* ?A.vV-ٕ\D* OnuI:# /$ W*& L6UG̦ڲeyd!rѐH UT ^eˆk)?E$Ԛ T.P\/$i{H|'laHUuՒ@. ][- vbTl׵K[l*+)ǡؚ! ?\mj>渁e8i{ScvDӄ+*B5#WeڹTmU UJEKlWd QBc S;#Nl1\5vYް̷+gXZ  }~J0BQfد~bǸ!f:VP>kއ|?m/ g\TU.a#ujsϺD6|OIN a(_(>Is=|D] l]V]Sv7qJIa^,G`X B:x' O%;V˶C ~ 'wj8c#Q/CVFaz&xHmC ]o}2˅-tX]އԂKN}A%( Et|40d#־&ZĐY;_es* /7i%VI_^%?ǓgdȲN '<xb!Ōl$"gg!m}$usv4g<0<]mgbQNAju7?X~mnousFѤj_B~. 7gl9J襁YwiIpgh0}|W4mI֪c{{¶ebuA.OIo ?IQ+De 8R Jv6|S,@[M.ƺKEw%*' +0.+04dt}qP7+ :$w4:6k!t0Dֲm֜/4P+ukH]'ddC< FV>NUV})<O"Aľ"U[֡wYmU@chf Tej; {^5~?Jj$%<DB܆K~ I8yP)h3UɆ5$ dFap WvpZ)_wobNx`>vL-U7!?~9 klosd,ӊU_28Z̅de !ku]֌"gH^WƇgdlzTJg+E1le.7εV8wJ4Ap c|e_^"j"Wd-֬q9͐q)J7KR: Yi+N֘W= 䌶Y*8E`֬wQKX?^*ј"{Ɓ ?hS5-EF[3ǐwfv2&Kd&&ܹ )tahuVo=o+ff/&`c<^$ f,X~S!cKOFA LuSadQ_XTIJJ4g!(? Fśm$@ s܎^pkƤvtHix{J20sK`@'t1I:.q4q`CPv\KH[8 YJUYSBU" Mng!鞠ՓvuԱu˦/AJTҾ< +ٚ=ٰLO@V$Y #4 1qf|J74whAE іrj/\tûY Sߠ Q^-4k FiؚwWN vȯ.pEk ~^sUe]%$yM#xdZҥ]2E֣Zd;|^wJG!‘N1}7! Cv?1©e=5 ^plʊߓ9,K:Pg!gs1}eO+Oբ3/}ԵV prn [tѡ5GG'z^wƪ`//tF΍BQ4P-Yy{<Ǣڬb0OpTn5 B/!v;M7;M&:LOeS8Ҹ"R%sx҂Ȇ v0)͚Y_^Wq(b{84oM9fW9UEw1v= B|ӐzTLu7T6@ de;c 뇉%`rsuŷ2ͣX,*)KöcaJ1̙׷Xe%Dg~*nT#[=U/$6=~-OH['C 丕 qnWčlCd>N%u,۾ 8^"87h[Vpw ar#uGm!a#- G&]ts%VEϫPIQyMt>t,O\އ|?Yl3qQ><3|Y U6=>\d]vd71xoz3AQ|>B:!'~:9k7\. n7KpB>%Ï~O> fJƖ]l[)-߻sF/ٗearuF3n`պ]iS-$ 9}+ѭD&Amg1TH]'.n>H=}k>n*CVR~ؖo>HSm~q{txx|tT:Y9&7'h5&L>d<2=2BxrcbTLq|:f!@I̝N)Fk'ph|R?& M i˟FY P3lʱڴJR;ǞNzcc_.4m\u. l~v0x|Nv4q,4SlLd^.@#}v޹kvv3>ck]aάW4 ID@N.f0TFv4qDCY&?y̯T5醔XB|Ѱ:˚E7WW^o|)o@la,tT+Z;º~_86Hǻ#_R21"TF^78 Y tK 4-8Pt\@ljvmP%,jlۄ醼`Z,ۿ":^p~{&Z]&L>(e'"=ĄZx}sH8xԓ[9Ÿk[Į:4Ngb^6 GvҚHW!_m}'YY}[I!5z ^fvbHd"ƊHu)m-L,nCV? *Qwe&?1gAzԚL.ܮ d)v.ށHp?/ޅH#{@ҍ_5 >|_qdb|o\J|vɝ^,-V6sq,3-ح#?vͼ5:n7.~ʾ`W[Fw˝G&rg]^H pNO|E7˾Y|6¾EރlsKT{K_JwQd_*ˎiw7ƑH\LoWIG\:[_=!ŏzܒs.V['&mZ_jv4GgWfRoW?T۽d%7_!?ݷX\h@{rG܏TC>6Gr0`"%B¿[ec*̗ _ $XvG1josS_x4ƆUɱ7aA,ϙ=lS9C'uÊ#}#~T@tbr*| fcSrY::3$?rE6ꘫg2{Ï4~ZFɭ}uYy>ٙ1 ٱ/Ͽm4=_Z3h @*o__KԮqVk@K+1[cZs+ Kwk2WL36M*\粅S39^4!z͜'Oܝ-?=gGŹ_/³e>06N , }5IW9ꥴ*Շ۞W"}Ԯ>.W !&S}\-]2KG)-"LizC/~uC{e]8  j: 2<\r׏B*d)z]2WLʷ/@0++ 8Px'QW0n6X~}_7=ajwpHpp@, „SځWj,- oAMC߃rj}fSCw4ŸfLqr!3} %f!l>?՜Wxא_k';kcy17,6SW 5X G}%?n8?뼑jK{cRPW!7Qokʑ5q*XLY)ڳڴv ~c|/Dmxx(m[QߺH`ߺQ6+^~"ڰ{ᚕ&_? ɭfMi,\v.aBDjfe{+1մ`Tkh}ɍ)Hku_ktfg);T ,b0jj_v)6M`2p}hm3׭6}g;֊U9Q 㑎G]7S *K)V#\)(oP{rp$w==enM11mz{ XnKEOCs+~a*뭊>9OÃn1D?@=KL4&𿓊O7ґXo/‡Q*MGsl.}m` V]cUިꇔ#JRCU?$|o%z,fN\cz+5nY+W8Eۻma #k0Rg7aZ0W _^ T]g]3sd1Hgq\?F}u[,f>Y9r{jjrjX9:>·_=;H⾲}%E%)46OپbX? #f<>3^_ /zRE/#|7} u&~8" |ǴߓWKI35h_1zS) GMȽfS{18$p'߄Ko7vo(xe(r|y"'.|V2{*ʦ[E ބp򨎿FbP¯$z_Qm0y׺AY]X> 3$J| Y2ʡ\Ŷz3jvq^$S !<(ˆˣrNE@ /%;ؽGg*HhU{Te3!|F!RE#eSߨ7#GT}POo*YTr7S|K1 ߹U6K1nM < p bjIuŦe ^({ipD5ps~ҦI0  "|\gS,Rkm$R1oR\@< 2ItpUǕpLK'"c]\܈=-.]EW[t]`ˡ.%XtZ'/i0 '`0I'oR?( sl1Mi1X}& j}&4O8P"s0O$- kT%-&ՄOeR? ,XfŮ:+?4漈zTH4=0GOaݦA !Ls%utW2r!1KC~o$4" F|aHGш{u`r h cۼiMyl{k'`(=ʥ*~zAY︘ELp_fUg<~ >șjaI"v?_^|9oZY04>EQSJ'')GXP=^y/~!K#&p/[6v!0a$وS}46::c]2YK^T- !굷&ߣmћTxƿ'@Mw}ت zJ<7ªY.NzKA0bv?T#, jW"T槀4@;}ԥCW@>RtKY Y951:5l\`zX_?Af%\b{wZg됯'XbH`x F?yhZc5H g!+%G mrU:inűe]<*ނ )}4ɹ|V?$6HS+]8iuDj:|]nwDx 16H1M@9*QL͇5lɗ^@-k\ώ kvT&UZ_B )4q] 2Ep$lռG IުI w t$wAgZZ5\9+JFJ(!+Tl;]ZyڅAID9 | ՏÚqqciʺEb*a=blX1UJS1"8(R)`RIXӏL? ls xR TW:.dH)I==`_ VR0ifT}^.RԷc( wKpnO ~G' .o &!WHN%{wR |:yupkǐIxWWwq9+dƒ*{u9T?eJ)z7`Y;!=h<+fWcoH`X!ucQ.8p^W 6;hYigmNCVZ*ߴft]YFH^e{+_!CH6R}h) fAI&Q:F,JIL!S %Ln5te+CO,c)( L]| _$&iWk[%aUp ul5]?cFO*exc{y}cA ,qǼRNċ;d_&|9d!WغoR0 58Y6ff۰ :&^z^Բ [٧/ 6Y_*8{R2^ģI[XxLU+*{K ĝ]+^۶aM7[ﻤ*[]Rw(Ⱥ}E鬊tO;Ww/vR6j O?el T딶x*KkO[˴k*c-ɱSɾ᧐wg,;>:zcHQvޕVHEjY^቞bwG1ҹ;̊5yȃTR:.#"Z!4 . < Y,0N A}t$!*[jፄ '83w%SH8YiL3I ICW9oig*  BNr><1gR[AN>8 qS>h: * r zc>3>jc ?3>jc>3>jc>3>e|g|ˎ9 gmc~ ah8 U#盳G“hE}OAVfV77uw'UKJ?' OCVp$xdu|ns>9RKBVʹ\r"pq9jEjBC1]{\4J9Ґl0R*_g9COYlXel֤frbt3Zo2q:@N(טHxr^K;YߑaQfpKI{)\{UT7m[ۢme32C͏ݚ9co[1~jng1/ < 7z>NHm3ss*O|E1˾Y|6A}E$(V.]:R\Ux4c35k=LJ$(׵sL(pq?P<)= <[*=s8iC'ēXĨzkoRIfO;ԫ?N$%"ģY,E37f!ir߃ f<۵}{_dTNΞPa/Ǩ=P8ކ|[ Ex/5^P"k ԊߙX3@>ޅPHKb2NZXfwYù7٦4NEO?rgfoa_rE1::c놳j= ىw2pZ&ymg)2oK{cRL󿀺%YP/ 6/}3J;skvz@61@6)wuw]=T}nlkmLz[,f>Yh&VnOMMN7GG6 őu<4<2 NobʙZ&LtQw˂Ew{75 ~M wnpR^-|YB?zN7+%]TD~km{E[ coec=jNJQ#n =, :5@=CJ'fX(YFT܁h,v[OBV9\GEsŨd `/)O:)Q`:xΊWKu`6[ ]t"!&kvvج5$Iu/Cx -Y^)N] ݖ"Wģhtfȯ9B=jWO&>iaJmcLu@Vk O@+#B8f?H21K%.Y%GgiO1VmXVJO} O%f%Ƙz1(ҮF CqrģY,cncPr:e E;dR<Y?4t!c)CG*zѩɊpޔf䎤HEj^Z75;jKXu?od؋7Ϟ 36a41󷆳J~+e,TzfWMW0UᘕXMXآ#U  @V7OgfoW+>ՊdWص~JDcCtWFcDXṷhB=pؖLb׋orlnV oW{̳Ws- mIv,qK?N6](do@O.OvuZt}t&tȢjӫBh23آ1$؛P EKgG' ;PBx%5: ҩŀ'T ǂ>kC:t!WMRg~iRR[4 |]m_f8V0)I$M7տi٦x^Q-{4 d 8&JDpiNA|p򌶉Q tMj?|$WqVT}n^gڑ#i{^ x4HW{xMjwV 6j{JIBU.I$.7w Iʒ1]wYXtKlu#&O!?f4E!ˇlq05\Vytw %߻dK=7XG3QۘxȺ(g?kGR?6ds! 'ߐWi{Cv5u Y7ȥ[LL96B-R!~G!_O,T˖']8&d[Br[oi;aM,zkl2eѹ \MIВ$VxyFlH2 #oU $ᘹr6:H uJZuPi52Bt͡`zM[jZo+jls #\z&msOvsVvM٥g Z̭ke+-|(?YXϾ<4eil0KFccoOGf]+|jmʿ2{,N+M! C~Jsud8 9'A d:Sb2ȬU/@V[&~z-W%j}N&=f{J sZ)&Z9km}w}gMHa:h߱4U/v'{OoB\㌫`evpv8+43e`ֵU}eX|mO*Lh׃Og[TK%Lq}b#uxGxO*(c3nV|ʸmk匈Iַp4U2$:}NA69<A&B&!+mOlr tVM.!+imc38~Zx>H?]:BoJB Կaos'% ݝPN\w$܃v.]Uã8|1VVKbvxrB% <Y?TJÒOOɈ$?vp6pa\qH}^@QY r_*0:@$hsvxZG, gV]!'w('1NBlOm Y߀|C,'3\jc0睉T8 3mr@\`g KcY!BZ8xB .gՎʇej>'XѓGi{v@H̑?;A4Pkǭ'N1j⧃!(/7D8p#8#flN,zmI:#| $LvG=Mմ(6JLu(y8y^C(O+%qJx ;^Ei&|i͕u)"x&DȗX!_}J%(*1|㬞IڧC(M&,5a6 m+&1;ԚQ;܁Ԟf +uGLQ@ Z,ؖ2T(OCNSbpSҪ"?S 18&ywAaK`v@|9!$OZ ;iM7I dIy| |RE|nܩ+;1q $lc>I\.{I/&'d?Jj_G!t`tx4KĶ7|x*'y凳IGePon@t2waUp34pЇ|.Bw1T5]u>fAPN|5~ +Y见!N0!ui{BBV:?X]Bm}#uc& W-/^qͭi^6tLWKb8|M| b2^>™~T`z >yU+U,׷BCS-bpfb}X|_q~s9r*g%wzzzh[űзFc&n7FnщwKy5|fv*7z>Nl_3ss*O|E1˾Y|6XVoe]rAvAYԘK*a= Y?o$zaaWVu+/ z:~Ĭ16G@9bIe C6ڑͣ7ooXsrܗI,1Q[ (R,}qa_D!IgDC@af 8̛G3uu退Ly`'Y,Bwm *']gOo_`͊WH p& 6s "_"/ CL9T 0kEm*|5+䘷USP3ya"ހ03n}7FGGs?ޣȱ1!y%P&.դ?5_w!'Vp"WT:~wN-ZZmk;\jG},36m'{`~BģVуtx픊;FwY>rε6k[,f>Y^&VnOMMN7GG6 őu |2AxWjx{R G:xӼN=},rjLj)ά뀬`\T愄 _1Z2wFݳKa1%TCn]/(:|f% گ;"<YdNjpYڽnzkvT]ދ/ؓj8NэOdQ o=Xހ|CٛRcIpvӰUFȏ.;jQUUժ5U;z|;:lkκH[fep|O*Uo-[ֳT/*W/|a"a`,7kbʮ9X u׵dl]Nv*cndWc+_Kfp_'C*Ƅ7!fl(׻Wߊ5Yj?^|Ij1`0vZ]+ Of g^cbαwYykཥmg[ Ix 5%Ja#!ߠQUX곆gIj O;K3t G-!Ջ%.QׅtaJO2D@QVtZF*8 ~^r|l;=87=)ȑbWxP8^|YRL9ԝ^|ET+{m ^͹ r/Y"zWO ?Ѧy$fEBVpj((Zv!H.!><<伶0k꙲oCVJo%l'Fޮ@IR0P 3}eG exO XapզQY#YȳF~@ar{>OG Ϗ]ڎOF -l=gQ7IC_OIx^OϢõ-4Ŭ4?;hڜ q)_B =<~ya8 W*l;&GO!wmU*`V<Vesfre5˯o!CjGDNÕ-V"yAX \ $)G ͉E?fRsִM_[ џҟR\ %@nwx'L@@a Q2?+OZ_kzImUim^e$'(l-M2*m;FxҴz\kXŠ=~EJ0Y-GNۮad{"3ʋ{R7 ~ )~Z@<)Wx:LB '߿d8uYoµvi4bѥCaax4K6cOr˽Ivafwgt0 C6sYVϰpV[ʆ5Tjj "Od_#3_>aymg^f <|ĆxFU~ˌ#NrW|=V3,k=``wE:UXcYqLҏ+.@^H66I_ܴz¢e-cxm;Om?=''|";ަiKkr|9kR,8F ڦ/) J7}kz0IdjW[8R!^ opLiUJˀr a8s)PdhmwfvbHd}Rw8yJ"=966d}Gof/z!/Oo/2W;'Y=s=[~g%wzzzh[űзFc&nuc7D̻߼[|>3Y bx 7z>N~^ewhss*k2=O"f7ϦٚUyYl KT{K_Jy=Ln1 Ke{1w|ro\?ޮz-/Au` ,ҿzB,%]\⧽3NLƿbWhμ U?9͔ҥ߮~{Z1KnTW[1}cw vlc >!CߏPCH-Zr t7%Q.DC@C>ksuj'nc3 CnE'I g5M1yjW !eW"Mf זgBF`j&,ɓ{ B/SI.IEN9lXfQ8?KGndcޕx,uGM/J)O^v5R"Ŷɩ5ds +Wc;skva!&@ZCNstR*:#M~]WG,Ug>[xm߼3WFY3n,+&V団#ȺQc>, I>7kO1%޾Ӊ󗘱*㐅3,oۻ-Jy=?S5 ~M {$hrpiF^-|YB?z2O7+/SMU+Fݾ{X%s|hNP/|"6R+ڔKhSTFZ-%ˈJ>m5 ?)`29VM HF!< t F.aW $d5̕؜.2]1`.XP۽ݖ!I2} 4^c/G$M؛ԟU-Na~o(>c_-NKjCImq)ئnmw6ݩx6bFBYB= YjH9$^{)cltkOHnIf =GjqL*Vy|'02IOA>~I<T#ٖ܃5g, xCnӑt^Qk#Q.)]0?=4w V٣I)BaETS06F1h Q{|zcƶd|:m jOoI>0({n*J3.toZc* -yz܊ "N߂r%\Aꆁ!PdkB}gd-&,:$dO.OۃJ N``, `>> Dpp0HFw 0H}w}[GO@֟NuQ BsERժ~X@OsWœ^<Gaӧ GeM.ki ,db&4-py&4DxҜ\l\dvRZO.³zvi9 @nCE/BoԬr xII&<\N@6ʑmild%>9s$FF^(ZN=y.$g5Juitjsr3?4BrM!!Nbf%h" lcbFLl ?Ć1!uǁؐK'!69`Rw1%6g\b׸R9Ak}.CK'Co."2C.9p48dlfj}yawҚ/aa&!265_ i͗pL(!:mLkHqn5IkMƴ]~Li ~5_ji:vkHYwkkfȓCc9^F CckKKqn,?PVI{42n/rMu(lһ6=‹vE AUt o.G hi ?wivchN^QSil1 [1|ƦYv3JJLڒNY{t& O3(ye2ta;8,1&kiz>SqNkoWS]|RFh30ү!!v`ʆOSm]>p*?k+~a JcgQ>lnk3  >3̵z\z^ ςagy@紀xk]K~Rux~X; f ,0Y-ۈZYDžb2Y퐝Ĝ厀x,S7>w=};.|5 q}DW@<-v <~z4b>$ #Cm?~ҡC4bTK G=p.X >DGxA*c ac~ύK;9< kI^J}ƨgo\S0G'!e0gبuAnùnx@YZw7:]eD-| Yi\ט(Py]cRx5sl]x_Z<َ1qJ +5xtmri_=?dk9OnO!~O'vOC?ROO˸B~iT҃wyIr4C8Lz mdòe)ta?E@hM$'GP$HNmt)L4O_:< Ym=*X-KY7J.Q 9ɻHb2\Rwx ]$ozEnA+=?DbA%x>նULn/Ztp1Mڼ*7Dpibn\ӯk +ܑW8;dHC33wRY]D0 9yk +AV އ?.}L V'tBC۟\$ gNgaG|9@<.R! yKrfb4lZ.٪Y63.'X^ޒea?;ʟ?J'&]ϩhWz/7iIm8iu!j;Hx-;l~ʗQS;pȞ> Nڸh+eLռ.[=W2UCy8>==7,sb;^߫:eUw,hM @^Wq5￀W \:rZ_ƜFeYI0%<:c/lOb0%צ@.E$:62dp=ߛ]]J&!+%Zϫ~(@VJF '1xRw8yJtJV=u'wkdqۜ 'yZC_f=R^m5 j} #uӐ8\ 9ֆe°RLj Ȼ1C3%SĆ8 ֝Br0'!u\OrS ĤGʉ 09ѴL8 YixU`#ǐD9SROYm6'eXoy_vMg#8|_1 >'L~KV-x˾Ϳf1,'b"9&d=KE3۶$[}wG14oےP GTQ4۴iY "< Y$e˩$[ g.!:iӪ)A8陑mWim瓺^rN7,׏|S.&e?~K7?MmNj40sJ>A?D vv NQ1Z_H^qj^78wZ2?@U7"8YiDLlE !{tSLvs+%{a:1 4MyDv+߂er^vCm :fFUr+_AE)Ŏ^#Jk(_ki6 Gv%ѯV5V$kFjpaB4i5h$ Y0M953=}OBoo )pz !Dv.&D~Z Ȟ[*!ܗX<ș9_󶳪@s4nabG ߑIxz%N˒K]ȤC@|D_OkBģY*c,98c_VɴOml˱O,;>::5$0? i^ꅝ+4Ei;g6|ZMcK! \>@(:9^p.$nFp@"YhKw1Z; +–B֯n7 %nqJ]މfopd74*d1i^YQ BV;V)IdÎ/jR49]Kv:p Ezrllxt]&7!+_Kf6||_sܟ\ٰV˦LIX(zXo2q;Ldw 'wE BN. iG"SI]e!(m ^pK,2W;K[9Ŝroj?Ƴ;==X|K{[lXf[c[S7G~ѱykt"o^->],;g!KO7z>ΣQ3"TXǎn=O"f7ϦٚU9l KT{K_JwQ;׏7ƑbnQ+$vkytU`R|g-8?iub25jGstMЮqo,.vHK֊Yr?ߊ{`ұXL%у<߁%;CDA%H@iF} ¾'Jl@\;x+Nȝn`7dѕ]M%5 vrcR[? d18( Rd 3&w᠄ ӯ19C/@ .p_ojJӐ\A㡿uTt#C^)A$Arb2sxra#  -2?mĚ!g&at4*dClEKoAmEKj@eϠ;d,/^ 0!ܯj~'n8|~:o~=1E?zzWucgǾ g!+&Q #( XGW %< J .^dn,X+|]5םH_$ar)֧-֯yN.d_U ~=zА/ ?' 1_xAEKWУsb$[P'|k[J!gV,gr,Ō@09 >N}>Q5gM ڽT<eRN=!Qsd \!-?8}w'b2>1g 5j ? { 1/D8YiVY9]B*W L:yߠ;d~nUi^wp!< prҀgJar9sƈ/ Up! X!?t9&g |. CLƍQgϞc o&V6@'QCJO (Јp5oj}Ƥ#,36m'jooBn_@-0v?Ko44ﺂ?zgGn{εڶ^Y3f|29wMܞZ1ol#Fy|X|No؉7GRV-f=xwrY_Cwn o^п}wBn3>oopkd^-|YB7?zO7+xTª|rolnnW>t}1 Su զCjO GrFx 1jZ-%ˈ:P!oeHx1M'щ"Q-"IKyyQ.-ӐI4|W:UxR.X0 9<+E8P`~Ǟm-RM@f?J&<VqjpC9Vr_fe vdT\>T3[ s,gU0˞С?c~0a0"q g*eˎoXzMBZYH1ȋ7ϞŞ˪LSD!,?+mAV}4n=%ǁsOzf9'^KX٥_I O_(O {e596>$Ti¤Qj EgٶF~1G,109]DC+Eeȗk9c*tv+OtPn$@'Dm,{N[YyĎmiWH{Lg!jy\35jSܠߺkvTkqY;ʶ'yR3g_#C=ŽхBVlE+|k}yݓR1!>ƅEʲf"!+x͐rEOغ Cm׉|A$TAKX*ȚÈt&L>~3NM6!Ki{'Z>omR!GM.(FY;3yT#Je3[i9.K-Ⱦ!P1zgK<"Mʍ砝P|RO]Qr9و H^`?e4.;-=‹՚ȥp|\H׀yJ;F962ԨeqBܭ\ [S  ǟͰTl4^Q/5-}_) MpAx}wwZy3ж.f#~k˞Tí-ms.B;G69n/ss5`Rw 9Dk19?c _Oc͕9.tjfi`/d9ȋTnҮ`Ϡnt͊c v&yceUPXjwU*٩jMjG .϶u׺,jZVuNtl۾"kK[FĿRݓyH'Ab3!Xd]Fr < ~-x IXސLj!^ /ąl Nk媹`4/j;: dYZ,!2W9J T j(3|Y^8ܢn~%[0q~?Km[e~".ZNpA\ ﰀʏ;Ux먤Tv55CXBd[]t 8 yԝAۅV' +kuuB$@H F laǟ(0K;]+ G}nw'!;Jw#[S_w8AwAmnOvBmr Gou/]۟@/ < rDk*v57L(5 zcXms`/[e>{U/~6mdˎi7AO#$ƿ;'6S>Ni '! AV:E.S됯?xQ+[i:ߨ@/ huL11Uz (T"$N!?n}:j'@֟8qiNOO8'"5J}f*dfqP$6\u%>Pr5O.{~2GJ~Y{'+|>O8$|nbO"B} }k"uxR?X&Aȃ&!+25 ֝P{~W:S#gLm uZ#}Z9J['d k̊&B nG[ds&& ,T;H@Vr&&a:(I9y[1;AfxoV. NStW?8~ V,~ 2Wm\p L,k=ӱ ¬dv2S#mjA*e7vsuv*&M9ClNA>z!uG!+5 pje*5j˺Qdǐƀ&w .h u,\#!R;< )Co}Cj' +-yKyHxڞA l]ʳ~n4#uo`QvV_RNNoP qmS_(]8D:[26ۻ.I4;jvKR}O@p\Uɼ?{[/fd#;9 yJAlCN-D# <rV\_V~@@MAEk{ș{#x*.C/ |LOKZH8 wiwCЪ0t0~ 23E?bR-}!eN0};\t`߳i@|o|<慅~œ9iBaMjRZ5Yz%vq}Qz!+ŵp;ǁ 'b3/R ҿ؂; kA/6._G-=iH 9+FZmߒmoLZxZ{gXQEL(֬t *xx4K,c3po&De)~ c}=OTtJzEZitń3k"vxr53hϵOUX%_ @拮hXn\Om^ר!ը>&^&c&㐏k[b&4->4{|"89Ʌ1KuBm+i񴽝[B!l];VJ6],;g!K7z>ΣI?A '>iY,f4[;=2:#ߕmA}o ~W)v6{n1^T2o#VI"Tv"'QXϒ[2ܵq%~!>jdJkK-vՎ̛]ӟLY*]gjFu~76n.I1cJ#T҇XC̨~ To7/(x!  |%4wa2GXw4K(R*l,#r 1H]xƌNyJ5q~ '0`rf|t~R_@} '!'yQ{% !=ᒄ (D4,d.{喺gzձy1+uxrk灟5g#62ar\: L@< }ϒk+7&ա:a4B %*v,CE3זgB&XZ?~R[eXt\_]*dQ>LX%%uW$_ƴ7V )o*t\fB 6~nё}|{5 :h1R;{xXl5ar߀c 3bDrdDfhJ.ʱ39_;{P$B_qU_g^g!g(G+r4:U.ڟ*(RRxBLcGIKC@`a  %36m'j /o_BnߢBTom:"Tt7KwY>Kqε6:h[,f>YQ&VnOMMN7GG6 őu<#y˶BОY+[_k'8db~#*nA >[n o^cSI!W_ẞZEnV0%UAՊy_yu+~C:hWhߴ) `dԺo(YFTfЁHEBIGJEB6l1e5cbl {@hmS{R 66xM/lb6LAx6F8vEOB9׎3_ew}@<+E5:{a«V>+`3ХCOx4Kea+oZi&? [ŪQak ɟ  sޥT[~=]LaKG]babSZGbӁe2ԖgWZ?=c9F?Vi6adbw_ Bզ={11\>c[oGcLR|< !ks>ؚiyu|;F9cl*zku7ҕ&v A>M6jywJu=yêw_f3G!6 ݪ_ff޽7Ld7s91o=*.CDYYE=:S 1_0jc^-/?{%Z|1E&!?~i!p^uv,Cd/O44i)T` ȏh.ԔV5bsRi`uڭGAjA A$ǑԶs[Q2&dAɩO[ de73)aѮ MZ(n/&7'FZ-jb:5lƜW5J|lRDCVVK(4d?hlDZπ/!܅HoaV/*TASN9])WחM~a&2k=Q2)I1n}Lx~![iW'oWwW<\rbn}!֭1A(Dpx=+qSAgR{4 հ{C)=)w)eJ .p dJP].mMcWl^M|H3mf%S:žF5)(:VXHO LT> v\p1JWx43,`.,i9A"qT ?j_WBN`LIc4=\X6v+PKfJU(WKcy[#-,^ ޡ/É !ߡIxBwͷ(PKwH0):|JCډq4vbR}U@90FeS:0~P-l>ji~Xa< &˫3 պhALC d1 8l6_qu4< e -4/I<ܓR?|L\u#"өBg.+-x 1nnx]m2]f8>`Y)ߗЁs|ge~U֫ls Ɇ|atOJq\ I$ gopy۞\*pv*(F>k%p*8^%dZ9L~;& 8yPXaGRҵТ@/wR* o+~Y[mJVgDp~oe( MʠjA>`5 _ OiV1XU)KS +Hi~GQ!3u>߃>HuhzUrdk8LxR?H捥j|p3+G͎ÙBWu*͚'tZyQl9 T |?R }&zˑscU:ps,Zz BtS+۲构 +mDE$< Y GrF<)M!U 5 /"|Y?OGfٵK2. r?vi,۪H/#4,åv[*/ ԺoI #.I}z}~]:lUT:66u۴#ֻ P47,)-51z#lmbN_ 3ǗXD?6M#1s85.3[TJV&"37*Y"oڦzeD;/DړڝHwn*t55D) <XR <YwӋXeb9zA!Y"[wcS=ͽ\(ʕ);Eșhka{QY CD8y@򶿜^|*TW3d qO]N5\1z&̓Q.bQU2SF\{(@7aB@O)jצ6ipeT/B.]pH S~*ZL7::~G0 0HR=ZqusvM/zYÛƖ(0٢JK~ie_g@\R>b }3Y vB^0GݞwڏLl ϩ73zfE̲oM5ϫ##:]$ک wbg'P+}c|G.fUbb{굼H:bՁ*H )~T>ֳ wws~ϴ:1R]9:&hW7SJ~Y%k,Q]o[eFݏ+T=-C>(աL<n5*7, a3ϴc~7Qͮ]V&s]') ~/`|>0d8B32md^.@a{]+4-آ\qt6ܦ IS-cr0'ӤvvY&?y̯T5i#b5| YeWﰪYt~^x=V1ȏ$Q,}CY3{hU}~kXQqG +5zCGēXȨzk5HI}񄼴[ΫTl"d^'aש|/QM,YY HAȃ $uS5-UNx]77-NuoS}$l:7G֩JNR?( ޾g5M1!Ԯ6d_.KP!%;cĮ=2 Qgd3-([̐4P4_VY+b2{+E Z?z\./u[tOb>(e,~L>cWh2;QiKZC‘jK{cR u?HCP/%߶VdMaSA*NY/Ӻ36m'jMa~[@->]MgA_JE'}y0~O ៥Ӿg\mӍS#zedϘ5"_7r{jjrjX9:>Q( 0<+Ѓ߬;SQQ8Cbl\z! {ew{7фk0יo?\ \W _^ nȔrP>BǮ~k6?xŢzW> Q6֣BM:6=Q;S<Yh"[2J v '!LIt8X`Np@MC{'aӬzdH ji`5Mb9>-ym^ҲI{a3$h!~B]= {R e!RN@<ХCO-%ˆXPYr+%c˕^d!'^1.MXZvSN{ݏvyOACڃHip ,myosg*zA-Hv uxRڽnzkvT_v?$|<>G{śgbb8 !ksØj,ϏANzC:UJP8L fYHR,a1^;n.T{^':|Yk%rn[I6r̍cl僳tHHhg/>64EK ]ʦ/uns+ib <oAhFf~٫wZ҄Q//~b8Y5Mhr٬u*uu&˾!'|rÖST#o8Gr쐟/=.@^Hxj;ө 7݁T? /%LE10.Uqx/U;O׽cW9:JE-'iu5'npw8ˮ~,yClQA>^E wkd(ngy^ xآL Fs|3oJg> !k_4lr\{Oa?#VS׎97OؼvDq6H% j7 Zwk*2vj &kg~yQΧѐԍ64\t⬽4m$_2*3setYk,Zt:SzѺ |Y?VD#"u{&~_eOxOa0 @wu?}eKt l_DgD$P3 3eSjpR םY#Mtu#ģIjKV ݩU5!:1m[R `za1i6;HRv1FD ,8d?$s1ZѦRUۜf gb҄QNAjuӐsnmWA#V7 ?k~'FI'>xZމ GىUv+K;:Z|O3 Ô=gf=fXі541? |Y}zA:VqH^ ͮQHmN:]ś:xi__xaJxX^kGqBM~'xa@)?N&*4<<*_䖆 !M4LYÏfF+,87DD+80l4SV*W!_*'eTLNCVM>7i~ )[I 610aҍP`Y\| u]CieBTTzk'‘6q9<Yi/[(|Bc~@dq D:pdkLsx mӨ ` 8y-RIY *=>JrA꺀70MnPojc[ <afv-+:GY9cVly0gd!MQ4> {1Z>btOs'C~yң{R_@<-6}tK$Pt~KG,>?Ʒ#c 1:aȪt D%lYRwx%ٽ D*kJqqހP:p Ԏ8N(,dVyZc[,PR( MFrl0>` 7ߑDm<Q-+E%ƈuYX*P5sXN0d+4qC֏;ʣy9 i`_bGf ܯmfSe;3F=Cĸq@jójatG1 #5$?{r_}/yX^8!{ȥd["Cn~BR>MwǷV-04Q] N'XE3\l2\Q@/,J_%3OD5O5ߤ*pͺé0 Yi%Zk"5P;YAk"iy4@ؼ6$psvB.⚷:Oo@V[Hw=ohE\@tn 'wf1B6dtdMxZ`!V MD+&fyݖd9 {2,!2wadI< ' 7cܦ3b!6@\fw imn5m9$}9)6KT?2 e3"\3eE {Lo6(M){ɓVKA!ȇȤn?p)70rF.EO8F$<`!u$zxR|3hhc [fѥc`: vd(p7綥%.w {nZ(~*Ѥ&0 ?Z[tZMg#1Or4'uC@A֞cjqf ߋ_D*vy|r|]2|r I/RGLzQt O!?m}F?& I9v@Pڮ%'eh&ffQ`ڂDS*DgR@m@WH~%~`xzjtBmZ+SOˇjwPK7Tۏu% ݭsGHMw[wx䚖Tt5'y5h:•jvkJdg!j2PV.u 8yYm[1-:p IcUF s$q(V1G#.Dx rN"\uOC?wr?rfxހGyY,4S'H;Xɹ܆s& $ >$QD<d [$%W_v e3 JiJ$dtS4Y:Y5r)8swB$da! q| Y?nq*0b"XDӐ6wnS!Co)d^r=)("aTS﷾& *l)TG'؍WxRj~Mg Ï7D7!ugCڶwp"ζ=X]CVjejS=<7=**k>sq[{FO0uPqR^CruOAVyCYnQfEtNCoWM$2i-4O27K~F@<4uAݫW:(^=Z4 OQ?,>CDl):"NT}}|"dmq5/; yf'^T+iB%Ë]SF- <YiXÛNV DA/BB"2OT4a!u q,hQFіHM߃t vz'ikO{l<  +RwxamR98v\lgy` r BRwx~tq QLCﴯr^3< !O8 о. һTNx1dՎ5FeنJ-P*> \c RuwCXph]Ao{y(Aa5= ~Aؼ425< 994Rl*Ro{!jF͝59XYka;51Kb ZC% U)l(9|Pe' B-c P;II|` orrHA%ۍ]x!vUo;v)~t(2qm}29C6mZ| ,P!$`ߙaH/ 3C~w8O R ܯmE~(xS4Ҷvs;[аM#|vY_|zfe[^·^&⚣o@UFE`3VwLz'J<dw_Aj~{/Mּ>iu`6Q*f7"7P6|Y)ҽO_P{ x؜pbktҧtH G9&!'c0#i5<\S*!o@%w TGtPwBE1,zPRI@EoGAEؼ]ﺵ^O>1Kt1ߙZ+FԔq`|xʻ}1`r0 ,Ir#TQ :c _O+'x4BUD“f 9`5dL3+veK4oCֿ$U0jjb\Й!feka{B fOPI0dlHiymoӦڨSTCsXα~𡥲%\^^スꥢGUbfK&jϳ - ZC8WDIm\'Ԟ|A&giy9̊pr{:ׁM9߹-8Jr_u!kۤE6w^{ +po4QzFkX9Yp`p㐕׼,۲76t3JpO岼cl1'z^~[']V֯ a/6G 88OD8;<YX١R>joݹ*}K q< 6k![E~/J8Sei,V4X""p<Ѳs:0sP1$p r|+J{)I kIg\Gb'hI'r;X d>`2Ȭ>C/@m~5.+f ׵֊~6(u(.B_ՂZ)A8j]Kp3|~2 ,{lV8Т!p ݄ƘjI 5N`?~mj`ȏzʎra_-5u;+to{_5rf d &e ?w$[HxlBv.U\^J|R)<;_Ι,VIև)}J 2jqΪ0Q6Ef9Ziu1iyop у.@ʺjshƖX[5_2v4%;VI !/U_gmw|v1?n/7J+ Ixڵ\TOy.}l~obP=,NmZnoU<`Rt*= h88i:ÕFa(Vv1Y2?em(pߠfi1eڄ%1^0~ Z&4/\-̷P#؎-2o}_/:Te;o eKm۱"X6oGζrZ9o]ݢ@0 9can#^@6G*Ts"4 Y?8|77-^HO߁1~Clm'[mRV#$W~DZ]&Ġ!C+%F>!S hIQd14>|Y+z(Ga?5 %;)w?E3aS4+ݳ~H8z_ϡ>R]h+{T0"}<#y_-͏X0D\ DP>7tc Mx FNd8vB#||] +˳f2d (O$ hG0Ry ? luvhMBc1Dƀ ߋQm Le(.B֟e]Cw?~TOw4.JxV+@2iemQM R O5!ui.)YGwMiZ~ UrG|&E$6~қCiLar=R=!^jY6r:^ې;1%u9s&D1dQ nrrZӈTnI?Gֻw<s f!o~,pb-HpbcNHPk2L"HS:%Q{uDG f $AX=ME*Dm_"JZY>j-< u.VgczeDt&!M[WnF/JR*.?  [*2|6#ȰY#ެiJ؊@sf$UAW( 0YD3V'ߠFX/K/@sguDN:)1XIګIE%ȗ- ǚ-7$ +pP ܣm61><]MOI,~~wvFG^ 9WˇI% oSISM0B8`oz{0k>4\~՗/ ނ*׵Nm1lbx6w~)~gFNR@sL9'q=[VV!=.KyJ.?pll4;vsjbz nMgщ%_xt~aYD;g!- }wg><0ӮgݶLl ϩO#F|ⳬ+fWK̲u+##6=Hw /Pzb԰q_.+i>淿EKI."^_IG\~:ЮпC_)^v ιO{gmHiɮQ:.~\)KKS֪Yp ~7v.w"JR>F,yJT 3})C^7L?rYPo%[:KKkPNwQ[4@'glZn6gH6D+ < d~)Dh <YjLCJiʛieȗ =`*R>K(Mp Ldfp qF(lKᒦ#|YXCrov8Sr7J+y !S$ 1 e-ʿ %Q;f6,3({gH+u,0#dYl ol|pI1vmQL /_B~ΌԿ&. Oև0tNvt##-<1c0 YiFA6| FC/ϲ,F0\Mh_>A}qT&! EޫKKLx4ݥͮ_;5$r_l$g- R+f!gc}a5᤯8yOlQ<'e%Dc++o Dq$(l n#7*fBwq]aU<9 H]xF,mN1gwiAq[ጿTTN3p_L_C_C4霤4ddTTϛK_&K_J4c/; KDKJ3ϴ;^sS9-kw~zkw~6{/#ٛ˾gQ`<Ybr_q M?>XBz@D 'w/i\;b(FN#CPBЪWޕN߿bCģZ ֊c8/^ IaB)/C4N_0)mAH\`~ڬ&*zH^ie %<ц:Bw1c>S052V%IfQ0.w G&Pqo=0Y>yG]GS8c s( ;!bGf=͂2vv!_}zsR5%9u#V9!I:QLwGݩ'J *SkLIey#< Y7mur[#B`-8{+6ʥ.E7`0RkYsƧ!?. c{+.x3gc~{jѧ_EP)G;u{icoW|any"Jk%IQG \ؓCÌ879vc/%äiBF9 5'rTk*󝋨9!+)~j7'!9~cO˃K ~:$r Dc>g&}{i[x?51r~klM.l/\? ٍ @ж~C|/BR q50lMqlR5pٍFDe8y5Fށ?rRJ_@~U C>k( %u_0hd- CԝP0O خ0*a~ਢ$P ~Z Wy!VCbk^PgJ!2\!u׀S?P86Xs:E|ՎxMC~Y^ָMe4P0UrF%Y騇\IjoCV ԊYK Ē@YJ7V:+x l[ j!v+GdgҜ6K קJĆa|TcU^LTlZ]I%:fM=BIj9je/jg0h:腳sHA}O`kzw%Zi`Ԇ6gIARN@<-xMI\{ŊLs^6x2a=jȌ!OX"H]xMm ⚷&UOi= Bf:VmNd;",{7f 6U}hy0![K86N0TjQ5#x٥ `D挋b=Sd=MWlϳ72nyCQA`:Lrx=Q 0`rF$2*ƈp:0&쥨M(3ېVMFsWI{2>skʭvo daf}^f\7WrcFl,-rds3O g|-U-`+A ';<#Gbtƈ٬D05#ȣJz6ԏ YBg։HN4@s"6 Ӌf29Sz@>2,ּ-¶V.-~vy\O(\]6 cf7a\R; YB 7S,W|9 VR! . G7YD ΎH2 j2[EUWc&u|#SI T)Gi9EF i;y\`)IUPD1dɱ7*K9m_f<+9 <TOCVJOR7;YC>YzS7ls8Y) CHH/ $d35 ^97jCF/_+(ww {Dhe ì4CWGhkKll8&S _^mp[&Dwqْ%j(͒,RFnۡ fmv*( 䥸,{7lI>blmA F0ųI- %@MBu,2t:(ˮ‚bq(=WB<q»['\SfykutLӉzŸ@$y^=Ǫ3،- "CU0"| å+& w ڶCJ@c~p~_-]I#hXzN1 HxMA>*b;֒jo'#HaJg[ 9<\k,rxyjQX`! x I׆#Pu`$M.G6R&DZLe/yE!b4\tAnfM@֏R3xcJo$Cֿ:d1oˮ^yc'M0hY%s GC0 1! sD!YmnaU r oA/n Y?Wo:rdQF#8ͳk (;+eG!>!3_ ; w(WAB4ģZTΐ~A4Gl%]$žKz -PSxU#բxQsxnBCtH.B֟G-7~UئM ' ,o=+(eɖԿOP9ԏiv|J0SuP!ԋk)4VB;a+R:)4Vwn*Tlӑ7*ނg~Xs"6dÄ7A֟ UP}KwTp$<ǖMz!ybĬbאBA/@VtD%wҖAVW]!1ÌMi_%rl '~_/V םc V'!l.)C.RZ 5)}ٲnDO -`ʏ?jj=l:;kȝY}Z=9O{`S̤9(XwXFVj9ǬUY?@8Sm-$^I5 NSbg>2r'B\.G!~o5ζyS+1UJ+PNu\Vѩ;ЖH[wGץOaTJLXL1'K֯ yz$}$4iI]' d14x6*|rlx{% OBol鞫pUԊd̵"=WᒫB=WQ=Vgv5Z+ӵMٛnku5Zks .f\K=Mu#{;_{[Oh?n$LAVOʹ:\"mpS (\r7VSX*EӂUM'ӂ =rj9-8Hg<" *dT:Q/' hw~$< 9 #;G@ 4 ly0á !9p7p7PRBrNIxr as lzZS]*dMrY3|Y3| I!+ʮpƍ:~θZ܀3n17mv 8Fg,61) "\?f"IgExCg!nTCx\1j^vM(vy l:bVҥSJfCģVRuaY9:$݄}6"< Yz1zV{\(T.pEtVVOxEy[-[ !/jϮC[bn' \!<9KKS[76E~6be׳ruvʧ<C@UtN: Iu+[ې67^J#̱bj!^H"d}nhʁa9Ak} !glѱb =}̸|B!{T UA254l' ϐ[p$Z:m&x1rMvĞŮEI"O3sΙ&>xx r ,Nmg?N|شEJ\AAom~13:<<>:*|+0+G+gjތtCm&I{^ivdM挑Q2w-Y?cR~5uD>#b <;].;QȣIxZM[B'cxet2A6>5i4}l;EMG$~HIhII?_}BplmΛY喍-:Q.x wt]~N8?">߲ɷ#?݄#nJ#қ=^H/ dY0y.\MqeBV{:^ GveH&W!yZD] aҭf1+^6i66R4FVRw8yJ"66sL9'q=[VV!=.KyJ.>fnNML|QdbND-å K" TfDw;/7@{*ss*ӈ#,kYƊ. m+k;k# +ۃ_^{W_|[)v{v1jظ/4޸~{n~;Q"W?ߩ5WǺ݂s.wf['"RZ_jvԷμ jWw(j/[fm4VL8X9X4y;c)c#|"} ;~<ѳ'Xm?Tyo7/kfRx[˽t~2ⅈG_{`lZ`Irx߄}b |NrfYpɱ&u) 4Y<|߲aXH_?pɤ=ԏ '({/QO;ԫȇޕNO *!|-0NZ?߰\RS'{qlE=w[V? &?Н?=Y=6,ᶹ`lGπ !1[Oo96մϐ0Έqo G2MJ9k։?!T_BM4H0Ʒ5vnZ O {]rniҫCE#MxZ£E෿E v/È+揢5Ϛ6, + M˓Y%BVjH2/i3Ƒ @;څxo3lZ[/|?E ԈU@[slZdW8@̿cy*e;) !k@ٽ}낱b*Z%!|Yz?!* &ͷFptUC@~׺B O; +E v/1l>㋐m^x^@㹷:PqFsH~|?QC>[x혻6J#KƬFFfՙɩUcezt|d30#-𝖾s*`q~"jqTDޟ\*JkG0*vp?i奚L7{.?'9/tW}z-2/<|M}]}?%Ud~gw]p(߅QK-jiTװ_S 쇬rjݷl,Q܁7QVZmR? ^w7% [|vTM.xbK."-.{a^"&eÈa.آv-k."xr(Kx,Y8`㐏8aKx8~Xd?R[NN+٣ZCO 'n<5k|ƖN:ݰHw{ u* [8w(i$aK D[d&m 8f pw Q2` \ OL -b G69zU_iz`DÝ2 ?.`]:M4 "l ;AkM 휛BMwt.roG4Ԛ\69p=CކQwn拠 _ĭAB%ӵe0be/d-Bm)XfyWh4ރ|F$Q4bi:"ͷXoZ&JXwj*-TFy rq:KUs(O˓bKUϙ*R)FGGy#LANjڋkB&i6Tm41V P琟kkbG =;5f.T 8jrfG d^5"j6daV&ƚ|cքw// 7/ڔ/A.0I3,ƺ{UuԞ^|u$eu7 O}Z.x | i]h`抯v|'_Ghs|Uz]p61jaVVca+! GwcygAPX&mG;x,>cami`ЕmZQp%<ֆ']X8 c˖/;} cQ`jF0quYI$Ԛ=ovr5m6-(vuL%=R!XO"x%{^KGqT`|H]CVv^BW0Tu"Iia#k̍@Anu%#7r5ѫO^8y 6>ЭuAV Q&pxO='iCwvIDkJ.63d663L“g+ <@l|3o9B87nmfC7nyU(AJ[|||~M1D`6x-xzuZI(:yz fԝ|v1 {3lpgSDFc'? 6n~ fys(q͈lI]7P+^[OO m=UN=Y-JMek?- Ml#SB+)^[_la yA ʷ=Ŀڰ0"̜M7=n W>Rx4iP Php"䒤~➙f:vhMFRif{)&Bt^r 4 f ASh$yЛP0/6)o.I#KJ^#Ws4\ g<"*'a pՄԎ&\1\ W4T&m. &y |Yɐk0 GUlu# G\%Tϑm> kAn>uBwZo@RW@<-o>6(L\ugF !eJ@XqB3*-3܈Q<[TAǐk'Ts`:G6ldswo h`X9WdɆ|ɖNXM|=͆kf|gE 7̘j{R7F+e˶SB #rrԓ[!v?O۩ NumbI`b |7=[6?fJ;4H}O!mSTv@V}9u G:j45FR{ĺt$g!ͭ~ @, ԯ}u>M.0ӿb-n֫CFI &mR!*#!=^[cg&ҪÐhv|f9MU暞08 5B| Dx]B|(p`۩(AgC K5g엱' e ~ 9Q*45&b{=(=y {7JU$ IT">=n%u]6v(E2ǀ'!2gc/CVJz*oS+4N{ګSלϲ`Z, oKUY%٦3?I!Ƿ>^keW2OC5.A65цQ7JV)K%tO c <33Uw- ]J\E#u{i;(fC3tDj18ǫ 9~Y?#_O۞_ؼg?+K!+7=19tD(ld()Eъ:Py?wc7Zg 2 |Kjpݯ "gCa:)(F-[7-sruR03"Eg?v-O(^O!ϑ[@)c;-HǘDN&30%-|dFrC꺀+5rvv 7g 'L`##zKѽAxtHŦSo@Fkl: 4 Hx4i =JpSO8y 9#rTBڎB>m(| Obw8Yi+d>yMDBV:T&WI"du>Vrt(0 qr}jȚN= YOnI|dWV]I+0:XDz,djH 07kj55zn}CR+0XOCV;۰%JYRw'x0~t]zHw &G`0.@G%#f^A'Co}Bfě'l^nU`BVa70\[74!n&vT2 IW<^F~1ͳH Z~5h:mhqt,lFHL&K~@(SI^e` K& N:U\^d^G4f&shdd7)=v`r}0Aj~BjA._O˻jql‖_@- SsUc,K_]n+6u1 :Gx{:pN i'rVNN:IW{=V#}?(`L +5ϻq)mȷ҃P; 1U$u׀w[Z]I]hw}"p&1paT v8yI-چuڦ?TBdNB3w^tBmRWMIxb*J@j VR! ӥSH7#GLQ56 cVytCer+n֝jgo%])J[z>܂#nyQ۔0ᤐwG_hSgu|n"a-nVֳ&q_">3y,R7YiXYs=,A~M<1E !<|ln"s8 ;CIf!gG!W+[jT2 nk2^2HVиGUXe5_*,_߃ϔr쀬6ǐ[$ +r~A:=6֔}^7ZpLa2b^#`T^G?.+ [i\A SFh߄ I4dH#K޺'vI]u'f:$a? Ȗ d /@m%D!؉%P6iJ;msxҡqԮA?g-_+SU4?flO;6r^6v NBm:kwBonO1~$d:Gݷy۴4t}BM%l/?hx+QZP; 4Rlc F|*6HW}fԥW*yf O~ jdad519}IrG?Y ݫyF߀ m*_*` R9Z.M7I \~;êy5۱LwVoငZfysmvDuw&2@↙oIZq`Q8BXfA7ˈ?dL~;g) v ҉M.A^.)wظ׬$}n;=)1Yik\JN3ՒflЦ 2asC̈́tոĈ0B΂KXֶ|C< U!=J¯C֏op{{xcCh{-; Mx -}b߷|jZr3쩹m:?GGT? ?:G<}>Ga9{|YmCS}UI琟7$uA֟?!Mϰ t#BK<61A!ofIr.xA?EC>|7&u@ii Ll?o |&\Y"/!f~dâeף4k ~ExڦƸF8yFNA?33e4t=SĂƐs!rc!_:̺.Q@[k"0c3yff.I?$RjSk~lv& RИ_:(_(LB^KͲ ^ 62=n'0[*TSHp Kj/ +mukH-Kk# O) *Cazs :R]/Cm|RxI~k81<ӄ0I~Ř9qj>dqG2|)-3K}!?M1 .~osEBk_5χ]4VD[8>4KLVR!Ǘhg!+ZK: m3?ة?*L.DOBMc%Ηs> !K\0d=ϻ͍۰])p' +N1+FIȓmRހvio0MT!&Sy[E?$1VQ ClWǡ FD-cfec(6gH]'0cTHMz*M.-YpOS'vch?mucefj9.Qf;hxR0klQ\0cU!1Y,1p:\˰q  6TGjC֟yn$<2'xcgh膽]O i)̈7#@MMOC}| ) n o3t (A}eMoBƽ*@i~Ag!߰'[Ѥq?ʖTvYx&aȇcn: |#vׁǛ1ny'i9w qN1ET!Rw8 Yip:xށ|'B~y.ެEh oH3hҘK7ƚc<(>;Qk; s7p<]aYn5fڠ1L0r'mP앝bpLMañU]yb2 <6eӐ094 Vd=>v^T~n/5; w4!NNNB>Ul?d婰9 <\+|^M/Be8ʲyZ4Oj)2dIz" gyR 9Og}ozS|$ylWB>Bm'0<663:<<>:*^qJ 6|"x, rLބgkRM{< ڜ+'/>0l,HXݭQ7P'VE;7syBπ_71G.A֏c8 +rp[B/v/UopddxrLE=S !5jY!c |ƀǛ˒ zC~G;<# {[ k4b'>b~,[;;21k;k# ;Bڻ(/2|RN{%ULV`p_>u'$~+dQ(;nz%\G_@rf[f 9cse4 P5[{g˙Nh>A} ^tLC:?FBzjƐJJ33P bai+ѵZΕS41rÕOKw 3{.Gy3\J僴tHҥHx!+]i8W[jd8+jzȌ!`ze7!Oo 0{ zf:o]:] љ>DЩMIaiw(p2_. :|C~ŠH7Ex7: T4Ժo_,TW^I}mj>@zM^]:Y" Gbl>nmT^?|cL i- nKM DO!X ?;;O{Hxb*eNےSڵHC@6tP?L3!}H#X%7L7: <9Md馿KL7|^MI?^| WPE~E5ѯ uWPO~%:+'!_l~K/ΐ+cԓ: 4P|nኄ%? <YVMU6-nUxlUx&Zzү !3Iq j.yePj#958㯡>$ckp_C}TkLıD1Mude~qJI9Iœ$< dvפs7=ykt빨v#xx=o$ Jj*W!+כ#iTe4Aui>wG^|W:k$) k9~"+F;޺cy\C֏t-yG$ dCV2fo=cMK4<'gds7+Oa)Sͫ <1*}T0b]Qop4 Ӑ,Ӿ-OAro,AwXoI+C]H5˷p,Hg`Hx~_xj gL^.z(oRzO䛬.ߪ1sfjIoq-?E$ᗮ8lF@wЭ%rdI7A0 9MOz+{( I֪}qd$ @֟no^Κ`^:hSnWXeo >s*_%3f=-:yO$ kR>t֊c^BctDK#LANi IWDOQ  Іz'|0\pk;\~9 㭵Q`nx(F[ ;n+5E{(R]|`p_x;F W&Y^.a|];x58j6\5AA.KIA0x3n`h8i?n[q#G`CG|W.rf t43b3Uf~cFdž<6 L ܰv3#!|k_hqK %5a|-| CwԠS~ zP{+(R UOWmyKkױU'lD H`J_5T\6tYhy߱z<=y+&Qߘ[o[oBģv|ڡ3N#}(~7?U~׎d#FidϘ5;:3559jLl#FqM _h=wB}U|pIڻlxh!ڤg`}r8>R^oN!d඀jyJFUKt(QC~_DwYHfP&LRI'L*Rщw#K1w!.MF<@d)/oy,6h+r啊,K0(ބ|SJD_Wt; iE2"pxco%Mhd:dR-m16އx QzDtNBںzD( @hk44~oDtb}eXk4[9hkJ;ԋ]'ubxtas`"iLYD') >yᬱsnvclF&KKf;۲fi B֏!0cŤ?~ ŷSh-Ph5'S#ob~;$`añ5XGlIY`rVd=< աr| N6칂nla&\W[{&g?]NtA΁<X59ռ]x̽t> /,6^y& v.?6pg" `Oc7Oؼxfy7fI`/d)D,MoBhVڑ E~KTp?WZKp?pҀa?ޔl'Gl!+r>JW7RX@<4Ss$ Y9[ ݩU5!:}c6~yBVZةO#rN 'Z_?HI;J:6;%)pK )wHSηcI&+ ,/'|E=ԿO="bS=RS(k|Ï[&^|-c$ە18w:pOg].v"b7#M߃6$`iה^v)Q}>s _$4C+30f7eOVUlr(dP*)ȩX$"V>*5Z Bf8y5NC6\V.V?ǐǷ)j\ ARbjyfi Q*{TScgHg KBm30\Ǚ$"CMa$\qK͂lψ̒U+1‡rN*] a**UTBqaJ6LWkeM[e4:e/m`U8I8YS?fi}^ђL |FD 9,>B꺀!+MԔD4Jo&;E!+$bTu&rgVqѤ!?5AC_hTcV J#+:v|{.R_@<-﹮ͱy=Wt$d| :>4w3;T/ESMK0.&1Rw8yHۓOd 1yڼ$[¶p>QvNE al7=**3rYmlzYRBS|RД?AݜMB~H|B֧‡%K1Y3Jxf[aZvVOB>|%u]SOi{P-~+g=F^TbWIdƁӐMބDT:$3ѤqUp?Q6eEӤ\FƉ ?GdK \LR CpiT}m#UY#`K8 y-m(6>Tח ̚߆@.` rJT8+륤"0ܡ?w/9 MBlnqzTV i-SL xR!o3 dA3lJչ)}8 CCѵ׫ J!j?BIA%{2^Cj W et: !/8o@`qW%>}66daTL ԝ׀W۞}cVi"5 \ 6keO֊lv#>G֦ Ӭttv$LCn4A֟>tG 'G,rQPVt)l!gy3s $?wNݕ.bux@8;"Cn~BR,䬶;K<..G=|gLdU PiT7AJ1^cᗂ8 bts80{EQ&ģI&yY07e߆fv-a+ls dF.}FAۍdx;QD찍ԥOFmoTl\lVbR{=V_R?/ Ms=wırrШ~^1 LTɒ^W;R#>qR0k޺< Y)gG5\M.ݏuK@+k]6Y: YOzw;E/9KWyYO9ATA>|G&u2r0'IyvIC֑aDoM7w2ua;V( p7BiD] 7H dQT:("ģI/oێ-Dҭ8 2)Q}ϷSkyRwO֛ s"yG_XmO8 xr*k-D% l>KqKO V7j;v6& 9v@Pڮ% 4uNWS݈Q`rVygrg^⤪KM έ:F,sV97͂xZ`;Cnvɶ!o')cMU_:@꺀}MrV\H~%~uqQT gj~X@<-ZBؼ~dH\؟=2SGj.Ÿ;%2? |Y?0擞yh%)~Mz6l ѺOl lRw٘H @[|R_))ԞDw=W]2Ȣ]iO];m4۹Ip4q7]]butm(ו(És)~+mLugp$dls*(ܗ _$r#[ķ%՘x>;j'+7)E_V5کDDӐLŒS!Co&Y{Ն&vT0u|raHj1P{7դ~A@!ͦz)]T'7 o$P>Wl5Gp4Gë ~;CM55K}O!?65jW7!Y^S w#/ …{1J;Fpr|ݑm( ;v˨,)-Jlj!|A05 IV//+ ϐrx ,rB!RJZَ؜`~Nm>]P3h ۞A'  '"5 X}A1,S  V0VLʣ&]l^]Eȋeb1J|d8ߞiAP}ձAup3e>Ci:l`V l+I*oy 5 sU;4[RGx3c턈4.8sރ|7P V~REY/ sd2{cI2EHJcLR!~i^Nޚx4ʾٖ䒇UyO13{S H7A -gI~IEie? }+;E~Ǻ-]);:oVp_r3JM;ԫ:M'iV [_-0`fcY~0OV6[v]a/rVܺt g#|Y{XeY76Mqmfr -c+qn A(މm{ jvOR=YO hxJPK.38+xӬPXzlffrHX0eȗ ˟7˦ Ak~u_ me9YYm'{RdYWf>+F߀ jiO MYɮ6/U.cWg&f|~s+L}kpd"ITrclYąs8 YmoL H:1 SpOeWrgGF/fmgmwe{ k*Ϩ Y Ũ-dE{17`~;Q"2RF."^_IG\~:ЮпC_)^v ιO{gmHiɮQ:.~\)KKS֪Yp ~7v.w"JR>F,yN&}+vP!8vB͎=wL=7*ͼ75x3ҋDC@V]sXu8(^Opb}{e;NE؁rm񨽀ƻ w P섊;7ww{?:}#9[x؝99mFYn,P3SSSf.?aGx+ fp=w6}=ѕэNnDUwY"Nv ⫗7~g__չ@xlg/|B?zշW0-*/@;aSO>alM iXC'&ygXzwaDFoLىUP~{ _jHe(j.O@ ,45ڻ\T!"da xn4\ƺ['_՚f-9V.Z^z4;a)nJaU# 6c.Ul'2W!_W!%:@h;" eۏd1>8_е$|Z^H' nI99&7~\H&;NabO:p?O?k#^|L |{x% Pvt::<9 lN\!cP:; Tm+ jԕlKC̮B~F;5[ҐG≩ gg"F/Ԣgw4#&uДX)pCX.[~RM¯%mYB ؓepnA-\ uI` 0 DBcQY3J%.9V,'akCUY_&A~OI&.^dL%靃[K4<1omІΨ%80UJSr>v"LCV ojyLNi & ٩z_G!#Jmm+Ă a5I C' 3.@7a<}wY.D R5VN`83m(-[q<s ;y:} !+F+>HWkRX@<4ѢKqt 1\Qk!5{=đJ[N`|Q:Q<N) rSii%Zrme AJmtGL'!{tw^bP7>W׋F,sI4܎pxkTخy 5FJLjP dmVeU4JB[T ux8 g ϴDWgMElu& w!mCuؖW%ZDuuE,i0H"]+ <%<\O޳y-4s$gX:WmE@(%K6Kg%܄oo{c1oAzg!+5 x9j9$8@5q$ZacaGR&I:_aЌ)ڷ \se3L'cXʈ-=_H PMpUul:=1@i x-bj Oi[;Ɔ'oJeb1NıM?줮ғ7s\ٴ֊TKMeXȽ1~ȩ7";Yi^2"㋄¤W;?Yߑ;!N|:|[r>sL9'q=[5۳;;;M{tXj;Fc7&Gpt([ՋKOE}ѻ3iw"SbTtcY ϩ,3ze _1KZ`{^ɝHcߕA/n`/sg.F 墽߉"1.{M%s@^XC)~|{-:?}iu""u&jG}̻pů,.Nj/[fm4VLqY}],|՝A0KqyRz:TPy&֞e;csa}>A}q! V)Dt&-?D\s`&Z`&uI` ONI'Bz9Űs>C>ksꜩ||hgg|$LtI 'D4 j>Ov"Z/9C]*Շw.r k`a3DJ( 1&MS" !/J.oRkPY=>P߱B04[NV>}1Fao-icvXId  h<;CgQ섊;6t,*V?kQY3fͿ75ė'Vg&V\~d(T _h=wB OET06\EIČ;UoP_u.wi?0wʻw Å*}-jgR#GF̎MP70dPe`j.1{3txeSF*I0 7b4gyFU ӯIllHxMץKz>hЪC$`._B98 >WY\9r.1m Oܘ sq>0*9v̇x˶a׶Oןj]ΛnαJ0ʉYݸU n\'Yav7~4_˴c) esҫ`m?|2l[A}:!5⧋m}%wHTngH ݜQ0L^o-7+x۾80u \c]vF [7tf6W366~4ߊh8d?h$*Z>Y[PI%;;;`Bm^\7#^K/p !C͏\Ag3B"ʥo{˕mׁ¹+MWi. 卢; duyܺOTxC5$..˵<ۋ̝,pxqhԥ'v}_N&!?֦6D:yZgѵi|1~D8Yih|U#^QN@V2\kE'!OjhJ֥ c.5WR % _N >e?E8"<]tN [A ؼ~r>R<idB@<,P{m BOlYUya^+0K\+򟪟4-s 6e0]&x^I츦Q[%JCañUdz0 YigXo) HWZb4~[:Gq/1yI3}J%oIb@XBwMXc0SV="L`sfOSBOΫBRwx=mȕ2U*b `Q\U6-dp9)f4 ZQ2~e~ &/:GY'SB2ʪ`җ5;UI]w)﫩 2Ȭ569M.e  6̛ :r(kZwVl|9?y@8ө U֮"=$d9W9"ug /t"Q><_uWu&*SD媰Ve8 yV(~G ^Pe+6|6Ty[ce&ALQXbNfU<&Q[b%. x )\E|'GN[$# 1LaV'Ԇs_.R' Mg ; w(We ;mfb~N?8L"Deغfv՚n&F#vN7 L+4Ltؚf֕@t|*z3E{ w㕰Ys<ǵy0|d'2׼KS5jڵx暯7kyyREMɧ&ӻEau ~G|~KU0\~T7+ 9~llO澻f+vR(W#I5F o528N-0ԫ{8WhbO d[X/ERqIZPș%pN;85fZG*-lU#RY9j5K턓0 0gԞ|PL*7 GrDhl2Qͭ!: YmqkHU[kpqDyjvkHR,l!3BqٺFF!/"\ 6ʢ  5)slx05´^Dz/P{ 1&_OL?l8k ܑvկwGIy; ʛjiiy|L#XfT0Z6Q3Sc/ kNBV +R_ּK7ֺ|6 3\fB5Ixu>C\CVg'3 d,5Od|t|~!w8loy< o!ԏkqO8줮xam0Z rwҩ.FQ!rgXF0\d,c ^qT٠[xRqellY:'`,BahۛIL4slJPj5; i񌕂Iì ?d@^MT&[]I}Z@<-Mn{5MDX77dNYm/zTDܩ=~x]@i~AG!+Vԏ ٭ʍ8CVcZR?! *SOslbb>VX%J=s1VeL^r Z5ry ><*ԩZy )X? yݛ*[%ڪ : lƪ5I[*CRVeWelU#N#˝u$ wmkzHq1dC ?!r6TFpoy`ZIWxҪHABwr=z (䣱{{i1Z#* +YZ=Rw x>QitLn0};ƖQ! Uf&p=!nkH񴼭 |cښ>Tכ"$pRpn57Сȼ/𛹹ӑY ۓ{i[' ϋ.M/h$&ߴ |phk,j"m0ԏ < juQ(7jo۴Fr;ģp%"ͷcʳ)}OXr_lI,˙[.96YۑA`(‘ *D@i#QTF[%hkE&UdT?RxS;|"`gOD%unG +ew VM$(dHuA>YH 8dyǼgTҭ5j?spH㼝&9! OB>$fT<d~ qIw.#&IU7x<3VG pO:gCˮiq;" |hk!D+Kw[9J̯ ϲ!fl6"< Ym~VtgBǚciچ-T0IZ+Z'EQ2H(-{xːނ+\wksMY1ʤGMf1LH'z :u)--@D\{c\svˮglOMGl2oUI]'0 OӑQY[d> K#̱bj!I"0ls{166:~cxxltrLy/0,G0S}108ce {q>"$wGn#hktgH)8 [y|݄w/_W.ؓg:ENw;v4)-lAē[o5 uې՚Iwxi>5>lw1 ' ḺrlreZ+gS.5a%#X3KB*ʛ"#A-qJ#V> oCaP*H7(!)| !|:|[r>sL9'q=[VV!=.KyJ.>fnNML|QdbND-å K" < l;vy'4s3nn TXG>Yf],mi]$Bڻ J4^zb԰q_.+iƾ(rcEvk+TV )~|{-:?}iu""u&jG}̻pů,.Nj/[fm4VL8X9X Y݉+KD#!, V>?*Mx75x1sDC@['< 6AZJ|nUj!ir Amrgʹv{ѺFVb2Wb+WXżY2S^D!p%oFe,;SM4~=0Kdv]gp5 I4B{>2vQWdM eXXk g?$ icHn2"α!yD6ַ$ͷFаg:zt/B;Ev̍+YIw}b3Js{v[o|/D<:3559jLl#FqDh;-}NoUZ 5ȣ=zMχ! MkG}&'P׽gϟxI }Uw^- ?P'㟬~UcE~]ǣEcLhñxZDJ(Ј۵+NTOU_PCe4;6: 0xb2Ђ Ez-)}ŞSuIڝ6qy4FyWhT:a)$O[e5R?. EuҡO@WDj\9rc#6ed8B~m|dW= {4SOfD.YݘUmnL'Y'n?Ze:kM fodX l߭y˥W'D0k2Q֯LV9Rt.Ph/T$W| ?qt '!O3]cQ{ ]== !ՊCtz?oE~cV8T?H4ژ%ZX}G'\ Ď Fޝ^1bJP0Ly,zedLxm+OP+0K[l4Êv(*-e%' ODB$IJmT]<ՆُWyY*KC>\=WO$Z N3 vg+Փh>ߛteo5˞Hv>s6XuH6/^|#"q` rJL]tU.BUT#Tda֘& i2+r7oC&h `?|H(f ¨nKLl`x W.X֙~5y GwA+?[s-Rwx D/AUu$2P) 1@iK & {i:K; +yV6*~}Q0# k mlf Vٵt.Lp\M9TxAST) 1^1Jn7MF!+J$K!ރ|/FG ڝP;y^IϽi^HU.n }G,֗i,ns5 Cϼl׻08텬?,]HA YXcG\2Q55JE0BbEQ̾xd"'v\ج8P-*>![p>i5VC$rW _͇:;OoN 'w\DODRw8 yTf݊]KT/K(uMᕗvMk"iyty]SI@- e;suRJ8lSJFeA˥ON™%Tw6\GkQ$#{` k~oEƁ^y9I}m*32&t+lFD'QRI(umPQ1{ɩX "䋭 de}\^_E,rjad^$Wd $daȁlpB3q8yNƓvnpr{:ӁM96az[@꺀1?γm=܎e5SmG7QXÜ3w3p㐏k&(5fu}.60m4%'!d%‰KY: _"l-q dY9"u' 63L*w>juUz8ށ|G`Dz䭢US,k6QCV |]N@Vڰ]; L OxI kIg\Y#[}O +aQ?u>4Ga*Q9 dY}^HT4tٯ<.d8y:QL!/jS=DXy29fe &;v9%e RX@<1re60Ȼl9?R! Ŷ.TG*GB~WY+Zn RIa4ː/kJw7DQ#&u-ȷbT+ې3]]W1ڌ*{%x*p"fݷ{ ]^A˒@An˒pZ!~zaGA W]]KM~a?hýhqΕD.KO@V+]R cNq YDDrF8^gXFq] y%ָ IzqQ]:-`}Yo‘{jD5tʉe(ͤ

nV[vV H4 I .@5Fc#A$H HYPPFWOU5@x4-$˲$'NdߜqNxI2ٜXv"hF}UI[_uU o$Wp{1MӬ66R}149BMTN0HmxGw'H Qϥ+Yh*>#$fOAQ/QQ'tXkH1ic=2AXǐ.5>,אIla~Axq(1,4*ƐУ -,+,40w$kxnV)[wU-'H*'`vqDR9 Y$HTN.PғLͣx; 7*LHJ?46er'FCWm 1fEӱck;U%z"d P!UIЛCOߐID(}KF[%u!5dlׂ?@5ȌQ{g(diLpVeX]힪n d!N2?<SmLVόde' 4 dD̈́:o"o"5Trc eD3Vkk4 uǺ5*K R9JijA/ɛ7&3'1:"< Yl6]/XuZZ WE肒%{fW 5to4 r,&w޺9!DM}w4UEzV*g/Ur>\3mg~'ieޣ|D; ^=!BV<.4;d7QPB-MeRNP;|Y> H!GɉkccW';A2[{!qcreƼSc<FBKzн 74Wm' H(asP1lk:~1Hi^F>+cL dWR YAf>T1y]#d!o uw!w\(ͣ>nNMMLpw4je(g[pw4P}G_8[,5f:[_M^/+I?~~^8qegmꐶni~2xҦ);&`??,/VŴ\uPNzQ={$Af/E "ϴue}1MR6lQ4,#{Y49u5yO@dnC?ҽQ@Dz! %t Z %%^ , oolYirYgi8D2Y&0Y۳:],}wQQ{OCC:*N1ܳKU{1׾D.a\co׽IW\x6ЩRLX[1ܵ?pmLk'SZc/TZ{g6uN~+e.wŪݷd7n*𓭘8F]$eM &#G;Jw@Xw X7F,+7/UQ.D+xʞץ8O VaC#i.Ν?Ҋk U gdpj$| j:d]:S%XKCkMXB U(!?ceE]Gf|i*{P&ku+rĎ`rJ]zanmNJG,lu Xď;tc8F?{5'{5Ɵ7iͿ99-WNܜ:b,_(׍x'*Z1( @\H%KUP)|Yoak(YώƐ {nGZه/|O;b{,LYBg%(kW}mXt'ם4쨽hbX{RCjD MQ/pPjݻdT,#npBatm/ E{TcftXP}! LwQuSLoNݨ(qmq0J,טQQaĎ7mҪ4 i`ˁ0JvɯM,䬲j.7"PcV#X)=NC7#GTFZ&mҜ$Ñp2C~I=EEe֜xn8Y[kjf'z&yG܆tx rlF^zJ8yHY-MX5*F{mW]PDŽ2lNqp %σ`<8{yVgJ\b=Wȅs}e )a>qGFK~dT%nFvYTwոN*]%z;D9[9sdGkZQ+bLNZFְ k;>=Fko.FR4ott hTWؽf+eO+fQߔ(XUJ~I+j$W%H질NdK52{JV%g!WW/k\NiiKmtW+uh%*W SX ?y~>r  f8ǭ};YmGfooB/cڎ _Ȁ hvϱ+mf8ֈ,='V3 Ǡ DM-ް 09|fsϥ)#IYY1YJ0XTɬT\=oW}>}gnޒo}vFya$^TzjoB~ݑI}@no@aK2 <)i37[T 襓1B-b(K1GZhv5f$t,# l )-X*(67s,zRT#D4a[!˳),d~:e'DO%uqɷMIEmȷO{[5Zsp$&s'H3:Ӓ_Uj#Q-Uم00YO` L, Cώ26u#abS^3&z o{'`6:.zl7==.zlTu IIm:iBZ{ʦgX8.;uԫB+ QΫ;*Kʿ7jv|c1,/S,3HSNCi;Ze=H2@VZGx'{exOhI]7KH}>xRH jjv7v!mGyI#jqHOgMּ/nS>% 3 - ə2 My;^S~>n2@ySn=Wp RnGYaW"8;ͤn8yB]*~2§zNAJW!ēz24*($QZ 0BJ88@jy9>) u9`QSu`PwZ VM8B?S̎,ަiVœhruvwTP{*\'HODOYXa!%5gcw_C#'&<5nby7LEBb7Lv^yp$(07w~b;t O8_ͪK8ŖV IpP]lpD[e-NB}ɵJR?A<~[{%}ءAh ΠuM 2#Y*ذAEa?~ecVd=96)Rָd P!;e7dR?A<>ߒQl'd$.imȤ+r YZ># TszEj*|FX@ 0& uQB' |L DAq AY0m 2Sw5M"n'8d.V!D9kDm R~2˛[־jFi1*~"j0FkW&NR@❉ vObU_( FlY.FN>\LBjVÔ􏮖nN K+v*R p>=idŋEֶEQЧnNMݼmҌN_y(yp E900 !cre+d&&& D"IN׷}`xf nPK<]#xu,D4}mj3 E9E+4gb\,Hco!/v` f21^~B|Z21n`L&f#H#sjfq p-f83c21ݺ;!,#RWڎL̒u%Lc21KHB&fRw8,X#umG&fA6oU0 9Xڔc21k,}9.sjvdbNmP 3>Fpk1P&f[ ebVKH&feڑY>>Y"J$dm}fbnfbI7oe2135ծY$?i dbIX$DVLot4s+FZ4 /}j}E&1(+P(uE`_`6ĖL̂"ye>Ғ|T+uU)T~0<ެnvהL omBkm;"))~`#1ƏPY hJFw D1n@Ĥ4ήkF㑄V3̯8 9ba3ւoOew7[,A8 ¦"}Pj唺R{8xh(5j´ NKc)kDZ}N?ZbD|pFMN@PXk8$NZG #XkˣB|#GT#]W sLW/gXUݠ2Aj5kumqۨ}c)qOt Ǝl[+ aJ/(k JG,j+-3 &qHzHDsf eOL z/P7'i?`_0&Uw(eգhF&ޒ_r[osm:?T9" SmHͯ_ThpV(H0-d)]_5Js&26@f9c٬σQ$0 iW ]k_Zs)_ܦ?6{QPՆX/-{p0V&Hb;gl8[/@vH}"#'>yiiii;pvq$u ᒚ4XNugPՄxG0u vtN d;`[eZ.efW-iVYE淯3x#)0 YwbVs">gR(+"d]ݒ P>,o{ޙL-@^.@^HHǁ!˟J8$x$i P.ŏvȦ=v{aTRvē wWxe18}ꘁ e{].y*xkdHJW]jv@VJE_=ERUbl:UZɝ.d8NXy˶k9"'rg℄ $?ڐ/JWUs x"N&`=L뵉6B|@lBt|q1sL[fйJс9J9 <t;,@:$S%:Yȳ[usT\}0X766Ln߃^gjP>Iē|>F6e45-V&G,cZBuwmפQB$Md6I4V}ٱ[r-£`=033y\c".^g^H^{aЖ ư= Twͥֆ+:Ƭ+Xb9=@њ\/Jbaž;! |Yz #G?.@V0^R !w` ?5@2(Cؾ|Px̶P:Ѽkq8GJ]bDߜL Og!uWӐϡ5^)OFV`ڞHƫ7!)M.Xt36m9ŋ! XR8y@ZE6q8<:C7>DjeKVzΥKJ9CWAtƁ3gҩDɊ9f-P.'彙esŨW6)a; Ty24׍؇Vs!40(s&8aXYMA/Ue $2j$3MAVy'Huds%R8x$il՗5D/j`,^ug#xun"Ug ˯.}gxA_-9YqԟR1\(nvR )@s#=0C |"6: YeTElZQ+/TpA<%2&q{51 EuM7ux<noM, dE[B [M#x{Fyo|mtшYF;1JF[h3@C-lvn8njbVW:F],B4H܊ Emmϒjm{ ԃQ sO87QJH5FBtGO@> ]-ghAUKHyvoC)iԍ'4H-KZyx4wV{dje<ʽE&O!?湗<p/LG(Q9<P,4Sm aX_]lުU1(W^C";HSY#\ıfzL-[8SZq |9M&!d'"GFi4mvU_-qLI$CM>"'iΘh@ lAp\KeeԍArlܭH mz>WoEeYYIRja qE$p(OftF޿hT2; w`w4 CT_6{: oJ2 `DnwI.B+Ep_&QSwC}I}ZQ u}v 3",nQ2tƹ pkvLk ߙ5k hw6 ) E 3ēzGϷ &_)ލW(0` CĂT {3M!˲7G9r"s؎0 c% h*fa"$.:om1J[Sq{} O JI[_/K^˿m hg L 9bh6?BJ7E{ߓm,G!Mwe¢혉 0C ޅ| ]9^3& GD)7amE#Q,d!>H]C *.18 < Yh?D]r 85ȦQ'ǀ#GdArc%~x| P; Y(EoEP V` ~ FdD2c)@!i=N|hpm9a{oq3;(w  _0BC"ѾaBmd4sZ)fDh8 y3&4L`&tM3(۱gVߟ&J8y]NAjDFӐІ]szD*!d!D gؽJܳ"2#r>{!uvﶕqbp xdi"Ԓ!9MU4]bpx ؉:ABTI*]$0%F[0 Ỗk7yӨ{IW^꺸yi.g:")DA4?T8ó*wԲ.nb*H!L*఑xRG>hM 7>)E2@Rcױ i]V11CbB&L\Hmυ3Թ/gݰ2@s!F wDfөUޞHC$Y'!RGA%{W1"k O@V8 ݥk2LqJꆀf̽LdC|A,?'%*w!0"u3{O "/cf-e'\,~(dĄvBAF*Vt{Nbsxs ='hrN4zA[YldQ ynyDt@~ M klkƆN5/BV~USu-V='JH'HDkԆ,mo=ÐŖbRFNOCVypTP G sWAJ.@Vy}*сwDp jC^@ކ.2 ,=h5;;EsEcpc-yʆiYp猳u W?0mPZ>w5Qq 1a5맴`N@.+,R?A["j|3m["~'ŪT=3#uS;7akZS"kZD.=Iz՚T{ִ^[Ӛ ״M{%-!o;kv/a]9*[^[KP; Yb-מ*h BWN;+" YhcLzy 2gZ8cn}QwǃԬقhb]U͗%SZ&5&"{ I2&\ tnzi "< Y,R~ak.qI)\%uSFm pULg mT+;ET KN!j7pY~p[u6BBܼ|7i crG~gFZZ` F] 館,밨2J^ݨS H^,3[;J _pHlS $u='f+ m+{΃mCVfgpDd &MFyBjOQd w|UM7ө"p|br Y~xͅz` -2ykaD !+4ńZU c[ ~2ZDvA/uV}i5QBٞfG楷q(Quؖ&̛d| ,6@s@uۇ5NyxYwYYZ}Ѣ0gkro!/ມdd8%_ -³ pPk7~@\gěC#o, HW$~{XHZ4_aX$dugȅz #R7 YދIKzGyM{lUײ~)ZG (qq 9=N^,nSi&LD B3}їnY>KoDOϡUo[ߵ"\-d:v H̷ x>J&⇁ dH}d]Ox7ǟC$ +j>A<7o俩9jS=7NxAe-prA jՒYw&.5Fi{ S*ƲYBq~鶿o|gϣͅ(b_jT(_I~!h! #E*,tҟMell֍JeKgۚcsì4ޤ5z UJ ߵtkCK]&\B.RJ4 n1BW,AIrbu5,,@ogcNq)`rQ(N[詻%Rq)xl]krmať/XtˣY^\p,J>,5uW>Zb 0bj֖~*w,_wKpO2E^4.뺽n̚/iO7waA)_dQl#zpJ?=p>N>[~  /h%+,VcE͚oT4m.Ђw *WkܚQ{ACUI XIN`j]gcO \(9zc+4̪nXSa79YI0%#͎a#Rb8dtcqQ7j5p s슞tikY|!G̙k 9'Ic.Y,JO,tNRDʆ 4<Y8/A=z~NFN@;{4=!Ol/CNa @=K 1B"rx r AH]xqZށ,6=C~H<>,40]"d9NdyG^TlP Շ=Ad!ny@QKA[GZiyөAeP˂66 gy2qYhlܿsAE3ICڡ׺a8 Z =" }Ck~,=74C"I@uKY:Mr-o-:j^Qdf_j'׀ MoCV="s@}mM]*/#0jr۴  ;0(Buӹs }V+jA7xm'“G:ho$e"t8Yz}Ku;ւI)`QSu}hb;P[vr >,@ky4j쇓ۂhrvQoV\Cuj@I/A=݇x.IZ"^}ӐUMXK<YPHKT,b9 |Yp'kCD'<PmuC[[n25&;4Czhb_9z}:7I9,gZ"TxЍF?ef`|[k"A0 9t(%-,Hh2^$<Yce}Ww vMEYU*QdV*ns`#%,:D&VkVb4"' wE`gW_X, Q)YԌVQXdrR1N#sOQ?>M.ԈUΆx,quLTJ!]kDŽ@ͮ[(P݂&B߆c!{s^`;^&h{Bof0hYi3BKM<ó\~fxFb8f ̒7`'y *rG$ːŎĦܚ4 Y+W3gkO]ݖuwЙ dQ T1,2caVM3Ɛ*;$kJA-)\;x6N\%s;߅ 3e1]rr|k[[_l>-?m+;7:ɉ䍙_v51m=z%|`7 dWzo~ߍxˤdUpk1zcXY}j"cAnS1( {;(s.Ue4^58k_O"I.^ۋ+~.VTWoH3ecKnpW}c3OifSjQ; nܥ߯vvߒbVܸObz`}Kvj1wJӲb#ʊPҸ+hZ7鍃 {c {-(uEM7(CqAojoxR=T-=Dr,ZN{RRiO꺁r_%@Amj{mװx-۰oDM$2 k6L$#j"|mXa n߆E,2kN[-ǵ ] S2cjwvA.`V6mhUO߆EAVi'Xo" OB X'g4d:~[l},#0 L>lZa:{3Ng\N^x ;0HU ;0H!B}qSjagvY d?>hM"6{Dhmv9)q0m6!,d+ C"2[DiCn!i?D!򄦤6V # S6{j#4&`!f%4khMv>G[KM|]:\6 d ܇gTRn?D ]X͑ŔxrsWxf{ǨUsn\?;ֆY; oCw?R 'bU*t1999`%^ĞP*m.X NJL !+_[w[wQYw^x ?|&bFlY~' ~d/g\~׎7ƽS&7'6ǟ++7gfά'7Juta~ }5J.LB%OkLĵgGч c#Z}}>/\-^{?_B`eiUpY5 {p }EÊ+@-|71_I!#@#ά"UV6W ߯4ozCDjݻdT,#ndBdwKzHiCzbpVO7;FtwzpjG|P؃ < Ysᬖ= Hv#ģ_5*/19:!< Yhh䬟CSŖN9A<ۂEi,zZ?NaIj3V-u,"y>dy8vC><˫ v/@~M#XS{e R9E<,W_WY\;zR# p ,βT ޓ*Ga _RfaIi`r^YsL׬z,;%0x͈( IS\cmV]ogI0l5Zܙ8# ,ڶpV,nQ Qh7 =-}cOYXx7m% ol%Ǫ߄4mK%]#_]: #Hq99tidC"DJ  v!u x 꾥u[ETQ .%:giZe sv!語oN(1/^3 P$KeۋsIe`rQ~􋧾^AEc4|g?hGCaBn8U\yw"t1= z.wN3뮱礇;t "]se鐽Ed_F Hސ*W!R`rVj!uA+N2reK_U% uy"oU"E~nZ!̒EWiT^ HۛXA:PJE~0S,r~ !ʺ%3 jA~~B"'&6= 0 uj ,p :n;YݰnV=bXհ%4LEM5Y֗6̘\1a?dULǢUcuDy,LPn&JntB\! kB M$oEOO2n}wI̡-̌e6Nשa<"8: O}`ܝ'? | tEjvu,sG5G%Yejզ@kσaEAw"Iq@zN")Ԃvt=7A<ܑM6ܙZ 0d+g־ZFsxs*^b*ޣ۟ѹkvRgIUz&G '8X{y[Q݄r⪼ynvoW7IÐN,䳝N#A>+%Ta%Hn8=0 T)$ԭuCdA\n4%ēhG!T;  £g4&p8< Yh߾ΌevɟN1锎+\=oUK:|5,b=TҚAM|QX`*XbsenLۥe]5w_1Hǐ'l/{׎?eA*,a Pnn6N&W0@/NJ+;6ÐHzToDr8yPYV ,oiCA~߭a'u'w3'ћBmAZ#!sk3@bssII9bCEGـf;WiNF TQ{uU!TEw Kn!7"VM oWiঢ~~t` խwޥyM4 Nx;ԭwk BMAΑ&hӈպ)4ݓ3(k] ]#Mҙтj!,Ļҫn].p:*pu7@0Tш(#<Y]t]^QG )!]bXG;Z1>|4t1e~jR#dwfE(g.3txeC]BHR7J>R7,K\tͨY\>,v8[ ,LK'k0pB̕e h8Yl_5ѱ"͛5o] H4Br@[~2<0K2'K\F)<~&u#]6oRwxy dH@'"a~#@E'EKRx |p>/4p">Et*FCwBKUK۪pB[ꋴCWf?=S6JǀCZ#^2񽌵YIGauQwby x}ilNs7,w;'alkςc~["*yBDz%R7<*]['AiUdGӵ O zӗg>t1~.0rƭET3go[n xؖZBڤElnC߇91gTrM*[]= asCuj[C7a.e-/ mQD)< YjKB"uc l . J@ ìT pP[qo|"R[sēFm]ށ|GzDN7C0]P | H)TCې;)ԿA<4ftݮA hjW 00arCy?pX=]7_뵊Ig1>dAaԭU)Gdn-06 .siV*E}2C|{ߓnq-F5.o%v8 YhЎeI2ds ^,9L6[c(@mxРoWw4 H<>p3be5LG0Rx#I2Z3JJ3R T7SH 8d,W{Gn灣SH02.Rwxr'._o.[ ކ,tߊ 09%uEӽB]C;0zEesbIae)^.Lq"u@uQ=Hze۟mZWyM G!3zʦOgs'bTydCIt4n⹆=0:'7QIojh'|MN/AV-YC l/CZW{~ Bf'p35bfH0 '5X!89@ f̘6d Y2#:j]5}CUf=rOq[^,ϊƋox85Jk/zʈ*fUf,7ժyf>Rsf^>!dMu";Y(&Dsx6d5A@7$ABA/\zf98;YS.o-suRkmW٧ms&s_&'7fu׋t·e>z;3~ ѷi>{Tpk1zcXY}j"cAnC^vbw%PwQl]ˎipד}vKp"J :U`RLX[1ܵ?pmLk'SZc/TZ{g6uN~+e.wŪݷd7n*𓭘8F]q+$eM &#G߁%1%3Ӡh_ A1ýO"GrE|Sr;> H.(4Uc+%㐅' 0I]xБ R <$oP$dF) ӶXOa)HbOa;`8dzr%XkB:"<Y2uzFMo(}~_OC>%4B%VyG]rM&87"kTv)@rIi2`?DU4MmCxР s^G="0!%'\fZ P/.UPoF?3_WOΆaͯ ܜ.lC&8ބ|}> t<[,07U#<4YoEYȋrm 8B@[*_t`/I_F"E鲣r.[7 2) { dat <- as.table(data) if(all(varnames != ".")) { ind <- match(varnames, names(dimnames(dat))) if (any(is.na(ind))) stop(paste("Can't find", paste(varnames[is.na(ind)], collapse=" / "), "in", deparse(substitute(data)))) dat <- margin.table(dat, ind) } else { ind <- match(dep, names(dimnames(dat))) if (is.na(ind)) stop(paste("Can't find", dep, "in", deparse(substitute(data)))) dat <- aperm(dat, c(seq_along(dim(dat))[-ind], ind)) } doubledecker.default(dat, main = main, ...) } else { tab <- if ("Freq" %in% colnames(data)) xtabs(formula(paste("Freq~", varnames, collapse = "+")), data = data) else xtabs(formula(paste("~", varnames, collapse = "+")), data = data) doubledecker.default(tab, main = main, ...) } } doubledecker.default <- function(x, depvar = length(dim(x)), margins = c(1, 4, length(dim(x)) + 1, 1), gp = gpar(fill = rev(gray.colors(tail(dim(x), 1)))), labeling = labeling_doubledecker, spacing = spacing_highlighting, main = NULL, keep_aspect_ratio = FALSE, ...) { x <- as.table(x) d <- dim(x) l <- length(d) if (is.character(depvar)) depvar <- match(depvar, names(dimnames(x))) condvars <- (1:l)[-depvar] ## order dependend var *last* x <- aperm(x, c(condvars, depvar)) ## recycle gpar elements along *last* dimension, if needed size <- prod(d) FUN <- function(par) { if (is.structable(par)) par <- as.table(par) if (length(par) < size || is.null(dim(par))) aperm(array(par, dim = rev(d))) else par } gp <- structure(lapply(gp, FUN), class = "gpar") strucplot(x, core = struc_mosaic(zero_split = FALSE, zero_shade = FALSE), condvars = l - 1, spacing = spacing, split_vertical = c(rep.int(TRUE, l - 1), FALSE), gp = gp, shade = TRUE, labeling = labeling, main = main, margins = margins, legend = NULL, keep_aspect_ratio = keep_aspect_ratio, ... ) } vcd/R/agreementplot.R0000644000175000017500000001365113044210676014363 0ustar nileshnilesh## Modified 1/25/2012 11:43AM by M. friendly # -- added fill_col argument, specifying a function to be used to fill the tiles # -- added xscale, yscale arguments to show the marginal frequencies at top & right # -- added line_col to change the color of the diagonal line ## Modified 3/24/2012 11:38AM by M. friendly # -- fixed buglet with yscale=TRUE and reverse_y=FALSE "agreementplot" <- function (x, ...) UseMethod ("agreementplot") "agreementplot.formula" <- function (formula, data = NULL, ..., subset) { m <- match.call(expand.dots = FALSE) edata <- eval(m$data, parent.frame()) if (inherits(edata, "ftable") || inherits(edata, "table")) { data <- as.table(data) varnames <- attr(terms(formula), "term.labels") if (all(varnames != ".")) data <- margin.table(data, match(varnames, names(dimnames(data)))) agreementplot(data, ...) } else { if (is.matrix(edata)) m$data <- as.data.frame(data) m$... <- NULL m[[1L]] <- quote(stats::model.frame) mf <- eval(m, parent.frame()) if (length(formula) == 2) { by <- mf y <- NULL } else { i <- attr(attr(mf, "terms"), "response") by <- mf[-i] y <- mf[[i]] } by <- lapply(by, factor) x <- if (is.null(y)) do.call("table", by) else if (NCOL(y) == 1) tapply(y, by, sum) else { z <- lapply(as.data.frame(y), tapply, by, sum) array(unlist(z), dim = c(dim(z[[1]]), length(z)), dimnames = c(dimnames(z[[1]]), list(names(z)))) } x[is.na(x)] <- 0 agreementplot(x, ...) } } "agreementplot.default" <- function(x, reverse_y = TRUE, main = NULL, weights = c(1, 1 - 1 / (ncol(x) - 1)^2), margins = par("mar"), newpage = TRUE, pop = TRUE, xlab = names(dimnames(x))[2], ylab = names(dimnames(x))[1], xlab_rot = 0, xlab_just = "center", ylab_rot = 90, ylab_just = "center", fill_col = function(j) gray((1 - (weights[j]) ^ 2) ^ 0.5), line_col = "red", xscale=TRUE, yscale = TRUE, return_grob = FALSE, prefix = "", ...) { if (length(dim(x)) > 2) stop("Function implemented for two-way tables only!") if (ncol(x) != nrow(x)) stop("Dimensions must have equal length!") nc <- ncol(x) ## compute relative frequencies n <- sum(x) colFreqs <- colSums(x) / n rowFreqs <- rowSums(x) / n ## open viewport if (newpage) grid.newpage() pushViewport(plotViewport(margins, name = paste(prefix,"agreementplot"))) pushViewport(viewport(width = unit(1, "snpc"), height = unit(1, "snpc"))) if(!is.null(main)) grid.text(main, y = unit(1.1, "npc"), gp = gpar(fontsize = 25)) ## axis labels grid.text(xlab, y = -0.12, gp = gpar(fontsize = 20)) grid.text(ylab, x = -0.1, gp = gpar(fontsize = 20), rot = 90) grid.rect(gp = gpar(fill = "transparent")) xc <- c(0, cumsum(colFreqs)) yc <- c(0, cumsum(rowFreqs)) my.text <- if(reverse_y) function(y, ...) grid.text(y = y, ...) else function(y, ...) grid.text(y = 1 - y, ...) my.rect <- if(reverse_y) function(xleft, ybottom, xright, ytop, ...) grid.rect(x = xleft, y = ybottom, width = xright - xleft, height = ytop - ybottom, just = c("left","bottom"), ...) else function(xleft, ybottom, xright, ytop, ...) grid.rect(x = xleft, y = 1 - ybottom, width = xright - xleft, height = ytop - ybottom, just = c("left","top"), ...) A <- matrix(0, length(weights), nc) for (i in 1:nc) { ## x - axis grid.text(dimnames(x)[[2]][i], x = xc[i] + (xc[i + 1] - xc[i]) / 2, y = - 0.04, check.overlap = TRUE, rot = xlab_rot, just = xlab_just, ...) ## y - axis my.text(dimnames(x)[[1]][i], y = yc[i] + (yc[i + 1] - yc[i]) / 2, x = - 0.03, check.overlap = TRUE, rot = ylab_rot, just = ylab_just, ...) ## expected rectangle my.rect(xc[i], yc[i], xc[i + 1], yc[i + 1]) ## observed rectangle y0 <- c(0, cumsum(x[i,])) / sum(x[i,]) x0 <- c(0, cumsum(x[,i])) / sum(x[,i]) rec <- function (col, dens, lb, tr) my.rect(xc[i] + (xc[i + 1] - xc[i]) * x0[lb], yc[i] + (yc[i + 1] - yc[i]) * y0[lb], xc[i] + (xc[i + 1] - xc[i]) * x0[tr], yc[i] + (yc[i + 1] - yc[i]) * y0[tr], gp = gpar(fill = fill_col(j), col = col, rot = 135) ) for (j in length(weights):1) { lb <- max(1, i - j + 1) tr <- 1 + min(nc, i + j - 1) A[j, i] <- sum(x[lb:(tr-1),i]) * sum(x[i, lb:(tr-1)]) rec("white", NULL, lb, tr) ## erase background rec("black", if (weights[j] < 1) weights[j] * 20 else NULL, lb, tr) } ## correct A[j,i] -> not done by Friendly==Bug? for (j in length(weights):1) if (j > 1) A[j, i] <- A[j, i] - A[j - 1, i] } if (reverse_y) grid.lines(c(0, 1), c(0, 1), gp = gpar(col = line_col, linetype = "longdash")) else grid.lines(c(0, 1), c(1, 0), gp = gpar(col = line_col, linetype = "longdash")) if (xscale) { cx <- xc[-(nc+1)] + diff(xc)/2 grid.text(colSums(x), x = cx, y = 1.03, rot = xlab_rot, just = xlab_just, ...) grid.xaxis(at = xc, label = FALSE, main=FALSE, gp = gpar(fontsize=10), draw = TRUE, vp = NULL) } if (yscale) { cy <- yc[-(nc+1)] + diff(yc)/2 my.text(rowSums(x), x = 1.04, y = cy, rot = 0, just = ylab_just, ...) grid.yaxis(at = if(reverse_y) yc else 1-yc, FALSE, main=FALSE, gp = gpar(fontsize=10), draw = TRUE, vp = NULL) } if (pop) popViewport(2) else upViewport(2) ## Statistics - Returned invisibly ads <- crossprod(diag(x)) ar <- n * n * crossprod(colFreqs, rowFreqs) if (return_grob) invisible(structure(list( Bangdiwala = ads / ar, Bangdiwala_Weighted = (sum(weights * A)) / ar, weights = weights), grob = grid.grab() ) ) else invisible(list( Bangdiwala = ads / ar, Bangdiwala_Weighted = (sum(weights * A)) / ar, weights = weights) ) } vcd/R/labeling.R0000655000175000017500000007221313120314702013261 0ustar nileshnilesh################################################################ ## labeling pexpand <- function(par, len, default_value, default_names, choices = NULL) { if (is.null(par)) par <- default_value nam <- names(par) if (!is.null(choices)) par <- sapply(par, match.arg, choices) if (is.null(nam)) { default_value <- par par <- rep(par, length.out = len) nam <- names(par) <- default_names } else if (length(nam[nam == ""])) { default_value <- par[nam == ""] nam <- nam[nam != ""] } ret <- rep(default_value, length.out = len) if (!is.null(nam)) { names(ret) <- default_names ret[nam] <- par[nam] } ret } labeling_list <- function(gp_text = gpar(), just = "left", pos = "left", lsep = ": ", sep = " ", offset = unit(c(2, 2), "lines"), varnames = TRUE, cols = 2, ...) { function(d, split_vertical, condvars, prefix = "") { if (is.table(d) || is.structable(d)) d <- dimnames(d) ld <- length(d) labeling_border(labels = FALSE, varnames = varnames)(d, split_vertical, condvars, prefix) seekViewport(paste(prefix, "margin_bottom", sep = "")) pos <- unit(switch(pos, left = 0, center = 0.5, 1) / cols, "npc") ind <- split(seq(ld), rep.int(seq(cols), ceiling(ld / cols))[seq(ld)]) for (i in seq_along(ind)) grid.text(x = offset[1] + pos + unit((i - 1) / cols, "npc"), y = unit(1, "npc") - offset[2], paste(names(d[ind[[i]]]), sapply(d[ind[[i]]], paste, collapse = sep), sep = lsep, collapse = "\n" ), just = c(just, "top"), gp = gp_text ) } } class(labeling_list) <- "grapcon_generator" labeling_conditional <- function(...) { function (d, split_vertical, condvars, prefix = "") { if (is.table(d) || is.structable(d)) d <- dimnames(d) v <- rep.int(TRUE, length(d)) v[seq(condvars)] <- FALSE labeling_border(labels = !v, ...)(d, split_vertical, condvars, prefix) labeling_cells(labels = v, ...)(d, split_vertical, condvars, prefix) } } class(labeling_conditional) <- "grapcon_generator" labeling_cells <- function(labels = TRUE, varnames = TRUE, abbreviate_labels = FALSE, abbreviate_varnames = FALSE, gp_text = gpar(), lsep = ": ", lcollapse = "\n", just = "center", pos = "center", rot = 0, margin = unit(0.5, "lines"), clip_cells = TRUE, text = NULL, ...) { function(d, split_vertical, condvars, prefix = "") { if (is.table(d) || is.structable(d)) d <- dimnames(d) dn <- names(d) ld <- length(d) ## expand parameters if (length(pos) < 2) pos <- c(pos, pos) labels <- pexpand(labels, ld, TRUE, dn) varnames <- pexpand(varnames, ld, TRUE, dn) abbreviate_labels <- pexpand(abbreviate_labels, ld, FALSE, dn) abbreviate_varnames <- pexpand(abbreviate_varnames, ld, FALSE, dn) ## margin if (!is.unit(margin)) margin <- unit(margin, "lines") prvars <- ifelse(abbreviate_varnames, sapply(seq_along(dn), function(i) abbreviate(dn[i], abbreviate_varnames[i])), dn) prvars <- ifelse(varnames, paste(prvars, lsep, sep = ""), "") if (is.structable(text)) text <- as.table(text) ## draw labels split <- function(vind = 1, labs = c()) { n <- d[[vind]] for (labind in seq_along(n)) { lab <- c(labs, n[labind]) names(lab) <- names(d)[1:vind] mlab <- paste(prefix, "cell:", paste(dn[1:vind], lab, sep = "=", collapse = ","), sep = "") if (vind < ld) split(vind + 1, lab) else { seekViewport(mlab) pushViewport(viewport(width = max(unit(0, "npc"), unit(1, "npc") - 2 * margin), height = unit(1, "npc") - 2 * margin, clip = clip_cells)) txt <- if (!is.null(text)) { lab <- lab[names(dimnames(text))] do.call("[", c(list(text), as.list(lab))) } else { prlab <- ifelse(abbreviate_labels, sapply(seq_along(lab), function(i) abbreviate(lab[i], abbreviate_labels[i])), lab) prlab <- prlab[labels[1:ld]] paste(prvars[labels[1:ld]], prlab, sep = "", collapse = lcollapse) } grid.text(if(!is.na(txt)) txt, x = switch(pos[1], left =, top = 0, center = 0.5, 1), y = switch(pos[2], left =, top = 1, center = 0.5, 0), gp = gp_text, just = just, rot = rot) popViewport() } } } split() seekViewport(paste(prefix, "base", sep = "")) upViewport(1) } } class(labeling_cells) <- "grapcon_generator" labeling_border <- function(labels = TRUE, varnames = labels, set_labels = NULL, set_varnames = NULL, tl_labels = NULL, alternate_labels = FALSE, tl_varnames = NULL, gp_labels = gpar(fontsize = 12), gp_varnames = gpar(fontsize = 12, fontface = 2), rot_labels = c(0, 90, 0, 90), rot_varnames = c(0, 90, 0, 90), pos_labels = "center", pos_varnames = "center", just_labels = "center", just_varnames = pos_varnames, boxes = FALSE, fill_boxes = FALSE, offset_labels = c(0, 0, 0, 0), offset_varnames = offset_labels, labbl_varnames = NULL, labels_varnames = FALSE, sep = ": ", abbreviate_labs = FALSE, rep = TRUE, clip = FALSE, ... ) { ## expand parameters that apply to the four table margins pos_labels <- pexpand(pos_labels, 4, "center", c("top", "right", "bottom", "left"), c("left", "center", "right")) just_labels <- pexpand(just_labels, 4, "center", c("top", "right", "bottom", "left"), c("left", "center", "right")) offset_varnames <- if (!is.unit(offset_varnames)) unit(pexpand(offset_varnames, 4, rep.int(0, 4), c("top","right","bottom","left")), "lines") else rep(offset_varnames, length.out = 4) offset_labels <- if (!is.unit(offset_labels)) unit(pexpand(offset_labels, 4, rep.int(0, 4), c("top","right","bottom","left")), "lines") else rep(offset_labels, length.out = 4) rot_labels <- pexpand(rot_labels, 4, c(0, 90, 0, 90), c("top", "right", "bottom", "left")) if (inherits(gp_varnames, "gpar")) gp_varnames <- list(gp_varnames) gp_varnames <- pexpand(gp_varnames, 4, list(gpar(fontsize = 12, fontface = 2)), c("top", "right", "bottom", "left")) rot_varnames <- pexpand(rot_varnames, 4, c(0, 90, 0, 90), c("top", "right", "bottom", "left")) pos_varnames <- pexpand(pos_varnames, 4, "center", c("top", "right", "bottom", "left"), c("left", "center", "right")) just_varnames <- pexpand(just_varnames, 4, pos_varnames, c("top", "right", "bottom", "left"), c("left", "center", "right")) function(d, split_vertical, condvars, prefix = "") { if (is.table(d) || is.structable(d)) d <- dimnames(d) dn <- names(d) ld <- length(d) ## expand table- (i.e., dimensionality)-dependent parameters clip <- pexpand(clip, ld, TRUE, dn) labels <- pexpand(labels, ld, TRUE, dn) labels_varnames <- pexpand(labels_varnames, ld, FALSE, dn) ## tl_labels def <- logical() def[split_vertical] <- rep(c(TRUE, FALSE), length.out = sum(split_vertical)) def[!split_vertical] <- rep(c(TRUE, FALSE), length.out = sum(!split_vertical)) tl_labels <- if (is.null(tl_labels)) def else pexpand(tl_labels, ld, def, dn) ## rep labels rep <- pexpand(rep, ld, TRUE, dn) printed <- lapply(d, function(i) rep.int(FALSE, length(i))) ## alternate labels alternate_labels <- pexpand(alternate_labels, ld, FALSE, dn) ## abbreviate abbreviate_labs <- pexpand(abbreviate_labs, ld, FALSE, dn) labs <- d for (i in seq_along(d)) if (abbreviate_labs[i]) labs[[i]] <- abbreviate(labs[[i]], abbreviate_labs[i]) ## gp_labels if (inherits(gp_labels, "gpar")) gp_labels <- list(gp_labels) gp_labels <- pexpand(gp_labels, ld, list(gpar(fontsize = 12)), dn) ## varnames varnames <- pexpand(varnames, ld, labels, dn) ## tl_varnames if (is.null(tl_varnames) && is.null(labbl_varnames)) tl_varnames <- tl_labels tl_varnames <- pexpand(tl_varnames, ld, tl_labels, dn) ## labbl_varnames if (!is.null(labbl_varnames)) labbl_varnames <- pexpand(labbl_varnames, ld, TRUE, dn) ## boxes boxes <- pexpand(boxes, ld, FALSE, dn) ## fill_boxes dnl <- sapply(d, length) fill_boxes <- if (is.atomic(fill_boxes)) { fill_boxes <- if (is.logical(fill_boxes)) ifelse(pexpand(fill_boxes, ld, FALSE, dn), "grey", NA) else pexpand(fill_boxes, ld, "grey", dn) col <- rgb2hsv(col2rgb(fill_boxes)) lapply(seq(along.with = dnl), function(i) if (is.na(fill_boxes[i])) "white" else hsv(h = col["h",i], s = col["s",i], v = seq(from = col["v",i], to = 0.5 * col["v",i], length = dnl[i]) ) ) } else { fill_boxes <- pexpand(fill_boxes, ld, "white", dn) lapply(seq(ld), function(i) pexpand(fill_boxes[[i]], dnl[i], "white", d[[i]]) ) } ## precompute spaces lsp <- tsp <- bsp <- rsp <- 0 labsp <- rep.int(0, ld) for (i in seq_along(dn)[tl_labels & labels]) labsp[i] <- if (split_vertical[i]) { if (alternate_labels[i]) bsp <- bsp - 1 tsp <- tsp + 1 } else { if (alternate_labels[i]) rsp <- rsp + 1 lsp <- lsp - 1 } for (i in rev(seq_along(dn)[!tl_labels & labels])) labsp[i] <- if (split_vertical[i]) { if (alternate_labels[i]) tsp <- tsp + 1 bsp <- bsp - 1 } else { if (alternate_labels[i]) lsp <- lsp - 1 rsp <- rsp + 1 } if(is.null(labbl_varnames)) { ## varnames in the outer margin ## compute axis names tt <- bt <- lt <- rt <- "" for (i in seq_along(dn)) { var <- if (!is.null(set_varnames) && !is.na(set_varnames[dn[i]])) set_varnames[dn[i]] else dn[i] if (varnames[i]) { if (split_vertical[i]) { if (tl_varnames[i]) tt <- paste(tt, var, sep = if (tt == "") "" else " / ") else bt <- paste(bt, var, sep = if (bt == "") "" else " / ") } else { if (tl_varnames[i]) lt <- paste(lt, var, sep = if (lt == "") "" else " / ") else rt <- paste(rt, var, sep = if (rt == "") "" else " / ") } } } ## draw axis names if (tt != "") grid.text(tt, y = unit(1, "npc") + unit(tsp + 1, "lines") + offset_varnames[1], x = switch(pos_varnames[1], left =, bottom = 0, center =, centre = 0.5, 1), rot = rot_varnames[1], just = just_varnames[1], gp = gp_varnames[[1]]) if (bt != "") grid.text(bt, y = unit(bsp - 1, "lines") + -1 * offset_varnames[3], x = switch(pos_varnames[3], left =, bottom = 0, center =, centre = 0.5, 1), rot = rot_varnames[3], just = just_varnames[3], gp = gp_varnames[[3]]) if (lt != "") grid.text(lt, x = unit(lsp - 1, "lines") + -1 * offset_varnames[4], y = switch(pos_varnames[4], left =, bottom = 0, center =, centre = 0.5, 1), rot = rot_varnames[4], just = just_varnames[4], gp = gp_varnames[[4]]) if (rt != "") grid.text(rt, x = unit(1, "npc") + unit(rsp + 1, "lines") + offset_varnames[2], y = switch(pos_varnames[2], left =, bottom = 0, center =, centre = 0.5, 1), rot = rot_varnames[2], just = just_varnames[2], gp = gp_varnames[[2]]) } else { ## varnames beneath labels for (i in seq_along(dn)) { var <- if (!is.null(set_varnames) && !is.na(set_varnames[dn[i]])) set_varnames[dn[i]] else dn[i] if (varnames[i]) { if (split_vertical[i]) { if (tl_labels[i]) { if (labbl_varnames[i]) { grid.text(var, y = unit(1, "npc") + unit(1 + tsp - labsp[i], "lines") + offset_varnames[1], x = unit(-0.5, "lines"), just = "right", gp = gp_varnames[[4]]) } else { grid.text(var, y = unit(1, "npc") + unit(1 + tsp - labsp[i], "lines") + offset_varnames[1], x = unit(1, "npc") + unit(0.5, "lines"), just = "left", gp = gp_varnames[[2]]) } } else { if (labbl_varnames[i]) { grid.text(var, y = unit(labsp[i], "lines") + -1 * offset_varnames[3], x = unit(-0.5, "lines"), just = "right", gp = gp_varnames[[4]]) } else { grid.text(var, y = unit(labsp[i], "lines") + -1 * offset_varnames[3], x = unit(1, "npc") + unit(0.5, "lines"), just = "left", gp = gp_varnames[[2]]) } } } else { if (tl_labels[i]) { if (labbl_varnames[i]) { grid.text(var, x = unit(lsp - 1 - labsp[i], "lines") + -1 * offset_varnames[4], y = unit(-0.5, "lines"), just = "right", rot = 90, gp = gp_varnames[[4]]) } else { grid.text(var, x = unit(lsp - 1 - labsp[i], "lines") + -1 * offset_varnames[4], y = unit(1, "npc") + unit(0.5, "lines"), just = "left", rot = 90, gp = gp_varnames[[2]]) } } else { if (labbl_varnames[i]) { grid.text(var, x = unit(1, "npc") + unit(labsp[i], "lines") + offset_varnames[2], y = unit(-0.5, "lines"), just = "right", rot = 90, gp = gp_varnames[[4]]) } else { grid.text(var, x = unit(1, "npc") + unit(labsp[i], "lines") + offset_varnames[2], y = unit(1, "npc") + unit(0.5, "lines"), just = "left", rot = 90, gp = gp_varnames[[2]]) } } } } } } ## draw labels split <- function(vind = 1, root = paste(prefix, "cell:", sep = ""), left = TRUE, right = TRUE, top = TRUE, bottom = TRUE) { n <- d[[vind]] vl <- length(n) sp <- split_vertical[vind] labseq <- seq_along(n) if (!sp) labseq <- rev(labseq) for (labind in labseq) { mlab <- paste(root, dn[vind], "=", n[labind], sep = "") if (labels[vind] && (rep[vind] || !printed[[vind]][labind])) { lab <- if (!is.null(set_labels) && !is.null(set_labels[[dn[vind]]])) set_labels[[dn[vind]]][labind] else labs[[vind]][labind] if (labels_varnames[vind]) lab <- if (!is.null(set_varnames) && !is.na(set_varnames[dn[vind]])) paste(set_varnames[dn[vind]], lab, sep = sep) else paste(dn[vind], lab, sep = sep) if (sp) { if (tl_labels[vind]) { if (top) { seekViewport(mlab) if (clip[vind]) pushViewport(viewport(height = unit(1, "npc") + 2 * offset_labels[1] + unit(2 * (2 + tsp - labsp[vind]), "lines"), clip = "on")) if (boxes[vind]) grid.rect(height = unit(0.8, "lines"), y = unit(1, "npc") + offset_labels[1] + unit(1 + tsp - labsp[vind] - (2 + as.numeric(offset_labels[1]) + tsp - labsp[vind]) * clip[vind], "lines"), gp = gpar(fill = fill_boxes[[vind]][labind])) grid.text(lab, y = unit(1, "npc") + offset_labels[1] + unit(1 + tsp - labsp[vind] - (2 + as.numeric(offset_labels[1]) + tsp - labsp[vind]) * clip[vind], "lines"), x = unit(0.15 * switch(pos_labels[1], left =, bottom = 1, center =, centre = 0, -1) * boxes[vind], "lines") + unit(switch(pos_labels[1], left =, bottom = 0, center =, centre = 0.5, 1), "npc"), rot = rot_labels[1], just = just_labels[1], gp = gp_labels[[vind]]) if (clip[vind]) popViewport() printed[[vind]][labind] <<- TRUE } } else { if (bottom) { seekViewport(mlab) if (clip[vind]) pushViewport(viewport(height = unit(1, "npc") + 2 * offset_labels[3] + unit(2 * (1 + abs(labsp[vind])), "lines"), clip = "on")) ### if (boxes[vind]) grid.rect(height = unit(0.8, "lines"), y = -1 * offset_labels[3] + unit(labsp[vind] + (1 + as.numeric(offset_labels[3]) + abs(labsp[vind])) * clip[vind], "lines"), gp = gpar(fill = fill_boxes[[vind]][labind])) grid.text(lab, y = -1 * offset_labels[3] + unit(labsp[vind] + (1 + as.numeric(offset_labels[3]) + abs(labsp[vind])) * clip[vind], "lines"), x = unit(0.15 * switch(pos_labels[3], left =, bottom = 1, center =, centre = 0, -1) * boxes[vind], "lines") + unit(switch(pos_labels[3], left =, bottom = 0, center =, centre = 0.5, 1), "npc"), rot = rot_labels[3], just = just_labels[3], gp = gp_labels[[vind]]) if (clip[vind]) popViewport() printed[[vind]][labind] <<- TRUE } } } else { if (tl_labels[vind]) { if (left) { seekViewport(mlab) if (clip[vind]) pushViewport(viewport(width = unit(1, "npc") + 2 * offset_labels[4] + unit(2 * (2 - lsp + labsp[vind]), "lines"), clip = "on")) if (boxes[vind]) grid.rect(width = unit(0.8, "lines"), x = -1 * offset_labels[4] + unit(lsp - 1 - labsp[vind] + (2 - lsp + as.numeric(offset_labels[4]) + labsp[vind]) * clip[vind], "lines"), gp = gpar(fill = fill_boxes[[vind]][labind])) grid.text(lab, x = -1 * offset_labels[4] + unit(lsp - 1 - labsp[vind] + (2 - lsp + as.numeric(offset_labels[4]) + labsp[vind]) * clip[vind], "lines"), y = unit(0.15 * switch(pos_labels[4], left =, bottom = 1, centre = 0, -1) * boxes[vind], "lines") + unit(switch(pos_labels[4], left =, bottom = 0, center =, centre = 0.5, 1), "npc"), rot = rot_labels[4], just = just_labels[4], gp = gp_labels[[vind]]) if (clip[vind]) popViewport() printed[[vind]][labind] <<- TRUE } } else { if (right) { seekViewport(mlab) if (clip[vind]) pushViewport(viewport(width = unit(1, "npc") + 2 * offset_labels[2] + unit(2 * (1 + abs(labsp[vind])), "lines"), clip = "on")) if (boxes[vind]) grid.rect(width = unit(0.8, "lines"), x = offset_labels[2] + unit(1, "npc") + unit(labsp[vind] - (1 + as.numeric(offset_labels[2]) + abs(labsp[vind])) * clip[vind], "lines"), gp = gpar(fill = fill_boxes[[vind]][labind])) grid.text(lab, x = offset_labels[2] + unit(1, "npc") + unit(0.1, "lines") + unit(labsp[vind] - (1 + as.numeric(offset_labels[2]) + abs(labsp[vind])) * clip[vind], "lines"), y = unit(0.15 * switch(pos_labels[2], left =, bottom = 1, center =, centre = 0, -1) * boxes[vind], "lines") + unit(switch(pos_labels[2], left =, bottom = 0, center =, centre = 0.5, 1), "npc"), rot = rot_labels[2], just = just_labels[2], gp = gp_labels[[vind]]) if (clip[vind]) popViewport() printed[[vind]][labind] <<- TRUE } } } } if (vind < ld) Recall(vind + 1, paste(mlab, ",", sep = ""), if (sp) left && labind == 1 else left, if (sp) right && labind == vl else right, if (!sp) top && labind == 1 else top, if (!sp) bottom && labind == vl else bottom) } } ## patch for alternating labels, part 1 if (any(alternate_labels)) { ## save set_labels set_labels_hold <- set_labels ## create vanilla set_labels-object set_labels <- d ## copy old set_labels if (!is.null(set_labels_hold)) set_labels[names(set_labels_hold)] <- set_labels_hold ## mask half of the labels for (i in which(alternate_labels)) if (length(d[[i]]) > 1) set_labels[[i]][seq(2, length(d[[i]]), 2)] <- "" } split() ## patch for alternating labels, part 2 if (any(alternate_labels)) { ## create again vanilla set_labels-object set_labels <- d ## copy again old set_labels if (!is.null(set_labels_hold)) set_labels[names(set_labels_hold)] <- set_labels_hold ## clear all non-alternated labels labels[!alternate_labels] <- FALSE ## mask other half of alternated labels for (i in which(alternate_labels)) set_labels[[i]][seq(1, length(d[[i]]), 2)] <- "" ## invert tl_labels and labsp tl_labels <- ! tl_labels labsp <- -labsp ## label again split() } seekViewport(paste(prefix, "base", sep = "")) upViewport(1) } } class(labeling_border) <- "grapcon_generator" labeling_doubledecker <- function(lab_pos = c("bottom", "top"), dep_varname = TRUE, boxes = NULL, clip = NULL, labbl_varnames = FALSE, rot_labels = rep.int(0, 4), pos_labels = c("left", "center", "left", "center"), just_labels = c("left", "left", "left", "center"), varnames = NULL, gp_varnames = gpar(fontsize = 12, fontface = 2), offset_varnames = c(0, -0.6, 0, 0), tl_labels = NULL, ...) { lab_pos <- match.arg(lab_pos) if (inherits(gp_varnames, "gpar")) gp_varnames <- list(gp_varnames) gp_varnames <- pexpand(gp_varnames, 4, list(gpar(fontsize = 12, fontface = 2)), c("top", "right", "bottom", "left")) function(d, split_vertical, condvars, prefix = "") { if (is.table(d) || is.structable(d)) d <- dimnames(d) ld <- length(d) dn <- names(d) ## expand dimension parameters boxes <- pexpand(boxes, ld, c(rep.int(TRUE, ld - 1), FALSE), dn) clip <- pexpand(clip, ld, c(rep.int(TRUE, ld - 1), FALSE), dn) varnames <- pexpand(varnames, ld, c(rep.int(TRUE, ld - 1), FALSE), dn) tl_labels <- pexpand(tl_labels, ld, c(rep.int(lab_pos == "top", ld - 1), FALSE), dn) if (!is.null(labbl_varnames)) labbl_varnames <- pexpand(labbl_varnames, ld, FALSE, dn) ## expand side parameters rot_labels <- pexpand(rot_labels, 4, c(0, 0, 0, 0), c("top", "right", "bottom", "left")) pos_labels <- pexpand(pos_labels, 4, c("left", "center", "left", "center"), c("top", "right", "bottom", "left"), c("left", "center", "right")) just_labels <- pexpand(just_labels, 4, c("left", "left", "left", "center"), c("top", "right", "bottom", "left"), c("left", "center", "right")) offset_varnames <- if (!is.unit(offset_varnames)) unit(pexpand(offset_varnames, 4, c(0, -0.6, 0, 0), c("top","right","bottom","left")), "lines") else rep(offset_varnames, length.out = 4) labeling_border(boxes = boxes, clip = clip, labbl_varnames = labbl_varnames, rot_labels = rot_labels, pos_labels = pos_labels, just_labels = just_labels, varnames = varnames, gp_varnames = gp_varnames, offset_varnames = offset_varnames, tl_labels = tl_labels, ... )(d, split_vertical, condvars, prefix) if (!(is.logical(dep_varname) && !dep_varname)) { if (is.null(dep_varname) || is.logical(dep_varname)) dep_varname <- names(d)[length(d)] seekViewport(paste(prefix, "margin_right", sep = "")) grid.text(dep_varname, x = unit(0.5, "lines"), y = unit(1, "npc"), just = c("left","top"), gp = gp_varnames[[2]]) } } } class(labeling_doubledecker) <- "grapcon_generator" labeling_left <- function(rep = FALSE, pos_varnames = "left", pos_labels = "left", just_labels = "left", ...) labeling_border(rep = rep, pos_varnames = pos_varnames, pos_labels = pos_labels, just_labels = just_labels, ...) class(labeling_left) <- "grapcon_generator" labeling_left2 <- function(tl_labels = TRUE, clip = TRUE, pos_varnames = "left", pos_labels = "left", just_labels = "left", ...) labeling_border(tl_labels = tl_labels, clip = clip, pos_varnames = pos_varnames, pos_labels = pos_labels, just_labels = just_labels, ...) class(labeling_left2) <- "grapcon_generator" labeling_cboxed <- function(tl_labels = TRUE, boxes = TRUE, clip = TRUE, pos_labels = "center", ...) labeling_border(tl_labels = tl_labels, boxes = boxes, clip = clip, pos_labels = pos_labels, ...) class(labeling_cboxed) <- "grapcon_generator" labeling_lboxed <- function(tl_labels = FALSE, boxes = TRUE, clip = TRUE, pos_labels = "left", just_labels = "left", labbl_varnames = FALSE, ...) labeling_border(tl_labels = tl_labels, boxes = boxes, clip = clip, pos_labels = pos_labels, labbl_varnames = labbl_varnames, just_labels = just_labels, ...) class(labeling_lboxed) <- "grapcon_generator" labeling_values <- function(value_type = c("observed", "expected", "residuals"), suppress = NULL, digits = 1, clip_cells = FALSE, ...) { value_type <- match.arg(value_type) if (value_type == "residuals" && is.null(suppress)) suppress <- 2 if (is.null(suppress)) suppress <- 0 if (length(suppress) == 1) suppress <- c(-suppress, suppress) function(d, split_vertical, condvars, prefix) { lookup <- if (value_type == "observed") "x" else value_type if (!exists(lookup, envir = parent.frame())) stop(paste("Could not find", dQuote(value_type), "object.")) values <- get(lookup, envir = parent.frame()) values <- ifelse((values > suppress[2]) | (values < suppress[1]), round(values, digits), NA) labeling_border(...)(d, split_vertical, condvars, prefix) labeling_cells(text = values, clip_cells = clip_cells, ...)(d, split_vertical, condvars, prefix) } } class(labeling_values) <- "grapcon_generator" labeling_residuals <- function(suppress = NULL, digits = 1, clip_cells = FALSE, ...) labeling_values(value_type = "residuals", suppress = suppress, digits = digits, clip_cells = clip_cells, ...) class(labeling_residuals) <- "grapcon_generator" vcd/R/structable.R0000644000175000017500000004370013044210742013655 0ustar nileshnilesh######################################### ## structable structable <- function(x, ...) UseMethod("structable") structable.formula <- function(formula, data = NULL, direction = NULL, split_vertical = NULL, ..., subset, na.action) { if (missing(formula) || !inherits(formula, "formula")) stop("formula is incorrect or missing") m <- match.call(expand.dots = FALSE) edata <- eval(m$data, parent.frame()) if (!is.null(direction)) split_vertical <- direction == "v" if (is.structable(data)) { split_vertical <- attr(data, "split_vertical") data <- as.table(data) } if (is.null(split_vertical)) split_vertical <- FALSE if (length(formula) == 3 && formula[[2]] == "Freq") formula[[2]] = NULL ## only rhs present without `.' in lhs => xtabs-interface if (length(formula) != 3) { if (formula[[1]] == "~") { if (inherits(edata, "ftable") || inherits(edata, "table") || length(dim(edata)) > 2) { data <- as.table(data) varnames <- attr(terms(formula, allowDotAsName = TRUE), "term.labels") dnames <- names(dimnames(data)) di <- match(varnames, dnames) if (any(is.na(di))) stop("incorrect variable names in formula") if (all(varnames != ".")) data <- margin.table(data, di) return(structable(data, split_vertical = split_vertical, ...)) } else if (is.data.frame(data)) { if ("Freq" %in% colnames(data)) return(structable(xtabs(formula(paste("Freq", deparse(formula))), data = data), split_vertical = split_vertical, ...)) else return(structable(xtabs(formula, data), split_vertical = split_vertical, ...)) } else { if (is.matrix(edata)) m$data <- as.data.frame(data) m$... <- m$split_vertical <- m$direction <- NULL m[[1L]] <- quote(stats::model.frame) mf <- eval(m, parent.frame()) return(structable(table(mf), split_vertical = split_vertical, ...)) } } else stop("formula must have both left and right hand sides") } ## `ftable' behavior if (any(attr(terms(formula, allowDotAsName = TRUE), "order") > 1)) stop("interactions are not allowed") rvars <- attr(terms(formula[-2], allowDotAsName = TRUE), "term.labels") cvars <- attr(terms(formula[-3], allowDotAsName = TRUE), "term.labels") rhs.has.dot <- any(rvars == ".") lhs.has.dot <- any(cvars == ".") if (lhs.has.dot && rhs.has.dot) stop(paste("formula has", sQuote("."), "in both left and right hand side")) if (inherits(edata, "ftable") || inherits(edata, "table") || length(dim(edata)) > 2) { if (inherits(edata, "ftable")) data <- as.table(data) dnames <- names(dimnames(data)) rvars <- pmatch(rvars, dnames) cvars <- pmatch(cvars, dnames) if (rhs.has.dot) rvars <- seq_along(dnames)[-cvars] else if (any(is.na(rvars))) stop("incorrect variable names in rhs of formula") if (lhs.has.dot) cvars <- seq_along(dnames)[-rvars] else if (any(is.na(cvars))) stop("incorrect variable names in lhs of formula") split_vertical <- c(rep(FALSE, length(rvars)), rep(TRUE, length(cvars))) structable(margin.table(data, c(rvars, cvars)), split_vertical = split_vertical, ...) } else { if (is.matrix(edata)) m$data <- as.data.frame(data) m$... <- m$split_vertical <- m$direction <- NULL if (!is.null(data) && is.environment(data)) { dnames <- names(data) if (rhs.has.dot) rvars <- seq_along(dnames)[-cvars] if (lhs.has.dot) cvars <- seq_along(dnames)[-rvars] } else { if (lhs.has.dot || rhs.has.dot) stop("cannot use dots in formula with given data") } if ("Freq" %in% colnames(m$data)) m$formula <- formula(paste("Freq~", paste(c(rvars, cvars), collapse = "+"))) else m$formula <- formula(paste("~", paste(c(rvars, cvars), collapse = "+"))) m[[1]] <- as.name("xtabs") mf <- eval(m, parent.frame()) split_vertical <- c(rep(FALSE, length(rvars)), rep(TRUE, length(cvars))) structable(mf, split_vertical = split_vertical, ...) } } structable.default <- function(..., direction = NULL, split_vertical = FALSE) { ## several checks & transformations for arguments args <- list(...) if (length(args) == 0) stop("Nothing to tabulate") x <- args[[1]] x <- if (is.list(x)) table(x) else if (inherits(x, "ftable")) as.table(x) else if (!(is.array(x) && length(dim(x)) > 1 || inherits(x, "table"))) do.call("table", as.list(substitute(list(...)))[-1]) else x if (is.null(dimnames(x))) dimnames(x) <- lapply(dim(x), function(i) letters[seq_len(i)]) if (is.null(names(dimnames(x)))) names(dimnames(x)) <- LETTERS[seq_along(dim(x))] idx <- sapply(names(dimnames(x)), nchar) < 1 if(any(idx)) names(dimnames(x))[idx] <- LETTERS[seq_len(sum(idx))] ## splitting argument dl <- length(dim(x)) if (!is.null(direction)) split_vertical <- direction == "v" if (length(split_vertical) == 1) split_vertical <- rep(c(split_vertical, !split_vertical), length.out = dl) if (length(split_vertical) < dl) split_vertical <- rep(split_vertical, length.out = dl) ## permute & reshape ret <- base::aperm(x, c(rev(which(!split_vertical)), rev(which(split_vertical)))) dn <- dimnames(x) rv <- dn[split_vertical] cv <- dn[!split_vertical] rl <- if (length(rv)) sapply(rv, length) else 1 cl <- if (length(cv)) sapply(cv, length) else 1 dim(ret) <- c(prod(cl), prod(rl)) ## add dimnames attr(ret, "dnames") <- dn attr(ret, "split_vertical") <- split_vertical ## add dimension attributes in ftable-format attr(ret, "col.vars") <- rv attr(ret, "row.vars") <- cv class(ret) <- c("structable", "ftable") ret } "[[.structable" <- function(x, ...) { if(nargs() > 3) stop("Incorrect number of dimensions (max: 2).") args <- if (nargs() < 3) list(..1) else .massage_args(...) args <- lapply(args, function(x) if (is.logical(x)) which(x) else x) ## handle one-arg cases if (nargs() < 3) if (length(args[[1]]) > 1) ## resolve calls like x[[c(1,2)]] return(x[[ args[[1]][1] ]] [[ args[[1]][-1] ]]) else ## resolve x[[foo]] return(if (attr(x, "split_vertical")[1]) x[[,args[[1]] ]] else x[[args[[1]],]]) ## handle calls like x[[c(1,2), c(3,4)]] if (length(args[[1]]) > 1 && length(args[[2]]) > 1) return(x[[ args[[1]][1], args[[2]][1] ]] [[ args[[1]][-1], args[[2]][-1] ]]) ## handle calls like x[[c(1,2), 3]] if (length(args[[1]]) > 1) return(x[[ args[[1]][1], args[[2]] ]] [[ args[[1]][-1], ]]) ## handle calls like x[[1, c(1,3)]] if (length(args[[2]]) > 1) return(x[[ args[[1]], args[[2]][1] ]] [[ , args[[2]][-1] ]]) ## final cases like x[[1,2]] or x[[1,]] or x[[,1]] dnames <- attr(x, "dnames") split <- attr(x, "split_vertical") rv <- dnames[!split] cv <- dnames[split] lsym <- is.symbol(args[[1]]) rsym <- is.symbol(args[[2]]) if (!lsym) { rstep <- dim(unclass(x))[1] / length(rv[[1]]) if (is.character(args[[1]])) args[[1]] <- match(args[[1]], rv[[1]]) } if (!rsym) { cstep <- dim(unclass(x))[2] / length(cv[[1]]) if (is.character(args[[2]])) args[[2]] <- match(args[[2]], cv[[1]]) } lind <- if (!lsym) (1 + (args[[1]] - 1) * rstep) : (args[[1]] * rstep) else 1:nrow(unclass(x)) rind <- if (!rsym) (1 + (args[[2]] - 1) * cstep) : (args[[2]] * cstep) else 1:ncol(unclass(x)) ret <- unclass(x)[lind, rind, drop = FALSE] if (!lsym) { i <- which(!split)[1] split <- split[-i] dnames <- dnames[-i] } if (!rsym) { i <- which(split)[1] split <- split[-i] dnames <- dnames[-i] } attr(ret, "split_vertical") <- split attr(ret, "dnames") <- dnames ## add dimension attributes in ftable-format attr(ret, "col.vars") <- dnames[split] attr(ret, "row.vars") <- dnames[!split] class(ret) <- class(x) ret } "[[<-.structable" <- function(x, ..., value) { args <- if (nargs() < 4) list(..1) else .massage_args(...) ## handle one-arg cases if (nargs() < 4) return(if (length(args[[1]]) > 1) ## resolve calls like x[[c(1,2)]]<-value Recall(x, args[[1]][1], value = Recall(x[[ args[[1]][1] ]], args[[1]][-1], value = value)) else ## resolve x[[foo]]<-value if (attr(x, "split_vertical")[1]) Recall(x,,args[[1]], value = value) else Recall(x,args[[1]],, value = value) ) ## handle calls like x[[c(1,2), c(3,4)]]<-value if (length(args[[1]]) > 1 && length(args[[2]]) > 1) return(Recall(x, args[[1]][1], args[[2]][1], value = Recall(x[[ args[[1]][1], args[[2]][1] ]], args[[1]][-1], args[[2]][-1], value = value))) ## handle calls like x[[c(1,2), 3]]<-value if (length(args[[1]]) > 1) return(Recall(x, args[[1]][1], args[[2]], value = Recall(x[[ args[[1]][1], args[[2]] ]], args[[1]][-1], ,value = value))) ## handle calls like x[[1, c(1,3)]]<-value if (length(args[[2]]) > 1) return(Recall(x, args[[1]], args[[2]][1], value = Recall(x[[ args[[1]], args[[2]][1] ]],, args[[2]][-1], value = value))) ## final cases like x[[1,2]]<-value or x[[1,]]<-value or x[[,1]]<-value dnames <- attr(x, "dnames") split <- attr(x, "split_vertical") rv <- dnames[!split] cv <- dnames[split] lsym <- is.symbol(args[[1]]) rsym <- is.symbol(args[[2]]) if (!lsym) { rstep <- dim(unclass(x))[1] / length(rv[[1]]) if (is.character(args[[1]])) args[[1]] <- match(args[[1]], rv[[1]]) } if (!rsym) { cstep <- dim(unclass(x))[2] / length(cv[[1]]) if (is.character(args[[2]])) args[[2]] <- match(args[[2]], cv[[1]]) } lind <- if (!lsym) (1 + (args[[1]] - 1) * rstep) : (args[[1]] * rstep) else 1:nrow(unclass(x)) rind <- if (!rsym) (1 + (args[[2]] - 1) * cstep) : (args[[2]] * cstep) else 1:ncol(unclass(x)) ret <- unclass(x) ret[lind, rind] <- value class(ret) <- class(x) ret } "[.structable" <- function(x, ...) { if(nargs() > 3) stop("Incorrect number of dimensions (max: 2).") args <- if (nargs() < 3) list(..1) else .massage_args(...) args <- lapply(args, function(x) if (is.logical(x)) which(x) else x) ## handle one-arg cases if (nargs() < 3) return(if (attr(x, "split_vertical")[1]) x[,args[[1]] ] else x[args[[1]],]) ## handle calls like x[c(1,2), foo] if (length(args[[1]]) > 1) return(do.call(rbind, lapply(args[[1]], function(i) x[i, args[[2]]]))) ## handle calls like x[foo, c(1,3)] if (length(args[[2]]) > 1) return(do.call(cbind, lapply(args[[2]], function(i) x[args[[1]], i]))) ## final cases like x[1,2] or x[1,] or x[,1] dnames <- attr(x, "dnames") split <- attr(x, "split_vertical") rv <- dnames[!split] cv <- dnames[split] lsym <- is.symbol(args[[1]]) rsym <- is.symbol(args[[2]]) if (!lsym) { rstep <- dim(unclass(x))[1] / length(rv[[1]]) if (is.character(args[[1]])) args[[1]] <- match(args[[1]], rv[[1]]) } if (!rsym) { cstep <- dim(unclass(x))[2] / length(cv[[1]]) if (is.character(args[[2]])) args[[2]] <- match(args[[2]], cv[[1]]) } lind <- if (!lsym) (1 + (args[[1]] - 1) * rstep) : (args[[1]] * rstep) else 1:nrow(unclass(x)) rind <- if (!rsym) (1 + (args[[2]] - 1) * cstep) : (args[[2]] * cstep) else 1:ncol(unclass(x)) ret <- unclass(x)[lind, rind, drop = FALSE] if (!lsym) { i <- which(!split)[1] dnames[[i]] <- dnames[[i]][args[[1]]] } if (!rsym) { i <- which(split)[1] dnames[[i]] <- dnames[[i]][args[[2]]] } attr(ret, "split_vertical") <- split attr(ret, "dnames") <- dnames ## add dimension attributes in ftable-format attr(ret, "col.vars") <- dnames[split] attr(ret, "row.vars") <- dnames[!split] class(ret) <- class(x) ret } "[<-.structable" <- function(x, ..., value) { args <- if (nargs() < 4) list(..1) else .massage_args(...) ## handle one-arg cases if (nargs() < 4) return(## resolve x[foo] if (attr(x, "split_vertical")[1]) Recall(x,,args[[1]], value = value) else Recall(x,args[[1]],, value = value) ) ## handle calls like x[c(1,2), 3] if (length(args[[1]]) > 1) { for (i in seq_along(args[[1]])) x[ args[[1]][i], args[[2]] ] <- value[i,] return(x) } ## handle calls like x[1, c(2,3)] if (length(args[[2]]) > 1) { for (i in seq_along(args[[2]])) x[ args[[1]], args[[2]][i] ] <- value[,i] return(x) } ## final cases like x[1,2] or x[1,] or x[,1] dnames <- attr(x, "dnames") split <- attr(x, "split_vertical") rv <- dnames[!split] cv <- dnames[split] lsym <- is.symbol(args[[1]]) rsym <- is.symbol(args[[2]]) if (!lsym) { rstep <- dim(unclass(x))[1] / length(rv[[1]]) if (is.character(args[[1]])) args[[1]] <- match(args[[1]], rv[[1]]) } if (!rsym) { cstep <- dim(unclass(x))[2] / length(cv[[1]]) if (is.character(args[[2]])) args[[2]] <- match(args[[2]], cv[[1]]) } lind <- if (!lsym) (1 + (args[[1]] - 1) * rstep) : (args[[1]] * rstep) else 1:nrow(unclass(x)) rind <- if (!rsym) (1 + (args[[2]] - 1) * cstep) : (args[[2]] * cstep) else 1:ncol(unclass(x)) ret <- unclass(x) ret[lind, rind] <- value class(ret) <- class(x) ret } cbind.structable <- function(..., deparse.level = 1) { mergetables <- function(t1, t2) { ret <- cbind(unclass(t1),unclass(t2)) class(ret) <- class(t1) attr(ret, "split_vertical") <- attr(t1, "split_vertical") attr(ret, "dnames") <- attr(t1, "dnames") attr(ret, "row.vars") <- attr(t1, "row.vars") attr(ret, "col.vars") <- attr(t1, "col.vars") attr(ret, "col.vars")[[1]] <- c(attr(t1, "col.vars")[[1]],attr(t2, "col.vars")[[1]]) if (length(unique(attr(ret, "col.vars")[[1]])) != length(attr(ret, "col.vars")[[1]])) stop("Levels of factor(s) to be merged must be unique.") attr(ret, "dnames")[names(attr(ret, "col.vars"))] <- attr(ret, "col.vars") ret } args <- list(...) if (length(args) < 2) return(args[[1]]) ret <- mergetables(args[[1]], args[[2]]) if (length(args) > 2) do.call(cbind, c(list(ret), args[-(1:2)])) else ret } rbind.structable <- function(..., deparse.level = 1) { mergetables <- function(t1, t2) { ret <- rbind(unclass(t1),unclass(t2)) class(ret) <- class(t1) attr(ret, "split_vertical") <- attr(t1, "split_vertical") attr(ret, "dnames") <- attr(t1, "dnames") attr(ret, "row.vars") <- attr(t1, "row.vars") attr(ret, "col.vars") <- attr(t1, "col.vars") attr(ret, "row.vars")[[1]] <- c(attr(t1, "row.vars")[[1]],attr(t2, "row.vars")[[1]]) if (length(unique(attr(ret, "row.vars")[[1]])) != length(attr(ret, "row.vars")[[1]])) stop("Levels of factor(s) to be merged must be unique.") attr(ret, "dnames")[names(attr(ret, "row.vars"))] <- attr(ret, "row.vars") ret } args <- list(...) if (length(args) < 2) return(args[[1]]) ret <- mergetables(args[[1]], args[[2]]) if (length(args) > 2) do.call(rbind, c(list(ret), args[-(1:2)])) else ret } as.table.structable <- function(x, ...) { class(x) <- "ftable" ret <- NextMethod("as.table", object = x) structure(base::aperm(ret, match(names(attr(x, "dnames")), names(dimnames(ret)))), class = "table") } plot.structable <- function(x, ...) mosaic(x, ...) t.structable <- function(x) { ret <- t.default(x) attr(ret, "split_vertical") <- !attr(ret, "split_vertical") hold <- attr(ret, "row.vars") attr(ret, "row.vars") = attr(ret, "col.vars") attr(ret, "col.vars") = hold ret } is.structable <- function(x) inherits(x, "structable") dim.structable <- function(x) as.integer(sapply(attr(x, "dnames"), length)) print.structable <- function(x, ...) { class(x) <- "ftable" NextMethod("print", object = x) } dimnames.structable <- function(x) attr(x,"dnames") as.vector.structable <- function(x, ...) as.vector(as.table(x), ...) ## FIXME: copy as.matrix.ftable, committed to R-devel on 2014/1/12 ## replace by call to as.matrix.ftable when this becomes stable as_matrix_ftable <- function (x, sep = "_", ...) { if (!inherits(x, "ftable")) stop("'x' must be an \"ftable\" object") make_dimnames <- function(vars) { structure(list(do.call(paste, c(rev(expand.grid(rev(vars))), list(sep = sep)))), names = paste(collapse = sep, names(vars))) } structure(unclass(x), dimnames = c(make_dimnames(attr(x, "row.vars")), make_dimnames(attr(x, "col.vars"))), row.vars = NULL, col.vars = NULL) } as.matrix.structable <- function(x, sep="_", ...) { structure(as_matrix_ftable(x, sep, ...), dnames = NULL, split_vertical = NULL ) } length.structable <- function(x) dim(x)[1] is.na.structable <- function(x) sapply(seq_along(x), function(sub) any(is.na(sub))) str.structable <- function(object, ...) str(unclass(object), ...) find.perm <- function(vec1, vec2) { unlist(Map(function(x) which(x == vec2), vec1)) } aperm.structable <- function(a, perm, resize=TRUE, ...){ newtable <- aperm(as.table(a), perm = perm, resize = resize, ...) if (!is.numeric(perm)) perm <- find.perm(names(dimnames(newtable)), names(dimnames(a))) structable(newtable, split_vertical = attr(a, "split_vertical")[perm]) } ############# helper function .massage_args <- function(...) { args <- vector("list", 2) args[[1]] <- if(missing(..1)) as.symbol("grrr") else ..1 args[[2]] <- if(missing(..2)) as.symbol("grrr") else ..2 args } vcd/R/rootogram.R0000655000175000017500000001661312510525066013530 0ustar nileshnileshrootogram <- function(x, ...) { UseMethod("rootogram") } rootogram.goodfit <- function(x, ...) { rootogram.default(x$observed, x$fitted, names = x$count, df = x$df, ...) } rootogram.default <- function(x, fitted, names = NULL, scale = c("sqrt", "raw"), type = c("hanging", "standing", "deviation"), shade = FALSE, legend = TRUE, legend_args = list(x = 0, y = 0.2, height = 0.6), df = NULL, rect_gp = NULL, rect_gp_args = list(), lines_gp = gpar(col = "red", lwd = 2), points_gp = gpar(col = "red"), pch = 19, xlab = NULL, ylab = NULL, ylim = NULL, main = NULL, sub = NULL, margins = unit(0, "lines"), title_margins = NULL, legend_width = NULL, main_gp = gpar(fontsize = 20), sub_gp = gpar(fontsize = 15), name = "rootogram", prefix = "", keep_aspect_ratio = FALSE, newpage = TRUE, pop = TRUE, return_grob = FALSE, ...) { if(is.null(names)) names <- names(x) if(is.table(x)) { if(length(dim(x)) > 1) stop ("x must be a 1-way table") x <- as.vector(x) } obs <- x fit <- fitted res <- (obs - fit) / sqrt(fit) if(is.null(xlab)) {xlab <- "Number of Occurrences"} if(match.arg(scale) == "sqrt") { obs <- sqrt(obs) fit <- sqrt(fit) if(is.null(ylab)) {ylab <- "sqrt(Frequency)"} } else { if(is.null(ylab)) {ylab <- "Frequency"} } ## rect_gp (color, fill, lty, etc.) argument if (shade) { if (is.null(rect_gp)) rect_gp <- shading_hcl if (is.function(rect_gp)) { if (is.null(legend) || (is.logical(legend) && legend)) legend <- legend_resbased gpfun <- if (inherits(rect_gp, "grapcon_generator")) do.call("rect_gp", c(list(obs, res, fit, df), rect_gp_args)) else rect_gp rect_gp <- gpfun(res) } else if (!is.null(legend) && !(is.logical(legend) && !legend)) stop("rect_gp argument must be a shading function for drawing a legend") } if (is.null(rect_gp)) rect_gp <- gpar(fill = "lightgray") ## set up page if (newpage) grid.newpage() if (keep_aspect_ratio) pushViewport(viewport(width = 1, height = 1, default.units = "snpc")) pushViewport(vcdViewport(mar = margins, oma = title_margins, legend = shade && !(is.null(legend) || is.logical(legend) && !legend), main = !is.null(main), sub = !is.null(sub), keep_aspect_ratio = keep_aspect_ratio, legend_width = legend_width, prefix = prefix)) ## legend if (inherits(legend, "grapcon_generator")) legend <- do.call("legend", legend_args) if (shade && !is.null(legend) && !(is.logical(legend) && !legend)) { seekViewport(paste(prefix, "legend", sep = "")) legend(res, gpfun, "Pearson\nresiduals:") } ## titles if (!is.null(main)) { seekViewport(paste(prefix, "main", sep = "")) if (is.logical(main) && main) main <- deparse(substitute(x)) grid.text(main, gp = main_gp) } if (!is.null(sub)) { seekViewport(paste(prefix, "sub", sep = "")) if (is.logical(sub) && sub && is.null(main)) sub <- deparse(substitute(x)) grid.text(sub, gp = sub_gp) } seekViewport(paste(prefix, "plot", sep = "")) switch(match.arg(type), "hanging" = { if(is.null(ylim)) {ylim <- range(-0.1 * c(fit-obs,fit), c(fit-obs,fit)) + c(0, 0.1)} dummy <- grid_barplot(obs, names = names, offset = fit - obs, gp = rect_gp, xlab = xlab, ylab = ylab, ylim = ylim, name = name, newpage = FALSE, pop = FALSE, return_grob = FALSE, ...) downViewport(name) grid.lines(x = dummy, y = fit, default.units = "native", gp = lines_gp) grid.points(x = dummy, y = fit, default.units = "native", gp = points_gp, pch = pch) grid.lines(x = unit(c(0, 1), "npc"), y = unit(0, "native")) if(pop) popViewport() else upViewport() }, "standing" = { if(is.null(ylim)) {ylim <- range(-0.01 * c(obs,fit), c(obs,fit)) } dummy <- grid_barplot(obs, names = names, gp = rect_gp, xlab = xlab, ylab = ylab, ylim = ylim, name = name, newpage = FALSE, pop = FALSE, return_grob = FALSE, ...) downViewport(name) grid.lines(x = dummy, y = fit, default.units = "native", gp = lines_gp) grid.points(x = dummy, y = fit, default.units = "native", gp = points_gp, pch = pch) if(pop) popViewport() else upViewport() }, "deviation" = { if(is.null(ylim)) {ylim <- range(-0.1 * c(fit-obs,fit), c(fit-obs,fit)) + c(0, 0.1)} dummy <- grid_barplot(fit - obs, names = names, gp = rect_gp, xlab = xlab, ylab = ylab, ylim = ylim, name = name, newpage = FALSE, pop = FALSE, return_grob = FALSE, ...) downViewport(name) grid.lines(x = dummy, y = fit, default.units = "native", gp = lines_gp) grid.points(x = dummy, y = fit, default.units = "native", gp = points_gp, pch = pch) if(pop) popViewport() else upViewport() } ) if (return_grob) invisible(grid.grab()) else invisible(NULL) } grid_barplot <- function(height, width = 0.8, offset = 0, names = NULL, xlim = NULL, ylim = NULL, xlab = "", ylab = "", main = "", gp = gpar(fill = "lightgray"), name = "grid_barplot", newpage = TRUE, pop = FALSE, return_grob = FALSE) { if(is.null(names)) names <- names(height) height <- as.vector(height) n <- length(height) width <- rep(width, length.out = n) offset <- rep(offset, length.out = n) if(is.null(names)) names <- rep("", n) if(is.null(xlim)) xlim <- c(1 - mean(width[c(1, n)]), n + mean(width[c(1, n)])) if(is.null(ylim)) ylim <- c(min(offset), max(height + offset)) if(newpage) grid.newpage() pushViewport(plotViewport(xscale = xlim, yscale = ylim, default.units = "native", name = name)) grid.rect(x = 1:n, y = offset, width = width, height = height, just = c("centre", "bottom"), default.units = "native", gp = gp) grid.yaxis() grid.text(names, x = unit(1:n, "native"), y = unit(rep(-1.5, n), "lines")) grid.text(xlab, y = unit(-3.5, "lines")) grid.text(ylab, x = unit(-3, "lines"), rot = 90) grid.text(main, y = unit(1, "npc") + unit(2, "lines"), gp = gpar(fontface = "bold")) if(pop) popViewport() else upViewport() if (return_grob) invisible(structure(1:n, grob = grid.grab())) else invisible(1:n) } vcd/R/lodds.R0000644000175000017500000002514212566042766012633 0ustar nileshnileshodds <- function(x, log = FALSE, ...) lodds(x, log = log, ...) lodds <- function(x, ...) UseMethod("lodds") lodds.formula <- function(formula, data = NULL, ..., subset = NULL, na.action = NULL) { m <- match.call(expand.dots = FALSE) edata <- eval(m$data, parent.frame()) fstr <- strsplit(paste(deparse(formula), collapse = ""), "~") vars <- strsplit(strsplit(gsub(" ", "", fstr[[1]][2]), "\\|")[[1]], "\\+") varnames <- vars[[1]] condnames <- if (length(vars) > 1) vars[[2]] else NULL dep <- gsub(" ", "", fstr[[1]][1]) if (!dep %in% c("","Freq")) { if (all(varnames == ".")) { varnames <- if (is.data.frame(data)) colnames(data) else names(dimnames(as.table(data))) varnames <- varnames[-which(varnames %in% dep)] } varnames <- c(dep, varnames) } if (inherits(edata, "ftable") || inherits(edata, "table") || length(dim(edata)) > 2) { condind <- NULL dat <- as.table(data) if(all(varnames != ".")) { ind <- match(varnames, names(dimnames(dat))) if (any(is.na(ind))) stop(paste("Can't find", paste(varnames[is.na(ind)], collapse=" / "), "in", deparse(substitute(data)))) if (!is.null(condnames)) { condind <- match(condnames, names(dimnames(dat))) if (any(is.na(condind))) stop(paste("Can't find", paste(condnames[is.na(condind)], collapse=" / "), "in", deparse(substitute(data)))) ind <- c(ind, condind) } dat <- margin.table(dat, ind) } lodds.default(dat, strata = if (is.null(condind)) NULL else match(condnames, names(dimnames(dat))), ...) } else { m <- m[c(1, match(c("formula", "data", "subset", "na.action"), names(m), 0))] m[[1]] <- as.name("xtabs") m$formula <- formula(paste(if("Freq" %in% colnames(data)) "Freq", "~", paste(c(varnames, condnames), collapse = "+"))) tab <- eval(m, parent.frame()) lodds.default(tab, ...) } } lodds.default <- function(x, response = NULL, strata = NULL, log = TRUE, ref = NULL, correct = any(x == 0), ...) { ## check dimensions L <- length(d <- dim(x)) if(any(d < 2L)) stop("All table dimensions must be 2 or greater") ## assign and check response and stata; convert variable names to indices if (is.null(response)) { if (is.null(strata)) { response <- 1 strata <- setdiff(1:L, response) } else { # only strata was specified if(L - length(strata) != 1L) stop("All but 1 dimension must be specified as strata.") if(is.character(strata)) strata <- which(names(dimnames(x)) == strata) response <- setdiff(1:L, strata) } } else { # response was specified; take strata as the complement if(length(response) > 1) stop("Only 1 dimension can be specified as a response") if(is.character(response)) response <- which(names(dimnames(x)) == response) if (!is.null(strata)) warning(paste("strata =", paste(strata, collapse=","), "ignored when response has been specified")) strata <- setdiff(1:L, response) } ## dimensions of primary R x 1 table ### [Or should this just be a vector???] dp <- if (length(strata)) d[response] else d dn <- if (length(strata)) dimnames(x)[response] else dimnames(x) R <- dp[1] C <- 1 # shadow matrix with proper dimnames X <- matrix(0, R, C, dimnames=dn) ## process reference category if(!is.null(ref)) { if(is.character(ref)) { ref <- match(ref, colnames(x)) } else if(is.numeric(ref)) { ref <- as.integer(ref) } else { stop("Wrong 'ref=' argument!") } } ## compute corresponding indices compute_index <- function(n, ref) { if(is.null(ref)) return(cbind(1:(n-1), 2:n)) rval <- cbind(ref, 1:n) d <- rval[,2L] - rval[,1L] rval <- rbind( rval[d > 0, 1:2], rval[d < 0, 2:1] ) return(rval[order(rval[,1L]),,drop = FALSE]) } Rix <- compute_index(R, ref[[1L]]) contr <- matrix(0L, nrow = (R-1), ncol = R) colnames(contr) <- rownames(X) rownames(contr) <- rep("", R-1) for(i in 1:(R-1)) { rix <- i cix <- Rix[i,] contr[rix, cix] <- c(1L, -1L) rownames(contr)[rix] <- paste(rownames(X)[Rix[i,]], collapse = ":") } ## handle strata if (!is.null(strata)) { if (length(strata)==1) { sn <- dimnames(x)[[strata]] } else { sn <- apply(expand.grid(dimnames(x)[strata]), 1, paste, collapse = ":") } rn <- as.vector(outer( dimnames(contr)[[1]], sn, paste, sep='|')) cn <- as.vector(outer( dimnames(contr)[[2]], sn, paste, sep='|')) contr <- kronecker(diag(prod(dim(x)[strata])), contr) rownames(contr) <- rn colnames(contr) <- cn } ## dimnames for array version dn <- list(rep("", R-1)) for(i in 1:(R-1)) dn[[1]][i] <- paste(rownames(X)[Rix[i,]], collapse = ":") if (!is.null(strata)) dn <- c(dn, dimnames(x)[strata]) ndn <- names(dimnames(x)) if (!is.null(names(dimnames(x)))) names(dn) <- c(ndn[response], ndn[strata]) ## point estimates if (is.logical(correct)) { add <- if(correct) 0.5 else 0 } else if(is.numeric(correct)) { add <- as.vector(correct) if (length(add) != length(x)) stop("array size of 'correct' does not conform to the data") } else stop("correct is not valid") ## reorder columns of contrast matrix to match original data contr <- contr[, order(as.vector(aperm(array(seq.int(prod(d)), d), c(response, strata))))] ##coef <- drop(contr %*% log(as.vector(x) + add)) ##FIXME: 0 cells mess up the matrix product, try workaround: mat <- log(as.vector(x) + add) * t(contr) nas <- apply(contr != 0 & is.na(t(mat)), 1, any) coef <- apply(mat, 2, sum, na.rm = TRUE) coef[nas] <- NA ## covariances ##vcov <- crossprod(diag(sqrt(1/(as.vector(x) + add))) %*% t(contr)) tmp <- sqrt(1/(as.vector(x) + add)) * t(contr) tmp[is.na(tmp)] <- 0 vcov <- crossprod(tmp) vcov[nas,] <- NA vcov[,nas] <- NA rval <- structure(list( response = response, strata = strata, coefficients = coef, dimnames = dn, dim = as.integer(sapply(dn, length)), vcov = vcov, contrasts = contr, log = log ), class = "lodds") rval } ## ---------------- Methods ------------------- summary.lodds <- function(object, ...) lmtest::coeftest(object, ...) ## dim methods dimnames.lodds <- function(x, ...) x$dimnames dim.lodds <- function(x, ...) x$dim ## t/aperm-methods t.lodds <- function(x) aperm(x) ### FIXME aperm.lodds <- function(a, perm = NULL, ...) { d <- length(a$dim) if(is.null(perm)) { perm <- if (d < 3) 2L : 1L else c(2L : 1L, d : 3L) } else { if (any(perm[1:2] > 2L) || (d > 2L) && any(perm[-c(1:2)] < 2L)) stop("Mixing of strata and non-strata variables not allowed!") } nams <- names(a$coefficients) a$coefficients <- as.vector(aperm(array(a$coef, dim = a$dim), perm, ...)) nams <- as.vector(aperm(array(nams, dim = a$dim), perm, ...)) names(a$coefficients) <- nams a$dimnames <- a$dimnames[perm] a$dim <- a$dim[perm] a$vcov <- a$vcov[nams, nams] a$contrasts <- a$contrasts[nams,] a } ## straightforward methods coef.lodds <- function(object, log = object$log, ...) if(log) object$coefficients else exp(object$coefficients) vcov.lodds <- function(object, log = object$log, ...) if(log) object$vcov else `diag<-`(object$vcov, diag(object$vcov) * exp(object$coefficients)^2) confint.lodds <- function(object, parm, level = 0.95, log = object$log, ...) { if (log) confint.default(object, parm = parm, level = level, ... ) else { object$log = TRUE exp(confint.default(object, parm = parm, level = level, ... )) } } ### DONE: ## The header should say: # (log) odds for vn[response] by ... all the rest (strata) # Fixed: clash with make_header in loddsratio make_header_odds <- function(x) { vn <- names(dimnames(x)) resp <- vn[x$response] strat <- paste(vn[x$strata], collapse=", ") header <- c(if(x$log) "log" else "", "odds for", resp, "by", strat, # if (length(vn)>2) c("by", paste(vn[-(1:2)], collapse=', ')), "\n\n") paste(header, sep = " ") } ## print method print.lodds <- function(x, log = x$log, ...) { cat(make_header_odds(x)) print(drop(array(coef(x, log = log), dim = dim(x), dimnames = dimnames(x)), ...)) invisible(x) } ## as.data.frame #as.data.frame.lodds <- # function(x, ...) # as.data.frame.table(vcd:::as.array.loddsratio(x), ...) ## Q: I don't understand the purpose of the row.names and optional arguments ## DM: The generic has them, so each method must have them, too as.data.frame.lodds <- function(x, row.names = NULL, optional = FALSE, log=x$log, ...) { df <-data.frame(expand.grid(dimnames(x)), logodds = coef(x, log = log), ASE = sqrt(diag(vcov(x, log = log))), row.names = row.names, ... ) if (!log) colnames(df)[ncol(df) - 1] <- "odds" df } ## FIXME ## reshape coef() methods as.matrix.lodds <- function (x, log=x$log, ...) { ## Coef <- coef(x, log = log) ## if (length(dim(x))==2) matrix(Coef, ncol = dim(x)[2], dimnames=dimnames(x)) ## else { # drop leading dimensions with length 1, then reshape ## ddim <- which(dim(x)[1:2]==1) ## dim(Coef) <- dim(x)[-ddim] ## dimnames(Coef) <- dimnames(x)[-ddim] ## if (length(dim(Coef))==1) Coef ## else ## matrix(Coef, ncol = prod(dim(Coef)[-1]), ## dimnames=list(dimnames(Coef)[[1]], apply(expand.grid(dimnames(Coef)[[-1]]), 1, paste, collapse = ":"))) ## } as.array(x, log = log, ...) } as.array.lodds <- function (x, log=x$log, ...) { res <- array(coef(x, log = log), dim = dim(x), dimnames=dimnames(x)) drop(res) } vcd/R/legends.R0000644000175000017500000001724013726614510013136 0ustar nileshnileshlegend_resbased <- function(fontsize = 12, fontfamily = "", x = unit(1, "lines"), y = unit(0.1, "npc"), height = unit(0.8, "npc"), width = unit(0.7, "lines"), digits = 2, pdigits = max(1, getOption("digits") - 2), check_overlap = TRUE, text = NULL, steps = 200, ticks = 10, pvalue = TRUE, range = NULL) { if(!is.unit(x)) x <- unit(x, "native") if(!is.unit(y)) y <- unit(y, "npc") if(!is.unit(width)) width <- unit(width, "lines") if(!is.unit(height)) height <- unit(height, "npc") function(residuals, shading, autotext) { res <- as.vector(residuals) if(is.null(text)) text <- autotext p.value <- attr(shading, "p.value") legend <- attr(shading, "legend") if (all(residuals == 0)) { pushViewport(viewport(x = x, y = y, just = c("left", "bottom"), default.units = "native", height = height, width = width)) grid.lines(y = 0.5) grid.text(0, x = unit(1, "npc") + unit(0.8, "lines"), y = 0.5, gp = gpar(fontsize = fontsize, fontfamily = fontfamily)) warning("All residuals are zero.") } else { if (is.null(range)) range <- range(res) if (length(range) != 2) stop("Range must have length two!") if (is.na(range[1])) range[1] <- min(res) if (is.na(range[2])) range[2] <- max(res) pushViewport(viewport(x = x, y = y, just = c("left", "bottom"), yscale = range, default.units = "native", height = height, width = width)) if(is.null(legend$col.bins)) { col.bins <- seq(range[1], range[2], length = steps) at <- NULL } else { col.bins <- sort(unique(c(legend$col.bins, range))) col.bins <- col.bins[col.bins <= range[2] & col.bins >= range[1]] at <- col.bins } y.pos <- col.bins[-length(col.bins)] y.height <- diff(col.bins) grid.rect(x = unit(rep.int(0, length(y.pos)), "npc"), y = y.pos, height = y.height, default.units = "native", gp = gpar(fill = shading(y.pos + 0.5 * y.height)$fill, col = 0), just = c("left", "bottom")) grid.rect(gp = gpar(fill = "transparent")) if(is.null(at)) at <- seq(from = head(col.bins, 1), to = tail(col.bins, 1), length = ticks) lab <- format(round(at, digits = digits), nsmall = digits) tw <- lab[which.max(nchar(lab))] ## if(is.null(at)) ## at <- seq(from = head(col.bins, 1), to = tail(col.bins, 1), length = ticks) ## tw <- paste(rep("4", digits), collapse = "") ## if (any(trunc(at) != at)) ## tw <- paste(tw, ".", sep = "") ## if (any(at < 0)) ## tw <- paste(tw, "-", sep = "") grid.text(format(signif(at, digits = digits)), x = unit(1, "npc") + unit(0.8, "lines") + unit(1, "strwidth", tw), y = at, default.units = "native", just = c("right", "center"), gp = gpar(fontsize = fontsize, fontfamily = fontfamily), check.overlap = check_overlap) grid.segments(x0 = unit(1, "npc"), x1 = unit(1,"npc") + unit(0.5, "lines"), y0 = at, y1 = at, default.units = "native") } popViewport(1) grid.text(text, x = x, y = unit(1, "npc") - y + unit(1, "lines"), gp = gpar(fontsize = fontsize, fontfamily = fontfamily, lineheight = 0.8), just = c("left", "bottom") ) if(!is.null(p.value) && pvalue) { grid.text(paste("p-value =\n", format.pval(p.value, digits = pdigits), sep = ""), x = x, y = y - unit(1, "lines"), gp = gpar(fontsize = fontsize, fontfamily = fontfamily, lineheight = 0.8), just = c("left", "top")) } } } class(legend_resbased) <- "grapcon_generator" legend_fixed <- function(fontsize = 12, fontfamily = "", x = unit(1, "lines"), y = NULL, height = NULL, width = unit(1.5, "lines"), steps = 200, digits = 1, space = 0.05, text = NULL, range = NULL) { if(!is.unit(x)) x <- unit(x, "native") if(!is.unit(y) && !is.null(y)) y <- unit(y, "npc") if(!is.unit(width)) width <- unit(width, "lines") if(!is.unit(height) && !is.null(height)) height <- unit(height, "npc") function(residuals, shading, autotext) { res <- as.vector(residuals) if(is.null(text)) text <- autotext if (is.null(y)) y <- unit(1, "strwidth", text) + unit(1, "lines") if (is.null(height)) height <- unit(1, "npc") - y pushViewport(viewport(x = x, y = y, just = c("left", "bottom"), yscale = c(0,1), default.units = "npc", height = height, width = width)) p.value <- attr(shading, "p.value") legend <- attr(shading, "legend") if (is.null(range)) range <- range(res) if (length(range) != 2) stop("Range must have length two!") if (is.na(range[1])) range[1] <- min(res) if (is.na(range[2])) range[2] <- max(res) if(is.null(legend$col.bins)) { col.bins <- seq(range[1], range[2], length = steps) } else { col.bins <- sort(unique(c(legend$col.bins, range))) col.bins <- col.bins[col.bins <= range[2] & col.bins >= range[1]] } l <- length(col.bins) y.height <- (1 - (l - 2) * space) / (l - 1) y.pos <- cumsum(c(0, rep(y.height + space, l - 2))) res <- col.bins[-l] + diff(col.bins) / 2 grid.rect(x = unit(rep.int(0, length(y.pos)), "npc"), y = y.pos, height = y.height, default.units = "npc", gp = shading(res), just = c("left", "bottom")) numbers <- format(col.bins, nsmall = digits, digits = digits) wid <- unit(1, "strwidth", format(max(abs(col.bins)), nsmall = digits, digits = digits)) grid.text(numbers[-l], x = unit(1, "npc") + unit(0.6, "lines") + wid, y = y.pos, gp = gpar(fontsize = fontsize, fontfamily = fontfamily), default.units = "npc", just = c("right", "bottom")) grid.text(numbers[-1], x = unit(1, "npc") + unit(0.6, "lines") + wid, y = y.pos + y.height, gp = gpar(fontsize = fontsize, fontfamily = fontfamily), default.units = "npc", just = c("right", "top")) wid2 <- unit(1, "strwidth", format(max(abs(trunc(col.bins))))) + unit(0.3, "strwidth", ".") grid.segments(x0 = unit(1, "npc") + wid2 + unit(0.6, "lines"), x1 = unit(1, "npc") + wid2 + unit(0.6, "lines"), y0 = unit(y.pos, "npc") + 1.5 * unit(1, "strheight", "-44.4"), y1 = unit(y.pos + y.height, "npc") - 1.5 * unit(1, "strheight", "-44.4") ) popViewport(1) grid.text(text, x = x + 0.5 * width, y = 0, gp = gpar(fontsize = fontsize, fontfamily = fontfamily, lineheight = 0.8), just = c("left", "top"), rot = 90 ) } } class(legend_fixed) <- "grapcon_generator" vcd/R/distplot.R0000644000175000017500000001365012610700530013345 0ustar nileshnilesh# added lwd arg, changed default point sizes distplot <- function(x, type = c("poisson", "binomial", "nbinomial"), size = NULL, lambda = NULL, legend = TRUE, xlim = NULL, ylim = NULL, conf_int = TRUE, conf_level = 0.95, main = NULL, xlab = "Number of occurrences", ylab = "Distribution metameter", gp = gpar(cex = 0.8), lwd=2, gp_conf_int = gpar(lty = 2), name = "distplot", newpage = TRUE, pop = TRUE, return_grob = FALSE, ...) { if(is.vector(x)) { x <- table(x) } if(is.table(x)) { if(length(dim(x)) > 1) stop ("x must be a 1-way table") freq <- as.vector(x) count <- as.numeric(names(x)) } else { if(!(!is.null(ncol(x)) && ncol(x) == 2)) stop("x must be a 2-column matrix or data.frame") freq <- as.vector(x[,1]) count <- as.vector(x[,2]) } myindex <- (1:length(freq))[freq > 0] mycount <- count[myindex] myfreq <- freq[myindex] switch(match.arg(type), "poisson" = { par.ml <- suppressWarnings(goodfit(x, type = type)$par$lambda) phi <- function(nk, k, N, size = NULL) ifelse(nk > 0, lgamma(k + 1) + log(nk/N), NA) y <- phi(myfreq, mycount, sum(freq)) if(!is.null(lambda)) y <- y + lambda - mycount * log(lambda) fm <- lm(y ~ mycount) par.estim <- exp(coef(fm)[2]) names(par.estim) <- "lambda" txt <- "exp(slope)" if(!is.null(lambda)) { par.estim <- par.estim * lambda txt <- paste(txt, "x lambda") } legend.text <- paste(txt, "=", round(par.estim, digits = 3)) if(is.null(main)) main <- "Poissoness plot" }, "binomial" = { if(is.null(size)) { size <- max(count) warning("size was not given, taken as maximum count") } par.ml <- suppressWarnings(goodfit(x, type = type, par = list(size = size))$par$prob) phi <- function(nk, k, N, size = NULL) log(nk) - log(N * choose(size, k)) y <- phi(myfreq, mycount, sum(freq), size = size) fm <- lm(y ~ mycount) par.estim <- exp(coef(fm)[2]) par.estim <- par.estim / (1 + par.estim) names(par.estim) <- "prob" legend.text <- paste("inv.logit(slope) =", round(par.estim, digits = 3)) if(is.null(main)) main <- "Binomialness plot" }, "nbinomial" = { if(is.null(size)) { par.ml <- suppressWarnings(goodfit(x, type = type)$par) size <- par.ml$size par.ml <- par.ml$prob }else{ xbar <- weighted.mean(mycount, myfreq) par.ml <- size / (size+xbar) } phi <- function(nk, k, N, size = NULL) log(nk) - log(N * choose(size + k - 1, k)) y <- phi(myfreq, mycount, sum(freq), size = size) fm <- lm(y ~ mycount) par.estim <- 1 - exp(coef(fm)[2]) names(par.estim) <- "prob" legend.text <- paste("1-exp(slope) =", round(par.estim, digits = 3)) if(is.null(main)) main <- "Negative binomialness plot" }) yhat <- ifelse(myfreq > 1.5, myfreq - 0.67, 1/exp(1)) yhat <- phi(yhat, mycount, sum(freq), size = size) if(!is.null(lambda)) yhat <- yhat + lambda - mycount * log(lambda) phat <- myfreq / sum(myfreq) ci.width <- qnorm(1-(1 - conf_level)/2) * sqrt(1-phat)/sqrt(myfreq - (0.25 * phat + 0.47)*sqrt(myfreq)) RVAL <- cbind(count, freq, NA, NA, NA, NA, NA) RVAL[myindex,3:7] <- cbind(y,yhat,ci.width, yhat-ci.width, yhat + ci.width) RVAL <- as.data.frame(RVAL) names(RVAL) <- c("Counts", "Freq", "Metameter", "CI.center", "CI.width", "CI.lower", "CI.upper") if(is.null(xlim)) xlim <- range(RVAL[,1]) if(is.null(ylim)) ylim <- range(RVAL[,c(3,6,7)], na.rm = TRUE) xlim <- xlim + c(-1, 1) * diff(xlim) * 0.04 ylim <- ylim + c(-1, 1) * diff(ylim) * 0.04 if(newpage) grid.newpage() pushViewport(plotViewport(xscale = xlim, yscale = ylim, default.units = "native", name = name)) grid.points(x = RVAL[,1], y = RVAL[,3], default.units = "native", gp = gp, ...) grid.lines(x = xlim, y = predict(fm, newdata = data.frame(mycount = xlim)), default.units = "native", gp = gpar(lwd=lwd, col = 2)) grid.rect(gp = gpar(fill = "transparent")) grid.xaxis() grid.yaxis() grid.text(xlab, y = unit(-3.5, "lines")) grid.text(ylab, x = unit(-3, "lines"), rot = 90) grid.text(main, y = unit(1, "npc") + unit(2, "lines"), gp = gpar(fontface = "bold")) if(conf_int) { grid.points(x = RVAL[,1], y = RVAL[,4], pch = 19, gp = gpar(cex = 0.5)) grid.segments(RVAL[,1], RVAL[,6], RVAL[,1], RVAL[,7], default.units = "native", gp = gp_conf_int) } if(legend) { mymin <- which.min(RVAL[,5]) leg.x <- RVAL[mymin,1] if(RVAL[mymin,6] - ylim[1] > ylim[2] - RVAL[mymin,7]) leg.y <- ylim[1] + 0.7 * (RVAL[mymin,6] - ylim[1]) else leg.y <- ylim[2] legend.text <- c(paste("slope =", round(coef(fm)[2], digits = 3)), paste("intercept =", round(coef(fm)[1], digits = 3)), "", paste(names(par.estim),": ML =", round(par.ml, digits=3)), legend.text) legend.text <- paste(legend.text, collapse = "\n") grid.text(legend.text, leg.x, leg.y - 0.05 * abs(leg.y), default.units = "native", just = c("left", "top")) } if(pop) popViewport() else upViewport() if (return_grob) structure(invisible(RVAL), grob = grid.grab()) else invisible(RVAL) } vcd/R/Ord_plot.R0000644000175000017500000000737412445046670013311 0ustar nileshnilesh# This should be revised to allow graphical parameters to be more easily passed # for points and lines # For now, added lwd, lty and col args for lines, with more useful defaults Ord_plot <- function(obj, legend = TRUE, estimate = TRUE, tol = 0.1, type = NULL, xlim = NULL, ylim = NULL, xlab = "Number of occurrences", ylab = "Frequency ratio", main = "Ord plot", gp = gpar(cex = 0.5), lwd = c(2,2), lty=c(2,1), col=c("black", "red"), name = "Ord_plot", newpage = TRUE, pop = TRUE, return_grob = FALSE, ...) { if(is.vector(obj)) { obj <- table(obj) } if(is.table(obj)) { if(length(dim(obj)) > 1) stop ("obj must be a 1-way table") x <- as.vector(obj) count <- as.numeric(names(obj)) } else { if(!(!is.null(ncol(obj)) && ncol(obj) == 2)) stop("obj must be a 2-column matrix or data.frame") x <- as.vector(obj[,1]) count <- as.vector(obj[,2]) } y <- count * x/c(NA, x[-length(x)]) fm <- lm(y ~ count) fmw <- lm(y ~ count, weights = sqrt(pmax(x, 1) - 1)) fit1 <- predict(fm, data.frame(count)) fit2 <- predict(fmw, data.frame(count)) if(is.null(xlim)) xlim <- range(count) if(is.null(ylim)) ylim <- range(c(y, fit1, fit2), na.rm = TRUE) xlim <- xlim + c(-1, 1) * diff(xlim) * 0.04 ylim <- ylim + c(-1, 1) * diff(ylim) * 0.04 lwd <- rep_len(lwd, 2) # assure length=2 lty <- rep_len(lty, 2) col <- rep_len(col, 2) if(newpage) grid.newpage() pushViewport(plotViewport(xscale = xlim, yscale = ylim, default.units = "native", name = name)) grid.points(x = count, y = y, default.units = "native", gp = gp, ...) grid.lines(x = count, y = fit1, default.units = "native", gp = gpar(lwd=lwd[1], lty=lty[1], col=col[1])) grid.lines(x = count, y = fit2, default.units = "native", gp = gpar(lwd=lwd[2], lty=lty[2], col=col[2])) grid.rect(gp = gpar(fill = "transparent")) grid.xaxis() grid.yaxis() grid.text(xlab, y = unit(-3.5, "lines")) grid.text(ylab, x = unit(-3, "lines"), rot = 90) grid.text(main, y = unit(1, "npc") + unit(2, "lines"), gp = gpar(fontface = "bold")) RVAL <- coef(fmw) names(RVAL) <- c("Intercept", "Slope") if(legend) { legend.text <- c(paste("slope =", round(RVAL[2], digits = 3)), paste("intercept =", round(RVAL[1], digits = 3))) if(estimate) { ordfit <- Ord_estimate(RVAL, type = type, tol = tol) legend.text <- c(legend.text, "", paste("type:", ordfit$type), paste("estimate:", names(ordfit$estimate),"=", round(ordfit$estimate, digits = 3))) legend.text <- paste(legend.text, collapse = "\n") } grid.text(legend.text, min(count), ylim[2] * 0.95, default.units = "native", just = c("left", "top")) } if(pop) popViewport() else upViewport() if(return_grob) invisible(structure(RVAL, grob = grid.grab())) else invisible(RVAL) } Ord_estimate <- function(x, type = NULL, tol = 0.1) { a <- x[1] b <- x[2] if(!is.null(type)) type <- match.arg(type, c("poisson", "binomial", "nbinomial", "log-series")) else { if(abs(b) < tol) type <- "poisson" else if(b < (-1 * tol)) type <- "binomial" else if(a > (-1 * tol)) type <- "nbinomial" else if(abs(a + b) < 4*tol) type <- "log-series" else type <- "none" } switch(type, "poisson" = { par <- a names(par) <- "lambda" if(par < 0) warning("lambda not > 0") }, "binomial" = { par <- b/(b - 1) names(par) <- "prob" if(abs(par - 0.5) > 0.5) warning("prob not in (0,1)") }, "nbinomial" = { par <- 1 - b names(par) <- "prob" if(abs(par - 0.5) > 0.5) warning("prob not in (0,1)") }, "log-series" = { par <- b names(par) <- "theta" if(par < 0) warning("theta not > 0") }, "none" = { par <- NA }) list(estimate = par, type = type) } vcd/R/woolf_test.R0000755000175000017500000000131411150520606013667 0ustar nileshnileshwoolf_test <- function(x) { DNAME <- deparse(substitute(x)) if (any(x == 0)) x <- x + 1 / 2 k <- dim(x)[3] or <- apply(x, 3, function(x) (x[1,1] * x[2,2]) / (x[1,2] * x[2,1])) w <- apply(x, 3, function(x) 1 / sum(1 / x)) o <- log(or) e <- weighted.mean(log(or), w) STATISTIC <- sum(w * (o - e)^2) PARAMETER <- k - 1 PVAL <- 1 - pchisq(STATISTIC, PARAMETER) METHOD <- "Woolf-test on Homogeneity of Odds Ratios (no 3-Way assoc.)" names(STATISTIC) <- "X-squared" names(PARAMETER) <- "df" structure(list(statistic = STATISTIC, parameter = PARAMETER, p.value = PVAL, method = METHOD, data.name = DNAME, observed = o, expected = e), class = "htest") } vcd/R/loddsratio.R0000644000175000017500000006034213163113030013644 0ustar nileshnilesh## Modifications: ## -- return a dnames component, containing dimnames for the array version of coef ## -- added dim methods: dim.loddsratio, dimnames.loddsratio ## -- added print.loddsratio ## -- handle strata: result computed correctly, but structure of coef() loses names ## and confint doesn't work in the 2x2xk or RxCxk case ## -- Fixed problem with strata by setting rownames and colnames for contrast matrix ## DONE: handle multiple strata (|foo:bar) ## -- print.loddsratio now uses drop() for dimensions of length 1 ## -- made generic, anticipating a formula method, maybe structable or ftable methods ## DONE: decide which methods should allow a log=FALSE argument to provide exp(lor) ## -- Now handle any number of strata ## -- Added log= argument to print, coef methods, and added confint.loddsratio method, ## allowing log=FALSE ## -- Incorporated Z code additions, fixing some s ## -- Added as.matrix and as.array methods; had to make as.array S3 generic ## -- Added header to print method ## -- Added as.data.frame method (for use in plots) ## -- "LOR" is renamed "OR" if log=FALSE ## -- Revised as.matrix to drop leading 1:2 dimensions of length 1 ## -- Removed as.array generic, now in base ## -- DM: added plot.oddsratio method ## -- DM: added formula interface ## -- DM: add t() and aperm() methdos loddsratio <- function(x, ...) UseMethod("loddsratio") loddsratio.formula <- function(formula, data = NULL, ..., subset = NULL, na.action = NULL) { m <- match.call(expand.dots = FALSE) edata <- eval(m$data, parent.frame()) fstr <- strsplit(paste(deparse(formula), collapse = ""), "~") vars <- strsplit(strsplit(gsub(" ", "", fstr[[1]][2]), "\\|")[[1]], "\\+") varnames <- vars[[1]] condnames <- if (length(vars) > 1) vars[[2]] else NULL dep <- gsub(" ", "", fstr[[1]][1]) if (!dep %in% c("","Freq")) { if (all(varnames == ".")) { varnames <- if (is.data.frame(data)) colnames(data) else names(dimnames(as.table(data))) varnames <- varnames[-which(varnames %in% dep)] } varnames <- c(dep, varnames) } if (inherits(edata, "ftable") || inherits(edata, "table") || length(dim(edata)) > 2) { condind <- NULL dat <- as.table(data) if(all(varnames != ".")) { ind <- match(varnames, names(dimnames(dat))) if (any(is.na(ind))) stop(paste("Can't find", paste(varnames[is.na(ind)], collapse=" / "), "in", deparse(substitute(data)))) if (!is.null(condnames)) { condind <- match(condnames, names(dimnames(dat))) if (any(is.na(condind))) stop(paste("Can't find", paste(condnames[is.na(condind)], collapse=" / "), "in", deparse(substitute(data)))) ind <- c(ind, condind) } dat <- margin.table(dat, ind) } loddsratio.default(dat, strata = if (is.null(condind)) NULL else match(condnames, names(dimnames(dat))), ...) } else { m <- m[c(1, match(c("formula", "data", "subset", "na.action"), names(m), 0))] m[[1]] <- as.name("xtabs") m$formula <- formula(paste(if("Freq" %in% colnames(data)) "Freq", "~", paste(c(varnames, condnames), collapse = "+"))) tab <- eval(m, parent.frame()) loddsratio.default(tab, ...) } } loddsratio.default <- function(x, strata = NULL, log = TRUE, ref = NULL, correct = any(x == 0), ...) { ## check dimensions L <- length(d <- dim(x)) if(any(d < 2L)) stop("All table dimensions must be 2 or greater") if(L > 2L && is.null(strata)) strata <- 3L:L if(is.character(strata)) strata <- which(names(dimnames(x)) == strata) if(L - length(strata) != 2L) stop("All but 2 dimensions must be specified as strata.") ## dimensions of primary R x C table dp <- if (length(strata)) d[-strata] else d dn <- if (length(strata)) dimnames(x)[-strata] else dimnames(x) R <- dp[1] C <- dp[2] # shadow matrix with proper dimnames X <- matrix(0, R, C, dimnames=dn) ## process reference categories (always return list of length ## two with reference for rows/cols, respectively) if(is.null(ref)) { ref <- list(NULL, NULL) } else if(is.character(ref)) { if(length(ref) != 2L) stop("'ref' must specify both reference categories") ref <- list(match(ref[1L], rownames(x)), match(ref[2L], colnames(x))) } else if(is.numeric(ref)) { ref <- as.integer(rep(ref, length.out = 2L)) ref <- list(ref[1L], ref[2L]) } ## compute corresponding indices compute_index <- function(n, ref) { if(is.null(ref)) return(cbind(1:(n-1), 2:n)) rval <- cbind(ref, 1:n) d <- rval[,2L] - rval[,1L] rval <- rbind( rval[d > 0, 1:2], rval[d < 0, 2:1] ) return(rval[order(rval[,1L]),,drop = FALSE]) } Rix <- compute_index(R, ref[[1L]]) Cix <- compute_index(C, ref[[2L]]) ## set up contrast matrix for the primary R x C table contr <- matrix(0L, nrow = (R-1) * (C-1), ncol = R * C) colnames(contr) <- paste(rownames(X)[as.vector(row(X))], colnames(X)[as.vector(col(X))], sep = ":") rownames(contr) <- rep("", (R-1) * (C-1)) for(i in 1:(R-1)) for(j in 1:(C-1)) { rix <- (j-1) * (R-1) + i cix <- rep(Rix[i,], 2L) + R * (rep(Cix[j,], each = 2L) - 1L) contr[rix, cix] <- c(1L, -1L, -1L, 1L) if (R > 2 || C > 2 || is.null(strata)) rownames(contr)[rix] <- sprintf("%s/%s", paste(rownames(X)[Rix[i,]], collapse = ":"), paste(colnames(X)[Cix[j,]], collapse = ":")) } # handle strata if (!is.null(strata)) { if (length(strata)==1) { sn <- dimnames(x)[[strata]] } else { sn <- apply(expand.grid(dimnames(x)[strata]), 1, paste, collapse = ":") } SEP <- if (R > 2 || C > 2 || is.null(strata)) "|" else "" rn <- as.vector(outer( dimnames(contr)[[1]], sn, paste, sep=SEP)) cn <- as.vector(outer( dimnames(contr)[[2]], sn, paste, sep=SEP)) contr <- kronecker(diag(prod(dim(x)[strata])), contr) rownames(contr) <- rn colnames(contr) <- cn } ## dimnames for array version dn <- list(rep("", R-1), rep("", C-1)) for(i in 1:(R-1)) dn[[1]][i] <- paste(rownames(x)[Rix[i,]], collapse = ":") for(j in 1:(C-1)) dn[[2]][j] <- paste(colnames(x)[Cix[j,]], collapse = ":") if (!is.null(strata)) dn <- c(dn, dimnames(x)[strata]) if (!is.null(names(dimnames(x)))) names(dn) <- names(dimnames(x)) ## point estimates if (is.logical(correct)) { add <- if(correct) 0.5 else 0 } else if(is.numeric(correct)) { add <- as.vector(correct) if (length(add) != length(x)) stop("array size of 'correct' does not conform to the data") } else stop("correct is not valid") ##coef <- drop(contr %*% log(as.vector(x) + add)) ##FIXME: 0 cells mess up the matrix product, try workaround: mat <- log(as.vector(x) + add) * t(contr) nas <- apply(contr != 0 & is.na(t(mat)), 1, any) coef <- apply(mat, 2, sum, na.rm = TRUE) coef[nas] <- NA ## covariances ##vcov <- crossprod(diag(sqrt(1/(as.vector(x) + add))) %*% t(contr)) tmp <- sqrt(1/(as.vector(x) + add)) * t(contr) tmp[is.na(tmp)] <- 0 vcov <- crossprod(tmp) vcov[nas,] <- NA vcov[,nas] <- NA rval <- structure(list( coefficients = coef, dimnames = dn, dim = as.integer(sapply(dn, length)), vcov = vcov, contrasts = contr, log = log ), class = "loddsratio") rval } ## dim methods dimnames.loddsratio <- function(x, ...) x$dimnames dim.loddsratio <- function(x, ...) x$dim ## t/aperm-methods t.loddsratio <- function(x) aperm(x) aperm.loddsratio <- function(a, perm = NULL, ...) { d <- length(a$dim) if(is.null(perm)) { perm <- if (d < 3) 2L : 1L else c(2L : 1L, d : 3L) } else { if (any(perm[1:2] > 2L) || (d > 2L) && any(perm[-c(1:2)] < 2L)) stop("Mixing of strata and non-strata variables not allowed!") } nams <- names(a$coefficients) a$coefficients <- as.vector(aperm(array(a$coef, dim = a$dim), perm, ...)) nams <- as.vector(aperm(array(nams, dim = a$dim), perm, ...)) names(a$coefficients) <- nams a$dimnames <- a$dimnames[perm] a$dim <- a$dim[perm] a$vcov <- a$vcov[nams, nams] a$contrasts <- a$contrasts[nams,] a } ## straightforward methods coef.loddsratio <- function(object, log = object$log, ...) if(log) object$coefficients else exp(object$coefficients) vcov.loddsratio <- function(object, log = object$log, ...) if(log) object$vcov else `diag<-`(object$vcov, diag(object$vcov) * exp(object$coefficients)^2) confint.loddsratio <- function(object, parm, level = 0.95, log = object$log, ...) { if (log) confint.default(object, parm = parm, level = level, ... ) else { object$log = TRUE exp(confint.default(object, parm = parm, level = level, ... )) } } make_header <- function(x) { vn <- names(dimnames(x)) header <- c(if(x$log) "log" else "", "odds ratios for", vn[1], "and", vn[2], if (length(vn)>2) c("by", paste(vn[-(1:2)], collapse=', ')), "\n\n") paste(header, sep = " ") } ## print method print.loddsratio <- function(x, log = x$log, ...) { cat(make_header(x)) print(drop(array(coef(x, log = log), dim = dim(x), dimnames = dimnames(x)), ...)) invisible(x) } summary.loddsratio <- function(object, ...) lmtest::coeftest(object, ...) ## reshape coef() methods as.matrix.loddsratio <- function (x, log=x$log, ...) { Coef <- coef(x, log = log) if (length(dim(x))==2) matrix(Coef, ncol = dim(x)[2], dimnames=dimnames(x)) else { # drop leading dimensions with length 1, then reshape ddim <- which(dim(x)[1:2]==1) dim(Coef) <- dim(x)[-ddim] dimnames(Coef) <- dimnames(x)[-ddim] if (length(dim(Coef))==1) Coef else matrix(Coef, ncol = prod(dim(Coef)[-1]), dimnames=list(dimnames(Coef)[[1]], apply(expand.grid(dimnames(Coef)[[-1]]), 1, paste, collapse = ":"))) } } as.array.loddsratio <- function (x, log=x$log, ...) { res <- array(coef(x, log = log), dim = dim(x), dimnames=dimnames(x)) drop(res) } as.data.frame.loddsratio <- function(x, row.names = NULL, optional, log=x$log, ...) { df <-data.frame(expand.grid(dimnames(x)), LOR = coef(x, log=log), ASE = sqrt(diag(vcov(x, log=log))), row.names=row.names, ... ) if (!log) colnames(df)[ncol(df)-1] <- "OR" df } image.loddsratio <- function(x, interpolate = NULL, legend = legend_fixed, gp = shading_Friendly, gp_args = NULL, labeling = labeling_values("residuals", suppress = 0), perm = NULL, ...) { a <- as.array(x) if (!is.null(dim(a))) { if (is.null(perm)) { d <- seq_along(dim(a)) perm <- c(d[-c(1:2)], 1:2) } a <- aperm(a, perm) } else { a <- as.table(a) names(dimnames(a)) <- names(dimnames(x))[1] } if (is.null(interpolate)) interpolate <- seq(0.1, max(abs(a), length.out = 4)) if (is.null(gp_args)) gp_args <- list(interpolate = interpolate) tmp <- a tmp[] <- 1 mosaic(tmp, type = "expected", residuals = a, shade = TRUE, gp = shading_Friendly, gp_args = gp_args, legend = legend, labeling = labeling, ...) } tile.loddsratio <- function(x, interpolate = NULL, legend = legend_fixed, gp = shading_Friendly, gp_args = NULL, labeling = labeling_values("residuals", suppress = 0), halign = "center", valign = "center", perm = NULL, ...) { a <- as.array(x) if (!is.null(dim(a))) { if (is.null(perm)) { d <- seq_along(dim(a)) perm <- c(d[-c(1:2)], 1:2) } a <- aperm(a, perm) } else { a <- as.table(a) names(dimnames(a)) <- names(dimnames(x))[1] } if (is.null(interpolate)) interpolate <- seq(0.1, max(abs(a), length.out = 4)) if (is.null(gp_args)) gp_args <- list(interpolate = interpolate) tile(abs(a), halign = halign, valign = valign, residuals = a, shade = TRUE, gp = shading_Friendly, gp_args = gp_args, legend = legend, labeling = labeling, ...) } "plot.loddsratio" <- function(x, baseline = TRUE, gp_baseline = gpar(lty = 2), lines = TRUE, lwd_lines = 3, confidence = TRUE, conf_level = 0.95, lwd_confidence = 2, whiskers = 0, transpose = FALSE, col = NULL, cex = 0.8, pch = NULL, bars = NULL, gp_bars = gpar(fill = "lightgray", alpha = 0.5), bar_width = unit(0.05, "npc"), legend = TRUE, legend_pos = "topright", legend_inset = c(0, 0), legend_vgap = unit(0.5, "lines"), gp_legend_frame = gpar(lwd = 1, col = "black"), gp_legend_title = gpar(fontface = "bold"), gp_legend = gpar(), legend_lwd = 1, legend_size = 1, xlab = NULL, ylab = NULL, xlim = NULL, ylim = NULL, main = NULL, gp_main = gpar(fontsize = 12, fontface = "bold"), newpage = TRUE, pop = FALSE, return_grob = FALSE, add = FALSE, prefix = "", ...) { ## handle default values, limits etc. LOG <- x$log values <- as.array(x) d <- dim(values) if (is.null(bars)) bars <- is.null(d) oddsrange <- range(values, na.rm = TRUE) if(confidence) { CI <- confint(x, log = LOG, level = conf_level) lwr <- CI[,1] upr <- CI[,2] oddsrange <- if (baseline) c(min(0, lwr, na.rm = TRUE), max(0, upr, na.rm = TRUE)) else c(min(lwr, na.rm = TRUE), max(upr, na.rm = TRUE)) } if (is.null(main)) main <- paste(make_header(x), collapse = " ") if (is.null(xlim)) xlim <- if (is.null(d)) c(1, length(values)) else c(1, d[1]) if (is.null(ylim)) ylim <- oddsrange ylimaxis <- ylim + c(-1, 1) * diff(ylim) * 0.04 xlimaxis <- xlim + c(-1, 1) * diff(xlim) * 0.04 ncols <- if (is.null(d)) 1 else prod(d[-1]) if (is.null(col)) col <- rainbow_hcl(ncols, l = 50) if (is.null(pch)) pch <- c(19,15,17, 1:14, 16, 18, 20:25) labs <- if (is.null(d)) names(values) else dimnames(values)[[1]] if (is.null(xlab)) xlab <- if (is.null(d)) names(dimnames(x))[3] else names(dimnames(values))[1] if (is.null(ylab)) ylab <- paste(if (LOG) "L" else "", "OR(", paste(names(dimnames(x))[1:2], collapse = " / "), ")", sep = "") if (newpage) grid.newpage() if (transpose) { if (!add) { ## set up plot region, similar to plot.xy() pushViewport(plotViewport(xscale = ylimaxis, yscale = xlimaxis, default.units = "native", name = paste(prefix,"oddsratio_plot"))) grid.yaxis(name = "yaxis", seq_along(labs), labs, edits = gEdit("labels", rot = 90, hjust = .5, vjust = 0)) grid.xaxis() grid.text(ylab, y = unit(-3.5, "lines")) grid.text(xlab, x = unit(-3, "lines"), rot = 90) grid.text(main, y = unit(1, "npc") + unit(1, "lines"), gp = gp_main) pushViewport(viewport(xscale = ylimaxis, yscale = xlimaxis, default.units = "native", clip = "on")) ## baseline if (baseline) grid.lines(unit(c(1,1) - LOG, "native"), unit(c(0,1), "npc"), gp = gp_baseline) } # workhorse for one stratum draw_one_stratum <- function(vals, pch = "o", col = "black", offset = 0, jitter = 0) { if (bars) { if (any(vals > !LOG)) grid.rect(unit(vals[vals > !LOG], "native"), unit(seq_along(vals)[vals > !LOG], "native"), height = bar_width, width = unit(vals[vals > !LOG] - !LOG, "native"), just = "right", gp = gp_bars ) if (any(vals < !LOG)) grid.rect(unit(vals[vals < !LOG], "native"), unit(seq_along(vals)[vals < !LOG], "native"), height = bar_width, width = unit(abs(vals[vals < !LOG] - !LOG), "native"), just = "left", gp = gp_bars ) } if (lines) grid.lines(unit(vals, "native"), unit(seq_along(vals), "native"), gp = gpar(col = col, lwd = lwd_lines), default.units = "native" ) grid.points(unit(vals, "native"), unit(seq_along(vals), "native"), pch = pch, size = unit(cex, "char"), gp = gpar(col = col, lwd = lwd_lines), default.units = "native" ) if (confidence) for (i in seq_along(vals)) { ii <- i + jitter grid.lines(unit(c(lwr[offset + i], upr[offset + i]), "native"), unit(c(ii, ii), "native"), gp = gpar(col = col, lwd = lwd_confidence)) grid.lines(unit(c(lwr[offset + i], lwr[offset + i]), "native"), unit(c(ii - whiskers/2, ii + whiskers/2), "native"), gp = gpar(col = col, lwd = lwd_confidence)) grid.lines(unit(c(upr[offset + i], upr[offset + i]), "native"), unit(c(ii - whiskers/2, ii + whiskers/2), "native"), gp = gpar(col = col, lwd = lwd_confidence)) } } } else { if (!add) { ## set up plot region pushViewport(plotViewport(xscale = xlimaxis, yscale = ylimaxis, default.units = "native", name = "oddsratio_plot")) grid.xaxis(seq_along(labs), labs) grid.yaxis() grid.text(xlab, y = unit(-3.5, "lines")) grid.text(ylab, x = unit(-3, "lines"), rot = 90) grid.text(main, y = unit(1, "npc") + unit(1, "lines"), gp = gp_main) pushViewport(viewport(xscale = xlimaxis, yscale = ylimaxis, default.units = "native", clip = "on")) ## baseline if (baseline) grid.lines(unit(c(0,1), "npc"), unit(c(1,1) - LOG, "native"), gp = gp_baseline) } ## workhorse for one stratum draw_one_stratum <- function(vals, pch = "o", col = "black", offset = 0, jitter = 0) { if (bars) { if (any(vals > !LOG)) grid.rect(unit(seq_along(vals)[vals > !LOG], "native"), unit(vals[vals > !LOG], "native"), width = bar_width, height = unit(vals[vals > !LOG] - !LOG, "native"), just = "top", gp = gp_bars ) if (any(vals < !LOG)) grid.rect(unit(seq_along(vals)[vals < !LOG], "native"), unit(vals[vals < !LOG], "native"), width = bar_width, height = unit(abs(vals[vals < !LOG] - !LOG), "native"), just = "bottom", gp = gp_bars ) } if (lines) grid.lines(unit(seq_along(vals), "native"), unit(vals, "native"), gp = gpar(col = col, lwd = lwd_lines), default.units = "native" ) grid.points(unit(seq_along(vals), "native"), unit(vals, "native"), pch = pch, size = unit(cex, "char"), gp = gpar(col = col, lwd = lwd_lines), default.units = "native" ) if (confidence) for (i in seq_along(vals)) { ii <- i + jitter grid.lines(unit(c(ii, ii), "native"), unit(c(lwr[offset + i], upr[offset + i]), "native"), gp = gpar(col = col, lwd = lwd_confidence)) grid.lines(unit(c(ii - whiskers/2, ii + whiskers/2), "native"), unit(c(lwr[offset + i], lwr[offset + i]), "native"), gp = gpar(col = col, lwd = lwd_confidence)) grid.lines(unit(c(ii - whiskers/2, ii + whiskers/2), "native"), unit(c(upr[offset + i], upr[offset + i]), "native"), gp = gpar(col = col, lwd = lwd_confidence)) } } } if (is.null(d)) draw_one_stratum(values, pch[1], col[1]) else { jitt <- scale(seq_len(prod(d[-1])), scale = 25 * prod(d[-1])) for (i in 1 : prod(d[-1])) draw_one_stratum(values[(i - 1) * d[1] + seq(d[1])], pch[(i - 1 ) %% length(pch) + 1], col[i], offset = (i - 1) * d[1], jitt[i]) if (legend) grid_legend(legend_pos, labels = apply(expand.grid(dimnames(values)[-1]), 1, paste, collapse = "|"), pch = pch[1 : prod(d[-1])], col = col, lwd = legend_lwd, lty = "solid", size = legend_size, vgap = legend_vgap, gp = gp_legend, gp_frame = gp_legend_frame, inset = legend_inset, title = paste(names(dimnames(values)[-1]), collapse = " x "), gp_title = gp_legend_title, ...) } grid.rect(gp = gpar(fill = "transparent")) if (!add && pop) popViewport(2) if (return_grob) invisible(grid.grab()) else invisible(NULL) } lines.loddsratio <- function(x, legend = FALSE, confidence = FALSE, cex = 0, ...) { plot(x, add = TRUE, newpage = FALSE, legend = legend, confidence = confidence, cex = cex, ...) } vcd/R/goodfit.R0000655000175000017500000002325212511044620013140 0ustar nileshnileshgoodfit <- function(x, type = c("poisson", "binomial", "nbinomial"), method = c("ML", "MinChisq"), par = NULL) { if(is.vector(x)) { x <- table(x) } if(is.table(x)) { if(length(dim(x)) > 1) stop ("x must be a 1-way table") freq <- as.vector(x) count <- as.numeric(names(x)) } else { if(!(!is.null(ncol(x)) && ncol(x) == 2)) stop("x must be a 2-column matrix or data.frame") freq <- as.vector(x[,1]) count <- as.vector(x[,2]) } ## fill-in possibly missing cells nfreq <- rep(0, max(count) + 1) nfreq[count + 1] <- freq freq <- nfreq count <- 0:max(count) n <- length(count) ## starting value for degrees of freedom df <- -1 type <- match.arg(type) method <- match.arg(method) switch(type, "poisson" = { if(!is.null(par)) { if(!is.list(par)) stop("`par' must be a named list") if(names(par) != "lambda") stop("`par' must specify `lambda'") par <- par$lambda method <- "fixed" } else if(method == "ML") { df <- df - 1 par <- weighted.mean(count,freq) } else if(method == "MinChisq") { df <- df - 1 chi2 <- function(x) { p.hat <- diff(c(0, ppois(count[-n], lambda = x), 1)) expected <- sum(freq) * p.hat sum((freq - expected)^2/expected) } par <- optimize(chi2, range(count))$minimum } par <- list(lambda = par) p.hat <- dpois(count, lambda = par$lambda) }, "binomial" = { size <- par$size if(is.null(size)) { size <- max(count) warning("size was not given, taken as maximum count") } if(size > max(count)) { nfreq <- rep(0, size + 1) nfreq[count + 1] <- freq freq <- nfreq count <- 0:size n <- length(count) } if(!is.null(par$prob)) { if(!is.list(par)) stop("`par' must be a named list and specify `prob'") par <- par$prob method <- "fixed" } else if(method == "ML") { df <- df - 1 par <- weighted.mean(count/size, freq) } else if(method == "MinChisq") { df <- df - 1 chi2 <- function(x) { p.hat <- diff(c(0, pbinom(count[-n], prob = x, size = size), 1)) expected <- sum(freq) * p.hat sum((freq - expected)^2/expected) } par <- optimize(chi2, c(0,1))$minimum } par <- list(prob = par, size = size) p.hat <- dbinom(count, prob = par$prob, size = par$size) }, "nbinomial" = { if(!is.null(par)) { if(!is.list(par)) stop("`par' must be a named list") if(!(isTRUE(all.equal(names(par), "size")) | isTRUE(all.equal(sort(names(par)), c("prob", "size"))))) stop("`par' must specify `size' and possibly `prob'") if(!is.null(par$prob)) method <- "fixed" } switch(method, "ML" = { if(is.null(par$size)) { df <- df - 2 par <- fitdistr(rep(count, freq), "negative binomial")$estimate par <- par[1]/c(1, sum(par)) } else { df <- df - 1 method <- c("ML", "with size fixed") size <- par$size xbar <- weighted.mean(count,freq) par <- c(size, size/(xbar+size)) } }, "MinChisq" = { if(is.null(par$size)) { df <- df - 2 ## MM xbar <- weighted.mean(count,freq) s2 <- var(rep(count,freq)) p <- xbar / s2 size <- xbar^2/(s2 - xbar) par1 <- c(size, p) ## minChisq chi2 <- function(x) { p.hat <- diff(c(0, pnbinom(count[-n], size = x[1], prob = x[2]), 1)) expected <- sum(freq) * p.hat sum((freq - expected)^2/expected) } par <- optim(par1, chi2)$par } else { df <- df - 1 method <- c("MinChisq", "with size fixed") chi2 <- function(x) { p.hat <- diff(c(0, pnbinom(count[-n], size = par$size, prob = x), 1)) expected <- sum(freq) * p.hat sum((freq - expected)^2/expected) } par <- c(par$size, optimize(chi2, c(0, 1))$minimum) } }, "fixed" = { par <- c(par$size, par$prob) }) par <- list(size = par[1], prob = par[2]) p.hat <- dnbinom(count, size = par$size, prob = par$prob) }) expected <- sum(freq) * p.hat df <- switch(method[1], "MinChisq" = { length(freq) + df }, "ML" = { sum(freq > 0) + df }, "fixed" = { c(length(freq), sum(freq > 0)) + df } ) structure(list(observed = freq, count = count, fitted = expected, type = type, method = method, df = df, par = par), class = "goodfit") } # does this need a residuals_type arg? print.goodfit <- function(x, residuals_type = c("pearson", "deviance", "raw"), ...) { residuals_type <- match.arg(residuals_type) cat(paste("\nObserved and fitted values for", x$type, "distribution\n")) if(x$method[1] == "fixed") cat("with fixed parameters \n\n") else cat(paste("with parameters estimated by `", paste(x$method, collapse = " "), "' \n\n", sep = "")) resids <- residuals(x, type = residuals_type) RVAL <- cbind(x$count, x$observed, x$fitted, resids) colnames(RVAL) <- c("count", "observed", "fitted", paste(residuals_type, "residual")) rownames(RVAL) <- rep("", nrow(RVAL)) print(RVAL, ...) invisible(x) } summary.goodfit <- function(object, ...) { df <- object$df obsrvd <- object$observed count <- object$count expctd <- fitted(object) G2 <- sum(ifelse(obsrvd == 0, 0, obsrvd * log(obsrvd/expctd))) * 2 n <- length(obsrvd) pfun <- switch(object$type, poisson = "ppois", binomial = "pbinom", nbinomial = "pnbinom") p.hat <- diff(c(0, do.call(pfun, c(list(q = count[-n]), object$par)), 1)) expctd <- p.hat * sum(obsrvd) X2 <- sum((obsrvd - expctd)^2 / expctd) names(G2) <- "Likelihood Ratio" names(X2) <- "Pearson" if(any(expctd < 5) & object$method[1] != "ML") warning("Chi-squared approximation may be incorrect") RVAL <- switch(object$method[1], ML = G2, MinChisq = X2, fixed = c(X2, G2) ) RVAL <- cbind(RVAL, df, pchisq(RVAL, df = df, lower.tail = FALSE)) colnames(RVAL) <- c("X^2", "df", "P(> X^2)") cat(paste("\n\t Goodness-of-fit test for", object$type, "distribution\n\n")) print(RVAL, ...) invisible(RVAL) } plot.goodfit <- function(x, ...) { rootogram(x, ...) } fitted.goodfit <- function(object, ...) { object$fitted } residuals.goodfit <- function(object, type = c("pearson", "deviance", "raw"), ...) { obsrvd <- object$observed expctd <- fitted(object) count <- object$count n <- length(obsrvd) pfun <- switch(object$type, poisson = "ppois", binomial = "pbinom", nbinomial = "pnbinom") p.hat <- diff(c(0, do.call(pfun, c(list(q = count[-n]), object$par)), 1)) expctd <- p.hat * sum(obsrvd) res <- switch(match.arg(type), pearson = (obsrvd - expctd) / sqrt(expctd), deviance = ifelse(obsrvd == 0, 0, obsrvd * log(obsrvd / expctd)), obsrvd - expctd) return(res) } predict.goodfit <- function(object, newcount = NULL, type = c("response", "prob"), ...) { if(is.null(newcount)) newcount <- object$count type <- match.arg(type) densfun <- switch(object$type, poisson = "dpois", binomial = "dbinom", nbinomial = "dnbinom") RVAL <- do.call(densfun, c(list(x = newcount), object$par)) if (type == "response") RVAL <- RVAL * sum(object$observed) return(RVAL) } vcd/R/strucplot.R0000655000175000017500000003000713631232430013542 0ustar nileshnilesh################################################################ ### strucplot - generic plot framework for mosaic-like layouts ### 2 core functions are provided: struc_mosaic and struc_assoc ################################################################ strucplot <- function(## main parameters x, residuals = NULL, expected = NULL, condvars = NULL, shade = NULL, type = c("observed", "expected"), residuals_type = NULL, df = NULL, ## layout split_vertical = NULL, spacing = spacing_equal, spacing_args = list(), gp = NULL, gp_args = list(), labeling = labeling_border, labeling_args = list(), core = struc_mosaic, core_args = list(), legend = NULL, legend_args = list(), main = NULL, sub = NULL, margins = unit(3, "lines"), title_margins = NULL, legend_width = NULL, ## control parameters main_gp = gpar(fontsize = 20), sub_gp = gpar(fontsize = 15), newpage = TRUE, pop = TRUE, return_grob = FALSE, keep_aspect_ratio = NULL, prefix = "", ... ) { ## default behaviour of shade if (is.null(shade)) shade <- !is.null(gp) || !is.null(expected) type <- match.arg(type) if (is.null(residuals)) { residuals_type <- if (is.null(residuals_type)) "pearson" else match.arg(tolower(residuals_type), c("pearson", "deviance", "ft")) } else { if (is.null(residuals_type)) residuals_type <- "" } ## convert structable object if (is.structable(x)) { if (is.null(split_vertical)) split_vertical <- attr(x, "split_vertical") x <- as.table(x) } if (is.null(split_vertical)) split_vertical <- FALSE ## table characteristics d <- dim(x) dl <- length(d) dn <- dimnames(x) if (is.null(dn)) dn <- dimnames(x) <- lapply(d, seq) dnn <- names(dimnames(x)) if (is.null(dnn)) dnn <- names(dn) <- names(dimnames(x)) <- LETTERS[1:dl] ## replace NAs by 0 if (any(nas <- is.na(x))) x[nas] <- 0 ## model fitting: ## calculate df and expected if needed ## (used for inference in some shading (generating) functions). ## note: will *not* be calculated if residuals are given if ((is.null(expected) && is.null(residuals)) || !is.numeric(expected)) { if (!is.null(df)) warning("Using calculated degrees of freedom.") if (inherits(expected, "formula")) { fm <- loglm(expected, x, fitted = TRUE) expected <- fitted(fm) df <- fm$df } else { if (is.null(expected)) expected <- if (is.null(condvars)) as.list(1:dl) else lapply((condvars + 1):dl, c, seq(condvars)) fm <- loglin(x, expected, fit = TRUE, print = FALSE) expected <- fm$fit df <- fm$df } } ## compute residuals if (is.null(residuals)) residuals <- switch(residuals_type, pearson = (x - expected) / sqrt(ifelse(expected > 0, expected, 1)), deviance = { tmp <- 2 * (x * log(ifelse(x == 0, 1, x / ifelse(expected > 0, expected, 1))) - (x - expected)) tmp <- sqrt(pmax(tmp, 0)) ifelse(x > expected, tmp, -tmp) }, ft = sqrt(x) + sqrt(x + 1) - sqrt(4 * expected + 1) ) ## replace NAs by 0 if (any(nas <- is.na(residuals))) residuals[nas] <- 0 ## splitting if (length(split_vertical) == 1) split_vertical <- rep(c(split_vertical, !split_vertical), length.out = dl) if (is.null(keep_aspect_ratio)) keep_aspect_ratio <- dl < 3 ## spacing if (is.function(spacing)) { if (inherits(spacing, "grapcon_generator")) spacing <- do.call("spacing", spacing_args) spacing <- spacing(d, condvars) } ## gp (color, fill, lty, etc.) argument if (shade) { if (is.null(gp)) gp <- shading_hcl if (is.function(gp)) { if (is.null(legend) || (is.logical(legend) && legend)) legend <- legend_resbased gpfun <- if (inherits(gp, "grapcon_generator")) do.call("gp", c(list(x, residuals, expected, df), as.list(gp_args))) else gp gp <- gpfun(residuals) } else if (!is.null(legend) && !(is.logical(legend) && !legend)) stop("gp argument must be a shading function for drawing a legend") } else { if(!is.null(gp)) { warning("gp parameter ignored since shade = FALSE") gp <- NULL } } ## choose gray when no shading is used if (is.null(gp)) gp <- gpar(fill = grey(0.8)) ## recycle gpar values in the *first* dimension size <- prod(d) FUN <- function(par) { if (is.structable(par)) par <- as.table(par) if (length(par) < size || is.null(dim(par))) array(par, dim = d) else par } gp <- structure(lapply(gp, FUN), class = "gpar") ## set up page if (newpage) grid.newpage() if (keep_aspect_ratio) pushViewport(viewport(width = 1, height = 1, default.units = "snpc")) pushViewport(vcdViewport(mar = margins, oma = title_margins, legend = shade && !(is.null(legend) || is.logical(legend) && !legend), main = !is.null(main), sub = !is.null(sub), keep_aspect_ratio = keep_aspect_ratio, legend_width = legend_width, prefix = prefix)) ## legend if (inherits(legend, "grapcon_generator")) legend <- do.call("legend", legend_args) if (shade && !is.null(legend) && !(is.logical(legend) && !legend)) { seekViewport(paste(prefix, "legend", sep = "")) residuals_type <- switch(residuals_type, deviance = "deviance\nresiduals:", ft = "Freeman-Tukey\nresiduals:", pearson = "Pearson\nresiduals:", residuals_type) legend(residuals, gpfun, residuals_type) } ## titles if (!is.null(main)) { seekViewport(paste(prefix, "main", sep = "")) if (is.logical(main) && main) main <- deparse(substitute(x)) grid.text(main, gp = main_gp) } if (!is.null(sub)) { seekViewport(paste(prefix, "sub", sep = "")) if (is.logical(sub) && sub && is.null(main)) sub <- deparse(substitute(x)) grid.text(sub, gp = sub_gp) } ## make plot seekViewport(paste(prefix, "plot", sep = "")) if (inherits(core, "grapcon_generator")) core <- do.call("core", core_args) core(residuals = residuals, observed = if (type == "observed") x else expected, expected = if (type == "observed") expected else x, spacing = spacing, gp = gp, split_vertical = split_vertical, prefix = prefix) upViewport(1) ## labels if (is.logical(labeling)) labeling <- if (labeling) labeling_border else NULL if (!is.null(labeling)) { if (inherits(labeling, "grapcon_generator")) labeling <- do.call("labeling", c(labeling_args, list(...))) labeling(dn, split_vertical, condvars, prefix) } ## pop/move up viewport seekViewport(paste(prefix, "base", sep = "")) ## one more up if sandwich-mode if (pop) popViewport(1 + keep_aspect_ratio) else upViewport(1 + keep_aspect_ratio) ## return visualized table if (return_grob) invisible(structure(structable(if (type == "observed") x else expected, split_vertical = split_vertical), grob = grid.grab() ) ) else invisible(structable(if (type == "observed") x else expected, split_vertical = split_vertical)) } vcdViewport <- function(mar = rep.int(2.5, 4), legend_width = unit(5, "lines"), oma = NULL, legend = FALSE, main = FALSE, sub = FALSE, keep_aspect_ratio = TRUE, prefix = "") { ## process parameters if (is.null(legend_width)) legend_width <- unit(5 * legend, "lines") if (!is.unit(legend_width)) legend_width <- unit(legend_width, "lines") if (legend && !main && !sub && keep_aspect_ratio) main <- sub <- TRUE mar <- if (!is.unit(mar)) unit(pexpand(mar, 4, rep.int(2.5, 4), c("top","right","bottom","left")), "lines") else rep(mar, length.out = 4) if (is.null(oma)) { space <- if (legend && keep_aspect_ratio) legend_width + mar[2] + mar[4] - mar[1] - mar[3] else unit(0, "lines") oma <- if (main && sub) max(unit(2, "lines"), 0.5 * space) else if (main) unit.c(max(unit(2, "lines"), space), unit(0, "lines")) else if (sub) unit.c(unit(0, "lines"), max(unit(2, "lines"), space)) else 0.5 * space } oma <- if (!is.unit(oma)) unit(pexpand(oma, 2, rep.int(2, 2), c("top","bottom")), "lines") else rep(oma, length.out = 2) ## set up viewports vpPlot <- vpStack(viewport(layout.pos.col = 2, layout.pos.row = 3), viewport(width = 1, height = 1, name = paste(prefix, "plot", sep = ""), default.units = if (keep_aspect_ratio) "snpc" else "npc")) vpMarginBottom <- viewport(layout.pos.col = 2, layout.pos.row = 4, name = paste(prefix, "margin_bottom", sep = "")) vpMarginLeft <- viewport(layout.pos.col = 1, layout.pos.row = 3, name = paste(prefix, "margin_left", sep = "")) vpMarginTop <- viewport(layout.pos.col = 2, layout.pos.row = 2, name = paste(prefix, "margin_top", sep = "")) vpMarginRight <- viewport(layout.pos.col = 3, layout.pos.row = 3, name = paste(prefix, "margin_right", sep = "")) vpCornerTL <- viewport(layout.pos.col = 1, layout.pos.row = 2, name = paste(prefix, "corner_top_left", sep = "")) vpCornerTR <- viewport(layout.pos.col = 3, layout.pos.row = 2, name = paste(prefix, "corner_top_right", sep = "")) vpCornerBL <- viewport(layout.pos.col = 1, layout.pos.row = 4, name = paste(prefix, "corner_bottom_left", sep = "")) vpCornerBR <- viewport(layout.pos.col = 3, layout.pos.row = 4, name = paste(prefix, "corner_bottom_right", sep = "")) vpLegend <- viewport(layout.pos.col = 4, layout.pos.row = 3, name = paste(prefix, "legend", sep = "")) vpLegendTop <- viewport(layout.pos.col = 4, layout.pos.row = 2, name = paste(prefix, "legend_top", sep = "")) vpLegendSub <- viewport(layout.pos.col = 4, layout.pos.row = 4, name = paste(prefix, "legend_sub", sep = "")) vpBase <- viewport(layout = grid.layout(5, 4, widths = unit.c(mar[4], unit(1, "null"), mar[2], legend_width), heights = unit.c(oma[1], mar[1], unit(1, "null"), mar[3], oma[2])), name = paste(prefix, "base", sep = "")) vpMain <- viewport(layout.pos.col = 1:4, layout.pos.row = 1, name = paste(prefix, "main", sep = "")) vpSub <- viewport(layout.pos.col = 1:4, layout.pos.row = 5, name = paste(prefix, "sub", sep = "")) vpTree(vpBase, vpList(vpMain, vpMarginBottom, vpMarginLeft, vpMarginTop, vpMarginRight, vpLegendTop, vpLegend, vpLegendSub, vpCornerTL, vpCornerTR, vpCornerBL, vpCornerBR, vpPlot, vpSub)) } vcd/R/shadings.R0000644000175000017500000002453012537041354013314 0ustar nileshnilesh## convenience function for interfacing ## HCL colors as implemented in colorspace hcl2hex <- function(h = 0, c = 35, l = 85, fixup = TRUE) { colorspace::hex(polarLUV(l, c, h), fixup = fixup) } ## shading-generating functions should take at least the arguments ## observed, residuals, expected, df ## and return a function which takes a single argument (interpreted ## to be a vector of residuals). shading_hsv <- function(observed, residuals = NULL, expected = NULL, df = NULL, h = c(2/3, 0), s = c(1, 0), v = c(1, 0.5), interpolate = c(2, 4), lty = 1, eps = NULL, line_col = "black", p.value = NULL, level = 0.95, ...) { ## get h/s/v and lty my.h <- rep(h, length.out = 2) ## positive and negative hue my.s <- rep(s, length.out = 2) ## maximum and minimum saturation my.v <- rep(v, length.out = 2) ## significant and non-significant value lty <- rep(lty, length.out = 2) ## positive and negative lty ## model fitting (if necessary) if(is.null(expected) && !is.null(residuals)) stop("residuals without expected values specified") if(!is.null(expected) && is.null(df) && is.null(p.value)) { warning("no default inference available without degrees of freedom") p.value <- NA } if(is.null(expected) && !is.null(observed)) { expected <- loglin(observed, 1:length(dim(observed)), fit = TRUE, print = FALSE) df <- expected$df expected <- expected$fit } if(is.null(residuals) && !is.null(observed)) residuals <- (observed - expected)/sqrt(expected) ## conduct significance test (if specified) if(is.null(p.value)) p.value <- function(observed, residuals, expected, df) pchisq(sum(as.vector(residuals)^2), df, lower.tail = FALSE) if(!is.function(p.value) && is.na(p.value)) { v <- my.v[1] p.value <- NULL } else { if(is.function(p.value)) p.value <- p.value(observed, residuals, expected, df) v <- if(p.value < (1-level)) my.v[1] else my.v[2] } ## set up function for interpolation of saturation if(!is.function(interpolate)) { col.bins <- sort(interpolate) interpolate <- stepfun(col.bins, seq(my.s[2], my.s[1], length = length(col.bins) + 1)) col.bins <- sort(unique(c(col.bins, 0, -col.bins))) } else { col.bins <- NULL } ## store color and lty information for legend legend <- NULL if(!is.null(col.bins)) { res2 <- col.bins res2 <- c(head(res2, 1) - 1, res2[-1] - diff(res2)/2, tail(res2, 1) + 1) legend.col <- hsv(ifelse(res2 > 0, my.h[1], my.h[2]), pmax(pmin(interpolate(abs(res2)), 1), 0), v, ...) lty.bins <- 0 legend.lty <- lty[2:1] legend <- list(col = legend.col, col.bins = col.bins, lty = legend.lty, lty.bins = lty.bins) } ## set up function that computes color/lty from residuals rval <- function(x) { res <- as.vector(x) fill <- hsv(ifelse(res > 0, my.h[1], my.h[2]), pmax(pmin(interpolate(abs(res)), 1), 0), v, ...) dim(fill) <- dim(x) col <- rep(line_col, length.out = length(res)) if(!is.null(eps)) { eps <- abs(eps) col[res > eps] <- hsv(my.h[1], 1, v, ...) col[res < -eps] <- hsv(my.h[2], 1, v, ...) } dim(col) <- dim(x) # line type should be solid if abs(resid) < eps ltytmp <- ifelse(x > 0, lty[1], lty[2]) if(!is.null(eps)) ltytmp[abs(x) < abs(eps)] <- lty[1] dim(ltytmp) <- dim(x) return(structure(list(col = col, fill = fill, lty = ltytmp), class = "gpar")) } attr(rval, "legend") <- legend attr(rval, "p.value") <- p.value return(rval) } class(shading_hsv) <- "grapcon_generator" shading_hcl <- function(observed, residuals = NULL, expected = NULL, df = NULL, h = NULL, c = NULL, l = NULL, interpolate = c(2, 4), lty = 1, eps = NULL, line_col = "black", p.value = NULL, level = 0.95, ...) { ## set defaults if(is.null(h)) h <- c(260, 0) if(is.null(c)) c <- c(100, 20) if(is.null(l)) l <- c(90, 50) ## get h/c/l and lty my.h <- rep(h, length.out = 2) ## positive and negative hue my.c <- rep(c, length.out = 2) ## significant and non-significant maximum chroma my.l <- rep(l, length.out = 2) ## maximum and minimum luminance lty <- rep(lty, length.out = 2) ## positive and negative lty ## model fitting (if necessary) if(is.null(expected) && !is.null(residuals)) stop("residuals without expected values specified") if(!is.null(expected) && is.null(df) && is.null(p.value)) { warning("no default inference available without degrees of freedom") p.value <- NA } if(is.null(expected) && !is.null(observed)) { expected <- loglin(observed, 1:length(dim(observed)), fit = TRUE, print = FALSE) df <- expected$df expected <- expected$fit } if(is.null(residuals) && !is.null(observed)) residuals <- (observed - expected)/sqrt(expected) ## conduct significance test (if specified) if(is.null(p.value)) p.value <- function(observed, residuals, expected, df) pchisq(sum(as.vector(residuals)^2), df, lower.tail = FALSE) if(!is.function(p.value) && is.na(p.value)) { max.c <- my.c[1] p.value <- NULL } else { if(is.function(p.value)) p.value <- p.value(observed, residuals, expected, df) max.c <- ifelse(p.value < (1-level), my.c[1], my.c[2]) } ## set up function for interpolation of saturation if(!is.function(interpolate)) { col.bins <- sort(interpolate) interpolate <- stepfun(col.bins, seq(0, 1, length = length(col.bins) + 1)) col.bins <- sort(unique(c(col.bins, 0, -col.bins))) } else { col.bins <- NULL } ## store color and lty information for legend legend <- NULL if(!is.null(col.bins)) { res2 <- col.bins res2 <- c(head(res2, 1) - 1, res2[-1] - diff(res2)/2, tail(res2, 1) + 1) legend.col <- hcl2hex(ifelse(res2 > 0, my.h[1], my.h[2]), max.c * pmax(pmin(interpolate(abs(res2)), 1), 0), my.l[1] + diff(my.l) * pmax(pmin(interpolate(abs(res2)), 1), 0), ...) lty.bins <- 0 legend.lty <- lty[2:1] legend <- list(col = legend.col, col.bins = col.bins, lty = legend.lty, lty.bins = lty.bins) } ## set up function that computes color/lty from residuals rval <- function(x) { res <- as.vector(x) fill <- hcl2hex(ifelse(res > 0, my.h[1], my.h[2]), max.c * pmax(pmin(interpolate(abs(res)), 1), 0), my.l[1] + diff(my.l) * pmax(pmin(interpolate(abs(res)), 1), 0), ...) dim(fill) <- dim(x) col <- rep(line_col, length.out = length(res)) if(!is.null(eps)) { eps <- abs(eps) col[res > eps] <- hcl2hex(my.h[1], max.c, my.l[2], ...) col[res < -eps] <- hcl2hex(my.h[2], max.c, my.l[2], ...) } dim(col) <- dim(x) ltytmp <- ifelse(x > 0, lty[1], lty[2]) if(!is.null(eps)) ltytmp[abs(x) < abs(eps)] <- lty[1] dim(ltytmp) <- dim(x) return(structure(list(col = col, fill = fill, lty = ltytmp), class = "gpar")) } attr(rval, "legend") <- legend attr(rval, "p.value") <- p.value return(rval) } class(shading_hcl) <- "grapcon_generator" shading_Friendly <- function(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = c(2/3, 0), lty = 1:2, interpolate = c(2, 4), eps = 0.01, line_col = "black", ...) { shading_hsv(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = h, v = 1, lty = lty, interpolate = interpolate, eps = eps, line_col = line_col, p.value = NA, ...) } class(shading_Friendly) <- "grapcon_generator" shading_Friendly2 <- function(observed = NULL, residuals = NULL, expected = NULL, df = NULL, lty = 1:2, interpolate = c(2, 4), eps = 0.01, line_col = "black", ...) { shading_hcl(observed = NULL, residuals = NULL, expected = NULL, df = NULL, lty = lty, interpolate = interpolate, eps = eps, line_col = line_col, p.value = NA, ...) } class(shading_Friendly2) <- "grapcon_generator" shading_sieve <- function(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = c(260, 0), lty = 1:2, interpolate = c(2, 4), eps = 0.01, line_col = "black", ...) { shading_hcl(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = h, c = 100, l = 50, lty = lty, interpolate = interpolate, eps = eps, line_col = line_col, p.value = NA, ...) } class(shading_sieve) <- "grapcon_generator" shading_max <- function(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = NULL, c = NULL, l = NULL, lty = 1, eps = NULL, line_col = "black", level = c(0.9, 0.99), n = 1000, ...) { stopifnot(length(dim(observed)) == 2) ## set defaults if(is.null(h)) h <- c(260, 0) if(is.null(c)) c <- c(100, 20) if(is.null(l)) l <- c(90, 50) obs.test <- coindep_test(observed, n = n) col.bins <- obs.test$qdist(sort(level)) rval <- shading_hcl(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = h, c = c, l = l, interpolate = col.bins, lty = lty, eps = eps, line_col = line_col, p.value = obs.test$p.value, ...) return(rval) } class(shading_max) <- "grapcon_generator" shading_binary <- function(observed = NULL, residuals = NULL, expected = NULL, df = NULL, col = NULL) { ## check col argument if(is.null(col)) col <- hcl2hex(c(260, 0), 50, 70) col <- rep(col, length.out = 2) ## store color information for legend legend <- list(col = col[2:1], col.bins = 0, lty = NULL, lty.bins = NULL) ## set up function that computes color/lty from residuals rval <- function(x) gpar(fill = ifelse(x > 0, col[1], col[2])) ## add meta information for legend attr(rval, "legend") <- legend attr(rval, "p.value") <- NULL rval } class(shading_binary) <- "grapcon_generator" shading_Marimekko <- function(x, fill = NULL, byrow = FALSE) { if (is.null(fill)) fill <- colorspace::rainbow_hcl d <- dim(x) l1 <- if (length(d) > 1L) d[2] else d l2 <- if (length(d) > 1L) d[1] else 1 if (is.function(fill)) fill <- fill(l1) fill <- if (byrow) rep(fill, l2) else rep(fill, each = l2) gpar(col = NA, lty = "solid", fill = array(fill, dim = d)) } shading_diagonal <- function(x, fill = NULL) { if (is.null(fill)) fill <- colorspace::rainbow_hcl d <- dim(x) if (length(d) < 1L) stop("Need matrix or array!") if (d[1] != d[2]) stop("First two dimensions need to be of same length!") if (is.function(fill)) fill <- fill(d[1]) tp = toeplitz(seq_len(d[1])) gpar(col = NA, lty = "solid", fill = array(rep(fill[tp], d[1]), dim = d)) } vcd/R/grid_legend.R0000644000175000017500000001036712471732076013767 0ustar nileshnileshgrid_legend <- function (x, y, pch = NA, col = par('col'), labels, frame = TRUE, hgap = unit(0.8, "lines"), vgap = unit(0.8, "lines"), default_units = "lines", gp = gpar(), draw = TRUE, title = NULL, just = 'center', lwd = NA, lty = NA, size = 1, gp_title = NULL, gp_labels = NULL, gp_frame = gpar(fill = "transparent"), inset = c(0, 0)) { inset <- rep(inset, length.out = 2) if((length(x) > 1) && missing(y)) { y <- x[2] x <- x[1] } if(is.character(x)) switch(x, left = {x = unit(0 + inset[1],'npc'); y = unit(0.5 + inset[2],'npc'); just = c("left","center")}, topleft = {x = unit(0 + inset[1],'npc'); y = unit(1 - inset[2],'npc'); just = c(0,1)}, top = {x = unit(0.5 + inset[1],'npc'); y = unit(1 - inset[2],'npc'); just = c("center", "top")}, topright = {x = unit(1 - inset[1],'npc'); y = unit(1 - inset[2],'npc'); just = c(1,1)}, center = {x = unit(0.5 + inset[1],'npc'); y = unit(0.5 + inset[2],'npc'); just = c("center","center")}, bottom = {x = unit(0.5 - inset[1],'npc'); y = unit(0 + inset[2],'npc'); just = c("center","bottom")}, bottomright = {x = unit(1 - inset[1],'npc'); y = unit(0 + inset[2],'npc'); just = c(1,0)}, right = {x = unit(1 - inset[1],'npc'); y = unit(0.5 + inset[2],'npc'); just = c("right","center")}, bottomleft = {x = unit(0 + inset[1],'npc'); y = unit(0 + inset[2],'npc'); just = c(0,0)}) labels <- as.character(labels) nlabs <- length(labels) if(length(pch) == 1) pch <- rep(pch, nlabs) if(length(lwd) == 1) lwd <- rep(lwd, nlabs) if(length(lty) == 1) lty <- rep(lty, nlabs) if(length(col) == 1) col <- rep(col, nlabs) if(length(gp_labels) == 1) gp_labels <- rep(list(gp_labels), nlabs) if (is.logical(title) && !title) title <- NULL if(is.null(title)) tit <- 0 else tit <- 1 if (!is.unit(hgap)) hgap <- unit(hgap, default_units) if (length(hgap) != 1) stop("hgap must be single unit") if (!is.unit(vgap)) vgap <- unit(vgap, default_units) if (length(vgap) != 1) stop("vgap must be single unit") if(tit) legend.layout <- grid.layout(nlabs + tit, 3, widths = unit.c(unit(2, "lines"), max(unit(rep(1, nlabs), "strwidth", as.list(c(labels))), unit(1, "strwidth", title) - unit(2, "lines")), hgap), heights = unit.pmax(unit(1, "lines"), vgap + unit(rep(1, nlabs + tit ), "strheight", as.list(c(labels,title))))) else legend.layout <- grid.layout(nlabs, 3, widths = unit.c(unit(2, "lines"), max(unit(rep(1, nlabs), "strwidth", as.list(labels))), hgap), heights = unit.pmax(unit(1, "lines"), vgap + unit(rep(1, nlabs), "strheight", as.list(labels)))) fg <- frameGrob(layout = legend.layout, gp = gp) if (frame) fg <- placeGrob(fg, rectGrob(gp = gp_frame)) if (tit) fg <- placeGrob(fg, textGrob(title, x = .2, y = 0.5, just = c("left", "center"), gp = gp_title), col = 1, row = 1) for (i in 1:nlabs) { if(!is.na(pch[i])) fg <- placeGrob(fg, pointsGrob(0.5, 0.5, pch = pch[i], size = unit(size, "char"), gp = gpar(col = col[i])), col = 1, row = i + tit) else if(!is.na(lwd[i]) || !is.na(lty[i])) fg <- placeGrob(fg, linesGrob( unit(c(0.2, .8), "npc"), unit(c(.5), "npc"), gp = gpar(col = col[i], lwd = lwd[i], lty=lty[i])), col = 1, row = i + tit) fg <- placeGrob(fg, textGrob(labels[i], x = .1, y = 0.5, just = c("left", "center"), gp = gp_labels[[i]]), col = 2, row = i + tit) } pushViewport(viewport(x, y, height = grobHeight(fg), width = grobWidth(fg), just = just )) if (draw) grid.draw(fg) popViewport(1) invisible(fg) } vcd/R/coindep_test.R0000755000175000017500000000576311150520606014176 0ustar nileshnileshcoindep_test <- function(x, margin = NULL, n = 1000, indepfun = function(x) max(abs(x)), aggfun = max, alternative = c("greater", "less"), pearson = TRUE) { DNAME <- deparse(substitute(x)) alternative <- match.arg(alternative) if(is.null(margin)) { rs <- rowSums(x) cs <- colSums(x) expctd <- rs %o% cs / sum(rs) Pearson <- function(x) (x - expctd)/sqrt(expctd) resids <- Pearson(x) ff <- if(is.null(aggfun)) { if(pearson) function(x) aggfun(indepfun(Pearson(x))) else function(x) aggfun(indepfun(x)) } else { if(pearson) function(x) indepfun(Pearson(x)) else function(x) indepfun(x) } if(length(dim(x)) > 2) stop("currently only implemented for (conditional) 2d tables") dist <- sapply(r2dtable(n, rowSums(x), colSums(x)), ff) STATISTIC <- ff(x) } else { ff <- if(pearson) function(x) indepfun(Pearson(x)) else function(x) indepfun(x) cox <- co_table(x, margin) nc <- length(cox) if(length(dim(cox[[1]])) > 2) stop("currently only implemented for conditional 2d tables") dist <- matrix(rep(0, n * nc), ncol = nc) for(i in 1:nc) { coxi <- cox[[i]] cs <- colSums(coxi) rs <- rowSums(coxi) expctd <- rs %o% cs / sum(rs) Pearson <- function(x) (x - expctd)/sqrt(expctd) if(any(c(cs, rs) < 1)) warning("structural zeros") ## FIXME dist[, i] <- sapply(r2dtable(n, rs, cs), ff) } dist <- apply(dist, 1, aggfun) Pearson <- function(x) { expctd <- rowSums(x) %o% colSums(x) / sum(x) return((x - expctd)/sqrt(expctd)) } STATISTIC <- aggfun(sapply(cox, ff)) ## just for returning nicely formatted fitted values ## and residuals: fit once more with loglm() vars <- names(dimnames(x)) condvars <- if(is.numeric(margin)) vars[margin] else margin indvars <- vars[!(vars %in% condvars)] coind.form <- as.formula(paste("~ (", paste(indvars, collapse = " + "), ") * ", paste(condvars, collapse = " * "), sep = "")) fm <- loglm(coind.form, data = x, fitted = TRUE) expctd <- fitted(fm) resids <- residuals(fm, type = "pearson") } pdist <- function(x) sapply(x, function(y) mean(dist <= y)) qdist <- function(p) quantile(dist, p) PVAL <- switch(alternative, greater = mean(dist >= STATISTIC), less = mean(dist <= STATISTIC)) METHOD <- "Permutation test for conditional independence" names(STATISTIC) <- "f(x)" rval <- list(statistic = STATISTIC, p.value = PVAL, method = METHOD, data.name = DNAME, observed = x, expected = expctd, residuals = resids, margin = margin, dist = dist, qdist = qdist, pdist = pdist) class(rval) <- c("coindep_test", "htest") return(rval) } fitted.coindep_test <- function(object, ...) object$expected ## plot.coindep_test ## mosaic.coindep_test ## assoc.coindep_test ## difficult, depends on functionals... vcd/R/binregplot.R0000644000175000017500000002546412503645152013667 0ustar nileshnileshbinreg_plot <- function(model, main = NULL, xlab = NULL, ylab = NULL, xlim = NULL, ylim = NULL, pred_var = NULL, pred_range = c("data", "xlim"), group_vars = NULL, base_level = NULL, subset, type = c("response", "link"), conf_level = 0.95, delta = FALSE, pch = NULL, cex = 0.6, jitter_factor = 0.1, lwd = 5, lty = 1, point_size = 0, col_lines = NULL, col_bands = NULL, legend = TRUE, legend_pos = NULL, legend_inset = c(0, 0.1), legend_vgap = unit(0.5, "lines"), labels = FALSE, labels_pos = c("right", "left"), labels_just = c("left","center"), labels_offset = c(0.01, 0), gp_main = gpar(fontface = "bold", fontsize = 14), gp_legend_frame = gpar(lwd = 1, col = "black"), gp_legend_title = gpar(fontface = "bold"), newpage = TRUE, pop = FALSE, return_grob = FALSE) { if (!inherits(model, "glm")) stop("Method requires a model of class 'glm'.") type <- match.arg(type) labels_pos <- match.arg(labels_pos) if (is.character(pred_range)) pred_range <- match.arg(pred_range) ## extract data from model mod <- model.frame(model) term <- terms(mod) data.classes <- attr(term, "dataClasses") nam <- names(data.classes) ## determine response r <- attr(term, "response") resp <- nam[r] data.classes <- data.classes[-r] nam <- nam[-r] ## determine numeric predictor (take first) if (is.null(pred_var)) { fac <- data.classes %in% c("factor","logical") pred_var_model <- names(data.classes[!fac][1]) pred_var <- names(unlist(sapply(all.vars(term), grep, pred_var_model)))[1] } else pred_var_model <- pred_var ## filter observed data using model (to account for models fitted with subset=...) dat <- model$data[row.names(mod),] ## sort observations using order of numeric predictor o <- order(dat[,pred_var]) mod <- mod[o,] dat <- dat[o,] ## apply subset argument, if any if (!missing(subset)) { e <- substitute(subset) i <- eval(e, dat, parent.frame()) i <- i & !is.na(i) dat <- dat[i,] mod <- mod[i,] } ## determine conditioning variables. Remove all those with only one level observed. if (is.null(group_vars)) { group_vars <- nam[data.classes %in% "factor"] sing <- na.omit(sapply(dat, function(i) all(i == i[1]))) if (any(sing)) group_vars <- setdiff(group_vars, names(sing)[sing]) if(length(group_vars) < 1) group_vars <- NULL } else if (is.na(group_vars) || is.logical(group_vars) && !group_vars[1]) group_vars <- NULL ## set y axis limits - either probability or logit scale if(is.null(ylim)) ylim <- if (type == "response") c(0,1) else range(predict(model, dat, type = "link")) ## allow for some cosmetic extra space ylimaxis <- ylim + c(-1, 1) * diff(ylim) * 0.04 if(is.null(xlim)) xlim <- if (is.numeric(pred_range)) range(pred_range) else range(dat[,pred_var]) xlimaxis <- xlim + c(-1, 1) * diff(xlim) * 0.04 ## set default base level ("no effect") of response to first level/0 if (is.null(base_level)) base_level <- if(is.matrix(mod[,resp])) 2 else if(is.factor(mod[,resp])) levels(mod[,resp])[1] else 0 if (is.matrix(mod[,resp]) && is.character(base_level)) base_level <- switch(base_level, success =, Success = 1, failure =, Failure = 2) ## determine labels of conditioning variables, if any if (is.null(group_vars)) { labels <- legend <- FALSE } else { ## compute cross-factors for more than two conditioning variables if (length(group_vars) > 1) { cross <- paste(group_vars, collapse = " x ") dat[,cross] <- factor(apply(dat[,group_vars], 1, paste, collapse = " : ")) group_vars <- cross } lev <- levels(dat[,group_vars]) } ## set x- and y-lab if (is.null(xlab)) xlab <- pred_var if (is.null(ylab)) ylab <- if (type == "response") { if (is.matrix(mod[,resp])) paste0("P(", c("Failure","Success")[base_level], ")") else paste0("P(", resp, ")") } else { if (is.matrix(mod[,resp])) paste0("logit(", c("Failure","Success")[base_level], ")") else paste0("logit(", resp, ")") } ## rearrange default plot symbol palette if (is.null(pch)) pch <- c(19,15,17, 1:14, 16, 18, 20:25) ## determine normal quantile for confidence band quantile <- qnorm((1 + conf_level) / 2) ## determine default legend position, given the curve's slope ## (positive -> topleft, negative -> topright) if (is.null(legend_pos)) legend_pos <- if (coef(model)[grep(pred_var, names(coef(model)))[1]] > 0) "topleft" else "topright" ## work horse for drawing points, fitted curve and confidence band draw <- function(ind, colband, colline, pch, label) { ## plot observed data as points on top or bottom ycoords <- if (is.matrix(mod[,resp])) { tmp <- prop.table(mod[ind,resp], 1)[,switch(base_level, 2, 1)] if (type == "link") family(model)$linkfun(tmp) else tmp } else jitter(ylim[1 + (mod[ind, resp] != base_level)], jitter_factor) if (cex > 0) grid.points(unit(dat[ind, pred_var], "native"), unit(ycoords, "native"), pch = pch, size = unit(cex, "char"), gp = gpar(col = colline), default.units = "native" ) ## confidence band and fitted values typ <- if (type == "response" && !delta) "link" else type if (is.character(pred_range)) { if (pred_range == "data") { D <- dat[ind,] P <- D[,pred_var] } else { P <- seq(from = xlim[1L], to = xlim[2L], length.out = 100L) D <- dat[ind,][rep(1L, length(P)),] D[,pred_var] <- P } } else { P <- pred_range D <- dat[ind,][rep(1L, length(P)),] D[,pred_var] <- P } pr <- predict(model, D, type = typ, se.fit = TRUE) lower <- pr$fit - quantile * pr$se.fit upper <- pr$fit + quantile * pr$se.fit if (type == "response" && !delta) { lower <- family(model)$linkinv(lower) upper <- family(model)$linkinv(upper) pr$fit <- family(model)$linkinv(pr$fit) } if (type == "response") { ## cut probs at unit interval lower[lower < 0] <- 0 upper[upper > 1] <- 1 } grid.polygon(unit(c(P, rev(P)), "native"), unit(c(lower, rev(upper)), "native"), gp = gpar(fill = colband, col = NA)) grid.lines(unit(P, "native"), unit(pr$fit, "native"), gp = gpar(col = colline, lwd = lwd, lty = lty)) if (point_size > 0) grid.points(unit(P, "native"), unit(pr$fit, "native"), pch = pch, size = unit(point_size, "char"), gp = gpar(col = colline)) ## add labels, if any if (labels) { x = switch(labels_pos, left = P[1], right = P[length(P)]) y = switch(labels_pos, left = pr$fit[1], right = pr$fit[length(pr$fit)]) grid.text(x = unit(x, "native") + unit(labels_offset[1], "npc"), y = unit(y, "native") + unit(labels_offset[2], "npc"), label = label, just = labels_just, gp = gpar(col = colline)) } } ## determine colors and plot symbols llev <- if (is.null(group_vars)) 1 else length(lev) pch <- rep(pch, length.out = llev) if (is.null(col_bands)) col_bands <- colorspace::rainbow_hcl(llev, alpha = 0.2) if (is.null(col_lines)) col_lines <- colorspace::rainbow_hcl(llev, l = 50) ## set up plot region, similar to plot.xy() if (newpage) grid.newpage() pushViewport(plotViewport(xscale = xlimaxis, yscale = ylimaxis, default.units = "native", name = "binreg_plot")) grid.rect(gp = gpar(fill = "transparent")) grid.xaxis() grid.yaxis() grid.text(xlab, y = unit(-3.5, "lines")) grid.text(ylab, x = unit(-3, "lines"), rot = 90) grid.text(main, y = unit(1, "npc") + unit(2, "lines"), gp = gp_main) pushViewport(viewport(xscale = xlimaxis, yscale = ylimaxis, default.units = "native", clip = "on")) ## draw fitted curve(s) if (is.null(group_vars)) { ## single curve draw(1:nrow(dat), col_bands, col_lines, pch[1]) } else { ## multiple curves for (i in seq_along(lev)) { ind <- dat[,group_vars] == lev[i] draw(ind, col_bands[i], col_lines[i], pch[i], lev[i]) } if (legend) grid_legend(legend_pos, labels = lev, col = col_lines, lty = "solid", lwd = lwd, vgap = legend_vgap, gp_frame = gp_legend_frame, inset = legend_inset, title = group_vars, gp_title = gp_legend_title) } if (pop) popViewport(2) if (return_grob) invisible(grid.grab()) else invisible(NULL) } ########### grid_abline <- function(a, b, ...) { ## taken from graphics::abline() if (is.object(a) || is.list(a)) { p <- length(coefa <- as.vector(coef(a))) if (p > 2) warning(gettextf("only using the first two of %d regression coefficients", p), domain = NA) islm <- inherits(a, "lm") noInt <- if (islm) !as.logical(attr(stats::terms(a), "intercept")) else p == 1 if (noInt) { a <- 0 b <- coefa[1L] } else { a <- coefa[1L] b <- if (p >= 2) coefa[2L] else 0 } } grid.abline(a, b, ...) } vcd/R/pairsplot.R0000644000175000017500000002145414133212566013532 0ustar nileshnilesh################################################################# ### pairsplot ## modified, 2-14-2014, MF: fix expected values for type= pairs.table <- function(x, upper_panel = pairs_mosaic, upper_panel_args = list(), lower_panel = pairs_mosaic, lower_panel_args = list(), diag_panel = pairs_diagonal_mosaic, diag_panel_args = list(), main = NULL, sub = NULL, main_gp = gpar(fontsize = 20), sub_gp = gpar(fontsize = 15), space = 0.3, newpage = TRUE, pop = TRUE, return_grob = FALSE, margins = unit(1, "lines"), ...) { if (newpage) grid.newpage() if (inherits(upper_panel, "grapcon_generator")) upper_panel <- do.call("upper_panel", c(upper_panel_args, list(...))) if (inherits(lower_panel, "grapcon_generator")) lower_panel <- do.call("lower_panel", c(lower_panel_args, list(...))) if (inherits(diag_panel, "grapcon_generator")) diag_panel <- do.call("diag_panel", diag_panel_args) d <- length(dim(x)) l <- grid.layout(d, d) pushViewport(viewport(width = unit(1, "snpc"), height = unit(1, "snpc"))) pushViewport(vcdViewport(mar = margins, legend = FALSE, legend_width = NULL, main = !is.null(main), sub = !is.null(sub))) ## titles if (!is.null(main)) { seekViewport("main") if (is.logical(main) && main) main <- deparse(substitute(x)) grid.text(main, gp = main_gp) } if (!is.null(sub)) { seekViewport("sub") if (is.logical(sub) && sub && is.null(main)) sub <- deparse(substitute(x)) grid.text(sub, gp = sub_gp) } seekViewport("plot") pushViewport(viewport(layout = l, y = 0, just = "bottom")) for (i in 1:d) for(j in 1:d) { pushViewport(viewport(layout.pos.col = i, layout.pos.row = j)) pushViewport(viewport(width = 1 - space, height = 1 - space)) if (i > j) { if (!is.null(upper_panel)) upper_panel(x, j, i) } else if (i < j) { if (!is.null(lower_panel)) lower_panel(x, j, i) } else if (!is.null(diag_panel)) diag_panel(x, i) if (pop) popViewport(2) else upViewport(2) } if (pop) popViewport(3) else upViewport(3) if (return_grob) invisible(structure(x, grob = grid.grab())) else invisible(x) } pairs.structable <- function(x, ...) pairs(as.table(x), ...) ## upper/lower panels pairs_assoc <- function(...) pairs_strucplot(panel = assoc, ...) class(pairs_assoc) <- "grapcon_generator" pairs_mosaic <- function(...) pairs_strucplot(panel = mosaic, ...) class(pairs_mosaic) <- "grapcon_generator" pairs_sieve <- function(...) pairs_strucplot(panel = sieve, ...) class(pairs_sieve) <- "grapcon_generator" pairs_strucplot <- function(panel = mosaic, type = c("pairwise", "total", "conditional", "joint"), legend = FALSE, margins = c(0, 0, 0, 0), labeling = NULL, ...) { type = match.arg(type) function(x, i, j) { index <- 1:length(dim(x)) rest <- index[!index %in% c(i, j)] rest2 <- index[!index %in% 1:2] tl <- tail(index, 2) rest3 <- index[!index %in% tl] expected <- switch(type, joint = list(1:2, rest2), conditional = list(c(tl[1], rest3), c(tl[2], rest3)), total = sapply(c(j, i, rest), list), NULL) margin <- switch(type, pairwise = c(j, i), conditional = c(rest, j, i), c(j, i, rest)) panel(x = margin.table(x, margin), expected = expected, labeling = labeling, margins = margins, legend = legend, split_vertical = TRUE, newpage = FALSE, pop = FALSE, prefix = paste("panel:Y=",names(dimnames(x))[i],",X=", names(dimnames(x))[j],"|",sep = ""), ...) } } class(pairs_strucplot) <- "grapcon_generator" ## diagonal panels pairs_text <- function(dimnames = TRUE, gp_vartext = gpar(fontsize = 17), gp_leveltext = gpar(), gp_border = gpar(), ...) function(x, i) { x <- margin.table(x, i) grid.rect(gp = gp_border) grid.text(names(dimnames(x)), gp = gp_vartext, y = 0.5 + dimnames * 0.05, ...) if (dimnames) grid.text(paste("(",paste(names(x), collapse = ","), ")", sep = ""), y = 0.4, gp = gp_leveltext) } class(pairs_text) <- "grapcon_generator" pairs_diagonal_text <- function(varnames = TRUE, gp_vartext = gpar(fontsize = 17, fontface = "bold"), gp_leveltext = gpar(), gp_border = gpar(), pos = c("right","top"), distribute = c("equal","margin"), rot = 0, ...) { xc <- unit(switch(pos[1], left = 0.1, center = 0.5, 0.9), "npc") yc <- unit(switch(pos[2], top = 0.9, center = 0.5, 0.1), "npc") distribute <- match.arg(distribute) function(x, i) { x <- margin.table(x, i) grid.rect(gp = gp_border) if (varnames) grid.text(names(dimnames(x)), gp = gp_vartext, x = xc, y = yc, just = pos, ...) l <- length(dimnames(x)[[1]]) po <- if (distribute == "equal") unit(cumsum(rep(1 / (l + 1), l)), "npc") else { sizes = prop.table(x) unit(cumsum(c(0,sizes))[1:l] + sizes / 2, "npc") } grid.text(dimnames(x)[[1]], x = po, y = unit(1, "npc") - po, gp = gp_leveltext, rot = rot) } } class(pairs_diagonal_text) <- "grapcon_generator" pairs_barplot <- function(gp_bars = NULL, gp_vartext = gpar(fontsize = 17), gp_leveltext = gpar(), gp_axis = gpar(), just_leveltext = c("center", "bottom"), just_vartext = c("center", "top"), rot = 0, abbreviate = FALSE, check_overlap = TRUE, fill = "grey", var_offset = unit(1, "npc"), ...) function(x, i) { if (!is.unit(var_offset)) var_offset <- unit(var_offset, "npc") dn <- names(dimnames(x)) x <- margin.table(x, i) if (is.function(fill)) fill <- rev(fill(dim(x))) if (is.null(gp_bars)) gp_bars <- gpar(fill = fill) pushViewport(viewport(x = 0.3, y = 0.1, width = 0.7, height = 0.7, yscale = c(0,max(x)), just = c("left", "bottom")) ) xpos <- seq(0, 1, length = length(x) + 1)[-1] halfstep <- (xpos[2] - xpos[1]) / 2 grid.rect(xpos - halfstep, rep.int(0, length(x)), height = x, just = c("center", "bottom"), width = halfstep, gp = gp_bars, default.units = "native", name = paste("panel:diag=", dn[i], "|bars", sep = ""), ...) grid.yaxis(at = pretty(c(0,max(x))), gp = gp_axis) txt <- names(x) if (abbreviate) txt <- abbreviate(txt, abbreviate) grid.text(txt, y = unit(-0.15, "npc"), rot = rot, x = xpos - halfstep, just = just_leveltext, gp = gp_leveltext, check.overlap = check_overlap) popViewport(1) grid.text(names(dimnames(x)), y = var_offset, just = just_vartext, gp = gp_vartext) } class(pairs_barplot) <- "grapcon_generator" pairs_diagonal_mosaic <- function(split_vertical = TRUE, margins = unit(0, "lines"), offset_labels = -0.4, offset_varnames = 0, gp = NULL, fill = "grey", labeling = labeling_values, alternate_labels = TRUE, ...) function(x, i) { if (is.function(fill)) fill <- rev(fill(dim(x)[i])) if (is.null(gp)) gp <- gpar(fill = fill) mosaic(margin.table(x, i), newpage = FALSE, split_vertical = split_vertical, margins = margins, offset_labels = offset_labels, offset_varnames = offset_varnames, prefix = "diag", gp = gp, labeling = labeling_values, labeling_args = list(alternate_labels = TRUE), ...) } class(pairs_diagonal_mosaic) <- "grapcon_generator" vcd/R/mplot.R0000644000175000017500000000471112445041730012642 0ustar nileshnileshmplot <- function(..., .list = list(), layout = NULL, cex = NULL, main = NULL, gp_main = gpar(fontsize = 20), sub = NULL, gp_sub = gpar(fontsize = 15), keep_aspect_ratio = TRUE) { l <- c(list(...), .list) ll <- length(l) m <- !is.null(main) s <- !is.null(sub) ## calculate layout if (is.null(layout)) layout <- c(trunc(sqrt(ll)), ceiling(ll / trunc(sqrt(ll)))) ## push base layout grid.newpage() hts = unit(1 - 0.1 * m - 0.1 * s, "null") if (m) hts <- c(unit(0.1, "null"), hts) if (s) hts <- c(hts, unit(0.1, "null")) pushViewport(viewport(layout = grid.layout(nrow = 1 + m + s, ncol = 1, heights = hts) ) ) ## push main, if any if (!is.null(main)) { pushViewport(viewport(layout.pos.row = 1, layout.pos.col = NULL)) grid.text(main, gp = gp_main) popViewport(1) } ## push strucplots if (is.null(cex)) cex <- sqrt(1/layout[1]) pushViewport(viewport(layout.pos.row = 1 + m, layout.pos.col = NULL)) pushViewport(viewport(layout = grid.layout(nrow = layout[1], ncol = layout[2]), gp = gpar(cex = cex) ) ) count <- 1 for (i in seq_len(layout[1])) for (j in seq_len(layout[2])) if(count <= ll) { pushViewport(viewport(layout.pos.row = i, layout.pos.col = j)) pushViewport(viewport(width = 1, height = 1, default.units = if (keep_aspect_ratio) "snpc" else "npc")) if (inherits(l[[count]], "grob")) grid.draw(l[[count]]) else if (!is.null(attr(l[[count]], "grob"))) grid.draw(attr(l[[count]], "grob")) popViewport(2) count <- count + 1 } popViewport(2) ## push sub, if any if (!is.null(sub)) { pushViewport(viewport(layout.pos.row = 1 + m + s, layout.pos.col = NULL)) grid.text(sub, gp = gp_sub) popViewport() } popViewport(1) } vcd/R/spine.R0000755000175000017500000001077211150520606012630 0ustar nileshnileshspine <- function(x, ...) UseMethod("spine") spine.formula <- function(formula, data = list(), breaks = NULL, ylab_tol = 0.05, off = NULL, main = "", xlab = NULL, ylab = NULL, ylim = c(0, 1), margins = c(5.1, 4.1, 4.1, 3.1), gp = gpar(), name = "spineplot", newpage = TRUE, pop = TRUE, ...) { ## extract x, y from formula mf <- model.frame(formula, data = data) if(NCOL(mf) != 2) stop("`formula' should specify exactly two variables") y <- mf[,1] if(!is.factor(y)) stop("dependent variable should be a factor") x <- mf[,2] if(is.null(xlab)) xlab <- names(mf)[2] if(is.null(ylab)) ylab <- names(mf)[1] spine(x, y, breaks = breaks, ylab_tol = ylab_tol, off = off, main = main, xlab = xlab, ylab = ylab, ylim = ylim, margins = margins, gp = gp, name = name, newpage = newpage, pop = pop, ...) } spine.default <- function(x, y = NULL, breaks = NULL, ylab_tol = 0.05, off = NULL, main = "", xlab = NULL, ylab = NULL, ylim = c(0, 1), margins = c(5.1, 4.1, 4.1, 3.1), gp = gpar(), name = "spineplot", newpage = TRUE, pop = TRUE, ...) { ## either supply a 2-way table (i.e., both y and x are categorical) ## or two variables (y has to be categorical - x can be categorical or numerical) if(missing(y)) { if(length(dim(x)) != 2) stop("a 2-way table has to be specified") tab <- x x.categorical <- TRUE if(is.null(xlab)) xlab <- names(dimnames(tab))[1] if(is.null(ylab)) ylab <- names(dimnames(tab))[2] xnam <- dimnames(tab)[[1]] ynam <- dimnames(tab)[[2]] ny <- NCOL(tab) nx <- NROW(tab) } else { if(!is.factor(y)) stop("dependent variable should be a factor") x.categorical <- is.factor(x) if(!x.categorical) stopifnot(is.numeric(x), is.vector(x)) if(is.null(xlab)) xlab <- deparse(substitute(x)) if(is.null(ylab)) ylab <- deparse(substitute(y)) if(x.categorical) { tab <- table(x, y) xnam <- levels(x) nx <- NROW(tab) } ynam <- levels(y) ny <- length(ynam) } ## graphical parameters if(is.null(gp$fill)) gp$fill <- gray.colors(ny) gp$fill <- rep(gp$fill, length.out = ny) off <- if(!x.categorical) 0 else if(is.null(off)) 0.02 else off/100 if(x.categorical) { ## compute rectangle positions on x axis xat <- c(0, cumsum(prop.table(margin.table(tab, 1)) + off)) } else { ## compute breaks for x if(is.null(breaks)) breaks <- list() if(!is.list(breaks)) breaks <- list(breaks = breaks) breaks <- c(list(x = x), breaks) breaks$plot <- FALSE breaks <- do.call("hist", breaks)$breaks ## categorize x x1 <- cut(x, breaks = breaks, include.lowest = TRUE) ## compute rectangle positions on x axis xat <- c(0, cumsum(prop.table(table(x1)))) ## construct table tab <- table(x1, y) nx <- NROW(tab) } ## compute rectangle positions on y axis yat <- rbind(0, apply(prop.table(tab, 1), 1, cumsum)) ## setup plot if(newpage) grid.newpage() pushViewport(plotViewport(xscale = c(0, 1 + off * (nx-1)), yscale = ylim, default.units = "native", name = name, margins = margins, ...)) ## compute coordinates ybottom <- as.vector(yat[-(ny+1),]) ybottom[ybottom < ylim[1]] <- ylim[1] ybottom[ybottom > ylim[2]] <- ylim[2] ytop <- as.vector(yat[-1,]) ytop[ytop < ylim[1]] <- ylim[1] ytop[ytop > ylim[2]] <- ylim[2] xleft <- rep(xat[1:nx], rep(ny, nx)) xright <- rep(xat[2:(nx+1)] - off, rep(ny, nx)) gp$fill <- rep(gp$fill, nx) ## plot rectangles grid.rect(xleft, ybottom, width = (xright-xleft), height = (ytop-ybottom), just = c("left", "bottom"), default.units = "native", gp = gp) ## axes ## 1: either numeric or level names if(x.categorical) grid.text(x = unit((xat[1:nx] + xat[2:(nx+1)] - off)/2, "native"), y = unit(-1.5, "lines"), label = xnam, check.overlap = TRUE) else grid.xaxis(at = xat, label = breaks) ## 2: axis with level names of y yat <- yat[,1] equidist <- any(diff(yat) < ylab_tol) yat <- if(equidist) seq(1/(2*ny), 1-1/(2*ny), by = 1/ny) else (yat[-1] + yat[-length(yat)])/2 grid.text(x = unit(-1.5, "lines"), y = unit(yat, "native"), label = ynam, rot = 90, check.overlap = TRUE) ## 3: none ## 4: simple numeric grid.yaxis(main = FALSE) ## annotation grid.text(xlab, y = unit(-3.5, "lines")) grid.text(ylab, x = unit(-3, "lines"), rot = 90) grid.text(main, y = unit(1, "npc") + unit(2, "lines"), gp = gpar(fontface = "bold")) ## pop if(pop) popViewport() ## return table visualized names(dimnames(tab)) <- c(xlab, ylab) invisible(tab) } vcd/R/assoc.R0000755000175000017500000002717412200255346012631 0ustar nileshnilesh#################################################################333 ## assocplot assoc <- function(x, ...) UseMethod("assoc") assoc.formula <- function(formula, data = NULL, ..., subset = NULL, na.action = NULL, main = NULL, sub = NULL) { if (is.logical(main) && main) main <- deparse(substitute(data)) else if (is.logical(sub) && sub) sub <- deparse(substitute(data)) assoc.default(structable(formula, data, subset = subset, na.action = na.action), main = main, sub = sub, ...) } assoc.default <- function(x, row_vars = NULL, col_vars = NULL, compress = TRUE, xlim = NULL, ylim = NULL, spacing = spacing_conditional(sp = 0), spacing_args = list(), split_vertical = NULL, keep_aspect_ratio = FALSE, xscale = 0.9, yspace = unit(0.5, "lines"), main = NULL, sub = NULL, ..., residuals_type = "Pearson", gp_axis = gpar(lty = 3) ) { if (is.logical(main) && main) main <- deparse(substitute(x)) else if (is.logical(sub) && sub) sub <- deparse(substitute(x)) if (!inherits(x, "ftable")) x <- structable(x) tab <- as.table(x) dl <- length(dim(tab)) ## spacing cond <- rep(TRUE, dl) cond[length(attr(x, "row.vars")) + c(0, length(attr(x, "col.vars")))] <- FALSE if (inherits(spacing, "grapcon_generator")) spacing <- do.call("spacing", spacing_args) spacing <- spacing(dim(tab), condvars = which(cond)) ## splitting arguments if (is.null(split_vertical)) split_vertical <- attr(x, "split_vertical") if(match.arg(tolower(residuals_type), "pearson") != "pearson") warning("Only Pearson residuals can be visualized with association plots.") strucplot(tab, spacing = spacing, split_vertical = split_vertical, core = struc_assoc(compress = compress, xlim = xlim, ylim = ylim, yspace = yspace, xscale = xscale, gp_axis = gp_axis), keep_aspect_ratio = keep_aspect_ratio, residuals_type = "Pearson", main = main, sub = sub, ...) } ## old code: more elegant conceptually, but less performant ## ## struc_assoc2 <- function(compress = TRUE, xlim = NULL, ylim = NULL, ## yspace = unit(0.5, "lines"), xscale = 0.9, ## gp_axis = gpar(lty = 3)) ## function(residuals, observed = NULL, expected, spacing, gp, split_vertical, prefix = "") { ## dn <- dimnames(expected) ## dnn <- names(dn) ## dx <- dim(expected) ## dl <- length(dx) ## ## axis limits ## resid <- structable(residuals, split_vertical = split_vertical) ## sexpected <- structable(sqrt(expected), split_vertical = split_vertical) ## rfunc <- function(x) c(min(x, 0), max(x, 0)) ## if (is.null(ylim)) ## ylim <- if (compress) ## matrix(apply(as.matrix(resid), 1, rfunc), nrow = 2) ## else ## rfunc(as.matrix(resid)) ## if (!is.matrix(ylim)) ## ylim <- matrix(as.matrix(ylim), nrow = 2, ncol = nrow(as.matrix(resid))) ## attr(ylim, "split_vertical") <- rep(TRUE, sum(!split_vertical)) ## attr(ylim, "dnames") <- dn[!split_vertical] ## class(ylim) <- "structable" ## if(is.null(xlim)) ## xlim <- if (compress) ## matrix(c(-0.5, 0.5) %o% apply(as.matrix(sexpected), 2, max), nrow = 2) ## else ## c(-0.5, 0.5) * max(sexpected) ## if (!is.matrix(xlim)) ## xlim <- matrix(as.matrix(xlim), nrow = 2, ncol = ncol(as.matrix(resid))) ## attr(xlim, "split_vertical") <- rep(TRUE, sum(split_vertical)) ## attr(xlim, "dnames") <- dn[split_vertical] ## class(xlim) <- "structable" ## ## split workhorse ## split <- function(res, sexp, i, name, row, col) { ## v <- split_vertical[i] ## splitbase <- if (v) sexp else res ## splittab <- lapply(seq(dx[i]), function(j) splitbase[[j]]) ## len <- sapply(splittab, function(x) sum(unclass(x)[1,] - unclass(x)[2,])) ## d <- dx[i] ## ## compute total cols/rows and build split layout ## dist <- unit.c(unit(len, "null"), spacing[[i]] + (1 * !v) * yspace) ## idx <- matrix(1:(2 * d), nrow = 2, byrow = TRUE)[-2 * d] ## layout <- if (v) ## grid.layout(ncol = 2 * d - 1, widths = dist[idx]) ## else ## grid.layout(nrow = 2 * d - 1, heights = dist[idx]) ## vproot <- viewport(layout.pos.col = col, layout.pos.row = row, ## layout = layout, name = remove_trailing_comma(name)) ## ## next level: either create further splits, or final viewports ## name <- paste(name, dnn[i], "=", dn[[i]], ",", sep = "") ## rows <- cols <- rep.int(1, d) ## if (v) cols <- 2 * 1:d - 1 else rows <- 2 * 1:d - 1 ## f <- if (i < dl) { ## if (v) ## function(m) split(res, splittab[[m]], i + 1, name[m], rows[m], cols[m]) ## else ## function(m) split(splittab[[m]], sexp, i + 1, name[m], rows[m], cols[m]) ## } else { ## if (v) ## function(m) viewport(layout.pos.col = cols[m], layout.pos.row = rows[m], ## name = remove_trailing_comma(name[m]), ## yscale = unclass(res)[,1], ## xscale = unclass(sexp)[,m], default.units = "null") ## else ## function(m) viewport(layout.pos.col = cols[m], layout.pos.row = rows[m], ## name = remove_trailing_comma(name[m]), ## yscale = unclass(res)[,m], ## xscale = unclass(sexp)[,1], default.units = "null") ## } ## vpleaves <- structure(lapply(1:d, f), class = c("vpList", "viewport")) ## vpTree(vproot, vpleaves) ## } ## ## start spltting on top, creates viewport-tree ## pushViewport(split(ylim, xlim, i = 1, name = paste(prefix, "cell:", sep = ""), ## row = 1, col = 1)) ## ## draw tiles ## mnames <- paste(apply(expand.grid(dn), 1, ## function(i) paste(dnn, i, collapse = ",", sep = "=") ## ) ## ) ## for (i in seq_along(mnames)) { ## seekViewport(paste(prefix, "cell:", mnames[i], sep = "")) ## grid.lines(y = unit(0, "native"), gp = gp_axis) ## grid.rect(y = 0, x = 0, ## height = residuals[i], ## width = xscale * unit(sqrt(expected[i]), "native"), ## default.units = "native", ## gp = structure(lapply(gp, function(x) x[i]), class = "gpar"), ## just = c("center", "bottom"), ## name = paste(prefix, "rect:", mnames[i], sep = "") ## ) ## } ## } ## class(struc_assoc2) <- "grapcon_generator" struc_assoc <- function(compress = TRUE, xlim = NULL, ylim = NULL, yspace = unit(0.5, "lines"), xscale = 0.9, gp_axis = gpar(lty = 3)) function(residuals, observed = NULL, expected, spacing, gp, split_vertical, prefix = "") { if(is.null(expected)) stop("Need expected values.") dn <- dimnames(expected) dnn <- names(dn) dx <- dim(expected) dl <- length(dx) ## axis limits resid <- structable(residuals, split_vertical = split_vertical) sexpected <- structable(sqrt(expected), split_vertical = split_vertical) rfunc <- function(x) c(min(x, 0), max(x, 0)) if (is.null(ylim)) ylim <- if (compress) matrix(apply(as.matrix(resid), 1, rfunc), nrow = 2) else rfunc(as.matrix(resid)) if (!is.matrix(ylim)) ylim <- matrix(as.matrix(ylim), nrow = 2, ncol = nrow(as.matrix(resid))) ylim[2,] <- ylim[2,] + .Machine$double.eps attr(ylim, "split_vertical") <- rep(TRUE, sum(!split_vertical)) attr(ylim, "dnames") <- dn[!split_vertical] class(ylim) <- "structable" if(is.null(xlim)) xlim <- if (compress) matrix(c(-0.5, 0.5) %o% apply(as.matrix(sexpected), 2, max), nrow = 2) else c(-0.5, 0.5) * max(sexpected) if (!is.matrix(xlim)) xlim <- matrix(as.matrix(xlim), nrow = 2, ncol = ncol(as.matrix(resid))) attr(xlim, "split_vertical") <- rep(TRUE, sum(split_vertical)) attr(xlim, "dnames") <- dn[split_vertical] class(xlim) <- "structable" ## split workhorse split <- function(res, sexp, i, name, row, col, index) { v <- split_vertical[i] d <- dx[i] splitbase <- if (v) sexp else res splittab <- lapply(seq(d), function(j) splitbase[[j]]) len <- abs(sapply(splittab, function(x) sum(unclass(x)[1,] - unclass(x)[2,]))) ## compute total cols/rows and build split layout dist <- if (d > 1) unit.c(unit(len, "null"), spacing[[i]] + (1 * !v) * yspace) else unit(len, "null") idx <- matrix(1:(2 * d), nrow = 2, byrow = TRUE)[-2 * d] layout <- if (v) grid.layout(ncol = 2 * d - 1, widths = dist[idx]) else grid.layout(nrow = 2 * d - 1, heights = dist[idx]) pushViewport(viewport(layout.pos.col = col, layout.pos.row = row, layout = layout, name = paste(prefix, "cell:", remove_trailing_comma(name), sep = ""))) ## next level: either create further splits, or final viewports rows <- cols <- rep.int(1, d) if (v) cols <- 2 * 1:d - 1 else rows <- 2 * 1:d - 1 for (m in 1:d) { nametmp <- paste(name, dnn[i], "=", dn[[i]][m], ",", sep = "") if (i < dl) { if (v) sexp <- splittab[[m]] else res <- splittab[[m]] split(res, sexp, i + 1, nametmp, rows[m], cols[m], cbind(index, m)) } else { pushViewport(viewport(layout.pos.col = cols[m], layout.pos.row = rows[m], name = paste(prefix, "cell:", remove_trailing_comma(nametmp), sep = ""), yscale = unclass(res)[,if (v) 1 else m], xscale = unclass(sexp)[,if (v) m else 1], default.units = "npc") ) ## draw tiles grid.lines(y = unit(0, "native"), gp = gp_axis) grid.rect(y = 0, x = 0, height = residuals[cbind(index, m)], width = xscale * unit(sqrt(expected[cbind(index, m)]), "native"), default.units = "native", gp = structure(lapply(gp, function(x) x[cbind(index,m)]), class = "gpar"), just = c("center", "bottom"), name = paste(prefix, "rect:", remove_trailing_comma(nametmp), sep = "") ) } upViewport(1) } } split(ylim, xlim, i = 1, name = "", row = 1, col = 1, index = cbind()) } class(struc_assoc) <- "grapcon_generator" vcd/R/cd_plot.R0000655000175000017500000000705012445057350013141 0ustar nileshnileshcd_plot <- function(x, ...) { UseMethod("cd_plot") } cd_plot.formula <- function(formula, data = list(), plot = TRUE, ylab_tol = 0.05, bw = "nrd0", n = 512, from = NULL, to = NULL, main = "", xlab = NULL, ylab = NULL, margins = c(5.1, 4.1, 4.1, 3.1), gp = gpar(), name = "cd_plot", newpage = TRUE, pop = TRUE, return_grob = FALSE, ...) { ## extract x, y from formula mf <- model.frame(formula, data = data) if(NCOL(mf) != 2) stop("`formula' should specify exactly two variables") y <- mf[,1] if(!is.factor(y)) stop("dependent variable should be a factor") x <- mf[,2] if(!is.numeric(x)) stop("explanatory variable should be numeric") ## graphical parameters if(is.null(xlab)) xlab <- names(mf)[2] if(is.null(ylab)) ylab <- names(mf)[1] ## call default interface cd_plot(x, y, plot = plot, ylab_tol = ylab_tol, bw = bw, n = n, from = from, to = to, main = main, xlab = xlab, ylab = ylab, margins = margins, gp = gp, name = name, newpage = newpage, pop = pop, ...) } cd_plot.default <- function(x, y, plot = TRUE, ylab_tol = 0.05, bw = "nrd0", n = 512, from = NULL, to = NULL, main = "", xlab = NULL, ylab = NULL, margins = c(5.1, 4.1, 4.1, 3.1), gp = gpar(), name = "cd_plot", newpage = TRUE, pop = TRUE, return_grob = FALSE, ...) { ## check x and y if(!is.numeric(x)) stop("explanatory variable should be numeric") if(!is.factor(y)) stop("dependent variable should be a factor") ny <- length(levels(y)) ## graphical parameters if(is.null(xlab)) xlab <- deparse(substitute(x)) if(is.null(ylab)) ylab <- deparse(substitute(y)) if(is.null(gp$fill)) gp$fill <- gray.colors(ny) gp$fill <- rep(gp$fill, length.out = ny) ## unconditional density of x dx <- if(is.null(from) & is.null(to)) density(x, bw = bw, n = n, ...) else density(x, bw = bw, from = from, to = to, n = n, ...) x1 <- dx$x ## setup conditional values yprop <- cumsum(prop.table(table(y))) y1 <- matrix(rep(0, n*(ny-1)), nrow = (ny-1)) ## setup return value rval <- list() for(i in 1:(ny-1)) { dxi <- density(x[y %in% levels(y)[1:i]], bw = dx$bw, n = n, from = min(dx$x), to = max(dx$x), ...) y1[i,] <- dxi$y/dx$y * yprop[i] rval[[i]] <- approxfun(x1, y1[i,], rule = 2) } names(rval) <- levels(y)[1:(ny-1)] ## use known ranges y1 <- rbind(0, y1, 1) y1 <- y1[,which(x1 >= min(x) & x1 <= max(x))] x1 <- x1[x1 >= min(x) & x1 <= max(x)] ## plot polygons if(plot) { ## setup if(newpage) grid.newpage() pushViewport(plotViewport(xscale = range(x1), yscale = c(0, 1), default.units = "native", name = name, margins = margins, ...)) ## polygons for(i in 1:(NROW(y1)-1)) { gpi <- gp gpi$fill <- gp$fill[i] grid.polygon(x = c(x1, rev(x1)), y = c(y1[i+1,], rev(y1[i,])), default.units = "native", gp = gpi) } ## axes grid.rect(gp = gpar(fill = "transparent")) grid.xaxis() grid.yaxis(main = FALSE) equidist <- any(diff(y1[,1]) < ylab_tol) yat <- if(equidist) seq(1/(2*ny), 1-1/(2*ny), by = 1/ny) else (y1[-1,1] + y1[-NROW(y1), 1])/2 grid.text(x = unit(-1.5, "lines"), y = unit(yat, "native"), label = levels(y), rot = 90, check.overlap = TRUE) ## annotation grid.text(xlab, y = unit(-3.5, "lines")) grid.text(ylab, x = unit(-3, "lines"), rot = 90) grid.text(main, y = unit(1, "npc") + unit(2, "lines"), gp = gpar(fontface = "bold")) ## pop if(pop) popViewport() } ## return conditional density functions if (plot && return_grob) invisible(structure(rval, grob = grid.grab())) else invisible(rval) } vcd/R/co_table.R0000755000175000017500000000161211623033204013251 0ustar nileshnileshco_table <- function(x, margin, collapse = ".") { if (!is.array(x)) stop("x is not an array") if("xtabs" %in% class(x)) attr(x, "call") <- NULL dx <- dim(x) idx <- lapply(dx, function(i) 1:i) dn <- dimnames(x) if(is.character(margin)) { if(is.null(dn)) stop("margin must be an index when no dimnames are given") margin <- which(names(dn) %in% margin) } idxm <- expand.grid(idx[margin]) cotab1 <- function(i) { idx[margin] <- lapply(1:length(margin), function(j) idxm[i,j]) rval <- as.table(do.call("[", c(list(x), idx, list(drop = FALSE)))) if(length(dim(rval)) > 1) { dim(rval) <- dim(x)[-margin] dimnames(rval) <- dimnames(x)[-margin] } return(rval) } rval <- lapply(1:NROW(idxm), cotab1) if(!is.null(dn)) names(rval) <- apply(expand.grid(dn[margin]), 1, function(z) paste(z, collapse = collapse)) return(rval) } vcd/R/spacings.R0000755000175000017500000000344311566471034013331 0ustar nileshnilesh################################################################## ## spacings spacing_equal <- function(sp = unit(0.3, "lines")) { if (!is.unit(sp)) sp <- unit(sp, "lines") function(d, condvars = NULL) lapply(d, function(x) if(x > 1) rep(sp, x - 1) else NA) } class(spacing_equal) <- "grapcon_generator" spacing_dimequal <- function(sp) { if (!is.unit(sp)) sp <- unit(sp, "lines") function(d, condvars = NULL) lapply(seq_along(d), function(i) if(d[i] > 1) rep(sp[i], d[i] - 1) else NA) } class(spacing_dimequal) <- "grapcon_generator" spacing_increase <- function(start = unit(0.3, "lines"), rate = 1.5) { if (!is.unit(start)) start <- unit(start, "lines") function(d, condvars = NULL) { sp <- start * rev(cumprod(c(1, rep.int(rate, length(d) - 1)))) spacing_dimequal(sp)(d = d, condvars = condvars) } } class(spacing_increase) <- "grapcon_generator" spacing_highlighting <- function(start = unit(0.2, "lines"), rate = 1.5) { if (!is.unit(start)) start <- unit(start, "lines") function(d, condvars = NULL) c(spacing_increase(start, rate)(d, condvars)[-length(d)], list(unit(rep(0, d[length(d)]), "lines"))) } class(spacing_highlighting) <- "grapcon_generator" spacing_conditional <- function(sp = unit(0.3, "lines"), start = unit(2, "lines"), rate = 1.8) { condfun <- spacing_increase(start, rate) equalfun <- spacing_equal(sp) equalfun2 <- spacing_equal(start) function(d, condvars) { if (length(d) < 3) return(spacing_equal(sp)(d, condvars)) condvars <- seq(condvars) ret <- vector("list", length(d)) ret[condvars] <- if (length(condvars) < 3) equalfun2(d[condvars]) else condfun(d[condvars]) ret[-condvars] <- equalfun(d[-condvars]) ret } } class(spacing_conditional) <- "grapcon_generator" vcd/R/cotabplot.R0000655000175000017500000003025512505557216013512 0ustar nileshnileshcotabplot <- function(x, ...) { UseMethod("cotabplot") } cotabplot.formula <- function(formula, data = NULL, ...) { m <- match.call() edata <- eval(m$data, parent.frame()) fstr <- deparse(formula) fstr <- gsub("*", "+", fstr, fixed = TRUE) fstr <- gsub("/", "+", fstr, fixed = TRUE) fstr <- gsub("(", "", fstr, fixed = TRUE) fstr <- gsub(")", "", fstr, fixed = TRUE) fstr <- strsplit(paste(fstr, collapse = ""), "~") vars <- strsplit(strsplit(gsub(" ", "", fstr[[1]][2]), "\\|")[[1]], "\\+") varnames <- vars[[1]] condnames <- if(length(vars) > 1) vars[[2]] else NULL if (inherits(edata, "ftable") || inherits(edata, "table") || length(dim(edata)) > 2) { tab <- as.table(data) if(all(varnames != ".")) { ind <- match(varnames, names(dimnames(tab))) if (any(is.na(ind))) stop(paste("Can't find", paste(varnames[is.na(ind)], collapse=" / "), "in", deparse(substitute(data)))) if (!is.null(condnames)) { condind <- match(condnames, names(dimnames(tab))) if (any(is.na(condind))) stop(paste("Can't find", paste(condnames[is.na(condind)], collapse=" / "), "in", deparse(substitute(data)))) ind <- c(condind, ind) } tab <- margin.table(tab, ind) } } else { tab <- if ("Freq" %in% colnames(data)) xtabs(formula(paste("Freq~", paste(c(condnames, varnames), collapse = " + "))), data = data) else xtabs(formula(paste("~", paste(c(condnames, varnames), collapse = " + "))), data = data) } tab <- margin.table(tab, match(c(varnames, condnames), names(dimnames(tab)))) cotabplot(tab, cond = condnames, ...) } cotabplot.default <- function(x, cond = NULL, panel = cotab_mosaic, panel_args = list(), margins = rep(1, 4), layout = NULL, text_gp = gpar(fontsize = 12), rect_gp = gpar(fill = grey(0.9)), pop = TRUE, newpage = TRUE, return_grob = FALSE, ...) { ## coerce to table x <- as.table(x) ## initialize newpage if(newpage) grid.newpage() ## process default option ldx <- length(dim(x)) if(is.null(cond)) { indep <- if(ldx > 1) 1:2 else 1 if(ldx > 2) cond <- 3:ldx } else { if(is.character(cond)) cond <- match(cond, names(dimnames(x))) cond <- as.integer(cond) indep <- (1:ldx)[!(1:ldx %in% cond)] } ## sort margins x <- margin.table(x, c(indep, cond)) ## convenience variables that describe conditioning variables if(is.null(cond)) { cond.n <- 0 cond.num <- cond.dnam <- cond.char <- NULL } else { cond.n <- length(cond) ## number of variables cond.num <- (length(indep) + 1):ldx ## position in x cond.dnam <- dimnames(x)[cond.num] ## corresponding dimnames cond.char <- names(cond.dnam) ## names of variables } ## create panel function (if necessary) if(inherits(panel, "grapcon_generator")) panel <- do.call("panel", c(list(x, cond.char), as.list(panel_args), list(...))) if(cond.n < 1) panel(x, NULL) ## no conditioning variables else { cond.nlevels <- sapply(cond.dnam, length) nplots <- prod(cond.nlevels) condition <- as.matrix(expand.grid(cond.dnam)) ## compute layout #Z# needs fixing for more than two conditioning variables if(is.null(layout)) { layout <- c(1,1,1) ## rows, cols, pages if(cond.n == 1) { layout[2] <- ceiling(sqrt(floor(cond.nlevels))) layout[1] <- ceiling(cond.nlevels/layout[2]) } else { layout[1] <- cond.nlevels[1] layout[2] <- cond.nlevels[2] if(cond.n >= 3) layout[3] <- nplots/prod(cond.nlevels[1:2]) #Z# FIXME if(layout[3] > 1) stop("multiple pages not supported yet") } } else { layout <- c(rep(layout, length.out = 2), 1) if(layout[1] * layout[2] < nplots) stop("number of panels specified in 'layout' is too small") } layout <- expand.grid(lapply(layout, function(x) 1:x))[1:nplots,] ## push basic grid of nr x nc cells nr <- max(layout[,1]) nc <- max(layout[,2]) pushViewport(plotViewport(margins)) pushViewport(viewport(layout = grid.layout(nr, nc, widths = unit(1/nc, "npc")))) strUnit <- unit(2 * ncol(condition), "strheight", "A") cellport <- function(name) viewport(layout = grid.layout(2, 1, heights = unit.c(strUnit, unit(1, "npc") - strUnit)), name = name) ## go through each conditioning combination for(i in 1:nrow(condition)) { ## conditioning information in ith cycle condi <- as.vector(condition[i,]) names(condi) <- colnames(condition) condistr <- paste(condi, collapse = ".") condilab <- paste(cond.char, condi, sep = " = ") ## header pushViewport(viewport(layout.pos.row = layout[i,1], layout.pos.col = layout[i,2])) pushViewport(cellport(paste("cell", condistr, sep = "."))) pushViewport(viewport(layout.pos.row = 1, name = paste("lab", condistr, sep = "."))) grid.rect(gp = rect_gp) grid.text(condilab, y = cond.n:1/cond.n - 1/(2*cond.n), gp = text_gp) grid.segments(0, 0:cond.n/cond.n, 1, 0:cond.n/cond.n) upViewport() ## main plot pushViewport(viewport(layout.pos.row = 2, name = paste("plot", condistr, sep = "."))) panel(x, condi) upViewport(2) grid.rect(gp = gpar(fill = "transparent")) upViewport() } upViewport() if(pop) popViewport() else upViewport() } if (return_grob) invisible(structure(x, grob = grid.grab())) else invisible(x) } cotab_mosaic <- function(x = NULL, condvars = NULL, ...) { function(x, condlevels) { if(is.null(condlevels)) mosaic(x, newpage = FALSE, pop = FALSE, return_grob = FALSE, ...) else mosaic(co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]], newpage = FALSE, pop = FALSE, return_grob = FALSE, prefix = paste("panel:", paste(names(condlevels), condlevels, sep = "=", collapse = ","), "|", sep = ""), ...) } } class(cotab_mosaic) <- "grapcon_generator" cotab_sieve <- function(x = NULL, condvars = NULL, ...) { function(x, condlevels) { if(is.null(condlevels)) sieve(x, newpage = FALSE, pop = FALSE, return_grob = FALSE, ...) else sieve(co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]], newpage = FALSE, pop = FALSE, return_grob = FALSE, prefix = paste("panel:", paste(names(condlevels), condlevels, sep = "=", collapse = ","), "|", sep = ""), ...) } } class(cotab_sieve) <- "grapcon_generator" cotab_assoc <- function(x = NULL, condvars = NULL, ylim = NULL, ...) { if(!is.null(x)) { fm <- coindep_test(x, condvars, n = 1) if(is.null(ylim)) ylim <- range(residuals(fm)) } function(x, condlevels) { if(is.null(condlevels)) assoc(x, newpage = FALSE, pop = FALSE, ylim = ylim, return_grob = FALSE, ...) else assoc(co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]], newpage = FALSE, pop = FALSE, return_grob = FALSE, ylim = ylim, prefix = paste("panel:", paste(names(condlevels), condlevels, sep = "=", collapse = ","), "|", sep = ""), ...) } } class(cotab_assoc) <- "grapcon_generator" cotab_fourfold <- function (x = NULL, condvars = NULL, ...) { function(x, condlevels) { if (is.null(condlevels)) fourfold(x, newpage = FALSE, return_grob = FALSE, ...) else fourfold(co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]], newpage = FALSE, return_grob = FALSE, ...) } } class(cotab_fourfold) <- "grapcon_generator" cotab_loddsratio <- function(x = NULL, condvars = NULL, ...) { function(x, condlevels) { if(is.null(condlevels)) { plot(loddsratio(x, ...), newpage = FALSE, pop = FALSE, return_grob = FALSE, ...) } else { plot(loddsratio(co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]], ...), newpage = FALSE, pop = FALSE, return_grob = FALSE, prefix = paste("panel:", paste(names(condlevels), condlevels, sep = "=", collapse = ","), "|", sep = ""), ...) } upViewport(2) } } class(cotab_loddsratio) <- "grapcon_generator" cotab_agreementplot <- function(x = NULL, condvars = NULL, ...) { function(x, condlevels) { if(is.null(condlevels)) agreementplot(x, newpage = FALSE, pop = FALSE, return_grob = FALSE, ...) else agreementplot(co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]], newpage = FALSE, pop = FALSE, return_grob = FALSE, prefix = paste("panel:", paste(names(condlevels), condlevels, sep = "=", collapse = ","), "|", sep = ""), ...) } } class(cotab_agreementplot) <- "grapcon_generator" cotab_coindep <- function(x, condvars, test = c("doublemax", "maxchisq", "sumchisq"), level = NULL, n = 1000, interpolate = c(2, 4), h = NULL, c = NULL, l = NULL, lty = 1, type = c("mosaic", "assoc"), legend = FALSE, ylim = NULL, ...) { if(is.null(condvars)) stop("at least one conditioning variable is required") ## set color defaults if(is.null(h)) h <- c(260, 0) if(is.null(c)) c <- c(100, 20) if(is.null(l)) l <- c(90, 50) ## process conditional variables and get independent variables ## store some convenience information ldx <- length(dim(x)) if(is.character(condvars)) condvars <- match(condvars, names(dimnames(x))) condvars <- as.integer(condvars) indep <- (1:ldx)[!(1:ldx %in% condvars)] ## sort margins x <- margin.table(x, c(indep, condvars)) ind.n <- length(indep) ind.num <- 1:ind.n ind.dnam <- dimnames(x)[ind.num] ind.char <- names(ind.dnam) cond.n <- length(condvars) cond.num <- (ind.n + 1):length(dim(x)) cond.dnam <- dimnames(x)[cond.num] cond.char <- names(cond.dnam) test <- match.arg(test) switch(test, "doublemax" = { if(is.null(level)) level <- c(0.9, 0.99) fm <- coindep_test(x, cond.num, n = n) resids <- residuals(fm) col.bins <- fm$qdist(sort(level)) gpfun <- shading_hcl(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = h, c = c, l = l, interpolate = col.bins, lty = lty, p.value = fm$p.value) }, "maxchisq" = { if(is.null(level)) level <- 0.95 level <- level[1] fm <- coindep_test(x, cond.num, n = n, indepfun = function(x) sum(x^2)) resids <- residuals(fm) chisqs <- sapply(co_table(residuals(fm), fm$margin), function(x) sum(x^2)) pvals <- 1 - fm$pdist(chisqs) gpfun <- sapply(pvals, function(p) shading_hcl(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = h, c = c, l = l, interpolate = interpolate, lty = lty, level = level, p.value = p)) }, "sumchisq" = { if(is.null(level)) level <- 0.95 level <- level[1] fm <- coindep_test(x, cond.num, n = n, indepfun = function(x) sum(x^2), aggfun = sum) resids <- residuals(fm) gpfun <- shading_hcl(observed = NULL, residuals = NULL, expected = NULL, df = NULL, h = h, c = c, l = l, interpolate = interpolate, lty = lty, level = level, p.value = fm$p.value) }) type <- match.arg(type) if(type == "mosaic") { rval <- function(x, condlevels) { if(is.null(condlevels)) { tab <- x gp <- if(is.list(gpfun)) gpfun[[1]] else gpfun } else { tab <- co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]] gp <- if(is.list(gpfun)) gpfun[[paste(condlevels, collapse = ".")]] else gpfun } mosaic(tab, newpage = FALSE, pop = FALSE, return_grob = FALSE, gp = gp, legend = legend, prefix = paste("panel:", paste(names(condlevels), condlevels, sep = "=", collapse = ","), "|", sep = ""), ...) } } else { if(is.null(ylim)) ylim <- range(resids) rval <- function(x, condlevels) { if(is.null(condlevels)) { tab <- x gp <- if(is.list(gpfun)) gpfun[[1]] else gpfun } else { tab <- co_table(x, names(condlevels))[[paste(condlevels, collapse = ".")]] gp <- if(is.list(gpfun)) gpfun[[paste(condlevels, collapse = ".")]] else gpfun } assoc(tab, newpage = FALSE, pop = FALSE, return_grob = FALSE, gp = gp, legend = legend, ylim = ylim, prefix = paste("panel:", paste(names(condlevels), condlevels, sep = "=", collapse = ","), "|", sep = ""), ...) } } return(rval) } class(cotab_coindep) <- "grapcon_generator" vcd/R/ternaryplot.R0000655000175000017500000001143513210517341014072 0ustar nileshnilesh"ternaryplot" <- function (x, scale = 1, dimnames = NULL, dimnames_position = c("corner", "edge", "none"), dimnames_color = "black", dimnames_rot = c(-60, 60, 0), id = NULL, id_color = "black", id_just = c("center", "center"), coordinates = FALSE, grid = TRUE, grid_color = "gray", labels = c("inside", "outside", "none"), labels_color = "darkgray", labels_rot = c(120, -120, 0), border = "black", bg = "white", pch = 19, cex = 1, prop_size = FALSE, col = "red", main = "ternary plot", newpage = TRUE, pop = TRUE, return_grob = FALSE, ...) { ## parameter handling labels <- match.arg(labels) if (grid == TRUE) grid <- "dotted" if (coordinates) id <- paste("(",round(x[,1] * scale, 1),",", round(x[,2] * scale, 1),",", round(x[,3] * scale, 1),")", sep="") dimnames_position <- match.arg(dimnames_position) if(is.null(dimnames) && dimnames_position != "none") dimnames <- colnames(x) if(is.logical(prop_size) && prop_size) prop_size <- 3 ## some error handling if(ncol(x) != 3) stop("Need a matrix with 3 columns") if(any(x < 0)) stop("X must be non-negative") s <- rowSums(x) if(any(s <= 0)) stop("each row of X must have a positive sum") ## rescaling x <- x / s ## prepare plot top <- sqrt(3) / 2 if (newpage) grid.newpage() xlim <- c(-0.03, 1.03) ylim <- c(-1, top) pushViewport(viewport(width = unit(1, "snpc"))) if (!is.null(main)) grid.text(main, y = 0.9, gp = gpar(fontsize = 18, fontstyle = 1)) pushViewport(viewport(width = 0.8, height = 0.8, xscale = xlim, yscale = ylim, name = "plot")) eps <- 0.01 ## coordinates of point P(a,b,c): xp = b + c/2, yp = c * sqrt(3)/2 ## triangle grid.polygon(c(0, 0.5, 1), c(0, top, 0), gp = gpar(fill = bg, col = border), ...) ## title, labeling if (dimnames_position == "corner") { grid.text(x = c(0, 1, 0.5), y = c(-0.02, -0.02, top + 0.02), label = dimnames, gp = gpar(fontsize = 12)) } if (dimnames_position == "edge") { shift <- eps * if (labels == "outside") 8 else 0 grid.text(x = 0.25 - 2 * eps - shift, y = 0.5 * top + shift, label = dimnames[2], rot = dimnames_rot[2], gp = gpar(col = dimnames_color)) grid.text(x = 0.75 + 3 * eps + shift, y = 0.5 * top + shift, label = dimnames[1], rot = dimnames_rot[1], gp = gpar(col = dimnames_color)) grid.text(x = 0.5, y = -0.02 - shift, label = dimnames[3], rot = dimnames_rot[3], gp = gpar(col = dimnames_color)) } ## grid if (is.character(grid)) for (i in 1:4 * 0.2) { ## a - axis grid.lines(c(1 - i , (1 - i) / 2), c(0, 1 - i) * top, gp = gpar(lty = grid, col = grid_color)) ## b - axis grid.lines(c(1 - i , 1 - i + i / 2), c(0, i) * top, gp = gpar(lty = grid, col = grid_color)) ## c - axis grid.lines(c(i / 2, 1 - i + i/2), c(i, i) * top, gp = gpar(lty = grid, col = grid_color)) ## grid labels if (labels == "inside") { grid.text(x = (1 - i) * 3 / 4 - eps, y = (1 - i) / 2 * top, label = i * scale, gp = gpar(col = labels_color), rot = labels_rot[1]) grid.text(x = 1 - i + i / 4 + eps, y = i / 2 * top - eps, label = (1 - i) * scale, gp = gpar(col = labels_color), rot = labels_rot[2]) grid.text(x = 0.5, y = i * top + eps, label = i * scale, gp = gpar(col = labels_color), rot = labels_rot[3]) } if (labels == "outside") { grid.text(x = (1 - i) / 2 - 6 * eps, y = (1 - i) * top, label = (1 - i) * scale, rot = labels_rot[3], gp = gpar(col = labels_color)) grid.text(x = 1 - (1 - i) / 2 + 3 * eps, y = (1 - i) * top + 5 * eps, label = i * scale, rot = labels_rot[2], gp = gpar(col = labels_color)) grid.text(x = i + eps, y = -0.05, label = (1 - i) * scale, vjust = 1, rot = labels_rot[1], gp = gpar(col = labels_color)) } } ## plot points xp <- x[,2] + x[,3] / 2 yp <- x[,3] * top size = unit(if(prop_size) prop_size * (s / max(s)) else cex, "lines") grid.points(xp, yp, pch = pch, gp = gpar(col = col), default.units = "snpc", size = size, ...) ## plot if (!is.null(id)) grid.text(x = xp, y = unit(yp - 0.015, "snpc") - 0.5 * size, label = as.character(id), just = id_just, gp = gpar(col = id_color, cex = cex)) ## cleanup if(pop) popViewport(2) else upViewport(2) if (return_grob) invisible(grid.grab()) else invisible(NULL) } vcd/R/assocstats.R0000655000175000017500000000321712504622116013677 0ustar nileshnileshassocstats <- function(x) { if(!is.matrix(x)) { l <- length(dim(x)) str <- apply(x, 3 : l, FUN = assocstats) if (l == 3) { names(str) <- paste(names(dimnames(x))[3], names(str), sep = ":") } else { dn <- dimnames(str) dim(str) <- NULL names(str) <- apply(expand.grid(dn), 1, function(x) paste(names(dn), x, sep = ":", collapse = "|")) } return(str) } tab <- summary(loglm(~1+2, x))$tests phi <- sqrt(tab[2,1] / sum(x)) cont <- sqrt(phi^2 / (1 + phi^2)) cramer <- sqrt(phi^2 / min(dim(x) - 1)) structure( list(table = x, chisq_tests = tab, phi = ifelse(all(dim(x) == 2L), phi, NA), contingency = cont, cramer = cramer), class = "assocstats" ) } print.assocstats <- function(x, digits = 3, ...) { print(x$chisq_tests, digits = 5, ...) cat("\n") cat("Phi-Coefficient :", round(x$phi, digits = digits), "\n") cat("Contingency Coeff.:", round(x$cont, digits = digits), "\n") cat("Cramer's V :", round(x$cramer, digits = digits), "\n") invisible(x) } summary.assocstats <- function(object, percentage = FALSE, ...) { tab <- summary(object$table, percentage = percentage, ...) tab$chisq <- NULL structure(list(summary = tab, object = object), class = "summary.assocstats" ) } print.summary.assocstats <- function(x, ...) { cat("\n") print(x$summary, ...) print(x$object, ...) cat("\n") invisible(x) } vcd/R/utils.R0000755000175000017500000000006611150520606012645 0ustar nileshnileshremove_trailing_comma <- function(x) sub(",$", "", x) vcd/R/tile.R0000655000175000017500000001463613607016754012466 0ustar nileshnileshtile <- function(x, ...) UseMethod("tile") tile.formula <- function(formula, data = NULL, ..., main = NULL, sub = NULL, subset = NULL, na.action = NULL) { if (is.logical(main) && main) main <- deparse(substitute(data)) else if (is.logical(sub) && sub) sub <- deparse(substitute(data)) m <- match.call(expand.dots = FALSE) edata <- eval(m$data, parent.frame()) fstr <- strsplit(paste(deparse(formula), collapse = ""), "~") vars <- strsplit(strsplit(gsub(" ", "", fstr[[1]][2]), "\\|")[[1]], "\\+") varnames <- vars[[1]] dep <- gsub(" ", "", fstr[[1]][1]) if (!dep %in% c("","Freq")) { if (all(varnames == ".")) { varnames <- if (is.data.frame(data)) colnames(data) else names(dimnames(as.table(data))) varnames <- varnames[-which(varnames %in% dep)] } varnames <- c(varnames, dep) } if (inherits(edata, "ftable") || inherits(edata, "table") || length(dim(edata)) > 2) { dat <- as.table(data) if(all(varnames != ".")) { ind <- match(varnames, names(dimnames(dat))) if (any(is.na(ind))) stop(paste("Can't find", paste(varnames[is.na(ind)], collapse=" / "), "in", deparse(substitute(data)))) dat <- margin.table(dat, ind) } tile.default(dat, main = main, sub = sub, ...) } else { m <- m[c(1, match(c("formula", "data", "subset", "na.action"), names(m), 0))] m[[1]] <- as.name("xtabs") m$formula <- formula(paste(if("Freq" %in% colnames(data)) "Freq", "~", paste(varnames, collapse = "+"))) tab <- eval(m, parent.frame()) tile.default(tab, main = main, sub = sub, ...) } } tile.default <- function(x, tile_type = c("area", "squaredarea", "height", "width"), halign = c("left", "center", "right"), valign = c("bottom", "center", "top"), split_vertical = NULL, shade = FALSE, spacing = spacing_equal(unit(1, "lines")), set_labels = NULL, margins = unit(3, "lines"), keep_aspect_ratio = FALSE, legend = NULL, legend_width = NULL, squared_tiles = TRUE, main = NULL, sub = NULL, ...) { ## argument handling if (is.logical(main) && main) main <- deparse(substitute(x)) else if (is.logical(sub) && sub) sub <- deparse(substitute(x)) tile_type <- match.arg(tile_type) halign <- match.arg(halign) valign <- match.arg(valign) x <- as.table(x) dl <- length(d <- dim(x)) ## determine starting positions xpos <- 1 - (halign == "left") - 0.5 * (halign == "center") ypos <- 1 - (valign == "bottom") - 0.5 * (valign == "center") ## heuristic to adjust right/bottom margin to obtain squared tiles ## FIXME: better push another viewport? if (squared_tiles) { ## splitting argument if (is.structable(x) && is.null(split_vertical)) split_vertical <- attr(x, "split_vertical") if (is.null(split_vertical)) split_vertical <- FALSE if (length(split_vertical) == 1) split_vertical <- rep(c(split_vertical, !split_vertical), length.out = dl) if (length(split_vertical) < dl) split_vertical <- rep(split_vertical, length.out = dl) ## compute resulting dimnension dflat <- dim(unclass(structable(x, split_vertical = split_vertical))) ## adjust margins spacing <- spacing(d) delta <- abs(dflat[1] - dflat[2]) fac <- delta / max(dflat) un <- unit(fac, "npc") - unit(fac * 5 / convertWidth(spacing[[1]], "lines", valueOnly=TRUE), "lines") leg <- if (shade) { if (is.null(legend_width)) unit(5, "lines") else legend_width } else unit(0, "npc") if (dflat[1] < dflat[2]) margins <- margins + unit.c(unit(0, "npc"), unit(0, "npc"), un + leg, unit(0, "npc")) if (dflat[1] > dflat[2]) margins <- margins + unit.c(unit(0, "npc"), un - leg, unit(0, "npc"), unit(0, "npc")) if (dflat[1] == dflat[2]) margins <- margins + unit.c(unit(0, "npc"), unit(0, "npc"), leg, unit(0, "npc")) } ## create dummy labels if some are duplicated ## and set the labels via set_labels dn <- dimnames(x) if (any(unlist(lapply(dn, duplicated)))) { dimnames(x) <- lapply(dn, seq_along) if (is.null(set_labels)) set_labels <- lapply(dn, function(i) structure(i, names = seq(i))) } ## workhorse function creating bars panelfun <- function(residuals, observed, expected, index, gp, name) { xprop <- expected / max(expected) if (tile_type == "height") grid.rect(x = xpos, y = ypos, height = xprop[t(index)], width = 1, gp = gp, just = c(halign, valign), name = name) else if (tile_type == "width") grid.rect(x = xpos, y = ypos, width = xprop[t(index)], height = 1, gp = gp, just = c(halign, valign), name = name) else if (tile_type == "area") grid.rect(x = xpos, y = ypos, width = sqrt(xprop[t(index)]), height = sqrt(xprop[t(index)]), gp = gp, just = c(halign, valign), name = name) else grid.rect(x = xpos, y = ypos, width = xprop[t(index)], height = xprop[t(index)], gp = gp, just = c(halign, valign), name = name) } mycore <- function(residuals, observed, expected = NULL, spacing, gp, split_vertical, prefix = "") { struc_mosaic(panel = panelfun)(residuals, array(1, dim = d, dimnames = dimnames(observed)), expected = observed, spacing, gp, split_vertical, prefix) } strucplot(x, core = mycore, spacing = spacing, keep_aspect_ratio = keep_aspect_ratio, margins = margins, shade = shade, legend = legend, legend_width = legend_width, main = main, sub = sub, set_labels = set_labels, ...) } vcd/R/tabletools.R0000655000175000017500000000522712456226636013700 0ustar nileshnileshindependence_table <- function(x, frequency = c("absolute", "relative")) { if (!is.array(x)) stop("Need array of absolute frequencies!") frequency <- match.arg(frequency) n <- sum(x) x <- x / n d <- dim(x) ## build margins margins <- lapply(1:length(d), function(i) apply(x, i, sum)) ## multiply all combinations & reshape tab <- array(apply(expand.grid(margins), 1, prod), d, dimnames = dimnames(x)) if (frequency == "relative") tab else tab * n } mar_table <- function(x) { if(!is.matrix(x)) stop("Function only defined for 2-way tables.") tab <- rbind(cbind(x, TOTAL = rowSums(x)), TOTAL = c(colSums(x), sum(x))) names(dimnames(tab)) <- names(dimnames(x)) tab } table2d_summary <- function(object, margins = TRUE, percentages = FALSE, conditionals = c("none", "row", "column"), chisq.test = TRUE, ... ) { ret <- list() if (chisq.test) ret$chisq <- summary.table(object, ...) if(is.matrix(object)) { conditionals <- match.arg(conditionals) tab <- array(0, c(dim(object) + margins, 1 + percentages + (conditionals != "none"))) ## frequencies tab[,,1] <- if(margins) mar_table(object) else object ## percentages if(percentages) { tmp <- prop.table(object) tab[,,2] <- 100 * if(margins) mar_table(tmp) else tmp } ## conditional distributions if(conditionals != "none") { tmp <- prop.table(object, margin = 1 + (conditionals == "column")) tab[,,2 + percentages] <- 100 * if(margins) mar_table(tmp) else tmp } ## dimnames dimnames(tab) <- c(dimnames(if(margins) mar_table(object) else object), list(c("freq", if(percentages) "%", switch(conditionals, row = "row%", column = "col%") ) ) ) ## patch row% / col% margins if(conditionals == "row") tab[dim(tab)[1],,2 + percentages] <- NA if(conditionals == "column") tab[,dim(tab)[2],2 + percentages] <- NA ret$table <- tab } class(ret) <- "table2d_summary" ret } print.table2d_summary <- function (x, digits = max(1, getOption("digits") - 3), ...) { if (!is.null(x$table)) if(dim(x$table)[3] == 1) print(x$table[,,1], digits = digits, ...) else print(ftable(aperm(x$table, c(1,3,2))), 2, digits = digits, ...) cat("\n") if (!is.null(x$chisq)) print.summary.table(x$chisq, digits, ...) invisible(x) } vcd/R/mosaic.R0000655000175000017500000003526313641353220012771 0ustar nileshnilesh########################################################### ## mosaicplot mosaic <- function(x, ...) UseMethod("mosaic") mosaic.formula <- function(formula, data = NULL, highlighting = NULL, ..., main = NULL, sub = NULL, subset = NULL, na.action = NULL) { if (is.logical(main) && main) main <- deparse(substitute(data)) else if (is.logical(sub) && sub) sub <- deparse(substitute(data)) m <- match.call(expand.dots = FALSE) edata <- eval(m$data, parent.frame()) fstr <- strsplit(paste(deparse(formula), collapse = ""), "~") vars <- strsplit(strsplit(gsub(" ", "", fstr[[1]][2]), "\\|")[[1]], "\\+") varnames <- vars[[1]] condnames <- if (length(vars) > 1) vars[[2]] else NULL dep <- gsub(" ", "", fstr[[1]][1]) if (is.null(highlighting) && (!dep %in% c("","Freq"))) { if (all(varnames == ".")) { varnames <- if (is.data.frame(data)) colnames(data) else names(dimnames(as.table(data))) varnames <- varnames[-which(varnames %in% dep)] } varnames <- c(varnames, dep) highlighting <- length(varnames) + length(condnames) } if (inherits(edata, "ftable") || inherits(edata, "table") || length(dim(edata)) > 2) { condind <- NULL dat <- as.table(data) if(all(varnames != ".")) { ind <- match(varnames, names(dimnames(dat))) if (any(is.na(ind))) stop(paste("Can't find", paste(varnames[is.na(ind)], collapse=" / "), "in", deparse(substitute(data)))) if (!is.null(condnames)) { condind <- match(condnames, names(dimnames(dat))) if (any(is.na(condind))) stop(paste("Can't find", paste(condnames[is.na(condind)], collapse=" / "), "in", deparse(substitute(data)))) ind <- c(condind, ind) } dat <- margin.table(dat, ind) } mosaic.default(dat, main = main, sub = sub, highlighting = highlighting, condvars = if (is.null(condind)) NULL else match(condnames, names(dimnames(dat))), ...) } else { m <- m[c(1, match(c("formula", "data", "subset", "na.action"), names(m), 0))] m[[1]] <- as.name("xtabs") m$formula <- formula(paste(if("Freq" %in% colnames(data)) "Freq", "~", paste(c(condnames, varnames), collapse = "+"))) tab <- eval(m, parent.frame()) mosaic.default(tab, main = main, sub = sub, highlighting = highlighting, ...) } } mosaic.default <- function(x, condvars = NULL, split_vertical = NULL, direction = NULL, spacing = NULL, spacing_args = list(), gp = NULL, expected = NULL, shade = NULL, highlighting = NULL, highlighting_fill = rev(gray.colors(tail(dim(x), 1))), highlighting_direction = NULL, zero_size = 0.5, zero_split = FALSE, zero_shade = NULL, zero_gp = gpar(col = 0), panel = NULL, main = NULL, sub = NULL, ...) { zero_shade <- !is.null(shade) && shade || !is.null(expected) || !is.null(gp) if (!is.null(shade) && !shade) zero_shade = FALSE if (is.logical(main) && main) main <- deparse(substitute(x)) else if (is.logical(sub) && sub) sub <- deparse(substitute(x)) if (is.structable(x)) { if (is.null(direction) && is.null(split_vertical)) split_vertical <- attr(x, "split_vertical") x <- as.table(x) } if (is.null(split_vertical)) split_vertical <- FALSE d <- dim(x) dl <- length(d) ## splitting argument if (!is.null(direction)) split_vertical <- direction == "v" if (length(split_vertical) == 1) split_vertical <- rep(c(split_vertical, !split_vertical), length.out = dl) if (length(split_vertical) < dl) split_vertical <- rep(split_vertical, length.out = dl) ## highlighting if (!is.null(highlighting)) { if (is.character(highlighting)) highlighting <- match(highlighting, names(dimnames(x))) if (length(highlighting) > 0) { if (is.character(condvars)) condvars <- match(condvars, names(dimnames(x))) perm <- if (length(condvars) > 0) c(condvars, seq(dl)[-c(condvars,highlighting)], highlighting) else c(seq(dl)[-highlighting], highlighting) x <- aperm(x, perm) d <- d[perm] split_vertical <- split_vertical[perm] if (is.null(spacing)) spacing <- spacing_highlighting if (is.function(highlighting_fill)) highlighting_fill <- highlighting_fill(d[dl]) if (is.null(gp)) gp <- gpar(fill = aperm(array(highlighting_fill, dim = rev(d)))) if (!is.null(highlighting_direction)) { split_vertical[dl] <- highlighting_direction %in% c("left", "right") if (highlighting_direction %in% c("left", "top")) { ## ugly: tmp <- as.data.frame.table(x) tmp[,dl] <- factor(tmp[,dl], rev(levels(tmp[,dl]))) x <- xtabs(Freq ~ ., data = tmp) gp <- gpar(fill = aperm(array(rev(highlighting_fill), dim = rev(d)))) } } } } else if (!is.null(condvars)) { # Conditioning only if (is.character(condvars)) condvars <- match(condvars, names(dimnames(x))) if (length(condvars) > 0) { perm <- c(condvars, seq(dl)[-condvars]) x <- aperm(x, perm) split_vertical <- split_vertical[perm] } if (is.null(spacing)) spacing <- spacing_conditional } ## spacing argument if (is.null(spacing)) spacing <- if (dl < 3) spacing_equal else spacing_increase strucplot(x, condvars = if (is.null(condvars)) NULL else length(condvars), core = struc_mosaic(zero_size = zero_size, zero_split = zero_split, zero_shade = zero_shade, zero_gp = zero_gp, panel = panel), split_vertical = split_vertical, spacing = spacing, spacing_args = spacing_args, gp = gp, expected = expected, shade = shade, main = main, sub = sub, ...) } ## old code: more elegant, but less performant ## ## struc_mosaic2 <- function(zero_size = 0.5, zero_split = FALSE, ## zero_shade = TRUE, zero_gp = gpar(col = 0)) ## function(residuals, observed, expected = NULL, spacing, gp, split_vertical, prefix = "") { ## dn <- dimnames(observed) ## dnn <- names(dn) ## dx <- dim(observed) ## dl <- length(dx) ## ## split workhorse ## zerostack <- character(0) ## split <- function(x, i, name, row, col, zero) { ## cotab <- co_table(x, 1) ## margin <- sapply(cotab, sum) ## v <- split_vertical[i] ## d <- dx[i] ## ## compute total cols/rows and build split layout ## dist <- unit.c(unit(margin, "null"), spacing[[i]]) ## idx <- matrix(1:(2 * d), nrow = 2, byrow = TRUE)[-2 * d] ## layout <- if (v) ## grid.layout(ncol = 2 * d - 1, widths = dist[idx]) ## else ## grid.layout(nrow = 2 * d - 1, heights = dist[idx]) ## vproot <- viewport(layout.pos.col = col, layout.pos.row = row, ## layout = layout, name = remove_trailing_comma(name)) ## ## next level: either create further splits, or final viewports ## name <- paste(name, dnn[i], "=", dn[[i]], ",", sep = "") ## row <- col <- rep.int(1, d) ## if (v) col <- 2 * 1:d - 1 else row <- 2 * 1:d - 1 ## f <- if (i < dl) ## function(m) { ## co <- cotab[[m]] ## z <- mean(co) <= .Machine$double.eps ## if (z && !zero && !zero_split) zerostack <<- c(zerostack, name[m]) ## split(co, i + 1, name[m], row[m], col[m], z && !zero_split) ## } ## else ## function(m) { ## if (cotab[[m]] <= .Machine$double.eps && !zero) ## zerostack <<- c(zerostack, name[m]) ## viewport(layout.pos.col = col[m], layout.pos.row = row[m], ## name = remove_trailing_comma(name[m])) ## } ## vpleaves <- structure(lapply(1:d, f), class = c("vpList", "viewport")) ## vpTree(vproot, vpleaves) ## } ## ## start spltting on top, creates viewport-tree ## pushViewport(split(observed + .Machine$double.eps, ## i = 1, name = paste(prefix, "cell:", sep = ""), ## row = 1, col = 1, zero = FALSE)) ## ## draw rectangles ## mnames <- apply(expand.grid(dn), 1, ## function(i) paste(dnn, i, collapse=",", sep = "=") ## ) ## zeros <- observed <= .Machine$double.eps ## ## draw zero cell lines ## for (i in remove_trailing_comma(zerostack)) { ## seekViewport(i) ## grid.lines(x = 0.5) ## grid.lines(y = 0.5) ## if (!zero_shade && zero_size > 0) { ## grid.points(0.5, 0.5, pch = 19, size = unit(zero_size, "char"), ## gp = zero_gp, ## name = paste(prefix, "disc:", mnames[i], sep = "")) ## grid.points(0.5, 0.5, pch = 1, size = unit(zero_size, "char"), ## name = paste(prefix, "circle:", mnames[i], sep = "")) ## } ## } ## # draw boxes ## for (i in seq_along(mnames)) { ## seekViewport(paste(prefix, "cell:", mnames[i], sep = "")) ## gpobj <- structure(lapply(gp, function(x) x[i]), class = "gpar") ## if (!zeros[i]) { ## grid.rect(gp = gpobj, name = paste(prefix, "rect:", mnames[i], sep = "")) ## } else { ## if (zero_shade && zero_size > 0) { ## grid.points(0.5, 0.5, pch = 19, size = unit(zero_size, "char"), ## gp = gpar(col = gp$fill[i]), ## name = paste(prefix, "disc:", mnames[i], sep = "")) ## grid.points(0.5, 0.5, pch = 1, size = unit(zero_size, "char"), ## name = paste(prefix, "circle:", mnames[i], sep = "")) ## } ## } ## } ## } ## class(struc_mosaic2) <- "grapcon_generator" struc_mosaic <- function(zero_size = 0.5, zero_split = FALSE, zero_shade = TRUE, zero_gp = gpar(col = 0), panel = NULL) function(residuals, observed, expected = NULL, spacing, gp, split_vertical, prefix = "") { dn <- dimnames(observed) dnn <- names(dn) dx <- dim(observed) dl <- length(dx) zeros <- function(gp, name) { grid.lines(x = 0.5) grid.lines(y = 0.5) if (zero_size > 0) { grid.points(0.5, 0.5, pch = 19, size = unit(zero_size, "char"), gp = gp, name = paste(prefix, "disc:", name, sep = "")) grid.points(0.5, 0.5, pch = 1, size = unit(zero_size, "char"), name = paste(prefix, "circle:", name, sep = "")) } } ## split workhorse zerostack <- character(0) split <- function(x, i, name, row, col, zero, index) { cotab <- co_table(x, 1) margin <- sapply(cotab, sum) margin[margin == 0] <- .Machine$double.eps # margin <- margin + .Machine$double.eps v <- split_vertical[i] d <- dx[i] ## compute total cols/rows and build split layout dist <- if (d > 1) unit.c(unit(margin, "null"), spacing[[i]]) else unit(margin, "null") idx <- matrix(1:(2 * d), nrow = 2, byrow = TRUE)[-2 * d] layout <- if (v) grid.layout(ncol = 2 * d - 1, widths = dist[idx]) else grid.layout(nrow = 2 * d - 1, heights = dist[idx]) pushViewport(viewport(layout.pos.col = col, layout.pos.row = row, layout = layout, name = paste(prefix, "cell:", remove_trailing_comma(name), sep = ""))) ## next level: either create further splits, or final viewports row <- col <- rep.int(1, d) if (v) col <- 2 * 1:d - 1 else row <- 2 * 1:d - 1 for (m in 1:d) { nametmp <- paste(name, dnn[i], "=", dn[[i]][m], ",", sep = "") if (i < dl) { co <- cotab[[m]] ## zeros z <- mean(co) <= .Machine$double.eps split(co, i + 1, nametmp, row[m], col[m], z && !zero_split, cbind(index, m)) if (z && !zero && !zero_split && !zero_shade && (zero_size > 0)) zeros(zero_gp, nametmp) } else { pushViewport(viewport(layout.pos.col = col[m], layout.pos.row = row[m], name = paste(prefix, "cell:", remove_trailing_comma(nametmp), sep = ""))) ## zeros if (cotab[[m]] <= .Machine$double.eps && !zero) { zeros(if (!zero_shade) zero_gp else gpar(col = gp$fill[cbind(index,m)]), nametmp) } else { ## rectangles gpobj <- structure(lapply(gp, function(x) x[cbind(index, m)]), class = "gpar") nam <- paste(prefix, "rect:", remove_trailing_comma(nametmp), sep = "") if (!is.null(panel)) panel(residuals, observed, expected, c(cbind(index, m)), gpobj, nam) else grid.rect(gp = gpobj, name = nam) } } upViewport(1) } } ## start splitting on top, creates viewport-tree split(observed, i = 1, name = "", row = 1, col = 1, zero = FALSE, index = cbind()) } class(struc_mosaic) <- "grapcon_generator" vcd/R/hls.R0000755000175000017500000000106511150520606012273 0ustar nileshnileshhls <- function(h = 1, l = 0.5, s = 1) { RGB <- function(q1, q2, hue) { if (hue > 360) hue <- hue - 360 if (hue < 0) hue <- hue + 360 if (hue < 60) q1 + (q2 - q1) * hue / 60 else if (hue < 180) q2 else if (hue < 240) q1 + (q2 - q1) * (240 - hue) / 60 else q1 } h <- h * 360 p2 <- if (l <= 0.5) l * (1 + s) else l + s - (l * s) p1 <- 2 * l - p2; if (s == 0) R <- G <- B <- l else { R <- RGB(p1, p2, h + 120) G <- RGB(p1, p2, h) B <- RGB(p1, p2, h - 120) } rgb(R, G, B) } vcd/R/sieve.R0000644000175000017500000003147212467662166012646 0ustar nileshnilesh########################################################### ## sieveplot sieve <- function(x, ...) UseMethod("sieve") sieve.formula <- function(formula, data = NULL, ..., main = NULL, sub = NULL, subset = NULL) { if (is.logical(main) && main) main <- deparse(substitute(data)) else if (is.logical(sub) && sub) sub <- deparse(substitute(data)) m <- match.call(expand.dots = FALSE) edata <- eval(m$data, parent.frame()) fstr <- strsplit(paste(deparse(formula), collapse = ""), "~") vars <- strsplit(strsplit(gsub(" ", "", fstr[[1]][2]), "\\|")[[1]], "\\+") varnames <- vars[[1]] condnames <- if (length(vars) > 1) vars[[2]] else NULL if (inherits(edata, "ftable") || inherits(edata, "table") || length(dim(edata)) > 2) { condind <- NULL dat <- as.table(data) if(all(varnames != ".")) { ind <- match(varnames, names(dimnames(dat))) if (any(is.na(ind))) stop(paste("Can't find", paste(varnames[is.na(ind)], collapse=" / "), "in", deparse(substitute(data)))) if (!is.null(condnames)) { condind <- match(condnames, names(dimnames(dat))) if (any(is.na(condind))) stop(paste("Can't find", paste(condnames[is.na(condind)], collapse=" / "), "in", deparse(substitute(data)))) ind <- c(condind, ind) } dat <- margin.table(dat, ind) } sieve.default(dat, main = main, sub = sub, condvars = if (is.null(condind)) NULL else match(condnames, names(dimnames(dat))), ...) } else { tab <- if ("Freq" %in% colnames(data)) xtabs(formula(paste("Freq~", paste(c(condnames, varnames), collapse = "+"))), data = data, subset = subset) else xtabs(formula(paste("~", paste(c(condnames, varnames), collapse = "+"))), data = data, subset = subset) sieve.default(tab, main = main, sub = sub, ...) } } sieve.default <- function(x, condvars = NULL, gp = NULL, shade = NULL, legend = FALSE, split_vertical = NULL, direction = NULL, spacing = NULL, spacing_args = list(), sievetype = c("observed","expected"), gp_tile = gpar(), scale = 1, main = NULL, sub = NULL, ...) { if (is.logical(main) && main) main <- deparse(substitute(x)) else if (is.logical(sub) && sub) sub <- deparse(substitute(x)) sievetype = match.arg(sievetype) if (is.logical(shade) && shade && is.null(gp)) gp <- if (sievetype == "observed") # shading_sieve(interpolate = 0, lty = c("longdash", "solid")) shading_sieve(interpolate = 0, lty = c("solid", "longdash")) else shading_sieve(interpolate = 0, line_col = "darkgray", eps = Inf, lty = "dotted") if (is.structable(x)) { if (is.null(direction) && is.null(split_vertical)) split_vertical <- attr(x, "split_vertical") x <- as.table(x) } if (is.null(split_vertical)) split_vertical <- FALSE dl <- length(dim(x)) ## splitting argument if (!is.null(direction)) split_vertical <- direction == "v" if (length(split_vertical) == 1) split_vertical <- rep(c(split_vertical, !split_vertical), length.out = dl) if (length(split_vertical) < dl) split_vertical <- rep(split_vertical, length.out = dl) ## condvars if (!is.null(condvars)) { if (is.character(condvars)) condvars <- match(condvars, names(dimnames(x))) x <- aperm(x, c(condvars, seq(dl)[-condvars])) if (is.null(spacing)) spacing <- spacing_conditional } ## spacing argument if (is.null(spacing)) spacing <- if (dl < 3) spacing_equal(sp = 0) else spacing_increase strucplot(x, condvars = if (is.null(condvars)) NULL else length(condvars), core = struc_sieve(sievetype = sievetype, gp_tile = gp_tile, scale = scale), split_vertical = split_vertical, spacing = spacing, spacing_args = spacing_args, main = main, sub = sub, shade = shade, legend = legend, gp = gp, ...) } ## old version (not performant enough) ## ## struc_sieve <- function(sievetype = c("observed", "expected")) { ## sievetype = match.arg(sievetype) ## function(residuals, observed, expected, spacing, gp, split_vertical, prefix = "") { ## dn <- dimnames(expected) ## dnn <- names(dn) ## dx <- dim(expected) ## dl <- length(dx) ## n <- sum(expected) ## ## split workhorse ## split <- function(x, i, name, row, col, rowmargin, colmargin) { ## cotab <- co_table(x, 1) ## margin <- sapply(cotab, sum) ## v <- split_vertical[i] ## d <- dx[i] ## ## compute total cols/rows and build split layout ## dist <- unit.c(unit(margin, "null"), spacing[[i]]) ## idx <- matrix(1:(2 * d), nrow = 2, byrow = TRUE)[-2 * d] ## layout <- if (v) ## grid.layout(ncol = 2 * d - 1, widths = dist[idx]) ## else ## grid.layout(nrow = 2 * d - 1, heights = dist[idx]) ## vproot <- viewport(layout.pos.col = col, layout.pos.row = row, ## layout = layout, name = remove_trailing_comma(name)) ## ## next level: either create further splits, or final viewports ## name <- paste(name, dnn[i], "=", dn[[i]], ",", sep = "") ## row <- col <- rep.int(1, d) ## if (v) col <- 2 * 1:d - 1 else row <- 2 * 1:d - 1 ## proptab <- function(x) x / max(sum(x), 1) ## f <- if (i < dl) { ## if (v) ## function(m) split(cotab[[m]], i + 1, name[m], row[m], col[m], ## colmargin = colmargin * proptab(margin)[m], ## rowmargin = rowmargin) ## else ## function(m) split(cotab[[m]], i + 1, name[m], row[m], col[m], ## colmargin = colmargin, ## rowmargin = rowmargin * proptab(margin)[m]) ## } else { ## if (v) ## function(m) viewport(layout.pos.col = col[m], layout.pos.row = row[m], ## name = remove_trailing_comma(name[m]), ## yscale = c(0, rowmargin), ## xscale = c(0, colmargin * proptab(margin)[m])) ## else ## function(m) viewport(layout.pos.col = col[m], layout.pos.row = row[m], ## name = remove_trailing_comma(name[m]), ## yscale = c(0, rowmargin * proptab(margin)[m]), ## xscale = c(0, colmargin)) ## } ## vpleaves <- structure(lapply(1:d, f), class = c("vpList", "viewport")) ## vpTree(vproot, vpleaves) ## } ## ## start splitting on top, creates viewport-tree ## pushViewport(split(expected + .Machine$double.eps, ## i = 1, name = paste(prefix, "cell:", sep = ""), row = 1, col = 1, ## rowmargin = n, colmargin = n)) ## ## draw rectangles ## mnames <- apply(expand.grid(dn), 1, ## function(i) paste(dnn, i, collapse=",", sep = "=") ## ) ## for (i in seq_along(mnames)) { ## seekViewport(paste(prefix, "cell:", mnames[i], sep = "")) ## vp <- current.viewport() ## gpobj <- structure(lapply(gp, function(x) x[i]), class = "gpar") ## div <- if (sievetype == "observed") observed[i] else expected[i] ## if (div > 0) { ## square.side <- sqrt(vp$yscale[2] * vp$xscale[2] / div) ## ii <- seq(0, vp$xscale[2], by = square.side) ## jj <- seq(0, vp$yscale[2], by = square.side) ## grid.segments(x0 = ii, x1 = ii, y0 = 0, y1 = vp$yscale[2], ## default.units = "native", gp = gpobj) ## grid.segments(x0 = 0, x1 = vp$xscale[2], y0 = jj, y1 = jj, ## default.units = "native", gp = gpobj) ## } ## grid.rect(name = paste(prefix, "rect:", mnames[i], sep = ""), ## gp = gpar(fill = "transparent")) ## } ## } ## } ##class(struc_sieve) <- "grapcon_generator" struc_sieve <- function(sievetype = c("observed", "expected"), gp_tile = gpar(), scale = 1) { sievetype = match.arg(sievetype) function(residuals, observed, expected, spacing, gp, split_vertical, prefix = "") { observed <- scale * observed expected <- scale * expected if (is.null(expected)) stop("Need expected values.") dn <- dimnames(expected) dnn <- names(dn) dx <- dim(expected) dl <- length(dx) n <- sum(expected) ## split workhorse split <- function(x, i, name, row, col, rowmargin, colmargin, index) { cotab <- co_table(x, 1) margin <- sapply(cotab, sum) v <- split_vertical[i] d <- dx[i] ## compute total cols/rows and build split layout dist <- if (d > 1) unit.c(unit(margin, "null"), spacing[[i]]) else unit(margin, "null") idx <- matrix(1:(2 * d), nrow = 2, byrow = TRUE)[-2 * d] layout <- if (v) grid.layout(ncol = 2 * d - 1, widths = dist[idx]) else grid.layout(nrow = 2 * d - 1, heights = dist[idx]) pushViewport(viewport(layout.pos.col = col, layout.pos.row = row, layout = layout, name = paste(prefix, "cell:", remove_trailing_comma(name), sep = ""))) ## next level: either create further splits, or final viewports row <- col <- rep.int(1, d) if (v) col <- 2 * 1:d - 1 else row <- 2 * 1:d - 1 proptab <- function(x) x / max(sum(x), 1) for (m in 1:d) { nametmp <- paste(name, dnn[i], "=", dn[[i]][m], ",", sep = "") if (v) { colmargintmp <- colmargin * proptab(margin)[m] rowmargintmp <- rowmargin } else { rowmargintmp <- rowmargin * proptab(margin)[m] colmargintmp <- colmargin } if (i < dl) split(cotab[[m]], i + 1, nametmp, row[m], col[m], colmargin = colmargintmp, rowmargin = rowmargintmp, index = cbind(index, m)) else { pushViewport(viewport(layout.pos.col = col[m], layout.pos.row = row[m], name = paste(prefix, "cell:", remove_trailing_comma(nametmp), sep = ""), yscale = c(0, rowmargintmp), xscale = c(0, colmargintmp))) gpobj <- structure(lapply(gp, function(x) x[cbind(index, m)]), class = "gpar") ## draw sieve div <- if (sievetype == "observed") observed[cbind(index, m)] else expected[cbind(index, m)] gptmp <- gp_tile gptmp$col <- "transparent" grid.rect(name = paste(prefix, "rect:", nametmp, sep = ""), gp = gptmp) if (div > 0) { square.side <- sqrt(colmargintmp * rowmargintmp / div) ii <- seq(0, colmargintmp, by = square.side) jj <- seq(0, rowmargintmp, by = square.side) grid.segments(x0 = ii, x1 = ii, y0 = 0, y1 = rowmargintmp, default.units = "native", gp = gpobj) grid.segments(x0 = 0, x1 = colmargintmp, y0 = jj, y1 = jj, default.units = "native", gp = gpobj) } gptmp <- gp_tile gptmp$fill <- "transparent" grid.rect(name = paste(prefix, "border:", nametmp, sep = ""), gp = gptmp) } upViewport(1) } } ## start splitting on top, creates viewport-tree split(expected + .Machine$double.eps, i = 1, name = "", row = 1, col = 1, rowmargin = n, colmargin = n, index = cbind()) } } class(struc_sieve) <- "grapcon_generator" vcd/R/fourfold.R0000644000175000017500000003657712515204774013355 0ustar nileshnilesh## Modifications - MF - 1 Dec 2010 # -- change default colors to more distinguishable values # -- allow to work with >3 dimensional arrays # -- modified defaults for mfrow/mfcol to give landscape display, nr <= nc, rather than nr >= nc # Take a 2+D array and return a 3D array, with dimensions 3+ as a single dimension # Include as a separate function, since it is useful in other contexts array3d <- function(x, sep=':') { if(length(dim(x)) == 2) { x <- if(is.null(dimnames(x))) array(x, c(dim(x), 1)) else array(x, c(dim(x), 1), c(dimnames(x), list(NULL))) return(x) } else if(length(dim(x))==3) return(x) else { x3d <- array(x, c(dim(x)[1:2], prod(dim(x)[-(1:2)]))) if (!is.null(dimnames(x))) { n3d <- paste(names(dimnames(x))[-(1:2)], collapse=sep) d3d <- apply(expand.grid(dimnames(x)[-(1:2)]), 1, paste, collapse=sep) dimnames(x3d) <- c(dimnames(x)[1:2], list(d3d)) names(dimnames(x3d))[3] <- n3d } return(x3d) } } "fourfold" <- function(x, # color = c("#99CCFF","#6699CC","#FF5050","#6060A0", "#FF0000", "#000080"), color = c("#99CCFF","#6699CC","#FFA0A0","#A0A0FF", "#FF0000", "#000080"), conf_level = 0.95, std = c("margins", "ind.max", "all.max"), margin = c(1, 2), space = 0.2, main = NULL, sub = NULL, mfrow = NULL, mfcol = NULL, extended = TRUE, ticks = 0.15, p_adjust_method = p.adjust.methods, newpage = TRUE, fontsize = 12, default_prefix = c("Row", "Col", "Strata"), sep = ": ", varnames = TRUE, return_grob = FALSE) { ## Code for producing fourfold displays. ## Reference: ## Friendly, M. (1994). ## A fourfold display for 2 by 2 by \eqn{k} tables. ## Technical Report 217, York University, Psychology Department. ## http://datavis.ca/papers/4fold/4fold.pdf ## ## Implementation notes: ## ## We need plots with aspect ratio FIXED to 1 and glued together. ## Hence, even if k > 1 we prefer keeping everything in one plot ## region rather than using a multiple figure layout. ## Each 2 by 2 pie is is drawn into a square with x/y coordinates ## between -1 and 1, with row and column labels in [-1-space, -1] ## and [1, 1+space], respectively. If k > 1, strata labels are in ## an area with y coordinates in [1+space, 1+(1+gamma)*space], ## where currently gamma=1.25. The pies are arranged in an nr by ## nc layout, with horizontal and vertical distances between them ## set to space. ## ## The drawing code first computes the complete are of the form ## [0, totalWidth] x [0, totalHeight] ## needed and sets the world coordinates using plot.window(). ## Then, the strata are looped over, and the corresponding pies ## added by filling rows or columns of the layout as specified by ## the mfrow or mfcol arguments. The world coordinates are reset ## in each step by shifting the origin so that we can always plot ## as detailed above. if(!is.array(x)) stop("x must be an array") dimx <- dim(x) # save original dimensions for setting default mfrow/mfcol when length(dim(x))>3 x <- array3d(x) if(any(dim(x)[1:2] != 2)) stop("table for each stratum must be 2 by 2") dnx <- dimnames(x) if(is.null(dnx)) dnx <- vector("list", 3) for(i in which(sapply(dnx, is.null))) dnx[[i]] <- LETTERS[seq(length = dim(x)[i])] if(is.null(names(dnx))) i <- 1 : 3 else i <- which(is.null(names(dnx))) if(any(i > 0)) names(dnx)[i] <- default_prefix[i] dimnames(x) <- dnx k <- dim(x)[3] if(!((length(conf_level) == 1) && is.finite(conf_level) && (conf_level >= 0) && (conf_level < 1))) stop("conf_level must be a single number between 0 and 1") if(conf_level == 0) conf_level <- FALSE std <- match.arg(std) findTableWithOAM <- function(or, tab) { ## Find a 2x2 table with given odds ratio `or' and the margins ## of a given 2x2 table `tab'. m <- rowSums(tab)[1] n <- rowSums(tab)[2] t <- colSums(tab)[1] if(or == 1) x <- t * n / (m + n) else if(or == Inf) x <- max(0, t - m) else { A <- or - 1 B <- or * (m - t) + (n + t) C <- - t * n x <- (- B + sqrt(B ^ 2 - 4 * A * C)) / (2 * A) } matrix(c(t - x, x, m - t + x, n - x), nrow = 2) } drawPie <- function(r, from, to, n = 500, color = "transparent") { p <- 2 * pi * seq(from, to, length = n) / 360 x <- c(cos(p), 0) * r y <- c(sin(p), 0) * r grid.polygon(x, y, gp = gpar(fill = color), default.units = "native") invisible(NULL) } stdize <- function(tab, std, x) { ## Standardize the 2 x 2 table `tab'. if(std == "margins") { if(all(sort(margin) == c(1, 2))) { ## standardize to equal row and col margins u <- sqrt(odds(tab)$or) u <- u / (1 + u) y <- matrix(c(u, 1 - u, 1 - u, u), nrow = 2) } else if(margin %in% c(1, 2)) y <- prop.table(tab, margin) else stop("incorrect margin specification") } else if(std == "ind.max") y <- tab / max(tab) else if(std == "all.max") y <- tab / max(x) y } odds <- function(x) { ## Given a 2 x 2 or 2 x 2 x k table `x', return a list with ## components `or' and `se' giving the odds ratios and standard ## deviations of the log odds ratios. if(length(dim(x)) == 2) { dim(x) <- c(dim(x), 1) k <- 1 } else k <- dim(x)[3] or <- double(k) se <- double(k) for(i in 1 : k) { f <- x[ , , i] if(any(f == 0)) f <- f + 0.5 or[i] <- (f[1, 1] * f[2, 2]) / (f[1, 2] * f[2, 1]) se[i] <- sqrt(sum(1 / f)) } list(or = or, se = se) } gamma <- 1.25 # Scale factor for strata labels angle.f <- c( 90, 180, 0, 270) # `f' for `from' angle.t <- c(180, 270, 90, 360) # `t' for `to' byrow <- FALSE if(!is.null(mfrow)) { nr <- mfrow[1] nc <- mfrow[2] } else if(!is.null(mfcol)) { nr <- mfcol[1] nc <- mfcol[2] byrow <- TRUE } else if(length(dimx)>3) { nr <- dimx[3] nc <- prod(dimx[-(1:3)]) } else { # nr <- ceiling(sqrt(k)) nr <- round(sqrt(k)) nc <- ceiling(k / nr) } if(nr * nc < k) stop("incorrect geometry specification") if(byrow) indexMatrix <- expand.grid(1 : nc, 1 : nr)[, c(2, 1)] else indexMatrix <- expand.grid(1 : nr, 1 : nc) totalWidth <- nc * 2 * (1 + space) + (nc - 1) * space totalHeight <- if(k == 1) 2 * (1 + space) else nr * (2 + (2 + gamma) * space) + (nr - 1) * space xlim <- c(0, totalWidth) ylim <- c(0, totalHeight) if (newpage) grid.newpage() if (!is.null(main) || !is.null(sub)) pushViewport(viewport(height = 1 - 0.1 * sum(!is.null(main), !is.null(sub)), width = 0.9, y = 0.5 - 0.05 * sum(!is.null(main), - !is.null(sub)) ) ) pushViewport(viewport(xscale = xlim, yscale = ylim, width = unit(min(totalWidth / totalHeight, 1), "snpc"), height = unit(min(totalHeight / totalWidth, 1), "snpc"))) o <- odds(x) ## perform logoddsratio-test for each stratum (H0: lor = 0) and adjust p-values if(is.numeric(conf_level) && extended) p.lor.test <- p.adjust(sapply(1 : k, function(i) { u <- abs(log(o$or[i])) / o$se[i] 2 * (1 - pnorm(u)) }), method = p_adjust_method ) scale <- space / (2 * convertY(unit(1, "strheight", "Ag"), "native", valueOnly = TRUE) ) v <- 0.95 - max(convertX(unit(1, "strwidth", as.character(c(x))), "native", valueOnly = TRUE) ) / 2 fontsize = fontsize * scale for(i in 1 : k) { tab <- x[ , , i] fit <- stdize(tab, std, x) xInd <- indexMatrix[i, 2] xOrig <- 2 * xInd - 1 + (3 * xInd - 2) * space yInd <- indexMatrix[i, 1] yOrig <- if(k == 1) (1 + space) else (totalHeight - (2 * yInd - 1 + ((3 + gamma) * yInd - 2) * space)) pushViewport(viewport(xscale = xlim - xOrig, yscale = ylim - yOrig)) ## drawLabels() u <- 1 + space / 2 adjCorr <- 0.2 grid.text( paste(names(dimnames(x))[1], dimnames(x)[[1]][1], sep = sep), 0, u, gp = gpar(fontsize = fontsize), default.units = "native" ) grid.text( paste(names(dimnames(x))[2], dimnames(x)[[2]][1], sep = sep), -u, 0, default.units = "native", gp = gpar(fontsize = fontsize), rot = 90) grid.text( paste(names(dimnames(x))[1], dimnames(x)[[1]][2], sep = sep), 0, -u, gp = gpar(fontsize = fontsize), default.units = "native" ) grid.text( paste(names(dimnames(x))[2], dimnames(x)[[2]][2], sep = sep), u, 0, default.units = "native", gp = gpar(fontsize = fontsize), rot = 90) if (k > 1) { grid.text(if (!varnames) dimnames(x)[[3]][i] else paste(names(dimnames(x))[3], dimnames(x)[[3]][i], sep = sep), 0, 1 + (1 + gamma / 2) * space, gp = gpar(fontsize = fontsize * gamma), default.units = "native" ) } ## drawFrequencies() ### in extended plots, emphasize charts with significant logoddsratios emphasize <- if(extended && is.numeric(conf_level)) 2 * extended * (1 + (p.lor.test[i] < 1 - conf_level)) else 0 d <- odds(tab)$or drawPie(sqrt(fit[1,1]), 90, 180, col = color[1 + (d > 1) + emphasize]) drawPie(sqrt(fit[2,1]), 180, 270, col = color[2 - (d > 1) + emphasize]) drawPie(sqrt(fit[1,2]), 0, 90, col = color[2 - (d > 1) + emphasize]) drawPie(sqrt(fit[2,2]), 270, 360, col = color[1 + (d > 1) + emphasize]) u <- 1 - space / 2 grid.text(as.character(c(tab))[1], -v, u, just = c("left", "top"), gp = gpar(fontsize = fontsize), default.units = "native") grid.text(as.character(c(tab))[2], -v, -u, just = c("left", "bottom"), gp = gpar(fontsize = fontsize), default.units = "native") grid.text(as.character(c(tab))[3], v, u, just = c("right", "top"), gp = gpar(fontsize = fontsize), default.units = "native") grid.text(as.character(c(tab))[4], v, -u, just = c("right", "bottom"), gp = gpar(fontsize = fontsize), default.units = "native") ## draw ticks if(extended && ticks) if(d > 1) { grid.lines(c(sqrt(fit[1,1]) * cos(3*pi/4), (sqrt(fit[1,1]) + ticks) * cos(3*pi/4)), c(sqrt(fit[1,1]) * sin(3*pi/4), (sqrt(fit[1,1]) + ticks) * sin(3*pi/4)), gp = gpar(lwd = 1), default.units = "native" ) grid.lines(c(sqrt(fit[2,2]) * cos(-pi/4), (sqrt(fit[2,2]) + ticks) * cos(-pi/4)), c(sqrt(fit[2,2]) * sin(-pi/4), (sqrt(fit[2,2]) + ticks) * sin(-pi/4)), gp = gpar(lwd = 1), default.units = "native" ) } else { grid.lines(c(sqrt(fit[1,2]) * cos(pi/4), (sqrt(fit[1,2]) + ticks) * cos(pi/4)), c(sqrt(fit[1,2]) * sin(pi/4), (sqrt(fit[1,2]) + ticks) * sin(pi/4)), gp = gpar(lwd = 1), default.units = "native" ) grid.lines(c(sqrt(fit[2,1]) * cos(-3*pi/4), (sqrt(fit[2,1]) + ticks) * cos(-3*pi/4)), c(sqrt(fit[2,1]) * sin(-3*pi/4), (sqrt(fit[2,1]) + ticks) * sin(-3*pi/4)), gp = gpar(lwd = 1), default.units = "native" ) } ## drawConfBands() if(is.numeric(conf_level)) { or <- o$or[i] se <- o$se[i] ## lower theta <- or * exp(qnorm((1 - conf_level) / 2) * se) tau <- findTableWithOAM(theta, tab) r <- sqrt(c(stdize(tau, std, x))) for(j in 1 : 4) drawPie(r[j], angle.f[j], angle.t[j]) ## upper theta <- or * exp(qnorm((1 + conf_level) / 2) * se) tau <- findTableWithOAM(theta, tab) r <- sqrt(c(stdize(tau, std, x))) for(j in 1 : 4) drawPie(r[j], angle.f[j], angle.t[j]) } ## drawBoxes() grid.polygon(c(-1, 1, 1, -1), c(-1, -1, 1, 1), default.units = "native", gp = gpar(fill = "transparent") ) grid.lines(c(-1, 1), c(0, 0), default.units = "native") for(j in seq(from = -0.8, to = 0.8, by = 0.2)) grid.lines(c(j, j), c(-0.02, 0.02), default.units = "native") for(j in seq(from = -0.9, to = 0.9, by = 0.2)) grid.lines(c(j, j), c(-0.01, 0.01), default.units = "native") grid.lines(c(0, 0), c(-1, 1), default.units = "native") for(j in seq(from = -0.8, to = 0.8, by = 0.2)) grid.lines(c(-0.02, 0.02), c(j, j), default.units = "native") for(j in seq(from = -0.9, to = 0.9, by = 0.2)) grid.lines(c(-0.01, 0.01), c(j, j), default.units = "native") popViewport(1) } if(!is.null(main) || !is.null(sub)) { if (!is.null(main)) grid.text(main, y = unit(1, "npc") + unit(1, "lines"), gp = gpar(fontsize = 20, fontface = 2)) if (!is.null(sub)) grid.text(sub, y = unit(0, "npc") - unit(1, "lines"), gp = gpar(fontsize = 20, fontface = 2)) popViewport(1) } popViewport(1) if (return_grob) return(invisible(grid.grab())) else return(invisible(NULL)) } vcd/R/plot.loglm.R0000644000175000017500000000206612305101202013561 0ustar nileshnileshplot.loglm <- function(x, panel = mosaic, type = c("observed", "expected"), residuals_type = c("pearson", "deviance"), gp = shading_hcl, gp_args = list(), ...) { residuals_type <- match.arg(tolower(residuals_type), c("pearson", "deviance")) if(is.null(x$fitted)) x <- update(x, fitted = TRUE) expected <- fitted(x) residuals <- residuals(x, type = "pearson") observed <- residuals * sqrt(expected) + expected if(residuals_type == "deviance") residuals <- residuals(x, type = "deviance") gp <- if(inherits(gp, "grapcon_generator")) do.call("gp", c(list(observed, residuals, expected, x$df), as.list(gp_args))) else gp panel(observed, residuals = residuals, expected = expected, type = type, residuals_type = residuals_type, gp = gp, ...) } mosaic.loglm <- function(x, ...) { plot(x, panel = mosaic, ...) } assoc.loglm <- function(x, ...) { plot(x, panel = assoc, ...) } sieve.loglm <- function(x, ...) { plot(x, panel = sieve, ...) } vcd/R/Kappa.R0000644000175000017500000000454612477411346012562 0ustar nileshnileshKappa <- function (x, weights = c("Equal-Spacing", "Fleiss-Cohen")) { if (is.character(weights)) weights <- match.arg(weights) d <- diag(x) n <- sum(x) nc <- ncol(x) colFreqs <- colSums(x)/n rowFreqs <- rowSums(x)/n ## Kappa kappa <- function (po, pc) (po - pc) / (1 - pc) std <- function (p, pc, kw, W = diag(1, ncol = nc, nrow = nc)) { sqrt((sum(p * sweep(sweep(W, 1, W %*% colSums(p) * (1 - kw)), 2, W %*% rowSums(p) * (1 - kw)) ^ 2) - (kw - pc * (1 - kw)) ^ 2) / crossprod(1 - pc) / n) } ## unweighted po <- sum(d) / n pc <- crossprod(colFreqs, rowFreqs)[1] k <- kappa(po, pc) s <- std(x / n, pc, k) ## weighted W <- if (is.matrix(weights)) weights else if (weights == "Equal-Spacing") 1 - abs(outer(1:nc, 1:nc, "-")) / (nc - 1) else 1 - (abs(outer(1:nc, 1:nc, "-")) / (nc - 1))^2 pow <- sum(W * x) / n pcw <- sum(W * colFreqs %o% rowFreqs) kw <- kappa(pow, pcw) sw <- std(x / n, pcw, kw, W) structure( list(Unweighted = c( value = k, ASE = s ), Weighted = c( value = kw, ASE = sw ), Weights = W ), class = "Kappa" ) } print.Kappa <- function (x, digits=max(getOption("digits") - 3, 3), CI=FALSE, level=0.95, ...) { tab <- rbind(x$Unweighted, x$Weighted) z <- tab[,1] / tab[,2] tab <- cbind(tab, z, `Pr(>|z|)` = 2 * pnorm(-abs(z))) if (CI) { q <- qnorm((1 + level)/2) lower <- tab[,1] - q * tab[,2] upper <- tab[,1] + q * tab[,2] tab <- cbind(tab, lower, upper) } rownames(tab) <- names(x)[1:2] print(tab, digits=digits, ...) invisible(x) } summary.Kappa <- function (object, ...) structure(object, class = "summary.Kappa") print.summary.Kappa <- function (x, ...) { print.Kappa(x, ...) cat("\nWeights:\n") print(x$Weights, ...) invisible(x) } confint.Kappa <- function(object, parm, level = 0.95, ...) { q <- qnorm((1 + level) / 2) matrix(c(max(-1, object[[1]][1] - object[[1]][2] * q), min(1, object[[1]][1] + object[[1]][2] * q), max(-1, object[[2]][1] - object[[2]][2] * q), min(1, object[[2]][1] + object[[2]][2] * q)), ncol = 2, byrow = TRUE, dimnames = list(Kappa = c("Unweighted","Weighted"), c("lwr","upr")) ) } vcd/R/oddsratioplot.R0000655000175000017500000001125312475151320014377 0ustar nileshnilesh"oddsratio" <- function(x, stratum = NULL, log = TRUE) loddsratio(x, strata = stratum, log = log) ## "oddsratio" <- ## function (x, stratum = NULL, log = TRUE) { ## l <- length(dim(x)) ## if (l > 2 && is.null(stratum)) ## stratum <- 3:l ## if (l - length(stratum) > 2) ## stop("All but 2 dimensions must be specified as strata.") ## if (l == 2 && dim(x) != c(2, 2)) ## stop("Not a 2x2 table.") ## if (!is.null(stratum) && dim(x)[-stratum] != c(2,2)) ## stop("Need strata of 2x2 tables.") ## lor <- function (y) { ## if (any(y == 0)) ## y <- y + 0.5 ## y <- log(y) ## or <- y[1,1] + y[2,2] - y[1,2] - y[2,1] ## if (log) or else exp(or) ## } ## ase <- function(y) { ## if (any(y == 0)) ## y <- y + 0.5 ## sqrt(sum(1/y)) ## } ## if(is.null(stratum)) { ## LOR <- lor(x) ## ASE <- ase(x) ## } else { ## LOR <- apply(x, stratum, lor) ## ASE <- apply(x, stratum, ase) ## } ## structure(LOR, ## ASE = ASE, ## log = log, ## class = "oddsratio" ## )} ## "print.oddsratio" <- ## function(x, ...) { ## if (length(dim(x)) > 1) ## print(cbind(unclass(x)), ...) ## else ## print(c(x), ...) ## invisible(x) ## } ## "summary.oddsratio" <- ## function(object, ...) { ## if(!is.null(dim(object))) ## ret <- object ## else { ## LOG <- attr(object, "log") ## ASE <- attr(object, "ASE") ## Z <- object / ASE ## ret <- cbind("Estimate" = object, ## "Std. Error" = if (LOG) ASE, ## "z value" = if (LOG) Z, ## "Pr(>|z|)" = if (LOG) 2 * pnorm(-abs(Z)) ## ) ## colnames(ret)[1] <- if (LOG) "Log Odds Ratio" else "Odds Ratio" ## } ## class(ret) <- "summary.oddsratio" ## ret ## } ## "print.summary.oddsratio" <- ## function(x, ...) { ## if(!is.null(attr(x, "log"))) { ## cat("\n") ## cat(if(attr(x, "log")) "Log Odds Ratio(s):" else "Odds Ratio(s):", "\n\n") ## print(as.data.frame(unclass(x)), ...) ## cat("\nAsymptotic Standard Error(s):\n\n") ## print(attr(x, "ASE"), ...) ## cat("\n") ## } else printCoefmat(unclass(x), ...) ## invisible(x) ## } ## "plot.oddsratio" <- ## function(x, ## conf_level = 0.95, ## type = "o", ## xlab = NULL, ## ylab = NULL, ## xlim = NULL, ## ylim = NULL, ## whiskers = 0.1, ## baseline = TRUE, ## transpose = FALSE, ## ...) ## { ## if (length(dim(x)) > 1) ## stop ("Plot function works only on vectors.") ## LOG <- attr(x, "log") ## confidence <- !(is.null(conf_level) || conf_level == FALSE) ## oddsrange <- range(x) ## if(confidence) { ## CI <- confint(x, level = conf_level) ## lwr <- CI[,1] ## upr <- CI[,2] ## oddsrange[1] <- trunc(min(oddsrange[1], min(lwr))) ## oddsrange[2] <- ceiling(max(oddsrange[2], max(upr))) ## } ## if (transpose) { ## plot(x = unclass(x), ## y = 1:length(x), ## ylab = if (!is.null(ylab)) ylab else "Strata", ## xlab = if (!is.null(xlab)) xlab else if (LOG) "Log Odds Ratio" else "Odds Ratio", ## type = type, ## yaxt = "n", ## xlim = if(is.null(xlim)) oddsrange else xlim, ## ...) ## axis (2, at = 1:length(x), names(x)) ## if (baseline) ## lines(c(1,1) - LOG, c(0,length(x) + 1), lty = 2, col = "red") ## if (confidence) ## for (i in 1:length(x)) { ## lines(c(lwr[i], upr[i]), c(i, i)) ## lines(c(lwr[i], lwr[i]), c(i - whiskers/2, i + whiskers/2)) ## lines(c(upr[i], upr[i]), c(i - whiskers/2, i + whiskers/2)) ## } ## } else { ## plot(unclass(x), ## xlab = if (!is.null(xlab)) xlab else "Strata", ## ylab = if(!is.null(ylab)) ylab else if(LOG) "Log Odds Ratio" else "Odds Ratio", ## type = type, ## xaxt = "n", ## ylim = if(is.null(ylim)) oddsrange else ylim, ## ...) ## axis (1, at = 1:length(x), names(x)) ## if (baseline) ## lines(c(0,length(x) + 1), c(1,1) - LOG, lty = 2, col = "red") ## if (confidence) ## for (i in 1:length(x)) { ## lines(c(i, i), c(lwr[i], upr[i])) ## lines(c(i - whiskers/2, i + whiskers/2), c(lwr[i], lwr[i])) ## lines(c(i - whiskers/2, i + whiskers/2), c(upr[i], upr[i])) ## } ## } ## } ## "confint.oddsratio" <- ## function(object, parm, level = 0.95, ...) { ## ASE <- attr(object, "ASE") ## LOG <- attr(object, "log") ## I <- ASE * qnorm((1 + level) / 2) ## cbind( ## lwr = if (LOG) object - I else exp(log(object) - I), ## upr = if (LOG) object + I else exp(log(object) + I) ## ) ## } vcd/inst/0000755000175000017500000000000014133313347012137 5ustar nileshnileshvcd/inst/CITATION0000644000175000017500000000470114133215016013270 0ustar nileshnileshcitHeader("To cite package vcd in publications use:") ## R >= 2.8.0 passes package metadata to citation(). if(!exists("meta") || is.null(meta)) meta <- packageDescription("vcd") year <- sub(".*(2[[:digit:]]{3})-.*", "\\1", meta$Date) vers <- paste("R package version", meta$Version) citEntry(entry="Manual", title = "vcd: Visualizing Categorical Data", author = personList(as.person("David Meyer"), as.person("Achim Zeileis"), as.person("Kurt Hornik")), year = year, note = vers, textVersion = paste("David Meyer, Achim Zeileis, and Kurt Hornik (", year, "). vcd: Visualizing Categorical Data. ", vers, ".", sep="")) citEntry(entry="Article", header="To cite the strucplot framework (e.g., functions mosaic(), sieve(), assoc(), strucplot(), structable(), pairs.table(), cotabplot(), doubledecker()), additionally use:", title = "The Strucplot Framework: Visualizing Multi-Way Contingency Tables with vcd", author = personList(as.person("David Meyer"), as.person("Achim Zeileis"), as.person("Kurt Hornik")), journal = "Journal of Statistical Software", year = "2006", volume = "17", number = "3", pages = "1--48", doi = "10.18637/jss.v017.i03", textVersion = paste("David Meyer, Achim Zeileis, and Kurt Hornik (2006).", "The Strucplot Framework: Visualizing Multi-Way Contingency Tables with vcd.", "Journal of Statistical Software, 17(3), 1-48.", "DOI 10.18637/jss.v017.i03") ) citEntry(entry="Article", header="If you use the residual-based shadings (in mosaic() or assoc()), please cite:", title = "Residual-based Shadings for Visualizing (Conditional) Independence", author = personList(as.person("Achim Zeileis"), as.person("David Meyer"), as.person("Kurt Hornik")), journal = "Journal of Computational and Graphical Statistics", year = "2007", volume = "16", number = "3", pages = "507--525", textVersion = paste("Achim Zeileis, David Meyer, and Kurt Hornik (2007).", "Residual-based Shadings for Visualizing (Conditional) Independence.", "Journal of Computational and Graphical Statistics, 16(3), 507-525.") ) vcd/inst/NEWS.Rd0000644000175000017500000002405114133214154013200 0ustar nileshnilesh\name{NEWS} \title{News for Package \pkg{vcd}} \newcommand{\cpkg}{\href{https://CRAN.R-project.org/package=#1}{\pkg{#1}}} \section{Changes in version 1.4-9}{ \itemize{ \item add \code{gp_axis} argument to \code{pairs_barplot()}. \item fix URLs in JSS references. } } \section{Changes in version 1.4-8}{ \itemize{ \item New argument \code{pdigits=} in \code{legend_resbased()} to specify the number of digits of p-values. } } \section{Changes in version 1.4-7}{ \itemize{ \item bugfix: highlighting was wrong since 1.4-5. It now correctly recycles the fill parameter along \emph{last} dimension (i.e., the dependent variable), in contrast to standard behavior of \code{mosaic()} } } \section{Changes in version 1.4-6}{ \itemize{ \item bugfix: doubledecker plot had wrong shading since 1.4-5. It now correctly recycles graphical parameters along \emph{last} dimension (i.e., the dependent variable), in contrast to standard behavior of mosaic(). } } \section{Changes in version 1.4-5}{ \itemize{ \item small internal change in \code{tile()} to account for new grid package. \item graphical parameters are now recycled along \emph{first} dimension. } } \section{Changes in version 1.4-4}{ \itemize{ \item Bugfix: \code{labeling_cells()} could not handle structable objects when called separately from \code{mosaic()}. \item \code{ternaryplot()} now has additional \code{dimnames_rot=} and \code{labels_rot=} arguments for changing the angle of the labels. \item The loddratio plot now suppresses labels in the 2x2x(strata) case. } } \section{Changes in version 1.4-3}{ \itemize{ \item Remove outdated inst/doc directory. } } \section{Changes in version 1.4-2}{ \itemize{ \item add \code{lines()} method for \code{loddsratio} objects. \item add \code{gpar()} argment to control confidence intervals in \code{distplot()}. } } \section{Changes in version 1.4-1}{ \itemize{ \item add imports for functions in recommended packages to NAMESPACE \item \code{shading_hcl} now also uses solid line type for \code{abs(residuals) < eps} like \code{shading_hsv()}. } } \section{Changes in version 1.4-0}{ \itemize{ \item Add \code{shading_Marimekko} and \code{shading_diagonal}. \item Add residual-based shading to \code{rootogram()}. \item Add \code{residuals()} method for \code{"goodfit"} objects. \item Add \code{grid_abline()} for convenience. \item Add P-values to the output print.Kappa() produces. \item Fix legend of \code{distplot()} in case of leveled plots. \item \code{cotab_agreementplot} panel function for plotting conditional (stratified) agreement charts added. \item \code{loddsratio} added as an extension of \code{oddsratio} for conditioned generalized odds ratios. The plot method is greatly enhanced, and structural zeros (missing values) are also accepted. \code{oddsratio} is now just an alias for \code{loddsratio}. \item Bug fix in \code{pairs.table()}: for \code{"conditional"} type, tables are now reordered so that the conditioning variables come \emph{first}. \item \code{cotab_loddsratio} panel function for plotting conditional log-odds ratios plots added. \item \code{assocstats} now handles strata (all but the first two dimensions). \item \code{sieve} now accepts a \code{scale=} argument. \item \code{binreg_plot()} added for (conditioned) binary regression plots \item Bug fix in \code{mosaic()}: using \code{highlighting=} and/or \code{condvars=} now not only reorders the table, but also the split information, so that both remain consistent. \item All plot functions now have an option to return the produced plot as a grid object for further use (e.g., in \code{mplot()}). \item \code{mplot()} added for combining multiple grid plots in a multi-panel-layout. \item \code{legend_grid} now allows more options for positioning, and an \code{inset} argument has been added for relative adjustments. } } \section{Changes in version 1.3-2}{ \itemize{ \item \code{Ord_plot()} gets \code{lwd}, \code{lty} and \code{col} arguments to control plotting of the OLS and WLS lines. \item \code{distplot()} gets an \code{lwd} argument. \item Changed default line types for \code{sieve} so that positive residuals are shown with solid lines, as per Friendly specifications. \item fixed problems with \code{pairs_strucplot()} type argument, particularly for \code{type="conditional"} \item Fixed error in \code{CoalMiners} data (missing group, labels switched) \item Change default area type for sieve plots to "area" } } \section{Changes in version 1.3-1}{ \itemize{ \item several namespace issues fixed } } \section{Changes in version 1.3-0}{ \itemize{ \item Bug fixed in \code{assoc()} \item \code{grid_legend()} extended for better finetuning of graphical parameters \item \code{legend_resbased()} better handles spacing for labels. \item \code{legend_resbased()} and \code{legend_fixed()} now allow changing the font family. \item default diagonal panel in \code{pairs()} is now set to \code{pairs_diagonal_mosaic()}, with alternating labels and frequencies shown on the bars. \item labeling is more customizable in \code{fourfold()} } } \section{Changes in version 1.2-13}{ \itemize{ \item \code{agreementplot()} now allows to add marginals to the plot \item \code{abbreviate} argument of \code{labeling_border()} renamed to \code{abbreviate_labs} to prevent name clash with \code{abbreviate_foo} args in \code{labeling_cells()} \item Several partial matches fixed in code } } \section{Changes in version 1.2-12}{ \itemize{ \item Bug fix: \code{assoc()} would not plot tables with 0 residuals \item Bug fix: \code{structable()} adds dimnames and dimname names if none are specified \item Bug fix: print error message when subsetting/selecting of structable objects using more than 2 indices \item \file{NEWS} file changed to .Rd format } } \section{Changes in version 1.2-11}{ \itemize{ \item Bug fix: \code{gamma} argument removed from \code{hcl2hex()} } } \section{Changes in version 1.2-10}{ \itemize{ \item Add aperm method for structable objects \item For use with \code{shading_Friendly()}, \code{shading_hsv()} now sets the line type of borders corresponding to \code{abs(residual) < eps} to \code{lty[1]} in addition to setting \code{color} to \code{line_color}. \item In \code{fourfold()}, modified default \code{colors[3:4]} for non-significant log odds ratios to be more visually distinct from the fully saturated \code{colors[5:6]} for significant ones. \item In \code{fourfold()}, allow the function to work with tables with more than 3 dimensions, by restructuring all strata dimensions into a single combined 3rd dimension. \item In \code{fourfold()}, modified defaults for \code{mfrow}/\code{mfcol} to give landscape display, \eqn{nr <= nc}, rather than \eqn{nr >= nc}. If \code{length(dim(x)) > 3}, set \code{nr=dim(x)[3]}. } } \section{Changes in version 1.2-9}{ \itemize{ \item Fixed \code{Ord_plot()} for devices where the default filling is \code{"white"} and not \code{"transparent"} by explicitly setting it to the latter. \item Bug fix in \code{as.table.structable()}, returning the table in a different order than defined in the structable object, confusing in particular \code{plot.structable()}. \item add parameter to \code{ternaryplot()} to control the positioning of the plot labels. } } \section{Changes in version 1.2-8}{ \itemize{ \item Small bug fixes in handling of some graphical parameters. } } \section{Changes in version 1.2-7}{ \itemize{ \item Corrected df handling in \code{goodfit()} with ML estimation: only non-zero cells are used. This is backward compatible with versions \eqn{<=} 1.2-4. \item Fixed bug in \code{goodfit()} for binomial distribution with specified \code{"size"} parameter (introduced in 1.2-5). } } \section{Changes in version 1.2-6}{ \itemize{ \item Small typo in doc of \code{co_table()}. } } \section{Changes in version 1.2-5}{ \itemize{ \item Bundesliga data set has been augmented with the results of the seasons 2006/7, 2007/8, 2008/9 (thanks to Torsten Hothorn). \item \code{goodfit()} was modified to treat zero cells better: \sQuote{Internal} zero cells (i.e., counts below the maximal observed count that did not occur in the sample) are retained (and not dropped as before). \sQuote{Trailing} zero cells (i.e., counts above the maximal observed count) are still not considered. The documentation now points out the problems with the minimum-chi-squared method in the latter situation. \item \code{sieve()} now accepts a \code{gp_tile} argument to control the appearance of the cells (apart from the sieve color) } } \section{Changes in version 1.2-4}{ \itemize{ \item Bug fix: labeling arguments were incorrectly handled when the options were not provided as named vector \item \code{ternaryplot()} now makes use of the \code{cex} argument also for the rendering of optional labels, if any } } \section{Changes in version 1.2-3}{ \itemize{ \item \file{hcl-colors.pdf} removed from source ball (vignette now in \cpkg{colorspace}) } } \section{Changes in version 1.2-2}{ \itemize{ \item \code{strucplot()} now accepts a \code{df} argument that is passed to the shading functions. Also, expected values are no longer computed if residuals are given. } } \section{Changes in version 1.2-1}{ \itemize{ \item Fixed a bug in labeling (incorrect handling of some parameters) } } \section{Changes in version 1.2-0}{ \itemize{ \item Moved color palettes from \cpkg{vcd} to \cpkg{colorspace}, including \code{vignette("hcl-colors")}. Package \cpkg{colorspace} is (as before) loaded automatically with \cpkg{vcd}. } } vcd/inst/doc/0000755000175000017500000000000014133313347012704 5ustar nileshnileshvcd/inst/doc/residual-shadings.R0000644000175000017500000001654214133313333016440 0ustar nileshnilesh### R code from vignette source 'residual-shadings.Rnw' ################################################### ### code chunk number 1: preliminaries ################################################### library("grid") library("vcd") rseed <- 1071 ################################################### ### code chunk number 2: Arthritis-data ################################################### data("Arthritis", package = "vcd") (art <- xtabs(~ Treatment + Improved, data = Arthritis, subset = Sex == "Female")) ################################################### ### code chunk number 3: Arthritis-classic (eval = FALSE) ################################################### ## mosaic(art) ## assoc(art) ################################################### ### code chunk number 4: Arthritis-classic1 ################################################### grid.newpage() pushViewport(viewport(layout = grid.layout(1, 2))) pushViewport(viewport(layout.pos.col=1, layout.pos.row=1)) mosaic(art, newpage = FALSE, margins = c(2.5, 4, 2.5, 3)) popViewport() pushViewport(viewport(layout.pos.col=2, layout.pos.row=1)) assoc(art, newpage = FALSE, margins = c(5, 2, 5, 4)) popViewport(2) ################################################### ### code chunk number 5: Arthritis-max ################################################### set.seed(rseed) (art_max <- coindep_test(art, n = 5000)) ################################################### ### code chunk number 6: Arthritis-sumsq ################################################### ss <- function(x) sum(x^2) set.seed(rseed) coindep_test(art, n = 5000, indepfun = ss) ################################################### ### code chunk number 7: Arthritis-extended (eval = FALSE) ################################################### ## mosaic(art, gp = shading_Friendly(lty = 1, eps = NULL)) ## mosaic(art, gp = shading_hsv, gp_args = list( ## interpolate = art_max$qdist(c(0.9, 0.99)), p.value = art_max$p.value)) ## set.seed(rseed) ## mosaic(art, gp = shading_max, gp_args = list(n = 5000)) ################################################### ### code chunk number 8: pistonrings-data ################################################### data("pistonrings", package = "HSAUR3") pistonrings ################################################### ### code chunk number 9: shadings ################################################### mymar <- c(1.5, 0.5, 0.5, 2.5) grid.newpage() pushViewport(viewport(layout = grid.layout(2, 3))) pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1)) mosaic(art, margins = mymar, newpage = FALSE, gp = shading_Friendly(lty = 1, eps = NULL)) popViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2)) mosaic(art, gp = shading_hsv, margins = mymar, newpage = FALSE, gp_args = list(interpolate = art_max$qdist(c(0.9, 0.99)), p.value = art_max$p.value)) popViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 3)) set.seed(rseed) mosaic(art, gp = shading_max, margins = mymar, newpage = FALSE, gp_args = list(n = 5000)) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 1)) mosaic(pistonrings, margins = mymar, newpage = FALSE, gp = shading_Friendly(lty = 1, eps = NULL, interpolate = c(1, 1.5))) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 2)) mosaic(pistonrings, gp = shading_hsv, margins = mymar, newpage = FALSE, gp_args = list(p.value = 0.069, interpolate = c(1, 1.5))) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 3)) mosaic(pistonrings, gp = shading_hcl, margins = mymar, newpage = FALSE, gp_args = list(p.value = 0.069, interpolate = c(1, 1.5))) popViewport(2) ################################################### ### code chunk number 10: pistonrings-inference ################################################### set.seed(rseed) coindep_test(pistonrings, n = 5000) set.seed(rseed) (pring_ss <- coindep_test(pistonrings, n = 5000, indepfun = ss)) ################################################### ### code chunk number 11: pistonrings-plot (eval = FALSE) ################################################### ## mosaic(pistonrings, gp = shading_Friendly(lty = 1, eps = NULL, interpolate = c(1, 1.5))) ## mosaic(pistonrings, gp = shading_hsv, gp_args = list(p.value = pring_ss$p.value, interpolate = c(1, 1.5))) ## mosaic(pistonrings, gp = shading_hcl, gp_args = list(p.value = pring_ss$p.value, interpolate = c(1, 1.5))) ################################################### ### code chunk number 12: alzheimer-data ################################################### data("alzheimer", package = "coin") alz <- xtabs(~ smoking + disease + gender, data = alzheimer) alz ################################################### ### code chunk number 13: alzheimer-plot1 ################################################### set.seed(rseed) cotabplot(~ smoking + disease | gender, data = alz, panel = cotab_coindep, n = 5000) ################################################### ### code chunk number 14: alzheimer-inference ################################################### set.seed(rseed) coindep_test(alz, 3, n = 5000) set.seed(rseed) coindep_test(alz, 3, n = 5000, indepfun = ss) set.seed(rseed) coindep_test(alz, 3, n = 5000, indepfun = ss, aggfun = sum) ################################################### ### code chunk number 15: alzheimer-plot (eval = FALSE) ################################################### ## set.seed(rseed) ## cotabplot(~ smoking + disease | gender, data = alz, panel = cotab_coindep, n = 5000) ################################################### ### code chunk number 16: Punishment-data ################################################### data("Punishment", package = "vcd") pun <- xtabs(Freq ~ memory + attitude + age + education, data = Punishment) ftable(pun, row.vars = c("age", "education", "memory")) ################################################### ### code chunk number 17: Punishment-assoc1 ################################################### set.seed(rseed) cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, n = 5000, type = "assoc", test = "maxchisq", interpolate = 1:2) ################################################### ### code chunk number 18: Punishment-mosaic1 ################################################### set.seed(rseed) cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, n = 5000, type = "mosaic", test = "maxchisq", interpolate = 1:2) ################################################### ### code chunk number 19: Punishment-inference ################################################### set.seed(rseed) coindep_test(pun, 3:4, n = 5000) set.seed(rseed) coindep_test(pun, 3:4, n = 5000, indepfun = ss) set.seed(rseed) coindep_test(pun, 3:4, n = 5000, indepfun = ss, aggfun = sum) ################################################### ### code chunk number 20: Punishment-assoc (eval = FALSE) ################################################### ## set.seed(rseed) ## cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, ## n = 5000, type = "assoc", test = "maxchisq", interpolate = 1:2) ################################################### ### code chunk number 21: Punishment-mosaic (eval = FALSE) ################################################### ## set.seed(rseed) ## cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, ## n = 5000, type = "mosaic", test = "maxchisq", interpolate = 1:2) vcd/inst/doc/strucplot.Rnw0000644000175000017500000031176312445055730015451 0ustar nileshnilesh\documentclass[nojss]{jss} %% need no \usepackage{Sweave} %% omit thumbpdf at the moment due to problems on some systems %% \usepackage{thumbpdf} %% almost as usual \author{David Meyer, Achim Zeileis, \textnormal{and} Kurt Hornik\\Wirtschaftsuniversit\"at Wien, Austria} \title{The Strucplot Framework:\\ Visualizing Multi-way Contingency Tables with \pkg{vcd}} %% for pretty printing and a nice hypersummary also set: \Plainauthor{David Meyer, Achim Zeileis, Kurt Hornik} %% comma-separated \Shorttitle{The Strucplot Framework} %% a short title (if necessary) \Plaintitle{The Strucplot Framework: Visualizing Multi-way Contingency Tables with vcd} %% an abstract and keywords \Abstract{ This paper has been published in the Journal of Statistical Software \citep{vcd:Meyer+Zeileis+Hornik:2006b} and describes the ``strucplot'' framework for the visualization of multi-way contingency tables. Strucplot displays include hierarchical conditional plots such as mosaic, association, and sieve plots, and can be combined into more complex, specialized plots for visualizing conditional independence, GLMs, and the results of independence tests. The framework's modular design allows flexible customization of the plots' graphical appearance, including shading, labeling, spacing, and legend, by means of ``graphical appearance control'' functions. The framework is provided by the \proglang{R} package \pkg{vcd}. } \Keywords{contingency tables, mosaic plots, association plots, sieve plots, categorical data, independence, conditional independence, HSV, HCL, residual-based shading, \pkg{grid}, \proglang{R}} \Plainkeywords{contingency tables, mosaic plots, association plots, sieve plots, categorical data, independence, conditional independence, HSV, HCL, residual-based shading, grid, R} \Address{ David Meyer\\ E-mail: \email{David.Meyer@R-project.org}\\ Achim Zeileis\\ E-mail: \email{Achim.Zeileis@R-project.org}\\ Kurt Hornik\\ E-mail: \email{Kurt.Hornik@R-project.org}\\ } \SweaveOpts{engine=R,eps=TRUE,height=6,width=7,results=hide,fig=FALSE,echo=TRUE,eps=FALSE} \setkeys{Gin}{width=0.7\textwidth} %\VignetteIndexEntry{The Strucplot Framework: Visualizing Multi-way Contingency Tables with vcd} %\VignetteDepends{vcd,grid} %\VignetteKeywords{contingency tables, mosaic plots, association plots, sieve plots, categorical data, independence, conditional independence, HSV, HCL, residual-based shading, grid, R} %\VignettePackage{vcd} <>= set.seed(1071) library(grid) library(vcd) data(Titanic) data(HairEyeColor) data(PreSex) data(Arthritis) art <- xtabs(~Treatment + Improved, data = Arthritis) @ \newcommand{\var}[1]{\textit{\texttt{#1}}} \newcommand{\data}[1]{\texttt{#1}} \newcommand{\class}[1]{\textsf{#1}} %% \code without `-' ligatures \def\nohyphenation{\hyphenchar\font=-1 \aftergroup\restorehyphenation} \def\restorehyphenation{\hyphenchar\font=`-} {\catcode`\-=\active% \global\def\code{\bgroup% \catcode`\-=\active \let-\codedash% \Rd@code}} \def\codedash{-\discretionary{}{}{}} \def\Rd@code#1{\texttt{\nohyphenation#1}\egroup} \newcommand{\codefun}[1]{\code{#1()}} %% end of declarations %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \begin{document} %% include your article here, just as usual %% Note that you should use the \pkg{}, \proglang{} and \code{} commands. \section[Introduction]{Introduction} %% Note: If there is markup in \(sub)section, then it has to be escape as above. In order to explain multi-dimensional categorical data, statisticians typically look for (conditional) independence structures. Whether the task is purely exploratory or model-based, techniques such as mosaic and association plots offer good support for visualization. Both visualize aspects of (possibly higher-dimensional) contingency tables, with several extensions introduced over the last two decades, and implementations available in many statistical environments. A \emph{mosaic plot} \citep{vcd:Hartigan+Kleiner:1984} is basically an area-proportional visualization of (typically, observed) frequencies, composed of tiles (corresponding to the cells) created by recursive vertical and horizontal splits of a rectangle. Thus, the area of each tile is proportional to the corresponding cell entry \emph{given} the dimensions of previous splits. An \emph{association plot} \citep{vcd:Cohen:1980} visualizes the standardized deviations of observed frequencies from those expected under a certain independence hypothesis. Each cell is represented by a rectangle that has (signed) height proportional to the residual and width proportional to the square root of the expected counts, so that the area of the box is proportional to the difference in observed and expected frequencies. Extensions to these techniques have mainly focused on the following aspects. \begin{enumerate} \item Varying the shape of bar plots and mosaic displays to yield, e.g., double-decker plots \citep{vcd:hofmann:2001}, spine plots, or spinograms \citep{vcd:hofmann+theus}. \item Using residual-based shadings to visualize log-linear models \citep{vcd:Friendly:1994,vcd:Friendly:2000} and significance of statistical tests \citep{vcd:Meyer+Zeileis+Hornik:2003,vcd:Zeileis+Meyer+Hornik:2007}. \item Using pairs plots and trellis-like layouts for marginal, conditional and partial views \citep{vcd:Friendly:1999}. \item Adding direct user interaction, allowing quick exploration and modification of the visualized models \citep{vcd:Unwin+Hawkins+Hofmann:1996,vcd:Theus:2003}. \item Providing a modular and flexible implementation to easily allow user extensions \citep{vcd:Meyer+Zeileis+Hornik:2003,vcd:Meyer+Zeileis+Hornik:2006b}. \end{enumerate} \noindent Current implementations of mosaic displays can be found, e.g., for \proglang{SAS} \citep{vcd:SAS:2005}, \pkg{ViSta} \citep{vcd:young:1996}, \pkg{MANET} \citep{vcd:Unwin+Hawkins+Hofmann:1996}, \pkg{Mondrian} \citep{vcd:Theus:2003}, \proglang{R} \citep{vcd:R:2006}, and \proglang{S-PLUS} \citep{vcd:SPLUS:2005}. For \proglang{R}, currently three implementations do exist in the packages \pkg{graphics} (in base \proglang{R}), \pkg{vcd} \citep{vcd:Meyer+Zeileis+Hornik:2006b}, and \pkg{iplots} \citep{vcd:urbanek+wichtrey:2006}, respectively. Table \ref{tab:compare} gives an overview of the available functionality in these systems. Most environments are available on Windows, MacOS, and Linux/Unix variants, except \pkg{MANET} which is only available for the Macinthosh platforms. \begin{table}[h] \centering \begin{tabular}{|l|c|c|c|c|c|c|c|c|c|} \hline & & &\multicolumn{3}{c|}{} & & &\\ & \proglang{SAS} & \proglang{S-PLUS} &\multicolumn{3}{c|}{\proglang{R}} & \pkg{ViSta} & \pkg{MANET} & \pkg{Mondrian}\\ & & &\pkg{base}&\pkg{vcd} &\pkg{iplots}& & &\\\hline Basic functionality & $\times$ & $\times$ & $\times$ &$\times$ &$\times$ & $\times$ & $\times$& $\times$\\ Shape & & & &$\times$ && $\times$ & $\times$&\\ Res.-based shadings & $\times$ & & $\times$ & $\times$ & ($\times$) & &($\times$)& ($\times$)\\ Highlighting & & & &$\times$ &$\times$ & $\times$ & $\times$& $\times$\\ Conditional views & $\times$ & & &$\times$ & & $\times$ & $\times$&\\ Interaction & & & & &$\times$ & $\times$ & $\times$& $\times$\\ Linking & & & & &$\times$ & $\times$ & $\times$& $\times$\\ Extensible design & & & &$\times$ & & & &\\ Language & \proglang{SAS} & \proglang{S} & \proglang{R} & \proglang{R} & \proglang{R}/\proglang{Java} & \proglang{XLisp} & \proglang{C++} & \proglang{Java}\\ \hline \end{tabular} \caption{Comparison of current software environments.} \label{tab:compare} \end{table} Figures \ref{fig:arthritis} to \ref{fig:titanic} illustrate some of these extensions. Figure~\ref{fig:arthritis} shows the results from a double-blind clinical trial investigating a new treatment for rheumatoid arthritis, using an extended mosaic plot with residual-based shading based on the maximum statistic: clearly, the new treatment is effective. The dark blue cell indicates that the rate of treated patients showing marked improvement is significant at the 1\% level. Figure \ref{fig:ucbadmissions} visualizes the well-known UCB admissions data by means of a conditional association plot. The panels show the residuals from a conditional independence model (independence of gender and admission, given department), stratified by department. Clearly, the situation in department A (more women/less men accepted than would be expected under the null hypothesis) causes the rejection of the hypothesis of conditional independence. Figure~\ref{fig:presex} illustrates the conditional independence of premarital and extramarital sex, given gender and marital status. The $\chi^2$ test of independence, based on the permutation distribution, rejects the null hypothesis: possibly, because the tendency of people to have extramarital sex when they had premarital sex is particularly marked among married people? The rate of such women and men ist significant at the 0.01 and 0.1 level, respectively. Finally, Figure~\ref{fig:titanic} visualizes the ``Survival on the Titanic'' data using a double-decker plot. Here, a binary response (survival of the disaster) is to be explained by other factors (class, gender, and age). The gray boxes represent the proportion of survived passengers in a particular stratum. The proportions of saved women and children are indeed higher than those of men, but they clearly decrease from the 1st to the 3rd class. In addition, the proportion of saved men in the 1st class is higher than in the others. \setkeys{Gin}{width=0.7\textwidth} \begin{figure}[p] \begin{center} <>= mosaic(art, gp = shading_max, split_vertical = TRUE) @ \caption{Mosaic plot for the \data{Arthritis} data.} \label{fig:arthritis} \end{center} \end{figure} \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= cotabplot(UCBAdmissions, panel = cotab_coindep, shade = TRUE, legend = FALSE, type = "assoc") @ \caption{Conditional association plot for the \data{UCBAdmissions} data.} \label{fig:ucbadmissions} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \begin{figure}[p] \begin{center} <>= presextest <- coindep_test(PreSex, margin = c(1,4), indepfun = function(x) sum(x^2), n = 5000) mosaic(PreSex, condvars = c(1, 4), shade = TRUE, gp_args = list(p.value = presextest$p.value)) @ \caption{Mosaic plot for the \data{PreSex} data.} \label{fig:presex} \end{center} \end{figure} \setkeys{Gin}{width=0.8\textwidth} \begin{figure}[p] \begin{center} <>= doubledecker(Survived ~ ., data = Titanic, labeling_args = list(set_varnames = c(Sex = "Gender"))) @ \caption{Double-decker plot for the \data{Titanic} data.} \label{fig:titanic} \end{center} \end{figure} This paper describes the strucplot framework provided by the \pkg{vcd} package for the \proglang{R} environment for statistical computing and graphics, available from the Comprehensive \proglang{R} Archive Network (\url{http://CRAN.R-project.org/}). The framework integrates displays such as mosaic, association, and sieve plots by their unifying property of being flat representations of contingency tables. These basic plots, as well as specialized displays for conditional independence, can be used both for exploratory visualization and model-based analysis. Exploratory techniques include specialized displays for the bivariate case, as well as pairs and trellis-type displays for higher-dimensional tables. Model-based tools include methods suitable for the visualization of conditional independence tests (including permutation tests), as well as for the visualization of particular GLMs (logistic regression, log-linear models). Additionally, two of the framework's further strengths are its flexibility and extensibility: graphical appearance aspects such as shading, labeling, and spacing are modularized by means of ``\underline{\vphantom{g}gr}aphical \underline{\vphantom{g}ap}pearance \underline{\vphantom{g}con}trol'' (\emph{grapcon}) functions, allowing fine-granular customization and user-level extensions. The remainder of the paper is organized as follows. In Section \ref{sec:strucplot}, we give an overview of the strucplot framework, describing the hierarchy of the main components and the basic functionality. In Section \ref{sec:shading}, we demonstrate how (residual-based) shadings support the visualization of log-linear models and the results of independence tests. Also, we explain step-by-step how the concepts of generating and grapcon functions can be combined to provide a flexible customization of complex graphical displays as created by the strucplot framework. Sections \ref{sec:labeling} and \ref{sec:spacing} discuss in detail the labeling and spacing features, respectively. Section \ref{sec:example} exemplifies the framework in the analysis of a four-way data set. Section \ref{sec:conclusion} concludes the work. \section[The strucplot framework]{The strucplot framework} \label{sec:strucplot} The strucplot framework in the \proglang{R} package \pkg{vcd}, used for visualizing multi-way contingency tables, integrates techniques such as mosaic displays, association plots, and sieve plots. The main idea is to visualize the tables' cells arranged in rectangular form. For multi-way tables, the variables are nested into rows and columns using recursive conditional splits, given the margins. The result is a ``flat'' representation that can be visualized in ways similar to a two-dimensional table. This principle defines a class of conditional displays which allows for granular control of graphical appearance aspects, including: \begin{itemize} \item the content of the tiles \item the split direction for each dimension \item the graphical parameters of the tiles' content \item the spacing between the tiles \item the labeling of the tiles \end{itemize} The strucplot framework is highly modularized: Figure~\ref{fig:struc} shows the hierarchical relationship between the various components. On the lowest level, there are several groups of workhorse and parameter functions that directly or indirectly influence the final appearance of the plot (see Table \ref{tab:grapcons} for an overview). These are examples of grapcon functions. They are created by generating functions (\emph{grapcon generators}), allowing flexible parameterization and extensibility (Figure~\ref{fig:struc} only shows the generators). The generator names follow the naming convention \code{\textit{group\_foo}()}, where \code{\textit{group}} reflects the group the generators belong to (strucplot core, labeling, legend, shading, or spacing). The workhorse functions (created by \code{struc\_\textit{foo}()}, \code{labeling\_\textit{foo}()}, and \code{legend\_\textit{foo}()}) directly produce graphical output (i.e., ``add ink to the canvas''), whereas the parameter functions (created by \code{spacing\_\textit{foo}()} and \code{shading\_\textit{foo}()}) compute graphical parameters used by the others. The grapcon functions returned by \code{struc\_\textit{foo}()} implement the core functionality, creating the tiles and their content. On the second level of the framework, a suitable combination of the low-level grapcon functions (or, alternatively, corresponding generating functions) is passed as ``hyperparameters'' to \codefun{strucplot}. This central function sets up the graphical layout using grid viewports (see Figure~\ref{fig:layout}), and coordinates the specified core, labeling, shading, and spacing functions to produce the plot. On the third level, we provide several convenience functions such as \codefun{mosaic}, \codefun{sieve}, \codefun{assoc}, and \codefun{doubledecker} which interface \codefun{strucplot} through sensible parameter defaults and support for model formulae. Finally, on the fourth level, there are ``related'' \pkg{vcd} functions (such as \codefun{cotabplot} and the \codefun{pairs} methods for table objects) arranging collections of plots of the strucplot framework into more complex displays (e.g., by means of panel functions). \begin{table} \begin{tabular}{|l|l|l|} \hline \textbf{Group} & \textbf{Grapcon generator} & \textbf{Description}\\\hline strucplot & \codefun{struc\_assoc} & core function for association plots\\ core & \codefun{struc\_mosaic} & core function for mosaic plots\\ & \codefun{struc\_sieve} & core function for sieve plots\\\hline\hline labeling & \codefun{labeling\_border} & border labels\\ & \codefun{labeling\_cboxed} & centered labels with boxes, all labels clipped,\\ && and on top and left border\\ & \codefun{labeling\_cells} & cell labels\\ & \codefun{labeling\_conditional} & border labels for conditioning variables\\ && and cell labels for conditioned variables\\ & \codefun{labeling\_doubledecker} & draws labels for doubledecker plot\\ & \codefun{labeling\_lboxed} & left-aligned labels with boxes\\ & \codefun{labeling\_left} & left-aligned border labels\\ & \codefun{labeling\_left2} & left-aligned border labels, all labels on top and left border\\ & \codefun{labeling\_list} & draws a list of labels under the plot\\\hline\hline shading & \codefun{shading\_binary} & visualizes the sign of the residuals\\ & \codefun{shading\_Friendly} & implements Friendly shading (based on HSV colors)\\ & \codefun{shading\_hcl} & shading based on HCL colors\\ & \codefun{shading\_hsv} & shading based on HSV colors\\ & \codefun{shading\_max} & shading visualizing the maximum test statistic\\ && (based on HCL colors)\\ & \codefun{shading\_sieve} & implements Friendly shading customized for sieve plots\\ && (based on HCL colors)\\\hline\hline spacing & \codefun{spacing\_conditional} & increasing spacing for conditioning variables,\\&& equal spacing for conditioned variables\\ & \codefun{spacing\_dimequal} & equal spacing for each dimension\\ & \codefun{spacing\_equal} & equal spacing for all dimensions\\ & \codefun{spacing\_highlighting} & increasing spacing, last dimension set to zero\\ & \codefun{spacing\_increase} & increasing spacing\\\hline\hline legend & \codefun{legend\_fixed} & creates a fixed number of bins (similar to \codefun{mosaicplot})\\ & \codefun{legend\_resbased} & suitable for an arbitrary number of bins\\&& (also for continuous shadings)\\\hline \end{tabular} \caption{Available grapcon generators in the strucplot framework} \label{tab:grapcons} \end{table} \begin{figure}[h] \begin{center} \includegraphics[width=0.8\textwidth]{struc} \caption{Components of the strucplot framework.} \label{fig:struc} \end{center} \end{figure} \setkeys{Gin}{width=0.6\textwidth} \begin{figure}[h] \begin{center} <>= pushViewport(vcd:::vcdViewport(legend = T, mar =4)) seekViewport("main") grid.rect(gp = gpar(lwd = 3)) grid.text("main", gp = gpar(fontsize = 20)) seekViewport("sub") grid.rect(gp = gpar(lwd = 3)) grid.text("sub", gp = gpar(fontsize = 20)) seekViewport("plot") grid.rect(gp = gpar(lwd = 3)) grid.text("plot", gp = gpar(fontsize = 20)) seekViewport("legend") grid.text("legend", rot = 90, gp = gpar(fontsize = 20)) grid.rect(gp = gpar(lwd = 3)) seekViewport("legend_sub") grid.rect(gp = gpar(lwd = 3)) grid.text("[F]", gp = gpar(fontsize = 20)) seekViewport("legend_top") grid.rect(gp = gpar(lwd = 3)) grid.text("[E]", gp = gpar(fontsize = 20)) seekViewport("margin_top") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_top", gp = gpar(fontsize = 20)) seekViewport("margin_bottom") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_bottom", gp = gpar(fontsize = 20)) seekViewport("margin_right") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_right", rot = 90, gp = gpar(fontsize = 20)) seekViewport("margin_left") grid.rect(gp = gpar(lwd = 3)) grid.text("margin_left", rot = 90, gp = gpar(fontsize = 20)) seekViewport("corner_top_left") grid.rect(gp = gpar(lwd = 3)) grid.text("[A]", gp = gpar(fontsize = 20)) seekViewport("corner_top_right") grid.rect(gp = gpar(lwd = 3)) grid.text("[B]", gp = gpar(fontsize = 20)) seekViewport("corner_bottom_left") grid.rect(gp = gpar(lwd = 3)) grid.text("[C]", gp = gpar(fontsize = 20)) seekViewport("corner_bottom_right") grid.rect(gp = gpar(lwd = 3)) grid.text("[D]", gp = gpar(fontsize = 20)) @ \caption{Viewport layout for strucplot displays with their names. [A] = ``corner\_top\_left'', [B] = ``corner\_top\_right'', [C] = ``corner\_bottom\_left'', [D] = ``corner\_bottom\_right'', [E] = ``legend\_top'', [F] = ``legend\_sub''.} \label{fig:layout} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \subsection{Mosaic, association, and sieve plots} As an example, consider the \data{HairEyeColor} data containing two polytomous variables (hair and eye color), as well as one (artificial) dichotomous gender variable (\code{Sex}). The ``flattened'' contingency table can be obtained using the \codefun{structable} function (quite similar to \codefun{ftable} in base \proglang{R}, but allowing the specification of split directions): <>= (HEC <- structable(Eye ~ Sex + Hair, data = HairEyeColor)) @ Let us first visualize the contingency table by means of a mosaic plot. % \citep{vcd:Hartigan+Kleiner:1984} which is basically % an area-proportional visualization of (typically, observed) frequencies, composed % of tiles (corresponding to the cells) created by recursive % vertical and horizontal splits of a square. Thus, the area of each tile % is proportional to the corresponding cell entry \emph{given} the % dimensions of previous splits. The effect of <>= mosaic(HEC) @ \noindent equivalent to <>= mosaic(~ Sex + Eye + Hair, data = HairEyeColor) @ %\setkeys{Gin}{width=0.75\textwidth} \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{HairEyeColor} data.} \label{fig:observed} \end{center} \end{figure} \noindent depicts the observed frequencies of the \code{HairEyeColor} data. If there are zero entries, tiles have zero area and are, additionally, marked by small bullets (see, e.g, Figure~\ref{fig:titanic}). By default, these cells are not split further. The bullets help distinguishing very small cells from zero entries, and are particularly useful when color shadings come into play (see the example using the \data{Bundesliga} data in Section \ref{sec:overview}). Note that in contrast to, e.g., \codefun{mosaicplot} in base \proglang{R}, the default split direction and level ordering in all strucplot displays correspond to the textual representation produced by the print methods. It is also possible to visualize the expected values instead of the observed values (see Figure~\ref{fig:expected}): <>= mosaic(HEC, type = "expected") @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{HairEyeColor} data (expected values).} \label{fig:expected} \end{center} \end{figure} %\setkeys{Gin}{width=0.7\textwidth} \noindent In order to compare observed and expected values, a sieve plot \citep{vcd:riedwyl+schuepbach:1994} could be used (see Figure~\ref{fig:sieve}): <>= sieve(~ Sex + Eye + Hair, data = HEC, spacing = spacing_dimequal(c(2,0,0))) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{Sieve plot for the \data{HairEyeColor} data visualizing simultaneously observed and expected values.} \label{fig:sieve} \end{center} \end{figure} \noindent where \code{spacing\_dimequal} is used to set the spacing of the second and third dimension to zero. Alternatively, we can directly inspect the residuals. The Pearson residuals (standardized deviations of observed from expected values) are conveniently visualized using association plots \citep{vcd:Cohen:1980}. In contrast to \codefun{assocplot} in base \proglang{R}, \pkg{vcd}'s \codefun{assoc} function scales to more than two variables (see Figure~\ref{fig:residuals}): <>= assoc(HEC, compress = FALSE) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Association plot for the \data{HairEyeColor} data.} \label{fig:residuals} \end{center} \end{figure} \noindent where the \code{compress} argument keeps distances between tiles equal. For both mosaic plots and association plots, the splitting of the tiles can be controlled using the \code{split\_vertical} argument. The default is to alternate splits starting with a horizontal one (see Figure~\ref{fig:split}): <>= options(width=60) @ <>= mosaic(HEC, split_vertical = c(TRUE, FALSE, TRUE), labeling_args = list(abbreviate_labs = c(Eye = 3))) @ <>= options(width=70) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{HairEyeColor} data---alternative splitting.} \label{fig:split} \end{center} \end{figure} \noindent (Note that \code{HEC}, a \class{structable} object, already includes a splitting information which simply gets overloaded in this example.) For compatibility with \codefun{mosaicplot} in base \proglang{R}, the \codefun{mosaic} function also allows the use of a \code{direction} argument taking a vector of \code{"h"} and \code{"v"} characters: <>= mosaic(HEC, direction = c("v","h","v")) @ By a suitable combination of splitting, spacing, and labeling settings, the functions provided by the strucplot framework can be customized in a quite flexible way. For example, the default method for \codefun{doubledecker} is simply a wrapper for \codefun{strucplot}, setting the right defaults. Most default settings such as colors, spacing, and labeling are specified via the parameters and passed through to \codefun{strucplot}. The additional code just handles the dependent variable information, and in particular permutes the table to have the dependent variable as the last dimension as required for the doubledecker plot. Figure~\ref{fig:titanic} shows a doubledecker plot of the \data{Titanic} data, explaining the probability of survival (``survived'') by age, given sex, given class. It is created by: <>= doubledecker(Titanic) @ \noindent equivalent to: <>= doubledecker(Survived ~ Class + Sex + Age, data = Titanic) @ \subsection{Conditional and partial views} So far, we have visualized either full or collapsed tables, as suggested by the analysis task at hand. Subtables can be selected in a similar way as for objects of class \class{table} using indexing. Note, however, that subsetting of \class{structable} objects is more restrictive because of their inherent conditional structure. Since the variables on both the row and the columns side are nested, subsetting is only possible ``outside-in'', that is, indexing operates on blocks defined by the variable levels. In the following, we use the Titanic data again, this time collapsed over \code{Survived} to investigate the structure of crew and passengers (and having the \code{Child} and \code{Age} labels of the \code{Age} variable swapped for optical clarity): <>= options(width=75) @ <>= (STD <- structable(~ Sex + Class + Age, data = Titanic[,,2:1,])) STD["Male",] STD["Male", c("1st","2nd","3rd")] @ <>= options(width=70) @ \noindent \emph{Conditioning} on levels (i.e., choosing a table subset for fixed levels of the conditioning variable(s)) is done using the \code{[[} operator. %]] Here again, the sequence of conditioning levels is restricted by the hierarchical structure of the \class{structable} object. In the following examples, note that compared to subsetting, the first dimension(s) are dropped: <>= STD[["Male",]] STD[[c("Male", "Adult"),]] STD[["Male","1st"]] @ \noindent Now, there are several ways for visualizing conditional independence structures. The ``brute force'' method is to draw separate plots for the strata. The following example compares the association between hair and eye color, given gender, by using subsetting on the flat table and \pkg{grid}'s viewport framework to visualize the two groups besides each other: <>= pushViewport(viewport(layout = grid.layout(ncol = 2))) @ <>= pushViewport(viewport(layout.pos.col = 1)) mosaic(STD[["Male"]], margins = c(left = 2.5, top = 2.5, 0), sub = "Male", newpage = FALSE) popViewport() @ <>= pushViewport(viewport(layout.pos.col = 2)) mosaic(STD[["Female"]], margins = c(top = 2.5, 0), sub = "Female", newpage = FALSE) popViewport(2) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= <> <> <> @ \caption{Two mosaic displays put side-by-side, visualizing the distribution of class and age, given gender. The marginal distribution of gender cannot be seen.} \label{fig:parttable} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent Note the use of the \code{margins} argument: it takes a vector with up to four values whose unnamed components are recycled, but ``overruled'' by the named arguments. Thus, in the second example, only the top margin is set to 2.5 lines, and all other to 0. This idea applies to almost all vectorized arguments in the strucplot framework (with \code{split\_vertical} as a prominent exception). The \codefun{cotabplot} function does a much better job on this task: it arranges stratified strucplot displays in a lattice-like layout, conditioning on variable \emph{levels}. The plot in Figure~\ref{fig:cotabplot} shows class and age group, given sex: <>= cotabplot(~ Class + Age | Sex, data = STD, split_vertical = TRUE) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= <> @ \caption{Conditional table plot for the \data{Titanic} data, again visualizing the distribution of age and class, given gender, using separate mosaic displays like the ``manual'' plot in Figure~\ref{fig:parttable}.} \label{fig:cotabplot} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} %\noindent The \code{labeling\_args} argument modifies the labels' %appearance: here, to be left-aligned and unclipped %(see Section \ref{sec:labeling}). \noindent Visualizing the strata separately ``hides'' the distribution of the conditioning variable(s) which may or may not be appropriate or sensible in a particular analysis step. If we wish to keep the information on the marginal distribution(s), we can use one single mosaic for the stratified plot since mosaic displays are ``conditional plots'' by definition. We just need to make sure that conditioning variables are used first for splitting. Both the default and the formula interface of \codefun{mosaic} allow the specification of conditioning variables (see Figure~\ref{fig:conditioning}): <>= mosaic(STD, condvars = "Sex", split_vertical = c(TRUE, TRUE, FALSE)) @ <>= mosaic(~ Class + Age | Sex, data = STD, split_vertical = c(TRUE, TRUE, FALSE)) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[h] \begin{center} <>= <> @ \caption{Mosaic plot again visualizing the distribution of class and age, given gender, this time using a single mosaic plot. In contrast to Figures~\ref{fig:parttable} and \ref{fig:cotabplot}, this plot also visualizes the marginal distribution of gender.} \label{fig:conditioning} \end{center} \end{figure} \setkeys{Gin}{width=0.7} \noindent The effect of using this is that conditioning variables are permuted ahead of the the conditioned variables in the table, and that \codefun{spacing\_conditional} is used as default to better distinguish conditioning from conditioned dimensions. This spacing uses equal space between tiles of conditioned variables, and increasing space between tiles of conditioning variables (See Section~\ref{sec:spacing}). Another set of high-level functions for visualizing conditional independence models are the \codefun{pairs} methods for \class{table} and \class{structable} objects. In contrast to \codefun{cotabplot} which conditions on variables, the \codefun{pairs} methods create pairwise views of the table. They produce, by default, a plot matrix having strucplot displays in the off-diagonal panels, and the variable names (optionally, with univariate displays) in the diagonal cells. Figure~\ref{fig:pairs} shows a pairs display for the \data{Titanic} data with univariate mosaics in the diagonal, and mosaic plots visualizing the corresponding bivariate mosaics in the upper and lower triangles. Due to the inherent asymmetry of mosaic displays, the corresponding plots in the upper and lower triangle differ depending on which variable is used first for splitting---inspecting both views might help detecting patterns in a data set. Additionally, we are using a special spacing and shading normally used to `highlight' %' the second variable in the first (as will be discussed in Section \ref{sec:spacing}): here, the intention of the spacing is to emphasize the conditional distributions of the second variable, given the first one, and the shading helps identifying the factor levels in the second variable. <>= pairs(STD, highlighting = 2, diag_panel = pairs_diagonal_mosaic, diag_panel_args = list(fill = grey.colors)) @ %\setkeys{Gin}{width=\textwidth} \setkeys{Gin}{width=0.7\textwidth} \begin{figure}[h] \begin{center} <>= <> @ \caption{Pairs plot for the \data{Titanic} data.} \label{fig:pairs} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent The labels of the variables are to be read from left to right and from top to bottom. In addition, the levels can be matched by position within the columns and by shading within the rows. In plots produced by \codefun{pairs}, each panel's row and column define two variables $X$ and $Y$ used for the specification of four different types of independence: pairwise, total, conditional, and joint. The pairwise mosaic matrix shows bivariate marginal relations between $X$ and $Y$, collapsed over all other variables. The total independence mosaic matrix shows mosaic plots for mutual independence, i.e., for marginal and conditional independence among all pairs of variables. The conditional independence mosaic matrix shows mosaic plots for marginal independence of $X$ and $Y$, given all other variables. The joint independence mosaic matrix shows mosaic plots for joint independence of all pairs ($X$, $Y$) of variables from the others. Upper and lower parts can independently be used to display different types of independence models, or different strucplot displays (mosaic, association, or sieve plots). The available panel functions (\codefun{pairs\_assoc}, \codefun{pairs\_mosaic}, and \codefun{pairs\_sieve}) are simple wrappers to \codefun{assoc}, \codefun{mosaic}, and \codefun{sieve}, respectively. Obviously, seeing patterns in strucplot matrices becomes increasingly difficult with higher dimensionality. Therefore, this plot is typically used with a suitable residual-based shading (see Section \ref{sec:shading}). \subsection{Interactive plot modifications} All strucplot core functions are supposed to produce conditional hierarchical plots by the means of nested viewports, corresponding to the provided splitting information. Thus, at the end of the plotting, each tile is associated with a particular viewport. Each of those viewports has to be conventionally named, enabling other strucplot modules, in particular the labeling functions, to access specific tiles after they have been plotted. The naming convention for the viewports is: \begin{center} \code{\emph{[Optional prefix]}cell:\emph{Variable1}=\emph{Level1},\emph{Variable2}=\emph{Level2}} \dots \end{center} \noindent Clearly, these names depend on the splitting. The following example shows how to access parts of the plot after it has been drawn (see Figure~\ref{fig:afterplot}): <>= mosaic(~ Hair + Eye, data = HEC, pop = FALSE) seekViewport("cell:Hair=Blond") grid.rect(gp = gpar(col = "red", lwd = 4)) seekViewport("cell:Hair=Blond,Eye=Blue") grid.circle(r = 0.2, gp = gpar(fill = "cyan")) @ \noindent Note that the viewport tree is removed by default. Therefore, the \texttt{pop} argument has to be set to \texttt{FALSE} when viewports shall be accessed. \setkeys{Gin}{width=0.6\textwidth} \begin{figure}[h] \begin{center} <>= <> @ \caption{Adding elements to a mosaic plot after drawing.} \label{fig:afterplot} \end{center} \end{figure} In addition to the viewports, the main graphical elements get names following a similar construction method. This allows to change graphical parameters of plot elements \emph{after} the plotting (see Figure~\ref{fig:changeplot}): <>= assoc(Eye ~ Hair, data = HEC, pop = FALSE) getNames()[1:6] grid.edit("rect:Hair=Blond,Eye=Blue", gp = gpar(fill = "red")) @ %% code-chunk reuse does not work with parameter changing \begin{figure}[h] \begin{center} <>= x <- tab <- margin.table(HairEyeColor, 1:2) x[] <- "light gray" x["Blond","Blue"] <- "Red" assoc(tab, gp = gpar(fill = x)) @ \caption{Changing graphical parameters of elements after drawing.} \label{fig:changeplot} \end{center} \end{figure} \subsection{Performance issues} \label{sec:performance} As stated above, the implementation of strucplot displays is based on creating and nesting \pkg{grid} viewports. The main time-consuming steps performed by the core functions are the following: \begin{enumerate} \item recursively, split the table until the individual cells are reached \item during the splits, add viewports to the plot \item for the individual cells, add plot-specific content (rectangles for mosaics, bars for association plots, etc.) \end{enumerate} \noindent All these operations scale linearly with the amount of created viewports. For a $d$-dimensional table with $k_i$ levels, $i=1 \dots d$, the total number of needed viewports $T_d$ can roughly be estimated as \begin{equation} \label{eq:numbervp} T_d \quad = \quad k_1 + k_1k_2 + \cdots + k_1 \cdots k_d \quad =\quad \sum_{i=1}^d \prod_{j \le i} k_j \end{equation} \noindent since we first push the $k_1$ viewports for the levels of the first dimension, then, for \emph{each} of these, the $k_2$ levels of the second dimension, etc. If the number of levels is equal ($k$) for all dimensions, $T_d$ simplifies to \begin{equation} \label{eq:equalvp} T_d \quad = \quad \sum_{i=1}^d k^i = \frac{k(k^d-1)}{k-1} \end{equation} \noindent and so the time complexity for drawing a strucplot display is of order $k^d$. \section{Shadings} \label{sec:shading} Unlike other graphics functions in base \proglang{R}, the strucplot framework allows almost full control over the graphical parameters of all plot elements. In particular, in association plots, mosaic plots, and sieve plots, the user can modify the graphical appearance of each tile individually. Built on top of this functionality, the framework supplies a set of shading functions choosing colors appropriate for the visualization of log-linear models. The tiles' graphical parameters are set using the \code{gp} argument of the functions of the strucplot framework. This argument basically expects an object of class \class{gpar} whose components are arrays of the same shape (length and dimensionality) as the data table (see Section \ref{sec:gp}). For convenience, however, the user can also supply a grapcon function that computes such an object given a vector of residuals, or, alternatively, a generating function that takes certain arguments and returns such a grapcon function (see Section \ref{sec:shadingcustom}). We provide several shading functions, including support for both HSV and HCL colors, and the visualization of significance tests (see Section \ref{sec:overview}). \subsection{Specifying graphical parameters of strucplot displays} \label{sec:gp} As an example, consider the \data{UCBAdmissions} data. In the table aggregated over departments, we would like to highlight the (incidentally wrong) impression that there were too many male students accepted compared to the presumably discriminated female students (see Figure~\ref{fig:ucb}): <>= (ucb <- margin.table(UCBAdmissions, 1:2)) (fill_colors <- matrix(c("dark cyan","gray","gray","dark magenta"), ncol = 2)) mosaic(ucb, gp = gpar(fill = fill_colors, col = 0)) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{UCBAdmissions} data with highlighted cells.} \label{fig:ucb} \end{center} \end{figure} \noindent As the example shows, we create a fourfold table with appropriate colors (dark cyan for admitted male students and dark magenta for rejected female students) and supply them to the \code{fill} component of the \class{gpar} object passed to the \code{gp} argument of \codefun{mosaic}. For visual clarity, we additionally hide the tiles' borders by setting the \code{col} component to 0 (transparent). If the parameters specified in the \class{gpar} object are ``incomplete'', they will be recycled along the last splitting dimension. In the following example based on the \data{Titanic} data, we will highlight all cells corresponding to survived passengers (see Figure~\ref{fig:recycling}): <>= mosaic(Titanic, gp = gpar(fill = c("gray","dark magenta")), spacing = spacing_highlighting, labeling_args = list(abbreviate_labs = c(Age = 3), rep = c(Survived = FALSE)) ) @ \noindent Note that \codefun{spacing\_highlighting} sets the spaces between tiles in the last dimension to 0. The \code{labeling\_args} argument ensures that labels do not overlap (see Section \ref{sec:labeling}). \begin{figure}[h] \begin{center} <>= <> @ \caption{Recycling of parameters, used for highlighting the survived passengers in the \data{Titanic} data.} \label{fig:recycling} \end{center} \end{figure} \subsection{Customizing residual-based shadings} \label{sec:shadingcustom} This flexible way of specifying graphical parameters is the basis for a suite of shading functions that modify the tiles' appearance with respect to a vector of residuals, resulting from deviations of observed from expected frequencies under a given log-linear model. The idea is to visualize at least sign and absolute size of the residuals, but some shadings, additionally, indicate overall significance. One particular shading, the maximum shading \citep{vcd:Meyer+Zeileis+Hornik:2003,vcd:Zeileis+Meyer+Hornik:2007}, even allows to identify the cells that cause the rejection of the null hypothesis. Conceptually, the strucplot framework offers three alternatives to add residual-based shading to plots: \begin{enumerate} \item Precomputing the graphical parameters (e.g., fill colors), encapsulating them into an object of class \class{gpar} as demonstrated in the previous section, and passing this object to the \code{gp} argument. \item Providing a grapcon function to the \code{gp} argument that takes residuals as input and returns an object as described in alternative 1. \item Providing a grapcon generator taking parameters and returning a function as described in alternative~2. \end{enumerate} \noindent For each of these approaches, we will demonstrate the necessary steps to obtain a binary shading that visualizes the sign of the residuals by a corresponding fill color (for simplicity, we will treat 0 as positive). \subsubsection*{Alternative 1: Precomputed \class{gpar} object} The first method is precomputing the graphical parameters ``by hand''. We will use \code{royalblue4} color for positive and \code{mediumorchid4} color for negative residuals (see Figure~\ref{fig:binary}): <>= expected <- independence_table(ucb) (x <- (ucb - expected) / sqrt(expected)) (shading1_obj <- ifelse(x > 0, "royalblue4", "mediumorchid4")) mosaic(ucb, gp = gpar(fill = shading1_obj)) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{Binary shading visualizing the sign of the residuals.} \label{fig:binary} \end{center} \end{figure} \subsubsection*{Alternative 2: Grapcon function} For implementing alternative 2, we need to create a ``shading function'' that computes \class{gpar} objects from residuals. For that, we can just reuse the code from the previous step: <>= shading2_fun <- function(x) gpar(fill = ifelse(x > 0, "royalblue4", "mediumorchid4")) @ \noindent To create a mosaic display with binary shading, it now suffices to specify the data table along with \codefun{shading2\_fun}: <>= mosaic(ucb, gp = shading2_fun) @ \noindent \codefun{mosaic} internally calls \codefun{strucplot} which computes the residuals from the specified independence model (total independence by default), passes them to \codefun{shading2\_fun}, and uses the \class{gpar} object returned to finally create the plot. Our \codefun{shading2\_fun} function might be useful, but can still be improved: the hard-wired colors should be customizable. We cannot simply extend the argument list to include, e.g., a \code{fill = c("royalblue4", "mediumorchid4")} argument because \codefun{strucplot} will neither know how to handle it, nor let us change the defaults. In fact, the interface of shading functions is fixed, they are expected to take exactly one argument: a table of residuals. This is where generating functions (alternative 3) come into play. \subsubsection*{Alternative 3: Grapcon generator} We simply wrap our grapcon shading function in another function that takes all additional arguments it needs to use, possibly preprocesses them, and returns the actual shading function. This returned function will have access to the parameters since in \proglang{R}, nested functions are lexically scoped. Thus, the grapcon generator returns (``creates'') a ``parameterized'' shading function with the minimal standard interface \codefun{strucplot} requires. The following example shows the necessary extensions for our running example: <>= shading3a_fun <- function(col = c("royalblue4", "mediumorchid4")) { col <- rep(col, length.out = 2) function(x) gpar(fill = ifelse(x > 0, col[1], col[2])) } @ \noindent The first statement just makes sure that exactly two colors are specified. In the call to \codefun{mosaic}, using the new \codefun{shading3a\_fun} function, we can now simply change the colors: <>= mosaic(ucb, gp = shading3a_fun(c("royalblue4","mediumorchid4"))) @ \noindent (figure not shown). The procedure described so far is a rather general concept, applicable to a wide family of user-level \pkg{grid} graphics. Indeed, the customization of other components of the strucplot framework (labeling, spacing, legend, and core functions) follows the same idea. Now for the shading functions, more customization is needed. Note that \codefun{shading3a\_fun} needs to be evaluated by the user, even if the defaults are to be used. It is a better idea to let \codefun{strucplot} call the generating function, which, in particular, allows the passing of arguments that are computed by \codefun{strucplot}. Since shading functions can be used for visualizing significance (see Section \ref{sec:overview}), it makes sense for generating functions to have access to the model, i.e., observed and expected values, residuals, and degrees of freedom. For example, the \codefun{shading\_max} generating function computes a permutation distribution of the maximum statistic and $p$ values for specified significance levels based on the observed table to create data-driven cut-off points. If this was done in the shading function itself, the permutation statistic would be recomputed every time the shading function is called, resulting in possibly severe performance loss and numerical inconsistencies. Therefore, generating functions for shadings are required to take at least the parameters \code{observed}, \code{expected}, \code{residuals}, and \code{df} (these are provided by the strucplot framework), followed by other parameters controlling the shading appearance (to be specified by the user): <>= shading3b_fun <- function(observed = NULL, residuals = NULL, expected = NULL, df = NULL, col = c("royalblue4", "mediumorchid4")) { col <- rep(col, length.out = 2) function(x) gpar(fill = ifelse(x > 0, col[1], col[2])) } class(shading3b_fun) <- "grapcon_generator" @ Note that in this simple binary shading example, the first four parameters are not used. In some sense, generating functions for shadings are parameterized both by the user and the strucplot framework. For shading functions that require model information, the user-specified parameters are to be passed to the \code{gp\_args} argument instead, and for this to work, the generating function needs a class attribute to be distinguishable from the ``normal'' shading functions. For others (like our simple \codefun{shading3b\_fun}) this is optional, but recommended for consistency: <>= mosaic(ucb, gp = shading3b_fun, gp_args = list(col = c("red","blue"))) @ \noindent The final \codefun{shading3b\_fun} pretty much resembles \codefun{shading\_binary}, one of the standard shading functions provided by the \pkg{vcd} package. \subsection[An overview of the shading functions in vcd]{An overview of the shading functions in \pkg{vcd}} \label{sec:overview} \cite{vcd:Friendly:1994} suggested a residual-based shading for the mosaic tiles that can also be applied to the rectangles in association plots \citep{vcd:Meyer+Zeileis+Hornik:2003}. Apart from \codefun{shading\_binary}, there are currently two basic shadings available in \pkg{vcd}: \codefun{shading\_hcl} and \codefun{shading\_hsv}, as well as two derived functions: \codefun{shading\_Friendly} building upon \codefun{shading\_hsv}, and \codefun{shading\_max} building upon \codefun{shading\_hcl}. \codefun{shading\_hsv} and \codefun{shading\_hcl} provide the same conceptual tools, but use different color spaces: the Hue-Saturation-Value (HSV) and the Hue-Chroma-Luminance (HCL) scheme, respectively. We will first expose the basic concept of these shading functions using HSV space, and then briefly explain the differences to HCL space \citep[a detailed discussion can be found in][]{vcd:Zeileis+Meyer+Hornik:2007}. Color palettes in HCL space are preferable to palettes derived from HSV space from a perceptual point of view. Functions for creating palettes (see, e.g., \codefun{diverge\_hcl}) are provided with the \pkg{vcd} package. In HSV space, colors are specified in three dimensions: Hue, Saturation (``colorfulness''), and Value (``lightness'', amount of gray). These three dimensions are used by \codefun{shading\_hsv} to visualize information about the residuals and the underlying independence model. The hue indicates the residuals' sign: by default, blue for positive, and red for negative residuals. The saturation of a residual is set according to its size: high saturation for large, and low saturation for small residuals. Finally, the overall lightness is used to indicate the significance of a test statistic: light colors for significant, and dark colors for non-significant results. As an example, we will visualize the association of hair and eye color in the \data{HairEyeColor} data set (see Figure~\ref{fig:haireye}, top): <>= haireye <- margin.table(HairEyeColor, 1:2) mosaic(haireye, gp = shading_hsv) @ \noindent As introduced before, the default shading scheme is not \codefun{shading\_hsv} but \codefun{shading\_hcl} due to the better perceptual characteristics of HCL color space. The following example again illustrates the \data{HairEyeColor} data, this time with HCL colors: <>= mosaic(haireye, gp = shading_hcl) @ <>= mosaic(haireye, gp = shading_hcl, gp_args = list(h = c(130, 43), c = 100, l = c(90, 70))) @ \noindent In Figure~\ref{fig:haireye}, the plot in the middle depicts the default palette, and the bottom plot an alternative setting for Hue (\code{h}), Chroma (\code{c}), and Luminance (\code{l}). \setkeys{Gin}{width=0.5\textwidth} \begin{figure}[htbp] \begin{center} <>= mosaic(haireye, gp = shading_hsv, margin = c(bottom = 1), keep_aspect_ratio = FALSE) @ <>= mosaic(haireye, gp = shading_hcl, margin = c(bottom = 1), keep_aspect_ratio = FALSE) @ <>= mosaic(haireye, gp = shading_hcl, margin = c(bottom = 1), gp_args = list(h = c(130, 43), c = 100, l = c(90, 70)), keep_aspect_ratio = FALSE) @ \caption{Three mosaic plots for the \data{HairEyeColor} data using different color palettes. Top: default HSV color palette. Middle: default HCL color palette. Bottom: a custom HCL color palette.} \label{fig:haireye} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent Large positive residuals (greater than $4$) can be found for brown eyes/black hair and blue eyes/blond hair, and are colored in deep blue. On the other hand, there is a large negative residual (less than $-4$) for brown eyes/blond hair, colored deep red. There are also three medium-sized positive (negative) residuals between 2 and 4 ($-2$ and $-4$): the colors for them are less saturated. Residuals between $-2$ and $2$ are shaded in white (gray for HCL-shading). The heuristic for choosing the cut-off points $2$ and $4$ is that the Pearson residuals are approximately standard normal which implies that the highlighted cells are those with residuals \emph{individually} significant at approximately the $\alpha = 0.05$ and $\alpha = 0.0001$ levels, respectively. These default cut-off points can be changed to alternative values using the \code{interpolate} argument (see Figure~\ref{fig:interpolatecontinuous}): <>= mosaic(haireye, shade = TRUE, gp_args = list(interpolate = 1:4)) @ \noindent The elements of the numeric vector passed to \code{interpolate} define the knots of an interpolating step function used to map the absolute residuals to saturation levels. The \code{interpolate} argument also accepts a user-defined function, which then is called with the absolute residuals to get a vector of cut-off points. Thus, it is possible to automatically choose the cut-off points in a data-driven way. For example, one might think that the extension from four cut-off points to a continuous shading---visualizing the whole range of residuals---could be useful. We simply need a one-to-one mapping from the residuals to the saturation values: <>= ipol <- function(x) pmin(x/4, 1) @ \noindent Note that this \codefun{ipol} function maps residuals greater than 4 to a saturation level of 1. However, the resulting plot (Figure~\ref{fig:interpolatecontinuous}, right) is deceiving: <>= mosaic(haireye, shade = TRUE, gp_args = list(interpolate = ipol), labeling_args = list(abbreviate_labs = c(Sex = TRUE))) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[htbp] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) mosaic(haireye, gp_args = list(interpolate = 1:4), margin = c(right = 1), keep_aspect_ratio= FALSE,newpage = FALSE,legend_width=5.5,shade = TRUE) popViewport(1) pushViewport(viewport(layout.pos.col = 2)) mosaic(haireye, gp_args = list(interpolate = ipol), margin = c(left=3,right = 1), keep_aspect_ratio = FALSE, newpage = FALSE, shade = TRUE) popViewport(2) @ \caption{\label{fig:interpolatecontinuous}The \data{HairEyeColor} data. Left: shading with 4 cut-off points. Right: continuous shading.} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent Too much color makes it difficult to interpret the image, and the subtle color differences are hard to catch. Therefore, we only included shadings with discrete cut-off points. The third remaining dimension, the value, is used for visualizing the significance of a test statistic. The user can either directly specify the $p$ value, or, alternatively, a function that computes it, to the \code{p.value} argument. Such a function must take observed and expected values, residuals, and degrees of freedom (used by the independence model) as arguments. If nothing is specified, the $p$ value is computed from a $\chi^2$ distribution with \code{df} degrees of freedom. The \code{level} argument is used to specify the confidence level: if \code{p.value} is smaller than \code{1 - level}, light colors are used, otherwise dark colors are employed. The following example using the \data{Bundesliga} data shows the relationship of home goals and away goals of Germany's premier soccer league in 1995: although there are two ``larger'' residuals (one greater than 2, one less then $-2$), the $\chi^2$ test does not reject the null hypothesis of independence. Consequently, the colors appear dark (see Figure~\ref{fig:bundesliga}, left): <>= BL <- xtabs(~ HomeGoals + AwayGoals, data = Bundesliga, subset = Year == 1995) mosaic(BL, shade = TRUE) @ \noindent Note that in extended mosaic plots, bullets drawn for zero cells are shaded, too, bringing out non-zero residuals, if any. A shading function building upon \codefun{shading\_hsv} is \codefun{shading\_Friendly}, implementing the shading introduced by \cite{vcd:Friendly:1994}. In addition to the defaults of the HSV shading, it uses the border color and line type to redundantly code the residuals' sign. The following example again uses the \data{Bundesliga} data from above, this time using the Friendly scheme and, in addition, an alternative legend (see Figure~\ref{fig:bundesliga}, right): <>= mosaic(BL, gp = shading_Friendly, legend = legend_fixed, zero_size = 0) @ \setkeys{Gin}{width=\textwidth} \begin{figure}[htbp] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) mosaic(BL, margin = c(right = 1), keep_aspect_ratio= FALSE, newpage = FALSE, legend_width=5.5, shade = TRUE) popViewport(1) pushViewport(viewport(layout.pos.col = 2)) mosaic(BL, gp = shading_Friendly, legend = legend_fixed, zero_size = 0, margin = c(right = 1), keep_aspect_ratio= FALSE, newpage = FALSE, legend_width=5.5) popViewport(2) @ \caption{The \data{Bundesliga} data for 1995. Left: Non-significant $\chi^2$ test. Right: using the Friendly shading and a legend with fixed bins.} \label{fig:bundesliga} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \noindent (The \code{zero\_size = 0} argument removes the bullets indicating zero observed values. This feature is not provided in the original \proglang{SAS} implementation of the Friendly mosaic plots.) % Figure~\ref{fig:shadingHSVHCL} depicts % HSV space in the upper panel and HCL space in the lower panel. % On the left (right) side, we see the color scales for red (blue) % hue, respectively. The $x$-axis represents the colorfulness, and the % $y$-axis the brightness. % The boxes represent the diverging color palettes used for the shadings. % For HSV space, we can see that the effect of changing the % level of brightness (`value') is not the same for different levels of % saturation, and again not the same for the two different hues. % In fact, in HSV space all dimensions are confounded, which % obviously is problematic for coding information. In contrast, HCL color % space offers perceptually uniform colors: as can be seen from the lower panel, % the chroma is homogeneous for different levels of luminance. % Unfortunately, this comes at the % price of the space being irregularly shaped, making it difficult to automatically select % diverging color palettes. % <>= % hue.slice <- function(hue, grid.n = 101, type = c("HCL", "HSV"), plot = TRUE, fixup = FALSE) % { % type <- match.arg(type) % if(type == "HCL") { % chroma = seq(0, 100, length = grid.n) % luminance = seq(0, 100, length = grid.n) % nc <- length(chroma) % nl <- length(luminance) % color.slice <- outer(chroma, luminance, function(y, x) hcl(hue, x, y, fixup = fixup)) % xlab <- "chroma" % ylab <- "luminance" % main <- paste("hue =", round(hue, digits = 0)) % } else { % chroma = seq(0, 1, length = grid.n) % luminance = seq(0, 1, length = grid.n) % nc <- length(chroma) % nl <- length(luminance) % color.slice <- outer(chroma, luminance, function(y, x) hsv(hue, x, y)) % xlab <- "saturation" % ylab <- "value" % main <- paste("hue =", round(hue, digits = 3)) % } % if(plot) { % plot(0.5, 0.5, xlim = range(chroma), ylim = range(luminance), type = "n", axes = FALSE, % xlab = xlab, ylab = ylab, yaxs = "i", xaxs = "i", main = main) % for(i in 1:(nc-1)) { % rect(chroma[i], luminance[-nl], chroma[i] + 100/(nc-1), luminance[-1], border = color.slice[,i+1], col = color.slice[,i+1]) % } % axis(1) % axis(2) % box() % } % colnames(color.slice) <- chroma % rownames(color.slice) <- luminance % attr(color.slice, "type") <- type % class(color.slice) <- "slice" % invisible(color.slice) % } % @ % \setkeys{Gin}{width=.8\textwidth} % \begin{figure}[p] % \begin{center} % <>= % ## generate colors % hue23 <- hue.slice(2/3, grid.n = 101, plot = FALSE, type = "HSV") % hue0 <- hue.slice(0, grid.n = 101, plot = FALSE, type = "HSV") % saturation <- as.numeric(colnames(hue23)) % value <- as.numeric(rownames(hue23)) % ## select those with value >= 0.5 % hue23 <- hue23[value >= .5, ] % hue0 <- hue0[value >= .5, ] % value <- value[value >= .5] % nl <- nrow(hue23) % nc <- ncol(hue23) % ## plot 2 slides from HSV space % plot(0.5, 0.5, xlim = c(-1, 1), ylim = c(0, 1), type = "n", axes = FALSE, % xlab = "", ylab = "", yaxs = "i", xaxs = "i", main = "") % for(i in 1:(nc-1)) { % rect(saturation[i], value[-nl], saturation[i] + 1/(nc-1), value[-1], border = hue23[,i+1], col = hue23[,i+1]) % } % for(i in 1:(nc-1)) { % rect(-saturation[i], value[-nl], -(saturation[i] + 1/(nc-1)), value[-1], border = hue0[,i+1], col = hue0[,i+1]) % } % axis(2, at = c(50, 75, 100)/100, labels = c(0.5, 0.75, 1)) % axis(4, at = c(50, 75, 100)/100, labels = c(0.5, 0.75, 1)) % axis(3, at = -4:4*.25, labels=c(4:0*.25, 1:4*.25)) % mtext(c("hue = 0", "hue = 2/3"), side = 3, at = c(-.5, .5), line = 3, cex = 1.2) % mtext("saturation", side = 3, at = 0, line = 2) % mtext("value", side = 2, at = .75, line = 2) % mtext("value", side = 4, at = .75, line = 2) % lines(c(-1, 1), c(.5, .5)) % ## significant colors % rect(-1, 0.95, -.90, 1, col = hsv(0, 1, 1)) % rect(-0.45, 0.95, -.55, 1, col = hsv(0, 0.5, 1)) % rect(-.05, .95, .05, 1, col = hsv(2/3, 0, 1)) % rect(0.45, 0.95, .55, 1, col = hsv(2/3, 0.5, 1)) % rect(.90, .95, 1, 1, col = hsv(2/3, 1, 1)) % text(-1, .33, "significant", pos = 4, cex = 1.2) % rect(-1, .20, -.80, .30, col = hsv(0, 1, 1)) % rect(-.40, .20, -0.6, .30, col = hsv(0, 0.5, 1)) % rect(-.20, .20, 0, .30, col = hsv(0, 0, 1)) % rect(0, .20, .20, .30, col = hsv(2/3, 0, 1)) % rect(0.4, .20, .60, .30, col = hsv(2/3, .5, 1)) % rect(.80, .20, 1, .30, col = hsv(2/3, 1, 1)) % lines(c(-.9, -.55), c(0.975, .975), lty = 2) % lines(c(-.45, -.05), c(0.975, .975), lty = 2) % lines(c(.45, .05), c(0.975, .975), lty = 2) % lines(c(.9, .55), c(0.975, .975), lty = 2) % ## non-significant colors % rect(-1, 0.5, -.90, 0.55, col = hsv(0, 1, 0.5)) % rect(-0.4, 0.5, -.55, 0.55, col = hsv(0, 0.5, 0.5)) % rect(-.05, .5, .05, 0.55, col = hsv(2/3, 0, 0.5)) % rect(0.45, 0.5, .55, 0.55, col = hsv(2/3, 0.5, 0.5)) % rect(.90, .5, 1, 0.55, col = hsv(2/3, 1, 0.5)) % text(-1, .13, "non-significant", pos = 4, cex = 1.2) % rect(-1, 0, -.80, .10, col = hsv(0, 1, 0.5)) % rect(-.60, 0, -.4, .10, col = hsv(0, 0.5, 0.5)) % rect(-.20, 0, 0, .10, col = hsv(0, 0, 0.5)) % rect(0, 0, .20, .10, col = hsv(2/3, 0, 0.5)) % rect(0.4, 0, .60, .1, col = hsv(2/3, .5, 0.5)) % rect(.80, 0, 1, .10, col = hsv(2/3, 1, 0.5)) % lines(c(-.9, -.55), c(0.525, .525), lty = 2) % lines(c(-.45, -.05), c(0.525, .525), lty = 2) % lines(c(.45, .05), c(0.525, .525), lty = 2) % lines(c(.9, .55), c(0.525, .525), lty = 2) % @ % <>= % ## generate colors % hue260 <- hue.slice(260, grid.n = 101, plot = FALSE) % hue360 <- hue.slice(360, grid.n = 101, plot = FALSE) % mychroma <- as.numeric(colnames(hue260)) % luminance <- as.numeric(rownames(hue260)) % ## select those with lumincance >= 50 % hue260 <- hue260[luminance >= 50, ] % hue360 <- hue360[luminance >= 50, ] % luminance <- luminance[luminance >= 50] % nc <- ncol(hue260) % nl <- nrow(hue260) % ## plot 2 slides from HCL space % plot(0.5, 0.5, xlim = c(-100, 100), ylim = c(0, 100), type = "n", axes = FALSE, % xlab = "", ylab = "", yaxs = "i", xaxs = "i", main = "") % for(i in 1:(nc-1)) { % rect(mychroma[i], luminance[-nl], mychroma[i] + 100/(nc-1), luminance[-1], border = hue260[,i+1], col = hue260[,i+1]) % } % for(i in 1:(nc-1)) { % rect(-mychroma[i], luminance[-nl], -(mychroma[i] + 100/(nc-1)), luminance[-1], border = hue360[,i+1], col = hue360[,i+1]) % } % axis(2, at = c(50, 70, 90, 100), labels = c(50, 70, 90, 100)) % axis(4, at = c(50, 70, 90, 100), labels = c(50, 70, 90, 100)) % axis(3, at = -4:4*25, labels=c(4:0*25, 1:4*25)) % mtext(c("hue = 0", "hue = 260"), side = 3, at = c(-50, 50), line = 3, cex = 1.2) % mtext("chroma", side = 3, at = 0, line = 2) % mtext("luminance", side = 2, at = 75, line = 2) % mtext("luminance", side = 4, at = 75, line = 2) % lines(c(-100, 100), c(50, 50)) % ## significant colors % rect(-100, 47.5, -90, 52.5, col = hcl(0, 100, 50)) % rect(-55, 67.5, -45, 72.5, col = hcl(0, 50, 70)) % rect(-5, 95, 5, 100, col = hcl(260, 0, 100)) ## grey vs. white % rect(-5, 87.5, 5, 92.5, col = hcl(260, 0, 90)) ## grey vs. white % rect(45, 67.5, 55, 72.5, col = hcl(260, 50, 70)) % rect(90, 47.5, 100, 52.5, col = hcl(260, 100, 50)) % text(-100, 33, "significant", pos = 4, cex = 1.2) % rect(-100, 20, -80, 30, col = hcl(0, 100, 50)) % rect(-60, 20, -40, 30, col = hcl(0, 50, 70)) % rect(-20, 20, 0, 30, col = hcl(0, 0, 90)) % rect(0, 20, 20, 30, col = hcl(260, 0, 90)) % #white# rect(-20, 20, 0, 30, col = hcl(0, 0, 100)) % #white# rect(0, 20, 20, 30, col = hcl(260, 0, 100)) % rect(40, 20, 60, 30, col = hcl(260, 50, 70)) % rect(80, 20, 100, 30, col = hcl(260, 100, 50)) % lines(c(-45, -5), c(72.5, 87.5), lty = 2) % lines(c(45, 5), c(72.5, 87.5), lty = 2) % lines(c(-95, -55), c(52.5, 67.5), lty = 2) % lines(c(95, 55), c(52.5, 67.5), lty = 2) % ## non-significant colors % rect(-25, 47.5, -15, 52.5, col = hcl(0, 20, 50)) % rect(-15, 67.5, -5, 72.5, col = hcl(0, 10, 70)) % rect(5, 67.5, 15, 72.5, col = hcl(260, 10, 70)) % rect(25, 47.5, 15, 52.5, col = hcl(260, 20, 50)) % text(-100, 13, "non-significant", pos = 4, cex = 1.2) % rect(-60, 0, -40, 10, col = hcl(0, 20, 50)) % rect(-40, 0, -20, 10, col = hcl(0, 10, 70)) % rect(-20, 0, 0, 10, col = hcl(0, 0, 90)) % rect(0, 0, 20, 10, col = hcl(260, 0, 90)) % rect(20, 0, 40, 10, col = hcl(260, 10, 70)) % rect(40, 0, 60, 10, col = hcl(260, 20, 50)) % lines(c(-18.75, -11.25), c(52.5, 67.5), lty = 2) % lines(c(-8.75, -1.25), c(72.5, 87.5), lty = 2) % lines(c(18.75, 11.75), c(52.5, 67.5), lty = 2) % lines(c(8.75, 1.25), c(72.5, 87.5), lty = 2) % @ % \caption{Residual-based shadings in HSV (upper) and HCL space (lower).} % \label{fig:shadingHSVHCL} % \end{center} % \end{figure} A more ``advanced'' function building upon \codefun{shading\_hcl} is \codefun{shading\_max}, using the maximum statistic both to conduct the independence test and to visualize significant \emph{cells} causing the rejection of the independence hypothesis \citep{vcd:Meyer+Zeileis+Hornik:2003,vcd:Zeileis+Meyer+Hornik:2007}. The \code{level} argument of \codefun{shading\_max} then can be used to specify several confidence levels from which the corresponding cut-off points are computed. By default, two cut-off points are computed corresponding to confidence levels of $90\%$ and $99\%$, respectively. In the following example, we investigate the effect of a new treatment for rheumatoid arthritis on a group of female patients using the maximum shading (see Figure~\ref{fig:maximum}): <>= set.seed(4711) mosaic(~ Treatment + Improved, data = Arthritis, subset = Sex == "Female", gp = shading_max) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{The \data{Arthritis} data (female patients) with significant maximum test.} \label{fig:maximum} \end{center} \end{figure} \noindent The maximum test is significant although the residuals are all in the $\left[-2,2\right]$ interval. The \codefun{shading\_hcl} function with default cut-off points would not have shown any color. In addition, since the test statistic is the maximum of the absolute Pearson residuals, \emph{each} colored residual violates the null hypotheses of independence, and thus, the ``culprits'' can immediately be identified. \clearpage \section[Labeling]{Labeling} \label{sec:labeling} One of the major enhancements in package \pkg{vcd} compared to \codefun{mosaicplot} and \codefun{assocplot} in base \proglang{R} is the labeling in the strucplot framework which offers more features and greater flexibility. Like shading, spacing, and drawing of legend and core plot, labeling is now carried out by grapcon functions, rendering labeling completely modular. The user supplies either a labeling function, or, alternatively, a generating function that parameterizes a labeling function, to \codefun{strucplot} which then draws the labels. Labeling is well-separated from the actual plotting that occurs in the low-level core functions. It only relies on the viewport tree produced by them, and the \code{dimnames} attribute of the visualized table. Labeling functions are grapcons that ``add ink to the canvas'': the drawing of the labels happens after the actual plot has been drawn by the core function. Thus, it is possible to supply one's own labeling function, or to combine some of the basic functions to produce a more complex labeling. In the following, we describe the three basic modules (\codefun{labeling\_text}, \codefun{labeling\_list}, and \codefun{labeling\_cells}) and derived functions that build upon them. \subsection[Labels in the borders]{Labels in the borders: \texttt{labeling\_text()}} \codefun{labeling\_text} is the default for all strucplot displays. It plots labels in the borders similar to the \codefun{mosaicplot} function in base \proglang{R}, but is much more flexible: it is not limited to 4 dimensions, and the positioning and graphical parameters of levels and variable names are customizable. In addition, the problem of overlapping labels can be handled in several ways. As an example, again consider the \data{Titanic} data: by default, the variable names and levels are plotted ``around'' the plot in a counter-clockwise way (see Figure~\ref{fig:labels1}, top left): <>= mosaic(Titanic) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{Mosaic plot for the \data{Titanic} data with default settings % for labeling.} % \label{fig:defaults} % \end{center} % \end{figure} \noindent Note that the last two levels of the \code{survived} variable do overlap, as well as some adult and child labels of the \code{age} Variable. This issue can be addressed in several ways. The ``brute force'' method is to enable clipping for these dimensions (see Figure~\ref{fig:labels1}, top right): <>= mosaic(Titanic, labeling_args = list(clip = c(Survived = TRUE, Age = TRUE))) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{The effect of clipping.} % \label{fig:clipping} % \end{center} % \end{figure} \noindent The \code{clip} parameter is passed to the labeling function via the \code{labeling\_args} argument which takes a list of parameters. \code{clip} itself takes a vector of logicals (one for each dimension). % as mentioned before Almost all vectorized arguments in the strucplot framework can be abbreviated in the following way: unnamed components (or the defaults, if there are none) are recycled as needed, but overridden by the named components. Here, the default is \code{FALSE}, and therefore clipping is enabled only for the \code{survived} and \code{age} variables. A more sensible solution to the overlap problem is to abbreviate the levels (see Figure~\ref{fig:labels1}, middle left): <>= mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = TRUE, Age = 3))) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Abbreviating.} % \label{fig:abbreviating} % \end{center} % \end{figure} \noindent The \code{abbreviate} argument takes a vector of integers indicating the number of significant characters the levels should be abbreviated to (\code{TRUE} is interpreted as 1, obviously). Abbreviation is performed using the \codefun{abbreviate} function in base \proglang{R}. Another possibility is to rotate the levels (see Figure~\ref{fig:labels1}, bottom): <>= mosaic(Titanic, labeling_args = list(rot_labels = c(bottom = 90, right = 0), offset_varnames = c(right = 1), offset_labels = c(right = 0.3)), margins = c(right = 4, bottom = 3)) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{Rotating labels.} % \label{fig:rotating} % \end{center} % \end{figure} \noindent Finally, we could also inhibit the output of repeated levels (see Figure~\ref{fig:labels1}, middle right): <>= mosaic(Titanic, labeling_args = list(rep = c(Survived = FALSE, Age = FALSE))) @ \setkeys{Gin}{width=0.9\textwidth} \begin{figure}[p] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2,nrow=3))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(Titanic, newpage = FALSE, keep = TRUE, margin = c(right = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(clip = c(Survived = TRUE, Age = TRUE)), newpage = FALSE, keep = TRUE, margin = c(left = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = TRUE, Age = 2)), newpage = FALSE, keep = TRUE, margin = c(right = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(rep = c(Survived = FALSE, Age = FALSE)), newpage = FALSE, keep = TRUE, margin = c(left = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1:2, layout.pos.row = 3)) pushViewport(viewport(width = 0.55)) mosaic(Titanic, labeling_args = list(rot_labels = c(bottom = 90, right = 0), offset_varnames = c(right = 1), offset_labels = c(right = 0.3)), margins = c(right = 4, bottom = 3), newpage = FALSE, keep = FALSE, gp_labels = gpar(fontsize = 10)) popViewport(3) @ \caption{Examples for possible labeling strategies for the Titanic data mosaic. Top left: default labeling (many labels overlap). Top right: with clipping turned on. Middle left: \texttt{Age} and \texttt{Survived} labels abbreviated. Middle right: \texttt{Age} labels not repeated. Bottom: \texttt{Age} and \texttt{Survived} labels rotated.} \label{fig:labels1} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} We now proceed with a few more ``cosmetic'' features (which do not all produce satisfactory results for our sample data). A first simple, but effectful modification is to position all labels and variables left-aligned (see Figure~\ref{fig:labels2}, top left): <>= mosaic(Titanic, labeling_args = list(pos_varnames = "left", pos_labels = "left", just_labels = "left", rep = FALSE)) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Left-aligning.} % \label{fig:left} % \end{center} % \end{figure} \noindent Note that obviously we need to change the justification to \code{"left"} as well. We can achieve the same effect by using the convenience function \codefun{labeling\_left}: <>= mosaic(Titanic, labeling = labeling_left) @ \noindent Next, we show how to put all levels to the bottom and right margins, and all variable names to the top and left margins (see Figure~\ref{fig:labels2}, top right): <>= mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, abbreviate_labs = c(Survived = 1, Age = 3))) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{Changes in the margins.} % \label{fig:margins} % \end{center} % \end{figure} \noindent The tl\_\var{foo} (``top left'') arguments are \code{TRUE} by default. Now, we will add boxes to the labels and additionally enable clipping (see Figure~\ref{fig:labels2}, bottom left): <>= mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, boxes = TRUE, clip = TRUE)) @ % \begin{figure}[p] % \begin{center} % <>= % <> % @ % \caption{Boxes and Clipping.} % \label{fig:boxes} % \end{center} % \end{figure} \noindent The values to \code{boxes} and \code{clip} are recycled for all dimensions. The result is pretty close to what calling \codefun{mosaic} with the \codefun{labeling\_cboxed} wrapper does, except that variables and levels, by default, are put to the top and to the left of the plot: <>= mosaic(Titanic, labeling = labeling_cboxed) @ \noindent Another variant is to put the variable names into the same line as the levels (see Figure~\ref{fig:labels2}, bottom right---clipping for \code{Survived} and \code{Age} is, additionally, disabled, and \code{Age} abbreviated): <>= mosaic(Titanic, labeling_args = list(tl_labels = TRUE, boxes = TRUE, clip = c(Survived = FALSE, Age = FALSE, TRUE), abbreviate_labs = c(Age = 4), labbl_varnames = TRUE), margins = c(left = 4, right = 1, 3)) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Variable names beneath levels, and clipping disabled for the % survival variable.} % \label{fig:labbl} % \end{center} % \end{figure} \noindent \code{labbl\_varnames} (``variable names to the bottom/left of the labels'') is a vector of logicals indicating the side for the variable names. The resulting layout is close to what \codefun{labeling\_lboxed} produces, except that variables and levels, by default, are left-aligned and put to the bottom and to the right of the plot: <>= mosaic(Titanic, labeling = labeling_lboxed, margins = c(right = 4, left = 1, 3)) @ \noindent A similar design is used by the \codefun{doubledecker} function. \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(pos_varnames = "left", pos_labels = "left", just_labels = "left", rep = FALSE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, abbreviate_labs = c(Survived = 1, Age = 3)), newpage = FALSE, keep = TRUE, margins = c(left = 4, right = 1, 3), gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, boxes = TRUE, clip = TRUE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(tl_labels = TRUE, boxes = TRUE, clip = c(Survived = FALSE, Age = FALSE, TRUE), labbl_varnames = TRUE, abbreviate_labs = c(Age = 4)), margins = c(left = 4, right = 1, 3), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport(2) @ \caption{Advanced strategies for labeling of the Titanic data. Top left: left aligning of both variable names and labels. Top right: changes in the margins (all variable names are in the top and left margins, and all labels in the bottom and right margins). Bottom left: clipping turned on, and boxes used. Bottom right: variable names beneath levels, clipping disabled for the survival and age variables, and \texttt{Age} abbreviated.} \label{fig:labels2} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \subsection[Labels in the cells]{Labels in the cells: \texttt{labeling\_cells()}} This labeling draws both variable names and levels in the cells. As an example, we use the \data{PreSex} data on pre- and extramarital sex and divorce (see Figure~\ref{fig:labels3}, top left): <>= mosaic(~ MaritalStatus + Gender, data = PreSex, labeling = labeling_cells) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Cell labeling for the \data{PreSex} data.} % \label{fig:cell} % \end{center} % \end{figure} \noindent In the case of narrow cells, it might be useful to abbreviate labels and/or variable names and turn off clipping (see Figure~\ref{fig:labels3}, top right): <>= mosaic(~ PremaritalSex + ExtramaritalSex, data = PreSex, labeling = labeling_cells(abbreviate_labels = TRUE, abbreviate_varnames = TRUE, clip = FALSE)) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Cell labeling for the \data{PreSex} data, labels abbreviated.} % \label{fig:cell2} % \end{center} % \end{figure} \noindent For some data, it might be convenient to combine cell labeling with border labeling as done by \codefun{labels\_conditional} (see Figure~\ref{fig:labels3}, bottom left): <>= mosaic(~ PremaritalSex + ExtramaritalSex | MaritalStatus + Gender, data = PreSex, labeling = labeling_conditional(abbreviate_varnames = TRUE, abbreviate_labels = TRUE, clip = FALSE, gp_text = gpar(col = "red"))) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{Conditional labeling for the \data{PreSex} data, labels (in % red for clarity) abbreviated.} % \label{fig:conditional} % \end{center} % \end{figure} \noindent Additionally, the cell labeling allows the user to add arbitrary text to the cells by supplying a character array in the same shape as the data array to the \code{text} argument (cells with missing values are ignored). In the following example using the \code{Titanic} data, this is used to add all observed values greater than 5 to the cells after the mosaic has been plotted (see Figure~\ref{fig:labels3}, bottom right): <>= mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = 1, Age = 4)), pop = FALSE) tab <- ifelse(Titanic < 6, NA, Titanic) labeling_cells(text = tab, clip = FALSE)(Titanic) @ % \begin{figure}[h] % \begin{center} % <>= % <> % @ % \caption{User-supplied text (observed frequencies exceeding 5) % added to a mosaic display of the \data{Titanic} data.} % \label{fig:text} % \end{center} % \end{figure} \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= grid.newpage() pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(~ MaritalStatus + Gender, data = PreSex, labeling = labeling_cells, newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(~ PremaritalSex + ExtramaritalSex, data = PreSex, labeling = labeling_cells(abbreviate_labels = TRUE, abbreviate_varnames = TRUE, clip = FALSE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(~ PremaritalSex + ExtramaritalSex | MaritalStatus + Gender, data = PreSex, labeling = labeling_conditional(abbreviate_varnames = TRUE, abbreviate_labels = TRUE, clip = FALSE, gp_text = gpar(col = "red")), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = 1, Age = 3)), pop = FALSE, newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) tab <- ifelse(Titanic < 6, NA, Titanic) labeling_cells(text = tab, clip = FALSE)(Titanic) @ \caption{Cell labeling. Top left: default labeling using the \data{PreSex} data. Top right: abbreviated labels. Bottom left: conditional labeling (labels abbreviated and in red for clarity). Bottom right: user-supplied text (observed frequencies exceeding 5) added to a mosaic display of the \data{Titanic} data. Note that clipping is on by default (top left), and has explicitly been turned off for the three other plots.} \label{fig:labels3} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \subsection[A simple list of labels]{A simple list of labels: \texttt{labeling\_list()}} If problems with overlapping labels cannot satisfactorily resolved, the last remedy could be to simply list the levels below the plot (see Figure~\ref{fig:list}): <>= mosaic(Titanic, labeling = labeling_list, margins = c(bottom = 5)) @ \setkeys{Gin}{width=0.7\textwidth} \begin{figure}[p] \begin{center} <>= mosaic(Titanic, labeling = labeling_list, margins = c(bottom = 5), keep = TRUE) @ \caption{Labels indicated below the plot.} \label{fig:list} \end{center} \end{figure} \noindent The number of columns can be specified. \section{Spacing} \label{sec:spacing} Spacing of strucplot displays is customizable in a similar way than shading. The \code{spacing} argument of the \codefun{strucplot} function takes a list of \class{unit} vectors, one for each dimension, specifying the space between the tiles corresponding to the levels. Consider again the introductory example of the \data{Arthritis} data (Figure~\ref{fig:arthritis}). Since we are interested in the effect of the medicament in the placebo and treatment groups, a mosaic plot is certainly appropriate to visualize the three levels of \code{Improved} in the two \code{Treatment} strata. Another conceptual approach is to use spine plots with highlighting \citep{vcd:hummel:1996}. A spine plot is a variation of a bar plot where the heights of the bars are held constant, whereas the widths are used to represent the number of cases in each category. This is equivalent to a mosaic plot for a one-way table. If a second (indicator) variable is highlighted in a spine plot, we obtain a display equivalent to a simple mosaic display for a two-way table, except that no space between the levels of the highlighted variable is used. In the \data{Arthritis} example, we will highlight patients with \code{Marked} improvement in both groups. To obtain such a display within the strucplot framework, it suffices to set the space between the \code{Improved} tiles to 0 (see Figure~\ref{fig:artspine}): <>= (art <- structable(~Treatment + Improved, data = Arthritis, split_vertical = TRUE)) (my_spacing <- list(unit(0.5, "lines"), unit(c(0, 0), "lines"))) my_colors <- c("lightgray", "lightgray", "black") mosaic(art, spacing = my_spacing, gp = gpar(fill = my_colors, col = my_colors)) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Spine plot for the \data{Arthritis} data using the strucplot framework.} \label{fig:artspine} \end{center} \end{figure} \noindent Note that the default and formula methods for \codefun{mosaic} provide a convenience interface for highlighting. A similar plot (with slightly different shading) than the previous one can be obtained using: <>= mosaic(Improved ~ Treatment, data = Arthritis, split_vertical = TRUE) @ \noindent The strucplot framework also provides a set of spacing grapcon generators which compute suitable spacing objects for typical applications. The simplest spacing is \codefun{spacing\_equal} that uses the same space between all tiles (see Figure~\ref{fig:spacing}, top left): <>= mosaic(art, spacing = spacing_equal(unit(2, "lines"))) @ \noindent \codefun{spacing\_equal} is the default grapcon generator for two-dimensional tables. Slightly more flexible is \codefun{spacing\_dimequal} that allows an individual setting for each dimension (see Figure~\ref{fig:spacing}, top right): <>= mosaic(art, spacing = spacing_dimequal(unit(1:2, "lines"))) @ \noindent The default for multi-way contingency tables is \codefun{spacing\_increase} which uses increasing spaces for the dimensions. The user can specify a start value and the increase factor (see Figure~\ref{fig:spacing}, bottom left): <>= mosaic(art, spacing = spacing_increase(start = unit(0.5, "lines"), rate = 1.5)) @ \noindent For the arthritis example above, we could as well have used \codefun{spacing\_highlighting} which is similar to \codefun{spacing\_increase} but sets the spacing in the last splitting dimension to 0 (see Figure~\ref{fig:spacing}, bottom right): <>= mosaic(art, spacing = spacing_highlighting, gp = my_colors) @ \noindent Finally, \codefun{spacing\_conditional} can be used for visualizing conditional independence: it combines \codefun{spacing\_equal} (for the conditioned dimensions) and \codefun{spacing\_increase} (for the conditioning dimensions). As an example, consider Figure~\ref{fig:presex}: the spacing clearly allows to better distinguish the conditioning variables (\code{Gender} and \code{MaritalStatus}) from the conditioned variables (\code{PremaritalSex} and \code{ExtramaritalSex}). This spacing is the default when conditional variables are specified for a strucplot display (see Section \ref{sec:strucplot}). \setkeys{Gin}{width=\textwidth} \begin{figure}[p] \begin{center} <>= pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(art, spacing = spacing_equal(unit(2, "lines")), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(art, spacing = spacing_dimequal(unit(c(0.5, 2), "lines")), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(art, spacing = spacing_increase(start = unit(0.3, "lines"), rate = 2.5), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(art, spacing = spacing_highlighting, keep = TRUE, newpage = FALSE) popViewport(2) @ \caption{Varying spacing for the Arthritis data. Top left: equal spacing for all dimensions. Top right: different spacings for individial dimensions. Bottom left: increasing spacing. Bottom right: spacing used for highlighting.} \label{fig:spacing} \end{center} \end{figure} \setkeys{Gin}{width=0.7\textwidth} \section{Example: Ovarian cancer survival} \label{sec:example} In the following, we demonstrate some of the described techniques in analyzing a data set originating from \citep{vcd:obel:1975} \cite[taken from][]{vcd:andersen:1991} about a retrospective study of ovary cancer carried out in 1973. Information was obtained from 299 women, who were operated for ovary cancer 10 years before. The data consists of four binary variables: the \code{stage} of the cancer at the time of operation (levels: \code{early}, \code{advanced}), the type of \code{operation} performed (\code{radical}, \code{limited}), the \code{survival} status after 10 years (\code{yes}, \code{no}), and \code{xray} indicating whether X-ray treatment was received (\code{yes}, \code{no}). The dataset in \pkg{vcd} comes pretabulated in a data frame, so we first create the four-way table: <>= tab <- xtabs(Freq ~ stage + operation + xray + survival, data = OvaryCancer) @ \noindent A ``flattened'' textual representation can be obtained using \codefun{structable}: <>= structable(survival ~ ., data = tab) @ \noindent A first overview can be obtained using a pairs plot (Figure~\ref{fig:ocpairs}): <>= dpa <- list(var_offset = 1.2, rot = -30, just_leveltext= "left") pairs(tab, diag_panel = pairs_barplot, diag_panel_args = dpa) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{Pairs plot for the \data{OvaryCancer} data showing mosaic displays for all pairwise distributions and bar plots for all marginal distributions.} \label{fig:ocpairs} \end{center} \end{figure} \noindent The pairs plot, by default, creates mosaic displays for all pairwise variable combinations, and bar plots in the diagonal to visualize the absolute frequencies of the variables. The \texttt{var\_offset} argument modifies the offset of the (centered) variable names to avoid overlap with the bars. Additionally, we use the \texttt{rot} and the \texttt{just\_leveltext} arguments to rotate the level names, again to avoid their overlap. First, we consider the marginal distributions. The study design involved (nearly) the same number of survived (150) and deceased (149) patients. Similarly balanced, 158 cases were in an advanced and 141 in an early stage. Most patients (251, 84\%) were treated with a radical operation, and 186 (62\%) were submitted to X-ray treatment. Next, we inspect the two-way interaction of the influencing factors (\code{stage}, \code{operation}, and \code{xray}): the corresponding mosaics exhibit symmetric, regular shapes with aligned tiles, which indicate no marginal interaction between these variables. The same is true for the interactions of \code{survival} with \code{operation} and \code{xray}, respectively. Only the stage seems to influence survival: here, the tiles are ``shifted''. A different view on the data, focused on the influence of the explanatory variables on \code{Survival}, can be obtained using a doubledecker plot (Figure~\ref{fig:ocdoubledecker}): <>= doubledecker(survival ~ stage + operation + xray, data = tab) @ \begin{figure}[h] \begin{center} <>= <> @ \caption{Doubledecker plot for the \data{OvaryCancer} data showing the conditional distribution of X-ray, given operation, given stage, and with survival highlighted.} \label{fig:ocdoubledecker} \end{center} \end{figure} \noindent From a technical point of view, the display is constructed as a mosaic plot showing the conditional distribution of \code{survival}, given \code{xray}, given \code{operation}, given \code{stage}, with vertical splits for the conditioning variables and horizontal ones for \code{survival}. Additionally, there is zero space between the tiles of the last dimension and a binary shading is used for survived and deceased patients. Conceptually, this plot is interpreted as a mosaic plot of just the influencing variables, with \code{survival} highlighted in the tiles. Thus, the plot really shows the influence of the explanatory variables on \code{survival}. Clearly, the survival rate is higher among patients in an early stage, but neither radical operation nor X-ray treatment seem to improve the situation. From this exploratory phase, the survival rate seems to be slightly higher for patients who received a limited operation only, whereas the effect for X-ray treatment is less marked. To visualize inference results, we can make use of residual-based shadings, investigating log-linear models for the four-way table. Figure~\ref{fig:ocmosaicnull} visualizes the null model, where survival is independent from the combined effect of operation, X-ray treatment, and stage: <>= split <- c(TRUE, TRUE, TRUE, FALSE) mosaic(tab, expected = ~ survival + operation * xray * stage, split_vertical = split) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{OvaryCancer} data, with residual-based shading for the (clearly rejected) null model (survival)(operation, X-ray, stage).} \label{fig:ocmosaicnull} \end{center} \end{figure} \noindent The model is clearly rejected ($p$-value: 0.000). From the exploratory phase of our analysis, we (only) suspect \code{stage} to be influential on the survival rate. A corresponding hypothesis is that \code{survival} be independent of \code{xray} and \code{operation}, given \code{stage}. The model is specified using the \texttt{expected} argument, either using the \codefun{loglin} interface or the \codefun{loglm} formula interface (the resulting mosaic plot is shown in Figure \ref{fig:ocmosaicstage}): <>= mosaic(tab, expected = ~ (survival + operation * xray) * stage, split_vertical = split) @ \begin{figure}[p] \begin{center} <>= <> @ \caption{Mosaic plot for the \data{OvaryCancer} data, with residual-based shading for the hypothesis of survival being independent of X-ray and operation, given stage. The hypothesis is not rejected.} \label{fig:ocmosaicstage} \end{center} \end{figure} \noindent Thus, based on this data, only pre-diagnosis seems to matter in ovarian cancer therapy. \section{Conclusion} \label{sec:conclusion} In this paper, we describe the ``strucplot'' framework for the visualization of multi-way contingency tables. Strucplot displays include popular basic plots such as mosaic, association, and sieve plots, integrated in a unified framework: all can be seen as visualizations of hierarchical conditional flat tables. Additionally, these core strucplot displays can be combined into more complex, specialized plots, such as pairs and trellis-like displays for visualizing conditional independence. Residual-based shadings permit the visualization of log-linear models and the results of independence tests. The framework's modular design allows flexible customization of the plots' graphical appearance, including shading, labeling, spacing, and legend, by means of graphical appearance control (``grapcon'') functions. These ``graphical hyperparameters'' are customized and created by generating functions. Our work includes a set of predefined grapcon generators for typical analysis tasks, and user-level extensions can easily be added. \bibliography{vcd} \begin{appendix} \section{Data sets} \label{sex:data} The data set names in the paper are those from the \proglang{R} system. In the following, we give a short description of each data set. \begin{description} \item[\texttt{Arthritis}] Data from a double-blind clinical trial investigating a new treatment for rheumatoid arthritis. Source: \cite{vcd:Koch+Edwards:1988}. Taken from: \cite{vcd:Friendly:2000}. Package: \pkg{vcd}. \item[\texttt{Bundesliga}] Results from the first German soccer league in the years 1995/6 \citep{vcd:Knorr-Held:1999} and 2001/2 (Collected by: Achim Zeileis). Package: \pkg{vcd}. \item[\texttt{HairEyeColor}] Distribution of hair and eye color and gender in 592 statistics students. The gender information is artificial. Source: \cite{vcd:Snee:1974}. Taken from: \cite{vcd:Friendly:2000}. Package: \pkg{datasets} (included in base \proglang{R}). \item[\texttt{OvaryCancer}] Data about a retrospective study of ovary cancer carried out in 1973. Information was obtained from 299 women, who were operated for ovary cancer 10 years before. Source: \cite{vcd:obel:1975}. Taken fromn: \cite{vcd:andersen:1991}. Package: \pkg{vcd}. \item[\texttt{PreSex}] Data on pre- and extra-marital sex and divorce. Source: \cite{vcd:thornes+collard:1979}. Taken from \cite{vcd:gilbert:1981}. Package: \pkg{vcd}. \item[\texttt{Titanic}] Information on the fate of passengers on the fatal maiden voyage of the ocean liner ``Titanic'', summarized according to economic status (class), gender (\code{Sex}), age and survival. Data originally collected by the British Board of Trade in their investigation of the sinking. Taken from: \cite{vcd:dawson:1995}. Package: \pkg{datasets} (included in base \proglang{R}). \item[\texttt{UCBAdmissions}] Aggregate data on applicants to graduate school at Berkeley for the six largest departments in 1973 classified by admission and gender. Source: \cite{vcd:Bickel+Hammel+O'Connell:1975}. Taken from: \cite{vcd:Friendly:2000}. Package: \pkg{datasets} (included in base \proglang{R}). \end{description} \end{appendix} \end{document} vcd/inst/doc/residual-shadings.pdf0000644000175000017500000025323714133313350017013 0ustar nileshnilesh%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 3813 /Filter /FlateDecode /N 66 /First 541 >> stream x[[w6~_IV'fu_$#7mҳHV]e~6@J͖Ugzf2 66}`feXJyg,cRLjkP`ˤb5*2eT5iC)YgF;dƌ$SYiĸcJ1'\$kЩa.eҢjg,c^PǠy%ӠcB %S΃9T,MQv,0N15Ǎ&S ,,5hsx0 i9#"3%zp)fx*M1s,HL}T 4XM7г`%fKR0uh322 X^BJmгC_ѳ"c\:.F Fo'gE&g``̚q9)j$(XMڏKYsUM٣Uy~)qQ`rΊlڰtRL)qJ(UzgQק{lHN <~U|\MG5{u5,Cf\5~XMF%UcVN.i1)'(|eMq\Sԏ)ݟ41Y5j4S쪪z8-o%VoŰapcٌ۠,?9bίA44=|T& I$Ub Y%Q/ M".`Ҵ4^A[˿v׽[<*v /meɷE88Hb/Y%dKUL0,tRY1* lfod%MV0MMyC뗵jx^4虿=>/ >?¢rZ7,Ntou3_*/\BC%IxLdR[CKV& xmQL䜉CI7=$d{q>'o[@d-E{>T`zsec2gXjz }߼=c^f:+֋W aD_ӳAuOzrXGxc2H)@- 4 ԤT 6TN'"dGKr\U[?Nm.̬~m}XIzr8ZO7 w =H]}vA->/h-H)TdXhVSA| I; 9F!(E 󢼼1?[>!'k2뜏x/E/O%0jWńw>|+^M ~ajħ oEO+a}OF`U%밼Xg dLu/`s?+ C5̿9}:tץOl .N&uXB`V^nBZE2c#lQ;:M#㕞R}@k_ş_,wa8& Saf~'*Nn_]=.};Ux ;~8|bMqDvEIUD$6#X؄@at"(45bo@ݟ" pЯB/gڑ% He2 "C=+:mcoIjN*;Z,b] * t1iol1v؍6)?ZKs Z;vABy~ #Rxq=+^L…,FM&. Y⢉w-uVǬjqhbPZJ^u ^U;![]L%EGfYRtu6QjO=}7VbGsh6(־jn4D )i eȧb%ÑC"LV Pׯ_(ஹ=QЕ#5TTnjWzb2Zk;{ΑR!SMO,EOC'Q I_΅'f#{v+^]7g;fn n| FޭWw+};Q<ώ?`jR۹3N̈́Bۆ>_z>mb^[stofTz]NakgGCfwc7=KsIIbڷ8uv1`մ͒l2/'&>VDQVՒ`ăW/_~َ{>'ͽy_ Gm2q;+nUI.K^P2+(K!尜g)ǣ1I$~Bz3=װ'NT)B^ܐWevYF>"[M16\ӣPۜ}H([p6v2I%D s%6sq=-'wz6kc.0F?4vE_E="݆~lJY/ZxԴ[m>ɳ67F{Нo:r$"WM0lBo3 rGe@v <YE]$(k{XNftI~"CІ`yw!LT?ܹM[ŋHrdiM1[UweWܭ ^?^I58.͕ePVsyesPw)c;_C%m27: nE;!aa _ ^}*rnpݶv^L?f6Ԫ:XZŰZRl@,P}\%b[XS TC(q.\?O(lmzx4 r6ޭI"jٶ'4nj5:f^>{4">Q k 5[ $aom[v(R6/P2(]Rz}@E)nnݎBߺu; kp;҇k(.N9R `cdR\ @&KrxRzZu*v55o@`Nz8 SO ? _"O<,EFۄ:cP$BGQ>1ܹ`tMFhoߦ:N~c6mI*)&Nh4&!J4!9dB,YuH2X6G)Qgs0E2 `cS֞xJ2o{oq޳.H͕^Y $'* [{jftQezT =hl*aZ'S&>KvkhϷ=PٽΪnuPc[%NCښ36 }7D%eS~Dm::AoW*Dj:GACSZYn ;^O耘@}=v:Rt@Dmzt472\2\½-+_92Նz햀݅r*.0O2>$  X R?RW6 (0(edfZ9@\ߏͰx0.04`SݱZAN(4cDzீX@'eJMBR1/7 pI%ɇw~3ͽFHgP*h6 /FY SONIHA\ (G./wckN/~4oOob)H| &kOeҖ&oI;hf*endstream endobj 68 0 obj << /Subtype /XML /Type /Metadata /Length 1716 >> stream GPL Ghostscript 9.50 association plots, conditional inference, contingency tables, HCL colors, HSV colors, mosaic plots 2021-10-18T17:46:47+02:00 2021-10-18T17:46:47+02:00 LaTeX with hyperref Residual-Based Shadings in vcdAchim Zeileis, David Meyer, Kurt Hornik endstream endobj 69 0 obj << /Type /ObjStm /Length 2242 /Filter /FlateDecode /N 65 /First 546 >> stream xZrF}߯G<%JEk˖$NX%)@ _{$HnbqL>ӠL0/yŔBO3Y) tc&u0G& ɠ )a2%c`A3gL)g01f3i i!2`Q0mDdQ2mm`Q1gxDX4aYHk68gFar6I#3A|bP*L%F+ƬBt1B3hx҆HG 9 Qb[X 0,]6zR:4hfhD+P[-Q$̠zE (@*t E+a*0 PK$mK 14*N맟X {,2b_rX.;̾6DvaZeEܤWeڿ8cvʛf'i~/+,˒,^XvMY*/NWˋK7:$Ϭ'7,ϳ ˏ'xv'i7~q0*BǣrVXcq\@,y;E/Ua p j%sf9ȱ@$UXZ+MNhSan6%96U6m<;kG*?um9kkd_> stream xZKsÖN؄ a38)9ReTH\I_`#) ӏϋd /v'0N'.g8,)9SrqOe m[^ɏś*+tKxN %f}WoW_{!+LQ7J KUnn.Ŋf,.K8 gk~ ,`xqA(4Qp"p *pb%yp~KʊI ^VUC<Y)*]4MCQR㸯j\Y@8Yc^ m@֕)6i88gK^7ORݵ}Шū}{\{yD ~*H5L:Ё](tܯ R4s *WKn J,6^ˬE5PJ!@/v^K.z`* Yu}ԤN?0b u`Dq>>nO0ƕfT x/zoP8mŔ.VQ[JcBϼ $ =W{}s׃, ,~5'/8d:]$p lr价QHd?jËZ$ǠFKo ƣJ R`` 26$$] 4 'ZɅT+>D"Q%9Qq^K|+ Njf3bW2r@ "R h]:]I]rkSOOoh~ձp A3KZLחǣG <_>ޠs 滓vwreL2\cJ!BiDuPRQ\rtQgqF?٢]q^%ȊJO%>Xo2,CvxNɶ\}DVb,y.AWԫQ;` zyw4Ծ0e-&CR=Dyf@kҠ^y~jQZ܁8W6aicjۏ߇Є7#\g+mFL+-MFϒ/9ͱ70&>)SHʮUM^+pY*)9ˊUBH#֙P1OuZ )3T7V^E'MٜxTy %f?'xߥwa0pJO8bx6Y?ɹ@ImUq9 ر, A#d||\BMyVHS.3`A b 0yepך]d1oM! E vi %fFRr:֐G@`D舐 j 5Y`O+0H8L(H6dZi>`ls.8NJ#nmbhd1?-oM.M͂4G`DK*ԣ\+K1Ga?r]֖:[S ׹UUJ2Rft 9/]PIJV;bY'~~G9RD9,%a_ɺ{3!4h*7Y&^HKV&o jǯS&?vvTkAEnܣi$-ΖT#v C_wg? qhUY .cq/?xx(߬BmisїbYO[H 8 (NyM S}U mظwmmƈ~!N MD=Oس}ʰ\f Dh%i}($dNؒp˝̕U2fmvB8[Romz$ +6are~)] #90KsM61SLx#)}ۤK{BDy _1uk⭕PD1o/Ss%1c3#ߘN/6ȅH@uou;P7q6OBc01.=! v0e۬@vpJpf%n0unUsd^ZcR|s@)jLԖqՈhcLTs6Q0ݾ?V#tm4t+mexy)1~ _g{dKOP66*4g]oGe(Da_wIg}?|a0(i gA/G2m:4^R/Ex[hlX.2%^lwm~e {3^k OYe3M-{aq`XA[9^%?C:hZ 7,nsg/~~L2Ԉiz}RaB> vRKaCWbhdhE2 uAw\C3ʻ)a W4꾎erYop'{5s%D`a˭2U.va J=wR!E^j!D\3>ix`³|pି)~d?1!0ӗXfz]>`b3Gu#odGa>h?KQ1A#nb7~t9@3C˔ *5Tg*}/%3+.=!/0S0K*꫎ 8Md_VYsy[CZJeWmF6Ѻ4C7M"j(] w@zn E3ԎvصŚ pYȹ&_~meX:m8{mx4=g͇(-><ųo6zSsN@187T^Q (jӃ]f3JvK^57O Μ^endstream endobj 136 0 obj << /Filter /FlateDecode /Length 2973 >> stream xZK9 Ivdq9$J؇hٙeHJʯOUu7MrV\֐WW}}JJ?lu.+qV $&5|[J"QY:Oԫ%{THŮݮ$2aqR’}Y:~.4ZIʅfߋ5n-2 knB=ɢm(iO?3h.d9(howL%2ZQ6R'E᪗gݾO~wZgM\L2b}qumXW TSw[:w}K5HSizv|At@h^6`D!r+7xߗ}՜FIa4iZ/R"v.q=Iy3ʓծ/j8Z4{ B,M&U<~Q} lh J Jb嬷 >*I38quls :zm_:`*t]ឲ;r*cЬw2x 0hS{"~w8( YnemKZY–K&L=h9~$9MUKdKqucysFw7aE|,:rz1I8#k x">谽lfadcҩU TaC35h2H<^ݜїQw^Х2YxrJqO Zcl9Nm98TI,z"TZf<{2ext3@rMd]Sj[9b':kFy]?@r(T]v$Tb7`aϪC3~Vz՞HDfUc~0 != @f)8j3#{4YnfY?;m]ҟeVݹ>jpV)mYwDeD2F*r1R- Nshv#cBI$$:Nj》S8aѪA MBRGXanGn !'wSe#51JGJ@U'\\ Bf>B l\@8RP@94[ݛ kAp+1\i#2]pdၗh:*s-7qpD&wYUr,k!%B&qhe|;VW脰zfڟ.>0WCaWSk"7WG@Қ|4pb&Z E!59,t6uޖmIs۔cŖ? ΫE`OǨ2C R:/rR̎;#G|(S]L8/W>AМ,, xM]KŽ|܋?|'{B͠ 䏭yA N:țv@VlwVH,`ƙƙk4*RS~,9^",g5;v<RB!'qz4F#0 @EB(pgLQ M>?ӌ>am k8wi< &Wzm?tPi3P72ZL=>=gwZ!G bmUuލ[Lk!Xra"{ϓa5lym]saZ"“FjCh}{_1endstream endobj 137 0 obj << /Filter /FlateDecode /Length 2716 >> stream xYmPЇ]'NMĨaFJ $* VXSB.싸KR;gܝ4oZE<,~^Puo60qI4.ˌ.Irs\J͕U`f-W4IeF3گk>x.7EMޯ֜$ fޅBq)x9t%y<ͷqieyV,KҔr 4f*\ ,R4l4_)OșgmuMZK&@SIk_%yY4Ϡ"{[ ؀fNZYi/jhA"j 3+/Yl5kr?/KeY|rK,%^--p[<4uC76zD0Y  SPpfDqwpZVI89'IQ&@)vy*9mhaZL\EVx-8s*uSiҝBR6܅*$ru,HY|gI΍ 4`hiRyt0~t*خ@"W ^h'~8\;'!ck B5#pYQMHF+ВtAP<Xg-z kGx\@)h,H 2k;vA52*خnE s6 @bin8G1Hc7CUbu%r w:e )$ngŒ\뺩Kx1Wv3yž|4˿O1EIW- 9kӾ<ˮߒsͩN8r|5<4M1&⿗wY l;2vsW8F;J!sj/;ZN55[+^wWuh >5UoC<[!<{N9?gzfd-vy?y{OU>KJF߄3 00 O"lf08$ gb28"\).? ["|,iu*۞Pu\ *7 թ (csbNLN͜0*Hi[ |4ta4,EɘT!enzjp~sE)0biFnؓTcx34NZR.~ ]醥j<DgjꦽRÚ0XtG7+OM@ĝQ&)!A^?xf91ur2wC f#꽂v׏[R3 n͛=7uї`0H< Qt$>AﺇPc2@U' t]g;ʮ_eڼ]*#b$곰gPUHF/NGx7ډ ȁDG+/yԠ +=ѮtZjgid+8S :jEeBxNagLJaZ aNvCy?kFnj31%ODYg/ax[YA:nq (΄_쇰ۑ1HʚwR%7@)>ý3>@q1*}ӏLV-8yNcx%+L-Y--LfUN1千$bYhϫFdF9(Ć➗i'!j cWA$u]C"?,8tSIZ:د93enȩ\_:s.LMӔ(" :))\Z.Ѻ+K*.3M&\flY©kK:@%2-ZF<3zB}[;)O)Ę@J ܰ:lWՑ-qɁFij pM5űt,y&#Nmٶ|NfwqA;c3ۭ1uC~Nm%YoJ_tQ6gsư=n5lio*,7}sb(1rG}'SsmZ6 ". 1ո-Uu9nabcZeK (%| 9t1ڧ뭪G]P4S3 i8s*2&?Vg  ϠMq0bbZ stpFa\(,lp,wn.M av27It쌆Jk{6EkW+ͤ1[ _1R3ckըH!t=N1mS;@GJyH]׭l4e7Y +TFSdFyB:hz1^Rc[ $nWCͤ:0}W苹n@|~hFK xMUO6se ѧMBUzRV5lr.PxB,H27in.Pepolza6m7׾E_7Eyt8ktq;^5 ?Ʒf~gZ'L(.ܨgLybx Cendstream endobj 138 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4448 >> stream xX XW@DCYV13W\(*F\DThvdWTdY%AܢɋIĉD˼[@ _SsQ0CB1|ʨ)L$_"9+CQJ Xbϝ=QmF 6T?ySR9/j{|thpNW<yqg|Uj%f 3c2u|f,`f,a1o fc gyQ3b(3`RE琅CU+S_YYV^Vo[Ood6Kl1l0b{yo 85sϽm`g d/ =f0K ,)M;NѠH'}Ov>*+:+bר PA3s hD{G,W]&5c74C|z\ 5٫B+/ [i XGrHfA@^J\z\>M^:Yo?!lm5$`Rԣ R(5:OL!ӧ!ġk"N_|v)R5w.k*ZO6ûдPԑ`y3tL0Fqf%t۔ɸK}(={Or2 B @~S` L={99<ߔ~t•ۏmaud1Jcl% ]T5H*DV/э YEkH֘$q&b8#O1F¤gm\fw9?"W;bcۣ z)=qvFSq&\|΃-W/GM:NK_֘.IW^klPR.ZEX&}YP ߩ"B_JG-T ]sh#U}n}]I )N;BTSHݔ.nK#eC5jN|>Axp&j V{BևlXm ]xǫBO*d>JrGL uG,6:i 2M l5iC2lccVnd:AaW_ ؏\}$]5+*P Tp Y2X'C_Q~瞑72#I1k$J3ŔGhC׷;ڏ*-NR.&E3uhBhKt`Hvm_4ʕ+S/3Ĭ=4&T7?sy*,d|#OxyxF<+l9j!R$#IPfhńҾXaGf>NIEdbr"s PIY{O|A^Ѿb-1@#=PC/eA4:䩔:&\c}p*T`f{4 76T؇CBVG#\RU>HRAAFA_"X]7?BNߨ~Aξ~7X?z dҚ vYk :eRJIeHK4ok`)ڕޙv0&tn2݄wGoRDŇ lO?{АT.C!*+yx@$ $*4@ pz-f -Mfw Wc[z%uuqꓡ[ö67l04nFVjU\z>*^ _y?$j2q\EM8u.vw8 9Z0 +WiYA.͖TǼ>(5?W3l}xB(ݡߢO22Y\B*109긓6; 22`ɗK}O Wconxi[mȍÞ$t- " Y酞׫ CJ!>gn3-Gz9Q(h; 2jjFXނImRg^Tsh"%I3Z t+x4c1 $HNI;ݑ"cvQPr3 L<Co]vPwa:V|'ӴfkĶ>Ce6N~#I?S~Li;llgo}G'g _|mfiKdXuh]ZquBxrb x^&QL*o|oW+ObIƇa؟$3 _/` !"}ꈔ=Zm27>bnsA_#&H>HQlŪ(+Zm./mcӖ{d0?Xk3a e endstream endobj 139 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2095 >> stream xmyPT_{"h@[^[aJeTth7p EqaXnff>) -ݮϥLFqJ)c$eEcfIL$Jy[{+d>D" (vaW~vW漹skuyޝyJ"L¤@v FF,_6R𓂟W6K0c<%H6g0e2sFΙ#~I),$f254MLDlfH\45)ڌt!]AE1>j}fE/r ScӴlJuTMr^+z˭%0LPK2F.Z#@Îf9OWFAF .n .3Cx,Q5'.z 'P~!\ }7&ؒVY^*'di<ijr#:@;QK(_j묎ȑq3.< \AR! JL"db_#AMJHiFtrF <\hh:s1q'l̻1& | B!Wbx}"KLޭO tBs!3TB3ZiνC﷿YjL47mK>v ={Nuٳ {^! C8a S~׷}Gr层=FC[ћ\%V{叠T2Pt@[r}.lz@2x;REgn9kHٟд .2#֭.q2[M'0G}_T+m2"2oʶ#-{YC+<#{!K,K\or5,b`aQM$t1Tt4ؠsh{ (Q>T{06aj<Ȃ$nц@mMz)vU^ADf'ܠq蘦6 6B# :,y<;R?qIzp GT0VBgdMC+t1M?[v$!GN;rfo*&$d;Le=ͺ;ry+Mӊ8&1P.)ЧO ټ\=ɠf_ "qn(/᪊ V/dwKܖsp8IGs4}Fc\3p.ѐ/&|/ | ]ZpB&<#Nt!c×dWD)w]J}#c&1ݐJ}! .WZ=\eGd]q+P_#ZQ եջ5 S~2 hW6X>Q΋MB IRIJVf\ڑ~zdQ-p<υ\S})JCiC %b{ʜ)e:sce[3S"M,>ٷ~Ҷ(- S0:E-N2=-WZ]%Uν9fuf\[ L^{I__4[DGÍK{ueu brG)vn=~,sOΔ&z| _aG a{#i*Yu/)7 Yd ?0䅕7&^ɧ/B*`H~!sɑ٪yuջIh8{YHwoUa`"Idq]IGv=] z ڷB hj8KjZ{G%ݮrD 9[7ϼ^|[K?kf!/N6ƀAjsXZ?k뭧Z쯳6;QԿ.endstream endobj 140 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7645 >> stream xYw\T׶>cWƑA,%jĮ(cA)VJQz0zC^cLb &%11 hIwgZ-%L׬ w 6;-DԊ5/݉&oQCl5[aamS~0wrJ M>KCvzYN6mƔ)HF״3ENt33nZ-}˯_ϙ߻G=F~բ[jND0do2<ݗ: Y6RGY4T$iFY5,4oҲeOۧ r?M+D{;/%AǿIXa/~hOO#op w wv Rt$\fhՇj<`xk+lOƐn'@ #-% Lk~t[IT\yBǒ@ 敺,G{+m`dm KA7 Ysl 7YpaʼVr#0'Q1 级pA{SP$HPIx<,f޼DЦ}k~Be0%婩nj|]0Ƕx]:4 !F֋4C93}qteOēbn.5ZcFE5d;йtfLI3f=~17kJ7:0<4.7 u]F>n̍]rh.UitnKO$}UV~;[Ce!YrIJ+NMZ,ct@nsu|*_sYA*^\{LlS0I_JXIIW$p@iEi24OxeTjV`&rLW__(nu+D-o6G|X8]tZ-[CvIT^bN®wY(K$"4 t%%i)V]Ώ.7m<܏3E=h:jؑc1M5mQMO2e? 4% XejBbҳ \iSX.kS|ˈojS,cXe*#8Ha)3Ye*IG>B8(!oxev;J sF%[Mcc,N om2̖ }kW_|OO ^g xy>Ya|`r!Xl֌̫$o(8&$#I_hlm-erxa [NLei1׋oݸvK S䞮#P=jYD>Jk$aiJp>iAԤt4큊)\kzIVs8tk?4eIexem͜ԣX@~{exTZ$;GQ]BpL/P^lX`Y }Gw3|?rVwjBby{8UԷU~DAbZjm#ƨAQ5PF#(#_mG_ E4+VRdenF2CU3]l)9AYްi847mVi!7 J'!׶BszlLEv,"*R Hxo*W( |)MIҟMYj[2G慠џJZv+l"%DC%iMn!7 .G!|WL9-;ZlfrUk*j Rj7s2/zrr!?|ȁ#EŢdq%;78މe!"AKJdqtsVBQLv> DIHHJ)),%4bZ+s ~tSpin&V#tǫk 9v*a:.[lY3<.EvtOzeŹ錸dRFSzBS,:Bݶ "FͥJ)q&x$h/~xi0.1qO+I4Ъڛf/ZNN&*h:EǰSWD{|8}`J-K+69s#0b/gm!Ie rKZ?:S 9ڳ]cD˚PFF#j&x1H۱D//%ʗ>(mD JineX|zL'lܴeA˻p133pħ$R*)"mj^Z(3#*AzҐWV r)2rPDE;{vl5j.L/ыg`}Ki 6}'gPvRS?f㌃hs#ʻITC\YWSQEaa ßN ـ*{UTu%|%|)T8gJrs(QA4N/iP?rGke|s:eIk|$M!zUh-O fchso#[D?3DQ!o $fM"gќsy 2"ZA$ =)$=S{Cgmؓ~յ_hq~t@k~1L@+5dHQ!1DC|7#njA]?MyڠE}p%44A979U&mT?4wOSg_%(EP*VU)Uҙ) ?47>] Ldt-}ξ%1xk}KR$)XqV[coX1 ji5P1;q_'>0V!s Neuy-v&h_k!"ijܸl,817ǎCr1!LXIdm}qE55A9ӦP?7m+$O&|b?Bh!"gq#T V Ut U{;w AU|)yfbZG$ ;"]n4S/E멋>WEufS4ؓ؍u`! WHN͈ࠁҊ6e90_~%%Jּ9p 4*yj݅%yU,^) |$Ňz3Uզ7d+򂜪_02 q\e;OvrHÞ=D0KzcWG1љ.1ތ $z{[F?΃QTCNH˻dA~UbOtlݕF_PEEx=x,D%D4 ~>6OF|һb{u2ϐ,'G }O#I(*WגM~^z- Gk_\k% sHB <;)YDdܸsdR/qH4Zu^Dsƃ|-nk 45ޟWnQSX zU=d݉;u=^J/igo_5I/XxREO3-{j&RaHn?VU"TL".38UFZq{A!R+_.{*[Le=x/Wi/ # 9tK5B(uvF!gJއO\d/;{0ՠTpt=sNڑFh2ECf]MFPBZyɄx`"/ҊbӸx""#5+'H|= E!x%OmJ7\?Rj4/TGTETre*-goE5 tƠ<{kIHcU?Mz͉LD➧\ۜV)!UW^UUCT<`3XJA!x Mdǹp?TBVi%]r%':(84(+/U/\PT$gfܹh=7u9A>*z" 4"BT}ɑh{R>"y!xB:$ա^E#LvHs屩 J6)qBB#M/Ӱo/m2Iyr|FKjvzG&(*MUҊ2?|IVh씌Em)µRt yWtSwS|y%n` 6S},aqUۢoFegކ; {&;XQ~p.GA#\.g`!-RHA 9#8_J"ՠc׮z[_As)&op|6 ^1ee> 'n=gz'·f◼#!*?%aOr*R9 9YŃ{O&') TJs|{p<*eZwIzHкyBߑ@C-5Vޫ=) ۽"EQ\a i;n!Em2D MK$U y6DZVLģ..=#kJᴰiu*$@gj4I;n 7O緑f$*`|g*7 l^T"QgLr!%pWdNE:= j"MO<IÇoajk76bRQј`|ma23Y&GN)ĭ+7<`{Se&U?zI12|l&+/i9/|6-tWv:vg4UEcznWOvR:$dDb#?!5Zԓ;Pr!+b("rQNו:67yɚ^6sD~痨?6O~f$?:GQ#3q+6odiʇ6nWԲ{<ٯzdoncsplA,{0@e3HߐTf.me0XG.1=*9k9 6V}]VRn`H+L-gBD;˅YZ6ӭ.,8ǞL錪.! d'SQ%cqD <hl[}ೖϷvnwb[Bt7̲ WL~]~ݎm>x]x+=Mf-yʃ,.?37UuǿJi1tήs,fo&"mX_Ǎݾaz_{( -Oܱ$!vdIPc`;]n'ң-'6޸ԙ3Toƚ#_En#[Akւi_kM?tQͿ숚8ѽ$$'+-+V2Xs8UQLhw9/nBEp4׉fNrY*iY%oSyyyt+r2!ѣ/c{| LmZ)rU!޿ZXqz  48z .\J/g~աZO;} IJ9E;2I+\7 O_K#1KZ;vZ46y{p8ϼ+_>~HЯ\z38¦tȝkM]LZ/ߗê3C*?tF[S Ym69aO)֩M-^L_K٫M8HOeSq@?oD##ջK0d6f?ACа¾j V+x=c!1* 3<`24z׼Likn{gz6>3ɘل)ٿ^fGsD2tױz%1H3V& NdB?~x]õRq`;8 hf՚4Y,F1pEendstream endobj 141 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 4882 >> stream xX TSw1jզ.uqtUŭ!,BHB|IȞ'E@Tܵjki;S8N[Mot7sy`t:v{.w}1v plظ-7;1gyk&f 2pG0qĿ"#&Y_>fLı/?)H3yr8qUA@ 2$55|dqgJLU5Z%{cȄFT@eV+4QAh7iAG j35[ .U6<l$_TTka+P]p 54l*mB#p}3/a]2n5hJXbܭ@*+M\ 䇱=,-4m lir&\ 6Q5o֞ 9JA+sFIYRv:h-`0WV4,tP_t6jҷo-yy2vaKX>;=ՍDOPѽ|H(%ڜ+~)iO7!ny{d[/ZoqCX`h^:zo.7ۡ[PQV&j7$V v_g! !f;΂4ͥ"/!z[U7VO ~6QC0 rBk>↪u|f{'SbL:6 04aPU4C[v$D>la7/}b϶Չ9V6iD1]]sxvzxztm- r.^V!{`:XFmeub Iw7PK'kXc*Q`Tn{re$Ưx/C< 䳼Adrv јZl,5&  UMZ(P:XEuZ_Bu &WfSiXq $HSp߿_2c.#g&Ϯd2}wRK huZlG߂-P'PD#K]Ҧ`EoarͿvSp4.ZȇOIrӝpl_ܭJP"Z *Ri/nn=ԻT/[1U v"s Ȩ368 --4zM:77SɃOFYB>So+@D%@5Hu)H<T|&i9ps ٹ )T ~5$h@?@ ҏhgfxw+{sm[ǀyn^AI0.q3* 0+)*T9ZwjlxhNyX&TyB,)∥[62 vw$3#9jL3̓ 7It8+)lw:_5Ed:)@jK&&6.!{n! a3`mv`][9X+QcjesaU V^2l2h)v!bo>ldkrFE_WƲR47'{?e:;~xvmPK &`hGf(? @G.9qT[ o x/ $`)Q1]`Kj8`aGǖv(Ow 6eWc)YK%aJEIL pKFZwitxgova\yyՀal IU&^ΒCiۢc! 2} t66I|-Wn~gg-g?*1s= 7ѪO!Y48 Ne}G\1=>I^FjrMʬ;wRZ۽k7(1¦~C5CLeaEGj֋9x5.a]CwXLJ]>^z >ŶA48xtQq`\Ĉ?_pCkXHʨt¡WhW_{mjҡi pʀTpJFW:E%R/;m5th4n/#v-QeatB7Նsr+.,am.#4$yjhJԛcX7L&5G0)M (PqҢQ r &* Rˎ Eѓ8Yޙ2su"hKe] LHߎ_v{Enh,2q0(L-J`IvA8Xue\]v pȿ {ipX 8a~"1Fo%Z?]ӧYlPfn ySFZi**mV851޽f16A%X^^LK784 a0C|1]4{0v@ހ l.ꩢ{ C)%5L=yq{"i)TR @6)^L')s^knu@Q)e2v9,r{ޕ8\8fSSYW% }ì+ľ]>ۊ=%oˎc3y>.\ح- %T Y 9~챾EYkR2-}e;yNtc/ii5YԯP=R3hR[Zc7CfKM{]W7F#7LE^8iFs9pj릯ܭ~˩i\?Ű+s4R:{yyDҐtfzd%l(KTPUlF -ڏ܅Ъ;ОTXnڲ\:鍛-1+4$ǒx%߱$L&$oOy}Y)w2>=|lܢb9J'8MtAWRװG$D9b$4Ғ J !Ú9Z崥,B_Hͺ*`,=5还":)ąFiyO?Z/zٔx {2/z@]%bM^~C? E 5MnAX]3}ڍ~.E%:X%i If[}&P?q> stream xY\vvD,0u}`MF@HgeeEz/Ҕ`JlX%Q`hb]K{e;ssw3H(aD"1Z ϳ\'RqXt"5j[L  FP6$OJW|Kgץ#,lXػz[쵰0b<\&Bc&ՎNk7liLQuV)l׆؅;bC}լsZΛ`,YlQdjzHKM9QS)gj5L͠\- 5JQ9vj55,5ioɓTa9w8%t>i݈\;̀~~y!;2+1mJAV#RRTiY1#Vc{w=O4c 3]POT>z/Fy싦?ųs7}dB+b@O f_95v{WmQ\WG!ǹJTBQbR A<~D$&6prDsf"pwoD|4JFf5HPA6K,\3w_**CG~0y Xoģ?ST>AICfAO3a-(qW{bɖ"9Gd-ySI4Oξ Tg88#=t^X"81^MiBh1Ng~y7'{tP$E tB~Ёx`+?^bp#g) pbtwut``昰bA +thRic޲Xp+Q@T=~`c;ͬFee09 ڱC1%*ˣ TSCG/͠SbV BҒ`>5ɠ]༴CWQjuܓ} CǙ%5L&Ҏ$EV"ԎrjCisΕQ( b1ى='5/# /0 #@N]ŞR 5~*u="F/9!`F?`IRagvm&5{"a]ru}A)*m+ٚ;Oc"u E~0k5٥U@1GRjg>a(PhU=5nh``+^ Մ5oY{KH3ˠS**@iSxBwb ܂bPGt< 9K!GO1%Gŧ%1;x5_1J2*u.o7䊭6 o1G~) Rt&7V!Ej]-DS2!p-v5LH v)1NZO lIVW)8֝Tx`pMs #7)/(J󾃼Lfo YBŭC 2ǹtTWef>aL'Lv Ȓ[#4,# Eꄉ8CU駌41/潁>Mv*9 <{CM<)} ;U<}'AB;$K' -b bGgGfkT?M}>L{e4 죂W/u2f{@ćlٔ GVꓨ8OWWv?#fNţu p`zI= &s.{mtu) bsyUN6b'9'x9UqCHQIy]F]3Z}ԖP\XN#=N]E΅橃"W5eHS F Qgf>`o[UmYc$Y4-5V3'XU{C7?#jOfڼv&? ~ݬUuMWՎjXxՄCy)W޲)n[N5 *wjrpPqQ !ȫDQKXg+Zgz c_w}dz=-bk!f5bPbFǖ0丸drJrf @ӻ|+ԜX]TS6 bkqnn.^[WNpĎ)ZYȰ^:n؀ǫ7(f*gքwsd+} Fߏ x>ђ_ >lSn`{/ R=_C-]xӕ~OkƐ<$D. iliq/ܲWUe~C7=O>?EŲ S"6t9qC {]S]nTJ(Qjg /eK-4wrC{xC'2*23*|l;jJZ c3?t~7>'Bx a\lE"@~Dج,R#P>\ M)>t)S{*]dMy?7w:A8llwtJx:l i "Ƌ,)֙c?X :zۆt6Cm_߃x[0}5đ4Տ4"?v../?6kjKֲ?zAя|)E g_w j{iq!S #4?&lX2<ȪwG>+B01Wgh5H]2>x2YD52%q`$0E^s hRvDŦƧE0&4% ݖkBt"*=S `4ğك/ίݸi  D3uUh?o$gg}\Iĉ:H$vWh1&tJɈ 1(ѧ \L9 k:c+hP+-*X9bSpYh%߮}0ztu~Ռ/Y~B~VM z0ݮ| L1:rSW2`*ʛ;2l?KfómNw^<Ճ+]1gk約guUWoʺ}`^ĥj{ 8XO= MYB\E?.\(?~cVLgfhYNnn*g"a6%4m/9MKmޣ;l #Ĵ-_e#6$7Q? _^?p2@\>>v@^ J𢨄%DñI=0-I WVYTA. yF\>ʒʬGb7*N,߃ -31Qjǰ&qIZc+c 3 Jx=yZ5XXmPiRNDN0C^(+! <̼ENuiȭ: +WŠœBZe; #G25_U9ymY9/>h83ǖ0endstream endobj 143 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5813 >> stream xX |R2 v  ( H}P  ([-4iIOMt,"aU\/?s/<9)j VSk*ZG=MB ?zBmQbYj zZF-fPLj5ZIRèCHj!AQb0JL8ʝzP"j 5J- SnI<"Jt2kgLIC[I 5҇v6Q1j(\^ز%'`tG}[a>>ycVG}L1PH?nhwh;*/5-:S ( yR j9%$Ψeg3qP ̏tKMpg͢-ODR}^TB#G1h4 9m@v_(ͶebK["9 _E^>`CtJ*:-:eAS0A4.sٷ]+Z,b[V\wTrlY±շɹlJ2Xn< yx6Q=ed2Z,-+/˿p( D;z֎ =Ht:AIX,Wes ,:B;:дr$̒Ѭ?5)ㅀŒ Qx"z+:s%x_|?{/ٽ>r a j|L"$t}[ĦWuђ(0SZ"84l2q qY8Pϰ"qhlKB}] Sb͚s?WUkOa]˙~AH7;?j́ ,m k':,9Ey+ƞRnyyIo3&s۠gu˯07A0H<""3)pLz]Ķi0*cq1-Gfg<2r[yUݯG76o~Vx״q G6ZĦ*smĀ^fHW Jv#qu,SvTm"^!n!ga\}m޼AI"/%z h0bη7{C͛[;+E giVىT'*"{Î#HVIȢ VA& hHtG]Kٓ>$(:tWޟ`!5P Zz{65lAzE)b%ais=?ކm>L"<hfe9P%HWƴWjS=E9]+y!].Nn_Fw4ᡮNjl|9]5PW'mkt ԂO5CeCp|:jw ~B SĿIFB {C#|TKCMr 2E]ʙ\ڈqg2yZh3%b~:& CmUP`(C ɵ{y0H4$? )P3 jJI~Exs3&1zXnXI+4Hēsd][![:ڎFO W;ڄGMɛбfhh?!~x:2>m<CdHxx"gvl#42¯ȃ;=!]á֬Kv$"p$|GnE-Y YtC8c!b# vfN2G'> .i1:K_ S-ΙZ'hw,Ww;S+uAwfiw~=yP ,]u-Z5 MFI? CFhTRڜj#-)ÔkU.`4< k9F_ÿr >f'GRGJoyZNv{#p Z2P,5t h*r[wXeT˳3l~ fs_> ɬW!WT% [_iiaJ.>[\b)h,n8P9Dv@\t҅ѿБ5y&S3Yn1do ]`"liP>$s t]tPkxj1eY^?;n(\x g<Oo >؍tpBF]z 8°:rbY4[vyQBϗ߬4V ~:'cqW6œ97h;=t P/>^GpPU>Pj#\}0{xY@cJ۰V~- :J7[= x8q`n=O+X-.z뒈P"6y;vR<R'IB#'Xo|BBg==V뻽jlV;rqٻs~U8 o_%l/^"=g!;`[f.MgbU B2>a&K-$H=S7HHز-#7ˏ: tu.RXP~L1] N3'Aå_ykŀIdr<7ۨi-4Lu@Ux,~fZzFO:|y0-d{ٜ=m9|Y I6vE}2{%uQFV~BD@Eu%H~Q'C$_,]%dl "JHɰv9hvEDZJ68%.NhpڈƄvm=k0NvVV7bI1yr){ oo@,+'≳DmEĽhw.>tЛ#h ھ4F_+{O*dYr#:2reF}|NbY[tn3Kp9wt0R \U­ے FJ@3PPxkGuN{4be<OhTWXin/1fԽy`cbzqj`l:[7(gѾO9(4d:s3&iu7V/.9^`Wߵ]ziZ TDSqki/)2΃ p02{>Nh4Q~wo ~fmw`YVL#+N;d)dޫI$MHB~}5 ?"H .ίPUd^EEPEkSdYɊC1$W d2(M8BIv[Ece]yGQv~ A'Ol9a".o@!&b$rΩ3s.P&B4LV2W\IU"P/r61NQ'Q6;I#W=zlnMiGk8fN`o>6 WsvV~$\ur fVbea;Vy jts.,2U5r|S$O;.=3P 9)Tv&6bޓ.qW[ZnϿW_o*sfUtȍOf%-UpgTܯ\I m3z|6&,hr}(ޏt #btR@;H'R+,T)0NX+ֺH"'g|,mx)Tv :M.7VjTF~4?K(Ů#lP\xDu6u]\G!euVe4$ʚL,v~fݽr p2.|)'I)4[\5Nwj.)4כer⃈7^DZl(ۄ >yUe9 qpW ~gE/Ś !_Aә][78SVT.*Eh9Ρ%兦js}zI9А;,"ېj̴mZts\%z+B]#$r"$!wh%D8II"H$O&bL;a2IlnUMi@bM>9͐!r EZTs^ $W*H3x 䊬e>N N_3gA'!j4EO]U\h/+% Xm&۞kxõ{i[M^!3R]̿\i0dž 1F WaYj#Nmm*E?endstream endobj 144 0 obj << /Filter /FlateDecode /Length 3182 >> stream xZIs|MuTdiV[Y2TMRTI6ݲFSPMŎ[J}2kG F(-~97[OAB*x#TdvN-'r2fpg 3wũ%7,$4X9bC2Xŷձ2I13iF$o9>gGCLZȐn- nfr WfװsÝfRiqt<(.S>ٮ0 mdKr ,w6TWV r)f卓V:z3ov"*r6*,feB#Bk@;X\FӗG?D텷Ū_Y'G1+|=vg8̲}|~X#UU>9wY/zp_g7E,6b-Wy\;}W4|gS*/z[)a􈊔 ~jG0)SyB\ he Cn-PjNY!(#Tt&[LIyW԰kR&y~xL``:a/w!Weى7'=):$2_e!wK,,ՊAI+"\pU c2U#8r2 S >T>VT7|ڍgQz$N߾ jc:NJNC6oyMܧO-(wta} 79v՝r8c=l[<2"|R{&~ojB>WDN>< Zp_⚯V$ZJO]T6⚑ uDZW|;o>QzU~ \+Q[r߮GSP)Fns _A,UDU6`Tgu۝sg1-.7oTj6Мg3I碅qAaĀ_[nC@kXp~$R צ&Jd(RT+aP Q/ysOa_bZ5(is=8ڝ[2=5=r@yq{ mJyA{"2h}F]R9?9nox׊s\X56C~r.[e*&~9>zn?zZ>熉;b9H+:Z*Tg]tX`TpBfV!{ߋ,)xU~EոMϐCO?}sҕU+@-H2@cZɼ,(u{B|qZG 4ԤT~*5#d=|#S/zO@',9Cш?FB*^Ѕ!rkbFzyOjjԨ:A8;P 2#r%: rݘ[vq aoSOǮ0![,S;.fv!;hS#Ui69~ { A0lو+*@@^ \ssr]WnЊyY22AۥeT)E bյCۦi`&85ªF7 N0ث̭}GqE NamGrj ^y_Q<ӘKO!q( #.x||298y݌+!Ϋ ,$vϋy9\l@S`}C BdX ^SϢxۡV0et+8Xd:uZb N\B锯Qv~kE,Qk"w\eO6[( c=pmibSo%B@Ph00,ÊVC)Ìx< ؀q8Ao8 ѦVIHk@VgN_8-wcù#ФZŢ }atT$N͓136 rLUyB{ S.. QTn\)^\l%xwC_Aa쒦 d| o/f8p]ܒuJ耻T }F Y7:RHdݧ>V`r ՂBP ל؏hlZd{zr~ry)>boGZO|vO SYPff+Z2$t1gJ۽˼\jG&@4xr拇m3 E^ڻ_ß#Wg9}Žߧ*UQCwޛg+B_W(Ny߀cn)+!(]?8Bt%@nōr0ES+kAMST} 7Iw-Admu0ֈVPkk.3O? q܀?{(tKږ2gƵC*h(&tQpkZ)u &R[W٠&\hx˦rj??А|΋ճ` 2> stream xZK)9asqZWF@iGg9zSUtܝ]I@fz~UE]7حޯ-oŗW@!=RV>m}p *6۠kI~gW)gs{l<ΖEJk+)lTnj?{ Bm]Y,93 jjH"6||7$W0_3#;-i!AyQ+ozA 攷Q@Xyv0fFCr,)RP0ޓ %D^]ŪjUS Rz]~6'{ZpP4,Ao;3=0H*!d~UiJ bh$Yז<Je>Ej+p ݽ>$kG[M!)Lr?A.b-EېQi;2V_W;VhS, ??AJFӝ H͌63~m !EygZ:)-#_B}n24pb .Ћʻ}bSTcS cң"OjQ{<EDt v/bX]t,c˯\5HBP EZ"K]c]ԀlA( bD]0>4(|~7R_b*I^^L--(Ti({O1i>+t9 1AҒ:/c2i "&c~bKЂ*oZyxaE})JU]k-ܙ[6Ёr /9A q*TTqk8^I*QR@,nRDM"TBYhGw X3ůb3"""`UC[`+R O†ʉHQ)bBm3Cw9?н]7V>zH%R0P%f|O(t™22B(fcӕ0ӵJXb(LݞXAA`[,4Rs_g]qRʁS|nw^T&0ۗ:Op'SATH7*g[*HrOhc}(5a&;#琡X;b:gh ةt,PO_$ǀⱂg5@4+<}gYo3c1|=OJk$Aoj# z@iɡҸ?CaJ=iql0s0+&-xጃẴN><)o8˩Й1SNDeN?5\G|$\-#D.u*tp`>vU(Ji2n-~x1\ATZxUtxVoS6[o% l9|ij0٣:8zno!,z Zܢu.B%9nt5ŏf07xU(tQq@'jBIl 21>TA< F_$~$dJkp!<zL׾u(֒K%IW2W ځA,8klNLd")  &$ k A+~w83YAI$PA7S©RS\}4g9i3f\Pg"]z!Z46K*,(AJ>JW!(˓G|I4x3y1ˎKԀG,|;?<3^ iN˗$y_MG0u6^''N? fjWx%fUjAendstream endobj 146 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3615 >> stream xW TTW~EQKz:ĘD]⸵*qHEv-v d*6ꯕeB,Vq@#ƅݱc4.;ɌI>rlMēsԩޭ}P.@ X/!.,_:mdh4,yk)GcyxϲPj1 aѣpGG!}$%6e-IHHI>uɓ^SVoOHOr)^kX ^[#c¤Q^ Q^" _om:S:}1&_]7i2ERSy? &RM75 RSeKfP+wUjj 5r(W*G@ \$.).? \vDeZ`Cr&nhĜ\625mv[a z-kH-fAhTʝB߿IЩ'FDk͎͐Vch,  O^p8H)f&*c"c ;q|<* k@Y-<~zЈ?JثuZ)*\_RD U"XުYX ~>tFc H!TkFFoKWO֌@WhiW@vV<Pa^ h@똷^)$3Kmi:̜?Tx{y^"~ܐTJD+ D.+آ|"OAƃpڴi4fiES$ew V'4 v}%g$Ja7TU Ж7O Qqљ% ֭C@4ɳ͕Ʊ反B;@\Q䩵B6`7WŔ$TkȒ/?,|>0 SsWW3B H: ̄J5옮 Κ)E hU;ZxVQU.F?NQ2Ͷm/f(?:M0¯dM&h2]z O#&ofb5NأA˃U:)^fvki1>n/>Z"Ek$L>8G;6;3_9bwCɳE%k1n qҁ8Yߧֶ Exs}cw-nNX;9>[tt\2~;g~T4 spR4 yԈ TqG=~g~3?^lvRI޳UWi5j~[%+QL蓼"v&B>w`TYL;RJRd.Fk IIu͑nSKg:Pكvw6Ws'F܈$-mڂ>9 HBWY uP\k(-v[*jvvy776v2asw~|ٳwak˻vbv1=?63b>M%|@)(7(-.^j'MNF ~):CjA^A<7O;$gеߥߧzD< Ly9r2=#Zg?8^q|ý{RЕfj\]Ra u&0[T'%k 'Y'pR!Tb7k3RI5)98ؠ%4;: %eFuk_{< sA yhUS|QE3Ьg. bKjq9uP {ͧmsֹ`* Lï|91hrc`u|]? _ b~ҘOMi>}$x$ߩk[s ChvVN43 1"07'Er1󊁳j{K;}^ @ˋq΁>(K|n_F(1-S7E4Db۟i5M+$"ʎbm 'aRDB=a{mC,%Zsi< p0:ؚ ڌTU!o8<,NUA.lYn̨UG>t'$m2Pt! A璩0~M<9TF8oF~UU#W8|=#`]]S\`UVL5Fm5<\ ;N )JN٦QK #We‰x/?؀<@7,:M}x&KMYsd޳)ᐶWK?ʪ7+ȴ7F(k3m2(Bc57bJITmOOΕ'& w쑩auZ>KCeMqI]A 2Ҥ2'mo3?zH~&yvdcGe߹w<W~_l9d3ʌv7AʮM޿Xzߺ")΀4ZEFkmt _"A28 cURb*)9j?Ǘ:Og>Qs,!} %v#g3xHIo8{@|?-J#OtkӃA@@^Zsaw؏8`UrK t~,6˨XHN$+Cԙj92Z@s>F\hqgϗ|uyƳ Ne돆Mh̆J(C$9{Lه?K,֜YWڣʒTKW/r <[en8h $\kڎwJjbG9l< Pz׍=[@2?ý ȁօ#*=0N  k $hH%: G%'v&vSA7bDz-?z_iwdhvp~=K=6,Y' xQ IV؅(D/ue HM$iJ[`7추fSRӁ@i֘ r =~U`+  hW"7_Rm;3t B aCz` ]kXFb6Dxbendstream endobj 147 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 636 >> stream xm[HSqg76uj8EQUOa&Xyli8نvɜ©$*"V/?q[|>_^$ 44=&wqPhv9z/Y8B(:)?:V)R\R=ة¶<$%vIa G**2z2QzP=u@UN)QjZj[ƶ}"]Q {ɐ} xY-QBsBOoE1tOz@HgDd 'hZ1#jB1>|C+]Nv%"kRnOzQ - |PF` a|20t>vTQq|c}yc+Y;omH.DsoN8 "?U\UAx~pةVc|Mi[ruBE,I3Z1Dye&#|Ka fRfj{:ewx+l2=O..e _f)4;✂{rwZi2e& GBQ64I<07b#~endstream endobj 148 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1596 >> stream xTTU0eD QD6'Ef@P(A1bAgDa\BP@PքBȳ'=vl*|?N{3w|=yy_i5ayE%yӜ8kQ72T應ut`̪aiLC> iل嵳V,ψ=;jtca~]yOG_+rϳ[tQWd-6Y)6i&M}o@!ZfߴT_ȌP*zP:ZVHj ȈQ3Z$ -J@LsDjk 4UMֺ`vuñC GP?UUqU^z񓏆K74tIn"ĭސ#1)X,N/ԂzO%\8aG@ɳX. V ݻ=tE@68J*Ք TM#N `!blߥ'&LKa ^VrGŒY 5#w:/S)TꓠI dxůOz&jvMEq8yNE;UgL,F_WT4mi<[gחMºIk+mJos@ jsCwHn}n,msq`[]#7`>R,$z28w}[ˮ݇;ު.ʺN:~)lZ5V_''N pO'j2dMOt ]*c1jp0fDdH{q;RT'Kfq(dxr>P zH0ZW@dkրp$V՞ozVnZlXV/HǑB@ҭCg(ElU/Dq> fiANV!G͎ rg{;vOT$^Wi=a_ c\EË?f.+mksWYcq@p ]ho=#IY,yTLjL-NeWh+T(x* ҙ?DI4dor(Ed osf-a ]ͻkIJF7xF4:^/P&\t*sH% 1y͒gG-2E|?phB p n:ZeE.pW_d\cK3W&b:Yi=X~?ƃlNJnB?nnendstream endobj 149 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3241 >> stream xVkTǶf" m L@A"DHx 3 "&JzG!DDE1 $(#QU9ιw]kVwUϪ+24h6 J.L+LIE+Zn N I2 cÃM S5 'S^.fs-L(P89.pQ$)/-?3]%´\e _(rX /X_\V"+[9o'gׅEn)ʚ"TMbKT8"H`3קs7+^ 2?Fݳ9qM[ƢYe'@nnG-s }f7m!P@9yɟB\Hډ5+wԊ*1L ބUppjRxMgZTV )·Xand`q2L6N!lA*gi\Yn%kJ2e lG.n [rts#+|wJ&˚2YJz>9żb5k0S1%>NCÊ Wԏ}UtFܭS!I4Z%XnNbFRt ״[4}3X@#;t%w7V8Qg e"AMb) b2ZkIӝ0=CLoGƀ;,.kOtv&`rcjDFF6u֍0:SqDjTÈu[fL \ziq/lPߗ7|yy69vx5؁@'0A(%iǷ_vt G~D܃yV?"VHDKmӰ57"xσGm{.>r w<a?klLV8$AA>.aO?xJ n P\CO5`G/)WB"Ze{z;`UyB5秋v`I 5VwFxsX+gXXoMRB^ϝihG0#ۅ|64K%?\LiP"I:h~jn*ڛp6 :kibU28Κ@ޘt|k1F3$|7]ÿ* Y2-RWjkDI!Fr5oS6I.vB<9Ǐ][”„͑8{SeDQ˂}t,9`0$hZuvptQPV j7sdcrei?VnƄ~," H|\'}8\T<'K_OA % S'cS~uΛ҂d~z65X?gOc.O*\%nM:8^Q(w}ųP%2zC@ 3Oa@6]F5Axa}?aPC9X ]9~ a8Uh(HPWѦGXF<[wb+aasHн~~eŋGz~k({^_ /l]Z.wv ?,Nb63~as67LRRN,7joZeVQbO50IFrAdlm>4LYî:p*V{}XZ,ߜ5|;7<8ܣՀ{bf{t,\'<qi!58 Ѣ'#W' XT}lӏ{b=+2l}$9GyA19I,UR8tɅ> _'b0 S %$mpFaJ#of#W>X.xybeΧ|;Dqpd!r:1./H*4T."`/e%S4|V d3jaNh% w֢N{ :/Ҁ 2GrJ4l1@BT X񣘃JboĥK.6z"厮mۮ[jO/]? %-.Tb@{\{ïULz~Im ;ZbSn5(ߎlQLISB̀Na. c?/k=~kO6[FX%%8EzM~dI珞One8_,꛼RYQt2꿘+`yyַ} {'RS!endstream endobj 150 0 obj << /Filter /FlateDecode /Length 3199 >> stream x[ے}_H0e"(DZSvIb٥ִLZ40WJR\ 4~kzovW+ob^4Z:;\k2]}fqdlos70wvX !?7%jnG#Uۮg\?lowNO aبh>DC0$x\*w]s锣_^jqﯯĺJPaWs2R6?WX+f9NɎ7JNFN8r):uh-6n1q[UXR[)&ʅmmrdN3-&I)(pxɎsq8֩S ub &ciZ -9(8bƆ eLu=70IK]¤f}8_ V4ן]q{?~8aY/:c&5Uc2 yחAN'wp*̒eADL,̓h# M-֞BxKA%cW#+RKd)&@֕* ҟu# {}X g8Ëcc"s3DP0b Y?6|N*}w z,RwBre)7g޸9d2m/7coN m>/WȣClWn?_K&mj s!@;!t##=;'$9pI}8wB\w 45锲 iDI/hL0A9d# xL;kDrz0t429 0A+tAF p<D< ~<"%O98R(*ZX`#k%Q2-,V@&=ӔAs9)Ih+l5Dҙ XfRPiu߱)MσE wMV}?>NPi.5dQq@ʑ: ʞQ>-M`7N3&H攕3iD 1`cvD FPr$s~R#99ZfO}<[wK>%Dj,\j֩!5Oƒ/HPUВ풟DoA/"ȷd)L -9(zE |K77"H*&s)rMő5g}2( h7&AM]@s,Z \yxAF0N>GH lHArP:H:tqtRZj3uU}B)t]cViĪJZm>$SKdIrnh a ()m5Re/ꪥJ$12Z*Z AJP4FPLσVY(tH\^1Q/ %{pn%<.xz`[NԋbIRx@rCB1"^Tl7JꮵEL(a ( (SQrC '@X+% 1ף f& &f1ba*GxAxHuc>uz|e{zm'%jw;zCmOn;Ɓ3.Gig#mQšގtOrk7hh[k/g~rwiV[vsa9_>'/yƍK=a;.F),y/""{V/{\Ʒ4BeUN!N{3ƛtXyqrC1D@tXޖO.[~5M#+>xegaֶ,,heF$=΂cIpJSBz7: ro):(DWzkc߰lا}CG$z?9&5 =)O2kĘC aEsjϗenEa7Ɓ"M6]'endstream endobj 151 0 obj << /Filter /FlateDecode /Length 2893 >> stream xZK>('b'١O@pqhڙe4/ܕSU$ș];@IvWWy;O9O_{=tM3Kۙz7%̰$EZ/sĤo+lq9_jWJpLb.8qpcme ܂-۪ilM QXE42)ZJ#RmŁl˫I:qD<}Jz&q9y恔̸LvzGܟ$ubM.c T[qٱ;VlRH4wI(c[As,PSyES;#H-4dJ-Rr$̗OUg,j,N&RnNq[P;8"\*cx C4'qB-c4-S*ղӑ_AA4\ GGC1nj8[ CwDĎ-b'b*zxcM&+'.O78dc7da~! ^j}]7핸Z`TN‚~f3F dssS)rʒ56iՕbU4RnR-4 K-6M@w|d^;yww6Ja#75 ga>1kz{ BX,ejA5֟J=m^8.z8P%j;>No?Q\n-3ܦ1,,{T(4ۉ1".~VOѪbPAلyH_3+,3s *v31-?^V$NQJwM8%)xSۇN4g LH#j,M>U0tby@Ic;# σ^IK伳\*J|Toa,-3HgO{*V;a1$8f(@QIHEc{*b0M}mV8K"vPl)}dzTpڶ m);Gμ:vaZ(n%s1$E+y$vf61ivNqQVi=q jvEWMl0c^Az1ܱh/=i1/~fQ:R7aWò:y+F>*䎾2h@vjlBbO˫A\0:'P*bT* 14-K¬Skuζf)=dh}FDZXeAΡҶܒ. )Si7-ĝhZx8/VDkagth|yeJםBtԚ6b p&4NYlS6ϕ{2 ?Ш5.}W& CYLBgH[Pdأ҂꺦ڰk"bM)OkK 8_<Q%* 2O\nhw}I5bSB~ݜQ эr6Eh6; O9qnEOko B+5૪PbV>l'Q݃]7]c_G~}6Ce?Lf$8P&XKdMDPa:"AFP'8pLyYujan20t^K{t[!n|:+gG<ƾ/y S_*Y!FV:e/+6T*|ق ̉vwP^cX%޸ hK0CoF噕 esY+7Ñ5JH 2$r1]ir'Ցm[ZCC 9$E9ާtxƺ0RCh}E8OYl‚zaoѼQ$ϻVkYnT~aD͔W m‰AZ[}ķGeU݉R񰊒`r:`MȿCOd!Е븕hQ} %t"{IPXh.a8k6 @yN8} (|R%OI> stream xcd`ab`dd M34 JM/I,f!Cܟ^ N*oeyyX&={3#cxFs~AeQfzF.THTpSJL//THKQS/ f*h)$f$))F(+ka8.  C/k~l^}͊S+6 }g8=sVGvuw{yM13S-9> -~~rKq ^ryK{v/^}{i' vؿ\8|?XUg|9mE]yK.Z{{ҙ Ņ{"z4=6,@]7ea7v9soIﮑ_u;'7vy^tͻ /_MzљtJJZw{!8|3Aszu?ƽy_#BlE:nꚿE~ t}y3ؿ tWvwԖr(Nʋ.0{j'M^]WS'/`[u[%${^O=g,\6wℾ< P"zendstream endobj 153 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 1980 >> stream xUyPTW_ThEP^E3I@ITd# Bw"xXedDnYl塢h4.e\X1Sy̵ydjR5un=wΕP6VD"qYNI[?fK9V5Nޚ ۸綫L+,G,Skg=imvCjt@e4$UJ|ƵR &w X9s3&,{R6 "aPtX8y8eZ}=bPA|c *󮲗3:/63)Yp*f-^^v馕ɹ} N*\қSyp 8 vs(֗Ct<[}, #}ˣL޾SǴ͆ hu_y=wM1dfgeQЩvN̍ЭЩ ېˎ/ZR9t)\xRoUқ3ntAGtq /1Kn?_i8fHЯ{3M-͇ZXg#ƅo~@Ddħn+L ULig X~UptG@FtZNB&N7^R.#dv3D`L ,BW[?:O[!,qq1ǐ5*BPln{ԢЅw/c1~RЫK*pk!|K6o/(a ̓k;$ i[a.`E=C#=8Z(0CmFaq_̓\`5V ʯBŜ| gN~ɃNxΗF)s5 )WMW%,Q˙H?pG7&s#;ύ4z:>XZS@cd%Jz yGS(ss/sDB1l HY:o? ' ;Ju&w:\K%>5.N]AT=ab.&0N@\;B7:p#Z%'t6rהղ*:my^CCUE],*|NrEf ċ M?r Tڮp ~9*Ò}@2\Z7o!4Q}(pȃ(/1* V(ǏV'%#9*|xV^N? ͐y- ;Cә'sa/UY3bzLH`=K>U:xx?@`Q]׀vTWl3Y Z\#!?]*YP؋_sьf t6(S%G9YD!䫭' e\WP0+WEi4uk_Z6ɁҎNxnΒ-I褤hSb2Y8iaZjh~:36ji`7xeeyyEUx⪝_}h{=Eendstream endobj 154 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 335 >> stream xcd`ab`dd N+64 JM/I, f!Cß^ N*oe}zxyyX~)=A{,(fF|ʢ#c]] iTध_^竧_TSHJHISOSIP v Vp Cw"`} ֫ ʾ_<}aߺ>> stream xmoHaǟVzm\"m" ERiMt9mӍ9ݭm۴ѫBU~Nn`eЛϋK!M(}wE5wGNVoPtP?)ocD , f_)&S-$#SO;“?V x$- gxXwC+`Xr&p֛`H$a6_XZ ;ٷ+*A(ɭW m! i!%Nթmzs(+~Px+s@q}}ՊawkXOO@=r#+:P}hу' 5JB1A/%j{r2@Qꢵ!T*IvZV:$B&rӗfSfm1+/eׄQ X.Iendstream endobj 156 0 obj << /Filter /FlateDecode /Length 1993 >> stream xYI_ȥS1+/ AC @Z3E{HJӴdߞUoU0^{UT .kAJWJԫS%׺sY4(n2!y'iEY1Oj{4$ Y:W)`v>|O Q`~713?Lڑfݯv`ݬvvX;z"',kIsS ]ʼ|!{c+`Ltӳ;-GiIeqӚ^ {g/'.28TNAVbP9=235ӊ.q${p(̓߉%g=)ub4bbہ]HlځYEǾd]엧Aә&(oQMD'H  }>]eٰ:okYP~x0fKNNKDzi!Rii.5? uغe<XgxY,ަtdGh?@Qձ#X Homu_[ .{~\Y6͏MEf*OU@cmV+C^o+JBꢠrGrD=9xB@Qbw!e&p\0E9븶+_ׯf %}ׇ͒l*-P`ŽoaΈ urTP@Jq!v.pkpjp"wu]%e-ぜJ)a0V:r91w!UvTl=p<<Ñ+؝0΅8c2$Ixh*N}y$9-GA]$]7" R2nM(GF4PzwD6RGuKI7 IC sYu'$,=ȕn sa""1>9\8)4"MAax\+08i8=i 4˚dJ&s;+&n8:'m +eM:?ēlFWtF>z: #šJ cAĝNP"Z$ypX콯1q}uF2PJsb):2FeI7K'>:E< R9Og֫N_a> stream xcd`ab`ddM,M)64 JM/I,f!CO N*oeyyX~"A{-*FNʢ#c]] iTध_^竧_TSHJHISOSIP v Vp P4ĒԢFQ.&FFk3s`-w3'}Dݤn3Z,gަ:Ɇ)M{'N)S'tO2Ffy3le9{<_~ -ߴm3fn9.p{n}N׻ga_fte`%˜Mendstream endobj 158 0 obj << /Filter /FlateDecode /Length 1452 >> stream xXߏ4~C'IN'8"knmtǎ6]@+&xo<}7Sٗoff|? $%a+l<+3R$AVHV)A~BIJ3 VtMo"g$:.$"+"?P:ͳ2^u"."Be`!~LxQYh.*zu*28T}uGϧ}wObi?҂?O"(W{C_wm.7c~tP4[~ߟ7S& y]tr{ |cijaj z7Iۼ@2`[,ň)|1xZR",ʪB>etfiΑƀkG|dY'M H!$6ip >Crk7\_1Q3]<',zҞ{Sƒ&{0/)5z9ސ<ϨT9+oYM*>=/3.fdݐ:kp n-FR1a]1Fvp  D/*t. ςa/ƦGMn4Gace ao7"a׆aЉ)/d㺽M@FXV:`jÖJ|^<p .5`_֤&C8ДTu$\pZ߮f?_Ђkendstream endobj 159 0 obj << /Filter /FlateDecode /Length 3460 >> stream x[ێ}7ArVx 0\6Ml@샷M=kgv>$R"imiT,NՑ+ѿy[_T?/x{ Hh3ϫw+b6^fxSq)IU߶W5LK˙JJ Ww\ǝq!zdL^/kvxd]~] C?{ju^a)[p-V.dr,ўs_nn^R ] :lT FS,kh|M{8g!xPod |sAO`.E0'+m{.Mz%qyZẏ7wOvfy<˕0& 2_kRBHfKqfThɤƅHB IuiQ5VU8xJ+u}!Fkk`B54Fs(tp#^ j1c(nΑpaBF3|W v O 0ۛ*|%u8Wҷ @YPc^y:VIP6hÒ4D$fX՘ 6<菽1^ uG|;A“\-ar0Q"&4Rˊzu^v"ER=HXD*ქI>o`_Q>8J$;J%bdǣ0}TQi*T:4/INd`_Q}I>$12`L[JˋSH4 H5QJkؖ ~`,t5 A y`dgaN.=]5u7a7Hfδ`RwImkdƇίPҳޛ/n~&N7f slMKܫ;ws=+t؄cְmw \! BHp<|.'9Ekv/SE"2Tۏ{a,%)[؄Ps:YDXjw|]lFpB4ʐ})@@$9N5e^XOMunB~L z (}|m8(Хn}Z",Ӕ{O,ɻ/oÔ\0agY}\?͜hȌ@u+[.Cc>mbt)}w764+vΛVMJ?vwNE Nc ԩPюDNa&3w< jEgS[lQf6|H0&JAJ#L㵓W;}OAd_w:h$[RoxU/TE'ý)a S-鮯]@˔޴\E 1|ΙCSΤ x֕ӯ=%v%/ ޑ5c+ut:6:yamH+]Whx~ERH\[񤡌H!'n3ɮ^\qpy.`zbL) &E39RSJJ[~s0&+0̪-Ҷ'CTJ\ν8v9:~ZoߥAΚC]YeBfd?d\fWaoC@%vj*_B4I-sGxh0MUF;:O )n$| cÏNmQ|γFw lG8U T8֚rG۽:?6UKH}uS1HqNh ϸ>9L5AꆏUS;_xNendstream endobj 160 0 obj << /Filter /FlateDecode /Length 3426 >> stream x[M/$^pawArsPf2Zzyb7"EWچU-/}8#Sjկ+濭⟇C=\NZǪ0UUF UV5kXT4 \T[M,> ZWʮ7?ޭ~GAsᩣi/b[XvmӶLj #_Y8;JJe&i[z^DbCL7pcx-p/?on6W[<ҴVT;75ws_.Սq;{bJ2TSQpDJѿyZ1iƬJ[*xÕ nD步82nE#{Z\mlZǛ9E9X4dK4 ,-O$xF;6;zRfͼ5״UZF)CpD1m+LLaFUkQP|>khom^F*Qla*#Z".=!kX:oEP¶'fBh%=e[ȫ 1dj-W#oZuOt'24XEw Tthwy--I9yM¿bD)2"&6*ٛwt|h} XjpS>C޳>e΀#a_ X182-|VJ4Fgi!>cB 3Nj.`5*%*J@jIsRK7KiH-##D外:P6otZsOt'') ,RZf* ) xJ̀(-2z 2'w-keA˅NrR ʏ X \\ļE)-$)J9A5#NBNi0QZױDעE5z>xy E%9np|~$b 2'pч0RheuʄPVgBhZ (H4EE5- G?KM!ty^Fb=6 zOE.[iKoz,Kˠ.kjvԲ1JWz݂9urTXU \˘puVXNuPEgLWJ]]pUqc퉆`%-1=S&yzF5˕Bỳӗ $!$KˠtQ+'\+3.)MǤ4A*MTV5+-H+D\)uqʔЛP#OR r xZ yIk5M嗾Y`D7@+--zf&m*k)uS-4"fr=d Kˠ0sQ 'f\ 1^tdd7Q-ӃM`IWkLii.JDW<N*1F'4N׸Ɲ6%݌/pmղvO{+-6D?)^ޭ =jUcxDZ\]B+| cy=D3x@W1UW?Ļw;n`JC]q}|}\wʗw⺰!G"f-8a`'FDK{SȦphKN?kuĹuڃZk򏢬 1T&A45鯝Qhs\ >/MwRJ| <~avEW؄\xéHU$-}ǂ~_RP|)㦕_: Lo`ikd)k,2>|" $|b¾6cpҵ(ɘ'l+ V bjeS;d1wJ\tM!/Q;_?GjGӫz>e$cF0@sɌ*yn8:Fh.W)ѾHvDJ ĈܠP;l} Veb EُD׼~ (pD8@ my8eҶW*˼"EM72erqm/TI^np7hHT} gmѴv&c\.ڔ$G겂[ IKWc_2߈&fJO3zo+E̚A }vL}dg,q\Mgp:jT A0Xy=m"))R K w4f^yҽ˻E->^k1A9-&-6C|rXiZ#r1T$̡|s:]jt-] v>9jWneqwwQXи#ORէMN NJ^K;zFGA+1B =wWCu!{j_싈~v]1. KGJ, D(<4t]]5AS`ɪřW3F@;~ݙu.N7P9Je09}7ߟь[w %`K#XD׊U%Ks֗s(3B |{WduY*ү'feHVFۙR!9=Ow]gOBPA 㳻lDy&%R{i6옡lŇtWY6i/K/( qIU;Sↇ PzɹGFy6rF%PA5>ńA?]W̺qPʐ-Ug%q3fR?ȇ1yS Sw jޢ\p%3V |,3`b9S_Rcro#\pImv{z H_3m/{? +Ro@% ƾb|7(/a TZ<g 4A>${YC׊"^;|Db/:h3%5̠}?8\ñglLqϣXibendstream endobj 161 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 495 >> stream xcd`ab`dd N+64O,,M f!CgVY~'Y~|<<,~ }O=\1<=9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C53000303gI} ֫ ʾ_<}a.r_ߢo}gZyҜ; >_/ևl_dnE?&ָPa;}wj\8Vh1^igxb{3e͙b(dfM։e+l~dY}["zMݿ44&$J\p흲)fWjJt4N6v#zȍSݒ%}XtᏀ9^v KHH<g7 }<> stream xR=O0+<:H9|vLj%Db6R=vRD€28w{=(<|3 5-ӂ6r8_!π{%m+R4U)XC/VW(Z܂l2harH-;vM:5҄s6>v-{֭c>,B/Bh2Qb|(+JL'$endstream endobj 163 0 obj << /Type /XRef /Length 149 /Filter /FlateDecode /DecodeParms << /Columns 5 /Predictor 12 >> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 164 /ID [<2096f03af4c6169fe224424097cb26d7>] >> stream xcb&F~0 $8J0?j?WOFe nl3y"H DYH\);@$*0Y"H`Y {l2X#L+dXD̾ l9 k 0, "royalblue4", "mediumorchid4")) mosaic(ucb, gp = gpar(fill = shading1_obj)) ################################################### ### code chunk number 48: shading1fig ################################################### expected <- independence_table(ucb) (x <- (ucb - expected) / sqrt(expected)) (shading1_obj <- ifelse(x > 0, "royalblue4", "mediumorchid4")) mosaic(ucb, gp = gpar(fill = shading1_obj)) ################################################### ### code chunk number 49: shading2 ################################################### shading2_fun <- function(x) gpar(fill = ifelse(x > 0, "royalblue4", "mediumorchid4")) ################################################### ### code chunk number 50: shading3 ################################################### mosaic(ucb, gp = shading2_fun) ################################################### ### code chunk number 51: shading3 ################################################### shading3a_fun <- function(col = c("royalblue4", "mediumorchid4")) { col <- rep(col, length.out = 2) function(x) gpar(fill = ifelse(x > 0, col[1], col[2])) } ################################################### ### code chunk number 52: shading4 ################################################### mosaic(ucb, gp = shading3a_fun(c("royalblue4","mediumorchid4"))) ################################################### ### code chunk number 53: shading4 ################################################### shading3b_fun <- function(observed = NULL, residuals = NULL, expected = NULL, df = NULL, col = c("royalblue4", "mediumorchid4")) { col <- rep(col, length.out = 2) function(x) gpar(fill = ifelse(x > 0, col[1], col[2])) } class(shading3b_fun) <- "grapcon_generator" ################################################### ### code chunk number 54: shading5 ################################################### mosaic(ucb, gp = shading3b_fun, gp_args = list(col = c("red","blue"))) ################################################### ### code chunk number 55: haireye1 ################################################### haireye <- margin.table(HairEyeColor, 1:2) mosaic(haireye, gp = shading_hsv) ################################################### ### code chunk number 56: haireye2 ################################################### mosaic(haireye, gp = shading_hcl) ################################################### ### code chunk number 57: haireye3 ################################################### mosaic(haireye, gp = shading_hcl, gp_args = list(h = c(130, 43), c = 100, l = c(90, 70))) ################################################### ### code chunk number 58: haireyefig1 ################################################### mosaic(haireye, gp = shading_hsv, margin = c(bottom = 1), keep_aspect_ratio = FALSE) ################################################### ### code chunk number 59: haireyefig2 ################################################### mosaic(haireye, gp = shading_hcl, margin = c(bottom = 1), keep_aspect_ratio = FALSE) ################################################### ### code chunk number 60: haireyefig3 ################################################### mosaic(haireye, gp = shading_hcl, margin = c(bottom = 1), gp_args = list(h = c(130, 43), c = 100, l = c(90, 70)), keep_aspect_ratio = FALSE) ################################################### ### code chunk number 61: interpolate ################################################### mosaic(haireye, shade = TRUE, gp_args = list(interpolate = 1:4)) ################################################### ### code chunk number 62: continuous1 ################################################### ipol <- function(x) pmin(x/4, 1) ################################################### ### code chunk number 63: continuous2 ################################################### mosaic(haireye, shade = TRUE, gp_args = list(interpolate = ipol), labeling_args = list(abbreviate_labs = c(Sex = TRUE))) ################################################### ### code chunk number 64: interpolatefig ################################################### pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) mosaic(haireye, gp_args = list(interpolate = 1:4), margin = c(right = 1), keep_aspect_ratio= FALSE,newpage = FALSE,legend_width=5.5,shade = TRUE) popViewport(1) pushViewport(viewport(layout.pos.col = 2)) mosaic(haireye, gp_args = list(interpolate = ipol), margin = c(left=3,right = 1), keep_aspect_ratio = FALSE, newpage = FALSE, shade = TRUE) popViewport(2) ################################################### ### code chunk number 65: bundesliga ################################################### BL <- xtabs(~ HomeGoals + AwayGoals, data = Bundesliga, subset = Year == 1995) mosaic(BL, shade = TRUE) ################################################### ### code chunk number 66: friendly ################################################### mosaic(BL, gp = shading_Friendly, legend = legend_fixed, zero_size = 0) ################################################### ### code chunk number 67: bundesligafig ################################################### pushViewport(viewport(layout = grid.layout(ncol = 2))) pushViewport(viewport(layout.pos.col = 1)) mosaic(BL, margin = c(right = 1), keep_aspect_ratio= FALSE, newpage = FALSE, legend_width=5.5, shade = TRUE) popViewport(1) pushViewport(viewport(layout.pos.col = 2)) mosaic(BL, gp = shading_Friendly, legend = legend_fixed, zero_size = 0, margin = c(right = 1), keep_aspect_ratio= FALSE, newpage = FALSE, legend_width=5.5) popViewport(2) ################################################### ### code chunk number 68: arthritis ################################################### set.seed(4711) mosaic(~ Treatment + Improved, data = Arthritis, subset = Sex == "Female", gp = shading_max) ################################################### ### code chunk number 69: arthritisfig ################################################### set.seed(4711) mosaic(~ Treatment + Improved, data = Arthritis, subset = Sex == "Female", gp = shading_max) ################################################### ### code chunk number 70: default ################################################### mosaic(Titanic) ################################################### ### code chunk number 71: clipping ################################################### mosaic(Titanic, labeling_args = list(clip = c(Survived = TRUE, Age = TRUE))) ################################################### ### code chunk number 72: abbreviating ################################################### mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = TRUE, Age = 3))) ################################################### ### code chunk number 73: rotate ################################################### mosaic(Titanic, labeling_args = list(rot_labels = c(bottom = 90, right = 0), offset_varnames = c(right = 1), offset_labels = c(right = 0.3)), margins = c(right = 4, bottom = 3)) ################################################### ### code chunk number 74: repeat ################################################### mosaic(Titanic, labeling_args = list(rep = c(Survived = FALSE, Age = FALSE))) ################################################### ### code chunk number 75: label1fig ################################################### pushViewport(viewport(layout = grid.layout(ncol = 2,nrow=3))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(Titanic, newpage = FALSE, keep = TRUE, margin = c(right = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(clip = c(Survived = TRUE, Age = TRUE)), newpage = FALSE, keep = TRUE, margin = c(left = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = TRUE, Age = 2)), newpage = FALSE, keep = TRUE, margin = c(right = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(rep = c(Survived = FALSE, Age = FALSE)), newpage = FALSE, keep = TRUE, margin = c(left = 3), gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1:2, layout.pos.row = 3)) pushViewport(viewport(width = 0.55)) mosaic(Titanic, labeling_args = list(rot_labels = c(bottom = 90, right = 0), offset_varnames = c(right = 1), offset_labels = c(right = 0.3)), margins = c(right = 4, bottom = 3), newpage = FALSE, keep = FALSE, gp_labels = gpar(fontsize = 10)) popViewport(3) ################################################### ### code chunk number 76: left ################################################### mosaic(Titanic, labeling_args = list(pos_varnames = "left", pos_labels = "left", just_labels = "left", rep = FALSE)) ################################################### ### code chunk number 77: left2 ################################################### mosaic(Titanic, labeling = labeling_left) ################################################### ### code chunk number 78: margins ################################################### mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, abbreviate_labs = c(Survived = 1, Age = 3))) ################################################### ### code chunk number 79: boxes ################################################### mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, boxes = TRUE, clip = TRUE)) ################################################### ### code chunk number 80: boxes2 ################################################### mosaic(Titanic, labeling = labeling_cboxed) ################################################### ### code chunk number 81: labbl ################################################### mosaic(Titanic, labeling_args = list(tl_labels = TRUE, boxes = TRUE, clip = c(Survived = FALSE, Age = FALSE, TRUE), abbreviate_labs = c(Age = 4), labbl_varnames = TRUE), margins = c(left = 4, right = 1, 3)) ################################################### ### code chunk number 82: labbl2 ################################################### mosaic(Titanic, labeling = labeling_lboxed, margins = c(right = 4, left = 1, 3)) ################################################### ### code chunk number 83: label2fig ################################################### pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(pos_varnames = "left", pos_labels = "left", just_labels = "left", rep = FALSE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, abbreviate_labs = c(Survived = 1, Age = 3)), newpage = FALSE, keep = TRUE, margins = c(left = 4, right = 1, 3), gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(tl_labels = FALSE, tl_varnames = TRUE, boxes = TRUE, clip = TRUE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(tl_labels = TRUE, boxes = TRUE, clip = c(Survived = FALSE, Age = FALSE, TRUE), labbl_varnames = TRUE, abbreviate_labs = c(Age = 4)), margins = c(left = 4, right = 1, 3), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 12)) popViewport(2) ################################################### ### code chunk number 84: cell ################################################### mosaic(~ MaritalStatus + Gender, data = PreSex, labeling = labeling_cells) ################################################### ### code chunk number 85: cell2 ################################################### mosaic(~ PremaritalSex + ExtramaritalSex, data = PreSex, labeling = labeling_cells(abbreviate_labels = TRUE, abbreviate_varnames = TRUE, clip = FALSE)) ################################################### ### code chunk number 86: conditional ################################################### mosaic(~ PremaritalSex + ExtramaritalSex | MaritalStatus + Gender, data = PreSex, labeling = labeling_conditional(abbreviate_varnames = TRUE, abbreviate_labels = TRUE, clip = FALSE, gp_text = gpar(col = "red"))) ################################################### ### code chunk number 87: text ################################################### mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = 1, Age = 4)), pop = FALSE) tab <- ifelse(Titanic < 6, NA, Titanic) labeling_cells(text = tab, clip = FALSE)(Titanic) ################################################### ### code chunk number 88: label3fig ################################################### grid.newpage() pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(~ MaritalStatus + Gender, data = PreSex, labeling = labeling_cells, newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(~ PremaritalSex + ExtramaritalSex, data = PreSex, labeling = labeling_cells(abbreviate_labels = TRUE, abbreviate_varnames = TRUE, clip = FALSE), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(~ PremaritalSex + ExtramaritalSex | MaritalStatus + Gender, data = PreSex, labeling = labeling_conditional(abbreviate_varnames = TRUE, abbreviate_labels = TRUE, clip = FALSE, gp_text = gpar(col = "red")), newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(Titanic, labeling_args = list(abbreviate_labs = c(Survived = 1, Age = 3)), pop = FALSE, newpage = FALSE, keep = TRUE, gp_labels = gpar(fontsize = 10)) tab <- ifelse(Titanic < 6, NA, Titanic) labeling_cells(text = tab, clip = FALSE)(Titanic) ################################################### ### code chunk number 89: list ################################################### mosaic(Titanic, labeling = labeling_list, margins = c(bottom = 5)) ################################################### ### code chunk number 90: listfig ################################################### mosaic(Titanic, labeling = labeling_list, margins = c(bottom = 5), keep = TRUE) ################################################### ### code chunk number 91: artspine ################################################### (art <- structable(~Treatment + Improved, data = Arthritis, split_vertical = TRUE)) (my_spacing <- list(unit(0.5, "lines"), unit(c(0, 0), "lines"))) my_colors <- c("lightgray", "lightgray", "black") mosaic(art, spacing = my_spacing, gp = gpar(fill = my_colors, col = my_colors)) ################################################### ### code chunk number 92: artspinefig ################################################### (art <- structable(~Treatment + Improved, data = Arthritis, split_vertical = TRUE)) (my_spacing <- list(unit(0.5, "lines"), unit(c(0, 0), "lines"))) my_colors <- c("lightgray", "lightgray", "black") mosaic(art, spacing = my_spacing, gp = gpar(fill = my_colors, col = my_colors)) ################################################### ### code chunk number 93: artspine ################################################### mosaic(Improved ~ Treatment, data = Arthritis, split_vertical = TRUE) ################################################### ### code chunk number 94: space1 ################################################### mosaic(art, spacing = spacing_equal(unit(2, "lines"))) ################################################### ### code chunk number 95: space2 ################################################### mosaic(art, spacing = spacing_dimequal(unit(1:2, "lines"))) ################################################### ### code chunk number 96: space3 ################################################### mosaic(art, spacing = spacing_increase(start = unit(0.5, "lines"), rate = 1.5)) ################################################### ### code chunk number 97: spine4 ################################################### mosaic(art, spacing = spacing_highlighting, gp = my_colors) ################################################### ### code chunk number 98: spacingfig ################################################### pushViewport(viewport(layout = grid.layout(ncol = 2, nrow = 2))) pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) mosaic(art, spacing = spacing_equal(unit(2, "lines")), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 1)) mosaic(art, spacing = spacing_dimequal(unit(c(0.5, 2), "lines")), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 2)) mosaic(art, spacing = spacing_increase(start = unit(0.3, "lines"), rate = 2.5), keep = TRUE, newpage = FALSE) popViewport() pushViewport(viewport(layout.pos.col = 2, layout.pos.row = 2)) mosaic(art, spacing = spacing_highlighting, keep = TRUE, newpage = FALSE) popViewport(2) ################################################### ### code chunk number 99: oc1 ################################################### tab <- xtabs(Freq ~ stage + operation + xray + survival, data = OvaryCancer) ################################################### ### code chunk number 100: oc2 ################################################### structable(survival ~ ., data = tab) ################################################### ### code chunk number 101: oc3 ################################################### dpa <- list(var_offset = 1.2, rot = -30, just_leveltext= "left") pairs(tab, diag_panel = pairs_barplot, diag_panel_args = dpa) ################################################### ### code chunk number 102: ocpairs ################################################### dpa <- list(var_offset = 1.2, rot = -30, just_leveltext= "left") pairs(tab, diag_panel = pairs_barplot, diag_panel_args = dpa) ################################################### ### code chunk number 103: oc4 ################################################### doubledecker(survival ~ stage + operation + xray, data = tab) ################################################### ### code chunk number 104: ocdoubledecker ################################################### doubledecker(survival ~ stage + operation + xray, data = tab) ################################################### ### code chunk number 105: oc6 ################################################### split <- c(TRUE, TRUE, TRUE, FALSE) mosaic(tab, expected = ~ survival + operation * xray * stage, split_vertical = split) ################################################### ### code chunk number 106: ocmosaicnull ################################################### split <- c(TRUE, TRUE, TRUE, FALSE) mosaic(tab, expected = ~ survival + operation * xray * stage, split_vertical = split) ################################################### ### code chunk number 107: oc7 ################################################### mosaic(tab, expected = ~ (survival + operation * xray) * stage, split_vertical = split) ################################################### ### code chunk number 108: ocmosaicstage ################################################### mosaic(tab, expected = ~ (survival + operation * xray) * stage, split_vertical = split) vcd/inst/doc/strucplot.pdf0000644000175000017500000102641614133313352015444 0ustar nileshnilesh%PDF-1.5 % 1 0 obj << /Type /ObjStm /Length 4920 /Filter /FlateDecode /N 84 /First 711 >> stream x\[s8~?oq%15UI*޲es.@tZas5ް4优 fa\˪Cv5u] Kk{.OE[jZcFxɨ*3_MF%=wlZh6}ňzΧ;[c~9FaA?yyĞ\TuSU\bRT8}6_(i3 i0`:,?7e zʿA;r+{W[>faH``FhiL{TGxb21Fb<L zj 9W_GTj|Dhi ^ +iMJՐM߶񿸚C2E)v3dQ\7rDb͗ &4F Д?@DI>hV 2 ZwN!IVkYWO-$8C_%?W^^}B B(&_ x5)*J^_xÛiQsg̿~z$-ۼgg&|֏'ß"@'q5WYpR5?“4.zY!͍l=A,YǮbi=idi=RH4+fx3:nmŶݿ~}s| h< 5%9|M  m]Vc :YMO0> })ZZZ ^hʟRfڻ\#is0/.agp(ie|nҫ`I<rhC%w"jU7JĶ-Izx?S[ZAu"U:#&{bQ4 }۲2?zLl~N߶ּf=`Liz2hOB`g%3oE~;skh|f~$Ne| |*HQ9ҝoUoQՓD![ή B>x"!WкsDːs WW}H^nTEC,r o V+xBNB+X ^͑Yete6=:lպCPY Uvgm*q40aۺ7',r<*pJ#ԣq1Ӷ [iAm1v@yݛ;z._#k^'A>EAy"]ZwK鴅WLʻaƷ-MR+M2Z \p@[$RSj_':m#! :B˄nE @Bv)\ OhKhiL{NY;5γ=^#S5 xMʽY1'%p۝&B,HiVt߁Q2G;TƗNLɠ!uVLi/KO4U޳A&B$F.Ѧ;̟4 uu'$s(84$G&+ a`ލJu_#ɷM-Bմ=G0H{sjP-w!uW:` +#H\\ RH;,HhYb mJ1Vl4/iN&zGi ȦܦՠwTP&BGCfo% 1,WiB{:ϒ6)o]I1Bzw;.|0"Or[  Dbi5XPo)M0EiSWW@sՑ[bJ@"Hߑg>f٧ (Ġ*d{22m\PdCڸ.C3}4Qi8hd)LFNn(('@w@RThҴK ^ɈTLBM;W\ՓpOD&ڶ,aD(fQf. %3JInHHef$d ©D}Q@M!d(ĝDժPF ͞)PKOROvD-DR&̜&< Mvg}$:hǻ@v4)!|<{͏$H0PBi nB $ )ƐV4IB FTP=hڀ TE&ُ@~_Y4eFS?/Mگy_ILfh6R,n`q_ώm-]Fʖ1q mm7I˺~[Z/o?5+endstream endobj 86 0 obj << /Subtype /XML /Type /Metadata /Length 1827 >> stream GPL Ghostscript 9.50 contingency tables, mosaic plots, association plots, sieve plots, categorical data, independence, conditional independence, HSV, HCL, residual-based shading, grid, R 2021-10-18T17:46:48+02:00 2021-10-18T17:46:48+02:00 LaTeX with hyperref The Strucplot Framework: Visualizing Multi-way Contingency Tables with vcdDavid Meyer, Achim Zeileis, Kurt Hornik endstream endobj 87 0 obj << /Type /ObjStm /Length 3562 /Filter /FlateDecode /N 84 /First 761 >> stream x[[s6~_tBo;8NdNR;;yPdV+K$I~"vx<2A>sp.ALҊE ]$s&s,j&&4,Z&wL Ye10e%hTFL #PPLPLkP0LeiޣhW`dF)Tӣe)Jq. -*[fS,A֢Su.`6`HCU9i9Ҁ ʖ9U9漦ʞL慢:yc稜̧!i*h=X a>VD(((Mv ғȂ$>GCa8JU ~DAc7` pÌAԚ4xE##\JbROYb\$ ,,Z?=kiU^ip[:A%PUD]"#jawI؜%@H":"m":F=ڧ1맟ߛ%_"`lj 2WY\}ޗC>3?Z3:=GdxSmmFf`6x5Zfr~KFȞ~^rrt weIBՓ_WhQrS9n[48L9X\=01%7Öį˫)qݎo+a\G<}>׷?/G'DGt@l2;gd7[N&j0;'r\ R ᨬC\X%(HV &g 4M`\]"@5\$zNjl#YQ|,啞To%XѶ'ܽb9&>9X ?zO/[ oǟ#-|x)9 +Ɖz#[~0/4v"Jh C/^L9qkx1obh:Χ9>G|MlœU~6< TpG^=AGɗWHUk]y2-yRC %ҵ?_q[r2^jr5¯d~F/Q1˴x%hR-F6nPVAÝ{Ϟ=oal3G.w\ggf6A9HP^977R(n<l2=Ժ'~ U$fS 7>^]bTɄ R"$ 𭨓\ƶ\ %CRm ]d|Oy8Q &(+ڌJ,7i,_Dnҍ,n9;Hy N$tJ1U;)8^L@eս~|`dg.cA՘$˼b2]Y: R? &k2jL>d Q=`AoJ1Q 093PѪuI;i݀lF!)e ymL!f*HFr!1P`2Fv0E:NLZ`qVa@U* Z:Du{ P}ZAY(a9T"wߋRڮk(Mx[rH2[1A D ֩LO&A>޳ 6vmȜk` {XHRUAR:o-Ey$¤i qɩs˂N+:% Dv/$$h&Z!AYNʹJ](Aժ!AUQe-*Ss8$% <;apI\T{+Lڛ,$<̭5&)0mq .xiB@{[0y׭1E1غ 3섛&yLV%V)D58/Z>$"!AduSqN1)D44p0aWh u@I?wxċ/[V\іR4wRJ$ )Qς> S٠G 2i84QݒdwE! ]i)SgP{Z#SS 41uڎi 4Vh$+(0TǔQzbRL!:HYΤcpUY1Y*cX*QbU?Hʫ))ΧBG3O"Z@#^!'9~^W&Y8?{?Z@|qHdeMbIC'mN?2fr zV49͈,`*!ub -ˉ )o`'SzqE̅`]iHUbL ,m~]oR~gSGw抬fhDwRָ+v:SZÀ_z~^-ҽi3'O7ǷRʨ-f}A+=.x2Z+^7b_E^7m#1OS~aJy_ vsa1UU^P{||ERGq)0,/WOO>|gYi_O4=nW?3_NG s⫋E6/5A,E?g]hJbyT:RiGXv|궦ܕxSEoS~]$[Dg@?c9FOq۰Jkʞt|+h)V ٦|+^S-kw0 7tǧ/hD/?L']|WYjfBc6>Q2hfۚ#0ܒx7%5h։V$Эtȿ-3yKJIQj+3~3!t6wg*0M\mkSStpPB\ ?V餄l:x.M|%zt%egÕϧgCN7go&W Wŗvmo~fַ,TH㥥8[Z/6Y(f>]k-mF"y=LX[D=gߥcJѶ u mJaenjNlzH}bA=|uvO tv+DN}E[nN3`"7Y&Vo`kZSfWӚc_'Peo4:tUNg]u%GQ5:Xպy!S_'s(UFhBTX|  bmܥ#: /@ҪSVIJgendstream endobj 172 0 obj << /Type /ObjStm /Length 2452 /Filter /FlateDecode /N 84 /First 756 >> stream xZmo_-P /ြC`MsE?֑ KrpWZKVa,w%y33!W1zM&3ᚍwQIFoeo8AO.3Q#cOF2DIP }3t eaGPpRE;aڈ[pT,%ΊJ oBp 4:6Aj!<U?E#/ŋh$}!靑!E HT XR&:>bbո0O&|FhbJ.F<ȧOe,zLeEk#!'$4ybgfEÛ-TT@f=@4hCLC&[p(h` b2zÞ7h@8iqjL:NSX є ɔs6%)PL) :5;-V »x/q~^.:3"wW鮱^mfWMDoF5W'E,0x? yvڬW7?}|oL'w{:?k6{͉}hn0?u_6/b]wݕk'r@>T>uO>%uP'ur!9xR9((9wvNCI{v%tCnB쮩t? L*P_Njust8\EyӬu u~iVCJ;6 4XAdl*6[HUb{|H1&Ш)WbX~bHiRg<R[H!& Qa/q!Cj+|CXr¾9oh*SD͎Fܵ:=_<i[V3 `(?tYs#قQ%Ҕ!A/ީ`{mM_{ݕD&Rv)?Mtߩ;& ۃU9i`qN** B-5/yzH|)>Ki8}d08U|ͪ-s)KK;Һe*rUiw*o ۤalV,k1cф@2xK3GDAaBn&ǴZ$=piy4wxG e!ղfA JePuSjOݻ7y~q\^obyif˗fyPT. %,7ZR׹wbOboEn|\\l>+K?mXʉX 5[Lϳb߿T/2\/X턯|X O|j*{ k\^^5xqn^C[U41m/Sem`|s7VKH4C=ˀ<0Mq}=\,Wg/_H= mu?zDeDH3fͷ4m:CB(H$5 c9Ǒ8D]XRh mpd3DjHh ix D[0Evws c;m,ݨM7cc<1)zAʮX#-G:BZ%$B*Di5x2-ABrL;HmL8HRn_7yB1aЫ[z8qdJ31"J{(MMi25d]~P&ĔHEˌ^z~|R"AN䧀4$|oV-/`?'}`7+QSڦe_`F׷ԌZ`Oz m%.#tOX> m> stream xZmo7~(W(8kIE>("K$ɿg++e݋,˗pf!L2S3%3N㩘O͢ x)1eA3E!`@T B) Ԫ47ꐔCdgFZQGf{Q143an6YՊ CmyQpX V,Q:Eͬ$z脑FNĸSSSdꕘHŁPA3AAOuWx3'd`jw`n (|6|+ -(ςͽ .QȂ)fd!bQ8/*6ڰHAM1 .zZށBX $\r!$dI;*(,nf[O[R,%H1:)i=^IMTȝ4FI6@'Q@ %XnB)J~`bܬoY:$`8[.6:0K1sK\TZFl\qP/1A@>*q>\!5R?zg2uysN3nxq9EīMuBF/ O, W+h̺վ76o&T<<\/nsj{QMs[8Hy Җ}=R|%N K)J@O(nxUH#7;@ Pd&d,|YʄL ˂_R2+vh nn*Mh(X ygoEܱQp-t L]7$Ҷ ?mЦ ݛ:A-w@;(z'ߟw30j-\ A H /B5mm됿Sz}ڹ kuGјrjQ3xMtyu5 ĺʘu-I12R lb}=V.%)-=0{A͟=s|b%p֕.M\Ӏ`eC[UxPY}9^[_ulw83dFXP{rHI嘓CB0=$!=. ='@JXk˜ݐ7yNq L8`13.Rɱ$oU!`=P{ޡѥP{Tϟ6,@ ;G9h4XR2CYrselG燦CKs籧ybC7OJE7Eh/LAh #!TU]Ch%uIq 4uDD9>Mɽթ%8gtsIoM!ד; A{u(W[ӤMsZfsm;I3' cɞ^xukE(=CD \^ gz^ G}֩LvFVRlM#!nQڦ`4NQt͎UD5RPX$T萣B-] P0r4iĹsoiM(45<0* 2u.547w{eIҺ+롧|<MG**$%bT>lHrq$w\:C;}7 tcH6o]oZZms?endstream endobj 342 0 obj << /Type /ObjStm /Length 2739 /Filter /FlateDecode /N 84 /First 749 >> stream xZ[s6~_twԹxiؽm:~`$F5$&ym9$k |kA5|MҪ|/VU1:/YXgW# Ր4Cq8:.z#b1ˉ}:iY砯-\ܭLEΛub(1D>$POMNV X_Y}Qa:FL,2fK8q(&/Y~~ނIVgt2@$sBr8O+T^(>{7(hon0[RhH~C2F%l pFz<}4m\NXmQ WiڢkOQJҁO;-c|g@`D-C( [O(H:$@;5 !|mShKYv5G~ȪbUNl?>:6&n7]c1OWZplgee ;ոՑvQ1ua\k{LIy:&X_us5uTgpe7Q1aYmdE\BUq+eE T|,>jA@ ..#b=%1 GbGi$D=~*,55ܣU!ePt$t+3!Q#%L-Qs݀ tJtƺjmnKHt%:җdݬCt4a/,JF:YV: tc@;&P0n0yc%49.MGz6AegbΣ֕N'"+a!,m' t6~(XT` V+!kd~ltsuF9>{Ѣ@4}3&xOF}Oe`Q/JML dRh_jr=5=^LBM 8! okCr4JB(Q /Qۄv|]4S=M;uoc97t|laqnέ$;tk}[ZժZê'l2gi>o_We˲ e<4 º7ͦZCҮ%,Jg9}t`QЩ^1*kcQ.Gl U+յɗ͎ԝ.+)@Ǎendstream endobj 427 0 obj << /Filter /FlateDecode /Length 4951 >> stream x[KqI:ˎvvҎV}ypXf?U=$g3@PpIt@>2~+_p~s_ԛwnׇo/ Jp6/PWm.don;iuUךp3~*5KP{5[Miة{UZlO;^[;q /J]{/YoQ;=ޥ<+anwqJY>yt xjv֎C}E+=D*UK ꢅ `״.( Z2 p"aلX rI(v$q}ڲ^ , yqo5C "mTkVTNef{߳YIxƟΰoOݱ >e p *UfesA_r5 -WZ^ּ8_s 1mX8pR>T}/rz_=_@@VH}r/Gm+epFgJ4ŀ%X>}?T=L~ְCm2 e ܭn1jW3wQ[N\A[s̫|}٪NyL/ g[ (}Zb=qYю`/m"L(pQcymM#(xmQf&P&HSݤr֗W/ =(kW..prK{\W@^N!%!da,gQ !JF.S{=J&T$4ݹYi|Nl`sݯFǸMhG2`x9 @9'x=@N$S.gȦ"uJ鞏:~q=@s -igT UhĄ2 {9!n{:gF#BP\F{ }d@PbI _㳔\..'PijTIyKzL (6>1+/rbIשF{wb@~"CNe ϧChvLJL044'"I4,֨,;y)ٲV4]S:$gAphmN@xgPiG쒂g\@ebMDY)uc0f>zݳ1tw01DYL1sgUhڠ,zC(-|_tN> }$7uI Ru9 Z  XFO*vZ); $}{SBΛ0{!WyKafIc:6 1\圉}.t |e]j M%(ms7Ev굍r0d wh-e#"qUXEIZW)U ?{X[(n~H)pAvtVpZ[Πuapq9>K1kC\9>@f_' @i|UYIh9z,QZ^_6އ|g('<59N]0!|`wUxnb"Y2F('|"s*#gt>b>8̺Ra1Pzo ;ݏ­nP@6qgni F▐}C?{oz&Q¨bϾ7`vxP_y/N֕4"]f&+2Ƹvfo`mQePVJJPN>PoT%d-BCuӑ%!VhnƐ X;:*kld-XptdyNpIe,|}6zߴd*COYUB4|y@8J//b$Hl"֠{r:1 $E <95{ ,-}f^qġwfW|O]Uz4:?d(3A D+|Q.K N3CpZ-2v= GSbS}ljыXlL'ItwkJV>hEIAM*A+op~ oیaEX3ɑ< [='A(*% 熝~5ZGVXqy_|kt̗&JAl=+[ uS`s/B:łB͙03*r+p?Gxbucj_Ǹ2FfS<ɕ7_5I<5lX cQ=`F-SCN(錣[ =AΩ“ɾo"Jcqբ?^n96`LHh]y1}hd5}U.a 'PB>{V&% ۥt4p4kFDVCz1H7)';ί;C`xB[dΤ`. G;'D؎jtQtee܇4R!-ќ<[%)qňre^:D}k<s>w6'I'"P圞6/^ԱX`aԓK$u-9-}gpLMRbKn-u)oi -4g`B 0@ Satb5/4'u8 ;5)ʢcpl7u&9|pvlsHofP'>t3%"􎞐/87OiNA= {<.f[!meOLwR p9Ŧ {>m1}e<~$1SGש^KOaްHě-*vBiC 9_p#+cF(Z4]~$5bwV1Jӑ?| bI[E:Ee0ALC:tЧO@Yk.,7~sq?rc6Q $&KOKœ hS[=uF6>/Di:ه@Q[ h 5I;JjwZKSn!=ը4totEYH`S9S NīHUH/NVk+Usbi=?=HRl.$3JpCYlw4nE5Zd6; Ÿw6kX2ZLAr_}`Ǫϗp[*8+ >JQy;Yz5Oi*P ̬:*,ǫ2 LjfMCQ'pFbGaY6C:6~M)Mv%~ ,=banHA (9CbS6stNj6lv2t39\V0mMa<;~"R{ESMr}>hP-x좘 ya93"=<&>e˳ǝ sٚ葥B-Q ILnNBmm% x5Y4W`圜H`lWr(19?8}|IiȁsھH`R_*qk=4uU:ua?3~}TxfxQqLA0\IXH)$52QejG>"FYd~:ԕҾ];r?Y!ό͜gbOÉڱX(7vCfT Ng&Y/Yjq=J!9'j4kI1CX| (#+p_Q*|!\$Ho*alЮK9QwqrJ5,Yk4OQ^k2q/b,]#f/OyYOPr >ƻO~co1+-eTk=Q> stream x[Ksȑ$fOmAԻI(F[ˍ j&hD73 Bj=: ++32"go'oDyNO}=m/.&/^?q]٩eFpI46&i.N+*B Ê2ۮBɳ뾽_fXfnfw˲̾[YY[qO+nI5_:gָ*Znr}OȵNmj!C*x؅w5mA: E(@|@غ gL6xljJѾ鼴2kޏg%,s}n9a)Aja=[rJ'hnm,J2Lsb9*}Wߡte O+ƅAvYlfWk 3jI+I&+:,w^!ΫX w~`VmekJ+6J=P0Oq1H] qxe]j_#-+ǰ"Dv8fz j{x>S&pGMA iqK"qV6h% ro0&@%zxxE&ٌ}T]>r>ؔa;p$Ty"m~`ٰ!% w h&kLqIL.( HC"?,-ύsSHko"]|n7ۨ>_FF97/?I૜B71.E6¿x: \Op%^P14hRrbGkx;}dd0]!)li d״8ćho?BX΃!f+j -2z{J: OX֨)/TqOb_x1dNkkȽ,E+@|\ֲ\dF}E0*cu8W=? [g?}2ټŨm(ѵ O.u<5ep,r!Hmo'fFEa|pnO|y# ;mspg"^ >|MtV\)j ftoeOgF؂OR2-1B\k.:1k.]0 '~% ,km%extPa 2M:=9n{̴UvT2on6]G<)XԻ3iN. XӔ`X֏M8RCǺ;WjOֱ$ ]鰄yS1վ \<)I8]x+Wtk^Z36ZrAײ>ͳO>աɛvw~sn_o۞߉kq~ }_Uh9 :j־n|c1cE.[ 9~H=;w2ToLOľvH Ʌ$QeQ`1WšSlpi) %hR!gI橌)>Ck7ɂt.g,RVnU:n ,U\5@B7Gc:ھ&0qR'dSLArrUBˇbCX]yYd@^Rtq@"2@xʝ!h\ٴE$2 =YK)#|c)lq>0L\BlY& k2•;uAxX, <ᗕ 06)TeJ) c`J6\n"-"kٿ"LJ|ǁ&s;TA'6l?cQFz pc߈HBS葃P#JL `:42.)Xӊ88'5ՂҐ|'|}/, \-npڂ1!I<ѧ$Nh%?6KzR/' }endstream endobj 429 0 obj << /Filter /FlateDecode /Length 4648 >> stream x[{F96ݦ9 Mv;gq{%š= dEoUuA o>,Fu=NB/:yF<]D9*R2OT0e8lUmOW'z|QJej6ZIl^;/f r$>P^ fku% U{?lfn]掶cm7"^|=ܸ@CaDjv'sc\;/ď냸ongsCLgocJ*VMMZx2lѪ_`aY4e'0⭐!b6,ޭg_"KSqA՗0Y##-+Bqޥse[gaRӑf/!uWo Oƈ6$(ӹԅ5AE7 [Z lxO3 nMA6q+罢(f"eUREEߞ)2#L"AJo aX]{[`5l-@aoXxcp]ޮAԷW,άUFn@TK:L{Mlr3i( hwN'CyvK|V8DU|Md+L2K?JWd;*I=]Zຆ^zMlORN^-Dײmz) =B%YY϶jX׋6ggx6S5>6\%l9'M-2l-8azo>M1.)[K)x]$^yx3t\]N˛0U'aAS*62B~7[unzlÆ䱁7 1*]T* +G]E=d~A=oG(*q9>œ6polWQةHuJ|6bWs[]3*_n#h|g6iD3palX:qNbb4 a'LCGu+iů[;ɀO[!#Jڸ}tӀwS_T7!!%MB |+4BBiEBeM$M ,`(^g~`W,p_JW*,Dk6p8EESAύɅ1$*F^.5%mLdb7#g,Sʠ7LfD+"3iOSnqˊCdV .n{ ʲ-כdj׫tܥbq )@W:;)F|sRinW/롲B!C_`H[ E&=/GQ0ݛ\K"j!HaD,"l>"y}eJ` Ij&bFPs3 \R~}"0eGzL23.D)KxʜuD , r U?/c 6>I<ZJD$D$d"j  &3;<"v`*GRej'p 0?5Ա6`kTUWT\=R%:-݅PM~z  h;y>WJ/m@͌ bg DD+s Ub8{NW3K*-HQG% QbpL4ۣ8YHuR íi~O m rBK|\$ПWjH&S~Gl*ɫx~w{uY*r7maM_N3*b1X1 g^S%YLT{ Hp;`~rcR]VA<H;;Hu3">$cim2XN3ې xnV/Xc>o/'cLkP!? =v}sE2tzN+Gb}7mjnu>XT`!b'nţ_8Ƕ=޶ W=8a&26f+j!{FyAPZC^*kTGM*b7d gNnN\ ?Alx_5nSӱp}jEO#_7'hlzur6)#L)Fy\/Kdv0tEindZ4cݸF{}r׋X]T8,r!K<$$Jp%O4JlU+)߳T$Ér:JT Q{v`;g@[F W\An-3IASDJߞ[;dVѣ2_pz\0 upEqҵ|UMG%gh/DNc3GĢ\ IF'+Rx>{Λ2kbrpr2c>Hي攲le+O#}Ed䧷hQX-dӗ2qWQ;$ª2ێ"HE*ؾ2Cl;[R%+DtJ8psvtM$ ښVApQtr0AnT2bac6iJVp)9cŢ"%z hpKM 0@<&܁Mthm }8Mg%qG VL5u LemY)=~F*ɳaOOp9H=[aވte`Kë^׺Y(p8jEuw0%|/FZ1𡲢wH7DGz;ѤUcn%~B(m:9(vf4~j8'VK"!uKj,ss~\cl?6Ʊ*wRQ4 `7ȪY0KvD8=0rqfeTE??,xN+76+^ħt20 ~f=f\O3&GI('ú";@;GPN;Yo8}@ =/v%QC9`@MXYZNjLL`@_{mH !􍪆#KtU?HK @S\ ⻿`q,*(W EPhB%ЂD|aRceϤ(3a\#KW8i8_ѷhkgN9x:=k+[TgnrvgBrB˟6yڠG!yA!ΕwSq: PQLizdDo2P4핿PH8endstream endobj 430 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 5437 >> stream xX XWW* M}5{Dq4,)h.tdYZ%Q3n1LL1 $Ɯ˼y'ɛ7+k{?`z0 EKC}&4vFxFM! ! TY4~ w~R~̀njT(Vn %&"( p%cҿS~1}7GEi}6j[4Nfx= .۴J{Ro휥{y0/>sY#<#>O oăE;6nZ4{YpȊcƎIzy+" b3^f *3x3Ùerf$ŬdV131[Lf,Ōc|ٌ'a&0syDf>3YLfdBL/ qf\5pd&,3vLXF=zm)v'W,;fp=zp81^{}}vi~_ciNA8/|TsU%>ߺw?K &R8p$ORqO$F1%)wN 𴈴T|=`~ CqaeXllEg5X[gnȓ+"YӥlGmV'TסEHm6O,{(pzhh.dF SǕAztAp[F.^=^20ҋVE-|쥔0\n dę<pI$rUSDE{9 UR/5/;Pe_X >1&ΆQ(KMxVKN@ 0&{_ l> (wOtQ) ۷2'X r0Wh0+ާV$#C?Ñd$9R†Co wzLs\~ҧBq=**xx#򹌫8Oqr&CgZӕ 1^8u^D70pBtA";`ʗM$=i}'XieN>lײDЋ7؎! \eC(4fQJm6AAx_z2/cIGN2}q HWkes7OAp9|tde_j *dha͉.ƩM8"LR% :Uɵ9.5J`0 ݛ8L.m(I*ޑ'Z-Pcj6p%2q=Qz njޯV{-́2 Y=Uc'ȘrWMTKd@pmCRjLu{,9i0 "̮: *Ly@MΜհ]quh{-Sζ:5o%S90AGI)JJѨ4rozVPXNuqA<ka]]qȩçܰa+{Bv$y o?ݵueJm2T(idL}F38iiɦ4f{ X#,f/̫f8\14%nwXJ~]lWeNɇYZޝ37$fd\>RUPzELsA)R ~"&Eo;6Dw1ϧ d7h4ibwA{hGeiޓwxΦ^#qB-v=KcnY%A AO:It8KO}P,l7L1oӱ;}'>fiJ2^:ae{ YudÚt9l1cҠ^rvQVj˸o&N{X#<0CkIKj;]?5EɑtɁBQVu9Yp̗K`{dd}'Ma ~2=Yb=Y ]F WO-kԞ;UǠ9ƺ^&b1]Yd;#SŎ1]f+~ُ<&"`+jXShf_zpwԅr xuEIcTmr#f5ivDRו ɋ-}\\=s%ORuq =2woj*2R (()ɦQ9IrI矃Z }UKZf:\åPAaJMWdM_m72 [=+T6߱…wprmxĊ^3{%}ڗmJ5)oa$ 5aVogGEb +vwǝGБk5AtRK ^h <}TC Ʃ&WEёSd:{6е86C.B%9I9򚜇 ! \+ߒ~R yߡcu֣"7L_FlT\^+F_/Od`zDY5([>_C\J =J ;zu:4S|[QQT>(֯)ح9`m{caM$(!#kr\1/ϲݵwbQʓ'4>r;cjG}3ZZ?Q9ow|AFX 5cFFK_9-/^įp }d=͓Q Q`Hߝa( b~ͳ| ( dÙ_J OK:N0ts9-PZtE(poY1&jazv"!>;*wZdvaC!4#x]wl >#oR|݅څLH~`VwА[M|;Io 6Mΐ(H6`)b'uƼUϽY"\}:6&v )lN +}: }⑲]7tISu5vKq#Mfk=q SɐGyU#FV^_yHZ7]0’1Afدxl2!7_ =!Ĥ եsoټ12duqafh O2uvR2Rbg=Pc/,:I(1ڍ7YCv xJKQ ܍J)y\7V/ZW֬ƽ|G8\ad`jI^. ƳTXQ5` ۮM!!bR4O9mL?b\wHS5N MNcmbp ގ/̋DCzѝ(?&[l:vk4[7LQTcr$A*#:S,`uNC>jca~47,w~#ͳR Cg@lԫmm*M1F': qZfh?8 j@kV}|NnI ։8CUP&( x?V[r8B@~՜xQҺsjR[/ɜfN>whH3e\szn_P-LL/,x'H#hֽeZ9fͤO&(h㸶{O,x$3pP.@j .SZ8?jG Q bG܅gʚZ^N>"bSpTm;`ކ "ɴi`.By}Z U# "䤊p ,a@NelqoC3xG%Vj/gmױ_S* O]ņUC)ث cCk|=uBvω.1I#Cc>qgmp얅 3329y7{j> stream xyX, ;cW2%vXbFw.Hދ,ea.ׅ 15ŒoYxo~Ga;9={F@Qtrk/oc]<O-n7P5o1&sft c%W/ԓ kosu 40~ıciasƙ/qp f|ɸW6wtvst1q1_fBk+ە6#>(j9>n7AEA8, u\|V.+]ݬٸ\vd[ SST3H͠R^T7ʛNP=TOʒER zSBՏO DMCm:Q΂.FWʘ ^ jf G2q0+Z"@1NN[; ꤬tYxOoDlv(;]æJdMcͭ͟ lp!!ۇ -z#a=n1<|8~#+FŠ1GAC}mij"IL pP*#SҰuN;lU'J=_WILR&Dؤ̼l4`707ʐ 2FMh=gkMU|ׂ?v2Ȇ(p/^s`̯*$7񤯥mNSZ$2WrԥY,x*CZGJǮK)6kwU$i,T:FpҘy{T 89R,AtH6lm$FO)3>g}|28>"k0 wBBM=:%yP,4HN$ oᱮ$%+ZԠ7Eftٜ}[ehMϊ^G}6#2-UVF&?c<"q 2{ D%K7LBTuAo=d 7K歝6ŽDjd/-ur7^+lF;r_n(,Ѩs$fKl/=C4}}7|KX̻D=L"2A!p ^eRJtY=J=.C.)^ Q:y|\'`g-j0#_J[^q;cQ$"堈Vx4,f^ E]瑠e<V,SG2|ДP4]ie[ԭ;2̰'- }- 49!F"xrf('W<%H<6`^P))emnXLhtd50/ϑD66sq/QIP̠Zh᪣oM8 `;AKrQ_ecrSE{E<,_!ljDid7h*yͬ AfSD[#/QKaZ"Aָ?>\F"4hZ)0uCa k/Un7m既 p5輽+3&Lz{(`W3ʿ*IJ y|dOIrp0\k[kJ#'( 2w0sV uݦIkxxCh r@ ڠCue9x6Ѭˊϲ<>Phsk:S"Bcbu>1: 2i;w|E$1+sKRYe-,2T!6iAC(*L̪qxċԠRJUH1>%;jt 4ũN sq%aE$MmhO mN@N ?fbJhv2JGCUF&$%תAE5C}SQ-^;ݫ;d-ʁ3LmyCdbfbɁ"OOHVtt$5ݝٸTɪ*_F0ڄ{sss9PVJ&dXJo"Vua>Ͽ$u!y sxak'U SM?]dKil1>KZ9 <~=1 '"wq&dhݐrP-%סOCP- 1*`?7)9rvYO XGCx?i'TӼG&0AXWpW^Ķˋ z8ПUŕu[l^䦴$f, U#1A ZWdPPK(ydZ{6"K Zd~laBx/G,'m\8gJc+z@ۿ 2< јS*/T4Auۀ7E3k|d3H\[a!r#2|ǟ9s85!`cr)PR8ު@ďzUV BLbB#.ƨZf PH#(})KMEHVxIS#9@HD}miFi+I#RAZ@ƶ8HMRd!a:c&3):9D6YÊ+`!aCe,)mU7bp+\ȶ^@Z [m P`jJޠ8C:U'dxP$!J/n3#SY^iqt *&OL~{-Aeaud+=)MQ?d9Yhx:oG9%(!i-tiH.Er߆^寐'Oa&~kL[iWIY>u̅^\5{Zg/^9`+\podӣqҘ689ԌνW~m!8kGI"d~7Sz/iְT!ѱq >&E8F 2BqIjLF$Dym%jW:n zl.X#WB: Cҝw.+5U_`:2[l^ޏ<2^|tO10L5$FC2M)aS/_ IuH7YA&덫V&SZT?(4q9y@[Us˯K9bbvLJS foY|:E.Md.nFjvh/hMa,FK7}.6 j$ $Zy{:#vײz"4P G )+2u~ekp$ ڄ@MɨeAx? *})?x|hIHý>{Aj_57UmSWJs °O9)Nh$3<RҾi(/:iP'^2.FD5MzrRv&]mz 9󓁏t\o˸NB#dE2;c"fdH/'X|HD\TBpu[9$BYDIj1)OIR$]+vJZ^AcOڻnK-#@KwUdIS!1A|;#ne?)~sUKkN@-4em' {UI>:)q'_&_Y,cUINLIy:<;rOG0\{Kx6!kM'̦C@[ ㄴ461 ̦}jwOrm!>~;wW7_fJK_B. B/ߛR{ ډѧZ<.MR"àREűn^U L4۾Q׶W팫t)twfSg^î:SeƂOdiI4@\s\k >GFv >[.ӣ-&\K89Ɯ4>rؼ\`Ê}|B֞9}¥'w`AD>E0ZPz J [-uP~sDR.WFC!CfbI!! "NFp{N$ٹY ".ȟ'τ~|׼rJK'w p>hTO%z+G%VF,Re!B"^K@Z\hѻzE_:ykP nOe b TUDL yZ+qYw%t&YYh<1яCVS A7orRxXdˣ&4,UںQnwX c?bD^,6ZkpUAgX.wb˼"tF;HBS9Pꔔ\=WT};T^)p뉿%,{$Lc9J=o׽QJTy- sU; e,AjTO"Uɉ<Hu/O= %/Ų6K<4Dh>x6J51uZrƥH?eS wʎaovP!jB ܖn1r40dGgr!#'6"bN(R3g٣( _3Oo.nAә74 ߬h&rNrN%~r0S%dj./1J]؏s%~uV4"f2~ H^ТWBnJm̪qg2P˗N~TLsi#ez!ov&\&OAQ'{O/çg^Wcw_0-jGQQۉ%w\1cɒ3./s;+# -EqO ZOf4KRr5Fe5]Z/V;X+9u4 J\g/ڸM鯊U$A*Nь< }{ G .8&ka7S[a?H?y3kHB__UOs 1Ju >׶M%cAGvxG<+EHu21ĊnF뵨o>ZM-@=Ib6KPi/1qK+bDQ\W$'U'wxeH̆E-QN9mSI&?%="be0ijMj2_8a.ꭰxV.~>,CJQe)Еm׹GmKBƈG$&yr-Ӣ٤sTD$ qs-Ep FY HrKљ6=F}"A ?bBuC2uG˚۴',ۡߙpT쇋3;$=,$owL2: ;w]qXg ]`lI#e*9 E;ϸzrWrac<w2,QNjNH.}ꏬ<_0[{MGJ ?fHN߹)$ou 75m]$U_پ-MiIY4bf.Pdhւi.C/ ko]1||X[}, 8ySp'7onAƹp0ˑ:ST6XΏ̘LurV:iZj 5+67nSk YO/?j9چ/'c˨GMD|iS)_u" VNRSߚЅUJQv #^r=OkR›-\=!unv(~`k6޲gZ ?DBxZ4rRw;G=v8wԶ$1mFhD|_O <zs0زlRq>L |v]u'ɴ./[[´q{Z*emQԡZd<^5lo-Cɤv<9B+y{{A}' ^4Мhzt'AX+u( &pK2IM֤8ݚJz`t'_6yZzkn}c)n"-<S.afo+(M~3yMXpLE+ V0vd*s >^[ΈcfW5m4Zر@)ZWLkI. wM/0c0SQ8'[8+C"ɿ"F 1`oC&{MWfhA [皶*Ƕ%3_[4iGXPN^俰UxkĘx Qٲx {[R"}]ƫWw]h|՚]5TFܵEh6endstream endobj 432 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3192 >> stream xeV PgfUDm!AP+$." Q9Dr DtF/Z5?Mԍ&w_U7VWuU_} | P(&;+nWI{·v7E,~w EES?IPZAVQ)+ʚbGPʎʈPTuW1[18F=&캹.sI|B0^ؘ㶌{>>l?,"Of;)I(^FtI+eNk688w ^?E&Y±E]pNDCP\y'(Qu8)hTEO!u 8B+-p4 Q3de$b#Jg%H=♧7J!B 7Vjh.BkRus7O5&{-tW-&ENRl&ua,s_]ĎLz_<\-B}p_L98gқa#le~N`1C~*D)0'۲ %=Dܿ#Ғs4[F_J!64{vTt1 lC76> P`:@P]s ۗkA&/ HT3NlU|a&_W/LGK[vV2.m޾7G%N&Y$ q9}(Z>})mmݼ|JcvXw~ٟڲTsЛb:Sjg Bg C~#0-pYzHJ߰O4i?˂\0ܛWC&0MNܺB8ȳv4 ΅1@Ɖ[*[fF0(B EhH؈m ,Em[ne} 7\=}OģE}30VcTM`G \L8Ŋ?8/_O(L8^|vO"X*D[dK '&1njM6:qB ]eL)S9R ?K]{ _ )~٨;5K(|;@?v2i{o tYk-j>c1b| לYZTA3#hd< Ęz̉Z]!P g0!^#@f0llbϙ&T "`9Y{"ZIl C'z8 ~GfxmMI䱟g"]S_[WSϰ>h*6&DĆĀ7D ?`1}86 Z-I4,ibu'NFyhe~+\u&O+g [Sdc m3tU1-]k+:#)g C쾛n dJpc&r=-O≙+ǪK}t-/fˡ.8j*c煝…Ċ?wE8e09*2i<]8 !0 6ᜧ+&>M0ӐHy~hmY4$9p]T϶W5.J7.oH⢴A2doy%/4ΉN`|CHiN'Ay kAt*:ݿ#9Q#i,0eq{jZ[k[x3pn?| |= 6bKPXU;*a( EwНX"e.qLWר-O\o144**4k42r9&)tӤE::Z.h HZG!dy2Z:_ (Z:+LxBv3 =إijtB8 \QmYSjU Ŏ4_ 9wՀxv`^GYm/ʤrN 0+H3NT|bpQaA/=$,*>h޳uBoG(m0Peq"-%ddVj(,57רH Mihz:Rd#esH-8>_?%w!h"[WsPܢLIHYMUŇK`X$&WMm-=B$fl]w{&NZlI]. P4L&쪽t"C|w2L@*9\Cëq- !Z8y\|z<5o߅/xqvdj&F:g—]{_> stream x]{PSWMȽ q: ((^bQ, /#H`U< *"D)P"#⫨]ת90MzΙ;}PF(?X)(&.%AltS7QcMD#Tu;i;,b͵ F{( FW ކ qk7)\\ܝqRYTk ƍz61ZvwV.7Ir!QYMUb!1+KB5ӝ|O1BH(q䍛RRZݲM\>84aBQ@BP(Z 䅼A#5 $AvhAA()u+ ڄ h =1*f#Tؽ)C'R!:kJ߅{bE41 Ew{)z.M|C7”p\dx?Ogfvjhd vKg=C+!:=>,g>¢6R&Тt 8dhM4DVI4)^ѐfH&fAy{zz&$˺hLLogݭj5FS>Wwceg;]SMN8/a_|nsaa XRrb+p14Ռ.I[{ >} x .&H'=W<|72 [#w..-nj> I֖z:^#˺2*4d^pW]׬8ܩXDA>'d Bkͦki۩>-B 2\/Mwc8,&BIDF_MIGKIEV0]|^ړZ 7m҂篬VNz B>)}ڿ˒a34(<.# cXhcMt-Eo[ m/%݅ccYfb[y1(,WHh'H<* KȈHzv0(ͺ߮M@qbkEz5?rJuEto xUJņ?ztS|ɾ]7y]ÝtYw"tC"Ev p[=x@P?),V?npACEF{R eTȇ44>|>f`3gJ"F=ss3Pm(C]p>pg唒WYhڲw gp|Ǘ%TGTB3kHF]SaNz04u8Rs=31 ZLr2͊/<}2N9c\wxӹ i@ JC3ߩ.Ev#ڐ*t@D5BK p:Kʡ6F#N Ra86)tVXXrtZ  :B8VRإqcVtn Z2K>9rDҒgP9B;:endstream endobj 434 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6756 >> stream xy\TgGkFDFͽو=ر0HiL3PeDk5G1}ll˾fݼ|}?ao :p8c7lܒ&;gڴa$3y75x"ƬXTxhŅQCLraCE1h I^*M 7gYK³VX?^& X7{ד2€Iذ耤mQ;o ܲ5`훶Θ ,HZ*0u2ևoȎؘ)&vp3fϞ/YW b D dL|cщ̤'&ɷ*RCZ-tp!_m'v{sǸ5eBk:*ӻ\FwnlRkw0A-FmB(w)@aU#xa)pDQ./ I!KZ&hᐶ Hk*Q<:obBff9e'SJ 4"9yf 3E5Z{5]q ^6%{$!b 3-71+B:> BmnY "Y6KK/cOTz5h2{^EAFF ,nk-(<E՝QcH}Hq-j!WuaO~+U7jp?z$>|k{S2ˡ˼\.=uFL+*j\y/PBOxh H'{<(֟wlphsu}ϰC(q^lV`o&?)K@7yt}8gӦ^ z>G!4}j|hΐ@FF{n"niBwCm;䲉Hxgy8{\ |`3 z ˧6,dp6MgOE F׍V)Aw/c/rh4c4W]ӡAK2J4s5Aoqj=x> TLY^_"A 1hýn&-~ý@`uZmf˩ ?A#t4fǰk@nߵ &>6ۛ.~t-aHzzW/cf'\o YOW&yh3ڊ(^ʇM"6hs {ȩQLfwv{up-p.z_zW"໤ŔO˧6T:v>:ǻfMV"t VXfϠd|e'@  h3TT֪@.]@zck,ퟵlK6EQoP$[M5M/4$mN|?0@^(<{Z9׻7.SrӃrWnu>^1c|)1jY$}ƣ,a@xt۔NH]X1S[ \p8p98Gnֆf)5.}_C5q*^)T멬xl\v;+CG+][2,"~m@UkeG ]=8u^SsO}ˆ·|* I=?ڀfU_{U`78 PJ4eFҨX2s$%s-t@-;'/Wݴ70PRQZ# 9wcZMFv-H6p RF7Ɓm[H|^#KLB5X}H\ P&Jf`f ZjB!K sBQQ)j@MZy8D Yq{8Uw|h[5+nmjrEz"={Vf)y,Cc2h:o92ЄXjLR~o_sco1F0l-Uhܟ ck3jS"6Us<ՅTd]@Z`hJ\W65"Tm n˿f΁vȷ(\ ^/WPg=TjCWz;Duw $ו[UWn=ڲAd~ngO~(3ؙ?~A!/fृd}2:coD_xk4D'PV1{ uP &K7.՘bfu1ý0tߥ_QӠnj=.ܨ7Dix k02!זH,3A Pmʚz,z\o IUT:A̪TaZ:+3ߦ>PPp`y9\v1=q<;p7SEu,$8 G~"XR[R4zJd͈++c.|ʻq"eO|2L |a֙M_i(z>!>$@c-{s9h5ဲ=1#5ͬϲ$8FaqN#?7蕚tJ/X{E<4֪z<ֆl|k!w&V[U9.?gזfĮt!ܼeXe3pVscWJFz-Ά*j3vUP,l~9$\4\aP;ҷ>J73X|#/ebWeobW%xRV&L&h4d 4J.mvb_S~l|>֖,'N}NkOZ.9y\H0j!ɤ6C}%4in%Ddǐk4vp.(_,R3k5uUUzT Z`GUQee乶 RÔXP_eM!;B"Ԗ9afy`wh_rl4Z1@%+u,wQ֢ `“q߄I|sIRf%e>L8ZQWSH6]\ߢ_]}e s'k!J8nzD_ĹO"(#};JSg@^FGh!B)H/S>cA] }˼fWnp8=?8PzG\7p׾}zpy8_wXPy:]3/Y)E/?{Јȟsoi)ZO2R} T־htFzZ~@1 *:R Ѵ"|yĬ3i:- Wk2~x5e'(2q|؋Q=>! Tbgt4$:s^&.3Ňs{R +j4*MN^b_N7Ub^ZRiZ]h-4 N&ehO䇸\vP\+WV*]FHXԚ24=F6Q t)rV7~}d>@#ѩY(W%T0 Av7k&trO򨾙<9!3WנA19\zέLKK)˩mlic29r|O9!ݤ2`O(]eV<)@HA\||bG P H &蠏B}-  ϕ.x/'MwXО7nO#c>>ky/}/#MY[.jij)y*Z5L* 1k5UY"xpu3S&2_2=L v<;RE=|C<okFʞB@t,d,E-ѕ|;:F.Bp\w2OOwZФqm O EPXgV nUIM„&Og-WpH~H+-s8,(jj^9zDé=\T*Y~[qn|(`> stream x[wܶtS}OKr铥WXVRRrտ @.v烸$>f63>_{vsZj'\$9<:ON/v|W>|R"sRONw2_qQ$ˊBBjgOgRJ)ImnvZv6˭&j[9O֔穰YUߧ63dIYc?M[]LX9aٳ}#-{8 3jk=}L= c9>00` ưC2g {Y,2v/tEZUu'u&])a "ֈ2yoZ 7 >;TsEykYPg+ZI ꬂcBe`ބMG4'3W+'`8hax'>Yb )a0M J5LbץWL WSXФf?Iqs ԅuH$1edĩE)cJd0<<ڂU9gQm>n 憖YR[  H0ۆgmIMM<'9em˙))\& n BQ u-z?{LXysQF"W~ l]hv,/*+ϷBC3ϰ}C@]mj2J*2~5o$$}0x*stL0 sAգs#7nž{a4^&Sa(j=ފ{7҅U im;/q A :  Д^գ1HS}3{=bѮPkSfJ B7^$!ivu'_TS3hVKeSM lxʶ3ȰcyiѥK qe5gȬulEwH\Up=*0 }[DwG[.W)FA6UAHv\eâEvt_O-md4mTƍa;Y yqp]|2!deDaSyAuy-z{X‚A5t޳͘U^xZt?АБ ]SۂoCHFq"Y$@ FPk[|B8XM vI,q?b`ssvHSh, ^G I]NDvy]Ri0wUѫ!hQ/Q~:/K)T7_Ъ?y'4evDb,0xl=jۛ>@a1a׷|+W&M)[]|m9@?~sʥhy 9jc͆ KHug7|t t}dg"Q9߯)>`Ҫݣm*bl& I*l6u A腅Tm20(,7B'x}]r:?ƈ"|?eAهxhF(zpT7Wes]oېV`тlP -,]49nv/Q, s&ae{7 "і e*{ o^M]21+Д|~p_M OA$R}<v_- 5d#"Yt>wςg(Lx aAČDMh%!}\t23M.W sDyd\  ahtE~΃BAժpfªr3/cF1Xru4ͽF+ ӲBB )~+<֗4|P8%sWW^5Rk_฽R6zBDZ^"PqN1) 3SbŲ72% uRnZO믮0,Y{L+8=v̈́ JOBrYv_h`85AEe Dx4&k,މ?h8+mp*ko?ڳ,+ۃzy1oW'G٢ ;xg9A$71% dLjM_~+UϘ= kgQ}m( EaMŜgЬ0c=|fwv, BNaGem5 Uݓ JFy=gEnIt 蚁*?l( N* ҙI| }tG+מ;|K. N 5@ >ɟ粉{X^%X;_EAy@E|S>pJ9z94z"T=V:™G_1\~- ˿Gp`W:;~@l> 6!*pT^'N F4i$ ᄅDP]VF%~@%#Qoe! #6iZflrxFsT#Z/ػ}V^/f k 7q ,EeUg/RTZ>K@g9'Q/,8f=i95do?}\s 1gAߜs>cHeUS:C1O_ ]8 F>:Νqt(1BVZnOF :O7rNvrx26]}ԞjmlYmwؑ:6d@>XYc8g?>"G2&@97JG\17 U ~LtKQāuI%S}Ww7Kxjzp @8ҵ#rtf"Tk@P5zMǷO]\J5Z; LNIWCG^iyy["kұ0ʗ"wUӧ~jIe(y::] 7<1Qrظw-A\oN=cVd(}]@ ;+~"m@n)46qHuI7uz; u{VS*=.b&~L\Yd' t&"A{ԿgӮ~?*jiJ{tFҝ1S={BRcM̗ҟ=W?pڼ+Qg3-MJ1ƍ I#r&q endstream endobj 436 0 obj << /Filter /FlateDecode /Length 6104 >> stream x]KHrcü8ȳOػRkmFVdsԒ3띅&{B`2++̬Wf_y*tլn~bוn5PH O}:jU[BwW__ hۖjY uS7J7Yx`^v]j/tWmG~՟֝0ޤܭy[7jx˕UZit5oŪnt=Q}?dAY#+4mՔ_r]7-jEuҪXx|o/-90&Kӈ\d\^4Qv;N-w6lnu\ C:N5vJWpC5l7O^'㸧MngZPhF5 {ӗ?&3 T60PA)eCx-2^+W_[@(p N5W5g4V|U ޻X۶RcE75VcD*|dRQd`̢cZ:W闣}̮Jn"ocTv:a= 2ck02MMzyj5f|e^`ZシD'`Zf&glh^QTe_Ƕm4ךUڰ}mu=ynV+f3XfI_;T"-\zGAJKi݀ ' Goݽ'DB/>o;2fYa\~:<"%id/aoꎵTy{DpYqIߤTdd <{q9J{@@aw T5GhRO avf %}Nהո%%E)!::;.K?0aعCtb c~Hn6Q<9zV-[A*mkM'"gt` 0yx.so0X)#av{SVlҮ]myoׇY=dVw ]4 K$ ;ւ4 RoĨI !ːкM`6A>ࠞNPl[34@71PĹ>O& e)7ok%$+ÉOҤYlIK:=~f Λc.U4J}-m6z;x$SQ!ɜ,J7]ѩ.CĄ^il-j-Cj$k;Hnɜ{(zwdɵ0¿LY:νYZSWmsK3֟^?= T&2|Dۨ^Daf"[eWD`0u(|ut\03P_~!NZ!˳Vȷz#2\ X;W1y#q4Wx2d6foiܕ9L\♝?cЗL#םYӴagHlvr Y)@h .FQ (ϋL60pO4J7G:MVQ ]F@ XyNntib$x@s_3^ׇD,9 (mqnvǎ񟲆I(>f~.:-Tcr CF VZbe"juיz&2vEsQ.Yvc-V|\+㶤fDFߦg4|ثtLjǯtc8m'aт֮ݺϘv[BjZUM'0Af=&UUx 64RCATC2pk^}e6z ~k6F'ML"\Jngȵ۟Ό^T?:ee}yo-(a/d3Od+(8M;Th2ﵐjTx.gS{{4-0ҝK!ʃldwT] ˆu %YMa$ڿ]uR @lY uG.k;` ƒ2! R" P A"k0@$D:)Mh$($D;8#;ۥ" ~ 2Rm#˳t)8AAl,/ǐY*@2{\EtpU0[20XA`)o q[+翖yĂ_ɺZ0I%(:+ȟy6co=!}wV].2[64R2PI Ȏ`(P".&PO|LLzf׻k%צM⅛eH-9M wu䟜/hNTq~2nnQ ÏD1܀{U){(8V)!r\($pWR0Eolub#9OӭH~[;>,t#+b PɑW8zGA88e#TecuC4r0># 4ad; cK s9_j,40:x&9$gћs-*}I..$#2yGUʑw΂JJ0 3Kr>4JR~9V.@FAGBl ;sczcvs#V;k~J6DzS܋Ȏj".H JCwr@\JcJ4pE2p]r9P/eGa!$ESv Q\W\ߕ6`֓\h<$ T9?)s*f! N}rwmo=.YsݗZw_|% G̹@2'̮sv|'( > gG2C0w C2?0]Y\d"A ۡ~ɞAʛ֚kR(59@"y!)30G* ́"0` 5I*KX+00eaHMHDaFa]-kD8fXt/[2C$ȘĨ@:1H:1@2 DJf]d80 .stVR; @9hDS"VZZH޾bdArp(D  *BqJP3p"`a P,?2ظ E~ _R A` w䰐Xb?h0O;@# DHR?!^הr`ds" #e ! 8$gX:%7{EJ55 '!?&_fI(XCGfL0?a#Gv`)s&e:E2scuO)x<<l޹pRPb\o“=?0ɜ/5zw0Ő/ߧ!'^UMnaKL1l xX$W]<\9xǟu1_ÛXjչ3wЧ\|[, />|֓{`v%ZҮlm[rx nǦ|5Lk[Q.I0M0rZےQxy@[˶0cZr䉜j+K2An HnYf?`!ҐiK\}"S{ޞ#k5YT#, 0گ 9޸̮ Ǜ!#2@|ˌ\VϒŽeYڀ)dfps:|޳չ+Ng4q4G﹭C0;zkkg_t/+TjZ9D?ϻ^|Tg~a/ߴ*P/d}mNW Je.tO6x^ F =LV;_/k```$bC׍-ESH>PU^!1wsZP2~Qx̜&o֘DZu8Eߕnb䎾ng{Y)Lٚ#ubMw֬,cZz-(CG`* T[Y녽Js(aV8f7V k쮪'$F/4xOU,SIе;R2.Q}%/S؊ѿR&W}IfRc1M[g&Z2 ԭc s3d'ƒ"+ ЙKѢ3vy;5,zw Fo]-3+:YW܍Dte9ovNS|vϰkФ$X.jÌj.EkZ/3/YZ ɭ|&cG|b3-hAKoKA$ ]y0sݙrϳ5BV/i؎vaՄ6MF 9yqZQZ!ar`TtLYdG!e? ŠM4"&cI7h!Z85kتZޭZ is|D'f[.>KhDz,#}M[MJ! \ #sbnv#N~-e5XTKSMeL93NC9O)OGHlCb[3-#׍1=2-nޚ Y_- CUc\}k]p1DS7fLwg$7]ϲ/-fj[k<LG @_Ǖendstream endobj 437 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3519 >> stream xWwXTg?0ǣbd9K%$Xb+@,D)҆*҇2S)J*bWk qa^I޴M60{ogm^ FI$76'Ƈ%(R̞T~#zKgg8{eYj܊iHǂ<ܻPቮN@87J$V&&eDE̝={̙{Ϟ |և% KY?k,0gJbϞ0^Ľ>[#wY)psY?=(Y߄ĤU)k)^5N?&Qj @Dm6j;ZA͠U,j5ZG^SoPj"NJhm[IǸw˦ɾՌHfdӨF}0:mػj_N)N=mq2M[i2NW!gAhE9s;BƄhŹzL2]!LԂ@0Q+iݕm(shmb&vHQ x`uyU [`Flϫ4 u*^@ I_~Qm˷o1?pC[lS9vhF:Ԣ4ͳ Uc19h0V,|:Y!63 v;Ùy`3tJĿZy #f& ^H60ySҁJaA#٩^4P B!˴@0bMI%iϯкf'oBXe17Z?P QZksn4z4ʼn63/= %my] [?qfSY`oʎU͛5s$ZPk~=}Xq8AniJn % An뇟 dlip!I7q8 :IY,+}@1(e&YXmj8Rnmrepx:'ڧ{MpC@>/v տB|S^3O&a-+uC]h3݅;Sh%XK`v"{@Xr~8SZB,ȊNf_X~Y-iAe@ʑL }sRqzJ^z)h~yRSdɞ@ V* ĪMUb&!;OUht { XPG'R6$QαkpGXR`@}B0C.E %8]Pd Aݡ#l]M{iN]>=T$:hm#$}Kٮy{#"'I4#M)ZOƍixܧym߁wl!D-PbC]~m P0y>J Gr1yTt}?#A]CeIFql8wcpWڸnnT Z\,G\VKL'ݓM5}[դb|`iF֎؎]o"xmj&*Ro,݆.[칌zvjx~qLU-KMtY] ;]7e.94&;[K.uZl%I6DmLT@H7 |KKnto&$b](?.S"]Bw~US4hD+93\P#$ 0Xې*B*W v1X*2)>`%O2}};9rT H7+yxOUd.+-ě}xL D\rket(9bC?bEq--7 @թgmd=߀pCh$[Gj7@=et;nJS@Xrsx| bM^'7T4 . 3p+D͓m t&pA-6ʄRPrrdM)TP %V[@OD폙u xڞNuIٚ{?滯oel / +R"ܚi흂h]-GT8v9eGr.Cf2q ew0gK,Rim/vds7C%e<.e|ZATwtFj]s vBѬv9[- LuU_F~X2Tid"p IM5L8- aGgK{nRF1}}-c?2O~AuWK$7?ȯ 2 $XOm^qf,uQ*cƓͷD]ccRS+[<#~-7ɨHIԦhjB 8̎ȕNډ9;'Q^ն?/ܦeW߻u.% ZPۆM m2M腂.1s.`)L\H*Ӟ{'Ⱦ2Uڰr$2Ky&PVHuH]*HGcs5mxTmLCJ(0a#"' ׸D#x'_׌Y:^MeX&F3 p1'L3!8bpzXZ6t̗"O49X4#F?gPoZN7_}\i w_V.Pw.E!Vf'!5IM.OjpZQjԂZ}EkrO5h3ViWVN;G8}1`0FCtqHd=PԿŖ2endstream endobj 438 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 6055 >> stream xYTT־Cszw"X@EA( "2t8TEޥ)ذ ꋣQcLQy&f5Ù{8goD%F k>+=T\aH!܋c#j,{04օq QP[GR"WʠP/pyg&KL=bLLmwE6533"N 4vcs&k6lq[88(2pU`U!Cքr_>f]n{ {>vqu0b۬ϝ7E/di5@-&RQ2j2@M5DM6S3(gj eE͢R+ٔ 2Q95eNRk)j>eK-Q "ʎtpjOYP#QR)CRF1IPc)F!JUjpոiX+B wkߣw?׉0| tuuWWGGQO{F?*Ӏ2hcq\1 6|a4hQmI5&M-˸q0c<B-&ދ /a¡ "P<ÅjP'Wc$E(=+)==%0CW֣(%Mu@=+Q-6i =2'Orp5nO><+oCex+:.,׈J%pjR/%nf_;zBiG;7gA*38v Βfv]!p ڵtb}d"PdLѮC-G!Q#*Ѡ#1Ўٚ0bA  CgY|kJx7S 2p x~E2ɷ\Zuyܵ5yIK7rɡ>isi6>̅Nf? \a~]¹hYfkrU./erhk ^(WX kMã0,_o37|~֜' $Ʉ219\% DrpJJ GY|a1_;̀viRI^ln\ bQM$rgEY M; s ly1|Ta1RLӌx~~okϾj* '&䞉P7W&1<bBtHc75Wb%FGg/@?IG(اU>mGr$E,ؘIj ),$a>LAnPFoUG>88EH+7{4:kMY< иuF\yQOEp.KX~S(2p{C)v?NW/k\ `(@qGPm|Y f;!k3=主>|0UIT~$4x`4;C\t㋷Y_5術}{FPHI/|NXETbj l8r\M!AH 2pW-pfnTDA 0~/ƑGyjeP)`~\_5%oJBց[^iZVㆢI/6Tҕ0mf5X Ϩ[E$3q(ըW:T|¨eG{s2Q9l{4a2bx,c{ފig{N'v\,F$#"2va~oM;9. Gђ?!\ýyǐ1WT)kxSWxX~jIl%*A(< BDS9VI䈸pO.K_|gӷx*&#GsrsKs"|q[LMng_=}tlS- # .rw rEc<|}LWŴ6\M!m>+oav.^G`8iLn FR|E8* {*m ЩX+ImD1)R2եPB`'p@փ!XEѰh}.=4ԢC)X;0hHP{6 }ÔDAk 4LܓLDY!I`|+P$ߥ䐮CQ+ +EEZ.HŪc/R%CGtj$ I -7Mf[G` [ Yv+Ož4l:*& Ҍޝ4L'L }?!aTPtPZ4Tؘ#^| iљݕCXD\S JKΊJ["f?m">"#D-6qދ`#?W i ewv?q͐ "/Hmd*;ʻW%zO>3J C1$>O@ 4gCr;n`= SKJATi^wPXr K(GCOQ: :+*kpjsPŀ|;Tr&DJ)ӵ1tKi"*"B;<ڷ٣|'ƢDJ<<߻jnY{/$= lslVm7T0 D(_*zU ʦz!3p|^02^VNshZrhXߗyл< bе/h,YLjfteSJ@}9 ug<Μ%l~Lp]zۈgEF[HԼ # '`8o]!;*iScH<4$~x=FPU|֒G>jO)s*N,gaCXS.rזeXoR-)j^U@Pg~o^\E.Xp-b1NG':Oۼz&dN9FZ̰oQ%4GXǫ--aD&TU4A%]#ʹn4W4GۆkymE$kOxq³J- B-QTT[4t[ap$rϛK9txAcVT.4r/lGgs]gNlB>/8zA1RvQGWB=mMlYS7Q Lw~<%.ٕٕ~ 6j KۊcD#0?݄(8 FW Zn`a㡌1}i$@˛_N%I2sg.X{]/MqxG!50o/7K![sߞtɍK,1D-D-j@f1fUO7-Oub#<بDh«N]~͡ %MΌ@QL|YlEۛ;ǺTQLij6Croʵ{Dߡw;*6Jp~{ZBڎ6*L`\ET2"*"->!:-.T㘲}e y}97G4P!'!ZSy`C`u1b+lA{woOSi FD e?TB` ssRtV\vd bB+3ʪ: U+_-%$D)wr;:)4;깗Oc׻OxhzSXgE{*j*J2NiG_e` $5V<[h [ rodރ#ELCw_i2ܳ m־ jņ2;k[z{GHBB#(PŸέh|gB$H7GWGi#a^=iJ&'C/)BqQ߇PFvB$,dߢV 0e&֪V!h+=*29d?co MVvJ* uV^!>?eelՆD9bsxyd|@߮-)h*hVi .Yʙ8b gXW{ :ʓ 2W:a*+Z. 5ñ+N-W<D? zD.qXiK'֣Rڧ_|}abo{ 1(1>("Z>Phx%^`ȷ/ VՕd<`Iqӯ,%^yxT 0x_>igTas۷;#zdDRV2.7 -/Q|T˩9p"شendstream endobj 439 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3652 >> stream xW{\M_^kIB*MJBI )% ]\RHJqy92F !D&̔j$]]cq9ϻϻ}5w>|޵<}fSeY䬴eP?ٛś;6k0wnzsy5u~y^ZH-,B\3v+ddGvURbΑ}U7\,ߚEsx&G5Z7Î6kz\$/geK!r6;+27'hyة5tֲ-VC/+"mbK Ohn=L@9y(o:_QbjyN*9tSy.Ne5|b4&Ėv@ER8#$@k##LqW|YKȀH_W&nNу>k: "p)p$Y %<g yMxqwk: #Q D2çOMG w#-{`z0D 1֨Ui>4 @0wvUw'%T5cfZƲ찖U&jqWW"jo&DP9rj _ܛHaܣZ?I3^4:I  & ' r}'N$~D+z+CK'L_h _@>vVBY -)XA|Xު~mP6-Jdx :i;zRcqxKou ?~WI!N^`JѼl&&v}kl:m0IF0w .Ux ^}ٔ_>YT=kB(K[4PaТ`Q$w 3#VF)A%n;P5jt3ԬD@`q7e-N*ةT>k. 8IjPrѥ?lqy=o!!eݞ2FNvmᾔ)fNr!PBAgW 1ƲXVζɍֲU8 yrf ?1ip=g.7:>,yH:#>t !"iO,-l78ܗg%]rLwaOWiOPح$rq[$W8.}V&W,[:GhvrD3\\XoK]ݜ6ly<(8ׄ(]%k"Z!/3+-cX$'SzksoV!m_6E[? [wQD1u$^Yxj|!JY=VhHgQ“g2BA83qn~*G_o)L?0*A'vءzSTN|9'RCNQ]عSG|`[a.$j`}+P?틍ZK+VAj^ED~O2bAF4`nW9Rc0Nƾ _p?= OrKyh C KIs‚ݣ%W5$']w'K4=5)X{g˵ұguRcZ3hZhbX+MלO{}k$=a4)dJ8y[-pEi)Ah6d镜On%lwuW܎gUG \n :%>!<ʅCCMl"䶱a[S Ί8oq2o,!_d#?aMHLXufmȝSg͈?:53:6A؍\[YŶ`4o l@Z̥xlk60_U:r.O1Ξ蔦yWRs>8h%h Qn=bѲݓVQN6NN2`Q@ckfuIƖ$BS=`k3_g*`zn(%e'fTg[Cقs[p"ƴTkϨkfc Q>xRx\]*0K a4ZgΛi *FmBߏSO6ǎTۊAc󂍟m{-d} #Z=mR&}!5R%G2I6#Ik%LYeFe?kLc^ɝ&g ҤK<}kd@BvD<2H dn(~1o/3k ΄b$qKatiA8`~ ZBL=/Bh(FB؎A6.(q}8Λ5 !JDp' +_߈8Wל\hި.o!u {KcثէDD f9ޏ:*V~scԉL8pnAh Qf7Q{_{IZED. IQF 7wa&Ke-\+^ߜ6kS|M :KDI>^PM Z" ٳ7ĖMFok+;~w#w|-gnnFRbźaۄV+LT-LbӂyhpE$d£ޞ bo2}h0fOgV"UU݈Q[i{#,-Z~!QF+ pk24&qj8Jz/PL[_9ob}UOKD,^q.Af~_͘D0kdEVyˉⳊQn'zֽCATP{`G|Ȧiq6^r!z5 y͖e]]~X˺-(>Z\j> stream xUiTW~ESՅMSAJd1DMA5iAFE`PB2"et&yy$1G}}~Bv)ڜCFR¸ 6ٺ%P;iLzs94 $*d*G`)jJXLǂxOooyk2 ‡~<쌴L9)Zj]J!*C6[Mwn>!:dMv!|휜܄uysSeiuFh4Ţ8 Oyxh E!(M@(Ih.BCxG3P>J Fzf%sEvʎ:iWh:>ʰL$ɼȷ+YV`19U4T#%m\#K/wu4dp; & @)Ff@ 8$g1e\{֣"5> ZQO%'! @ ZP Zo8)C_b -c=:=>dG_Ó$ (ud?H9ܖOǔD|؝kVcwwB_†=03)C#Oe<e0ߖ#,!Ib]٩enw, }Jڳ'<^t!-0qifF4zƹ1KBu;u/ /T rȃN@ @*ˡw:44;M]'WϻS_gߞ50ZxYA vFr P-mmLn$C,L{0?@0-~Xm~y]ߵ7Ols#ěف>Mu:/6+pȅaJqcS%`2I6鴵LKn*dXfmVڊجE9 xt|E^),b+`╊8g+w޹M( yLonav0bwmljaY#HOEPԓ Y/i=Z/{\5띎cl<(mo@N LruC䊄hv BuHFsjBY'Ek\ ~ Q ,'=':CyA4 >㛶%Ξ LfOJ%5M- z!LݖHRqavjX чŁĄ˵4i?X[YLq¾LL=D]O}+'<au4\yߙmmzH٥:sdi@2f=)X$W( @ ʤW?gј.<|_OLzqT?3hȋQN(k'b3BBlmcIvjl$J ,Kk :s/ mՙwomgɯ[YR-uגuUBe&h.,8.ga< ϧds8d ѬɶP%J!} @ gendstream endobj 441 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 7215 >> stream xY|֟vK&.HKA1 Dfwgkz EKT'.~wg7$>'&ݙs5|4qOlL춨g \y8p~MyzLߥ88Ø&'7ơ񔳓T˱q aI.\<>}wp |opٱ1ÂBcC_u߾mmnAERgΗįMX>iCTc7m =jGs3A3 ӟX8%K|Ū/̦fjKS[Vj&EQjOJyR;.j RP먅zYjE-W%Fj)C=OmFQU1j,5Sݔ bT %&RG9SOPj2$5Im$aSN熱Ú9_f"=n1;&qڑF=7mwT?61ؤ+?v|]F4Sⶉ&^uqǭ'dI3&N6}Փ>9cSOr=O?頻icEN{kt+3fHqu+̩mmvumbCHnV!N{(S18A- IfrsY&' fnA(i u:{*IU1h4 }*ۀ[.!?+ʗ dA&~eT*p'0l,? !L/XP۴?>/ <e5kCkElNHNAal`,?ll~c:h+ #Jq-N,:_reM ҙhuT#TL/)bfC^gr>9L^@bu_!=Iþ*ܽ}*+Չ%E^q-|Z¬g,x ^]Ǘ2X,iuA [0٣/ Dit:i<9hnnK xp[Z¯_Brhƾ@W.tNTwI0In N?m|!Z%t&ʘħ&F4=_zSi6cMhHeJmZBLKPͫŀ%h_O8Ngϋk65)q?<z0aSf( =4YAaT TžhWE!'@jˬzRsWxc%W8v\ѧ>\w<3돟ӷ(769؍gˁ#3y O#WތeSUxM>S=M`ۅdࠫVlHdkiw=..ZĦUMu0Ф[Ca:j>`ig8Rk\V>|~Xu;.) `aנW_&[Q@);mĨ券XM0ȓjd8\C*Y\i~Mz7tX]q3VɍaMWg+I@QMJ^ruXCan+ Hb#l7z)t';̯̇\Q~X~c R6Z8n&KagCTF`x!3MXA[ŵcMb$l}ςゆ۶ A~wJ\rű3of%-bv Ni5!B~Zݵk'92ev!+ʰ:IhxBm٫1ynji Ѻxm.c OUF6Rg~N<{=KC/b!m8Hiڠ*U=oҶZb+zkCm<߉bs : ߺ{-jD~N=Ô.͔;’R. n )< Dc(&vC}8@2fxrF-avM ZN@BiC|rLaj&M㛓/@IS#;"lp8Y_f 9!^"ÙE#Q@{ޏ5sχ^pA$19ߑ߮m9ojg=ԙt8+a4;J&އO0T¦) y(DUo& ,e/at0arOHb -G \8L`}9Ef,ˎKmTK~w>\>D#fёW U+t`L#'廔Q)K5 +r]p{DŽ*(RΛh3?aNj&jɑFw-5P nk _QP3AHj9GЩ\dz8= hhR>8 rHg&Jx\M"WNS m`½\d>l.oq? RC3c1ǎE%:!Am Q"IU/xNOt`?C))?ؤ4+K L"K)&+;q2Q:bCz'qA%W::P7+,]vKG"WӤh 4|=Nh>c8W)b~͠t-q?G̒q ۃʾ;DrFSŸnrὋp&Nz#7qFhn&5mEyjN*||wu܄kЩvg{7 M lÖf[wu˕7E$Y Kd>"6Hf 9D34 3ivIt^x,(8ZzSRytyƃP>6ZdoH6=w}IBDhpBwZo\UGF =SsrA.gm;j}gؤgxNllrإgOgFV̇=2*Ddg%UaE kKۄ3|WŻygYKB( Z9e2co9QzRİ+[2"_s[^kvK}ILSA%4ؙ4bOƿ_t⭓еbe}`3-cUyGwMKE!\!R{Iل%}sյMX@ú7?}ThfѶ 6 Ww;s2ZIX(xGp>4s[Sj/Z}s"[;kT!jji^2D[]ɰɣKӻ$B'Ygq.- ye|s3}dewem~6u@IB?6$!=|ԒZK|Jnhs䟝~\%ڄe5h裘7a=VWqJ" x%@@7_K.Rukd!7-+:ۿogX*c|C9kV}.#w1$̰7 UJCUd_CauPXV}6#mGIdq{Cz6=qY-P|_SH{0_ s"lCaQo IV)$HHˋz8hAc?"*G>EdS=I9~z}1~3lAL8ffg.VS=bV&@˞qeOyE؊1vh2v3* ֽ=4Ρm{ g:VCE5Ik_*]tٍoXu?#bs(15-%8%E!9!0%b+[?m'~_dW|O]z>݇A΢{z;QGx4thC /2Av6Zlq|Kb>`ݺJMO$u=3W@+[UkóϠǕ=W9t(AjXCt"}Ya] UDGf&36 R%#\ąIg;w/”mh=-?~q&2^r;? AH`fs4:NܻxI$7tڌBYfblD6k3,LQIk5 H7Q}2'EB>ҧ3 :Ǖ&s^,M%[UigbrOejAI0ФJ|9<7KȈR42U^B `[>14 0!D6UT92ӈjy4470K`:3©L9]^. =+k滈-aMJLf(Hs fNDZ6#n(!P6[M- %dL "J-v NFq5@8Hepc7 >;ӳF(I$}r>]=;:$F̯<=!9~#V25#'[^%tiѷϋ{"!Qʐ8m펔+Ʉ[1&:KlʮA2df=:.']\MjIZ AQyA)u\Q:0a-︢/:p8q6l('KհQhvDz:rx+|bsk^XbfnoFK8Sζwk;͍B75645@ -֒ҟXݩxSj2f$EURU^:AWM:Di Nh̡c`?{ȶchb[?.ol2-uR:6/R]N( ˉCksEgVѿ8EN-N0ymMMZc/@Եw_>G_Ԡ1@KU!MJBMC47Ssl{2nfԚ̾7z>ܖρD=v2iA+9SKۻ[|La2@PuD^)E)2g./1PGϣĚu@DXx4SyLnR*Y?\D쫯4;=Xpιy~;Kc\֗XU CYyۻ xcCK!ER,1S&WZS yɚeP`&Ux޸ǥaLUD7ɉbsIԃsUN#7Q'>H\t4 R J(Ł6-d#UJѾ~cϣl?%.A#l<#c)Ix(<~칠0}Jl+'*$iY#Dp h`}Zz֍3MhH*5d+zȋ>~"?+߫-Z^."c>$Xѥ+\*#WͲ J]!So"{w!E6D8LN{7)BMJoR: SE= zB'hCXO`"44;/IR[DE؋WR-/2I_^SWd)#(bylU> stream xYn#}W[AHrC -qen(Q&u9՗3`,V"{NUWWUW}p&NۇgQ?xs?n&&}h~9hVgIT4Kyhq,(Ӭf߬3.i?n  V_m θ[߾%d`$o!^6~R" >d޷h_V~U!v8 C?'׶>9l`&WwV췫831BfM0H&ls4mgy~~jzp?J}cъI2ޓda!]vtY:9/ < g`d ӐA*K1II(98=KSК1@~q^'# Ll1&4lMl^ʹB3E&#,Xiǖtи**2)pJ򒞦Ӯܪӊ"y 8WvpA<@y@yAeT@yW2Q2 Ai@?4Z)(֟{*mp?ۯqG8ky;~>L(V?}>->%(Vzi~J爯qp59X ry%ID{6fy~AruB8dj-/Y.LA >};&Iʯ^$YER+1-`O75A0aPt̔sh,Y$ в+ j"Сz\M'e*^6hفʶ*njܐ-/wNdjD)ՏP D7lzۘeɛ AS0aD Q9=GJSޮ L89@]j3]nbSS8s̄\8&P _<‚SpHt;|MisX2 < Ga͔g[>ԑ&'%*>.fԆm\hw\,CoM&kwۼBZtGPkM:~x @`h6G KgQIb%b4қ0${*jwWon=m LNjvI_kHfKUXӆΏx CEz]*kpnƾ6 ɨcG׊+1є2KCdE0+ܹV -(\j\ooCнJh?$@{ ҵ?dSj\)(s<?}\^~M:φ,&>vWm>Aeʹ-E=W%>;0L"U룮ks5f%KzWNK 83o;m}(W_Rg{rR ! N]XEGjm$'YdYB$WÞ7j360mױ:KRP jnR?{*q/\,R G|B$; sQݵqY]vZ |$WCx:I貔Ebk p(:Ð[EsV[ y_YaqD+HN@e3Hʋi$_V1LalJb88faq|eGpE\5'@,;~LrMzMeI:7ɗ*FOӸ Pl7E1ˎ/InM*M%Mhٱ d7&@'Skԓ$ =zlc*=yI5)D%JU!͑=}s1P$(&J+RB~3RfjJ;x9XVOY:[C81r&l'̫ĈKX\G0t\Aޜ*8?fW-ceZDbm<;D7i$%E7^J i1')\i[0?WpVWWFendstream endobj 443 0 obj << /Filter /FlateDecode /Length 5454 >> stream x\Ks6dg#t3k&@߼yx"vꚮR$m/؟ Dd4rĄV#__>_.R\V_۷/˻_.zw}+xZxR6U#.>\RVUsik[6:\+HWVBf*#o7۪j'qF˜{ܽ+NR)>n]eEC \ߌnُTDh :v)O \t簆npW7\bܪtwE ii+] W6-?\S%6 Y|a=¥7E~6[C ;O:#qOXnZ9<v  uHb.=j1 69TbL7xb *5/3Wh30]\IGotA ͭ nÚA%uOVC=7=F8vmAbAa)HT+}``HKTO]-mx s=0vLx\w~T%l];"O<,sXT {,l/ $=q٠ndMxTDdͪ݇aimw( v蜑zw1A\3b"!_P* EC@II^?Â͐7!Hbt`%+jxIg q"?? n-ΫvܬByk=_B鮎o7z~-Tw-0]܊+xMLSl cm;o!ף΍*ÉzFo{o03O45?08i KλUapl>O8AI-EUȉ+r] 3U]f.!C`w;mBăMOźX_Fc}>M;B8:ze'̑ul"Bp´Se|.q#'Lpm1H}YBigO}h:OH|G<49*CeEb6DhQ tV4jcCuMirѰ+ aE<ZH`>KxH@n89lcJYcJZG8I 2vo c\2s~; 6[]cVcb10 vIFnNJIUjmF)" UȘdJ2YyX̀6y_llFYS:D6`RAȦ44>q߿o-H<~cwm2G13ۭ b g`I-{RAznn>i @)lp fC4[uC|ѻ7pߵ##7ݦvר Zb>"r!S|.x F*?Z.RMLDٴK]M:-h I79)ZE5򫦐% g ϔ1U͵3dAaLۣd_Lބ@H}X)dsY SD$*5yȋĔ=c }~`%9*ABMy \P,M ȋP4H6udyo^w,8vz0a&‚ 6Q8TshrD%*02"`כ,##%T+eΤ!z*4`k_?'&g@dSgI;04%Y$.GIA?d5 VN*CN~TŃ2T{l0eyCURXs!u8&P#SAg?ɲ ^ˢ]2I|g2p@ yԑ  >!(lOTZ%̔/& 6+Gߏ\74,HekH9&R/UH| 2A4ZH g71^st7?8A=z1Eӊڤ'R6>Ed*Ent-9oag*n2qBD"EwBLڧgKsA ȬT>:9 Pm~1q4_PrF7{Rv: *4D돈g9ޅ =.eynx5%v^ kPfuZYH<44iwu5y7$CvwgyLtTX۟} nĜc= @(>R$l-RׅC^J8" _xᎹn}j%:p\˳ *n53nhuhe.%Xf6V 8V>KU=Cj,176VĚ7wh{ H4Ƒ $\ }t> UI:3t" =t9"`X ʓbޕ4vl%W}U["K[ C"'sӃ->b tg^ $tU*w˱obWv_᭞v/|qܓx\}wKk+H鱻 $gL1䙔C@Qxi|f ඟք턠%U} Ԓ*_ђ[iSz(%UXv/xڧt>I!bK+4dY,Ky> N'R`=ݤ1Sp CeΕa=v^ I[u>$qմ:7M AP@_jBQ^SB~7<2ᩦ.rS=ݦm-u rWmadims t֐jW0Jj[+jͨ$YwC糢8ޢЦRIRjsOVncz.Df'tAfgZc ÚtBH2h͛ l%lCf7hcz"&UTS:/C{31 5t]z yB/1T|6^m͛שwQHyRlc^$YCdª6={m|z/uR%\pyXnrh_O#eA dJ^ӯ4J> 8ĕɮ',L,L^Vj.5ɈW]s16܋ˮ-0eml:]QfN|. ENxˡkhf?1<͋Ө*bni%ESamxU.Lv۩XXɄͳe,c6cg^!zbceE;n4*y^ݗ8AuVXR|`ކHys0?x@07C?$~(TXuW-ķB7IU:W / vj>Ag[ Db=Eb!?mI/i<:bb;~3]‰MƱ䣆fgfq`s?m؎Ew7p':KBQ*.Xo,tXݪfLER`>&?Qq7+$f| x͖_<*Õnem~{1I*Ja aDO,Irɂa@ddMB<=)j!6֊};C(Zhz=&& ǖ1Rel!! 4l8G);ngI\:.cn6x:_Zbׂڑլ6¼ww,’]+lH2O(<70O]|o|ɣ_όI<?(%۹ LSDV%4x8$]+@xΛBK[3F1MaR€,HES7~tYjr"'i{`wR&ػΘ7o,hcj?CWkqNe2XRY_}|2jҗ142jvOM,.4(56^Ɗ$^N^>$fq>'qjZo`p)r^߉]~_x6dK'mg,_ sW׷r _ 4ʴW?gܴ/3D9\Dgwt5aF;#PO%~A&5.Mmx$+> stream x[K䶑1%ހcg#${%}nxZAu8j5zg&IGc"H$6M-6 KoW plWu7_\C M 6obWu6θ:(>^~n!MSw)`EㅷzJQءi|95JWD~b[D+;8= an?H?`ږ+jpwWwƋNzW[6;c+ImcSijjkf'jl0. _ælzm@Г mhd94v`#% 쐅;XŦoMjB|>|S+-IQ{h.)ArzUMg(p"PuH՘M4%W5ʖ/L (H+븩ӵwB9% +[j&7[lWB{|cJIe6~6+eh3%'kqbcL>/IXR$I2.o݀mZ.qpg 6s  >q չ;_Y`}u:>}2o?w筴@hl{$w Oܨ]+f,Tmiܿ/ܖX|8F \IǂqƗBwCPUަQ,/C)[ #^4+е7IlYB@hLXWASt.aB۝i@dQ}C{=\% )CU+!E%%d4:X**1 5a`߷%cr;0(eb8wRCPE;$y Q/~'ffm$VBO+ɹTs͐4NBX`YW"?D`?UÉY} uxy< Ȧq8TC;%lBs:1DcxrUS OQBGSrڪ-) hIZl:sk&]!MP\'tmYdn;eBBχ|91}i1[YK@3R>iPա( 骖$vRv2  2LiyS1K䝶4StKjED\4UŊ#.kh5tnhJZTXiқ[u=M+a5M~H] f,%ZɁO TY C1RpWBYT5S^A!@_/v;ꔉcƿOgh;&wƅ%!k.HDTIpň`Ѵ{=1g,n@S9~8J!KJ[ZW@~ .H,Hv٥FDA` )H0 2}L+8ND2/ן/}"+эaTG[ІF|pMJhL({y8wI%vᾃCq:y sK"\˜ =BĈdxA4TwH1(R+SCcjn"em/I/6E4O$wj!h,\${" ؏nMz)9/pl9T,qxJ"ߨ4!%2C2wc`}S,j9Gcԫ^/@Gާq5.JF\+Z洁mN= (ç3Gs86/lGtGE63jHMOB| Eݍ]BK7ҀS-d-Bs=Tb82 kiy=\q%性&ƛmN)d!V;v{ũ{s/dx&#6bvjBqO փltAAy☾I.ifM)x<,.=KHBƺfzx_LXcqu}'C;! Ϸ< Y. C j.1<]T6=d_#*yamLF̬:%qe :=!`gѯsKK|}yfp@BJY_p O7uEMmJV>1V#'rT:S-hJ9b3y6U1GLt@?tdNӥG*ۜpLMقt*bppוVQF :*jx"y NVۇ ,qoY,wdOadz c)׻|WYڱ?-*JOok-a|a%O! @$]I IǺwyp[M|b>+ Ȭ=10yBF2M*XD14mXޝJ>:<2gӉPsMZ*R2:OJg:e]TPԁ‚r,LhՇ>aS@ > pǐ> ԇ.B8a%Ƿ=7&*C kN!8StlDc7 Nk/|3`ߧ4 ,F:twG TdI6?g"FycՊ5e[P}ٱCi<(Ȣ=V?WؽfH:SUӵ zy=t(o {{7g=T%~+o nǸZ:fwWw=ʟY=gA/.LS> =aUژ} zkЕNxW<-賈DT$W7(eM~noZ ⢧Onbg7qG0ݴ?skQ=Q`-VbTo^4(K07e#^}7$f\E|kXH;(W ܚW#qb'eBi{.SFj&^鳊}[Y,Xs> stream xZݏS R=-q"i)t-ξ]R$u5(o>VﲪdY.*ۭޭŸKX!5|SʱfIYfYf)P~s^\$+@pY//R°b-G}}<ѓruˬhY=s.YXYVoceŤɻ/r5U;4/ʸ25ݮPYJa2ʹlid8#L; V7 >2PJݸXk6]*n*3|`H2S5#L)"]UJSq8Zk\`yԦf0ckJa֦TvSY 4 ` S%XwzU`dƬ=+t_?ѣV" fwaZ3i s*ux)ْrX(Ew|8?NBcta<q%gqgoޛ =vlMS}L Y 1Ώ^V͵XsJFnmX3k(x_pk`]D)杀 ӡŚJ@=odnf?~lJb2a.Pa Oڍ˒aywo:Ń1( X:z pO Mx__W`kkն(À I]ӳyHZ23'nd;e *5C4֫sZe11XQ1>3gȎq@؋68(#{"`!X\?l-TJ7 8,x*|.{vL܀w&(za< X( oeᐬ H<&AnL}{ Fx,RdY_oyDC&4|)I&@W ˗e>8E&j9t ,axU|b.^CuЅɑRW"{WS_ G?*!4 +P?n$tz[ :bpC |{%W߿|巟vDP<|;KhSwùa4Cb$1VA*1uIʒlFy)B cvІf*z aۗv\ #XLHcc.*p9΁RiylM^A"a.'C;&y)i@|҆UwfӳQePܒv4 ןE|;E!o :$6)ڈ~XPKdqT4?GJҏ [[[륊aP_M N,RewȖMߛ3 lh=OCw>Tފ 6>6 Gb0VpvL 9#OtL)rCq펤`@Mتu_`lȧ&Tvz)M0n?V[3i5ptz1b'Sl(E\+)> "լB@wyv0Q8DR :t|ZBTn3/`&5tsmKr%FH9K]vhBE3{ ("PXmS0h愍Mnǡ)=6,W=s8͏S !il@3e1AK|!#NttH!DGh$&<]NM ŋіM1\4I^QR8Vr@Vd$X|Bm%$}>l;m#y=0T-t㊮bRõr=Iz=P>{ɐPA ="]Pd) u:ɖ:p? 6['&2 8I+nOn)@jA3k 4臟$ #48 "BpG~ͬyx>1vZVrbNςnBj<@2qy !IV2ٜ鑖bt{tfqE~bمtI+am;]h<ț2fL%6@"D'"h/諯&̮B'i8{iumw .3K5U,qM *W \gzTUߣks7ua~5JNɚǔE'|O*mzެ Z:8VK20LQn5]0[wT$7}.\{b7-b_c瓘R$Mxpli*kn `PgL^!9endstream endobj 446 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2674 >> stream xVyTwdf@exw+Vk^hBB!RA+uPkZ_vպ^v/ jnǾyo}"b%ϙVJp"~'A#/>KS<)1_PJKE Kuiɚ$ٳ 7q%3)̔de6A:3lr.[x*IJ]rz22"dmrՑ|%AL!6.>,aZ.u=AL&Ve"XGD%Rb1!fˉk<"O BO\):6խH$_DIHߐ$(_jIvv?1cG#[+s|rh${i#ҝm\ FؙK&)L@XIQ!P9Xt$*n+n1rexy5Hz98."|D0h5/Z˚]P.VA_\ #5T#5ަ,n}RoT3vAV#?1t24i]<f"~y)YW#l(H.HHk -cpzꮚía)[! O94΋~ߛB#_3߇2e(hgXMPCb4Am>B6|Pf>7+ 珕oI8âFli;.?ݿ(FP +:MVqȃ#jH%^TB2;% HɒҘlyDYP,92K{/U1{Qא%;; fŚL^sB{6i㺲;:Yas:QlG]DW_"FNm[5UqT55pe߭r֒_^~hU|&Z[m,v^:7c; /0:<:?z(-m zQ9 k(dX@ZT(GSQ"}?GR@/[vVIEKXԅ8"Ty/=n'1qpj|?$Gei1,eװdHcTuBS5e{a|j+ʽ hStg ҘNl"w*"ż~ ʍꡙFb8lNLoN{gW.}#Ͷ]净:BT{)of {l Hټ,mHrCu٧(~v9Ă52d(x0E%%A=uƨhA%_{#G7P`L|u~D)M5S`Cu꺭O j}E݂%<81?voRR(;kb@jK#a>E@c6֖; ~G Λx7&v"I-$ .иI?߾8 Gf)ug5MՂHsf,ɳC.BV)cD^<Ȧ$ʋ,V@ X(wޔ2E+l;M`Cy@OﭽC$ T S`HpeFQaEPQ^G\p*7Κ 4&g|$>?أEauDжm3yadÙ=mGjbHb1;zbLCGAXi2Z%Ȼj*s ̐E;eƯ51ѫOL Cu,4C[[J.Jtv_!@v0񡂈s$d[ j!^@FhymU5²9sLz @Ӭ&jI:m">)zRxx2h]sb 57._cJVx0~M'^!o/CH7% yl,Hu65 As>pē2<ӭu2g+N*vv̦(3rhطg6ª)94\|6^O: =@^⇀tIo}!YeH- 8?As1H6L7l!4{#"iC\D1מHނF/MJQjg#}?(FC9'2zb%TެJe%k0n5I ֚_!qVN9KϦ%toiX#v\\, oiߪ菲j-qTjq a,b͍P> stream xcd`ab`ddM,M)64 JM/I,f!C׏zVY~'٤m<|<<, }^=G1<9(3=DXWHZ*$U*8)x%&ggg*$(x)34R3sBR#B]܃C5p8MaC FFg> stream x]P1n0 T(`hI 6i*`YP!/E2;5⢛2-:4zςǤN?%Ϫ9}|{e꫟޷> stream xmkpWȆڰ+3 e#0  e˶$۲Zwedɲu 45IM&Im2 s3L쇻wss%DB"<DlmٸP]CW#jc槒̳K2k-X}k]kWAr?KF᧐9u=IJ$o5Xv:5_nذP|nUTE}ʚΖ&RUWtHF[ؤxMkT+u#:{HZؤlmoTevz%Al%=>%b?O 8 0jf:Hzn>v mo4Xx3..؂C\p$JcChchNc. ⟍Ԥ 2!6s[MSMUr$~?WxםzP9| att89 KV+:pUսm@VߘFVicfI{?J)Y̕E5vmXM(߃VSoTG<ћw$|0Mo,͏Ľhv;LE}'MjC3tǧ/ݛA}'E3xF%&KbACS.jKk+Z^?P/ΞF/9t324Ƀ s=cTZN8 /]6 )8Y|-0UEa𸆐<3^wy3@~3xQPӬ) V_!1Ru{SRkF]ô+.Çk^ gNm< ,<Ƙka hgٔfDۖښgd[j)# 2?N5Q/4 z(oM1_B X1#Y6Ws5Qc FLZDF@}ɗ,W:;Uxg2'ntĤ}1[UOC.xXL(矢$ e% BvzLb~&2wvj"{קȌ bsح6 ` z2&7v]Ayzh6@ R;#UiL#ΛX c<^%^:O Cb_~j([Gi&ج ce([ud+|?##HC+ΠY߬(vIK;E_kp^-Go lčamzc w,"ѿ4pP|Wu2:[[ZS^^V8^1sC\^7%AA. endstream endobj 450 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 545 >> stream xcd`ab`dd M̳ JM/I, f!C礟 NIku0w/=Y{ pfF|ʢ#c]] iTध_^竧_TSHJHISOSIP v Vp Cwlhd   C UFk3 ;0tzr`阾A~e=rIa:Y˺v]g*{ZG\Fۖ;QawvЁ/|{%.Gwwfnnlߥ͞u왒';;߂ryl 6\jFyr+[nse'\y cTY$C?Uwޝ߭v2skrw%SmE3XjʁrArlp=lksqpvp/ zz'Y7kYI}&Le`ݵendstream endobj 451 0 obj << /Filter /FlateDecode /Length 2370 >> stream xZێ7}m- ./[uWUUzE4싊VOz?:F7wjJ iW2VɚO/雍BuZ󗠂 p8cU !rq]Zi/Ҫ:_vS㕒WªK|,)M?I`VA K7 Abl;gl`DptӂIІjpD™ii =ű--:pO2*ޱa3j|lzi-B|Zߝu2N71&8$eE0Zxۧ0\+9%N[8׭ ūlZ5" b\iijeW~7ƖӶM&2ݡ.:RE4te|&i#dxt3Z]Orpqa)jCzAأhJ0 5}`mZa&E7fcƦc0k=4vTY k]6_Ry 6e~xJ5SxxC<硩{RLuXi]{ ;d41FLUZZ#()oȰE쌓IMI1u";2g<ΠUC{&^ 2m/*T8N|"RZj|=㔁C88]0z搏 n!O5 *a%r0OO[f5L]ݿ0qi ;caCT6۴:Z,RvgIYT4mN*J3kGTeaTm|AIϷ-#Rv.?F!hc^YOp._r{Ӷ)EhԳX2-ɎZum[n4rU*tM0FqXľ(.LMk(Ȝ# 6{U(  T1SL(p&fJ~b80ti2'>FOJpmSRi0/OY3k ;BFb" VBFrh5/QYe6jPbQ ,9_tԾȭ[u4HoV,_p 񗤄꤫buЎ7V-^5IWo.w>=VkEoSjݹ?wW:+4/5oLĨ w&ݕendstream endobj 452 0 obj << /Filter /FlateDecode /Length 3317 >> stream x[]o+}ׯطj&!W6ARZ,Dپ=Cr\Yյ$Rg3p;O\/OwOym!MX79t]$Q^v3 4]/i?,WJ.X~Y7^x-%dB/OI}yxu?%B~IXDڻ#-wSjڿD&h Cڿ=j,s-<׶6t&7,/^|uM;h\'Czi!4?5n"<bgkQu{u6Em5*(޷#5h@B1 >i݅,a]Kb!*7VBvyy>}ǵS^j]}XJ)˦K6_^hH"%&UNa#!1cQVc4"Hq CD'P(U^@̓M<cM D2pvRDӒN[$yLS9Q9A!k:dTg4h aU{=48vK8xd:]5 >)qs!!AL*YAd+Sh`®#q294hmXpQE7AEAqt X,PJe96Uc1( L<°a9)5>t^YEi {ZBz%€e!&o67尕J"K zw|,61icg]06j. =_?< (#&a#{'qZYi %IuN˜c$C@FD9W/CJ@$%dyZ Sq $DV)oۑ*Pf {J:)&ƚh@ 锈_ޕT[. V8ϽΆx!Af*Fʶ^GgF4Qݲ dȉw/UۄV}\iM[nӢ>[\ه>F/&Z"\jDWeOR| 5]BO(F 9E=VUQ jŔ Tݿ c}Ro#\((7eY!<":]t3Id+ ؝5XJ{rS%p{ 4Q{KMSĚ}Bo8 mL`rGc :&TR5v#yay4HZ[_)`+ ؝5X KX 81(a{YP!DȭD6@2kF KJqrFzǨ@JNը<{Qao\ Ho H̓A(Je$!k=.Q~(k)hmG4U<`G4$(OBTQg*gA2L`McKO6*+Q Gly#jT|z,5 ,y_lA lx*B|+.q8a7.'BV8萱<7c6k}>.=K-uB3XJz- '@ 6fEiH\p퐑1& .>;OU6KӕSV.81HeU6f0O`G'@:ZYJk&v{<*BH:W)UJ*Sqd[F`tF/[67ʽWcu=ųxTOר2bce-밁nTy-y 츱Gs#Jd1%b^H$V0d c?#nP>^;6%A'p `6#F- nlH߷o6l}|\) D9t]%L_M?[!La$oА9-F0mdc/#fxY)J!!~8'O3Xh'KV<4PcR3[8!v/OOM _[ͬn7{#[#9KC3;#[܁,Pl!CGZ(s PX1^\~;ױ%s(/ӝ;.xs~v%uda-S=rV 6uspBwۛ=r%yW9c%ѥqskl7/=F>%3X</,jh|'F[׼`0*3rPrg9ͧɎq2E167˝g.R4 g|"-%Q7GlV.[rp;/xs̜8}L ?g87}< '%,zѶC9$5񖺘Bo(,zd'zMeYR xXr49łd+q78E'A4]=Ro΅QU#6c_rP-L{pn*3Gn#Ly3>"E<7RO8#,ɵy=h}D"wYw=GuAOŌ=D*Fef<tT w>TEܝYF{8>2uTE#-/sBDSeѳHՑbYʾ}̦a\(x 'Tflqb_r83ȶYO'zL3nW'3,wz !N+h AVޣs6̟7P0 {G4ߦ-L,3zΥ6wX$΢g1l蜝Ϳӻ&n+/%77^c)PvPRa}_6 bH}]j+wo{ Dgh0u族5K?Zy2 t%}W/ޟn聗> stream xWiTvADg " ,M 0l-PhD5*Aq FE2Jw{R{^Ny9wݯhJoEӴ~@rFNrvZbV0 Ä u8|0рB"dW6趑`5%)Md5eT;URR͝/7si)dj<93;$M|Z k(/LU>}X<(?1 )$9tEXJjD•3QSb-up2cLY]x|iCQT(eIQs(+*LYS E IMSQ7MPӨʗb)?ʁG9Rt*O9S AQT5ҧ)OʐKPFK1KP452SfJS$ ڝN[{aEFѿ!K0VR 'S\fعl:{Eq_6l9b숬ߍ5 . 3h:fӰᯣLG͌9z3pPJ Cp,LXŷU7 ޭcaz Ph@%BDkjQKg6lJymic%Mι )W`^J=P<ޛSUS FjTM$o;AC֜.#Ub}%'86]>Toa=ѱ-G~-G(P&7+/sKy)?a'䲒JEGL.صӕ+#B%m-/SY{ s!pkl'+^xt}D;H@r]-MWBCZ$@ BcSZFM6"[) (jV@|&8t`4gDIDXa*fW?C0x~"i3idO@,dgC iK˥^IQBbm3` hp0 dG_u;OFA/71xDG.w@JᦒS Ԣ>c8@A @e~g 7a. Vmq~[Ɇ2C J_-&)PpTj %J7cOJ#[0xOZa5`qY"XN50o+K%~IV0Wj Ռm(uW$ |kH{$-uPXVFǬ^PZ93;pHcy#2dBUǛVf..5V6%+ $뮐`ӰW@y2i^ρ+{uEL+>cր {ݐɎp8&bGVH;*6ӏE5fc+_Ldefӡo^!ma?޶q)T?qr%tZAx|`5r{ܬ4xxKQS7f"rٸԚ/spT`gkmXv(WsJC1 i z`s !H[*Ep_Y v{Z;s2p`y)8u%8za_HNoSq?*Y==C%H׮(,avݮ>ցgWEֱE)o?M(dMF<~JȣWз8l poY y/t;5"v =81` ``.*;m7\&UwE#EșV3ZϙoaI28Ƃ5.Cr%԰%t/2ɥZ]Lf,{ N ig/LE;M>=ѱ݇9zpoApk)txzic)cޤ,`c:`,pֲ_9,j`r ˽ux0m*aJ$Cb-4r̳8(% $jAU0lPDyC-h sVmaˤU)0ڰBL&8aa'M2yX\ $ݱLr wsvy`㣟EP%HU"x2Vhj.R#ԪoN {#u}rq}MSӰ{a~ f`J XRb Ƿ/mow 4Ad"k+ja?_SM>y8&iQ^([b#8`^)uWx!6 _8ZAFdDlJ|E0vQ2~[k*:(PL3~\6[e,9%V?o@DM@ g֡LӎN3= پX7űN:cig{td`Cx Jo%X;.],Ϻnڊ w,6O]Qqct&m{0>r&82] +kyU6Œ\fDc>-ZX8y}p,2:d/?NgthZ#@,[鲢@˥ .cRo9@UR=@=y!7129,Hξh4FjYѝلj%(֖v3,$0eݢhG۾Tb x!+Ty Ǫמ]"LQRNbƺ̜a ->znw.%8`czRAzO%uM$ ؔq·+5AWř$Zh3QD} o{>h*4#YHЛm vw kgИY [ޙ A uuZ<?\%~Oئbsg, lm`;su&1JVroNw+nSrb#N, Yo b[2x1x&N$CKB~,9k`hIcy$RT܂@8A{`-bTR19{8c 1NO& !V_Q !x節tN ܧM"&oM:!þІH⢅,%n*5пt_~> _=օy[%M`ic{Vg?N{[7l(iث^a^&%xB>@gV׈κv8wս /X{-&:4agdP|ql ߗ7 FGC$3v22Zj7dM$` o;-@ic,\qYpAo8҂c&ckŏS!Ycਫ਼q5]9${V9y?m ؂s1Kֶ\mI^z\"g6qv?:QK ? 0oO|Bw24ش[j,Fhٙ xyN.3xs`0V--0Bb(<Q˫Z8> stream xZߏ~Sއ_Jц nH""ؓdYtH7$w\I>!pNK ? grskQq/o'PZ&ZM~m̷_!FjϽ_NTQI.k}匫2v[;Mͅ4z1)jof9F4as<'pްAQ'%<{5%YlMMS7G5oGBB.iaС6^LTד'ߑ V[URZCWe}u7ʙz/~ES;x{WK_mU}\cV#0BRvZ`/)0YbNj sKSkk+c@'4½M3g%z=@i|21w"6o!lJ 7!4 40U)@Eڎ> t5Nѽj|tS"}HA7d1b˲>y1YRdr&Z sDYjs0v2`5!ϴMH[{^7~X"=ӌD/ +}}ƍܣy*1U>Bh@I9I)jB4L'U~LF(lf]-dQy1&jK0+ѡ7 C Χ#vcSE{>"_sXb`tXPP[jX!=>H${Ҋй/?ZS˪ǿPnÏ e xYsR°V1e!m+jPF/v poBUC܍d=Hq6J#AJʥ&@|*a\+5&<]4AՀ;dB$zȎxM7FiKU.pCV٦/ In;hjP~M,!^CPςe7pej. A7&s PkKe2p 34]? 9l/$@! n$F,MFbH/:?(FQw2ag!LB ]l32}jfX3?v sz× Ei6=Fqu0.`0apq-aH0S4jKBtoZl*+ܲ喾8zd ̤pŀ,_ t5a*"?[d/3퐆2ῘΜ^,!䡚l^gxڬ+¢#e>ixr,_лC'R!X[t̄vd 嫙UGz'-;|F#[ ZYZ@LEtPtɴYgԎ (jR^/ak0?'z}lOGX&:t)3Ŀ)d |mC6}{Qe0- ϋ[c]:8CM+'j8Ip=9X&]pj#;&o[v_)F+U d\0b M99а6V a#958UHY#+ͅ"ZX &R 2ϙ4M9&=XVc S=joD4+nO* r^Q?e#SrKQ0Q\] 0A+qխctrSvI|%L!ĢݧNìȧ>Bzb(/iPiYlET55ٴ(z6\hO$3M-'!:B;T(Ϥh% ] hCKUR輋*úUg֛MzB忸A]ۇ#<a&iRlw vSe&n8$R 3/YE)nO"@_v(]2p"Bv}(+@ӈI8EaK:U`OKw.!`]"}7H!;ۏH|Έ.S26y/WPEvs cCucf.j}Ey~hJg=4)sPk{0PE5AcYgM~TxÊ,9 l;]WʹNXل=8s,Tstt>*p- ̷##Mo5*o Gݭku^w}%p`r*Zzu}jedx^3AԒn QH)X'V+j59ѸSC=l@俀@$>$4aJUyG^Z`I 'uױ)sEt"PZr?h|~ sńGZPUǢȿ>xJӆh LM>wM5.5vf9fpgwsl$,8iR?d쐛0 jߒɣ5]F+vZ/LX`4b^xYtߟV-/98u֫&oDz._7Ӊi_wvao7Jaް_.LN8N w~o2I='2}[4O[TZ|jDž W(1J058CilF!\93C ]n߸X{ꆣLdV~\Ov[QѮ\nlfO>Dߒt\ŀendstream endobj 455 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 3144 >> stream xWyTSw!c:n mֶ3ZEPTaK K flD ;HY*bKX;ڎδ9]7s~swqtOINN~r%!y0&6QVy<-O|jHaH(WĜ=(jNj8ƅ%Y"*tIwJ%2([.ں͛g%[ir%ʢ\0 C%v0Nd? 7J iyYBI`f0K{ش_'=a_H=rEqZ̬"qN^~dԓ11,ۏ%`Xv`;]KnlEcX,Vc~B-Z9ќ֐Ԑp\ }>orh5<.\X_|aA=_ J ҇g^T18;ĉYrbW@ &x5y%EkR-`v"AsN/V=YdSB Ի܍"T2O[lX@M~=kIYd3bJD谩K\:ZwS`ʍ%F\yϸ|dǻwubTCaUIUVE,6Vhn *UFQM`ƌjQPl{edi} }3LX)(Ə?{mriaP2jguk/2LCf#]Kz' d{0}W,4qm(90skIg zG?/ɥhI1 uN*NI&t6O TZ#h^=( muN#kϞqR#e^~Kʖ0nYhQ6p*Lm"v2#ALN85Fߧ寮>\4xd٠P]k;WWǧ^5ɪ ܨ#΍ oƙ>_.W{ x88KSh.W+JT2U_jς20eG_Lھ(Q|ݭ} gnY.ں\]jB\+eua2Q1o=16Hzƪ&CoK<^d7Z8Lv\; o8tI͆erս@)$e"i1+*+#n!j:keFm,Pb`Y M A#ɫ%(mEk\Ȑwc=˷/~yAWn^[Ht_NKoX(-EI )ұ}\+P̢PA.k5=5Siq_|Y?Oˀ1PWi#ck-Fb?Ceߕ_(:iJ-oA2za7K= >PX ٵ~joMf"'_l\5_xKld\`ޤ#J6z6N}?OyH#Nh Vƛ8& V48][ԞR$'c@~ |=} }Ys^7z=ڡA%饠UUM~s|w6t5ș]!w$hBZH$'wBLf=<:*Ɓd* ؠ!s.exP~\npyBfz-'ڜrh:qt+Lmp: +9قb[ -FY q(ϩR3aUelu'&޺06tC̟mg)Vx(WJs3n}D7Ľ$V)vA(kaSz?9շѭ=k*:ϑhf@9F}YqͲVPi 9&_  C=W_V ߩUH +Z.bAQ{ӈn_O3 վqHҦ6;.K {d$vR  PBudj=ҚBv К1[iokjkՅ_ŸbG1gNDIFNW2z@8˭`%LHt]V<_j~&eq,zrD&pѱby-С *R6yV (康aFdM8:I#roxl۱@Yh9&P=T[⅋)+ۿ=j9l'R-a [Jr[fkz"):`o_S0 jTH@i."g:Z>GUsC^.oJ%:e'p&@%wJyҶ@w;ŧTdk: .ZA,_rP Va:ְk PmYa+1d#endstream endobj 456 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 774 >> stream x]{HSq=隥,lq fa9)wm+{i[ns:jSVy ,d=$A=dGA(XQp|qAsjӊBѰ6SD]J9M!5{-IQ|Ts-џ8Kbq!z:5Pi+SRu 2*G* ʑ˨j]MijuR[L*쭅"EzVGh R 9ڄxPG|(iy!NqvúIԃgkp 4p~{X%o'/ 3ZD楫2cb:cxҵ0C-dX.oN r.fD'-$޷_*Ӿ3gIx:IwdC|ITBըmŷoy Y5GAs%nK׾1x94`Ӊ{|QnY f+LEcx1}ñ#He"f[䕒޲V tySUUG& ޓ!,H:d?BwF gGZZO{7\i~v}eq02~';Ȑr.xw.Hա ɨX o}qy|֍c:pcFs`bFt23]$øq9Y`6BPRendstream endobj 457 0 obj << /Filter /FlateDecode /Length 2284 >> stream xYKo14c, ] ؃,hIKRTu7n{`#]U_}KA+VP_fQbh2cm[BjxR9XxSVXVe*'T -֮2Fb5#%QG\_9MSNZKXf%ɲ9}ieE)Ӥw䶢Lrh]k7p9cR\jjpE3Q)x_Vg[8Qs*dxcTESk~*YI޵a{\wӰѻzwvY g?ܑOe(p1Jx뷸q;tu'M|J9<g sޓf=ypz+H^5 t_ޗޡ.f? c1R;kpK @UqpBLXnfQSB D%@s.Lg30/cg[8RG2}>R)9Y*n0:E x+V5tA v:2:9YZ+M~&@'uw,+渔)BQUi.PfVs*H,R ?\j!gpƨ @Iw|¡ \?|%I2* PT:0&kOD˹X2|&ϸc5u)֫KfA FfȧKϬRlJicγmHl&h!U6I=HU܊)ro(Tb.Me8S 9v_')4k$jx/W,sZЅoG60QjH ]KZ@Q9рsp_ih1!0{ KM}3:u<"o3!*]tMeh샖S[`C5>p1xoRk% P0Aظn9X[Xs; $#=m%bƄh5E(DrVq9beJNj>XFQ7R*Xqe|01 $%cٌz3F@&0"Һ~45[tJDyCh\o5\ewmş2gH}?ۢZ (@`^3O^ ,t_nzۭ9=7cIA1BF .=Q뢴U*ϔǯW5~) nH5\ϸ\{Rxi IG.nD|;@ݽUC>38Z#Ym0@^PQY[*wCܸ'R|}S|;&wyn=-I_Q۞L4 vF@Θ7S)[cx漨!gA;HPnAv$_̧rz6M9 W( 9N[̥CMi CXaX_>(~-ZC#[/)\x( 忴_wl[KDrMu M ]S{/iת*ʅr\*ʉeumjΐ4}P~THRO "C<\\ 96t̬lZ&=O_ NhxUpB24қ >vX$Y > stream xWiXSWrsYl 2{iVZZ*T EUr.UkXE6bmv>XCNV3sP,?&ZFؾavi;B{gAHת֩oH֤tzyd2f{^Kb+"BD,$›I"{^Ÿ@l$K@"Dˈ[`‰XC8/2D:1)Ρ]!N$KPTi ڥꜬ9<|f%yFh;fC+ PWu4Dg(Y pX'e!`^!A)ds;ף/U\1\H6,S Snh{9 c!N fX, ]=(T3j^*): K yՑIH2q}hP׆*Iw}*^) #gw(&ASnC=:M@fAfo  m#|,J$ NCgI~]H:J>w{ 0ѪWa$I g(v" M7#yXXb hw@{hwf3˶mvO>|߲xl5,o0*p0;(K֦F7o{ŽIpI[e0rM'U6rCvӷ(6GY,{z%82͇F{;s.VBKrVJk"%GwFw14OU `9i"&s/[;6O(hMN5Ymv t#h-[ht4 P+^%Քm-> EܜBVV/z@7eEfqyC`?L\r,o."WUփLhQ;_NY_@n^=&*4haǞ4@&B'!kdTRoJluIQׯOEm ܆AO4]Փ3Q35CAh SO;f209!YƬL=JrU-e,atBӗg x꠲C=ׇHz٪CG $60ҏ>T@z%]h>aFC1X&" r*_DVMeH^+#9U+ Э<@_y?O,D3QzUVII. ek;_<:U^Syg+gCJX9>Yދ#rE{Z>db3),#FrFw qOW$VbJ9Cp|q uyn۪-|}9UmHi/ Eh oJi%mvM/\J.J i37UZ Zupy&~OG/~} nn-87ۉiap.}Mr??Ҋg|%ftj2Tk5&JяiS=Q):Vcؙ֤ץpzV[,|nW-K#! %;Ta ie*m?BW7vяP9_4|'-y*QYI>2"w2%O d.Ax4:h``uA+/:1/J{wG!hǕ}rw{L+8RF1MjNaj}gon2axi]幝o~T|^a}MB.~[y"/Pn>S˓;krѶHC̐b%2Kn8i%$?4UXg1L[o4 pƚ2`* L*$k{kob0*gUpyUiiv8NjG|~J\-rj+\Ŀendstream endobj 459 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 946 >> stream x]Q}lSUセK)enb:1,:pЅ}Dc˪uٲلݮl}meƈNdĒK1b Mޜ;pH#Vn/YwjIOr@hP +b6ZQr.u D/ҁo%Z;Sqյ͞[u{ޕ- E*ΕJ]=$W[RinYTif:i5{\ %n^Sr^I[*Z*a~5ȌP*Dϣ(" k W}#`*o~$}%IҩxX*ĠE(:k /tx{udoo-ZPo*1~8 |ĩ SR" ʨ"0Ÿ_*B&$CA S㢊JLۖ`nV`4gQST1,d_7aӂC 9qz$d=݆|ધJ9b2 dW@}c2!Hp;0mͷ5s}Q8j'~y wwr2L{ņm+Gz$Ҩ7Kvt {A=`Oݠ<]?Soendstream endobj 460 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 946 >> stream xmmL[u;d^ ʼn^tfM&Ƭ%L6ua@KW@  Җ"Nu!Wg"&|| |0Dcf̹.,11IsN~yr(!Ee\ZΝ:_q(*8Qp"y%?:jyn6d~1_AO2A2)$QTMĵz:m ,[e%fnvVg[RXZ<`qNf4\#[i;VU)`*x]G$\BHyT*RBJ5&I&v5Q\h1.K2@#1(`=nes.!075Ά&hj .nFo.7} Vz?ſf@j dJj^o }똵Y9L) 3-%,pꌬJ1ϛ'a b!~ =s/-}f D$ajx"b*gpݦǫk4fVq8weq}u(1jE 86<_' >j]WzZH}"ֈяI v uGBc[Farx _{%\nƯ]{zKNuY q΁m^2 M@a|8ta4,\`ܸ}Ŀ{'aGIR qMkNȵ@01JZ%f uY gEUw [XRH2lwɼE;Hj@3*Bޫe6uճ!rSo Ad CdٹYgV@ҿ|'|&/ݥeR>'ݸO1l-o1ZJv>\θ ppl[kG!]!Cdendstream endobj 461 0 obj << /Filter /FlateDecode /Length 4551 >> stream x\s6rd[%# n%lqZn;(o4{?; @R癔#G ?_V%?_xQ]^|K5ޔuUw+(SB]^]zw7hkLVR0 ovUY)aXUݕyi@O>Xf-f]r.YYV.wܔr.*NT䄖ב AvwQ-EG]n 9Uѿ2ozjd# }D X:1]&m:c)ڤwѨ>]'ЧM ] ui]SZյ)zPF1ɫE,l \s(v]լG>o/r@]<(R\ꚕuVgchuE+:Ĵ5(~c!S:U j]>%~t8™Sž>x̓[KKA;U>>p) 7nsZmI6HrWR\"~;TL%L)wN4YSݓxi,wW <*'pʐ$ܖ"JOԺHaW0|hܚN@Ti578<8re׷C;W No1X{y?v#15skrX:%O P]++KTtK{R7Wa Pz5 g<~Xno.v<37) wx !Q<5fpЁvJ.؉,<҄!۽ ># Yl ݗْK \C KFI$N&+>u!XS g"g7;8YkN"؊=dKsQFuhn!d! uX 0}iICkj\FjQ' )Aj-"MDF &L-m!(+B@tB>+[$TobrQ5Pk^ںr?bsDUr"^0{|_Q6 eX$j5~(x}d8.""A,]$Z Hi[%$~%?>4M߇LN<3HSt#9-%<'[Or|;0*.z~g+}s #qA42bM\ZF@s B3uX,+]1"SR@h'2T:R_:mج?V#>9p N?Ԡ2bsk+< ]*ۯa*LC}O^ ~NMi3o-c<a 0 oy0w`A`L,jN~LulB;;Ux ` YUc- E N%]d\h+qSPĎ`; ({ޖj}{j,lss6MK8ڠBUX[\Np WC+7aQZ{񂉄s`Ctd#>'@lLrjrn X9 8 gyic58ܴ`[H$[n&G!)kW8hy$(!7ejwOW?= e6#X1_c%峥ؗ G] $z;T$HH9@Evt*:auR8C%3;i^״l65`ir>OKsc%n*c))\X i*Ne8yeRZSZH+R<Τ,9,.H$AGs "֍p4 JX 2! &{n H^DNE@ᱲ+VK+3jx4 3ZM/p̜ԗ &I#.Jx["Ja8CvD]j"b҅P̀zO"D1:C!8D$AJH |)GwfMS;ߑDc9[}oh1`ZЗHM0w-4h3\ǦSpzy Ѷ=>"mR:2;%r@xx5CyY(m p$^J-]dqe%|ʒ_f9мJægQN':Q wA{BR=Sbܺ셝 83&ƾYzxu-&wvyCqJڀz[.ǐtޅlZXoa" PJhRDE |g/p|b웷j|yW O Y-jp$RX3L`D=\Leb#M9Vk8 A"ʞVJ>ISY?G䯦EugjX8T{haDex?+গ$nj|8^🮖1XqHB2MKQ/݈(dq4v\>Hۮw \6YLg|>`; { - /e?PSw}9] A9 0Ϳſ1@$ fֶ^*}Lx= _w5{#&3dܭ|)G^w=ɩN^0+XE. p0PCqTxR/k ׸?u#1"xG:qZ6 h/s c.Ԫ&dAuЄDv^ *4Zn`|? 4 FBcat64]kvBA凿4k.ПOJ5͘_Ew<(<H) Ww.ߥʿ\x׺^endstream endobj 462 0 obj << /Filter /FlateDecode /Length 4835 >> stream x[o8r~s6/QnEM{[l36@BcxUg[WU$%RnIbW_ljv_~h./~`2_JH oj8vyWe]ej'zsPؘv1*\]T]4uavyxHOIk,Vbasw+a:]ZۺaT/b>8ƭPڏ##ͪя[Z#~oB jcÊUoekuZSU6WPX8? PqfwɇǴ\C6bg8>EE9$+v94ךʯo-gV.?`Gх= ,]hH9 ~_|*هc;v)L7]Tәg`!6eM9[b=}9sIBp v-؝C^:Kg8WneeSe!*!YN~H>So"JIj) Yqvq톩wA2[6l8-OTl+MWo4rC;[qǾ -xRM\GP(9S) I7Rg>ʦPiD(ET8R\#S%i~ ~ЫP3]Ъ $rdf۸֛xJERo:L4V&CK2G[e5YXU4I.'?wϝ 3~p&YpcLWl9˲E"D`b5,Tt-7قfw`a̕EB?icvpzۅ~ucY36$db0{- WCp߇5qxRqn_䦑k{`Tfb0 Ar.CQT}GBro|;So2ev޷wýx7fMOX?2~VkƩjbo[ӘXvMa2U3(9[mm *P'N9TkhM~`+ CQvx4l#PW:7r_Au Z6,YVjZV9j^16?_x.M];S>sǮa ~&K{g5xݬ@Ԍ]j/iMJ4MZ0瓂;pAr>X@{ Qi.}N(PHvy(mMoA-ɿ\x1w  u%Xo+A\vk;FT4oV6jVWaD-ʧu3%M~1Ytƀym+ `((&A0 aLwI#lURJ#GNP"j쑟jLc @; d%$PbUfAE}@Ϗ x|Ɓ EuN۬A N 5@θIo>_iUlS[ng]4$mQe Nv& I. 뽅H챬&֋+|!O2.Њ +i7'<l(;?wc@/?_`=13`d SݬV/5zRΒenS,mw;DSgDLhmB5>𥫦p^n&O~^t i)[+_ie8` U O\$/p(} !c%%@݌`}b&:6W5,7ā˂ \E!LAo*#b)S?5-Ex2wɅV$i-M}R*nP1ek#yyV6OVqID}c&{i |PK Qp`mZV! d! 'qVVMSUH[h"dt#tTN(7!ct Tb6 lIB?!]dCDR9Ϲza+m\w[(,tvlO`$%xH̊p5|Fqn"AIID0}<7$^I)1u8Ɇ6{=sKNL1T)XۜFc]$DK$+<'}PsWL$?T)>P&&= k,|y q`$s "֛u/",gYc!^!*ns&3!"~MPʐ3 BC»Sr}\xٱa[S!/35Ь-S$=sOjO-4A8Х~Eӟc-m4Ɩxt+KƜjOYx8kbCq0좟Ty#gBĔ|EdLIgԎ z~3;}}__p희J wݧ~lO/6+X=@0A  $5WXVYC 9ֶijPIڊ6(CX~0*aNą53 Wd%}ԉ"?l[,S[ORœgjh14鲮zv~ 4X%a&9g %MII8ޣf4d2ʧaB8v{O 楝 #t\˻JqH/0^+Clr_#%Wcd8CMmc`tCnغGZ2G+IѺZ*8}0xi`p-!!6Ȧ8530 !M˱,-#P8 lFP-SI++b+._%Y;yJ"1ާpT\SA}'UELfFIp^Ob_']JGbҏW> YF~҄OK* Dr3'6&J.LME21wHh9.֏⒊2fllX7vF#-\3oU}#g/˔1¥Ic|wpVBu0c4>֐AUz^0_\EVzhwD ~ضH;(~ iMaW EY þESq鵞Ɂ.Ȱ!i^\`2ba>"UxQI2Cľ^ t@_ƣ1NI/-o;], S:1Ēy%}i +nmHA_cLD3@YP>_rW@H3"=,ЫtY4PrǰWq X[Y/a/CO1pds&jsTU6SPKKs2. Tp*@<9iDeo-iNrӳȳQ(?ѨYKw _JׅxĮ< Ų.0_&<^tqiUX?Mlv)I$tS|څ:ϾK4Z=7Ę o$z:ui>S&*@~9qa0A H{ؚnlrP~wtAW _Ʈ\ng܄ lA1:󬟓Yx J@pFS=|i  ױAP—`z4̘3 #:º׽|d]M@qFOQI'Jz~JN*)FtpKJ# Yk?n(6Z&'yٍq0Lt! Ts>cw `|(z1%P !̐> stream x\KHril/7 |'ؙ/+cA[=\Uui=7df蠪b>"3##"njqտ~땠ῷ/u۴w^\;VU_sYc)p{w盦nriR }3z{/^xI۶~na;ܧ]>H_7B8VJ씩,ovaD{Z!}ɶe'|SƑZJIf-]q6q:Ͼn5wE{ٶsQ: ;쵩49Ԧ m,zLܥަ=qxi4i cY(7(6Zj6J%]{J|򣾛_mֲq6N+89 5DZ~e{]a %q܊IvESɦ6M\FՍT;N DyEJ&9nLϖ6M:P2LdBR5m\W?TxB_wa7Eں^&f^ζF ?y иzU~ߟh|[}iF lVzտbYjL5K74] ~H}J2ËBKd?m0­M>;ڇtZoស4֔JK w'\6~)$+ISzIx74O60TTI|^2|ÛK|Q }hrs| ͔ w% EwÙÚu+aSC\As.ɕꔏ6iX͔8ݙ}7 H 5@ z=Fjz:>= =R՘6-O:a B4ߥABE<]5 _}C:2(vi8 T&( >Q^b D[ϏeHO;3>)OKž H>P,F Kq91q]woώa1OѲ EgҺ̰,caR9>fml@tc mpI#dkp~;%h7tqyb!HATEh|$;S:`JE3F˾[(}g FH# ® =]ɍ45%{ͱ33Z^h.vA.!D4%?\GojѻD+즟¨~y rc֬c %{-)rÎQ ;?oO"(XB&wC``v3`]g|m<)keԓ,Ijta I]Z:SBʼn(Ӆ4/ D082 bS@9 0*@T,86;!; Fmi{z%:JGe}S(`4* e1\2*J/|Ƃس).AqS)X J S_-X>2kri0h2!wPG㜀!} XM^s<]g?],+! ͋=!Lh q1amE[9s|̐?=@jNTŊ= OÁg>N"F Yi57ml2,2̽T31G{<_hR0+< ?u OLG ݩsv%)n pwh:Dюv28e̚O.,dDE'RY#Uo)w UoC(@glC;=qr^ ֕'l$B"o#y$)Rhr 9cG?+D{+4s<XՀqu#jx*HJUƦ2SP??3ۯ\|_`I䴤vp%7]+2*?ЕVLI.ZwuBSb u{'Fn.(gQVݟ<^"2%b#aL9W3F#)OU-5|@6zbyaJQ[NPmr0E쇵$9D.cF:g舺P5AG:?-kWy6A KzB'ʕ׿jׂ!P`0e8CpϪx<:tTSIJPq ]]s_ עqWմ!] ybXuctDm|m})|@-)W2`:]>DF?qY鯗o[MpJ56""Dp>-V`5@낓!6h13Q߅q_Y/> stream xZo>[WD*H HM}S:;E I֊c͌~^__ ]w.~Ժv՟C&+󒯶o.P|eJWz/lLҹ(3c$ /~d۷<˵4E_5N^`ʹ=Ñp?=:b/yk)\<7y-u6yYd}^',>7~0x"s! 3\|fA0QHY=^\U, uɉǚݦ'g-s=U/dcx(F_ڰq!̇<unB(.ڈ*~ؕMѐ#xڻ:BH$4i#@z$1 k0KÕ%<ޛ[W h(Ÿ@I8\u{躼.*i?U= Ѡ ɰRwׯ^/Fy`eNxˤrnBPIa/ {*>pߡw)WDOI[)8psW8lJ2bK3lPDq0TĬy8kS&'3dU78!h>""3^&dЦ{;k ̪\x)7är R}д<+S=ؤ,Χ^΃'Xe QRAqY*#_cWxM0yHU<;3%i&ωM(1/:%:?T KjcA_x#9>aEԧĖB9pH횣J42gLw]'x5/G6LnHNn/1;~8,Su^5I a}G˔j\*?2' 2@|+XtWϫ6wJևY@IpQw GMl7Aшr.GcCp*#9^-9"NJjEIu(%hE@Z% `̓ *I\GCQdRio>dJffYҟr]Қ ?,-7 3r fG:@pvye­tFl^L&'!rtğq~}aAnWs~\$6uNr߄-DlqY:'T z/;Y{ؼUipfYaŴLN,2I\\e&9Y?I2+L*M"m4Ԓ[8O0ܘ^NC<0_.5uOn!BcT?cvuw?lRr~>Th=20MxXzAa8qU_)rQM3}a [ceIr IydJx-<,He2]2z+sBfPبIZV*v*|<P"Z2%jRDsuǸeoiqv=M#hi>2@ I 1mS<IF!R4O Q0.*ںy$ܝ HǞݺDaLwSn5xVיv w?]f1A)Ep!l6qd|JK_'$`?$!//MnNLL>.ɋrnd#$kV IBSaq ɐ*Ti ` B·JN>o}CB8*U8?ae&z$Inj]:0W/g% ;H>s/=#R%_dM>[ 3J>r'Q`]F ǕHr)Z İUm x$P9Bd də r1sc=Sj=3\\xLKguKKR᳞yaR-VXK{=58}>VZR1Xnw/mew$nk:OS ^# hడ3)m i}CbJP*zQq"YB[ 8& K2/oWendstream endobj 465 0 obj << /Filter /FlateDecode /Length 3726 >> stream x[K)''NaN`8hn'J*oW׿' | Vh˭:MzH^>0~nw4*kk*RwZ3Kœ,oJf>+ݯTDw8i/HuU?*dklƢ۸,Bi)aӝS;j7XщItw[g{4STL)XKBxVFejuUm6- <ޔՆxd(T ţ?X?Z`FDU3m}>%r,c$dpEcU!N2#Uc7 74 uU4lOPY<1zpTc*h|9?u>.PG01 نˢ""6~tUe 6wC2ms-0/W tۻDy-NJRac&rPauD k>! '4&skvS_?O~X$nE7lCuSلs5FTHw!L]JG F{KN cS^”T`{݀#=su@;m Jl4? ipnڏ:T\| Rj.(H`|jd [dII_Miaa'GGL5y? .cGewǺMUK_)5K"g%\n@ߔj?f^^d٨r}cC] ezˇxp J ^U*y߁gwc4:MZO]9)'!k{7JN"oFft55XpBTrl>|fT34.0ZonV]$i_= _oPAp +>ov]NͰŜ%'ijm8=[ʂN˳ 7F$5 g$AnA Dw y\`w(P>")3!á9< yܓwmEqɱ 9˾6 ;j5#u{f"}"I=ziX$m@G xS,uXe9 g)MUwйvUM.!賿CD\1Yq -bghl>k<{-v[ h!*Ɇ uKYKKFt|h`YcR BJX/wMuy28l p]N/Wn*'ٳ̱Wys0-KM(tcR<_'gy gcHR~}pv g0[<3 c0ʀtm`Od.HS35rS,NVGry:>Н=[u3:O w7풚K@Nl*F'[Xͳztb5sN;?L NaS:$q&S-?eY>=uH rjzP5br4qY1W)f͔crS48sZtUVLSSN!,Twel2yU;*`; I/Gqd (#A[Bz̵{1rrmߐmF mݝqdPW'R>C=Fpմq:Si99pc#u*L^qjL9Pf lgx2w1r:ޝL'IϹLJDu~qy/|[qB$xOA/qm)!KU?cM' | oK{!B%8H½-$żQOC] mbGaZD3W+?d$ʔL="UI2_d9/:.X}vV1_B5tXpDw'/PIL@ oSh8`8ffMP/̙ Z=8Ǻ[؂DVfeh jq^}/&G]P!B]\! $KO7<$xh}JEl# ˟γbXY&@?*7l9NKh7)>\# }E)BK;04 ѵnLHMt#T̹Cy쯑N{:.vzM]FJq22,IkR2ƳC][1oh3qֲ 6PMx=&񨹞ŋ͑+6,9m|j@3_zPus@qXI+7܎62rcl 8yv+MKM-o vP8sKD\A:Ln3ܕ.>=pS;Bs\ĦUr~y7ŗmQ!/z6_pbH&F_//yQrnu׏P.5.]PpqR~ D `ٽ (@~ߛ=y!i~s?endstream endobj 466 0 obj << /Filter /FlateDecode /Length 3866 >> stream x[KWrf~? $/#wI;,%I!U Ij1bUuwUWUݚ_K]t Y2o_~uBۅKCZr/ 7j*Qrjj]H)vu9WVN޽I+)֫K|1(S%lusʈoS+KB-_W[|}W$Y er5tY/6{vWLqA 9A}~)I#a'us&%S%Y$.RzmYi~mIpRl+G),9 2,(B)xy^*t`۟%xFki]2EnW jfa }R#\dF aPCI2H%vlϚH.X *ə0j%41]lvܓj<}zZDa"ʁ:cI 3K"%+ RI))  RTdKa?Y26b 4C0EPPzGLjH>+Krݭߧ`|g%tRP8{ q1é1^z=k(2SĆ ZrÆA9K5;Ł'1:>CÍHߨ1qU2 YB؊*A&aW՗ٜ P@Tq*&EU#?M nQļ",T~"`+AA-JTU{SY],ͱ#Qbtnaku_vn: -ޯ{N﨔,I{@Iz7@gI7RIgɝ3H8 !q}qawS,{ϝ<]BL<"7]#o<,cv走zE$a.=9 >GBF4R{t opun|^,{b^gS0irA63lo&ķ2\J?j:oHXs_;P[?BC,hu}U@Z7khvws[Gxv Nz))|VfšƂ|!LK͵A'y0FolT"o=|q~BPam‘r+9<'DЏxt\&OyD7E|Pw|0aI: 4,V>lT bj3>x$ +KPTa.:<(m#LL(kZz&1E3g剤SneFP&WDA&:m9EP~$S1nfLcclW%)B7nb5tvu):xB˲C\OåF՞IȽ6pV8j 5yh)^n;ro!Jkh6fh5j%pvXAHw CmD."/wܭt{= Si^4ւIepJX+9PibcbC%d(4DW_`b EU6R4ᾒ lmf! &X~y-@=Wgeth=*o?Zė3Osл̦N?oPKE CV!ƴrSwYIw= 98CP:5P>3mwRX\|ǞQikES V69 *8#] I]=2K|'x)CKCr)L8(%N;9P* I' +XޓTꐌA:X{  I~UKq=Kuw`l¼`Mn*̪H$0s:+u2Xund̸, N}=!rzyӯ>:[ZS |:RpZ1;!x} FY_=f cA,QeV>^jŅF2f {Bn e怹QK8\ |/i'l|N~#0ss0[!-AgR}9_4k~a!n¶reoՠGo= 8l0t> F1]5-!9BdVCUqZ殪b$SFal -KuA^:hWmN"±G@Jyc ñ?m`%N9I?Tl'xnQbl`@”o|aM5W?(<5DH F`e̊7m湧c@rM20G[uȱb5Wi"Wy? ΖFPW8cJNj(Xˈ`a{-ςLiD,NbLȶ!Qd9,bmPR{pE jTՁۓKjǙO.9c* &ūahgZ;VT.l:>`_g%G!ep8^[A2Stz?SD>Aʘ % v [3oS;qwBAź úe3%(QTFOOz @af] 4.u tzPDMxuv+(I&4W֣-$mӗ>NV8 uz I82 ە1c6I,kf죎%N qⲟ/G „s l8xx^:lĒA?Cɘ3Y}GgvL|2>Kwۙ,Vin>n7z0?tqYu8ˡhPMdԝ0#4 f&/_KO !7+<C1DnBnv SO Phgr>P@Rr '!JfDkhÊ?փVOS֮2)/yNbU0&F.].XR]jz 4>l+b?}"!HIfDA8ԉkq @tYRNJ>}TeN"2!G,'~FpqgCC>'~}ۇk{TvA.țK/endstream endobj 467 0 obj << /Filter /FlateDecode /Length 1673 >> stream xřO7)(H9n HQU9׮!n|<#4$U)Z77V .{ ?n^п҉}ꦿXAٯu[eeA~u1)`s 7lBpa"bGbůO&hb?xg l;B`O^s!eͦ<R;xz=Yu/cInd^ zuo;=Lb.G <>HύVG#8! d0/A{ $!2=Qj wشAydR&>m]CVji,83YMJhg%H,&.Hs Qky(&Pl2D(xM (yK $bWJ0p'M,qLOg Ih!6JA) CƇc(!!AJ PNFr EVj dMn2"FBăWQ|}Ud' in`,Ʃ)=;ЈcWti,YK]*\q/o|Ŭ endstream endobj 468 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 739 >> stream xm[HSqVti+Fy)_4XK^ФM<^cmٜݼLRQ%R $eQKHϝ#G%~q KȺye観2\)WN!#뙙7DxEHDV!T7[DUC33ukh+$Vbov{^h @khX;mX%[nQ@!^`q6-cQ|4Waha`dy=EYYanyKDo_MxlY^V0dץ[x#0WI"v,D~l~ұ}`}ԪCS3,x,tL.s7FޖJ!j2'GQ< pDV⪄%:,?qaDc47\Mthr6 _K4⢹yVG$MpkqSljԪmCm&a.sO\?^\CXd;[Xo.:H0Tl^Ꝇߢew4gGq&ҚᄝD,W柂)r1wGݞܮKendstream endobj 469 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 516 >> stream xcd`ab`ddM,p(I+34 JM/I,f!C[W kv7,lڶ|<<, }+}) ;Teg(IKJ'=Lļ/=_=r`F~BRjFbNB~BHjBhkP{h@NbH&)9E)%PSD$cc73##Kk.)dz ݌@;#ZĖ=MwH7ǟl?&x9iro_ -ST)U݊\R}>n߼ײNb+hnoğY>7wvwK6L+'2? Wa9ueXEyZ3w|;(8XoGؽ~Kȅ()c9v ;_*~Oau[%${I={&ó$ 9so< 8{endstream endobj 470 0 obj << /Filter /FlateDecode /Length 2165 >> stream xŚ]z3w^ԩ#q6Z^kyTJ$m 9Cjg88°s=gga7,?|+}sw^nシwq{߼@a-,3ϛ͇EU7V[n6R8ʸJJIr(ӎ;ǥg;s+qR'=nr>w?>&_?!Wp;] C?o̕g1P7Dś!q $J5B05hIjNCLn!7xn`ԨF:[j~&j&⿹qJ1x9NS+:0!qQ>ɩ^m}jőޫ5TX٩pf1{9!n\Z\Fa$ҙUb˨*T-YiZ⾡6?JQ0*:+Gk{HԈG#F}tT7:mUI*m{Xt^"SEK*"u\*b%KPŕTRT\-A+,X$[ؐޒt>>[7݂vjǚn aRhWd{x5zG7poW"$Ob<چ>Y`MSaQGZrw ;+ Ѻc7A(^EaE"0\Ehg}u֨ NcїUDd EבE<$,4/_FzT^č!eyQ'%u2hסy!XۋC*Ҽc97W z GG=h=}r$ ET*YLhy5W.B΋vԞSC"&{PcheyI,pՌ`\t}eKahA .A'v?Y%'g y}8>HB&pa_Ky%| A&by wu[G(`B+;iΣhRS4ɨ !3&G. u,CE&`>Ή/vEhUTs ,FÀB|, O%yY^Y%$oo}~I޴j7S KR d)TB2UX"*Z U,L-[L f9n|ojm*o2__7C:G }Od0X6ɩ|p9볢@>Ҽh +:T@+@J@IT%Њh $hEIK%4-4 #͋E9H'N! [Jz+DLU:{CǞ[O+3DL*VDŨ#Vx.*אg0*9 h*xRA8FKB*w&!! 5Z &8~?b R)_8JӖ޳(UhN e5 wR:gǼėi`DAX{,%$o QH5nR~)ZԔ%T'*Z U,L-*VHB!SEKJk!v*ibMTtG'JRǻE$UԊ)VD&QS+!uLLM*VD&QS+SQ'i JрITԊh^TԊh=~DEGO>W 쀶PԊh="&*VD#ޯBSJM*VDEhHE u48+up Iδ&ZPx Tc:ҺpI6P9sTCvx "9+ݫ 8I9J*}qp\7}e%qoL ̽)_(WE4mhHٶ|r).#tn}ÒcU['+W\<('i#2Mwcg^]yn#mkK#N-p5>NO 3 l 7> stream x]]o,}ׯVm~ysx``W>Ⱥ#ѕ**td˚bX:]=a0տIçWW*:?Ona=H4'5~wU!!0%ۧۿ8 >_LPs(F__~%l QEZ꧔oYAVZiV6/{?殚yrjP&)$l^~r!J'0;hWOR&pFlʒEo'2Pjv`-|5bd{ T.m` 0yF4QX YSRfWA'sncLMzR06J)X5m@Sg@ڄ)$д jvz<8-0 ȘC&='?#'熦A2  Z5Hbc+*wZ(E7*,,~Wc";E=iꨴ+nރj>PPC$ҴA=f~M#f7Hأܔz 0$Ij][|d1^ʼ0Lo@Bo 牗Z>' z}h 0k{?W@‡/@zp凄(18vpd4IƀMa='!KIY&vC9N^a9ZJ&&+F@zZ5H`kwnq +*YY5,6~Jƹg m$ "]m&3da),4mDL:!X lPZv0*HBniHؤn3^j֛tsSG<^&} # )oA`Ha#v9n8כ \Aѭ״ 6Ua+a;ޤl˳b< NN&F 9! V@?$9,j#f]`WkPv*YTV&@w%dz>?(UM98)X"TCp#4P5H#Xf<6Jk +ICߏ{L`\QGK')"p^i\*ل!ںЍT4Mt#VtRʫb/9 2xU%%4AKq ]nN{1@VcI MPB۠f+AVV ~ܳjBBT-HG uZ 7psQ Zr&y{QVH|ou񟙡8(a+``<?UTϏ??|h{.P|}!*T4BkC<~4{`ܑbZ뗇k<žo_rC<^Xb_°n+t`ƇϽ,3pw;OW=#"h?#ޣ0BZ}cvh`=tr4/C󃲨}u0x~QI*?E0OgE5y/AI[-ϝ'c:pX|p57ׅF~pyrbNЬe2ifL~fBV$D=)zpVY/B\_Z t,l@eXI+VP8-nX/6"Ez`:\ev@S46X+%1%$-:Y&DQ$)Fm"`@4P)dn Y= ž\%vP,6fٸ !i<vk!cW4x'2#Tg T   X3~,.瞗ʀ 0`wUlz4|%y!vaI eᮁWzX 1` I.SլNW[1`l!J#pą}O1`;@$br  a )nQ`6r`;@Ɂ4np`;@¦l4s`1fjъKɢV.+5]VTUz7]h,Aw}%dz^cOd_hf̤Rn!`Zh2]YR.Ql!J^x2ʃmB@KűN*~.:]py*k] 2&>BW/9^RMʲmdEV|k8+Ih2EKJ|E8[A4Xcö19<>]6!_DXߒ04+\\DeӅubm|faa=V}jl&\h%N56- XgR1GN5oyFWJW[M[k-h4'p*߷@XSK-tl>'qMm:xE+)Xۦ9M'X5կXP,vQHp@qOk;jy:5@fgVJYMe^Qf8kh喋]%XNɐhy`Di!ӫOQsZze Wf-2}->Ή2R"ӫ$qSb3ogJӫQ*l ZzҖMV]5,!ӫOk՗1“4&⹑O^qz5s#ִ 1/H N&|n4 8t5VgZb%0[!ѼOm)[T} )P} !FM9ɢVNv]-UQ3N%J]:5q:_/9(SwJ2Jdrȇj9%Y5ԲH&I4-fI4P˜K2:aHm9Ԅ*nZ,GDV߬,*tj^r<PyHjpR*3ok7C7DMn,RI٪Px7fX@RSOZXn8PӡijoRmASRIJ5ܸLCO|}HZa(=k\K^>MN; Z> 6}Q;fFIƷA2\99Nϐgr;ts&" 4i9/NF&}}Щːf%L\Y)P,e$=ZFFGʕ^bIXA N&#*Y,zq!J`?W  ΐ^%v8_NR#9D>CZHi(M&E͌(M9$b&8 H^ u*k}eq*$"M" !4R"bIh*UZ̢̈2YC+sZuT*iTȬf!JҰ̔^%v/WȬm gJYe2IDTDfJKTT*rⶈ̢383Zz2;T(^K3E9tom;?53=Z$EӍ;CwfBC Ȝ5Jkyѫ簊ѨbIZ}nuqnUeSI_ύ~.΍zW97zᯙY)JnmfFgP2JpQfBC Ȭubk3W7eG&eGK-93_OHhpa#+x}Nڃ$Tx;d23H5WRH άJfhY>f=*K OP=$z('J ))e| {W \ /ƜR2V4H.05\=3ݱAvNuaʙ6ɫorm7-0܌U>UI__^;ǮHjZ M{]O1ƍw'ǏB~zGmcc=[|QI/軌+'#Z̡#R__.u 9ڸk:Q׺%Q4ztVtnOX|guk e'endstream endobj 472 0 obj << /Filter /FlateDecode /Length 3598 >> stream xZI/77SacT)3 eazH65RdN?<=G:0/g~ƚ36gu|u <~5Sy#նR77˹pB7󅔲?cqg\a.03Vû qR}='v};ԏn6^a@/i=7\RriO_Zi׿Ͼ sPP\BJa y܊wYmJgJ1tZ%gi/ a:,oϚoBnMpXJq7#KnoE$p{ w+|DX3QKxB(bIuZxyNk Oc z1hYxi&r ,-Le&L䱼]gNn?Da Hau>YBA\SKxR(bWҥJJ饴c0ФRSfjH#zRD5 @Wr9PD{i(mgaDit<1_5RƾY,NaZؿ -T{̟k;6 Q֠49=97ƲSGˆq/UOQApoCpT߾*]BUB ( Mb&6"4t'8:% BjDiJ)Paza9x @$Q9i0!rDiTwaJ86\tD-xi mD'TxR(e4O+[5 ڍ P,t$MYMit5SBR@# kXݠBDCv_bi7$w,H&JQ wBcXyZ: Q~3HI O!Oy! `sB#H\l3yH"3)B`1= P6X*πyxzٰR5 @$NfF(ƒG" -l#!C?Ȇwo3훛L%?#BFaڂB|kЌS loD:`D8-;:w+w>Qع`&5 z҉Bm(O_Wp'm>љT,G"^%t؟CJPqԑTp&f'=Ky&~y7_pJަ+tg$lH'a?:E ށcO:dgu) Q`7NsH x=ZsR20~y gYa (AA78ȣXP DZWAw<~D qϲKr܂J\!| ˨td& P\ŠBr᠔Srɗ//4+X+!@WY5U:Z[᜴ai8  hIcPk"H'V7pߠv}$@C 6q4]AE~{[܊B/ }k}UV6Qݮԇ<}Qr}yX}Du*P'Kuw==͠Ado`B7DxGtwB5@+s!H`_m=b,x>,ǑLѤL\H-a׹zyH\Bqu> stream xYے}W-To;-m*@Ԋk}Nc3$*BFр~eR(&I8nLlYٟ@H2)x;UR + .d[g??/;Tuwc+fH!]TGNC'Iʐh,_&(v?ٰlw8:LᒅD4 }8-ʭWKzM?}OA 0?lBjc࿯gx|E,Hrl_In6e%=JFA$|Ď)'iya05xl0YcX,ѱDaB5G?&bEA+ C&ED|j֣43jUpK@G}Jx^ AD]a:%y[9"Ff#U1*%/$=XM*Dr Zp(yG,X #+BWðzr٤\&ǤPL(bbah V "r >"_YD:DVX~` "rGP>stTdP%۔u!0E̱ ȁX(T&D#A "}BΩ`T&`Ьa'vqRQSPJ S&T|*2mB:'9Lg@`yL:a(1#Iu)ӠzI A8ӠFIA3A\~FiBdhBl#100"Gv9mHX  *XģAQ-/DA`a"@[@8QuP)Q G^EOb`F c,NMZ[| xDjȮDOVu>\JΔUlB CV{ԣ6(595rOS AAgUxIG_B|2 ]ª^s8=˫٩tAt458-/5.X=[|QM8S϶Xá×VfD{Cv2-GzDk_u7 璴ojtڈ. Vg['aMR?e>;ofls^nT{}A'v,wEs=ƙw49e>t1+'ܯ hpCkb{z²+ݍ0%9'pz6HhX ZqkU?-OkzxSG2izX;oslNbrfО]͌"^K&P/wzE3?#lY˗7O3hajɚIv? ;tw>>@o2CaNI&ƻUģGt=u-3w8,T]탞4TQ3iE*9<7vE=!:rO│D 3NX yvn@yhD *uj4}nTe>#sF>u̞UUfRy[5nB j^RU/gE*KEy-K 5gQn-?޿:m>Η{M\e~k/r{7H]$O~<j$?DTpD%}.6\j2_AE}RMXendstream endobj 474 0 obj << /Filter /FlateDecode /Length 1392 >> stream xXn7}_ fַIB 4j+J$%E{,&Y3g93Zj]}MfWiqSLTWkxDE%S#HbDpA%|].f6Z7rvvD&i#_5ZGD˚$_2\[Y}Ml7ۻ1_'X9r)~]I6yHQx.am]?]UDZ988X[p"%l Vp"E?He1)j !Ep,UL\Vt+rkmD7${mCr1p8?Hd"= 4'*&@:1l‡g |#>CP泈e\˻}]r wUИ~QJ,73cu[&Q(~/]\- \BfX<) - c"MWrKrF[Mڎ}絛:P RKl4zdeR:PybžuE{XGWP@Sr *REə*#R5húxVD ;`>.{Bm9l lѡ'0}u- ><&9OZ1 `pW}!y-yЈ5jeQʳ;`: [PD&K ' Qd? K,N/848Y!ohLrHPFjdtwʀ pRa5d$"fZDzIOvO!gDs41u1t[5M>DB'ߵ고S.}7,LASx Jb}8(9n|d$t" GN#1A.d~kNGu3%iofl #|-(ۏ&|GKl  " |9ym"RGѶx]WID?r$G~2G )_qؼm1r9j_֗w-n$> (. 87I@uHmrŊVɒܭ6c;ԕUc1ZͿ|%}XLUyU)mEu xϴ>("#8Ⱥ.`"e5QsWawy32w/mETu38 ֙H~YwK⣥ݤEP{U)êk뫡= =b_jw:  'qqtSf?ϱ_DHendstream endobj 475 0 obj << /Filter /FlateDecode /Length 5443 >> stream xo$GrHjR=y#23"+0_32"2٨Yo?ټy}Q7Mi12gef&8g7wO7Nۚ4+mn9O:4}x&+= y}@4 ɺdu~"kVy?SK?_ϽT?R;]2}}<=.Cfw7ۻn#zzBrRܘϟ7yq~O0⿿цYMH9lUsͫtQTS$ 5p*1͢*p(g0"EPک8N5EPYYN5EPV9%N5ER!*rp)VAgǔ1WhB sXT©`g)W!%0:9X0OWUiSp*z51F93GˠpJ0)R8e\).FE /kQp{;)R8EMM4D7EPނoj6/"q9p*! )Ҵ`Vܘ2#sz9 ÌPp*G(ReΉN;+Ơ+g)r6d)>SZ(R8"4zRFè6AMZiUy5V|Y,v)seuSqQؔջAK{] t(XAeFDpʪgc,)2STSe\ʫ0)2Gȕu& $e"eTV0$7Y(R8J$E 2El!QVCGNV)Ged v<9E N+1Q8q %N5EPZ""lUAc i8fEQUKDgb`bp J) e t)2L?]M N9 $îp*h[rH om@Ne Q)w7QMջ=q?x.Cj2vŲJI) D~\>vN~tS7ւ3 ͩ|g^׳N5EPmH xFbԸdTSpQQLMUF}A>d)hbj 4j=O)I8h"씣ѦǽzeݑZGPp "+ʨjga(QM 6eTcC@}ꩠƥ)Rٕ|a,HaQ>i)mqJ9E Q lE NZPM F)p |j)!'EP]"TS$nAUeԮ~k9Sid-HTtPeN(L5vSˆ+*ox]iU#)Ny|9E 8;Y#)#`TŦ֭9"(\UEQNlGB"QV1x]by ,b)&ь"Eui%=*_SpRFe0>vMi0"©m"Q}t+*+lE \J=-hLT6Z1M33)+~IRF?HMBѠr7G'c&QQY}qab "(8ǩH V@ELF(p %\(R$;:eUARTSP$q*jR j6EPx lL"e$edj#BAFPUfr$CO*ǥOUFme#:8"gaInE@ogc /u)(2R<"EPF-)xQVS$T UAo C"gn-ETe42N ʻ.7©e©\?(RL<ԑ0DaNǙ) 2*/ ~lmMTՔQ}v9ԄQIA~ .򵺔n"MaTSFeCXk|# t=3ΨvaU"4ætYϩʗm&"*CrRUSQ Aknpj9NX7U E <zZ3u-&b~HL0);vXN&iRe@Y)q]'\"9 kʨFg>u7G79yʹ\6mr[|D{.:ැvKzsVBnk0АhzCn}N@0 ~œq;6Z(ր3~q8>?lo!q~#G8zz5Jxfw_7EN`>D{ r܋䠳>noCX]sPx&~&ni(70tW}5!b}+׍5JلP[ : WN7S^QNUʧ^ÍSy7ax9O??dt3]}.~g޽F^;] u|v/c?uz ;=v]kBӻ;/^Z~?i>LeBc]60Gj߳G`B0q:UYiM~Յ3ƀ1:TPt0*$frzh, U#?2&)r&?n_qmyn/?o2xQrxk;ٻ>Ggmop1:iR"i?UÚ{ }V T#w܊.y ;_O=صk)Z&TWGi_䒠qpzFÞCH}}& U紇́ u<⪆ӛU WXa¤ߒՀS'yUjkWq3N_a=F??  Ӑ׷?݁@dr,WwDiW)XB&O%`6=a8 ɖ qܿER/^NzDٲe\;ꑽmԣN?tNE[ b 0x?ʖ~5Qv m1ymb^B=F@;buS#j;!ǩr:`3`@_`y[da8Hw4{nBA]_v reYKhw&Bj+/( :۪g̹b0 OWWpMwӃ`d40::R'&oq /%ƫpnõ޹%nU/,䮗 -6k[p8\X{pY,xz٨FjFZbX#+_0S+ ѓ>z^sC\%-Wd*%,J)+{>^WOA9%#xҘ_8gl/mh``8l/x$(=}`YH$7FX[,,]WP.>~'cP^#ʸN1Cj3w̔zUZeA Nz |~Ŏߜ^>ZC<\Nk&׿eSǀ/nVܷә EnۏfzT 4Z_%[o_ur'UX ~%I$Ln[~ۉ,0 W;Φ8$a_)gc%[~.#U~aavynkl&q҇^%{-̣]^VW>m*Pe>to] 42PR*5gLsiKr)0}}^I_96$Τ95clm(cllaV.cFzVg3/qԗ\C{<s* |S9ʥaH/PMYِ6lf6ߕ*PV\6=kܧ՗𮎡3iu8Q5>Q 5h)w{tZ/ PqhWQw+ņUm̖_~a=yxj-XHֶVeV䗔3㚴pjA.Z~;yOU?SC nk\ F79xAS1>0aj'K/<.bYK nW䇉b2Kn+J dX0quP`}ϲGɸg>u" ^)4rt^P{p9/ *ï0aۭUuص#ė:a-ܕkK}-mCZ6||Zendstream endobj 476 0 obj << /Filter /FlateDecode /Length 4042 >> stream x[m#>!A߮ud A^v{D>if-iw>On֌ gdUVC/V/;UX=n7ҟ?nw0&+/Vθ>(=t¯oع lC€oۿ~0ʉ!tR {S> n /ݻ>!0rǵ 랏OUDoJKz%Vjv{|X醶"lj){VFp%6x|kAG({?_3 QĬP_Ú6 nr`/cAmL ͋.fA-c#tFIp GavgOZ@ zI)(\pmpNS;sdMo 2tc5pk㢓zw1kXK(|'rI P38 ? A+P@Gx@D#A4ni#8҃͞O4 Py?~AS`BLM-p3%&g7YvYl㤃6A,=Uu,&-f 8;v ,F2fM DС zJ5;{FբӀK7( ]#z |h.'j*^a|2`7? ȗq+Q~&x^AFzwNVYفd2h~38 gQ4T/U+%qMtiDn}y~NxxEϺ ˺5$ skwȀOer OX%oxW`t#n; x|LxsIBAjw;ovw#[$򃑩{_L=oseD-!͝WꞟxVBv]z7ݶT)}_~= ݹViVR;C|B |&;BK RuO tmk0wn{3Y]4&SymSͶEXQ;Ҽ wMLJxQ{ bnu~pv`+_ F1(Gפ-^Dt=G=|DIny߾+p6N@^`e XvOC6{*Etia!2߷ ]0kRyu:]PC:'=?Y|1u>РU祽5],yT)/P-߾IVXȵ!DOHyHIASKݵqxԼ¢::́Fa5 |Z?_y#|8VϦw@7*;/zV6t8JԨU w[mAFXLzNx\g+R5Ż~^@5PrL=55i|RQ:""Hٷ T!KE%>XRCqPM"s2Ɇݓ ֗zy"Bj)R#E>boY&rWbSB#p|ȦX%zemF6OK'7:Y6WkS,U2?gUo|'6.W(zYHe:n,h~)͌z K :Gxi\"\o|gm8/mPsZv1M<:!׍K?+ $gӒWc-h[zҖqވc}8.J 䩗4 tΣSg-):8 oɦ˻3ݞNIdڵf9 MJU[*̜Ƚ]#@ԂK]Nk~E r0䠔 RrđnuDPG~a]p秢 8e~J6M&QY- IQ̈:42AEdm$d{:l&FlP҇jb8ŇQL0jѹTsY]cpepxܖR0ѪirSk#UzIԹ.YHjn`}wXvb7+b^2zs\5aNYqWM@"&C4?|;*S:CV'P*p>מN5}7:p=e\ͣE5+b~*<YnK:y:" }[V)O#̺^5\h[Eq/Ksϼ1(ij,H N9' Mc]fswͪ JL(8MU.kʟgl6rr295%#}*Tg>w8ߝ*' l4AڦCX}9yFۧSK7*]k Vn,@$9GZ*9:E8O1(lLQ,Mb (RâXS >"W$/_ Lf=ޭ3'`լ0҅FqHr55q?Ms_m-TnCʁ XB@u"~m~UO>Ng*Kßeΰh&xOݾhƆ;rJ`em}0n˽<_G|Uݯ|㾪5#SzPԭ;"QyRq(Yv,>ŪCPcI2@%Χ>K֞S9? xfO+iմ}25|Osd3)DϨׁYYe3uQק;WJlnR1M}!*f *;:'r"Ὂ0ӣ/FS͈D_i2~Z['JE.fyF~w_vq-M3KFN^ZSŷ~7X~)4)endstream endobj 477 0 obj << /Filter /FlateDecode /Length 3128 >> stream xZMz-0@RHY^֘;! #t\A>LG=ZpKv^A$$D/"aFd a9*R{# A1G_BǕĨ`2L,T r{G_BQ>N&.XDc6X0ZkQcU꡴HlTbs]F 4ZP{Z5JFF_Q"F(wblZcFТ}FS:x+>ܸ\A!^&6хFBuዀ9PoJ+JzK4B;.|8Fp QpOJQIGk3UyШ\ɒx`nDc,qWƁU" ̗ TDYN;,ТZΰp`H#ӛ/EI~\Bx?X~7iF*؄;˻7pt@iQm׽Ď%7j{Tʀ`W#_Mx]>Q@ZriGOQ+Ǭ+$߭'Y m柳?b_ a16NS/=Փq_*]>@UP {yNOb%yU$l@Ҭ<>ȀV#Kh+C\+m(o^ r"L^.̉īj @@Z>dPS'=*{:sKLtd֥3E)>SXm69ͥW/SS7 I6!}׃<䮼xWlTH0"\r˺b}EòM9 Ei&[YT19H7s]![۳r}5~\-1#]BcR%Ы"V7H`]aJZue]FƧeU+˥][E)V–VuO"SƎ}pKгu=:T|KaT@ 'u\HCB{e+=/r%9zW2lg rҚ@=Ur/lZvu y%˴> T0n%=]*R䀡۹'..d@r48Tf:jq!5š`vGEۊU}nσ׷Ȯb:_֨LدIit`|z9 &J,\z:]*_ ;}nC*[U;}띈DL.I'1c$)"u('j˥yĹS~Fv109*a/431Z)l.N4DN('s%"\4) 6Gf @#K>`' J!XS}J=~C6TF$s*v3k . ,1xC= i_*_3dS{ZU&3Ԟ-mܳ^JshϏ5B~.3g@.td2ZOKUu)t^5}06llxΦ+"[4Or>z\^`iERp6[4ǒKR@'FbNNi!d_UmoΪɝ$F+cPt dtܢUq'):)]5'M34DbA++~\N/IrIglj&k`U]Q듙DJЁ = /iryZ.T[_כּ0RM>(;9#Op2SPWw57Df˻_AкaW;VE:r/h<\DrZ'9 '&p:FL[C> stream xuV PSWr"VWZU⨻Uy(!/!DȋG䑈$b%m-Zۺݎn3ms{#*Lg6w&3$#"7u֭B+ $d-aEG.o3y5 <=˃HzڟBO=SHopH.;["Zp e,hMhsfvDV\',<(ڜ5AD-^rr3EhGNhgTƔm;.7LHZRZY%gP]{g ۉd"I"vk7bHl"6[ *bGL ^'!PDGD͊&_ !zft/rM:i>3SKF#!4[`+ҫ5jO١RtFGi.qrV!UPEiͲ&6ܡf ^_e @/>K;v{.{^cN^2j_w^n#EqH7Ws*<x$ ([Vu>ؚr \KCF/ܮͨO}W;(JF5dT:Z^ƶdliqbJ!R]84ty+5Nvzr.?yHlpE/ԶF/9ø\e4n;[:y $է@͗1v'񾦠mzJf#"S`O8L][F)Uܪ8=u$^klC+Zl_FfP2 F5mRmr%G3N0Iتt h1Og ig3>F߄a. ;IDGȔʁRպck`vljI>WJ9@vwΡI=6pPž,,( 3;fR\Y+uLNb'/ݧ&YgI? @_+4ڨn4L]֏ r @gMZ t<ܡ8[Gw}i/ƱG`NZ,t}.7PΆꊪr&E}3|ts-t38!c4G\*JVn2  FQUK7s4b"Wthڳރ!h?ksFD4r _;:Wj*(o8v0l&-t=άTWixKvdJt?1fk;͌EZ1Z*9mN 0Sm6ib@H׹F꺀BOPT?;s$>7J8P;>Y'Vo VaXd %_rf#\#6)?GoQԵ3]9DAUqt n4,tʼ*"I4U/O*v zUs;)h.oUi<_#8E,C+'Gh ô8<'-{B?yàmٙZu35G[7*^q4k |V *ją2Q]%T[j.`A޼#alK[_e82N.;R" +Ur=]0P./\`$<*T &]XE%_A{1,xsȝX7ԣ^zGV658O{,X-'#hTzZW&[{mc X`v2dL~zhߑ ЂNzх2"W>FxKg ].̧߬=8-D_DC#47RC~LmmCU=1}aCfq]"ousHxo-RPCu!^k:w7Dr.Zwojp+4n~4KNj'%.@˯Mx744Ajr!7 A{ ɗcw|I$`Ro(uZ8^RW^X^YS=+cBAWY#lFn#(QVaWr/ht={!r k;4<[×:lA1gB~\vGE/cQʦjrG?pE+31$KKoM#f&xltSO;SpZ<8>˥+(>L9&YJ@bF'1Q;$ vrĕ&%6}bnM'sendstream endobj 479 0 obj << /Filter /FlateDecode /Length 3150 >> stream x\K۸7#Ue#ē`nlv8l"92P[&k$f\RcJ(<ʐ'*0R8T$b8hJA Ŵݨӱ#XKT<'?:8*9qU7.]9ku[\a6yB"qYt!<;ۧeq]"a de>!O<lubuZ*&g2sgspRA)#;`xzDĚ#Kϣ."1i/Fn}74A Y7O{Լ@ u1CrD:Š0.2yV(VTµx `snDׂYrD9i4 _ﺨ(Sһn`ڝP^-uͮQҫhv?;70-QOԩq h:Lyp˘<{ؽ-MØ"s0p%`eu!W! Ĩj(M2<]U<=wl y[ݢ H8Xo]U3S:Fe^ 񈉆ҩѪiDb&L:S\uaxxD0,9n%KWlVF+GkK F㾐Z#VU=]1!_rO`/±0UCvoCks zF>^H>'"6!WUYDT &ta7% -Drxƌ"Lɮf{NخE F Ђ1/dD߂2 CX߂¤cvO`aSvY uR\~J^T *6m|,_`d8y.S+5"0enB-nun-v ZJ X P9Va|B9s@qwrF@F%bاuOb?PSv[f 2^V_u%ø,zڬH7+?GXωrDb9H^ b" !zY5C0vUa;` x~_zsc$7%qCIV?HN-p{|駑8SD0in! 3i:oP¡Ř zʵx DkA Bٮ03!{lqǎ3Aq$|8WIrSOe'#K;hȂT)9\9X z˵r[qHUZr0 ݪG߭^+4|͇lME'EY gE[oj>`M(Ǜ:tۭݮH|'z|,huT 鏋}cendstream endobj 480 0 obj << /Filter /FlateDecode /Length 2957 >> stream xZmo~pȗ:v_ IӴj u:ɴD3K.ĖayۙyYÜlN_Zu;هoj;VO G\V6QpBO7rmAW䮺\,ӌ}X҂*ˬaadRK%VH QGmn-o&TEыPN¶ !?M*'\sP?8y7;>¸i@\j+ &\K]01lofL27 0lFՅѻ͜qOQɥ{S۲nλvOu/ZX8B@;C Z?'9FRGhQ}X2(F%vdŸf2\aجП~`B<ស=S ShY(3~+ž/&,N竃sla큕/ 26˂FRJV9 b&GY@ٔA08+p({n&em{d]fH7h}ս';QTW@0jx҆r1@Y=ȵ|#b*8ȷrΫni$6 ?N'R(z7j&('@ ՞ 4-(`2#u"4ߠsJwjׄ\tOP t5h Y${ 2r惍6M&WY oOsoxQOq'ߡ'i2H( `YQx*gĺ^Z03 hat;媺> qGrN otpth6m1L\98BA:n`|,I',4׽(GD!ybD)Nʩ*fp|͂jSBV't?I ^,:潂3 D9xf7]%i]uaa1э#PlhýDK`H.W 4ҁ*jK:KXMdN"AuTZ*dJ䟾"&PT6mݻ}Ha4R>LŰ< bɂ\+@ɢt2.u NM+֒ƥ"E&P&!$QP<E (Ϗx@=n3^`nakjz":T)yC~h- aO,J*-1&p1} ͏<`$ `lǽnpm3kF<,9!'0R`~|K 4d7)5o_vLVԘԂ!DA?GJ4UkLɟ#&lޱpt gהm9^0jQa7o Ba4r,~̍|fm`Ȁ }= XaQ\3s c59wCYɘ%^u_ FabgCC!$&4:2=U6{U ˀz(j`#;5|D̛>b@b!4$Qeh2mݖ1 0|j=j9Ru3TJavZP2g1GAgɬM)0p8?@UmmX?h|/ǐhǨ">:?@ ygT;*lI|L=(\мjw9?Rg]_ZS즴~1Ʒ?A;V0hI#u0ڰ?/yuiۨnjI#Ϻ1:` Ə)S@L6~7^ ED¼Ggf_T]7!9o^-!a[܋flv!db@5f3&9^lzLܜLU/*d` :[7]sKUI)y^(&H*m$((Xl/D=g&مJ ^ƩO R!^R0f&FKAD c#0`py*$bsC84'V` iL"' A㧼DA>?Pž:>! Dקɋ? ؔ ^AYD 9%EƑr}[l:~XH^; `)GI-B4kWpJ-90;0ѣ-SID֯ǻlJNeomBaTcPU25-v"Nb IyѭK7icm#]c $"{~mNo$}vo8t M*mػX_Byfeu`0{vnrB%7 9Ok4?}O|e@^8gٜޠjwG3 5,%C'n LSA*O(:8OtTTpb(Ъ !  Ñ%a%XRB{thhEN\U^y+'b$Rƚ+W-dr_bz9co~3g~ތ? LƉ ō Ι{20qD<>]endstream endobj 481 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 2504 >> stream xV{PSg˅۠R[A,-Ђ`+/E#/Ey(h/" DZݭV@EŶ[5Wv"mg|MĶ $~99QbJ$!̔LUOg/6^@U;8[Aga` 4MɔX$zs 襱>!3S֮vknn߸&eMws'rR36%g/NIWf-Hp[4i2uMO-;(qSfXV2gM^|~BbRu)R<}Vͦj !<(*bTGR0*O}@-RŔ=5 D Qb}mMm) &/P% It]#{K)2Y,FqkpIl74uOe{,)-(ЪXF6& J]XH4ԦմU6o.sǸ{s4.ɐZ΋Pkݜ`-D$B<5tm?O]^ 8ӿ&:|tw1a  p&?(+߯ \XpWbј2Yfp;gҪۅlqhA|Y)3SxRRd$%d|GH!Iנ'-ƒ66o%EfR&Rt[rY>$"o.ެ* GZ}C&OnܣԤrMsߥͷm0@Anp;]얃K"єh Kڂ*G] z9M3GWJǹ8;&Yٌ3Kֵ3CJ#za_Tf!x\.0E 2{ /[r?ƮoO.PQlתt\3}c`jG YWttaqIIQ?eUS{pRe-;_|Ѿz%C-\[~077Ga\MNТ/?9ӫեYfr[Z +aABH A1B&II2|ӷ]2y鼘]2~]5b>[aIHݥ8kP@ow &+L wb'&>L`-:QĜ^7HeI&4b{Qh`hw҂yQ⊲Rn ]U5Ѥ#mJ[.F2kV}9293.Q+3$x-`_)i@]H0Q=G4sp>IZN41'% cZfx`g, W}=ԪEڤn.R?Z/G~+IkfնjJ'1]Bw8NF"& TOv_ttat'΅,)tck5L7=+I%GO5O@4 !u^^YU^HH QFpp~U6[ |7 5J$x$Ba#_~ұnn;G RMq .6}GQoYl׬,6vcd( `ؑu9p"%.]XMcZ`=AR}l&ssda:0;LY+mWX Pj]c UINAv˰yWeNXOD|n AuE0K߲HZiaYQxQе.>  I%Ln A o$YQGn!c$R#VOFIU[N&U$xfp2-ў`rul鈹'! na#q- Gz9чnX⫷-J7ѝRX[j3E[V"AujCf%p酩IVj!UTU5U,;N53#;l-VUōƺ`{#7sdP7lLVy(޾r[%W霧+j׶5*ڄi;; tM5|:`/ l2BM"r83aɴY5ܶ}k-O\YMmvn'ݼE[X_׃S&mo88w@QJQendstream endobj 482 0 obj << /Filter /FlateDecode /Length 1585 >> stream xXM6W(rf[S$)]'tn Q--$O̐ѤL=oIRTF}>WAa=,:Dj:J* .$NmUMl?']m27+7}sX6)XUOSJ&Zm ;O5!Mr[K#E!xmXA)GiJW3i+Q{}W9-.o|fV1 GuXR2:ϔ80b9h1u| J 9mv6k)@N=\yIc M1ZrM҈B +2{,ۤ &Y!:zQV`\~I,GNzKfBjH dG1bY/`Ed"$صY.idkGHh#j7EPBzR#P#2Kx;Yd ؜sY4U22U0# \~X$wO\ ^dI$"9s$,7Yr:-g6YQҡ+j ^ȤWɄ 6B۩NVK:)t*,BbBnP+YQSNVK::`Q2Ňi>Y/Db N'H4rڴ n*t^ȤWȐ 7^!F2V[4StR0U2A-"X6 =D%+%!7!I  ԿA¶~q:6YR{l6 *ݞ/-O^}1dk47)L踘0n 1tR)_ j|u >kF~}{1mD qUǯEiGL51<\ӗ/f='ie=D矻bD$??Oc4KxvwmuñߥP|[/OvO;]z_Ut6endstream endobj 483 0 obj << /Filter /FlateDecode /Length 1195 >> stream xWn7t%X^]:1RxH@Yգ3 PF0lY!^~eR\l_>+Y~,6jQFbYJLI%[/lZ!IYmu_O":z" VX%bxs@ː _4Ewړ|iC պܱZK`&ovm,7o9 lL+N=U׳cxi)e͟Ŷ N1K:L32,CeB}s_tZ)a@pǀA28LD ;`M;t0A ht"BR&"> @89Ld}!v $q| qPO'K Pq^P0΃p&X2]u * A)2ގ0z:I8+vk(΃2%@v%8(ǓRP0]J?$AHB^2@edV:l ;&(fZ逴(2"8_]VÜc/f@4:ir֧k%WF1( 9bTLg6}X<4jhƐԧHaTpn@C/(Q;BNH% 0%hp @H"Nm::\piBO1<ICuJ @:Aqʖ<G$T<d3O%O9R'K.kD'˝^Q,]j[SIj&I&) (7>8IaxWZQ9SJ7P>8z2Kcr ;ڨFl i[ urQc m>7[[r3l||& /WjҦE;i[u z}n,ۃTBmnkC4.dZ4?k[V+h9j7\}"endstream endobj 484 0 obj << /Filter /FlateDecode /Length 2234 >> stream xYsHw\h-[@ lP[2%dk[3\%9ːTR~ᏫCwU>^Qv?B–vU2t.,P+[hnuCv߯ˢ\Ғz9M&0ܯP ;6o%߮(ʒ*VCzyLQRI~Lmqea3: Iuh WwKvRi4wT!H70(!u7 jC0u.i]+wKQtbJ1M]5Z mtWK^e$f7rUNnBz[VJR^HakV ~='Ox}ݤ2TGHi1@wWYo,V2 Yff8jn5\r@&H]޹Qel +h8"U8dk0%U>P"L씒24 !6"xq8 QZS$(l- 4FnU?Igc I n<- ~b`h*yq tw<,2Va`:IuB)Dtr\a -y|((wg$#"/t<}9}Js"tuk-$$/V|}XG;-2T}^$,0iS_"G 0Aca"rZg7`ml%d~,o $By>Om *h=+/z(]_?GN&ft=B u;m }X|y]e7%Ws@ VjyM"-n7R] oz7 %#O3AQPyc5$4 y}}V;w%(Iteu06tOd VsbW{#39j1Ңh Tƾ,OeT\d잇0dy^$4 q‘8@ 5_ȖN0COvMLe*h1m0!$ /Jml|ݻ7܀)1䷑'oK߀7#1fþw2>iQɣN6=R.HHLyF}y_H+QB$˯>ྂknځv[r v\_gm=_s8l?K4yFD*=.?p 0]k ] Pf~NvQXJny4c?bPu}S֤ƞ*3l4+xHMF}l2mo$a~e;3@e?:;+S*Ek$6dOm,!󐌝\[ҹ0y#qp59uz!ҙZ8X#{,B,XTІKSr s_;XwЈ.Uگf^S#vS!&K x4Ր0,19Bp;I!\> stream xZYo~9 0$;4" $BۀmZ4+њe oOUu7Hk{dC:VyW9G~-?WG?qrWÈ7 _=SJ"SY̌ԫkIUs]sH)3Spvɳ\W**0EvBW bgKr.8V<7ٻū+Zŏf%Q0B_:\joprU'2mG0k(W(pkF La/yv"b22hY~^]lqie9kv\ٜRBf1lslIn4v ,U%IF*(X=>hh؝]dvЧ= 8 {׊ v >ջߑCy^LAm8 \(Jo !;:bٓ Q0lymO}ި32 Ogp!<*cUyz(JE\$ (>D9wXˆucHs?90O$ȵ`4PӮ~k!m>R=1W*4ʨjsn /۵VAkYzuvUȤk :#XOSfƻQ$:B55F4;Ê{BA'b_7bKR9,@#r-Z ;J(r͝2魷[30> 6Xუ B[hj}*}{E/>2a/P֣t19QR ყP>Mm%v[%\9^9#3E'D b>]T "uc|%#H@.m+~O> J$)jD#K \tmvhsmğsh|\>sԽyuw\Ӛ0k};y-"4=|,?Y s8sӿ8R;/O%7CqClq|A&$X ; }n"2,fh${C۷p&\e".S|t)W WyCbID/,t++3J3pXH0y p A`` Dz$:[UxA6dDܯ)! D}SѢ6b)!Dm o I$D]"ޮb(B^'$ >s_e,,q!z%M ՀU O|cZ؁4𖘸ySZ{db>TE.sus8]I YK&]SB2%I,%rHY82ROC `'Rp<c$-A:q]c $%`qK0{0#Z)@(9#\P:C"bgEBB\M)yg)6\J_O%#>(1 A2pb8o1 JYdeͮvCsVa {vr&/ mNMش Z@V!m/tYD6qpάJiW@nd@B8^nހV.Y'V](ypWr6ON8Kkt#cH_Xs5i"}o٫ 5[D6m~@T1KG9hQEN"q v *_5;u'*+FF*\.$*$pPv*l ٲWTsk< ͚Dzxkb*hZ%Rd .v/jX%3c.T*3 FT`=)#ېҫp*hbkYIl@1.[uFe2"mDHv; js6c@EEiWSc;QjHAvXhZ +QUHNrnPu);؞ lvkL 7)ȳ!q%ҭ¬|z S| vOu %kL(![q&iru$/-سK,Muoh„)Ρ iM*""!؄)=Q3GPům7 JvW'(+1;UqЊ!2_ ݻFP1I!|~=8(-O cԵ*EVr{# 8H"^7%։"1ؐ!r5id$~i)E0̓~XS~u| a&HI6torZ0zD~DI bW˹6FvO"H6(~5dUQ.;de+. d p?2G0*-\~g4jOB &:6=LO 7WTV6/} 22`SPPJZb)’f| T6•*k~U,Yُ5rt0 < ŖM![]红-{)`!$2FXR]xk3R'mChgt,R\ӻ"Upja,BlaVvuSH#PƢf@\ eY g}\I; JrGT~MļG{(ܻ|'Ӭ-ZhǛqL4[=*!EdwHkd g-\GP&SZIOoa`J'Z8o㛩ڑ==5-¼kV9+(uT1*yZROMԯI%2Zd\L:AŔwu/d)=glӉ 5#1y1 aC/Z#=џm?R>LKPEYo N) đ<"IE{!~VJ!R=A(c͔l=a4ZMWf~ hv@Bz3+iÔR;~9GNmci`Un M. )+yO(Hf-&ZVgNU}O;9'7f<\<FV*wDbdKpL+ >bZe8'P8k}VGEs&Zj҄> stream xYM#>&|pF|،9hC-ؒ֎lv{B*V|B5uֱYfY~~wߗ@eTi&[/r7k/EFcq.+BkGjszфTpm_}?FH\_.)o_?~B D\c ,uC$4s<5^8tHD+0)-?UJ+ƪ?;x=ʹm~'柷t@ptd1&)ۿKЦd1tl:Ի@5KAdЪbЄ_t:!]Tv:g=y݌QBiRk"B%A*[K&vvZ#=*NPGVi!%(6d?9al386}߽УoA`c &T>32}=%nPɈ;x]n:x[2`hvk1cz"z dܑ)'<u8\(!ǻ7ۇBi~y{LzZag0#K{.$ xބc{0%z|a[$j0L}#LWW1wL[)?s;IA4ȧcػ,u 4tt73*P7JpqdPesW@eY Dujzc1+0&IvmaPNP1*ВIʴ{]VB^Wt 2P i -V vz1a47uВFAby?44]%bxI3%T-XI:Ӓ%>AL^>|yiN1sUɂp`@o@X"RvCO\ ="zaEhqrkW؋KY>T^6QI ѷ8*T!;aPu)ǂ_`K]B-,u͡vnzqRLNB?7΅yy^ȆS{\C7m:pnGpia fo7ݐ on;Y`l 3HN:nߎ4beq?W<7X@seگd@͖_bMQuhף3uv"㬏\]4ĎR}F#SePqoM {@1lgPg+א"Pjrء?Xw,wɉ.] Fej* Rfz1i1Gͷi:LcQ-|Bu-ҒS-+BPEfY\ ~z1m,.8(lF\(Mot4Xe7[%upK}>aa[t3) qvl<v" Q`:S"uaJ`me[PoEczVi C4ٱ&\)_*McX!ϸ-#(-Ŀł'K}<{Q ~ܝq]78yt-:h5| z+LUڡPt_-Bv\uIqZN*]ᅨ \x*^]*tv,:$‘:R(zJg(:Ml_QlٸӮ4!A(h8) WWZn|:u]鹤(bЫ$^ %d4*^Rx,o=:rylū1s5C$}n "$,B&@lt/se[QP&(]ՒYdSTXx-^W!|\8jIZ,)\F1 qwq1k"@^e΍8M˚'H'*}#/T/;jy{^j^.tt AxtV4sZ bZILZیL,dէJn{ķTaOf?գfߙ~;SWϛAj39ju\}NQ^mX J/CRHOe թ_ت?UEo^,endstream endobj 487 0 obj << /Filter /FlateDecode /Length 4175 >> stream x[ݓ۶ЗAoZ%δ3nҴM7wgYt/׿ @R:יd2'Q eSeů"r-fÂѯzPOj8z%ox-4N~]q[7fBNպeնz\qx5Vω Y]'\n°U}`nmvz{b׎'"ǻWV.urСVuY]};8 [`5K)F,9olxn5RIk@#NԖ[_߃qp=6ViPdY[Dm„KFN@!Up'NZ, i5bɔwEOhp%r>4/\p D !%3{FO z^{qѓ]&/RFZJpQ@«x -`^~ }J(Ezw/OXMd׋A@k8븆IfE- <3B!Za/]4)ϻ'@*' 0 H545Sr`4 ,p&j >4GSZ]*-AyBNRFN1$7V\所ӼXvq";Tœ]&orEIjm2{tl'Z&'"j989WɌFfCT QKLn~rY2Ů:hPjȭk+.a#R}BMkZ*r#w\>x%`f/mwF ߼ߝH(IL_P(7P 9 SՃ'`DW+ԥѼB^7Vg+yIKYsJ07 # `r |7ku[v>AA d- I4ULz먾=t:]u; M _Dإ?RK!&g:ֳknR֝7ɃTi{ZSކL#RT DRs Bp)!LDn<^텫*91v7_q9ImBWZ6oɝc=I.r2GwKb.V,^PӱEG'fN E7oc'iPRK-%T)+{(.{0a%K,o ?L)CFA9 :90%KÞlh!C.cQܻ0ppqoPDQ9>qy 1.e%"evLbk5{4' lTh 5¾s{,ǣF^U/f>[Z rI3׺N鹈1hB)V[LE2h'^j~Pq:|?O01cByj8a6 SA7Ȇgo.e({ leގ0>Qѝgc k\~>ôqmMy6c8 se|A] 1U)ȇa6hpI焳 AVJ 4(<{J͢ox7`ZGwn9gRM*Iȩ%ibݲͮ`fy|`)r]_Z>wtikdq^@y~ΐASS1KESg).ΰ:͌^`1nؐuh2'&s\خ}(lSK[g|M?& gxw% BHt'%崁RZ K,`̀)sibu |U&4SǕ%,PwSc2͎|RecR:sYAzAEh^m-D=e1 hp""ha}18jbzf*1OI %} %Lؔ!<ƍ}v: LJ$0E"I=>8#ɦ PkL>T|dqFA*>6pcbIm/J.0yv>L[?Dz&ApSAIb"17f H(L'tİL](Ϫؤo b'rp(u3 yM18ls83(;ތm i;m ".@qgRܨD3/Iofu3),9|_am>.% .n="0{f/Z#4!|SgEtJƽ5P،mWSdEL[CF/KMQIS[%I]!i̯a%g R//s>I`\jfP2-(.@LJ`r7hhMHzRO=#U srAȽu{:kt@(Sm ߄Q {w8Bq%w >3]Z}f~9GK4>r7M{.ŠIQA>n%ΤsL/ $qc  RK?NB}˦ے}'x/l <ҍstiEh/@Cv ~Thy DB> 9_SsHoir9i0[ώI>1 )St͉  mTy]xG)z.>.ZT~M<jɅK?y.az‹2fTV(xa V<9QLcANGJf5b(JV#_M*TUy;̛7.n9U9/9ؙ쓄/ l=xjMlagAIJ lHe&%*-n}{w$$ "k߮=j'~("ī-Uc}}`qW;\#)hqRS,*QO~I0`?a+jfɰ*@F7\8QmVHNNQ#x"Ȇ +O/=;~Lt/8 v.Bd{˪fWǧd:d /sypftNCrKO ƓȚaNuۀ(hqh9diBNLВUv}YoA8)$M*{ 9^dOGM0+|3^. ^;v<,k k^v1~oTl>D}҉(pM|NCnӠ5|t<_+ݟw@hd7hbL.S,HN7ntяWܗFS3lA\coS6`f} Fr!տ'.V>#[Ms >ZL]AN^@>5OK54X*ώCéS.F,f#$WpMZM]= |yr;t wMqB!=Nrq5,endstream endobj 488 0 obj << /Filter /FlateDecode /Length 2573 >> stream xYK70S3'n `zQXZ8@vuRZoCr)@vfX]]U]Ɋgonw"2,痠_r_x]L<U3m.ד+M9./r1I)so8[5ywƱ_p|4 ±ÓkJ³:2w3\fXhכn2C!C=0?MfJl&uW&0RNoPn}%H_n“}4o< Yyc5ek`DJZa<.rlrʛ}zD b၍ q*{#`esֳO .iYԲ*f4],^mtdԺ vV \/QFG#%4.Qf(+) .eȥُIeqbz Qpx}k9tnG]6&7ƙ%tx[."IB!jzJAr bDz^V)K-reQ~:ߛS:L\#ᓓ̌#i?+\/ҋ%fј~ɍAQʃg\sOf]R֫PyDMJS2!r;]D>S44A4/4aZ0F%Æ kZmT܏ÙV`1E²_6)lojɘ4(d'8ܸad(WlDAu쾵 ޴c |]d6sJ;X+ٲ-2=).GQhJT-me']UGH~]MXp/t@ķ Jߋ>ҀmIȌBV?_Uu_b`|(^rj%E:i a$CFaqL|4u"T/ o&:@AҖ $>8Ru,O`E CUld+͠(?s5E{*%eu0=Z@z'AQ<%q\(Ўsievz : RkZ[&m:*ui}O QXfivp=jhA;$^gӖ fy*}/)ھ1>|D9)!kk#GW}P!#:k :Йeu#CAA=xP&v.VvS! ,>ޣ g?`dLGwf<8ikP"ר`)DP e/!#N޵FR"4.sJ"!yqڒ- V'n %tr 'Eqf: `}s ~VEean-E+d!bP?|׀/h+TpL+M/ ,?7O3iE2LGc TѸ'´xӲj5u°rIT4R/S8tG?hZ]mendstream endobj 489 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 384 >> stream xcd`ab`ddM,M) JM/I,If!Cϒ NIkyyX|/J{9Fʢ#c]] iTध_^竧_TSHJHISOSIP v Vp NTќF.&FFk3[1h >_ǮO2{Ʃuݭ r^_]/];mjۏKh1u ,Jk\f-.)Y=Se 5N> stream x[o丑S|`˱o݊H rwdo$>pBv{$=~UERbQX̩R)NHR7+x±Y!J4G,3*͞ T=0im/0"pj!.;ys!1rs&Y]l<_g&),%]* |Z<ֺP_L{fO["_&xl0J k@Dpk .ޭX*q 8v"4|,dc)"919n@7džfX/+[prqO[.B0t*v ’+3'Q~NqMmk.Lʓ)Ԟɟ_.>GX̀Bf_Q@qhBrQ)@>v"nFe?nY +kHY,pooJ|'eQVw,` UQ^eT Ni(y3+edO &Կ %5W40b:K7'>N'1IǬsk2TU׎*!OŃ 3#Nnqqڟ(XÍaJ70kyg98q>y$sÚfa>[D)V">AqEN]ܐ牲h D'cnr}gvhd afAc \.]xQ?~t O' ƛx[JWU^L*閅r<3Zk%eh@WF( ;욅\9@rz@fkau1Dez?#\D8jŋ'F`g0=xhvtYŋ-|!O2~h1֮ӔgDz~8? R _-X@_0i屬2! PyICP+/!s9'2##/1O 4Zz,۵dR'0& uN-OgF N4BBy@p:ѧC.[ [ WںU~N-2]j).{qPJ0Fɒ,Ϣl$v{߳ȝ%w=–PzL"v%tyZK$[-51{u\ c"x[XSRMw1B PEqɭ_oi'7;(-gk?L!7r%b[|z9ٺ&*W dpTM)rv3V!gثCT8sܺئD~r!\;is4s;dٚ]f%dps_f,>v_F 9?oWvqg^$峋E1aH@&]"^'(N2(pDٱe0Jon_(WV* u[$HGK%o}Ւ2)r%8]yW6ի3ք:4&G8ruL69]f46&""UieAU)9Q$JٙZƋ,@=?6f ֐DCB.ۺ%3ݏkv] Ew1婔_2_/|f;]yjldRy&tp& @Mt_LQ$׌;m m4îR z[n&%xl~}|G3F]u`-sMԎjBfPEE($L tF|1ld[_.Ͳ)40z>ē36LI;J4;Y/31 <)I9<%KXrp:$K64 aKZm j}bJ?%?Cmhr+4rP^tՙVfbbs1CG1&*UEEK Kɾ̤t<M.(Uz9 uml~YxmƔ dANwssWgYfRЩ3`fɘ7/ $ƞgG>Y\F澷`%l. |F'>M=ؿ:)d%$HjWap$2CZlŽ (*OȢt_usGvRK'\*Uq;7"eq?i5c3bQeSeh%?"Tn7=W}HsEb%; Z5v{c2i⤬s!I\u"M} " [=Ŧˌ~Fsِy=e܆v+m!EdQ+Z͔ |zPXڨUBo,Lυ ';,lSZ+PXR@lM޺8ᇂ?:.582+S+ Zt;/IH_ݻsx>K!yeݤJ(]Eh"NԁqmLeK )!hxu^a>9IJoL`P*lCmۏ\6ӈ &IR1ǻMEĆ&P8!f$kp`Fh"8<ʜEbs;$VC7.K :1U)օOtA/XJU!r'`uVRbznO[j):ԏ ¢fv$$EW۞| }Rk&gȟ%#~rHVQDŽl#'8*Uvnt6ͭw]c#4Fcbҍ)|C_q :kz5J v߲3Jts:H_G0oWCgsg!endstream endobj 491 0 obj << /Filter /FlateDecode /Length 5337 >> stream x\oqϳFpb n.|r" \IwFr?&HnDW?W8ߩ?~8}\7 \ޜ}_\TeeUSnJ)SOisf8jW<$4M鲪D]m:F^l?HVյ6l*>$+Ep__՜_GD*un,0'ԲB~_\vX4CN6tͪsj]qxzb$/߻qz߮͞j{"^]|uڷ톰ư? Odk`({]?YDVԢ8 ahj(]Zq {4^@xj;tIqgZ}*.]'x:,go?,5UTKH Բ^wBp5uc\i+U|2xط fruEcb/],?Ut{16IhV md) حQ;O ď3# C]K[yP䄅 Y )ojnNJ)Tv(Įͤa)õ +g`ЀiO>P~ډvN7LƐQ _t>QەG%P_kLx( ƒȹI&9&Gj׵(_d;|}vߏY W?(>nxӌc]J8EQ"N;pQe5y?Cn30l?jܯ 1sŻ5p@k(0v3o0 m)@H#ykݵQs)EIApJA!7h$rqH;0 | No,+F;LHM'&|^ݹGzC^c)=εOZkx?E|!`[$`vsm`'k-Co͵ڙ(mE%`Q <=337yu̗nOD1FIFvf=PP\#l]haY;HNyH-$`hS9#"Ň!ףYf !F;|֔'_7FڼKKx"2ȹw'5pw1lJmC# APVz +YS|kWT\] yn0/ȟRPilYɆM 1N,`$Q(~R萞PECvWŻ;>^]7;_!~}1{F?O>bW wot{/[ &΍<3$ZrT5-6-QǁfΛO~DGK.71n` 4Q$8 !T6`Vg |!4 *3m zzfהLAI`j ,V>ë4X^Qf~yHkKp3sÈ+Ӹfϙ[:B8!ܮ܄)yoiqIxQX ɾRCNh 5u|slݩ<簊 5MYl/ko|BQS]TIzknY/ Akr1gZ죣]4' \)95̑v;QX' zJ;pzJ _Px1шKͅ[28VO{ VJ'>Lp%XI @Ts}I0ްM,Di]CLyYt)ɐj:x O! i7&@R:糐o~SkbovaɆ$:y?P2,1"՚Y3Xhώnwx%@1\cY4}U!!cim,04AT71R)M=VsPML #ӧp>B&5" Cz$q?P&Zđ÷7>aZUxx>!f+edK-k<إ$if\㨟FNslؑD60Rg/8zUPѣ9'#w+f+W q>ًrs׾uwl-="Z7ۏ,GS`7L=τ^z]i?% LiLec,~ESq\ 0uAз0 xQ }oXE8NQD{XV!Y8SRq֭۷!d*5!{b; MU1O4vz+)]sh[k圼D'}@Gfx!Dj!L\Rݜn0} E\1&1:c8F'{Jw𰡟܅ϪĶp6^C=rGV^ھuRPSЍј-c< v_>f„F+w( T=BDQ9#̞!mPT' l.`"KR1kƊ?+c,UGE+@/ Qeㄴg%؅ugp} N ҥHKAPƅТ)ų*(ɘ%^JufU_FOLrn5_-!#5!zb(K=pاMQy.a-*ņ 6Cxi\)gXăcUM,N<%尫cdAϤ2HYoZ1ɛrG1 }!5:O&u:vt]1 "Bay֞(]fδe4 ! u3TڄцR`%))% Cz*@iWi38t`WY[H\ 86Գ*:7}%f*>@&z$XDueiq,+")YMb>< hZ&[{YwOH (ٞ`Ӕvoǩs౭|s*mri۶TNVx{ GVc"LSJП 9Yj{ yUcEm}K;mF*Z{a$ޡ~] T-ENaL,k72㓣bG/(lm"ӎb9F64gvnS6[SB*uS u@ow l:f~ 4֔R4#SηӍCXAuq C#tFx <푶%؃ܓw'~qVëE.r9R\n. .*xcRj^Ӟ=u,-ZKsj Wm.6U^h0TBWR#CR~,qkNa9!W YK>NMqwɊ]ޞopaqz6Y|V Ԡԇރ[0W&6`ߥZPdF\yC6/ -L3tTu=w1Ta瞛}\u@&p+Sǿo_z&x5}7f%1ƃ3v ,l*Mc#6߱s{[} "?uSNG}Eirυ&>+]Z'q-yZ19!_}.az%kI.ƠskJ7` x7ŴI>|]un܅m#S X,4jJjs_3*xA Q[\*|%Kgha2?&4&KXZsk%*1вWkWm⿦~J4L&kÀCVфNngu^O8i[}_J߂wá~jsCH%'蓔o!]uE1/7Pj _NZ/oF$endstream endobj 492 0 obj << /Filter /FlateDecode /Length 6711 >> stream x]ݏ$q>%Xi~rd@H%ȝ!vF9=UEv7&$ޛG>~U$[[u-[u?}+tѭ.vU~('[]l;έ2ju}͚۶c\5u5]_vm,6x\ǚuH }5H+ \[On~= PI`;i:w?̥gch_^4ܭ/ 8 "SɕA@B¬.r R_xw jRZȖ4t4ۋȨ *a oFNt`taᏆ^c6u56q`1jtҟk9С嫈IBǥ^.QEc0DdZ(ٚWT(Om0Thl¨4Ps`jӵ\B[?[S]1- ^-l@&Fk% @0H0Rk%} u?S;=ER柲p'bzO~ҦZl{Uj1tgd}3Pቃ~dRiETIB,) OblFIB% O`1UxP“*BD$TA#$ ZQ' lL {j mSϵ4tx W{:Esܞvo6ӧ]0 M8?\+Z5곑3$KԪh΀2VCd+0,+oO *F#g֗iF5 Ō 2iO hفdC u@ WƂLUʈQQ*Te9lQq`PUtcU(ⴘs1W 1^Ug(¥n![-yuW>q"Ե+) ɲ lg}gHNΉ*WC)q>9W9j9L.'8y jMA]8]R:~d_Bl!FN8 m8)ucrV&@yˆj%&fj%U%)&{sJvU`dK&`kW-nUbiWC\Wl#*t1&HuUt '⺪Q%SӬJn6;GŻꢄPW]U)#|CBx5%Fv#BJ ]Uy+O9uz d\"([]դ}E~HmLUN2DdW (SNpyUJ_RĉjJP8@72V$2&K6>AsZDW$t‰0>Z\t7e Sʫ2cΨU #]Kݹ $mOzUL!HѽM8Ucw9F+=gYj,UZhUu)EHT@bwJH#ҫ^iyo-5FHXma+L)"#f xTm.HTSV+#@ ]#%1*JDapeaNE`HcivI ʳ0-Y-O"xU_UgbN<(:mCU[7n:Nՙ{2MyM^]hB#Jo1ea 2 G &Wq/\MT,ٛO 509k! ^r6LtU`ٳ7@tU"*F<_&\:s1br1B.Z9{/bdԙP.KZz!2 E.+fN]XkK'_ ޓ0?= ܓPj'c'1ޒp<%xr?/wwoGw:?]_*kxY:iwO6>{p=wwR0j(&#x<爺6ߏ1{,@GRUC3 o Kyw]Rʞ& hTeK0 Ez7 y F; β,ob~n4-umwT}7ň-!E fđCIޭ9}`)XSen.pR^d.ZVȱ9}\l3tZw X27!OÛVxƖ.|h^EO!jj^$?isIJw[,z^~L5?mN}WvdbMp~ޭze2O+V}]JYۻy^N9P)277Io8+`˱ P4Y^߿LKai`!RLЦM~@pyksR' ΡEb"c,AQ\rL,?>uBXL !F t !Ȏ utFGƹ=蕮(YAM*eL8}Kҋw]INlqhHUT/@é/>Y! FGϥ 2bw45G횘\ |$W,$:BT ҠQ6˱\~u}OS~sCcH)|/чMh%G!@|!=1nrJQ6 ?(^nÈhf귁$nU1N;Ha. -Av&>b]SsV"8PM}%A' 6e8B2oRKt6Ik9[E!`:*cMK17N@y|Eaie( 켮¦#u cbϗG0 gvN/ֲ*2eh@ Cߒ2H@np}U$"MdZ4ϕg (y}>֭ Ux+9Fڀ:P{60(qݤW~PbhʹkC ։FeBRtt|  #Fcb ?K-%m:k`vlC}Bvu9, [jFґ8*?r 1H):\M`[jMj(ؚc)A!>2pό;B>1Pe7vcdRt8#䟄?UJ}7w ЃMh6LyO'=3%3_?f _ɫ!mڞv{PIˎ /Ex85ߏ_񻹥~!%ԝt<چ8=6Xs17loܢ$. f68?e!ibEӈhӑNJ.GPpjܞl#Xئs*J7,qX.)^$&C{/up<7.I)R9i*I,I>CZi!G#ӂ6Oá (uo3u0+uy>0F~h5Z[ڨ'q6=>/_9V 72@j-߆QJ5ٝ!Vg]͐%mR;NLёTjM I4u8[~?jendstream endobj 493 0 obj << /Filter /FlateDecode /Length 4439 >> stream x\Ko${7m053a,>jUT A2U/Ft`$:I&>n;9=F_a0D$tTUSTSpA$㦻l/@a $B0P͇F LP2͏1z\r8?lX*8R?4VHrxQHe?nF0٤AZPYIESˍAkpwt=46)aA̔P6Z{ jƨPZaL&7^ $C7Eb +P&yUju?@o5CوPVM^(CBG-Ca bȐS@h%b0Mh*ڊ}PMA]L>8 t$@=Ŭ%"=X" "U8ӳ*jD 176x%ǻX2Nw__w_eRw0F;!_oCje (On!&/!"h޴* 1ȏr. åL¦F装F@1Zwq9$΁`L*#Y),H=';i \ڊ05!R0V˹@S㳵PXT HF#xZ -q-m< ZuHj`Ϲ=UT8`S-l(mN\ɺ/ U6 pkcaI8 >&}XJZ'!un F߳*%oQP9D 3 7ozVEg{"$B.fk7)1=\gg@;5$+5Q*A VX{^|yAJX)gEۘҼl03%o.R$jy ]VQ~R_ukQ HbȐnt,BƲ[d8Q6,r.b : 'k2oj\i낛R>Ռ!Xu{ )EuɌe TnNbID)A Vydqe.,L .m]QLyqqBuUΡHZ VA KjWňG d+n=c\ Q\ .@ R$F #: ZHY{qEc1R[T5o.[|H l֑Yb$a4tzqU.+3m("1~Ec1BFa7U};{~Rm**Pf9'GF Nc2&ھ> kȘW4#DVpS TiIչ.",$}D*Td/FN+eVqeQ/:ᥛe#m9VV1!4x&g8KdI,FnT-4~Ӥ y43hI,4$X$6Jk -IhG?Z2`>`$⍓. c1Na`1BVŸHJM"He!d%I /PO1HK01H~9xA.Ԑ6:Lכl c39NuvFy1(" ,[OB3uGӂ%I8'_T Ԥ<#]7<@tc1BV@RO:1dV, Tzu7NbA*шuH8M'qH=ҜTs'f܊%pDYI FiA Ғ==q2w:Uw9u[y Av\(kp>_MnE  ma3W^o0#K[<`o~rmL":f vUEhz6JYoJdzڀf5bs0ɂe2QVsfRK4eE[ ET%)<[RF.3'k<=WB/36Z( )ޟ@ُUᄑ@dgSטLpe !~ť~os`~Q=?tZ>N> atD_R- N'ɑۿEs,{:ň2dԓ w|0FFV {Oxhg `r@CO}i§\9T:DN{VZ?)9d{E#yRY% 9OHs1UD +t}:802HXSq䣯s z8K91s|V]D4,ekUB/ aݓN^~(`YHwC1D frހmo[ { $N/îgسevz<.6Iz %b Z+-W5)Nj6ܧaOz)GaN(@[q&g䞈Z N1n[hv#v^V]RY};B!gsZ۵qn|~=8#GE/{BAVEYjFd&㩓,@dQpTMW٨v &$^8-~BB覷]Cs{07+/} _m@Cc5~~{[\cIFF2tF@U;0*}}N :?=e_E 'E28;v^c!ZAWN6?`<$;z/RBVϻw Ef>}wJ!H9|?տ*cpҠ1T9h욟GϐZS\NK{Ї/Ż>zua)e0IuC΂MqP`ϕ?mPCҥz6=,*&ؗ!LO[`oqXm!6kng7[_9v,n=}{;O9教c\' FŏbuXKc8EX{±:ot @1Jl2Yendstream endobj 494 0 obj << /Filter /FlateDecode /Subtype /Type1C /Length 663 >> stream xcd`ab`dd M34 JM/I,f!Cܟ^ NIk~u0w/=M{<(fFBʢ#c]] iTध_^竧_TSHJHISOSIP v Vp p \9/1!^F9ƹҽVmp{q+?抭`.Z݇Eyb&fvkuZ4st}b~[5(ߋؗ^޽`N;pə~r뱪r Cۊ}ܽ].3 Dpi0{PqsmjYrߝف6oX73'+o^s,ޒ]#h9vK5Ofaom!`wϓ^ӿ*}3o6/锕~wvCq~2gSŅ~L{=?G@!{يu~95~fʻf-^Q)]a7/\#?U{OvZ=lYN^ KH>g7 =={z7Ylf }yx:#fendstream endobj 495 0 obj << /Filter /FlateDecode /Length 1069 >> stream xVr6}7o;C:&M'8ә&}`mVCN= A t%qqr8L b2m:C%ea寳-{XDXsQTbJ*addzeͶzͿok$e^hEt_ .kNg eOHІ 4E~U'$#_o3/pjO ݮtyW1kM*%x gʁ߭lWIA4J`uHx43RX"EbFPly%G 8 L8iAލ d"<:čOJދX&E@,*$40g7QtȌ^FAƵt oԟLiOJ 1/jO6dENF%Acƺu:zXU*gYZq ##YSkfz(-#&NDR zDeAl TI 'dll)QV"VSq$9J- %8#_ajܧv=6V[7"KI WVpo77+Glñ[*uvDq%vPZk[Ed'2=>|?i4sR'4(8w&6mT[Ju=%5‡;Ȇ6Z,#@r^ Ľ&\wΤ?5 IIοl7RBFڍvu>H3,  HnACm]|մ@3E{^hu@%q׾ܴgcjT=!~Kq~' PwfP\LB u+4LL-c?/o+[)F̓zaLv˛r('/5N:ӮP1[ھoE1Fm6B3r7LeFcuuEpVk?)PhP6Mm7 X8a1*SzQ> stream xZo~Sҗaj[E%Z&(ڴ@- \k{(ݵw;3$%֗+Cr8|CJx®juw֕zh _J[Y^l+^ʮҥj=^*[sSVⱹYoYzS2ԦxZsc+V$O/܀2Kb,/l *[4G/ܘ⟉ka8,S{{a粎wk(oo. !S*6B߫ Rn\_ۦ7/E~wBQnteqjo7 䫶ۣo4rle|޷U70]t"GM h(nV^\]F;e.^_SkC<:? ̅ʒ %YZgh]ٟ@5*s/I7kgpO{S&=9,>-펉'MQmc]Ȥ }Nz{@ 2L%` FT jWjٚ uOXBm:oOOs.w=H=w 'ߟհC,k4KwrB@ ei0 ExRE a{uITfJ~%zodFMىdͧK;X[ж !ܵ]`ގp<$*$a3וtQk>"@쮲<#0!VPG@AS4v4RƖhht1"*$<}෬2kMHfȵ>t{h$reQ|vPHsGc FTᳳ8КI =1lLAq>_Ep|h(H֊KrZ [8-FRm[BvB)M.TcM֘[&Mfixtyq,6oe–pF Ck,g (ӏbh!1L>d`6O7C=AZ1DJ*Jc$Y^t*&cKlÍ:pAjJmdJ. ]RAcpNq`SDY@DƕhQf}GzDZG'Ef=#L`|v(Ⱆ+!^.%\#mPgDbbDA ӐsyV( ,IYI)JH &Y:'YKYrbū~@H5rda~;c:]I`w(m33I(ץ#mΡ/x~_}Bg­.3-/0i H@M`Dq $l@p'ф5MP[5Ւ-$gS:̻KHbO >ޠV&_(wNx  U٥1]UסtU+DC=AeӴ9J1Cn8Cpev үy C*zI'f81SA$'O(?&AҜq/{Ua#̤Uᨐ;d|cd+,:Ќ9qQUqZD=Rڷ~t|qa5\IBKڌK̭2C5Gx`0LIYY+Biehm4)Uf~Wj7~@cSZvCjԤNkty@T~"AkJ[yk"C>-p{WOalFmfi0Ua0C7yS*,'x ʀqޚ0:8<54F 7 ^ p:E#䐊=5Zrh{N՗X!Dg~pYnH# YFmN,{?[]=Qcv%޻ኗ5όdp,⨏ 7E]3XjpQ!<-pD j8K[i:>Ƿ2E&D_Ȟ+gBXsWJ[o QCÇPxOYQ]NQNۥd.KSuy>{`x4~8wZ"j,|LuK8? ]P)8 >Cdg|#?P *(6†,OSy&"/g3gR2'MdRW[-Lj,%eŧsXc7`\cƐ3hiu|c#B鼃^cGv$߭CO|jjg#>9Oe21g8L-pz?i?G{b;X?٤C@od)ˏgo喟*gs{&~={Q'5X6Z<WEVli߫Ϋϥ@{| Vr{1= xM%XKY# #I$NwGz7^ TG c<אwA\ f7SVR$}4H ;kr$'_9uaypUqno\ 8rR/5;}i>ȸ|>qSc+>֩{5i]Y8,M$+E~&\QV>Y8As".;\~\A|-**F%b#&H&en3pVNIxChL>@K9Z5߻!X9?QYo.,endstream endobj 497 0 obj << /Filter /FlateDecode /Length 5915 >> stream x]sq_T4| 'ĮJĪCI<^'ɗ>VrCh|u78=L9L߇Kכx=<<~{eʘdwnJUs˼͇? xk8;ݾq΍)oL4GCB4!}0Mq.CC3in1S+j<+s%j/ gostAqNw7o~EP/yƍF3='?4·08.̄0"ѷL(n )˸x ͇= Q[@V;.yD`uh |Fi`2L!m4Jcȃi%) -*S QLIjѡV?R~n qsXR̕1-F-c*#̡Clƅմx;F- (MA1`Hg |P1Ik>[HFkiE(D)7_ @.wS5JE5Pg73҂6Mc!*gPj3e >q3el61 lmJm=v1ֺHAYw0&G6Hϰ5 a3G5pY"g0a] W=FVU4߄[ xFo qJJD'2X, nL)?xwA)TM<(B> pcU5HBԕCӋ;\gXe촍y(8w-m Y|D F0q?!4U|>(OtMOyj' -<٠4yX#&䣕O%s\C XBW\M9 bArhz:OV7\OAYg =>5Mۮ '](0q@dz[x-f/\jݿXw _8LϹ+*wo@+nx_fZ:`@t-rCi!KOԷaxja/^\҂~9~}f4?>Ka.1.0w/2 X`̃ytNX{t[{ٿ,KuGWYS 6ySpf&Sx^}2Sk"0D$y{8rZ)iL e8 <,!]aq2YR2\7;@yU f|t7` zovD=PiJ{ƍnbq6{ aU0 |3AFVU<߆_ xNuɽn+];$gpRK0zrJrt "WMTϻ .|Їz437?!4U}>(O*Xc\? -lovO8~s`sd,<*WoM |[f ä6C w?ݼtX/#& ?o @(L7t uӁ: IO 5_4Rc.,@(>¡k WmwZl AܕC DZeu0JuLz@1 D^6esTPn 3 W D0`Y/>/<=kQ- p'S"DDA6'I@?TN"h!=]lNI "LC|v8mY ճdS:3Hv 'qmWEI@T.MH~P 8I $A3\k]AƉDzİ y(:Ad!.K/c$;@mD"q2s9;2DrqF : %Qu-+.$;Aha@2fCJ!d]Ief ]Kt[F)a\F[&rS,)C(Aʥ rh`1LR!AġJ֜3:IC ' 4H·ܣMj%CW5O)m6z^DyK"QJ)VJI|ɔ]:1-ni$gAxpSuɝ:XzZ-Bʧ)L{թE]d5rv j%z!SʺVzz^DxKRֵW$$-xVD)J_V=A {aPdBXJє()"D$m'npHt;@&@Iyj\K(^yJYj\K>yG&+}Mo<Ȋ)JDԧ2YP2b:@}L ygҍ}Ql_=3NEO?A!n*YsTH9ym3w0#`_@ 6?F>],!yplEt_!q_xO]}G ͎ӈnԺLg&UPVӚEV:3uv+ECҮkvG1Ni7,^9憳 RD8/߰ JUbNRlΟ J]o뀔N\~з pKgtMmB&T%[ҎS~9UMB9$F5BMr fuFmٮU)"p%g'ӔgIL;2=?1;j(OMct..Ύu;K&ŶɷJ^i[[Oɱ2 v{%s ELuWJ{}xP]KA*Ř10|n??A#>[ /pQgrC԰nxo#y/Ѧ4ALM,퐫ÙOGϷ8|2DC ӒG _뿨*i܎ǟbvI!d@4WV4z21 Oo+(T`uTJ력٣t,%FcQA|2E`TEε|R*ĵuf> stream xZݏܶ!hKw+~KA[ -4EZ4yX{:K%ׇIinQ$r8 ~SwjsΊ9P쫢7gn*ߔ|cWRoΏgLa`S0;-(w@ORe.;|(yiJv kͯ}-վ(a}}ʲ;1v; 22eyCRMt4{Fqך KK%EUTZ¸!fqa8RmmwW(ÒM'7QFf##0dld(xݮq($`ErͺLK2"[#gNe؅IS'-Pv*]g&Ӣ>M$,rK+cP`ݎ˽V؜}vW*elTcU[l`%>&f uo <(3yJ5-ofp{S2xp,zӜ]/Çkb*gߜ7sÍv,ĜkA!# .a"rE5 IMl<6T|Q饖Ãd-ZD'#sͼjLY .b3$Y&|Jv(j''Ȗҩ~=^ci./Ydv\,6d+pl\Wf0E+#qY Q;wnj /qa?vC2gW~30I--2N,A=Y%OMJKv Wk?"B{V(}6"[|CgY0+:jB!I*+.ܒ2rnʁPhc7㉘k%7a!bl Acw9[x֫ d:nO;Pl'cv^҅ xvӽu݁-fPk5B4%KCi0Ȫܯd?5#-Bv,?HZ-'^vK 9oIlR1v_Zcc 18g ! Ovi,ܫA+)q\ i4ۇ4T.zdY@X8 \DЧBD_5*g짥xY ena;99O(tĴZZL"?d"}Xɕ+?ATki}iL yq&Â@ 5xŀՓaR|{iFIOeH<Hʸh0v4URE+!+ vezHD>)E40` S|Hc:E40sWʡ2oO |g]fkЀ+ie3@*C 0U-,PRDK@R C0b35qwZ_GSҰPBǫfuuS~YȮU9㸁\~q#rV(]'/iP 9^]&F+IBTt,($JzkfΌufLLșΆƗ.};u8?Y8>M= u9J3&փ{ׇ%U,v7x[$Dž́)jJ8tQrq[M$z@ʉ,|W }doFuMGm0os#%{% M Nqeud!7<…QP ]ɹ 2'ZY?\Ÿr2{rJ-o?*I%RVpj6T.' TJ wL"}@,JP!ZU8Yyxg؈)swMRp (.ܴZiզ 9InSfv暝}묰nH=\:'\B/ yLT?bo|:t¨G # ^.7VC<9JHSS ~bB_G4n>:=T'\ʙ.nRp2!*=i\-4Ēu~Bb_eH,UINLaqZօ+VOJz)]GAaɸߦEcN?uMzF2cƲcYM- @b#~jydu{ œ sO Ε;t3&ӓa DS. R6I@n7#zh|INV{c­ca_D+l:Aޭdj1YvTբ[%aWK|jHl#>]lqG?7OS"x dPDEJLi7gڶsGMx}eppl-DAwɭj[䵑[ʪ7EA[?Df瞏[> stream x[Y+IV~'xfitbDa%ԅnmw)~=߉%3"WU/OsW+Fw)tVW?_tWx 2i=|up_+WVK_5J l|k wW?4?Y˴~RhM{\sǝqͧ;S-c4n_u-\˸,ފwy\7y U6>v_woovwp:7-lխ*?Ѻ~>DOn+8|?akN}莏X ˅R -k-3g`VOWx8֖;DV1-oPb%oT_=\Wv W?,W_ &m$`>=5hߏa$lxGY 6+JYH2L9W5 ,Pߗ[2(zGcfc̭8o1# @q0hHKyb!kȤCzƱ >l ;7st.M#G3tw H~{ 1[Ιw*0tM9!`S>+H +|<_z?Z,TcQZW4M'[WB A<]!B+k̈2hNv[0nk11 @܈2hM f1K xCMi4H'=܋qoZȚ. J1 ʔUZ ! `gf djJ  ] % a&wH @IS,B5!)]Z(3BH5V`P+ @)O׃]^zߧh=ƒZ 2YTx1,k%h[CÀfE̓mE^AP-0i  @\8PjJH @ )e ,4BҊi2/ɜ)VɼD 67X {OkIˆV1ZQz Y5GZv*=#zql)(# Oi/=< ErL9.@0or@Cʹ!`F1CE,n{DS"=UǶEwT:'ǃ..QŻ"^tPFs=մܶoCA|~,E{!ãtMǍ]9riyc>W3S:"ɜtp6uֻ]GjʼnC6xAh|6݈#@x҂3YEǧX7UR炉@}QtC\vސ@I&^0d@  38 4Hhƪv4+WjwH݌*:.MQH5X aL068m·[ٞ>WHf1LJWWJYN]e}㫕vyB[. m+99Rsl A cGP.'ז.'N]R6@)o_]z htE&x M%͒)9fᯪXg4.7D5u8- yNXzvԾ|? 6>SP|k {%oupK5! Jِ)(Foș(.""O^*'BQ6й $O­+֏&BH>bMDWfj!Qi[S%NҐẙ[qNe'gϙ{t0|9@*nl@S^*smB*A ތuoBUeF|KS5bQczsw ;|Njh]~ͬ d/kr1ͳcsu(=ϫB#ͱZ.UӘQ'yRtS8g2:Co[\"APB%UMYNIʻPS܆&)>bZMW6E ʻUir?qREWR 6OvQ,zkwxf-?9R1tUߖ[㢰7/> stream xkoBy}mIZ)*Z*HgSCRٽ۽D[ G$ofwfv޳Ӣ(pV/~:"^ _*_{8uF|!jQ/zq~}},j.4m˕򆳿n8vkΊO:8e$g+-=kα[U܄%W??.s=pL9PiϘ7g+b%u_+!x lTN,/4/|aG@ g.8;6DlmOsl@B)WٓlP 挞 PP"QAX>ߔ(*hJZv"\,}mh@w.f;m^em!Uᢰ%f6[ԘV)iR*+beYIVɀ ^%emÑ^fql$`D0;(Á;K+N=_ŽaMRv9@~;Y6 Ps9p3Xqc$[vkrB +sgb?#J.O U.l*-1)ⲟ 0|SRuZXP)g9+ ?ef|_C8xf %;MZ f[숖=ohk* L'8Hˋ岓6DY/v!k>,b,xw !_nlBI^4 msV[yx={)aY죌uR0WW}NzQ.U 8]:WYiaz l<spT=@B # +[06mZN Q4p+ݠW0LF!,p~\>Y5n %iJIcv@ S`-N Vh^U+ט BZ8HjCZAT, kcK68pT @= O.FwGm@7zizdhg UAa80`@%8AbS'Ge_ 9 ׻]!]4hZ7MvKd'ǒ ;do9Gԅۨ"d~3d8mڃ B$~&XYhG5 R YUzn FϦjn[ꠈ 6JM?5!z'ǾO+5]7I]OjsRhs>9 w;;MQs[,|l9=O8!WGùBOu1W!هbp5O2۔MC,5v*a4=KۚZ9=CIpܷ/g-aX"q:&t_+NR4GɮPOQ49u6[m/(BDMinBmpSZ E͚4ij }6҈1(AL )HC>?p(4x6e׻C!z'N5밮S@ϺgYB -3!5ăEF&hsvT҈ M\r8e5UDL 8 8sɿض*rRk$v!w}[' mL /vBfXңm{tB" 4Ex3?'+(j]$Ψ a0|E0}!;̀/ho.rڀ@@Me'XFcCd]7!S}ȬǢ497 =4 LᇣsOV+2ޖZ;i =đ5} غ,Q btAH׎5qKN3AX)9g,5VKMIt". +(#Tψx?$|4h'Ҥs9O :(%lf+6$}%掼QxGx`$;!}/ /L1Gom!UVKM:'qD_LԠ;<ӕ0(lCZ.GaV\`[\;p](8-?|,r&'*] x]wJ-ӳrf (X_=&DgdryބCzWZ2-sEqlgR"΅l'|t0|U ӷ~gw܃}A򸸖$u dK2Y\rAT 2MNEhY㲃4X6$UfpxGT}qd S;M;?D$8%?17mdư;ܧt"qk<݂Cl$CTbPjHhvR|fv16dt&Bi㎐=hr)NG'%6?0d}s~"*[V ({LDKf8&RK0QY-WjrSi/93ŽvԻP!קf@*KPYGu/R`M1]ؼs"RwVƇGUY}De7UӵCH*ez9։ursζF~$IHgE~Źa֛^{8-} 2NПq.Lxfoc~/D킝o_!~Ͽ FVf4A@n>\嘸_K8 :w{8_/|5x#Ő4{GQN-(fca?AJ mxi e{jJ 2)x3l? Űz"^V Dx$:@GuM›!ROAڪ/XVU( s+BW_Z ևzxoLlF-uDAשN=\ԢSs=݊(t8=VU=4FOȹƧRڕ-]I 2 wUVj" 0xJ"Qf'cfEAFD +}( F{ wMaK/yWdWn!endstream endobj 501 0 obj << /Filter /FlateDecode /Length 442 >> stream xSKo0G ~?zbQCO]qti)YD/rǞ|fcym{tt!=x} ez9h*ql^jzD-$[{lTNQƸ!eɏJ8ʸdH[|N"C1RSgLFJVovpw> /W [ 1 3 1 ] /Info 3 0 R /Root 2 0 R /Size 503 /ID [] >> stream x핱JPo4@$  (A_@QD骓A]* Utd8mؖ1ml% bd0춾H#31oϥO#S_Z4jC=~_܂X[_1fLRSĊ-X=V6tڞ{1њ֏hz"SEJqf YU2nEO'guWQCw?n nE6Q/.Q8]9]8_ti&&3a^+= endstream endobj startxref 273067 %%EOF vcd/inst/doc/residual-shadings.Rnw0000644000175000017500000003711613731705707017022 0ustar nileshnilesh\documentclass[nojss]{jss} %% need no \usepackage{Sweave} \usepackage{rotating} \newcommand{\given}{\, | \,} \title{Residual-Based Shadings in \pkg{vcd}} \Plaintitle{Residual-Based Shadings in vcd} \author{Achim Zeileis, David Meyer, \textnormal{and} Kurt Hornik\\Wirtschaftsuniversit\"at Wien, Austria} \Plainauthor{Achim Zeileis, David Meyer, Kurt Hornik} \Abstract{ This vignette is a companion paper to \cite{vcd:Zeileis+Meyer+Hornik:2007} which introduces several extensions to residual-based shadings for enhancing mosaic and association plots. The paper introduces (a)~perceptually uniform Hue-Chroma-Luminance (HCL) palettes and (b)~incorporates the result of an associated significance test into the shading. Here, we show how the examples can be easily reproduced using the \pkg{vcd} package. } \Keywords{association plots, conditional inference, contingency tables, HCL colors, HSV colors, mosaic plots} \Address{ Achim Zeileis\\ E-mail: \email{Achim.Zeileis@R-project.org}\\ David Meyer\\ E-mail: \email{David.Meyer@R-project.org}\\ Kurt Hornik\\ E-mail: \email{Kurt.Hornik@R-project.org}\\ } \begin{document} %\VignetteIndexEntry{Residual-Based Shadings in vcd} %\VignetteDepends{vcd,colorspace,MASS,grid,HSAUR3,grid} %\VignetteKeywords{association plots, conditional inference, contingency tables, HCL colors, HSV colors, mosaic plots} %\VignettePackage{vcd} \SweaveOpts{engine=R,eps=FALSE} \section{Introduction} \label{sec:intro} In this vignette, we show how all empirical examples from \cite{vcd:Zeileis+Meyer+Hornik:2007} can be reproduced in \proglang{R}\citep[\mbox{\url{http://www.R-project.org/}}]{vcd:R:2006}, in particular using the package \pkg{vcd} \citep{vcd:Meyer+Zeileis+Hornik:2006}. Additionally, the pakcages \pkg{MASS} \citep[see][]{vcd:Venables+Ripley:2002}, \pkg{grid} \citep[see][]{vcd:Murrell:2002} and \pkg{colorspace} \citep{vcd:Ihaka:2004} are employed. All are automatically loaded together with \pkg{vcd}: <>= library("grid") library("vcd") rseed <- 1071 @ Furthermore, we define a \code{rseed} which will be used as the random seed for making the results of the permutation tests (conditional inference) below exactly reproducible. In the following, we focus on the \proglang{R} code and output---for background information on the methods and the data sets, please consult \cite{vcd:Zeileis+Meyer+Hornik:2007}. \section{Arthritis data} \label{sec:arthritis} First, we take a look at the association of treatment type and improvement in the \code{Arthritis} data. The data set can be loaded and brought into tabular form via: <>= data("Arthritis", package = "vcd") (art <- xtabs(~ Treatment + Improved, data = Arthritis, subset = Sex == "Female")) @ Two basic explorative views of such a 2-way table are mosaic plots and association plots. They can be generated via \code{mosaic()} and \code{assoc()} from \pkg{vcd}, respectively. For technical documentation of these functions, please see \cite{vcd:Meyer+Zeileis+Hornik:2006b}. When no further arguments are supplied as in <>= mosaic(art) assoc(art) @ this yields the plain plots without any color shading, see Figure~\ref{fig:classic}. Both indicate that there are more patients in the treatment group with marked improvement and less without improvement than would be expected under independence---and vice versa in the placebo group. \setkeys{Gin}{width=\textwidth} \begin{figure}[b!] \begin{center} <>= grid.newpage() pushViewport(viewport(layout = grid.layout(1, 2))) pushViewport(viewport(layout.pos.col=1, layout.pos.row=1)) mosaic(art, newpage = FALSE, margins = c(2.5, 4, 2.5, 3)) popViewport() pushViewport(viewport(layout.pos.col=2, layout.pos.row=1)) assoc(art, newpage = FALSE, margins = c(5, 2, 5, 4)) popViewport(2) @ \caption{Classic mosaic and association plot for the arthritis data.} \label{fig:classic} \end{center} \end{figure} For 2-way tables, \cite{vcd:Zeileis+Meyer+Hornik:2007} suggest to extend the shading of \cite{vcd:Friendly:1994} to also visualize the outcome of an independence test---either using the sum of squares of the Pearson residuals as the test statistic or their absolute maximum. Both statistics and their corresponding (approximate) permutation distribution can easily be computed using the function \code{coindep_test()}. Its arguments are a contingency table, a specification of margins used for conditioning (only for conditional independence models), a functional for aggregating the Pearson residuals (or alternatively the raw counts) and the number of permutations that should be drawn. The conditional table needs to be a 2-way table and the default is to compute the maximum statistic (absolute maximum of Pearson residuals). For the Arthritis data, both, the maximum test <>= set.seed(rseed) (art_max <- coindep_test(art, n = 5000)) @ and the sum-of-squares test, indicate a significant departure from independence. <>= ss <- function(x) sum(x^2) set.seed(rseed) coindep_test(art, n = 5000, indepfun = ss) @ Thus, it can be concluded that the treatment is effective and leads to significantly more improvement than the placebo. The classic views from Figure~\ref{fig:classic} and the inference above can also be combined, e.g., using the maximum shading that highlights the cells in an association or mosaic plot when the associated residuals exceed critical values of the maximum test (by default at levels 90\% and 99\%). To compare this shading (using either HSV or HCL colors) with the Friendly shading (using HSV colors), we generate all three versions of the mosaic plot: <>= mosaic(art, gp = shading_Friendly(lty = 1, eps = NULL)) mosaic(art, gp = shading_hsv, gp_args = list( interpolate = art_max$qdist(c(0.9, 0.99)), p.value = art_max$p.value)) set.seed(rseed) mosaic(art, gp = shading_max, gp_args = list(n = 5000)) @ the results are shown in the upper row of Figure~\ref{fig:shadings}. The last plot could hae also been generated analogously to the second plot using \code{shading_hcl()} instead of \code{shading_hsv()}---\code{shading_max()} is simply a wrapper function which performs the inference and then visualizes it based on HCL colors. \section{Piston rings data} \label{sec:arthritis} Instead of bringing out the result of the maximum test in the shading, we could also use a sum-of-squares shading that visualizes the result of the sum-of-squares test. As an illustration, we use the \code{pistonrings} data from the \code{HSAUR3} \citep{vcd:Everitt+Hothorn:2006} package giving the number of piston ring failurs in different legs of different compressors at an industry plant: <>= data("pistonrings", package = "HSAUR3") pistonrings @ \begin{sidewaysfigure}[p] \begin{center} <>= mymar <- c(1.5, 0.5, 0.5, 2.5) grid.newpage() pushViewport(viewport(layout = grid.layout(2, 3))) pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 1)) mosaic(art, margins = mymar, newpage = FALSE, gp = shading_Friendly(lty = 1, eps = NULL)) popViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 2)) mosaic(art, gp = shading_hsv, margins = mymar, newpage = FALSE, gp_args = list(interpolate = art_max$qdist(c(0.9, 0.99)), p.value = art_max$p.value)) popViewport() pushViewport(viewport(layout.pos.row = 1, layout.pos.col = 3)) set.seed(rseed) mosaic(art, gp = shading_max, margins = mymar, newpage = FALSE, gp_args = list(n = 5000)) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 1)) mosaic(pistonrings, margins = mymar, newpage = FALSE, gp = shading_Friendly(lty = 1, eps = NULL, interpolate = c(1, 1.5))) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 2)) mosaic(pistonrings, gp = shading_hsv, margins = mymar, newpage = FALSE, gp_args = list(p.value = 0.069, interpolate = c(1, 1.5))) popViewport() pushViewport(viewport(layout.pos.row = 2, layout.pos.col = 3)) mosaic(pistonrings, gp = shading_hcl, margins = mymar, newpage = FALSE, gp_args = list(p.value = 0.069, interpolate = c(1, 1.5))) popViewport(2) @ \includegraphics[width=.9\textwidth,keepaspectratio]{residual-shadings-shadings} \caption{Upper row: Mosaic plot for the arthritis data with Friendly shading (left), HSV maximum shading (middle), HCL maximum shading (right). Lower row: Mosaic plot for the piston rings data with fixed user-defined cut offs 1 and 1.5 and Friendly shading (left), HSV sum-of-squares shading (middle), HCL sum-of-squares shading (right).} \label{fig:shadings} \end{center} \end{sidewaysfigure} Although there seems to be some slight association between the leg (especially center and South) and the compressor (especially numbers 1 and 4), there is no significant deviation from independence: <>= set.seed(rseed) coindep_test(pistonrings, n = 5000) set.seed(rseed) (pring_ss <- coindep_test(pistonrings, n = 5000, indepfun = ss)) @ This can also be brought out graphically in a shaded mosaicplot by enhancing the Friendly shading (based on the user-defined cut-offs 1 and 1.5, here) to use a less colorful palette, either based on HSV or HCL colors: <>= mosaic(pistonrings, gp = shading_Friendly(lty = 1, eps = NULL, interpolate = c(1, 1.5))) mosaic(pistonrings, gp = shading_hsv, gp_args = list(p.value = pring_ss$p.value, interpolate = c(1, 1.5))) mosaic(pistonrings, gp = shading_hcl, gp_args = list(p.value = pring_ss$p.value, interpolate = c(1, 1.5))) @ The resulting plots can be found in the lower row of Figure~\ref{fig:shadings}. The default in \code{shading_hcl()} and \code{shading_hsv()} is to use the asymptotical $p$~value, hence we set it explicitely to the permtuation-based $p$~value computed above. \section{Alzheimer and smoking} \label{sec:alzheimer} For illustrating that the same ideas can be employed for visualizing (conditional) independence in multi-way tables, \cite{vcd:Zeileis+Meyer+Hornik:2007} use a 3-way and a 4-way table. The former is taken from a case-control study of smoking and {A}lzheimer's disease (stratified by gender). The data set is available in \proglang{R} in the package \pkg{coin} \cite{vcd:Hothorn+Hornik+VanDeWiel:2006}. <>= data("alzheimer", package = "coin") alz <- xtabs(~ smoking + disease + gender, data = alzheimer) alz @ \begin{figure}[b!] \begin{center} <>= set.seed(rseed) cotabplot(~ smoking + disease | gender, data = alz, panel = cotab_coindep, n = 5000) @ \caption{Conditional mosaic plot with double maximum shading for conditional independence of smoking and disease given gender.} \label{fig:alz} \end{center} \end{figure} To assess whether smoking behaviour and disease status are conditionally independent given gender, \cite{vcd:Zeileis+Meyer+Hornik:2007} use three different types of test statistics: double maximum (maximum of maximum statistics in the two strata), maximum sum of squares (maximum of sum-of-squares statistics), and sum of squares (sum of sum-of-squares statistics). All three can be computed and assessed via permutation methods using the function \code{coindep_test()}: <>= set.seed(rseed) coindep_test(alz, 3, n = 5000) set.seed(rseed) coindep_test(alz, 3, n = 5000, indepfun = ss) set.seed(rseed) coindep_test(alz, 3, n = 5000, indepfun = ss, aggfun = sum) @ The conditional mosaic plot in Figure~\ref{fig:alz} shows clearly that the association of smoking and disease is present only in the group of male patients. The double maximum shading employed allows for identification of the male heavy smokers as the cells `responsible' for the dependence: other dementias are more frequent and Alzheimer's disease less frequent in this group than expected under independence. Interestingly, there seems to be another large residual for the light smoker group ($<$10 cigarettes) and Alzheimer's disease---however, this is only significant at 10\% and not at the 1\% level as the other two cells. <>= <> @ \section{Corporal punishment of children} As a 4-way example, data from a study of the Gallup Institute in Denmark in 1979 about the attitude of a random sample of 1,456 persons towards corporal punishment of children is used. The contingency table comprises four margins: memory of punishments as a child (yes/no), attitude as a binary variable (approval of ``moderate'' punishment or ``no'' approval), highest level of education (elementary/secondary/high), and age group (15--24, 25--39, $\ge$40 years). <>= data("Punishment", package = "vcd") pun <- xtabs(Freq ~ memory + attitude + age + education, data = Punishment) ftable(pun, row.vars = c("age", "education", "memory")) @ It is of interest whether there is an association between memories of corporal punishments as a child and attitude towards punishment of children as an adult, controlling for age and education. All three test statistics already used above confirm that memories and attitude are conditionally associated: \setkeys{Gin}{width=\textwidth} \begin{figure}[t!] \begin{center} <>= set.seed(rseed) cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, n = 5000, type = "assoc", test = "maxchisq", interpolate = 1:2) @ \caption{Conditional association plot with maximum sum-of-squares shading for conditional independence of memory and attitude given age and education.} \label{fig:pun} \end{center} \end{figure} \setkeys{Gin}{width=\textwidth} \begin{figure}[t!] \begin{center} <>= set.seed(rseed) cotabplot(~ memory + attitude | age + education, data = pun, panel = cotab_coindep, n = 5000, type = "mosaic", test = "maxchisq", interpolate = 1:2) @ \caption{Conditional mosaic plot with maximum sum-of-squares shading for conditional independence of memory and attitude given age and education.} \label{fig:pun2} \end{center} \end{figure} <>= set.seed(rseed) coindep_test(pun, 3:4, n = 5000) set.seed(rseed) coindep_test(pun, 3:4, n = 5000, indepfun = ss) set.seed(rseed) coindep_test(pun, 3:4, n = 5000, indepfun = ss, aggfun = sum) @ Graphically, this dependence can be brought out using conditional association or mosaic plots as shown in Figure~\ref{fig:pun} and \ref{fig:pun2}, respectively. Both reveal an association between memories and attitude for the lowest education group (first column) and highest age group (last row): experienced violence seems to engender violence again as there are less adults that disapprove punishment in the group with memories of punishments than expected under independence. For the remaining four age-education groups, there seems to be no association: all residuals of the conditional independence model are very close to zero in these cells. The figures employ the maximum sum-of-squares shading with user-defined cut offs 1 and 2, chosen to be within the range of the residuals. The full-color palette is used only for those strata associated with a sum-of-squares statistic significant at (overall) 5\% level, the reduced-color palette is used otherwise. This highlights that the dependence pattern is significant only for the middle and high age group in the low education column. The other panels in the first column and last row also show a similar dependence pattern, however, it is not significant at 5\% level and hence graphically down-weighted by using reduced color. <>= <> @ <>= <> @ \bibliography{vcd} \end{document} vcd/data/0000755000175000017500000000000012367374476012114 5ustar nileshnileshvcd/data/SpaceShuttle.rda0000755000175000017500000000075111566471044015203 0ustar nileshnileshR0RPOpxmx)E;ϧR7On7KRgƘtl[LØkz[`,{#2Q/2 ͽSO>rnYTIŃ̝D>bF L|ȿt; w%DD"GCKD<8yp|ߔN3vcd/data/VisualAcuity.rda0000755000175000017500000000065311566471044015222 0ustar nileshnileshJAggWAz@r֯F@QgmaZW#z/GIYA߬g; n !Pے!ѡeII]9CZC?%^dV'o$~ݪ3mYtzx@^zJ!ԇc}|__݅SXߕ6Akmf>TH)ρE;Kb$ d_P0NH>Xx+ꇒFApl|}wf5ˆݒJ.V-/ǻ8{N~2?Ӝ^[y?3PPPPPѰ @Hy$"H%2R =z0`ЃC =z0pE}q6x m'xDvcd/data/Lifeboats.rda0000755000175000017500000000113414133313352014471 0ustar nileshnileshVMo@|B^B"B{Ԕ^r]GvrOf3"M+By;;v2L}0x#8F|&i8 ~2K'hU-zo="v/ {{A{|G~ ض/rz;z+TŠPqߝiM@5vi33e|0„&dH2_85wtf4H gmxvq2hU_"< x]؎B6(Dtap2͋L&8/>j`#1~'d8S'TGoqޡiRuԍآ6~k1a [m&3ܦTaR)ss%bޠr90Rz]@Xܚ@VxGCDG<=;y3+%ZC}A{dOɞ>g-z^_'%6XUQMvϰm:SJ?}_ۦO:6̸W3L/ s? f{x vcd/data/MSPatients.rda0000755000175000017500000000041414133313352014610 0ustar nileshnilesh r0b```b`add`b2Y# ' H,L+)*(883CV9V:PZ`?`@M>8~-Tups 0`pu:0bNR &HДq%概QV"ZTSP g"]KJJsk L<<3// 5K-W/IM+F+W`PAq$ ~E9%PiX8  ~jvcd/data/JointSports.rda0000755000175000017500000000074311566471044015076 0ustar nileshnilesh͓O0ǻ10=za-?FQ Y+?ͿL--tk_off:BIA KYTҽi(d0"dPM%Uʁ\~P+}[wItD?B^ k}Yl9)h>\,/DILSKhs_=c0׌Ěa#;> VV1.LXs~]L%^m yP;pFc@NB*ӲdתlΗ¼F +N#~&ݍ5W{-&o=9K/wxKn$+ _/M#'qFr{}Z<"醭 FwQԦMY6Umj`LFG1tEt%tettUtȠȠȠȠȠȠȠȠȠȠ``````````(4Ju'ߓf!߿ 5fvcd/data/OvaryCancer.rda0000755000175000017500000000054311566471044015012 0ustar nileshnilesh=O0/i6EJt`F"&*b1u=%.&@6~2!wJK}_}?Z`8BT(ݻPfӥ'+!:ű\wBƹ?nτ:cࠦ\$ '2-U/U7OBRzτ;$qSEl^`(9]+ήS^p=. vYϵy ze]q-J1P0:Bvi Ŀ."(IU URF#x+/̇ӼQV2{o!H$e7G0ϷBDy8E }pWHi,]iybig{VIEI2iStPڪȃ!sύ8:\nHY=uf5G4AJD\#u|Y ou#d7Nⷦ]-$sExBw 0>qn>]Z &Wߑ?ܞ Ƃ+Ph;_uTWi&}"!__o` y#٩O\HN;~&61淾K~ o@^r_G_b+o֏F&BK3NB((;i{hYXWg;J3UG}{C]Џۊ"XmYS則Cm)jߐU k,quzlVs( _9?iJ^;y۹_-wAdu?LIZ'z^P|_jw)n ]Uv΢ГKfB݄'N`XУ=stF} I2:yK/%, g># $?z6kH"]9b6Dό-i¿c.@N1:RNtϦb0D}:!uo'c2 /p78\'<%&~{v~iUl $fףb(09oŸCē6 lҿX w :R߼c9O6f =ػMOM).w~hޭ TwC-sVpS{אo u&Y3h$C'Ⱦñb=dW:#ezxo=|N?;= z$u@M?k&qqhѼޕ凞#,;wzN_!K,4'dyFVO畮kk7ӇLX8Z>>>84~yŲLX+Q@TPAK~%%%%Jj4(iQB 28dp!C <2xd#G <2xd! C@ 2dB *dB *dB jdFjdFjdAdhAdhAZdhEZdhEZdhC:d萡C:d萡C2̔c2QD<&fZ&2єd4%)MhJFS2є1hq1hq1h<3h<3h<&0h &0h &0h*FS1T&]G ū?Z8:^-~(^_Dvcd/data/WeldonDice.rda0000755000175000017500000000032214133313352014574 0ustar nileshnilesh r0b```b`add`b2Y# ' OIsLNe``p;+0/zeޚ ?[ oz]i ̜ xB@kѤ9y@ CA ` C01L` S 01,` K(-Pw69']-kIbRN*D5?eiL"vcd/data/Federalist.rda0000755000175000017500000000025114133313352014642 0ustar nileshnilesh r0b```b`add`b2Y# 'rKMI-J,.a`` bY ic)@*͎&KM-/ U#Vg41 a #01La 34kXv͆ &V芓s$&BT36vcd/data/CoalMiners.rda0000644000175000017500000000053512367374476014643 0ustar nileshnilesh]J@7I+`)x u!$٪=Jc]m%Mk(zx?GG|Yinө61Y-u,j3XU;(>&r2fTf_c?+_O|b%#\%_A(QwSb>Пp[7)-bQIcNp< ZݞȦMR-*[zfsKAQ ZcsӁV6w jųOpO+B+Bp^a2&B eubZ.)d>T(dp=|vcd/data/Butterfly.rda0000755000175000017500000000037014133313352014542 0ustar nileshnilesh]= @ A" bA88T Z7xIpso^nUm[lj2fu̲~J^VC|ߙ+("g#="9;w{6OAxjHO+FWžfW Dx$>ɘ$ $Slclۄ-dg(x(.PXN7K?$ChE7|vcd/data/Suicide.rda0000755000175000017500000000362414133313352014154 0ustar nileshnileshoTeORM]`fs^`Hi;ӋNH6 EP4 qҥK,]tم@i}4& |so <wxWzRwSjz[mdqzlzyϵvg[yUfrߊ^~g[CdHtJ,._˚UnU\Vd|˥\yFk._u{Kd^~^K~r~s2;.] o |C}_/,w<.z}NI_IޗuGJ)ɫw$N}9=p'}:zWGd?r<|$:U.˲Bz֏ɾuζWֱ]2\~u|󪧎WumCMG$:*gLew[|2?>TN==!z6sH}kIRg_/IyNqg$e_[d_PuGxE/uK}+\~z=~p9v2h}z-o=psIkVYɯI޼rn%߯cr隤^g'qT㳕zj{үΣِzZa٥ܯgJ|^?'O?͟ի/u?[VldRۓr[gjk3VڨXiDmm/ܖfMTVQ6W]{^=sZEoQS5E]ҟ3^o>=_ yݾP2=sQH\ ޞ/@}ape+^Q_?nv(e֡ۡ̓^gp3י|ٙ|LU:{cq3yҙ)7 m6cgᱍC~G7qmp+{[x>u@NXl$bIY<7ōً)j⚜Bb~wڼoy7j=_\-Lu:m5'E]6W6Xol tڰ@6+FT4J~Z`Z"kJZ9X1` ƀ1` ƀ1c#0} c#4Fh1Bc#4Fh fP#2Fd1"cDƈ#6Fl1+J)6Fl1c$H#1Fb1c$H#5Fj1RcH#3Ff12cdȌ#3Fn\fglllFll&ll@Hi 4@Z@Z@Z@Z@Z@Z@Z@Z@Z@Z@ZHZHZHZHZHZHZHZHZHZHZDZDZDZDZDZDZDZDZDZDZLZLZLZLZLZLZLZLZLZLZBZBZBZBZBZBZBZBZBZBZJZJZJZJZJZJZJZJZJZJZFZFZFZFZFZFZFZFZF]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %K@.]t %]%]%]%A%?i.T'_1,6vcd/data/Rochdale.rda0000755000175000017500000000101414133313352014277 0ustar nileshnileshVKK@ޤƂЃă_تuM Y1Em3Iby|$!W7[ !$a$T7XdJHu>!?h.eQ|QޢEmd\\w\:j^zrqpqAQ^EZ}|jZrQ>ùquw Kȶ8I?좗{Prt5ϔ= AB !};CׇeKxBy pK)%/h1-.| hN/R (Q͈cp{OB @ p = JQmϾQE+eWk}[RR\zp򘯌 JUr2>m-CiډXYeKJr,(ONWiӽLʧ}U:+f889J41UՓZԇ'gL fEObb2Q !gcAm/ +S2#%?r ,Jq?X@k ^X)MSm+=yREj?9t6PK9[ kikC+ҳ\΢3*2C'=RTLUf-8Vv898S>1"  NۇP 78k!i;qb մJuҏV6J۽pg`PPeY(vdv-RR_%ZU3T\d7]Z2 ]AځGlޕq/ˣZ1kZzjZ*ӗGƞa9Zvw Fi|r]M z\QgT PIx8g1C $XfkfemzzҽXIJZ{j1mcvo`r{CC}w}}EB UfPyb2hwZL Qno̾gҾ1}y1Z[ 7G5`ٳf$O-f^=&JsGʕiʹ|jكP Jry|t℟Gc-9?XtDP +"q*^c3)f<֡냪B9aHv`wX (aTLZ%9AȡSͯRg̊C oxUu3(f8:=PSV8Rm%J a%sD9UU WKghw|ӸP8:,"IǼ[8TswhΎzAhMqfOH6+ y≢4,潕JqL77T&Y}ձaiQ]YՇN|m՚'J۔:EfC#jiX=]E],p.)Rm¯#gu"U]Ъ|F~[ A1mM'S W9:$Bj C#E)jn+ǪЈw8YԼv)Z("n wdO6y_2\+̎_0!(ZM m@jxGj2n+-T4nܛԈJʀ8_W(Ѩ~WQB-y >VOAD& ƓqZv'Ξ -ROڒw-{BK>hB5>((R]}ȑ'/;Z6 o&kR^ đ``qo7-49x,(s˵~;ĦVPq0U+ԻX|K^.䣆! $^Y+yrM SȔgU-C h䱡,j8XUWngiXUS_FQ9O:m*^,#<݊c!C2!{Oﲻ2J xuFa7л"imOJ$08X%;䗔Oޣ$:)do񌗡b d)/Ǜ3^lT!(7JMWʄO(bٳ;(QZx*NH2N~q!@)wT?^=s =! u o۩e񾐇MdjȧXasYSjv3D'oTZ){ B`fWq2Eߒ V@AzE%V a$;K*XVNyx)2߅utƘ:*Q =]?utOׅttQIQTsJǨ.TWѝDۨO꟧OW7Aѵ]t]OPRGt}\*=ʋ3*?Nеܕ-?q_Kz!]kw_(;%]C<1V^BW;ѝt-#o|]t 5͡2/wsUKTz. t.=?Dwx=Q9*Mwt]m&r(ԍ31wkL't7L;5gtŷS+T^BYtu;z-(vGY#nNcq_LnG77:y24}LL?# 됙_q|'1,eR;/a~]'T_AtahĽKwr6tŮ H"s''ېcK(ft+]X6&C͏|1xb+f[D1lBNeHp,:y?O:=.ư=LSTn辍M_ K7=϶ONwL{^X8ىy{N 6 !ߠ-!/E0 !:#퉗~%$ՐaH 鮹.R` ?z<p)It>®C^BׇB5f8x0]D C\NWqpP=2=Y_y<Krn>Htz Frb`׾Gl!r|uy^,##K<ޫv~ 6ix ?8C̷K#L *~qDŽL@-yXt;̼>2. z1?O0lÆ 4쾁 fƁl.l<`BIWMZ1Q7 S2{N7x10|^yy{+7G{}iq:mx1sпk_0Y/: `H Ow2~LkȮCl>A4\?Gd2~, ȽKz~k"_ xks}&+0Vp #8gyÃ%nmn?q_, \jbp+V?-+2 cIp a^ }3G̴e4ZsXXɴ~1MMknb :~⶘ċ1 62[,fݔ\n#y >| A 7WWr;]Q]by ÷.1hf㧕̣5<[o1:Be;R-U[~{~ϰ0u ctX6s`nAC>z.C֕| ncܷs:.8'#b|y,>0>_x^sa ƹۯyc:pO6C 2-L̵iw- qd )c|mV.;a'070͌m|mlf:}ܷs \dKxۜaZmf~Ot@<Ƈ\ȼ:W?㸒) mofމ=lbz }73<g <9fZ/dCU_pzE<ȂU<`_Ϯ`zCΎ'7;㳘bc`ǔuJ~wGaC~'׻|A*Fuh n`]t.1/d?2}W̧qq[i4]cc pcX1n |c'?mh\Ug^x/wy+h1NO3/ \33e:]8r˙ &-c6sVnѵׅF^œBw1_633 g:Y*J*X`\x/bz-fdA~lb=]{%ШNm!Y{%rC,%uuኜ$ ׇhF~! Oʑ3Eϡ;_=5Gߣ$o _H_nL'9XB^Bo~$߭4GcR옱6 dx#YQrXuS )J&u3:@G맑M/bt,FٺkG%Gd@>r~w r1oW.w:\d*KMk46tlafӋig6{N~eH{\Df&'K>@c ː.D;1Q/%ŵӜ3N>|<|ͻ=&ksZM̐\& 7!{>"'#zs^_޷>ɷ;/&G MS GhcSdO։=}a:ɴz{G_2IrZ`3^A<#ߛu~ɞtۮ DžF%3n~2¸]}. #/0V\Ms9w4G\i7 b{Fo1 clHe7]ow37p8^f4/fhh$5^ F~|FgkROME )!Lͯ@/0]K#OH 'cw@Sفt'#cζ8B>"7zCW3#u$=M_Fnj]w/as!O`wc-h 9G -1lbdobxح#,/s(C]BGƞk}MbSca'@w,4ig5ټ6{BgF | 0Σ6]ě b!hـ̣,k{ϐo8:Y[g2'?Vp r78Yp(x>'ӭaj銘hŘC.ey{ae#QB5gXܞ9 ׍S\o/ 'Cm{6 1WX'.##ͺu`O`Os8Y(_G.Fż\mb8M3qV!?r' ߭^Q/řcd&ubVd K DW^ ggjW*C k8n^?bYi5| '_'Bq^&3@Xs?A.p k%~6~*1.N8_X~)ٞ'\Gdktg} ?ƍ;ZX.%Xo .غ۳3$s_wa7j_،Gy{FVƉ1trVFzzC;|bݎWNl v {8CGv"Ct`f|-'[^6h6% И \9wC}n-{3+F\}E{V9.5Pe š <؃6ۜ5.ş1 .ցAsWGQ==0:D|o~ ?:yKMn~6V-FlYp{} 76N$ayhi::yGCtcձ.- |繱93;ߐٵ܋ѯYcl|1/!q&6%Zď a7o^Y.O0 Ώw9[_? 'Sس:F[ Kı!q#9掾#s%>팳V>O8bNwo}IJcРTșC+ '/0-(~@Bgiho6.񓎮t;O:\cN|:{i}ʌ+v>cov2E1I#þ 'O8E>;b 7seW31|ם2=3ڝL[hyjÿɦo?p?|B|r5,gߊ8fN^LGGJĘ8?ipIU}^1b x~oد,ox''8lm.Ġxbnh ?\#@|= /֠qhsk+ |+)\EL7B_| a{yldu#^GYO9$+OX6x{mcW:;IIo#Lƚnz45uOg3L;\s{D?ts gLzM&gl7=fL:0[d=XslNsw6k6Fpmri[zKx C xKAφ,0ϔs\K+V3|Lw. l8=GmCz\*7_Do0g|6s}7,6c`5R8Z$"զ?ۀZ=2yl ܗTIInKq8=bCR?%e92zTOq3. JJuYX|N~ B>1v9Rǖo9jm峟da l#H 5{-L*i/xFScO~> N_I9^ʸ.75n,,bZIJ Ly?7z J?mZ-Ksl4^RދXiTx€_!_e\/"̒/"oVhz)tk{џ>. 3*Y=J ǾVfr^XEDbn+B9\TB#I39z%GĆ-9 (T[mxDn7 $7ЭeM]ø%)?cLGʾNd]Kio]~})ow'elzTʼnR42{m@}1Bϰͪ)FF(Lޯ1%|9rFM/4T!A;>bdbE^ĉ0dB`b)]!`a0+AT.֡Y eF2ȌȮ%;ZmQ"8 DV\c\np"aւ/~)mߦR*|߂/%?^nV_׷~ـG~|\is >î36do n{Tj`O.mܧp,IrҔ87h\Z:;GQ$s3e>H{?eRHIǧ3rצOY|j?"% 2S >ȸOEh&$}Ѹŧ';?f cG39뇴:cYH!ϾH+106-1O$qsd4tTG,O3O~~gp&'?N۸tS}n/io_2.,[ Rʴ>KcH;Jsç|f`۟f?gpLl2~=ƥgy !I<&>~3p,G\ ت3nϖ4JA")y-d&]ҏsZuNc|Zm68;r9i2?~i0H#Go~7h^'GKuÆ,HU|ŧF`~C%>"}% tq㎏\-.qwҘH>HM@ʊMS{\~> &,4 {æww' vK6tiis*_gYl[w PACn. ?@>`hڝeY= @\hѽ&Ini ;HفnS[s9mA~DަmÇ#]C*96`B}'s!K]| Oosx8 v r ?p6E=fl\emǫaЊR<0ot-gt"?Ua=`ʞ/+'Nב}g'u $엽Yً>7_)si`JYύџc0SRD ~[ c[٠,޼+aI^֋C}Jy'wr~f3Ǭџ@Udqd0)4HBӈ1ei)|cns- cɾ|oi6z=yɾ|w%Xd?:\fШȞ|L&x{N0'9”D_=D/5*"/˹Ȯ `l4]E7'Fm"~-sr~,4G.tۈ.G}=7eyɇK/Uy7HS·z^OK֕rwýM?yۓ˿O2.=|q<~ D}}}c蘻3=oX<՘b~G;0Ue~՞vϙo_wx#bwd~w|׶N2S(?PIc;_S~3%{7_;Α;[>lxsgݛ~*6pkskk.Ztg\g&%>/\Ifm&t8Gf?\fp/f\25\Φӌ?}nlLkrce/&̍g;7V~zuX{:$hXIq sc%7rX+dˍ=Lsc%hML2率+?|ש:Jj'7VdnL+?wJZXyaه3>dO:Wn ~͍}יrc<۹l"{?7xm8Z3nkÇ[Jʕ|qb8!㎔'}-?R-e>/ lV}c" ~% =(_ ܨW>o úw (*uy`-_}B6sKcuƹ6atJF*ZU9X8͂[43mN)}ALmõGx7핥j93jPjeF4h0۸]*/hs;[3uEj=ғHRӯMW$z&XTV#Kv2-ȵ<$@III qbO, !%#F48ipAdsI' A4i!HCt~n$ܹI}J0vcd/data/Trucks.rda0000755000175000017500000000071611566471044014053 0ustar nileshnileshJ@7icmEQУG"6UoE^D{tM664&v*(xPPx}}?732_4S!D'ZR#Z\`\ОU^UB"2Dv@hpT p8Z": 1Cc#~ v.Vd v(dAtLBo{7=n7#7URnX[MGͣM0fӱ:JW~^}vڴPC~+u=4 '6L}|x Utq7esn૴pe6N$v':mrA09)<4 ,kfRQF((hJQ^ѴET0<;iH'.v4^>Jvcd/data/SexualFun.rda0000755000175000017500000000034111566471044014504 0ustar nileshnileshM @/RA:wdҩz_ a3;}qct 9΅Z&0hxr_{R&HW+4Ҽ@b#R׈,3WQӈSsRx2 GX}N +SJ[q^ VVA4Mwvcd/data/HorseKicks.rda0000755000175000017500000000024214133313352014625 0ustar nileshnilesh r0b```b`add`b2Y# '/*NL.f``q.;3UbN)HHssSF2 CA ` C01L e6 &Ȟ璚X>9']=kIbRN*D5?vcd/data/DanishWelfare.rda0000755000175000017500000000212411566471044015307 0ustar nileshnileshNGCDT.zBQTUys7mISF@X?ҵi;?Gi9)Q+[2xf~;;3x#h)zTkբZLO-V[e\güwy-~\V6F2(SAdr~Yiq``|-pV)ާGTzv܏C\j𹥸MS>T>}A{xgu/.󼣠 a9k]b>ؠܥ3zܟ0?yګ}Vm}:E^jo'Uy\>w?]f*>%LOns^7UMvRw4fO,?~]V<ɻg%F9\'AG5.xtG~Υq6>?(ghg[o"ԺO5~>iN 'lj$$kdEyd 2 `( `( ahahaha`a`ǥaaXaaX`8`8`8axaxH`$0 F#H`0R)F #Ha0R6䑹L7h[I%5ZI^DRbbbbbbbbbbєhJ4%MDS)єhJ4-MEӢiѴhZ4-͈fD3ьhF4#͈fDYѬhV4+͊fEYќhN4'͉Ds9ќhN4/͋EyѼh^4/-yХlmzyņvcd/data/Bundesliga.rda0000755000175000017500000015070311566471044014657 0ustar nileshnileshܽos\u滺A ȦĀ,whB֘HedI*JyKK2E@r7lF;醓yuQQ>ϳ^{?U5n]fUw.^߽x^u?U.//~O.~.~.~/!C^@~k0O 8?:8s#6ؿCm9eydg!(] x=?'~GVxwu!RGu7b)v5[w`{ {p 0p XOY./˧ uY'.)uR ?^?O/M_ /o.:^=|`Uj:ÛpIy]+qngqz;TȷMXZOr';XX5q纣k'Vpʷu|P9xgu:<č'*Խ]^Hk\_saX7@8w7,;vzv%V|;cg*kb \s$ rn51_GW7q<V?4ş)9YgQW˱MX&n<^UyZ=0*.v׭[_gO8Gv8Ox ^ 8S`o[5T,u&YL\dk8?u=\b*xg˟[qg]]:ΰcV>3'zd:|uqiy֭5,nSzauX=}+qz>^eXpnU+aܪֿëb"ĝ7q}b9Ai9ր9Zago:<~ |j58 xn!w*}~Ա:7==BxP#|^Ku~,qGÚ!+ͼVc= A殮CI rx3IN/x֣j<60uXsG>]oW;ǂaj{ZbzBMg;0ȫuXA:~o!8q5=:H0bWWz9vfΏSC` ݀?ή0k|r%[}?8ßm|Du{PWuuGc=Mܠ/$6l'ެZOwWz jwb7 =۔NSX=xh-88l#Ջ8_ƙz)~85לVk3^o8c^]Y$gqZǟ)Nżǟ)Ib?̟SzjԢZ=逅'{ɰv?߀p~k^L}nA݀<33v}<=Oz͇??1]ky\>+6~9[j]tZ7/N6ZEܩSxẘO|}WreLnG`O:8qlQzqy9ea 3ƺ/p摰V`d"ta<LuQO7[a}m8?k;ݿj)eO;]ux؋ 8)O`ˏՓ))zXӋYoI}kߛɁE'Z |Ԁ Kڗ 8?(l_סLMv^g^xų/LN :Mxn]Ƴ ;x{*\>ٯV Ŝ !l05zX1/s &{%2?jy/b{>ϻ#tpL⁵j7vF3񸖳KbM`q]Ts;S Xωu_v'}Xo ?8œ a=?Oak{QLJnygU=Zu1ϪUuy8q}Jy|r8˟`OGp\qn0㳔㗲Oj+ГxB0 <52KHg4B?jT8<cjȴ {Ov7N/:=TLya{0,;1]t^i5/kܭƟǧ󳱦ŽǟuܙT78Î y.pǡ)^2G5l{+j5mE2]Dy kq6p:mZclk 'ıoT;&4gXiWp8z8ԅu)*/YUL?a#˵|/{Z ?`myHة:p< 8ikbq:Ǻng*kzpl7 {:cĖ{u[y!<9Rkvtns~/sfVc`u NƝ\%\Ysѧ9:mDf% 1M&q]WxNXCW?Ћ;5)yH1UǶS+γ&Sq9v9ѱr"׭-Nk%valwk9 ͫ}>q P]m>9)Ї3`s(ysp޶ zn PCaI)[Hk.`#Gw[2=tH?K:a!;UҮX0|8#pߴ] ҋu3i1[J~zf}N,H 鶮?`wלpЇڔfSgX?0YmLróuq=?WxIYftossn^ǟLqq'1z"WgA猓l8pﴮyqbɝeOts5^51{9:y f/0|n}6߮񽗉Of0 tv\gI?^rl~;t[O.Kv ͟)J;)z8j1 g8j?xs?@ 3\xL=9輀`>rot;cS5ggOKq~ZL3(Txg9E'4sij^U3#w0l:r9_c$z,6Yc8sؖ"|q>3k8ﰦ9i;1Nڴ.=|Cu<ߧ9+o yς ]0gcX'jcb=p_ͳ[޳XΧonNjo.''ZgssR}Yx%&A'c788ef^h"5xOL8uw8u2~x:bڳz7 =/5?}]ȲslȲlr"ϭ &3E8p\ϬۮpJ0d+XؘvYݒm?pSc̉2l 'c{zⅾ胾'?a9 7[=buJ?T  e8f>~cfq~nטCiׇ0 YY˛uF 9j<;`>`|g3Zo~_X'}'¾pHomA7| Ϫc պ7~/>u_|۴0+&Gg|P82:DNpBϻ>[or^d>_L]5ɟMqVܝj/V?vğ<Uɀ3&xƠWEٰa^;-yO:yScx \<JqxxXvUgc~:>\٭iĪZ0ŗ <3 +cxSwr:¿j߼|1GJx<{8?rc5ȦoΏ}+`LdFCk,x'b ֺX;ά=̓|NLpz}ȉ\D!7S[7Z-{!==sr_8'{5_'r ^ sjZτXpqg{YC2Ϟ=RȭpV5>q)v/=pW&5`ڿ]\g>Gҗƌ\L `a|o%HD:X|y+s%-{Y ^c^=İ>},Lz˙CRd;gWzs "j98̖wq#N?՞Lj; 6p-g‚?v 0P$õPxpы3v+6~vW gޯA6z{اh!u| /ғ;; l߉drv>lUW*|y#c QLXmr}6gC?ѝ~?/Cs:< U>gZg<0>·EmW8|5k:<=uunԺs9p=: gO/̫}o)yh̕m.a 5#zFq\YO9ς laS?'Emo07$ގ59|<b|לNipݭg^ybYi52#߅@e^^Te;sΊ3lպgYH u6JӋ¤6!ZNa۪; V/9ϼPCXAG|yK̼3`Y7|g=\T=O#̣uZ_ k]XjU^M-D}Z9/{r̨ 5:U|Y~2"6 w{kd+YⰪq>ez-L|Wq\U5c'W'2T'p8j{'?PHXܯ>?S~,)8V6},8j}%su}N`rga=Gkm k7yI:~-rIqy 65v5.Uۿ\\?VOwPOKsH+xc^~K6qSm#g, yczcŘ>DEV/X I؃cyh%]g5֋02*n_j٥̽a xL}&?=˥5{'z¢ ]5~ IK_5#a 9鬋>G§ }>y]j72˸Wnd {OP>'þ,z#5Q8/߫Ɲa xcW-ju=z0r~Ω=%OO :P!?6LcS4=ő0=w{~O85gI|T_%άƳlzu/ ]gY/yzvl> f>8<繫B3{2a-Ag봨VۨE0󚧱QYϯg`8f{0/PCcP',=D+1 ?Qٖ{ =-ᒷؿOA1BKk<{Z;q_<3<3a=:|W?6F1[!6șaT؎.O:8TX`lx&ߡg/?g`& ZMF'x&&1џK^K\7L<,={M?xXbxGf>T?P^S!WEJg8E|I۱k/p^Zb?zXse<0Їյ^p=Yr׳Vߧs$j ?:18[Ыr#g%%?ΰlgZX {<N3G8G8Ô<~_rc_\ݪεsl70ެqd|S8V0eటOlv[xa[(nʇ =zl=׉.)/{nUu9jqGjnl,<yzh֤0'~ý: uAX~=yk>xSi)N\=>}τ&>Kςa\Y5Ray`q`U`QG9R`vjL#v7V'^|"g q]Tۏ{: | !/0o ܹ>[/7ݷe\NVxsvwo_ 7%/}Kߟaxy_<~wg_l$oWy?wٷ_z|Ͽ/._˳^~|6ݛvvՋW_~?ߝxfg_~_{b_>W,7~;?|/ ݫ?8׊{|~훷Ͽz ׫_+݋Wo/P߮>?՛/g/Οb߽ċ/^}wow/Qڻ ۓ??0ݫ ߝys_o-xy/~ O~}Yxտ~ÿ>;El~o.Qf\ rY_R ً_|5~y?]D;r;~onݛưtAo}]Xo)OV\3Ņz[bwoŅPto.21zvCoVpoY{Tz_˗_[~?\`ͻoe_ۣw~W߼"_oߞ]"6g?wAoW߽ӟ.g_2J/_>CE}˷//Jک?*%;wtoԸepV۽o ײq*өw\_~w>Gj'վ!/fßw'[x~g_u:Y|G;,k sbxjicF<sH{&Yz}#Ú?pzg}ƿ_G%_O>bf\ǺDžE~}x2lX9pAt\GĊ5*W<9;'^^x3a T`mN0\rW:vGޏ?qk%8w?5Lu1;xSq/}g8 3 j9;8==8t9Wbi^R{/\Iߣ 8$R0x{uUMٷ ^Ͼk`pbݚ yI~5΅ubO;kfb'y6r㨃>غMO+qnNq5k eCmxzߪ0qZy2|\Ǽ%8E{5[8ȼiS̳^]Jwt%GW?O#q ?vF fO=]nUu'5~ r~.l1dײ` Bޫ#Ppɝ}_‏ Of ;f(w7Ʀ$NV5gԻ =4YGKSd6*SpgS[bZn p |UUKaĩm 啰m#=j=vCpvgxf8)dCGc.o!om;{14Qm hT{gkl91?]ISb-`)=?v5հɀayf0X'[uZ0vf\ո/NkZtfcɀ56™jt*ְϼÇzu )|o9(q_3a%_TQZ3l֘}8<` #8~`Ù5M <.UlfgpꪏA5m_}ɳf [79j. S5:XWId'/qXAѷXֽ% g}tXo>sܑ'Ϭߔ2y:.'}jOգ']Szá8em\+U50Oo!%|&.kp8j`Ϸ;K>vt*5rTvjR׳\uZ>5<g5`or?6M]SLS+,=c0]ɵ]Ƀ=Aۼ[Wm[M`Xߟgyָ/ԃuQ=yǥg õ ɦ/VB >1Yje7q81rO&KXqOqPlz՘=;Kl5+' 2n/.u{yZ/c o [jʁ s#{:`?j=ms [+Y50Z#Y|B~Uclk`x~N_zpC:d\6GN6\ìfkd0&`^|0,O=,l<yiݺ^&d8Fq?gɼsV({g=-a|0!gX80f:N`+؄>b{6nro٫IVZ@:+\ɏ\s|3bo3ɩ]a} <>Or:m)wuxhEk`Vu"?==1&T{d? {Z'/݀ȧ?/׸hoC{!>Д ~`Z?cIi#߂1}5lBoz`Xz"ğMdž|n)#3|jq_0<'f1Gվv>wm7-9fƽ_cSnO:aNa[kM̒O-xRj3llus>61ğ<ހSŋ5NX<=*õ`N/vo槾8~LclߤO s._@ܫv:jp57rWs]Ǫ'µ,OYi}~odDO9zFlZ8jߪ/c{~`nrv×}~!ۈvz rًg\7-u#u;*AG>:JN9?f1q֦[ɜ qOHKzj0zo'5֏9bkᢃǵGk0%9i8%oz}ebYR0i5̥loa_Qeb;ݿG*p!'qGX5e*wOcA<؃8=]L!j/XGo %=q_`YP!A0X}ϳ18l$1ovm@{c{݉g|Lzڳ'j-zC덝b&u>r`a}Lop3m}ϳj{O:mk3?La.ܳMqǟ?ޞ?dw/c+v(L5o g2'ϰ{u5,;A{31Hs$g=9 `c~!FW560[T;)}aY\) vPSkܷphZk͡8ݓqot`B+ &yτ;#֘M`xL%_c>4G_bOC<7s|aYrgCp]IutZ_g 1Bzd>Ϝ5)wa={}lE` oPfl|lgyIvָ=~ྰAvr|nuMท貮ڸ;Ef:[绞?ȱ7K|FpuD@e:܇%dpxZXG<~'\[u>DqF x`{Xg_}bmc?6 yZLۄo[{όQCί;5VgO'cK8NjЏ;x'|~m|VW}23y7cz>6.}{{{~VL赯39< ^`z{y Sa%8 A_Ǧ]gL;d{ufNԭψ%o[uV|TXYT$xӁsCEb9_FoơŷҟoX!2Tvw}a& bu{%ާ_To{*;jO}fKNn `YSɯ:vAo%]AGϟ8wvk`ۖt3a3`"{IlЏY{K$֘WV;#cnpKoi\3C0s3a9SO/fwYm<֙~kOa wj9|bOFrήpݗE }ϙ8Nߒ[IݩVo<;c'}3a{I;^.}_v]{@lی^ష&y=G70>y9 zV{6ﰡG0>VC;GoQbmz y7wbz.xݩv~:lح>IMbe܋Zx@M@;5ؠ ܤ'yҳYXVC~ygXc89K7k`CV҇]CvoFjpJ`s3Adj{VmߓO ,|ơ 0Mp;p%g` ic}J n]Cԧ=<~̿Հ}+~?g|8b.P|/q &>"SjU؂zM:&6/1Ok.1wtݩ6 }aPkZʃߟ-j\pnėD`3g0K/| ,u-["<ξOLqGߣ#yld}bĄ:qUK#X o=I>^։u!>^Y yk\|ìIܮVKcO8;57*0]*&LY܆;XD̅{֝p0sfO/_Ak1q1wA9 ^E@O8р,vg8yy_]g[Ϛnf@ g?mHQWH\prM|O\ksl'Pk\ؿ39 Z@=E> 1}k]s }8ہz0|oZ|U8ȃMt}zW^+;N,IGCꇯ%N,,zmJyh_6B7|*IU" ; ٗVXd^ٟ3:9q,[X]V҇u/ bx"yb#spUW9lEnç5|w|;MN`q1}fz˞Y=q﹧Cj7=۟V$>yg3u>. p$O]@'VۃKV}>}(j16K '硰Y!߾pc0c.}a{'|J̫>O9ֻc,sy`J:syV{ո{-{X_ p!ǔh;cs0x)ְ>滑VҙZ\\c7A-XkG,kD+RCN zjMن:.j9ڬP c)jstZ;sxc]a_.}2r.p"Lܠnf\Iv}u'k|\v |{ {0=Ə[4`wy8`R~\6=% u>'5O'y/A/ð {wW%KI XUzCl'5;8&'61j=ɀ?5{Rg8ۃ # yp1oUpl5i}/znܠ߄kgzY.r6d`_л5>=CAEu'cƙUkZ=ƽj y6:O}.kޗgNzVj8Ч]۩^DW'3{s\L^gBL?q0 e5`+X3Uz 3q/У{̾d̞3>5j=|".ɗdX n}ӽ t&ʞ?؇0U _әy߫OyϏX"}1/@w{,8^zO++؏%O carM7mz|f|ͼ'Gf Nqmlts^ u2{a~9Խj7>ܧ5zaD2kp\_74pc}|}҇p4plj|3{:.҃3dq#NC ơgle8t$6e},:8`v>~t<=* Ls*ϭ 83}=~#s-k<~\ȽdRzo0ݎؕ,ra/pvszsCzl߃3a"|_?X85|#{"y}_vfϦR/헼C]_#N-=a߃-+Spsqvvk3q^y}8"y|'vr{r9q \s w,Lf>Gy|4}r ,d6Z?٬' vuoVaQ- 38U98Cl̀ú7>|ܫA}rܟR8^?0}$cv 7_-A?s ā}X՞]9YƼ~lW;p[.:baž]8=\̕^bJvGnn ⊞j Ϥ_s @k"srgdk /j9<v  rCa!r0= XMCar~~;i.3$GrT-l}ϝ,y ϰC>)5??,#F)ً>u{̣j\kG/@][`ԇUyCsWҿ[[Fp-3[A|TX:N@?e^Y :9T֥o!LbxWj"{u|g yO8>lgsq/prOw&q!QEwԻ /.q/3NVxsvwo_ 7%/}Kߟaxy_<~wg_l$oWy?wٷ_z|Ͽ/._˳^~|g4^^Cjwgś7?[}~vKݛ7ko߽b߿ߡ~\g^ŹVo߼}fx_߾^W_y^z{~vw|<{wu~w[E$^~߿{3{_マeޞ/Յ^]͛ >zxk[&ޯ [xHKo#o.b/Ʈ_o}s_P7z_\ꟾbo^|uvoo.w/ w"Zgߑ㿼~;p4}^ \{’__~VHWo/ž/./޾{/.\ ۿ>s/a׳zcFg2 ן_ҋ?Z\ۯo}.^/I7g/=Y=9ꅅ}JݟtA/>ŗmQf\^v_}}]IUm,ߪ{Cۖr^ߊg_ZFut=jcqccԑgZ55Sbތת g56u~Ћ5gq k~K2^2>t}u؋yo?ąZpKr-f0lvyupjMsFגk_;̫#TfČkm| ky]C&c &p{f\g:V`:^ѹvKc{r ƱYWիCirVe{ٶ`՟6{[w䩃s^?ۀ7?3q߬qrz1zU)z!kn#sM%kkboV]˵:^2a둵yVn k{5r?=1ʘg?ox%f+m[jw'ٯsݽĺ%u5z|~=W wƾm]3~ y-۝'佐}(neY};u~{Y{M/3SLu# ^d}!5 ƺug$7zr=}\^sl9'} __{W!Aڷjle=nE2_rzc<b[5YgYK ԣW#_'ưm{*-DlgKdm{9{dJ]l_Vkv`8vY{=}߫Yɋ=^$F2wemٝskΟj~O{Y:g׫uLݧr9{3t>gx遲U~ƪjܯ{tves.|m/kl_#)޸7˺t#qsސϽ3g,woc^kqHNX2'wNrړWտ'^ݷYzyn'˞͚39s;v:z~u3쪫f~.7kCǬRל9mMl7U7gontN͸6}kz{f96+SulW?%W5g9bo}Mz'SzݫS_S޻W߭{]vj\7q~j~zRq}F϶'yzރJXkX#kݬGf}\Ͻ3}p:|.뽙Ⱦ=ژzfUc?9&Yo3DQGUz7UGz{S?}/sPXGx\+]Gv=:eW~LMo6\CgVqO^dl֡j ̩gMe95W37c-c]WnvzM;#'\}&e9|+dz6em'j'd]+s h|c<=Em)3<ףkooՋog}7ާΩ^.o̴Xn*~3kXSuײ߳}{gYc81\oU8}Sa|j>jW?2G]'|V%gd^[y4nsKGf!cޫ;ֹ&v ae@grӶ87{8B=YVyg߱x~}qw9't %}6]܎=%f׋L~+p?c݌k{QϬ؎IjcX|j >(>57c]ϝ|֨qnfO2{#^n~iݹֳq:3ߪ|^oeH?q>̣js8=3vz-+z{ϰeNmU䞕٧Y~yk/{{P> kd]Y>wOcy79aswW?R8r=\{kLL뭷uN;3v%mz2eCrs d wۓ>܊Ёώ'1Ǎx?VUs%y:5Oc)>QWcQ&?9.u;!x_saXWck㒜8?o6?S̳^<g߈bny\1W].^upOz}Ž@oMzdV\k}\W%9ls_Ucd Q>\t,mco'{2E+=:$]:X7_zӔ#usrǼv| igV7ڬeDZK<dNgFөɸZl[3zk+8k/Gd~)oG3'X5ֵW󺪖CYדּ=۶8kfܓr=}u짶ρkѫ?SﲮN_+D=q]c_\uY?~ȱ?:[ohx_znBxϘ'Oχ%]s7+ۣKx~=&amvޟ=3c|s{~絜+㔼ճ'=9zκ59{}yM Vy٧YyF5W]ڌ_ﺴ1slU55gu>8 _z=_uwO33yd]{8z$瞐Xܵ/|`Zc0/=q² >{Uu5+G.~/޷쯊k̷1AwUux~z}ol?3X}ܳ>'52vK{<սaɮܗ'yY`|2W|!kp 7+ql7:6yxjtu_rX9czje՘_wKdz5v9>;8^gD %y <0aOiYSgF&M鬙߹^u*~\{\Xٿʵ-.=.lId#9ٵ5{gj3/}`[z}̺czslUkb~YǺpk{+krwڗ{Es}\G/G{3oܳ{A﹭k}zo1GzƬ+=]Aۙ9_s}}*gr_7*)gھuyN5iwR^;wg~`:r{m4z${c#_O':֣5-gdr&7KdS{lNԵg?ԫw?|V\߬{xƭ7uY׽^ O޾Ï+3d{wUWizϽ=ۜ7K~u-h)^P5^;yXoҧ&ޟ/{Uc܇2.[qMU?v-}匝>h_䞗>dt?#zsҟ|ސֽ_O=t'= ˏorS:eȺ{u}̗^|׭s 5N?`K7sݹ<5?Q2>̳^&[q;xñL^ǺKrΐWg(;կձك}~2?㱦s4`fM2VoWgo-zr6z浩c՞zOe rO~ۃxu5'9o˙\<ϱ2Rޑ5J̬5kDꔳ)=~?O^ˏ^,lkom={vkh?=}m1Zwmoߌs+eS&Y]]g'͐72˾Ylw&jmί:"׻rvgSqz=s6ߨݎ]5׸^K_o\eZ<#d9Şًma9-l}5Y̝^=0SYcڰ7ݒl25Υ ӫ3Sr}xGގ=]3/rȾ=IE;={oE6!,"jŀ7ԀQFD@ (pQn] %Hd a-컌 {TTzͩIo\~z>3]UNzg~*}o06ja1Mc껅 C C7=އ4{.ưn8pKfʦqUրsUߟ-9Z~A Bݳ#p`M_c|M1Eue/?V:F/=3+6O]~S7i\7ƨ܅1Z52!m~s8|cB0AwR([:6 |,ڀPƭ1:p;UH}RڰTk}\/PXuNMtcǧa-IU΍ wx3H>Y|}Ncڌs6qk7 5 co~?i6췎?Zj7'sFjΝ_j3q9=c8Z ~r16}AvPhY`i*o^Ә4 s`n|JykوC}JXKWhV^z.7ԯ5%Kc5cvw.P[qCV}KL}&چڄaȾ4 cnV Ӹq*q:p]uq6ns>9􌮅/\S_r{DGW||~ri|x? ǘJh\r~ʆ!')tXkVN1Iۊ5h VSaq^ۀG9Ck3u8b]1oGlYA8q6Zvtkc#?1f1 C7xs?r>D E.qޢ1oP p=~nIDc-mj څ: j.~ڌZz.։q~ڏ ]X?{C _4ݣkmU[qs#~bOox}Jڋc}!C˦1 ʹ\)]oN6n]mvtia^w!ˍ{(ݟ9IM9wMuǧJp.O!ۆぶ7@ m76v!(u+j<zO4uj.?w0Ƨ5Q +UO8[!]ZU%Ayxjch]06X8.p>87&A9Aqv`fpI5* 0N ډe~ƭ5u.%-pQ?]tZV~F1f/-c,ñxj t霮jXN9(16·h]X>1n;_Fc6}r$|My0N95cj3W.ƝPGۃusmQ)zݓSѸx}U C7e9c;}:2i;1fi>!zM Wa^ϨN'6q1{|?'*]. C=rcb*Q{iwrL^o ϣxڈU1c0ui4 9ԏ/c~b ǂ{G7ԖS FR jaȾjAu7ߜqƾ @rUmvpqgW%9\g7|=vjW>E~SgWmڀmE?bpDÍ 5&0Һ[ZPwT 8sm¹ #Ur1iù*4Y[Xcֆ4O$Σk4Zg0J˳6<{_X!?cʏuc8UW׷Quʲ>SL,3Q]X6$CڂH>P=p|T3hsWtmIG7? K7 AUFk*-㜖Y6)>ϯcuT}M4̣jNOq;8gy+nX6 =d\N 8t\.Aޗg\a_pp{n!j%ڄk,j3#*O3Z4^C__ j=NJ}8u>l@ŕKrmD?Q{lS:{UkZg9={TP\_.ܨ߹7=77pSU2ұ`@\u3f~Q;3DyhYu|bmQi!kڐd}UZ͇Mur~n88ty`ΡbBxq^V?C_sHT78W*?-C57Auìxok'j3W&^Cr3{VCXqNו\_qqA~R{Ĝܽ{nm7n?;mܽU<_z]tgGw^ TCA܇cKտV/t w}a˭wwY'8p~FmlHd'-˦|殏zDe#w0d{9[UP۸JdjTmǏU`TG1PՉʶGsߵ6Q#iL% U֡1{0Z{\}]Wce{]~+\"S\Էla<ѲBR˓2۠̕}kΏ8ݰL硲t(@mXEUB,-oϫs wQZ.p)/ 1 ^7:[n- A,]7`wj\sX&wIFiӵ MC׾tJ>*AV;:Qq)>֓\9`[mDZl>sym8?o~U58scLc7NUk6xRIY6r3gGy`{V=4*k#[pycQym@>.& ؇Y86%\>n'wcŲډc|k"z=ǜ] 1W? >ô8sk5{7V~U0x/9$sV~Jo-_qQ7G`98}̓vcg(8vrPw{\P}Tϸ'j1Z76h\q>8Zreօ}Җ㯹эc~k?j!m;=PT:}ǹ6qx|}R6ր8537}_cN 4OǍMn9k6 ]p76USN=7>>T!3rPsLCeΡl8fWiUVAP/h~7~GahW5 N^ Ush~z;ZcaoF߲T=a .9Dpk?NІKϷ6􋵖# #GNx[>nGJ"[:k|nHvT$y<&sSs6qqNc_`=\̃c'P]dXڊ:SPVV*&☾TLSrJD:g]E+81h$8=CqNAo3.n~3c IqCai;9 Si[i]xu۸1އtNTEϸb7Xqϟ(Vbpͥs2Nh9KUwuY] |b/gr`TsUS}aLP۰^, qc{U~6Í{n$U qn.66a9}0ntS՚^kiXέ񨽴|ƲO[\s+)7}ܵ3>D-Be?v`}ps-n 73\,qh~=r hٮGtN_vUZ~5j+֓HCq c \{P{lʡ~zإ߳ȀXӘ:'mh0~./aաvsq`g:ډ}Z}EJ$sb]n.sh7xω:=X-i*=7YzփmT5 j:ڎk7^ս~.9{T'ZCpi\*퇊LVscۂeZ'׏nqDڋGV9Wimm\SD>y9yӀI{h;s6>8OcqcW4}ڃjmXQ*2 ;h^G869? ,<9Nۣ5h|緞Mbc +kjrg8/ ; 5|-ܜs wk^kuNq *78{88ݨ`\%D(+,{ŕGGöƌak&Z'QٖO+s2-7jqn~+-[W|nq0eͯ4?։+:iut{&..>>ȭ?8vPrs( y߸ءjմ|nc9?}\W͓x.}Ʊ|:h[e~Pyc礊p܀h3701+j\jj'9A﮸øu~61Z͏t1 - |NK=DNیGrx|Ms>K8-Fmڮڇu_ewe ͛N!q|pnyŹsAQz\'1օcmtfGhp!ZRr&0JK$X>G~U|^º1y-њN5'rXn5[CpjJ1pUr\lqsHD[׉|Kי?h,`{_h\3JG\\sk\rkFW1}ƭIbˣELz.=&6pI:|,D۬"- Ǎ_g+JqmV)4&m3^qwk.wڮYY6sߨ_`>Kk-՘XDZ6c^̯>굎kZuU>esߩDUv9ʛ跒}w0><57a,5{UUk 8T]h!Xm }߸:_maÐ͍lu^ڇ8oZè#\y8U1L\kk֎0=ա/8C[}z>{|\  Ahj']p,#Q^nA >TygÜ;3=7QkTg2$^[2\la| /e9Wڇ>>4Z\ t9MyTk?@V^u>֩dU=OvYzu 5pQUcG:shJ3 EMx^CqƍqUlrd^wɍo\$&ϳssiUWFu&pm:p=bǸ:,>DJeM˲ڎP.=+n_>Xǭg=@[ 8_2PP-0JMuA7W~'-)-ۣ:S*Q}1%C&oO\=FPrNq9\:GbS.hFu}B[zۍk l?_nZ`?'k!i[PcConF?K(yPև6}] qms>RRP5~|KTòF_p~ڢZW:U~5m5ƚ5[ay=^41h\}}lG]|Ճa`˯a4 Z~19➖~._N9gS?%x>=:~^ևD>PgnN`[T㶬jraT3!FQNU[u4ySp@ }QX89?qqAm2>uL}JWF';W>j7ne`۸9;.yXݬrUYV>== uاxO3oV}g6$Av)Cu em|K^Wes1Z_t/* aՉmes(114 zSuJu-0K'UƭhlkWU}Dͭ C~ͯw\<`bscZη|D>j P ha6sq~Qj#=R~n_1|z=Wp}Z6е5oقe`𞻇1č+&p}JیFmQ5V,Z8;h\Z7p]>|xڦ{;ܸAZim9{_/ط;OOWML/ܽSUHls*?`FCMU_r}78cYan}:ONn|:-[Ða~nY6qqbGsaZ~W7h{=[LnMw>g~]9G;a|WDqm(pj,&ƍ#S\Qܬ2*{NNSpSoC]e5a$7˲ʣ%I"=nGآ1a[i*bnSj¹p'.ZG5"}ÕmKE|)j%_$c;a?ӶujMXUGamWOC?>1:eՁ}ƍY}9>k09sza0J7i>+օOtc*1cF*n5[}~@hhܩZj G{-~nߋb>kޣq>&α즟rm7.^qQ˵ܸc$v2 wﲬvXAFb98G8B%z1a>k4Ul)ێ\>GA [wѾV35H>zڎF}Ec J{ܳ\l { ׊XQ2i8sus84F5ܵ.ngX\np԰Ӝ/pLrk1(=Psp4@mcn5j! <[?⎞íqΧ?7cFL;1a0/#%****N*#U)#\FZF:tj2RJZ2R2R2R2R2e2R2R2ҙeHuHHzwǯ1lgvƳ1mg\vƷ1ngvƻ1ogvƿ v;`GvŽ^ьl)F:Fo#i:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:f#i:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uLu̮3fWj]}qvuή;gWj]vuЮChWj]}vuҮVKiW7j]Ǔӹ6y666^u^u֭ZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:F1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uL1cZǴi:uձ&oX/I'NI'NN: ^I't:btI<ꤓN:iN: I't:RtI<餓N:iN: 뤓N:iN: VꤓN:iN: I't:jtII't:ST'tNO5&7̏}a{~p7n*%Ox*84-.M XCo<'r;oz7W0 |;E[2bfEu(7yc壮8oN?.vFh/OƷgxK][fx;Swa`Ş8:Xk7&gx✟V{mq87N~7W]yckNOCoܻDp7wlIޘ;g| Wo>8v7}Cq{o|7>~7)xW,v%sol//kF/_v8??k?l/|pgpox޹&U'Z g,k3ǻ{]CWkf󇗼+~ 4Z0?vËQ8eS?䤏?>??L '>"y vy}c+/av?X/|%&^q8a?U_81ZNݗ73ݟ;2}5%|Y~K:3/>Sݞ8<#ك \ql\g+q>o1|AO{S]U /,&U7]>f 4l/Z y%_Kħ5iԂž5rqdf>(;žقQofb/| 8vxZ/38my/^^S.wtu^SՅV{cbªWy_ {f^8o|ᐵXZ|&5/) ?N. ׸BO9J UMp8pGOhZ\O,*';~'>|io[0臲gz\O3.XuO{}v}ޔW}}<+=MPEWxb=GE]l2;'C_'5&;~:E洶ar{_P6U,3׎wīE%6wŌ,̯gVNjkی-v#xGlW+|8/gew65B,rv8&{_[ek:Mްjd71y۴b1D?zD˯_,cV[ZukZsw-~oNΏ9bS=-ub}]b噽VYs#⾍wmirOk+G=_7놏NhgM^Z?G3GD? :e7k!㹞xYΐd9Է('oP'7qMn8/P'ʽoz }Ҝ|]#~z/|az_8K%(LO-T9eQ'o#3=qmp%plO;[;  w-8Ɔ;Uɬg.W|qGgz߫{M>y5?/:Beɥ Dy]V gnWDg7 lTMMFO,M3Ovg8)f*2qlw\N=~>t/kk5)P'lo(ϼ6/̬Yڈy&Z,-_ :A%W_)9S+yw?,-? l"O/z_/*I_̗S[UV-e.;A^_.xM0 8b.pĿ'6VsIW|("_]OW'k-ʹ7!D9DpN3E'tH\pI8ED)L3Y-+DzgiOE|9ö_nxQ9a=~]g$iכX?1H^]w,~MgxQ޷+¹CVsD8=≹EFɣ?၀hק- ]i&XIW/(5^0{֊'^R z"x󟅾Baǚ"?,i W\4yw|jÖx>qY#'H KD\qz?O/-Wϥn58o/آxNv_qM{-8sdȽ3~=&?9qÅo_(OΉ[zMgI̸3⊙{I݈+\P]nbi$[qC/x̳$.q7psň/|7*0o _=yWOqKW͒vKo|#=H`E YOF<Ѳg/\y(gkv dô$_q+.mbÿ#v5{9}}ef?qE?G?G"Mwxw|aJVn(߬UxWӈ'[ :w<2Vk_(?X?↯_KcU#xX^8"mw~u#^\WU%qEW?<Oy/|Cpt?̟QK*/F>D񿵭^$G<.$q1/'≵FJ_X(UaBxg2/#!V B0Qĕ!OsZq|v88pu~^4)/Pb1O ri`C괘/lTu!OZׇ\q@}@.m'NXı_| U3$NrŗJŽW^y=1_7aϪ!O<? ?fҤCX'K51fǐ' {.K/xsū70٬ySGcyg.G] i{t~MM:F]qXEQCy>4>OrT#>< ?s_Dݰȸ =A_x Y$k奚_ѶiQ_8fO3Qr#~w*˯jX~;)Ŀ֋z--uߧIb]7eHt?v8?5!wg;=w彻$51W+5qŇ ?uX$M7s_Ίz_f<7+5̘'$Isn ‹J+6Ϳ2-yb۫B]/<sŬX^2ne']󅳟 5}?wo0ʢCIMQ޺bhoՏܖ{y%抖ѽ2?<䄫j4瑕H̘J)|_`_:=7?kN*vjdb,dGT:%'J1ム#6][ =s/Όz8Z5g̹8Sq}gvgYpK*`gQG|iȷ4k :fN)nsĝd8n9ꏫ\s!SVј#~V.CCMBsğfeLל%~5<8t;Yst/\S#V̴wM=9S-`yڕ1G<(?'nsc,v[3e?3>\5@:ɋy#z>1eUsBy\qڼ'~rgaOcY2} G?4Suxmu?W q_FvKcAG<,_h[[i,hՉ}awk{zbi,~9舡w$wn#.b󵃪=*gi 9<?6'׹̘#N\/QW~XAOnk絉ykg{m@#k70YkwZr1G|/,Zh5PBrs!ˣc*ZC=vˠ孻t Xru&|a1'WU-k<1O̫ougɅ|n/0zlS~\qRyu%e/?'X@bLh׸!WPkrR-Ѿ 8c˗q^4]7Fyfa47k\ y#Pdc5CDIlt Xf{\户U/buii,/ύ¡{D> z⨚x_ԅ1O|6+!G2Pԗbj5F3юC:P1Wܲ! |SbyMBnX\GlvMϵ.>wh#^T8c9^/X-fRC¾+~xUGEy͞ĖX^S?숭Z*/ w;ʒg-޺DTˢˮ#votGjю;ΒlG-磸Y#NI$xJ,oe;b~,MLIOˍr8n WqA5a7$.._-OgaG\,Qƨ_|Z*z}n7?(ڷOqhǎOܳHV #Dw.W?(#S%~\5NS H:o>_ⅿyCz97Vg/s^-^!_2k9זx⹷G xg_h_.864.{L}дC'-lOB'^7[7Vc®/qS/|dCĜ]qy2]q4#OOwQ-Dk>n%s}+}7Oî܃b|=Gw 2TIS=qʒ_89omXoQ}q,_+8zoZxs'.]%)Wupc¿[?g+ns]928 Ou%^>|a?r|aSeN)rŔWE5.qXC|{cͷX6I<;94l㹩⎘q/1OeC®xųMj?.IY-[b" }a<Ѱ+f#?wƊ{z#4LI#8xg!8ⰛþU'6#rFI1/eI|lWwMVbRlq1<O'NMS.hYs;Ee/q e.-reD+J<5VM}D9r]~1۳xӦr畸bRen IsY%튧ϯaWRq])x|xV,{]ޡ,[<;/%!Ϲ/ /.a]=D{{';DI͒9+[aG|SDpi_EG~La3$?rHlG|ªKîmOfqtЯѿX|NXs(OcY"U6I}Re JUCs\16Y%tfSGTKxO#]y<u 7'ޞeqG0#bIf6W>'^ams;y; 5<w:^byvlGhǹɌA/lxr/lVͷ]cv _]i)"pVBvGv4쌷z 'vys-.sw|"]dzX[) E ;'sn{heí8T_\qAFSY97]QkK\q;,pg<Esr+NY8Whߋק\qfsѾ_%qYW*E|%Es[<'8Ooߗo~T^p ܝ?gExrѮb-~&ΏwWgpoVY~*oa>aˤV+rĜ<_/qRYiš5#"G==sKq\TAyw8 :70妴#neW>ȼߺeww/rȀ(KʓxN1g'-0RX~7$d|-ƫYW$z#'EEy,:숿v&gNwg1$6ɶ+s ߈M'͞*y=5|=nHB^;-^)Ebئs{RX^r{{\ea[JNmw|kI2'bk,{qĞkTdkm]+sfIBn~޼zikHW\ }9,Td\.3p\%WiE<8[soq'뱭9k:K|[\BؿQX.prW+C/ {V!qMEQG0G?&I2:SE{f ȷczssK{FOȷVm1"~X&H|k߫i򃍢YnsM~[l[/>W,Ŝ"rG'p2g8n] kH (E(PQ#.$E 8DdfG\wNWÎar㺈MqsRɭKXn*5,vȔ2;b%?"sR#^! X^rY#^zmUo1#漳inīNJwƝZ7|-[3mZUraG\vz{/qy7UK|E3&.+KGَb}q_)2Ӌ s\,KŒ;" ,5vƟ&"q'i44ggS$&N/;+<"ʩ!O)7 jwFd;鳅=5HT#qh_iYϬlY ywiP?漳a ϗslQ՝/E9ls4!z1?!3}*# tɗxؠƩBua#_~]7lGysTaϽeN/r=*q%hSypa%?wv.n8jCħn 8d_Iȱx,+!+_QE\S#_w3MN%qtG8䋻$%gVlqG?v "*Kynvv*wKDf4nI/dJ]ĊRϻ͒xrl{S,_f5n;bʢ]t[#nŠr^;Sv-~絫cLSPCpc9!Sw6_&djQN 3*sG#^8ʜ/v]IK1K%f$8:@M|oW`V+nlZ\OڮME%^ղ8r|tVmծo~{ ㈡//1(roV,XC%PPOmp_qġ ?<9 ; n͔Yӄ<05zQ3VJ?fI65MuϓE'l{Dܸ-Ni.;hT;-%3 ^&H^/^_K6<( ^JҒz3Kvls-6l*sOn$>}s^Tb%pPOVhb~TC,;]+z>FWat{"=tQv~k-%=n!KQ5ٓnߋzyT/D/ljziКrOL:3n%yQoޛ%Vٰx,ӾIȔJe%YdD}53d4agļVYHwf2?QXhwu{TSdM]տ~jv(W巬Rbޖ6K6M{!꽮gĶ넝׷ɱ{Dm-Λ%ddQ_i$z[&o9"zgz;6,dag{l)^ṉb: ]#_wǥcXjuT}GD 7l)ypKz%v>;nDk8dsnz.?*پpd/\3ߨ)ڳᆊ&vK[H|sZWg I[#qϩaw2\ۋN5?hǎJu+BiqwpغtW&9[KX+|Ŀd>q÷ '뱷s\%$Tox+zOvbCф"W( *qFolQ3jiWl,&9]k-rcGI|[]YbS%YbE9xc;PFIU+:yۆbo펑{5\vĻָ/t_j9ѮWdžmqQ_k= KbѰKL\2᥸+nuĭǣw~튻&7'슑KK.Nwŏx}+~RE7m"W<8į-qC7K<|I&Ka{+Dk%}\׳FI#WmwA-ro[\NQzmox#֛YEv?6Jx9Ikl.ra$fU⊗n8p+'KWlvkk-*rGI+pQd]%viwǿHv0xٮسI } ~pr=Oq ⋗835{H<;+.y6o^#q%QonvOo.q{A+zT➫%K\+6KtU+~`k_v-růN%1K+~fM 7$KaQjBxk#Í+[IWOwiIO͖xʾ}xjk%\4Gx:kl}k֯/kW"ŵ\*KrW׭Ĵ]q:掿? PSWcu KѮTq]Kx,RXM@#`(j),]k36&0_̹K搂= ſYۈ gvKbw74 LAt l5"׷L 7䳹Ig7.f2ٻ)հyԎL-[+]2IYt2}4|!duۖAfba$ f{h0/Ggj&KeBˑ{ l.DLdEiȪl-W<խ"& kfX=aÎCn~Ь C&@?'T i4I&:|5;\>ݰF\ܸ+VŻ䦕Z7*M^O-4s<&0]M9LO HnkC6pxT\OMR"{;˩!W\m?=`$ <}{fii~,C"AdWB$Y z aȽB&E#Uf5Ȫ5'=*?C^Or2#zȃbXbuB?Rhv#?RC?'yoD~>맧)"G/<34ex!qby*4^Hp?et$uf#vOT$;a/iZȮj1ɋJ _^;+ې fHhfC>'s:9 Hdiϓw=^s_! k5#R7]iA>\LiX_qGHYgc ljuZ_O`{zSO",ңsJhskg%𲆤ע0 . 4s/qJfv~Un1(9蜆䫳Kۡy iُ &i,DO7]ϛVr˴*BI]WӼ3 Vj!W.!&Ƚ0^]r";5 qoph1>i]#rR)"&cgrMq^6r ܨvͦIMHM h!750z*guhg;ې@{ҷh"9s[gۦ|9ssf5OFb?XmY񍅤r])2{ygzC ]RI}f6K '|daY'Ys#`=,),2a Yunq8eu{7yzxS=a]rxiWr_GeޔuJ|)u_VTvs+N?8=VCQ.񢼦@kBJYV x%)o<7e9meAvp\j)V ^,O5)pI</Svcd/data/WomenQueue.rda0000755000175000017500000000027714133313352014662 0ustar nileshnilesh]0 1 b4$ 0T_@/p yo،6K/mv=:c*sd\Z];X`"bB,%1'jf"glKW±^;vgZk$.7Eʒhe˲cٳ,DfKH8ס~ޘޏosk씆 |&vcd/data/VonBort.rda0000755000175000017500000000210611566471044014164 0ustar nileshnilesh[kW{ ЛYs-T\ՖIdRӎd7s-×|g3QE櫩.IIӯiI~}1Y<|X>&Ig|寓į%jgN8yܮ!q]}E^|wv73`߫z kߙ]3߾';3tbc/w{4ynY|]|>6wv(mw&gm;sn|?r&#燑39?F#痑m>r9ȹ9#g>rM>τn>sy?||ԧZu~?7_]ׯ|^-I.,M|dxf΄%wLQng'f7e} ::׎R_Tk`=,[~z( =oǷwv?Y,YΗ_-uSMx(,EXʰTa҄ KܛJo[fC6dC6dC6dC6dC6dQ(l6 FaQ(m6JFiQ(m6*FeQ٨lT6*FmQۨm6jFmhl46Fchm6ZFkhm6:Fglt6:]05gkZV5kڲh9Zh9Zh9Є&4 MhBЄVhZVhZVh%ZVh%ZVh%ZVUhZVUhZVUh5ZVh5ZVh5Z֠5h Z֠5h Z֠5h-Z֢h-Z֢h-Z֡uhZ֡uhZ֡[ݲl~iH>+,vcd/data/Bundestag2005.rda0000755000175000017500000000122611566471044015020 0ustar nileshnilesh]S]HQwa5!HE"i\3g#\wGgfmf@ʴ"2(z^J| ^"!;Xpf9;Fd^ȳTٿ<7j$rY0k!e�~zfWlE/m׎X͟?w; \ y r-a O~_ jT[|^2dAQugօs`1fR A SA9CtVָ w4˦QԞQ ̱S:dnyJjZ$#&=/1 ?U-|%QSdTL2]Av1ֶ橩/RhLD8hyB4YmS=E=e BLz{҅G]AD3Ԡ.#/.n%'%@λzFŶ&՜#x"˥f6Iit Ϳ `vcd/data/PreSex.rda0000755000175000017500000000037114133313352013771 0ustar nileshnilesh 0E/_Wu'(bq!څ3,*}@ˊc3RW33v2!q9v00M llx`0s1s+8鷗*Ψ>"n>G<{*Ч(At?ڧY[hMY( 懲+}=3q!5"TY'Bs#:,i\ctO68E$YH&U゚KRqȋOSl,yrQQ?{u޷(% }x&vcd/data/JobSatisfaction.rda0000755000175000017500000000044411566471044015660 0ustar nileshnileshPMO1MHwLHL [&+{Se`vvu:}o/Q2K ҈ڍ\ϟb*aVlY %zc~:7׀)x|_p>zN[6mFY݂oxal"ܺhg@\dY0oHHƔl{o,ݵ UZkِ3l~d%PQI #0NWjҍK\## ArHI*6\ikۄ/NqIvcd/data/Arthritis.rda0000755000175000017500000000141011566471044014541 0ustar nileshnileshՖYS@3 L"耂<!( sS!Ńeǜd:t:wXkݖeٖb?%gW5k~˶[;\ʼnvp10e  x2#  wkpiiY`R}J4sṕyp \ׁK<\<Gf@?j೬XdQ_&~ox.w uÁ ]'I}G?IFv,KjW$n&k񎹴ǖ7f!G?u#Zy6iD-t#ۗyե= XLZɸfJ3^^^=^Z֐fT4~r畖&jR#PZBM3sCZ#iCҲ\f)]W_8cXߣY\auL R|ag(>{xx G}os'{'$sŚZ=ޗ1ݾns篤 q4.tFׇ_n;n$ӵ\MVl$M}YI~XjkCײ{#n#YHvdϑ| R߄eBd˜(Se|)dRL..........>>>>>>>>>>!!!!!!!!!!ECѡPt(:EGDGDGDGDG$ vcd/data/RepVict.rda0000755000175000017500000000070314133313352014136 0ustar nileshnilesh͓JPo(vp$$N+"Vmzi[išK""( ps|qtcϗB_9߽$=6]2Ƃ,`} GYV5U2sCE`KI)0D\@?;߯io|o76FIĕ$W2]KGp[›Ie]]EMij2բ)a;"Ua42Uwt^:0ˎ(zei3-/_?̖ sߟ.5@),TwWչNJ/I/vcd/data/Employment.rda0000755000175000017500000000045714133313352014721 0ustar nileshnilesheQN@<4q҅[11 JR.&4tOS(Ȃsσs/1'&+ ,uUiO9X<ɈC'T>)fS <>@ 9C `۴3o/;p΄3pP" []KXSi!ۯW=_݊i 9~e =4Xr^5qEnE"͗/"6+zfa[ b?g,ϓ" =\m,biݣ36\ {{vvcd/data/NonResponse.rda0000755000175000017500000000052111566471044015043 0ustar nileshnileshJ@76 ^*xYݺބ>Oֺag)6dvff2IjD1ƙz ,><B۷JL4Xs{jkYyu'NoPY ]_N?0cu\;ŗ__Wh =̖Ѩ& #HQ1Enԋ,tj+ͅ!'6"-4_1uf_ tO r!qy,EUb 45<#(R~7mPz7׻ǽ !8&8!8%8#8' G%L"D!:Cm;s`_^evcd/data/BrokenMarriage.rda0000755000175000017500000000056011566471044015465 0ustar nileshnileshj@'_BECћAW]m1&&xk߬'nܙrhٙYrw=u2` 0l)?@$2њ#&[qy"ߊ]K OG ox~<*RUųNu\fL A,gp’x3XL I$$~)Jl4-_Zf6|'|grB~.?͔N<:(OyًنEt\Њ`Vf?$`IDo5]%h :]GЧ6\M-MmMM]M&m%򤪭R?Uvcd/NAMESPACE0000644000175000017500000001236313210522464012403 0ustar nileshnileshimport(MASS) import(grid) import(stats) import(grDevices) import(colorspace) importFrom("graphics", "pairs", "par") importFrom("utils","head","str","tail") importFrom("lmtest","coeftest","coeftest.default") export( ## generic functions "agreementplot", "assoc", "cd_plot", "cotabplot", "distplot", "doubledecker", "fourfold", "goodfit", "mosaic", "oddsratio", "odds", "rootogram", "sieve", "spine", "tile", "structable", "loddsratio", "lodds", ## spacings "spacing_conditional", "spacing_equal", "spacing_dimequal", "spacing_increase", "spacing_highlighting", ## labelings "labeling_lboxed", "labeling_border", "labeling_cboxed", "labeling_left", "labeling_cells", "labeling_conditional", "labeling_list", "labeling_doubledecker", "labeling_values", "labeling_residuals", ## legends "legend_resbased", "legend_fixed", # shadings "shading_binary", "shading_hcl", "shading_hsv", "shading_max", "shading_Friendly", "shading_Friendly2", "shading_diagonal", "shading_Marimekko", "shading_sieve", "hcl2hex", # core functions "struc_mosaic", "struc_assoc", "struc_sieve", ## panel functions "pairs_barplot", "pairs_text", "pairs_diagonal_text", "pairs_diagonal_mosaic", "pairs_strucplot", "pairs_mosaic", "pairs_assoc", "pairs_sieve", "cotab_mosaic", "cotab_assoc", "cotab_sieve", "cotab_loddsratio", "cotab_agreementplot", "cotab_fourfold", "cotab_coindep", ## `normal' functions "Kappa", "assocstats", "table2d_summary", "co_table", "coindep_test", "grid_barplot", "hls", "is.structable", "independence_table", "mar_table", "Ord_estimate", "Ord_plot", "strucplot", "ternaryplot", "binreg_plot", "mplot", "grid_legend", "grid_abline", "woolf_test") S3method("[", "structable") S3method("[[", "structable") S3method("[<-", "structable") S3method("[[<-", "structable") ## We cannot do the following: S3method("rbind", "structable") S3method("cbind", "structable") ## Instead, we currently have to use: ##export("rbind.structable") ##export("cbind.structable") S3method("str", "structable") S3method("is.na", "structable") S3method("length", "structable") S3method("as.table", "structable") S3method("as.matrix", "structable") S3method("as.vector", "structable") S3method("dim", "structable") S3method("t", "structable") S3method("dimnames", "structable") S3method("agreementplot", "default") S3method("agreementplot", "formula") S3method("assoc", "default") S3method("assoc", "formula") S3method("assoc", "loglm") S3method("cd_plot", "default") S3method("cd_plot", "formula") S3method("cotabplot", "default") S3method("cotabplot", "formula") S3method("doubledecker", "default") S3method("doubledecker", "formula") S3method("mosaic", "default") S3method("mosaic", "formula") S3method("mosaic", "loglm") S3method("tile", "default") S3method("tile", "formula") S3method("rootogram", "default") S3method("rootogram", "goodfit") S3method("sieve", "default") S3method("sieve", "formula") S3method("sieve", "loglm") S3method("structable", "default") S3method("structable", "formula") S3method("spine", "default") S3method("spine", "formula") S3method("pairs", "table") S3method("pairs", "structable") S3method("fitted", "goodfit") S3method("fitted", "coindep_test") S3method("residuals", "goodfit") S3method("predict", "goodfit") S3method("confint", "Kappa") S3method("plot", "goodfit") S3method("plot", "loglm") S3method("plot", "structable") S3method("print", "Kappa") S3method("print", "summary.Kappa") S3method("print", "goodfit") S3method("print", "assocstats") S3method("print", "summary.assocstats") S3method("print", "table2d_summary") S3method("print", "structable") S3method("summary", "Kappa") S3method("summary", "assocstats") S3method("summary", "goodfit") # loddsratio related methods S3method("loddsratio", "default") S3method("loddsratio", "formula") S3method("coef", "loddsratio") S3method("confint", "loddsratio") S3method("dim", "loddsratio") S3method("dimnames", "loddsratio") S3method("print", "loddsratio") S3method("plot", "loddsratio") S3method("lines", "loddsratio") S3method("summary", "loddsratio") S3method("vcov", "loddsratio") S3method("as.matrix", "loddsratio") S3method("as.array", "loddsratio") S3method("as.data.frame", "loddsratio") S3method("aperm", "loddsratio") S3method("t", "loddsratio") S3method("image", "loddsratio") S3method("tile", "loddsratio") # loddsratio related methods S3method("lodds", "default") S3method("lodds", "formula") S3method("coef", "lodds") S3method("confint", "lodds") S3method("dim", "lodds") S3method("dimnames", "lodds") S3method("print", "lodds") #S3method("plot", "lodds") #S3method("lines", "lodds") S3method("summary", "lodds") S3method("vcov", "lodds") S3method("as.matrix", "lodds") S3method("as.array", "lodds") S3method("as.data.frame", "lodds") S3method("aperm", "lodds") S3method("t", "lodds")