gnm/0000755000176200001440000000000013616026022011031 5ustar liggesusersgnm/NAMESPACE0000744000176200001440000000613213615560311012256 0ustar liggesusersuseDynLib(gnm, .registration = TRUE, .fixes = "C_") export(asGnm, checkEstimable, Const, Diag, Dref, DrefWeights, exitInfo, Exp, expandCategorical, getContrasts, getModelFrame, gnm, instances, Inv, #Log, Logit, meanResiduals, MPinv, Mult, MultHomog, ofInterest, "ofInterest<-", parameters, pickCoef, qrSolve, #Raise, residSVD, se, Symm, termPredictors, Topo, wedderburn) importFrom(grDevices, as.graphicsAnnot, dev.interactive, devAskNewPage, extendrange) # in plot.gnm importFrom(graphics, abline, axis, frame, legend, lines, mtext, panel.smooth, par, plot, points, strheight, text, title) # in plot.gnm; plot.profile.gnm importFrom(methods, as) # in hatvalues.gnm importFrom(nnet, class.ind) # in gnmTools, expandCategorical importFrom(qvcalc, qvcalc) # in getContrasts importFrom(relimp, pickFrom) # in getContrasts importFrom(MASS, addterm, boxcox, dropterm, logtrans) importFrom(Matrix, rankMatrix, rowSums) importFrom(stats, .getXlevels, add.scope, add1, alias, anova, approx, as.formula, C, coef, confint, cooks.distance, delete.response, deriv, deviance, df.residual, dfbeta, dfbetas, drop.scope, drop1, dummy.coef, effects, extractAIC, family, fitted.values, fitted, formula, gaussian, glm.control, glm.fit, hatvalues, influence, is.empty.model, lm.wfit, make.link, model.extract, model.frame, model.matrix, model.offset, model.response, model.weights, na.action, na.exclude, na.omit, na.pass, napredict, naresid, optim, pchisq, pf, pnorm, poisson, predict, printCoefmat, profile, proj, pt, qnorm, qqnorm, quantile, reformulate, residuals, rstandard, rstudent, runif, sd, spline, stat.anova, symnum, terms, terms.formula, update.formula, update, variable.names, vcov, weights) importFrom(utils, flush.console) # in prattle, confint.gnm export(se) S3method(add1, gnm) S3method(addterm, gnm) S3method(alias, gnm) S3method(anova, gnm) S3method(asGnm, glm) S3method(asGnm, lm) S3method(asGnm, default) S3method(boxcox, gnm) S3method(coef, gnm) S3method(confint, gnm) S3method(confint, profile.gnm) S3method(cooks.distance, gnm) S3method(dfbeta, gnm) S3method(dfbetas, gnm) S3method(drop1, gnm) S3method(dropterm, gnm) S3method(dummy.coef, gnm) S3method(effects, gnm) S3method(fitted, gnm) S3method(hatvalues, gnm) S3method(influence, gnm) S3method(kappa, gnm) S3method(labels, gnm) S3method(logtrans, gnm) S3method(model.frame, gnm) S3method(model.matrix, gnm) S3method(plot, gnm) S3method(plot, profile.gnm) S3method(predict, gnm) S3method(print, gnm) S3method(print, coef.gnm) S3method(print, profile.gnm) S3method(print, summary.gnm) S3method(print, vcov.gnm) S3method(print, meanResiduals) S3method(profile, gnm) S3method(proj, gnm) S3method(residuals, gnm) S3method(rstandard, gnm) S3method(rstudent, gnm) S3method(se, gnm) S3method(summary, gnm) S3method(summary, meanResiduals) S3method(termPredictors, default) S3method(termPredictors, gnm) S3method(update, gnm) S3method(variable.names, gnm) S3method(vcov, gnm) S3method(weights, gnm) gnm/demo/0000755000176200001440000000000013152512332011754 5ustar liggesusersgnm/demo/gnm.R0000744000176200001440000000421713152512335012670 0ustar liggesusersmessage("1. Set seed as gnm returns random parameterization") set.seed(1) { if (interactive()) { cat("\n3. Type to fit (linear) uniform association model, ", "\n using Diag() to fit diagonal effects: ") readline() } else message("2. Fit (linear) uniform association model, using Diag() to fit", " diagonal effects") } Rscore <- scale(as.numeric(row(occupationalStatus)), scale = FALSE) Cscore <- scale(as.numeric(col(occupationalStatus)), scale = FALSE) Uniform <- gnm(Freq ~ origin + destination + Diag(origin, destination) + Rscore:Cscore, family = poisson, data = occupationalStatus) summary(Uniform) { if (interactive()) { cat("\n3. Type to fit an association model using Mult() to fit", "\n separate row and column effects:") readline() } else message("3. Fit an association model using Mult() to fit separate row and ", "column effects") } RC <- gnm(Freq ~ origin + destination + Diag(origin, destination) + Mult(origin, destination), family = poisson, data = occupationalStatus) summary(RC) { if (interactive()) { cat("\n4. Type to fit an association model using MultHomog()", "\n to fit homogeneous row-column effects:") readline() } else message("4. Fit an association model using MultHomog()\n", "to fit homogeneous row-column effects") } RChomog <- gnm(Freq ~ origin + destination + Diag(origin, destination) + MultHomog(origin, destination), family = poisson, data = occupationalStatus) summary(RChomog) { if (interactive()) { cat("\n5. Type to compare models using anova:") readline() } else message("5. Compare models using anova") } anova(Uniform, RChomog, RC) message("6. Produce diagnostic plots for RChomog") plot(RChomog) message("7. Get simple constrasts of homogeneous row-column effects") getContrasts(RChomog, grep("MultHomog", names(coef(RChomog)))) message("End of demo. \n", "See vignette(\"gnmOverview\", package = \"gnm\") for full manual.") gnm/demo/00Index0000744000176200001440000000006313152512335013111 0ustar liggesusersgnm Fitting generalized nonlinear models with gnm gnm/README.md0000744000176200001440000000231113615620606012315 0ustar liggesusers # gnm [![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/gnm)](https://cran.r-project.org/package=gnm) [![Travis-CI Build Status](https://travis-ci.org/hturner/gnm.svg?branch=master)](https://travis-ci.org/hturner/gnm) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/hturner/gnm?branch=master&svg=true)](https://ci.appveyor.com/project/hturner/gnm) Functions to specify and fit generalized nonlinear models, including models with multiplicative interaction terms such as the UNIDIFF model from sociology and the AMMI model from crop science, and many others. Over-parameterized representations of models are used throughout; functions are provided for inference on estimable parameter combinations, as well as standard methods for diagnostics etc. ## Installation You can install **gnm** from GitHub with: ``` r # install.packages("devtools") devtools::install_github("hturner/gnm") ``` ## Code of conduct Please note that this project is released with a [Contributor Code of Conduct](https://github.com/hturner/gnm/blob/master/CONDUCT.md). By participating in this project you agree to abide by its terms. gnm/data/0000755000176200001440000000000013615621571011753 5ustar liggesusersgnm/data/barleyHeights.rda0000644000176200001440000000127013615621571015235 0ustar liggesusersV?o@?iڄ"ubcbBUlJq2E r"P6&X:_S_K9{mC!Nzyb?UәQ֙nHXE~8lʘ!MILnxF#^s{G3]G'x' A{ς_(^g-o#xo =GvGooNz unx&.8*ov=n 9m9AS|zvmBo ·wgo}ETV=կr}3]|Rτz];iOWPWz~[q\8\ )>~1$)Q]RyC~}\"'N~?t-pNug9=ΫCsNÎ+'d-~,>4'T P-T>e.8x n-*mNS򃔼wSrJJɵ\Ut0THR?MB)]憛@oV[zjKM^#GuLFs׶JWOF"m';FfYid%6t84: 3xD/:-3A~y08/?$>g(As*&%A)]'G gnm/data/backPain.rda0000644000176200001440000000113713615621571014155 0ustar liggesusersr0`r SxL<ê[(gLQ<6 M,N{t|wlz7M$Mh&)i?$ɒrq\o~< x,(_#+Cf.Ʈ3Ϲ8OΜ+Ҹc7{.ykHܾ Оȣ{YYh47 DDDDĄĆ:92TYʂ#$2L#3`0 `0 `0 apapa!`!`!aH!aH!a( `( `( ahahaa`a`aaXaaXaAOZ< ߄ܗU{2?|bW0`tXqS yj5UUOYi3wf=Ẕk\xoUz%UhuGkz["bKFl۶-m{^]ͻQO8(0#yH֐sGJ?mN޲C}ߎ GT;bо)0 I (H 6 lSmiKEJ)/<;'¸W*!Qv t!"U =Hi$đL$ I I$ `0 `0 `papap Äa0a0L&  Äa`X0, Âa`!`!`!aH!aH!a0l6  Æaða0lOם gnm/data/erikson.rda0000644000176200001440000000126113615621571014115 0ustar liggesusersVNSAz+.Xh i1([##+jJ mTimјD}>JGL/w a;s939gnsLiF)Pd@_  T>Nջ7N[)?{okee\ky̗62 [aI=&^~Ɓ9`xG ^'(Ma?OhƹY`ȸ47s-{/>2>xB-7C|{KYc0E|.wO2Fq$raxڮw׊%&y]q1I,_DuvWTDܧ*h~u!^|C;/E`<Fӭӻc95ݡ]t^/m^##N<~yB~ Ww7GqfOҽ¨BTwT/jLG^{.#E:/ߗ1eMO7cNc֍O;7Or G!Ԛ-;!oZlm !Ăw&V*`vɮ띓+?#E !O\-dl4]{f7;vG_<^O)^nݎ gnm/data/House2001.rda0000644000176200001440000001201513615621571014030 0ustar liggesusers][srl8[u*$R$UXϞGIDY+vuXUI= @HJk풅 ҷ1{?ӦeY׭W֫pxVڀ]D۷[oo7Nw?~wQ[E?Q.Xhvɺ5K>Y6F)yНF,đY^Lʼjh_ñL6<͕np}бW76j2]l0֨9>ܮX_|/fwڝ08/zFh:p+*jj_[iIz |E;'-hޢ<ׇ o,Vomeam *0 '5a`^sm$ o1u$>\\*e8}b\ʗ20dXf1a<0{qqZňMoeR7gX\YUUΙ۬e9pt5u\Mv>tӮiupb/L8Syqj)/[E=S` ^4%\a2?9aאS \I<.5EmЧNm׵#ugNn1簘(̪k4=sR&#UiybaVu\So()KU*ky i⇋h<:SFÞ❵g0δv]Wr$-mħ۪>I=wUijz~QR-y\ʷMXyIW6V1Ÿe:Mjq:NV2226RƙC~4gƵ&:lrηpoqS:FݳJ{{㱜vgJR~YUzL-Y3"/[kLkX^*_j3' 0|Ijjk/I/VỶI ]j3)ϷpޱgNVƽq+8}eǩ 㬯 Sa\ø1Dgݪnz6wZ9}S|,bZiSk1A~ ٰVM]YqWu6}iqu.h1:Juf~%ˋq\_GJey\ilqSOqƙbSltֻ: + ,Ÿgub1\GZy:<'Ufʷcjc\Z}1.]0Kk*UNꫩU˩UrXZ2j ɜ֨U*9—=[2_e'q+UfvRjFLj_̙tyr愍q1nsyZe]E1ήi+¸cٲ}0;n}&ĭ}*XZ{5u8K8"[$F2yNJRI})~UᾓPjZeܧ8fsb*NMN]^x5nb,#|8a<'{}{G0ӵ ]?Íw}'p5Eb2 յۧpQcy.> qbO>a|o{Q,'~x/cៅ*jW)g8 #jWh6 =|OdCx޽C{W'^ G ݌90/I'‹a|RFm{ׅiNa{rpLφy}{ a^0 j(8yC7'=q |7cç;׿@?~}b9% d#y+'D"TH?ӭHhR7޹ Czx;]W{а|st{Ogw cͅC(&g13wo!lD,W!M[3*&l_Ё.=y3 {=˜X-^;-v#p@̝O#p/?op a!qC4cҝa(cXtc "Ap;2I,i|skGgcp=!,<ƭʅbExj ilT"=E'c'o'PIק 2:*RGuK{a4"yF>3ELIĖآ&uCg 6vhk$SR]ր&42'+GɨYċs4D4$0ӌӀy#Qi}7AMM.wRj\Mc|yI lk5GQlHݑSD t\@h>I:hy=8B~wi9#DY]G'!WցyQ^LZ)\'yN8h( P7˽̳r'7֊mT6pq96bp`+ݻ{`>־c/aB=^b l@W}q}^"7m*$>f?YP&SB 28<#aW9q'BlxdcY@j ~[[IġX u&@>j=EtpP:{͑#@gF$Q{9q ] 4rzK RP߁HQJv(y邳!aOCI$)P^hsN+G))!h+x39d AO2?;؇ -=|y<&8bD -\?V*ZtD)<!%h3&nZwyKTsS1oI8R^8@xTf$(ק F8D럲>@|5$%)y)BV|c3s Ey(~Hu hJg"HLh͙Ua Q:lo|r/䒛g+84oNM[1%G|eMxoT@+;zQc߀hՓuo'])zR ,h]SS&h_5R;*grCq)z*PBE0BLFr雞^ m01`F/tћM a_dFdO7pM\9X"w\@p3zn>p6.:f!oM_fQe Y =z_FGZ9)oT7W}H̓@7Q$q}o<1GoG77"_-GؚQX[Ӂ6X4J0';*f&E?|d*,{pwB%/ &!G~f$zhM"ͮ5%E=S\+]584mt~&|f(-׻~&j+ORt19|}iG7t *_]$i@J0[3b ?D-2gnm/data/yaish.rda0000644000176200001440000000101113615621571013551 0ustar liggesusersVMK@6UkA C=""bb?TD#Vу -Toi⶙YٷINvy䌧)(3VehRk؍i 4lAqq=_4]qy^blO`]YW x-A}( ,0jW9oԼqݽW050tuMėUn}'R3'/Ɗ1EeYEQnMD6٦h(Е ȣo# tff7{GvΙ33;LΦ/zw_@nl7rS~|{ֽ㣕| jۺ6mKn݁z?y[ƺ o_ξuzg#?/>[0{دSW|8|?y['o3an1If~>g>O90-W~Q߁ J_zavN}qߪ%qc{ȉ2b_E_SJ?{$0^ 0F /]? |ez!.U8~?N>g{s/v A.$/$N#I`cs]؀E}/NDO5/A~}#q7 Wu%W 7O@!:qAH\As&\w 6Ѱ(U.SbgLxsNI:g֑9v;כa~sS0Lú;xGםx}@<$v_!ylL'1O TDۄ`0oěQ$N&+9rA>yKƿi֩JLpp|4%GcDZ}$OL/?מϜsֿaIx[_9חĿxNI}'&z%\/G0\LrRr3GXt;$^Jr S$_OH.Mc7"upY9>dW= zAT/;u!?N|5oPJp+%U܃xH$q )`|כs"yւxɮw `|!}ޱuzc]B^DW SC?F2z-`&s"?Աq{O^~q0. ޹ yp3"?گ[o޾_7?ɷE_DZOk\]`93fgs}<;4ʞ/Mwy|nt.œ{Zulwn:ə' I5Y՝;fUZUJbZ[Ü=7 ?aǪXGy~w /xJZ k'!gnm/data/mentalHealth.rda0000644000176200001440000000054213615621571015052 0ustar liggesusersOO0vML ŕƃ(.x '̘)^Xo&~u]ߟ9o28uθ9<<gJe"Lݡs<C'"s׀_+ư 9p;U*=׍fv{F((O(c ʳsgma v$/b].բ 9?]|k m%Z&+QΫ^"{K9VKEw[y J5gB/ HGp k mވzB뿆ts]i\kp\ aƵ'܍?_S5?wmXrC޻#lֵsX~sط H;q=u/ñuҏ7sT?i,J8E+-2.bf?M"$HXyNrJ\`2 AGʡx!iG-xKy>X9tA3)IM%R+{"+e\5RU. d~@KC~ʒ)5wzVHf%{H>XF+׊?b%<)-@J}Rl''L|=|_(+R0|_e%'{χxLJq@q}XI5DKiO\GεX/y+I?fe_HYm? J+??]w.DJTzh)$U.5.K=AfiW>ol~Jqy>X>R0|y[d^ʮoRV]uqw|qb^@ҟY&*ҏY up["΀}zRǁyRߗfo?M2c%8_0};"^COz[~{`'X*UXCb%{?_q))5?oI}NxJ]ozO>8Lx%$YC?5ʱZ_F=O`$ϛrR+c%8|gҞH9> rlH)ɼOK\#>4)4Ǭ_.!jZX9.bZ>,%rϬIRr|'R}4+Hqx=y~XyPry<`GrO3V+_u7XyH1)5+<6'Vc1AnӬ<*g%_+1)şWNLLOh@)V?69uXON̈&eqə{fN5'N)nt߰#fn7s̭9mMavش6OG*h9bv3Urfn{ٰ#fV0jfs*JQFXQaąFZjjjjEjj%jjW ^5jxUëW jFjFjFjFjFjDFjDFjDFjĪFjĪFj$Fj$Fj$FjFjFjdFjdFjdF]yF3fz33C3#3c33S3MljeS+ZʦV6MljeSM͛75ojԼySM-0S L-0S L-0BS M-4BS M-4BS M-2"SL-2"SL-2bSM-6bSM-6bSM-1SKL-1SKL-1RSKM-5RSKM-5RSKM-32SL-32SL-35%|7_͗x%|7_͗x%|7_͗x%|7_͗x%|7_͗x%|7_͗x%|7_͗x%|7_͗x%|7_͗x%|7_͗x% '6pKWҿtgnm/man/0000755000176200001440000000000013615560322011611 5ustar liggesusersgnm/man/summary.gnm.Rd0000744000176200001440000001300413311222714014345 0ustar liggesusers\name{summary.gnm} \alias{summary.gnm} \alias{print.summary.gnm} \title{ Summarize Generalized Nonlinear Model Fits } \description{ \code{summary} method for objects of class \code{"gnm"} } \usage{ \method{summary}{gnm}(object, dispersion = NULL, correlation = FALSE, symbolic.cor = FALSE, with.eliminate = FALSE, ...) \method{print}{summary.gnm}(x, digits = max(3, getOption("digits") - 3), signif.stars = getOption("show.signif.stars"), symbolic.cor = x$symbolic.cor, ...) } \arguments{ \item{object}{ an object of class \code{"gnm"}. } \item{x}{ an object of class \code{"summary.gnm"}. } \item{dispersion}{ the dispersion parameter for the fitting family. By default it is obtained from \code{object}. } \item{correlation}{ logical: if \code{TRUE}, the correlation matrix of the estimated parameters is returned. } \item{digits}{ the number of significant digits to use when printing. } \item{symbolic.cor}{ logical: if \code{TRUE}, the correlations are printed in a symbolic form rather than numbers (see \code{symnum}). } \item{signif.stars}{ logical. If \code{TRUE}, "significance stars" are printed for each coefficient. } \item{with.eliminate}{ Logical. If \code{TRUE}, any eliminated coefficients are included in the summary. } \item{\dots}{ further arguments passed to or from other methods. } } \details{ \code{print.summary.gnm} prints the original call to \code{gnm}; a summary of the deviance residuals from the model fit; the coefficients of the model; the residual deviance; the Akaike's Information Criterion value, and the number of main iterations performed. Standard errors, z-values and p-values are printed alongside the coefficients, with "significance stars" if \code{signif.stars} is \code{TRUE}. When the \code{"summary.gnm"} object has a \code{"correlation"} component, the lower triangle of this matrix is also printed, to two decimal places (or symbolically); to see the full matrix of correlations print \code{summary(object, correlation = TRUE)$correlation} directly. The standard errors returned by \code{summary.gnm} are scaled by \code{sqrt(dispersion)}. If the dispersion is not specified, it is taken as \code{1} for the \code{binomial} and \code{Poisson} families, and otherwise estimated by the residual Chi-squared statistic divided by the residual degrees of freedom. For coefficients that have been constrained or are not estimable, the standard error is returned as \code{NA}. } \value{ \code{summary.gnm} returns an object of class \code{"summary.gnm"}, which is a list with components \item{call }{ the \code{"call"} component from object. } \item{ofInterest }{ the \code{"ofInterest"} component from object. } \item{family }{ the \code{"family"} component from object. } \item{deviance }{ the \code{"deviance"} component from object. } \item{aic }{ the \code{"aic"} component from object. } \item{df.residual }{ the \code{"df.residual"} component from object. } \item{iter }{ the \code{"iter"} component from object. } \item{deviance.resid }{ the deviance residuals, see \code{\link{residuals.glm}}. } \item{coefficients }{ the matrix of coefficients, standard errors, z-values and p-values. } \item{elim.coefs }{ if \code{with.eliminate = TRUE} a matrix of eliminated coefficients, standard errors, z-values and p-values. } \item{dispersion }{ either the supplied argument or the estimated dispersion if the latter is \code{NULL}. } \item{df}{ a 3-vector of the rank of the model; the number of residual degrees of freedom, and number of unconstrained coefficients. } \item{cov.scaled }{ the estimated covariance matrix scaled by \code{dispersion} (see \code{\link{vcov.gnm}} for more details). } \item{correlation }{ (only if \code{correlation} is \code{TRUE}) the estimated correlations of the estimated coefficients. } \item{symbolic.cor }{ (only if \code{correlation} is \code{TRUE}) the value of the argument \code{symbolic.cor}. } } \note{ The \code{gnm} class includes generalized linear models, and it should be noted that \code{summary.gnm} differs from \code{\link{summary.glm}} in that it does not omit coefficients which are \code{NA} from the objects it returns. (Such coefficients are \code{NA} since they have been fixed at \code{0} either by use of the \code{constrain} argument to \code{gnm} or by a convention to handle linear aliasing). } \author{ Modification of \code{\link{summary.glm}} by the R Core Team. Adapted for \code{"gnm"} objects by Heather Turner. } \seealso{ \code{\link{gnm}}, \code{\link{summary}}} \examples{ ### First example from ?Dref set.seed(1) ## reconstruct counts voting Labour/non-Labour count <- with(voting, percentage/100 * total) yvar <- cbind(count, voting$total - count) ## fit diagonal reference model with constant weights classMobility <- gnm(yvar ~ -1 + Dref(origin, destination), family = binomial, data = voting) ## summarize results - note diagonal weights are over-parameterised summary(classMobility) ## refit setting first weight to zero (as DrefWeights() does) classMobility <- gnm(yvar ~ -1 + Dref(origin, destination), family = binomial, data = voting, constrain = "delta1") summary(classMobility) } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } gnm/man/cautres.Rd0000744000176200001440000000567513152512335013561 0ustar liggesusers\name{cautres} \alias{cautres} \docType{data} \title{ Data on Class, Religion and Vote in France} \description{ A 4-way contingency table of vote by class by religion in four French elections } \usage{cautres} \format{ A table of counts, with classifying factors \code{vote} (levels \code{1:2}), \code{class} (levels \code{1:6}) and \code{religion} (levels \code{1:4}) and \code{election} (levels \code{1:4}). } \source{ Bruno Cautres } \references{ Cautres, B, Heath, A F and Firth, D (1998). Class, religion and vote in Britain and France. \emph{La Lettre de la Maison Francaise} \bold{8}. } \examples{ set.seed(1) ## Fit a "double UNIDIFF" model with the religion-vote and class-vote ## interactions both modulated by nonnegative election-specific multipliers doubleUnidiff <- gnm(Freq ~ election*vote + election*class*religion + Mult(Exp(election), religion:vote) + Mult(Exp(election), class:vote), family = poisson, data = cautres) ## Deviance should be 133.04 ## Examine the multipliers of the class-vote log odds ratios ofInterest(doubleUnidiff) <- pickCoef(doubleUnidiff, "class:vote[).]") coef(doubleUnidiff) ## Coefficients of interest: ## Mult(Exp(.), class:vote).election1 ## -0.38357138 ## Mult(Exp(.), class:vote).election2 ## 0.29816599 ## Mult(Exp(.), class:vote).election3 ## 0.06580307 ## Mult(Exp(.), class:vote).election4 ## -0.02174104 ## Re-parameterize by setting Mult2.Factor1.election1 to zero getContrasts(doubleUnidiff, ofInterest(doubleUnidiff)) ## estimate SE ## Mult(Exp(.), class:vote).election1 0.0000000 0.0000000 ## Mult(Exp(.), class:vote).election2 0.6817374 0.2401644 ## Mult(Exp(.), class:vote).election3 0.4493745 0.2473521 ## Mult(Exp(.), class:vote).election4 0.3618301 0.2534754 ## quasiSE quasiVar ## Mult(Exp(.), class:vote).election1 0.22854401 0.052232363 ## Mult(Exp(.), class:vote).election2 0.07395886 0.005469913 ## Mult(Exp(.), class:vote).election3 0.09475938 0.008979340 ## Mult(Exp(.), class:vote).election4 0.10934798 0.011956981 ## Same thing but with election 4 as reference category: getContrasts(doubleUnidiff, rev(ofInterest(doubleUnidiff))) ## estimate SE ## Mult(Exp(.), class:vote).election4 0.00000000 0.0000000 ## Mult(Exp(.), class:vote).election3 0.08754436 0.1446833 ## Mult(Exp(.), class:vote).election2 0.31990727 0.1320022 ## Mult(Exp(.), class:vote).election1 -0.36183013 0.2534754 ## quasiSE quasiVar ## Mult(Exp(.), class:vote).election4 0.10934798 0.011956981 ## Mult(Exp(.), class:vote).election3 0.09475938 0.008979340 ## Mult(Exp(.), class:vote).election2 0.07395886 0.005469913 ## Mult(Exp(.), class:vote).election1 0.22854401 0.052232363 } \keyword{datasets} gnm/man/mentalHealth.Rd0000744000176200001440000000416213152512335014507 0ustar liggesusers\name{mentalHealth} \alias{mentalHealth} \docType{data} \title{ Data on Mental Health and Socioeconomic Status} \description{ A 2-way contingency table from a sample of residents of Manhattan. Classifying variables are child's mental impairment (\code{MHS}) and parents' socioeconomic status (\code{SES}). } \usage{mentalHealth} \format{ A data frame with 24 observations on the following 3 variables. \describe{ \item{\code{count}}{a numeric vector} \item{\code{SES}}{an ordered factor with levels \code{A} < \code{B} < \code{C} < \code{D} < \code{E} < \code{F}} \item{\code{MHS}}{an ordered factor with levels \code{well} < \code{mild} < \code{moderate} < \code{impaired}} } } \source{ From Agresti (2002, p381); originally in Srole et al. (1978, p289). } \references{ Agresti, A. (2002). \emph{Categorical Data Analysis} (2nd edn). New York: Wiley. Srole, L, Langner, T. S., Michael, S. T., Opler, M. K. and Rennie, T. A. C. (1978), \emph{Mental Health in the Metropolis: The Midtown Manhattan Study}. New York: NYU Press. } \examples{ set.seed(1) ## Goodman Row-Column association model fits well (deviance 3.57, df 8) mentalHealth$MHS <- C(mentalHealth$MHS, treatment) mentalHealth$SES <- C(mentalHealth$SES, treatment) RC1model <- gnm(count ~ SES + MHS + Mult(SES, MHS), family = poisson, data = mentalHealth) ## Row scores and column scores are both unnormalized in this ## parameterization of the model ## The scores can be normalized as in Agresti's eqn (9.15): rowProbs <- with(mentalHealth, tapply(count, SES, sum) / sum(count)) colProbs <- with(mentalHealth, tapply(count, MHS, sum) / sum(count)) mu <- getContrasts(RC1model, pickCoef(RC1model, "[.]SES"), ref = rowProbs, scaleRef = rowProbs, scaleWeights = rowProbs) nu <- getContrasts(RC1model, pickCoef(RC1model, "[.]MHS"), ref = colProbs, scaleRef = colProbs, scaleWeights = colProbs) all.equal(sum(mu$qv[,1] * rowProbs), 0) all.equal(sum(nu$qv[,1] * colProbs), 0) all.equal(sum(mu$qv[,1]^2 * rowProbs), 1) all.equal(sum(nu$qv[,1]^2 * colProbs), 1) } \keyword{datasets} gnm/man/residSVD.Rd0000744000176200001440000000416413152512335013566 0ustar liggesusers\name{residSVD} \alias{residSVD} \title{ Multiplicative Approximation of Model Residuals } \description{ This function uses the first \code{d} components of the singular value decomposition in order to approximate a vector of model residuals by a sum of \code{d} multiplicative terms, with the multiplicative structure determined by two specified factors. It applies to models of class \code{lm}, \code{glm} or \code{gnm}. } \usage{ residSVD(model, fac1, fac2, d = 1) } \arguments{ \item{model}{ an object of class \code{gnm}, \code{glm} or \code{lm} } \item{fac1}{ a factor } \item{fac2}{ a factor } \item{d}{ integer, the number of multiplicative terms to use in the approximation } } \details{ This function operates on the matrix of mean residuals, with rows indexed by \code{fac1} and columns indexed by \code{fac2}. For \code{glm} and \code{glm} models, the matrix entries are weighted working residuals. The primary use of \code{residSVD} is to generate good starting values for the parameters in \code{\link{Mult}} terms in models to be fitted using \code{\link{gnm}}. } \value{ If \code{d = 1}, a numeric vector; otherwise a numeric matrix with \code{d} columns. } \author{ David Firth and Heather Turner } \seealso{ \code{\link{gnm}}, \code{\link{Mult}}} \examples{ set.seed(1) ## Goodman RC1 association model fits well (deviance 3.57, df 8) mentalHealth$MHS <- C(mentalHealth$MHS, treatment) mentalHealth$SES <- C(mentalHealth$SES, treatment) ## independence model indep <- gnm(count ~ SES + MHS, family = poisson, data = mentalHealth) mult1 <- residSVD(indep, SES, MHS) ## Now use mult1 as starting values for the RC1 association parameters RC1model <- update(indep, . ~ . + Mult(SES, MHS), start = c(coef(indep), mult1), trace = TRUE) ## Similarly for the RC2 model: mult2 <- residSVD(indep, SES, MHS, d = 2) RC2model <- update(indep, . ~ . + instances(Mult(SES, MHS), 2), start = c(coef(indep), mult2), trace = TRUE) ## ## See also example(House2001), where good starting values matter much more! ## } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } gnm/man/checkEstimable.Rd0000744000176200001440000000422013311460701014773 0ustar liggesusers\name{checkEstimable} \alias{checkEstimable} \title{ Check Whether One or More Parameter Combinations in a gnm Model are Identified } \description{ For each of a specified set of linear combinations of parameters from a \code{\link{gnm}} model, checks numerically whether the combination's estimate is invariant to re-parameterization of the model. } \usage{ checkEstimable(model, combMatrix = diag(length(coef(model))), tolerance = NULL) } \arguments{ \item{model}{ a model object of class \code{"gnm"} } \item{combMatrix}{ numeric: either a vector of length the same as \code{length(coef(model))}, or a matrix with that number of rows. Coefficients of one or more linear combinations of the model's parameters.} \item{tolerance}{ numeric: a threshold value for detection of non-estimability. If \code{NULL}, the default value of the \code{tol} argument to \code{\link[Matrix]{rankMatrix}} is used. } } \value{A logical vector of length equal to the number of parameter combinations tested; \code{NA} where a parameter combination is identically zero.} \author{ David Firth and Heather Turner } \seealso{ \code{\link{gnm}}, \code{\link{se.gnm}}, \code{\link{getContrasts}} } \references{ Catchpole, E.A. and Morgan, B.J.T. (1997). Detecting parameter redundancy. \emph{Biometrika}, \bold{84}, 187--196. } \examples{ set.seed(1) ## Fit the "UNIDIFF" mobility model across education levels unidiff <- gnm(Freq ~ educ*orig + educ*dest + Mult(Exp(educ), orig:dest), family = poisson, data = yaish, subset = (dest != 7)) ## Check whether multiplier contrast educ4 - educ5 is estimable ofInterest(unidiff) <- pickCoef(unidiff, "[.]educ") mycontrast <- numeric(length(coef(unidiff))) mycontrast[ofInterest(unidiff)[4:5]] <- c(1, -1) checkEstimable(unidiff, mycontrast) ## should be TRUE ## Check whether multiplier educ4 itself is estimable mycontrast[ofInterest(unidiff)[5]] <- 0 checkEstimable(unidiff, mycontrast) ## should be FALSE -- only *differences* are identified here } \keyword{ models } \keyword{ regression } \keyword{nonlinear} gnm/man/meanResiduals.Rd0000744000176200001440000000604513152512335014677 0ustar liggesusers\name{meanResiduals} \alias{meanResiduals} \title{Average Residuals within Factor Levels} \description{ Computes the mean working residuals from a model fitted using Iterative Weighted Least Squares for each level of a factor or interaction of factors. } \usage{meanResiduals(object, by, standardized=TRUE, as.table=TRUE, ...)} \arguments{ \item{object}{model object for which \code{object$residuals} gives the working residuals and \code{object$weights} gives the working weights.} \item{by}{either a formula specifying a factor or interaction of factors (recommended), or a list of factors (the elements of which must correspond exactly to observations in the model frame). When a list of factors is specified, their interaction is used to specify the grouping factor.} \item{standardized}{logical: if \code{TRUE}, the mean residuals are standardized to be approximately standard normal.} \item{as.table}{logical: logical: if \code{TRUE} and \code{by} specifies an interaction of factors, the result is returned as a table cross-classified by these factors.} \item{...}{currently ignored} } \details{ For level \eqn{i} of the grouping factor \eqn{A} the mean working residual is defined as \deqn{\frac{r_{ij} * w_{ij}}{\sum_{j = 1}^{n_i} w_{ij}}}{ (r_ij * w_ij)/(sum_(j = 1)^(n_i) w_ij)} where \eqn{r_{ij}}{r_ij} is the \eqn{j}'th residual for level \eqn{i}, \eqn{w_{ij}}{w_ij} is the corresponding working weight and \eqn{n_i} is the number of observations for level \eqn{i}. The denominator gives the weight corresponding to mean residual. For non-aggregated residuals, i.e. when the factor has one level per observation, the residuals are the same as Pearson residuals. } \author{Heather Turner} \value{An object of class \code{"meanResiduals"}, for which \code{print} and \code{summary} methods are provided. A \code{"meanResiduals"} object is a list containing the following elements: \item{ call }{ the call used to create the model object from which the mean residuals are derived. } \item{ by }{ a label for the grouping factor. } \item{ residuals }{ the mean residuals. } \item{ df }{ the degrees of freedom associated with the mean residuals. } \item{ standardized }{ the \code{standardized} argument. } \item{ weights }{ the weights corresponding to the mean residuals. } } \examples{ ## Fit a conditional independence model, leaving out ## the uninformative subtable for dest == 7: CImodel <- gnm(Freq ~ educ*orig + educ*dest, family = poisson, data = yaish, subset = (dest != 7)) ## compute mean residuals over origin and destination meanRes <- meanResiduals(CImodel, ~ orig:dest) meanRes summary(meanRes) \dontrun{ ## requires vcdExtra package ## display mean residuals for origin and destination library(vcdExtra) mosaic(CImodel, ~orig+dest) } ## non-aggregated residuals res1 <- meanResiduals(CImodel, ~ educ:orig:dest) res2 <- residuals(CImodel, type = "pearson") all.equal(as.numeric(res1), as.numeric(res2)) } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } gnm/man/gnm-package.Rd0000744000176200001440000000316713311222714014253 0ustar liggesusers\name{gnm-package} \alias{gnm-package} \docType{package} \title{ Generalized Nonlinear Models } \description{ Functions to specify, fit and evaluate generalized nonlinear models. } \details{ \code{gnm} provides functions to fit generalized nonlinear models by maximum likelihood. Such models extend the class of generalized linear models by allowing nonlinear terms in the predictor. Some special cases are models with multiplicative interaction terms, such as the UNIDIFF and row-column association models from sociology and the AMMI and GAMMI models from crop science; stereotype models for ordered categorical response, and diagonal reference models for dependence on a square two-way classification. \code{gnm} is a major re-working of an earlier Xlisp-Stat package, "Llama". Over-parameterized representations of models are used throughout; functions are provided for inference on estimable parameter combinations, as well as standard methods for diagnostics etc. The following documentation provides further information on the \code{gnm} package: \describe{ \item{gnmOverview}{\code{vignette("gnmOverview", package = "gnm")}} \item{NEWS}{\code{file.show(system.file("NEWS", package = "gnm"))}} } } \author{ Heather Turner and David Firth Maintainer: Heather Turner } \references{ http://www.warwick.ac.uk/go/gnm } \keyword{ package } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } \seealso{ \code{\link{gnm}} for the model fitting function, with links to associated functions. } \examples{ demo(gnm) } gnm/man/getContrasts.Rd0000744000176200001440000001411213311460701014551 0ustar liggesusers\name{getContrasts} \alias{getContrasts} \title{ Estimated Contrasts and Standard Errors for Parameters in a gnm Model } \description{ Computes contrasts or scaled contrasts for a set of (non-eliminated) parameters from a \code{\link{gnm}} model, and computes standard errors for the estimated contrasts. Where possible, quasi standard errors are also computed. } \usage{ getContrasts(model, set = NULL, ref = "first", scaleRef = "mean", scaleWeights = NULL, dispersion = NULL, check = TRUE, ...) } \arguments{ \item{model}{ a model object of class \code{"gnm"}.} \item{set}{ a vector of indices (numeric) or coefficient names (character). If \code{NULL}, a dialog will open for parameter selection. } \item{ref}{either a single numeric index, or a vector of real numbers which sum to 1, or one of the character strings \code{"first"}, \code{"last"} or \code{"mean"}.} \item{scaleRef}{as for \code{ref}} \item{scaleWeights}{either \code{NULL}, a vector of real numbers, \code{"unit"} or \code{"setLength"}.} \item{dispersion}{either \code{NULL}, or a positive number by which the model's variance-covariance matrix should be scaled.} \item{check}{\code{TRUE} or \code{FALSE} or a numeric vector -- for which of the specified parameter combinations should estimability be checked? If \code{TRUE}, all are checked; if \code{FALSE}, none is checked.} \item{\dots}{ arguments to pass to other functions. } } \details{ The indices in \code{set} must all be in \code{1:length(coef(object))}. If \code{set = NULL}, a dialog is presented for the selection of indices (model coefficients). For the set of coefficients selected, contrasts and their standard errors are computed. A check is performed first on the estimability of all such contrasts (if \code{check = TRUE}) or on a specified subset (if \code{check} is a numeric index vector). The specific contrasts to be computed are controlled by the choice of \code{ref}: this may be \code{"first"} (the default), for contrasts with the first of the selected coefficients, or \code{"last"} for contrasts with the last, or \code{"mean"} for contrasts with the arithmetic mean of the coefficients in the selected set; or it may be an arbitrary vector of weights (summing to 1, not necessarily all non-negative) which specify a weighted mean against which contrasts are taken; or it may be a single index specifying one of the coefficients with which all contrasts should be taken. Thus, for example, \code{ref = 1} is equivalent to \code{ref = "first"}, and \code{ref = c(1/3, 1/3, 1/3)} is equivalent to \code{ref = "mean"} when there are three coefficients in the selected \code{set}. The contrasts may be scaled by \deqn{\frac{1}{\sqrt{\sum_r v_r * d_r^2}}}{1/sqrt(sum(v * d))} where \eqn{d_r} is a contrast of the r'th coefficient in \code{set} with the reference level specified by \code{scaleRef} and \eqn{v} is a vector of weights (of the same length as \code{set}) specified by \code{scaleWeights}. If \code{scaleWeights} is \code{NULL} (the default), \code{scaleRef} is ignored and no scaling is performed. Other options for \code{scaleWeights} are \code{"unit"} for weights equal to one and \code{"setLength"} for weights equal to the reciprocal of \code{length(set)}. If \code{scaleRef} is the same as \code{ref}, these options constrain the sum of squared contrasts to 1 and \code{length(set)} respectively. Quasi-variances (and corresponding quasi standard errors) are reported for \bold{unscaled} contrasts where possible. These statistics are invariant to the choice of \code{ref}, see Firth (2003) or Firth and Menezes (2004) for more details. } \value{ An object of class \code{qv} --- see \code{\link[qvcalc]{qvcalc}}. } \author{ David Firth and Heather Turner } \seealso{ \code{\link{gnm}}, \code{\link{se.gnm}}, \code{\link{checkEstimable}}, \code{\link[qvcalc]{qvcalc}}, \code{\link{ofInterest}}} \references{ Firth, D (2003). Overcoming the reference category problem in the presentation of statistical models. \emph{Sociological Methodology} \bold{33}, 1--18. Firth, D and Menezes, R X de (2004). Quasi-variances. \emph{Biometrika} \bold{91}, 65--80. } \examples{ ### Unscaled contrasts ### set.seed(1) ## Fit the "UNIDIFF" mobility model across education levels -- see ?yaish unidiff <- gnm(Freq ~ educ*orig + educ*dest + Mult(Exp(educ), orig:dest), ofInterest = "[.]educ", family = poisson, data = yaish, subset = (dest != 7)) ## Examine the education multipliers (differences on the log scale): unidiffContrasts <- getContrasts(unidiff, ofInterest(unidiff)) plot(unidiffContrasts, main = "Unidiff multipliers (log scale): intervals based on quasi standard errors", xlab = "Education level", levelNames = 1:5) ### Scaled contrasts (elliptical contrasts) ### set.seed(1) ## Goodman Row-Column association model fits well (deviance 3.57, df 8) mentalHealth$MHS <- C(mentalHealth$MHS, treatment) mentalHealth$SES <- C(mentalHealth$SES, treatment) RC1model <- gnm(count ~ SES + MHS + Mult(SES, MHS), family = poisson, data = mentalHealth) ## Row scores and column scores are both unnormalized in this ## parameterization of the model ## The scores can be normalized as in Agresti's eqn (9.15): rowProbs <- with(mentalHealth, tapply(count, SES, sum) / sum(count)) colProbs <- with(mentalHealth, tapply(count, MHS, sum) / sum(count)) mu <- getContrasts(RC1model, pickCoef(RC1model, "[.]SES"), ref = rowProbs, scaleRef = rowProbs, scaleWeights = rowProbs) nu <- getContrasts(RC1model, pickCoef(RC1model, "[.]MHS"), ref = colProbs, scaleRef = colProbs, scaleWeights = colProbs) all.equal(sum(mu$qv[,1] * rowProbs), 0) all.equal(sum(nu$qv[,1] * colProbs), 0) all.equal(sum(mu$qv[,1]^2 * rowProbs), 1) all.equal(sum(nu$qv[,1]^2 * colProbs), 1) } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } gnm/man/Const.Rd0000744000176200001440000000206613152512335013170 0ustar liggesusers\name{Const} \alias{Const} \title{ Specify a Constant in a "nonlin" Function Predictor } \description{ A symbolic wrapper to specify a constant in the predictor of a \code{"nonlin"} function. } \usage{ Const(const) } \arguments{ \item{const}{ a numeric value. } } \value{ A call to \code{rep} used to create a variable representing the constant in the model frame. } \note{ \code{Const} may only be used in the predictor of a \code{"nonlin"} function. Use \code{offset} to specify a constant in the model formula. } \author{ Heather Turner } \seealso{\code{\link{gnm}}, \code{\link{formula}}, \code{\link{offset}}} \examples{ ## One way to fit the logistic function without conditional ## linearity as in ?nls library(gnm) set.seed(1) DNase1 <- subset(DNase, Run == 1) test <- gnm(density ~ -1 + Mult(1, Inv(Const(1) + Exp(Mult(1 + offset(-log(conc)), Inv(1))))), start = c(NA, 0, 1), data = DNase1, trace = TRUE) coef(test) } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } gnm/man/anova.gnm.Rd0000744000176200001440000000655613152512335013776 0ustar liggesusers\name{anova.gnm} \alias{anova.gnm} \title{ Analysis of Deviance for Generalized Nonlinear Models } \description{ Compute an analysis of deviance table for one or more generalized nonlinear models } \usage{ \method{anova}{gnm}(object, ..., dispersion = NULL, test = NULL) } \arguments{ \item{object}{ an object of class \code{gnm} } \item{\dots}{ additional objects of class \code{gnm} or \code{glm}} \item{dispersion}{ the dispersion parameter for the fitting family. By default it is derived from \code{object} } \item{test}{ (optional) a character string, (partially) matching one of \code{"Chisq"}, \code{"F"}, or \code{"Cp"}. See \code{\link{stat.anova}}. } } \details{ Specifying a single object gives a sequential analysis of deviance table for that fit. The rows of the table show the reduction in the residual deviance and the current residual deviance as each term in the formula is added in turn. If more than one object is specified, the rows of the table show the residual deviance of the current model and the change in the residual deviance from the previous model. (This only makes statistical sense if the models are nested.) It is conventional to list the models from smallest to largest, but this is up to the user. If \code{test} is specified, the table will include test statistics and/or p values for the reduction in deviance. For models with known dispersion (e.g., binomial and Poisson fits) the chi-squared test is most appropriate, and for those with dispersion estimated by moments (e.g., 'gaussian', 'quasibinomial' and 'quasipoisson' fits) the F test is most appropriate. Mallows' Cp statistic is the residual deviance plus twice the estimate of \eqn{\sigma^2}{sigma^2} times the residual degrees of freedom, which is closely related to AIC (and a multiple of it if the dispersion is known). } \value{ An object of class \code{"anova"} inheriting from class \code{"data.frame"}. } \author{ Modification of \code{\link{anova.glm}} by the R Core Team. Adapted for \code{"gnm"} objects by Heather Turner. } \section{Warning }{ The comparison between two or more models will only be valid if they are fitted to the same dataset. This may be a problem if there are missing values and R's default of \code{na.action = na.omit} is used; an error will be given in this case. } \seealso{ \code{\link{gnm}}, \code{\link{anova}}} \examples{ set.seed(1) ## Fit a uniform association model separating diagonal effects Rscore <- scale(as.numeric(row(occupationalStatus)), scale = FALSE) Cscore <- scale(as.numeric(col(occupationalStatus)), scale = FALSE) Uniform <- glm(Freq ~ origin + destination + Diag(origin, destination) + Rscore:Cscore, family = poisson, data = occupationalStatus) ## Fit an association model with homogeneous row-column effects RChomog <- gnm(Freq ~ origin + destination + Diag(origin, destination) + MultHomog(origin, destination), family = poisson, data = occupationalStatus) ## Fit an association model with separate row and column effects RC <- gnm(Freq ~ origin + destination + Diag(origin, destination) + Mult(origin, destination), family = poisson, data = occupationalStatus) anova(RC, test = "Chisq") anova(Uniform, RChomog, RC, test = "Chisq") } \keyword{ models } gnm/man/se.Rd0000744000176200001440000000061613311462242012506 0ustar liggesusers\name{se} \alias{se} \title{Extract Standard Errors} \description{ Generic function for extracting standard errors from fitted models. } \usage{ se(object, ...) } \arguments{ \item{object}{ A fitted model object.} \item{\dots}{ Arguments to methods.} } \value{Standard errors of model parameters.} \author{ Heather Turner } \keyword{ internal } \seealso{ \code{\link{se.gnm}}}gnm/man/plot.gnm.Rd0000744000176200001440000001132413152512335013635 0ustar liggesusers\name{plot.gnm} \alias{plot.gnm} \title{ Plot Diagnostics for a gnm Object } \description{ Five plots are available: a plot of residuals against fitted values, a Scale-Location plot of \eqn{\sqrt{| residuals |}}{sqrt{| residuals |}} against fitted values, a Normal Q-Q plot, a plot of Cook's distances versus row labels, and a plot of residuals against leverages. By default, all except the fourth are produced. } \usage{ \method{plot}{gnm}(x, which = c(1:3, 5), caption = c("Residuals vs Fitted", "Normal Q-Q", "Scale-Location", "Cook's distance", "Residuals vs Leverage"), panel = if (add.smooth) panel.smooth else points, sub.caption = NULL, main = "", ask = prod(par("mfcol")) < length(which) && dev.interactive(), ..., id.n = 3, labels.id = names(residuals(x)), cex.id = 0.75, qqline = TRUE, cook.levels = c(0.5, 1), add.smooth = getOption("add.smooth"), label.pos = c(4, 2), cex.caption = 1) } \arguments{ \item{x}{ a \code{"gnm"} object. } \item{which}{ a subset of the numbers 1:5 specifying which plots to produce (out of those listed in Description section). } \item{caption}{ captions to appear above the plots. } \item{panel}{ panel function. The useful alternative to \code{points}, \code{panel.smooth} can be chosen by \code{add.smooth = TRUE}. } \item{sub.caption}{ common title - above figures if there are multiple; used as \code{sub} (s.\code{title}) otherwise. If \code{NULL}, as by default, a possible shortened version of \code{deparse(x$call)} is used. } \item{main}{ title to each plot - in addition to the above \code{caption}. } \item{ask}{ logical; if \code{TRUE}, the user is asked before each plot, see \code{par(ask = .)}.} \item{\dots}{ other parameters to be passed through to plotting functions. } \item{id.n}{ number of points to be labelled in each plot starting with the most extreme. } \item{labels.id}{ vector of labels, from which the labels for extreme points will be chosen. \code{NULL} uses observation numbers. } \item{cex.id}{ magnification of point labels. } \item{qqline}{ logical indicating if a \code{qqline()} should be added to the normal Q-Q plot.} \item{cook.levels}{ levels of Cook's distance at which to draw contours. } \item{add.smooth}{ logical indicating if a smoother should be added to most plots; see also \code{panel} above.} \item{label.pos}{ positioning of labels, for the left half and right half of the graph respectively, for plots 1-3. } \item{cex.caption}{ controls the size of 'caption'. } } \details{ \code{sub.caption} - by default the function call - is shown as a subtitle (under the x-axis title) on each plot when plots are on separate pages, or as a subtitle in the outer margin (if any) when there are multiple plots per page. The "Scale-Location" plot, also called "Spread-Location" or "S-L" plot, takes the square root of the absolute residuals in order to diminish skewness (\eqn{\sqrt{| E |}}{sqrt{| E |}} is much less skewed than \eqn{| E |} for Gaussian zero-mean \eqn{E}). The S-L, the Q-Q, and the Residual-Leverage plot, use \emph{standardized} residuals which have identical variance (under the hypothesis). They are given as \eqn{R[i] / (s*\sqrt(1 - h_{ii}))}{R[i] / (s*sqrt(1 - h.ii))} where \eqn{h_{ii}}{h.ii} are the diagonal entries of the hat matrix, \code{influence()$hat}, see also \code{\link{hat}}. The Residual-Leverage plot shows contours of equal Cook's distance, for values of \code{cook.levels} (by default 0.5 and 1) and omits cases with leverage one. If the leverages are constant, as typically in a balanced \code{aov} situation, the plot uses factor level combinations instead of the leverages for the x-axis. } \author{ Modification of \code{\link{plot.lm}} by the R Core Team. Adapted for \code{"gnm"} objects by Heather Turner. } \seealso{ \code{\link{gnm}}, \code{\link{plot.lm}} } \examples{ set.seed(1) ## Fit an association model with homogeneous row-column effects RChomog <- gnm(Freq ~ origin + destination + Diag(origin, destination) + MultHomog(origin, destination), family = poisson, data = occupationalStatus) ## Plot model diagnostics plot(RChomog) ## Put 4 plots on 1 page; allow room for printing model formula in outer margin: par(mfrow = c(2, 2), oma = c(0, 0, 3, 0)) title <- paste(deparse(RChomog$formula, width.cutoff = 50), collapse = "\n") plot(RChomog, sub.caption = title) ## Fit smoother curves plot(RChomog, sub.caption = title, panel = panel.smooth) plot(RChomog, sub.caption = title, panel = function(x,y) panel.smooth(x, y, span = 1)) } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } \keyword{ hplot } gnm/man/Inv.Rd0000744000176200001440000000322213152512335012631 0ustar liggesusers\name{Inv} \alias{Inv} \title{ Specify the Reciprocal of a Predictor in a gnm Model Formula} \description{ A function of class \code{"nonlin"} to specify the reciprocal of a predictor in the formula argument to \code{\link{gnm}}. } \usage{ Inv(expression, inst = NULL) } \arguments{ \item{expression}{ a symbolic expression representing the (possibly nonlinear) predictor. } \item{inst}{ (optional) an integer specifying the instance number of the term. } } \details{ The \code{expression} argument is interpreted as the right hand side of a formula in an object of class \code{"formula"}, except that an intercept term is not added by default. Any function of class \code{"nonlin"} may be used in addition to the usual operators and functions. } \value{ A list with the components required of a \code{"nonlin"} function: \item{ predictors }{the \code{expression} argument passed to \code{Inv}} \item{ term }{a function to create a deparsed mathematical expression of the term, given a label for the predictor.} \item{ call }{the call to use as a prefix for parameter labels. } } \author{ Heather Turner } \seealso{ \code{\link{gnm}}, \code{\link{formula}}, \code{\link{nonlin.function}}} \examples{ ## One way to fit the logistic function without conditional ## linearity as in ?nls library(gnm) set.seed(1) DNase1 <- subset(DNase, Run == 1) test <- gnm(density ~ -1 + Mult(1, Inv(Const(1) + Exp(Mult(1 + offset(-log(conc)), Inv(1))))), start = c(NA, 0, 1), data = DNase1, trace = TRUE) coef(test) } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } gnm/man/gnm-defunct.Rd0000744000176200001440000000145113152512335014306 0ustar liggesusers\name{gnm-defunct} \alias{gnm-defunct} \alias{Nonlin} \alias{getModelFrame} \alias{qrSolve} \title{Defunct Functions in gnm Package} \description{ The functions listed here are no longer part of gnm as they are not needed any more. } \usage{ Nonlin(functionCall) getModelFrame() qrSolve(A, b, rank = NULL, ...) } \details{ \code{Nonlin} is not needed any more as the plug-in architecture has been replaced by functions of class \code{"nonlin"}, see \code{\link{nonlin.function}}. \code{getModelFrame} was designed to work from within a plug-in function so is no longer needed. \code{qrSolve} was a function to solve the linear system Ax = b by two applications of QR decomposition. Alternative methods were found to be more robust. } \seealso{\code{\link{.Defunct}}} \keyword{internal} gnm/man/Diag.Rd0000744000176200001440000000245713311436503012751 0ustar liggesusers\name{Diag} \alias{Diag} \title{Equality of Two or More Factors} \description{ Converts two or more factors into a new factor whose value is 0 where the original factors are not all equal, and nonzero otherwise. } \usage{ Diag(..., binary = FALSE) } \arguments{ \item{\dots}{ One or more factors} \item{binary}{ Logical } } \value{ Either a factor (if \code{binary = FALSE}) or a 0-1 numeric vector (if \code{binary = TRUE}). } \details{ Used mainly in regression models for data classified by two or more factors with the same levels. By default, operates on k-level factors to produce a new factor having k+1 levels; if \code{binary = TRUE} is specified, the result is a coarser binary variable equal to 1 where all of the input factors are equal and 0 otherwise. If the original levels are identical the levels of the factor created in the \code{binary = FALSE} case will be in the same order, with \code{"."} added as the first level. Otherwise the levels of the new factor will be \code{"."} followed by the sorted combined levels. } \author{ David Firth and Heather Turner} \seealso{\code{\link{Symm}}} \examples{ rowfac <- gl(4, 4, 16) colfac <- gl(4, 1, 16) diag4by4 <- Diag(rowfac, colfac) matrix(Diag(rowfac, colfac, binary = TRUE), 4, 4) } \keyword{ models } gnm/man/vcov.gnm.Rd0000744000176200001440000000762613311460701013642 0ustar liggesusers\name{vcov.gnm} \alias{vcov.gnm} \title{ Variance-covariance Matrix for Parameters in a Generalized Nonlinear Model } \description{ This method extracts or computes a variance-covariance matrix for use in approximate inference on estimable parameter combinations in a generalized nonlinear model. } \usage{ \method{vcov}{gnm}(object, dispersion = NULL, with.eliminate = FALSE, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{object}{ a model object of class \code{gnm}. } \item{dispersion}{the dispersion parameter for the fitting family. By default it is obtained from \code{object}. } \item{with.eliminate}{logical; should parts of the variance-covariance matrix corresponding to eliminated coefficients be computed?} \item{\dots}{ as for \code{\link{vcov}}. } } \details{ The resultant matrix does not itself necessarily contain variances and covariances, since \code{gnm} typically works with over-parameterized model representations in which parameters are not all identified. Rather, the resultant matrix is to be used as the kernel of quadratic forms which are the variances or covariances for estimable parameter combinations. The matrix values are scaled by \code{dispersion}. If the dispersion is not specified, it is taken as \code{1} for the \code{binomial} and \code{Poisson} families, and otherwise estimated by the residual Chi-squared statistic divided by the residual degrees of freedom. The dispersion used is returned as an attribute of the matrix. The dimensions of the matrix correspond to the non-eliminated coefficients of the \code{"gnm"} object. If \code{use.eliminate = TRUE} then setting can sometimes give appreciable speed gains; see \code{\link{gnm}} for details of the \code{eliminate} mechanism. The \code{use.eliminate} argument is currently ignored if the model has full rank. } \value{ A matrix with number of rows/columns equal to \code{length(coef(object))}. If there are eliminated coefficients and \code{use.eliminate = TRUE}, the matrix will have the following attributes: \item{covElim }{ a matrix of covariances between the eliminated and non-eliminated parameters. } \item{varElim }{ a vector of variances corresponding to the eliminated parameters.} } \references{ Turner, H and Firth, D (2005). Generalized nonlinear models in R: An overview of the gnm package. At \url{https://cran.r-project.org}} \author{ David Firth } \note{ The \code{gnm} class includes generalized linear models, and it should be noted that the behaviour of \code{vcov.gnm} differs from that of \code{\link{vcov.glm}} whenever \code{any(is.na(coef(object)))} is \code{TRUE}. Whereas \code{vcov.glm} drops all rows and columns which correspond to \code{NA} values in \code{coef(object)}, \code{vcov.gnm} keeps those columns (which are full of zeros, since the \code{NA} represents a parameter which is fixed either by use of the \code{constrain} argument to \code{gnm} or by a convention to handle linear aliasing). } \seealso{ \code{\link{getContrasts}}, \code{\link{se.gnm}} } \examples{ set.seed(1) ## Fit the "UNIDIFF" mobility model across education levels unidiff <- gnm(Freq ~ educ*orig + educ*dest + Mult(Exp(educ), orig:dest), family = poisson, data = yaish, subset = (dest != 7)) ## Examine the education multipliers (differences on the log scale): ind <- pickCoef(unidiff, "[.]educ") educMultipliers <- getContrasts(unidiff, rev(ind)) ## Now get the same standard errors using a suitable set of ## quadratic forms, by calling vcov() directly: cmat <- contr.sum(ind) sterrs <- sqrt(diag(t(cmat) \%*\% vcov(unidiff)[ind, ind] \%*\% cmat)) all(sterrs == (educMultipliers$SE)[-1]) ## TRUE } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } gnm/man/instances.Rd0000744000176200001440000000263613152512335014074 0ustar liggesusers\name{instances} \alias{instances} \title{ Specify Multiple Instances of a Nonlinear Term in a gnm Model Formula } \description{ A symbolic wrapper, for use in the formula argument to \code{\link{gnm}}, to specify multiple instances of a term specified by a function with an \code{inst} argument. } \usage{ instances(term, instances = 1) } \arguments{ \item{term}{ a call to a function with an inst argument, which specifies some term. } \item{instances}{ the desired number of instances of the term. } } \value{ A deparsed expression representing the summation of \code{term} specified with \code{inst = 1}, \code{inst = 2}, ..., \code{inst = instances}, which is used to create an expanded formula. } \author{ Heather Turner} \seealso{\code{\link{gnm}}, \code{\link{formula}}, \code{\link{nonlin.function}}, \code{\link{Mult}}, \code{\link{MultHomog}} } \examples{ \dontrun{ ## (this example can take quite a while to run) ## ## Fitting two instances of a multiplicative interaction (i.e. a ## two-component interaction) yield.scaled <- wheat$yield * sqrt(3/1000) treatment <- factor(paste(wheat$tillage, wheat$summerCrop, wheat$manure, wheat$N, sep = "")) bilinear2 <- gnm(yield.scaled ~ year + treatment + instances(Mult(year, treatment), 2), family = gaussian, data = wheat) } } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } gnm/man/gnm.Rd0000744000176200001440000004403513615560322012670 0ustar liggesusers\name{gnm} \alias{gnm} \title{ Fitting Generalized Nonlinear Models } \description{ \code{gnm} fits generalised nonlinear models using an over-parameterized representation. Nonlinear terms are specified by calls to functions of class \code{"nonlin"}. } \usage{ gnm(formula, eliminate = NULL, ofInterest = NULL, constrain = numeric(0), constrainTo = numeric(length(constrain)), family = gaussian, data = NULL, subset, weights, na.action, method = "gnmFit", checkLinear = TRUE, offset, start = NULL, etastart = NULL, mustart = NULL, tolerance = 1e-06, iterStart = 2, iterMax = 500, trace = FALSE, verbose = TRUE, model = TRUE, x = TRUE, termPredictors = FALSE, ridge = 1e-08, ...) } \arguments{ \item{formula}{ a symbolic description of the nonlinear predictor. } \item{eliminate}{ a factor to be included as the first term in the model. \code{gnm} will exploit the structure of this factor to improve computational efficiency. See details. } \item{ofInterest}{ optional coefficients of interest, specified by a regular expression, a numeric vector of indices, a character vector of names, or "[?]" to select from a Tk dialog. If \code{NULL}, it is assumed that all non-\code{eliminate}d coefficients are of interest. } \item{constrain}{ (non-eliminated) coefficients to constrain, specified by a regular expression, a numeric vector of indices, a logical vector, a character vector of names, or "[?]" to select from a Tk dialog. } \item{constrainTo}{ a numeric vector of the same length as \code{constrain} specifying the values to constrain to. By default constrained parameters will be set to zero. } \item{family}{ a specification of the error distribution and link function to be used in the model. This can be a character string naming a family function; a family function, or the result of a call to a family function. See \code{\link{family}} and \code{\link{wedderburn}} for possibilities. } \item{data}{ an optional data frame containing the variables in the model. If not found in \code{data}, the variables are taken from \code{environment(formula)}, typically the environment from which \code{gnm} is called.} \item{subset}{ an optional vector specifying a subset of observations to be used in the fitting process.} \item{weights}{ an optional vector of weights to be used in the fitting process.} \item{na.action}{ a function which indicates what should happen when the data contain \code{NA}s. If \code{data} is a contingency table, the default is \code{"exclude"}. Otherwise the default is first, any \code{na.action} attribute of \code{data}; second, any \code{na.action} setting of \code{options}, and third, \code{na.fail}.} \item{method}{ the method to be used: either \code{"gnmFit"} to fit the model using the default maximum likelihood algorithm, \code{"coefNames"} to return a character vector of names for the coefficients in the model, \code{"model.matrix"} to return the model matrix, \code{"model.frame"} to return the model frame, or the name of a function providing an alternative fitting algorithm. } \item{checkLinear}{ logical: if \code{TRUE} \code{glm.fit} is used when the predictor is found to be linear } \item{offset}{ this can be used to specify an a priori known component to be added to the predictor during fitting. \code{offset} terms can be included in the formula instead or as well, and if both are specified their sum is used.} \item{start}{ a vector of starting values for the parameters in the model; if a starting value is \code{NA}, the default starting value will be used. Starting values need not be specified for eliminated parameters. } \item{etastart}{ starting values for the linear predictor. } \item{mustart}{ starting values for the vector of means. } \item{tolerance}{ a positive numeric value specifying the tolerance level for convergence. } \item{iterStart}{ a positive integer specifying the number of start-up iterations to perform. } \item{iterMax}{ a positive integer specifying the maximum number of main iterations to perform. } \item{trace}{ a logical value indicating whether the deviance should be printed after each iteration. } \item{verbose}{ logical: if \code{TRUE} and model includes nonlinear terms, progress indicators are printed as the model is fitted, including a diagnostic error message if the algorithm fails. } \item{model}{ logical: if \code{TRUE} the model frame is returned. } \item{x}{ logical: if \code{TRUE} the local design matrix from the last iteration is included as a component of returned model object. } \item{termPredictors}{ logical: if \code{TRUE}, a matrix is returned with a column for each term in the model, containing the additive contribution of that term to the predictor. } \item{ridge}{numeric, a positive value for the ridge constant to be used in the fitting algorithm} \item{\dots}{ further arguments passed to fitting function. } } \details{ Models for \code{gnm} are specified by giving a symbolic description of the nonlinear predictor, of the form \code{response ~ terms}. The \code{response} is typically a numeric vector, see later in this section for alternatives. The usual symbolic language may be used to specify any linear terms, see \code{\link{formula}} for details. Nonlinear terms may be specified by calls to functions of class "nonlin". There are several "nonlin" functions in the \code{gnm} package. Some of these specify simple mathematical functions of predictors: \code{Exp}, \code{Mult}, and \code{Inv}. Others specify more specialised nonlinear terms, in particular \code{MultHomog} specifies homogeneous multiplicative interactions and \code{Dref} specifies diagonal reference terms. Users may also define their own "nonlin" functions, see \code{\link{nonlin.function}} for details. The \code{eliminate} argument may be used to specify a factor that is to be included as the first term in the model (since an intercept is then redundant, none is fitted). The structure of the factor is exploited to improve computational efficiency --- substantially so if the \code{eliminate}d factor has a large number of levels. Use of \code{eliminate} is designed for factors that are required in the model but are not of direct interest (e.g., terms needed to fit multinomial-response models as conditional Poisson models). See \code{\link{backPain}} for an example. The \code{ofInterest} argument may be used to specify coefficients of interest, the indices of which are returned in the \code{ofInterest} component of the model object. \code{print()} displays of the model object or its components obtained using accessor functions such as \code{coef()} etc, will only show these coefficients. In addition methods for \code{"gnm"} objects which may be applied to a subset of the parameters are by default applied to the coefficients of interest. See \code{\link{ofInterest}} for accessor and replacement functions. For contingency tables, the data may be provided as an object of class \code{"table"} from which the frequencies will be extracted to use as the response. In this case, the response should be specified as \code{Freq} in the model formula. The \code{"predictors"}, \code{"fitted.values"}, \code{"residuals"}, \code{"prior.weights"}, \code{"weights"}, \code{"y"} and \code{"offset"} components of the returned \code{gnm} fit will be tables with the same format as the data, completed with \code{NA}s where necessary. For binomial models, the \code{response} may be specified as a factor in which the first level denotes failure and all other levels denote success, as a two-column matrix with the columns giving the numbers of successes and failures, or as a vector of the proportions of successes. The \code{gnm} fitting algorithm consists of two stages. In the start-up iterations, any nonlinear parameters that are not specified by either the \code{start} argument of \code{gnm} or a plug-in function are updated one parameter at a time, then the linear parameters are jointly updated before the next iteration. In the main iterations, all the parameters are jointly updated, until convergence is reached or the number or iterations reaches \code{iterMax}. To solve the (typically rank-deficient) least squares problem at the heart of the \code{gnm} fitting algorithm, the design matrix is standardized and regularized (in the Levenberg-Marquardt sense) prior to solving; the \code{ridge} argument provides a degree of control over the regularization performed (smaller values may sometimes give faster convergence but can lead to numerical instability). Convergence is judged by comparing the squared components of the score vector with corresponding elements of the diagonal of the Fisher information matrix. If, for all components of the score vector, the ratio is less than \code{tolerance^2}, or the corresponding diagonal element of the Fisher information matrix is less than 1e-20, iterations cease. If the algorithm has not converged by \code{iterMax} iterations, \code{\link{exitInfo}} can be used to print information on the parameters which failed the convergence criteria at the last iteration. By default, \code{gnm} uses an over-parameterized representation of the model that is being fitted. Only minimal identifiability constraints are imposed, so that in general a random parameterization is obtained. The parameter estimates are ordered so that those for any linear terms appear first. \code{\link{getContrasts}} may be used to obtain estimates of specified scaled contrasts, if these contrasts are identifiable. For example, \code{getContrasts} may be used to estimate the contrasts between the first level of a factor and the rest, and obtain standard errors. If appropriate constraints are known in advance, or have been determined from a \code{gnm} fit, the model may be (re-)fitted using the \code{constrain} argument to specify coefficients which should be set to values specified by \code{constrainTo}. Constraints should only be specified for non-eliminated parameters. \code{\link{update}} provides a convenient way of re-fitting a \code{gnm} model with new constraints. } \value{ If \code{method = "gnmFit"}, \code{gnm} returns \code{NULL} if the algorithm has failed and an object of class \code{"gnm"} otherwise. A \code{"gnm"} object inherits first from \code{"glm"} then \code{"lm"} and is a list containing the following components: \item{ call }{ the matched call. } \item{ formula }{ the formula supplied. } \item{ constrain }{ a numeric vector specifying any coefficients that were constrained in the fitting process. } \item{ constrainTo }{ a numeric vector of the same length as \code{constrain} specifying the values which constrained parameters were set to. } \item{ family }{ the \code{family} object used. } \item{ prior.weights }{ the case weights initially supplied. } \item{ terms }{ the \code{terms} object used. } \item{ data }{ the \code{data} argument. } \item{ na.action }{ the \code{na.action} attribute of the model frame } \item{ xlevels }{ a record of the levels of the factors used in fitting. } \item{ y }{ the response used. } \item{ offset }{ the offset vector used. } \item{ coefficients }{ a named vector of non-eliminated coefficients, with an attribute \code{"eliminated"} specifying the eliminated coefficients if \code{eliminate} is non-\code{NULL}. } \item{ eliminate }{ the \code{eliminate} argument. } \item{ ofInterest }{ a named numeric vector of indices corresponding to non-eliminated coefficients, or \code{NULL}. } \item{ predictors }{ the fitted values on the link scale. } \item{ fitted.values }{ the fitted mean values, obtained by transforming the predictors by the inverse of the link function. } \item{ deviance }{ up to a constant, minus twice the maximised log-likelihood. Where sensible, the constant is chosen so that a saturated model has deviance zero. } \item{ aic }{ Akaike's \emph{An Information Criterion}, minus twice the maximized log-likelihood plus twice the number of parameters (so assuming that the dispersion is known).} \item{ iter }{ the number of main iterations.} \item{ conv }{ logical indicating whether the main iterations converged, with an attribute for use by \code{\link{exitInfo}} if \code{FALSE}. } \item{ weights }{ the \emph{working} weights, that is, the weights used in the last iteration.} \item{ residuals }{ the \emph{working} residuals, that is, the residuals from the last iteration. } \item{ df.residual }{ the residual degrees of freedom. } \item{ rank }{ the numeric rank of the fitted model. } The list may also contain the components \code{model}, \code{x}, or \code{termPredictors} if requested in the arguments to \code{gnm}. If a table was passed to \code{data} and the default for \code{na.action} was not overridden, the list will also contain a \code{table.attr} component, for use by the extractor functions. If a binomial \code{gnm} model is specified by giving a two-column response, the weights returned by \code{prior.weights} are the total numbers of cases (factored by the supplied case weights) and the component \code{y} of the result is the proportion of successes. The function \code{\link{summary.gnm}} may be used to obtain and print a summary of the results, whilst \code{\link{plot.gnm}} may be used for model diagnostics. The generic functions \code{\link{formula}}, \code{\link{family}}, \code{\link{terms}}, \code{\link{coefficients}}, \code{\link{fitted.values}}, \code{\link{deviance}}, \code{\link{extractAIC}}, \code{\link{weights}}, \code{\link{residuals}}, \code{\link{df.residual}}, \code{\link{model.frame}}, \code{\link{model.matrix}}, \code{\link{vcov}} and \code{\link{termPredictors}} maybe used to extract components from the object returned by \code{\link{gnm}} or to construct the relevant objects where necessary. Note that the generic functions \code{\link{weights}} and \code{\link{residuals}} do not act as straight-forward accessor functions for \code{gnm} objects, but return the prior weights and deviance residuals respectively, as for \code{glm} objects. } \references{ Cautres, B, Heath, A F and Firth, D (1998). Class, religion and vote in Britain and France. \emph{La Lettre de la Maison Francaise} \bold{8}. } \author{ Heather Turner and David Firth } \note{ Regular expression matching is performed using \code{grep} with default settings. } \seealso{ \code{\link{formula}} for the symbolic language used to specify formulae. \code{\link{Diag}} and \code{\link{Symm}} for specifying special types of interaction. \code{Exp}, \code{Mult}, \code{Inv}, \code{\link{MultHomog}}, \code{\link{Dref}} and \code{\link{nonlin.function}} for incorporating nonlinear terms in the \code{formula} argument to \code{gnm}. \code{\link{residuals.glm}} and the generic functions \code{\link{coef}}, \code{\link{fitted}}, etc. for extracting components from \code{gnm} objects. \code{\link{exitInfo}} to print more information on last iteration when \code{gnm} has not converged. \code{\link{getContrasts}} to estimate (identifiable) scaled contrasts from a \code{gnm} model. } \examples{ ### Analysis of a 4-way contingency table set.seed(1) print(cautres) ## Fit a "double UNIDIFF" model with the religion-vote and class-vote ## interactions both modulated by nonnegative election-specific ## multipliers. doubleUnidiff <- gnm(Freq ~ election:vote + election:class:religion + Mult(Exp(election), religion:vote) + Mult(Exp(election), class:vote), family = poisson, data = cautres) ## Examine the multipliers of the class-vote log odds ratios ofInterest(doubleUnidiff) <- pickCoef(doubleUnidiff, "class:vote[).]") coef(doubleUnidiff) ## Coefficients of interest: ## Mult(Exp(.), class:vote).election1 ## -0.38357138 ## Mult(Exp(.), class:vote).election2 ## 0.29816599 ## Mult(Exp(.), class:vote).election3 ## 0.06580307 ## Mult(Exp(.), class:vote).election4 ## -0.02174104 ## Re-parameterize by setting first multiplier to zero getContrasts(doubleUnidiff, ofInterest(doubleUnidiff)) ## estimate SE ## Mult(Exp(.), class:vote).election1 0.0000000 0.0000000 ## Mult(Exp(.), class:vote).election2 0.6817374 0.2401644 ## Mult(Exp(.), class:vote).election3 0.4493745 0.2473521 ## Mult(Exp(.), class:vote).election4 0.3618301 0.2534754 ## quasiSE quasiVar ## Mult(Exp(.), class:vote).election1 0.22854401 0.052232363 ## Mult(Exp(.), class:vote).election2 0.07395886 0.005469913 ## Mult(Exp(.), class:vote).election3 0.09475938 0.008979340 ## Mult(Exp(.), class:vote).election4 0.10934798 0.011956981 ## Same thing but with last multiplier as reference category: getContrasts(doubleUnidiff, rev(ofInterest(doubleUnidiff))) ## estimate SE ## Mult(Exp(.), class:vote).election4 0.00000000 0.0000000 ## Mult(Exp(.), class:vote).election3 0.08754436 0.1446833 ## Mult(Exp(.), class:vote).election2 0.31990727 0.1320022 ## Mult(Exp(.), class:vote).election1 -0.36183013 0.2534754 ## quasiSE quasiVar ## Mult(Exp(.), class:vote).election4 0.10934798 0.011956981 ## Mult(Exp(.), class:vote).election3 0.09475938 0.008979340 ## Mult(Exp(.), class:vote).election2 0.07395886 0.005469913 ## Mult(Exp(.), class:vote).election1 0.22854401 0.052232363 ## Re-fit model with first multiplier set to zero doubleUnidiffConstrained <- update(doubleUnidiff, constrain = ofInterest(doubleUnidiff)[1]) ## Examine the multipliers of the class-vote log odds ratios coef(doubleUnidiffConstrained)[ofInterest(doubleUnidiff)] ## ...as using 'getContrasts' (to 4 d.p.). } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } gnm/man/Topo.Rd0000744000176200001440000000527213311222714013021 0ustar liggesusers\name{Topo} \alias{Topo} \title{ Topological Interaction of Factors } \description{ Given two or more factors \code{Topo} creates an interaction factor as specified by an array of levels, which may be arbitrarily structured. } \usage{ Topo(..., spec = NULL) } \arguments{ \item{\dots}{ two or more factors } \item{spec}{ an array of levels, with dimensions corresponding to the number of levels of each factor in the interaction } } \value{ A factor of levels extracted from the levels array given in \code{spec}, using the given factors as index variables. } \references{ Erikson, R., Goldthorpe, J. H. and Portocarero, L. (1982) Social Fluidity in Industrial Nations: England, France and Sweden. \emph{Brit. J. Sociol.} \bold{33(1)}, 1-34. Xie, Y. (1992) The Log-multiplicative Layer Effect Model for Comparing Mobility Tables. \emph{Am. Sociol. Rev.} \bold{57(3)}, 380-395. } \author{ David Firth } \seealso{ \code{\link{Symm}} and \code{\link{Diag}} for special cases } \examples{ set.seed(1) ### Collapse to 7 by 7 table as in Erikson (1982) erikson <- as.data.frame(erikson) lvl <- levels(erikson$origin) levels(erikson$origin) <- levels(erikson$destination) <- c(rep(paste(lvl[1:2], collapse = " + "), 2), lvl[3], rep(paste(lvl[4:5], collapse = " + "), 2), lvl[6:9]) erikson <- xtabs(Freq ~ origin + destination + country, data = erikson) ### Create array of interaction levels as in Table 2 of Xie (1992) levelMatrix <- matrix(c(2, 3, 4, 6, 5, 6, 6, 3, 3, 4, 6, 4, 5, 6, 4, 4, 2, 5, 5, 5, 5, 6, 6, 5, 1, 6, 5, 2, 4, 4, 5, 6, 3, 4, 5, 5, 4, 5, 5, 3, 3, 5, 6, 6, 5, 3, 5, 4, 1), 7, 7, byrow = TRUE) ### Fit the levels models given in Table 3 of Xie (1992) ## Null association between origin and destination nullModel <- gnm(Freq ~ country:origin + country:destination, family = poisson, data = erikson) ## Interaction specified by levelMatrix, common to all countries commonTopo <- update(nullModel, ~ . + Topo(origin, destination, spec = levelMatrix)) ## Interaction specified by levelMatrix, different multiplier for ## each country multTopo <- update(nullModel, ~ . + Mult(Exp(country), Topo(origin, destination, spec = levelMatrix))) ## Interaction specified by levelMatrix, different effects for ## each country separateTopo <- update(nullModel, ~ . + country:Topo(origin, destination, spec = levelMatrix)) } \keyword{ models } gnm/man/Exp.Rd0000744000176200001440000000317013152512335012633 0ustar liggesusers\name{Exp} \alias{Exp} \title{ Specify the Exponential of a Predictor in a gnm Model Formula } \description{ A function of class \code{"nonlin"} to specify the exponential of a predictor in the formula argument to \code{\link{gnm}}. } \usage{ Exp(expression, inst = NULL) } \arguments{ \item{expression}{ a symbolic expression representing the (possibly nonlinear) predictor. } \item{inst}{ (optional) an integer specifying the instance number of the term. } } \details{ The \code{expression} argument is interpreted as the right hand side of a formula in an object of class \code{"formula"}, except that an intercept term is not added by default. Any function of class \code{"nonlin"} may be used in addition to the usual operators and functions. } \value{ A list with the components required of a \code{"nonlin"} function: \item{ predictors }{the \code{expression} argument passed to \code{Exp}} \item{ term }{a function to create a deparsed mathematical expression of the term, given a label for the predictor.} \item{ call }{the call to use as a prefix for parameter labels. } } \author{ Heather Turner and David Firth } \seealso{ \code{\link{gnm}}, \code{\link{formula}}, \code{\link{nonlin.function}}} \examples{ set.seed(1) ## Using 'Mult' with 'Exp' to constrain the first constituent multiplier ## to be non-negative ## Fit the "UNIDIFF" mobility model across education levels unidiff <- gnm(Freq ~ educ*orig + educ*dest + Mult(Exp(educ), orig:dest), family = poisson, data = yaish, subset = (dest != 7)) } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } gnm/man/expandCategorical.Rd0000744000176200001440000000753713311231062015517 0ustar liggesusers\name{expandCategorical} \alias{expandCategorical} \title{ Expand Data Frame by Re-expressing Categorical Data as Counts } \description{ Expands the rows of a data frame by re-expressing observations of a categorical variable specified by \code{catvar}, such that the column(s) corresponding to \code{catvar} are replaced by a factor specifying the possible categories for each observation and a vector of 0/1 counts over these categories. %Expands the rows of a data frame containing a categorical variable %\code{catvar} with \eqn{c} possible categories, such that each %observation of \code{catvar} is represented by \eqn{c} 0/1 counts and %all other variables are replicated appropriately. } \usage{ expandCategorical(data, catvar, sep = ".", countvar = "count", idvar = "id", as.ordered = FALSE, group = TRUE) } \arguments{ \item{data}{ a data frame. } \item{catvar}{ a character vector specifying factors in \code{data} whose interaction will form the basis of the expansion. } \item{sep}{ a character string used to separate the concatenated values of \code{catvar} in the name of the new interaction factor. } \item{countvar}{ (optional) a character string to be used for the name of the new count variable. } \item{idvar}{ (optional) a character string to be used for the name of the new factor identifying the original rows (cases). } \item{as.ordered}{ logical - whether the new interaction factor should be of class \code{"ordered"}.} \item{group}{logical: whether or not to group individuals with common values over all covariates. } } \details{ Each row of the data frame is replicated \eqn{c} times, where \eqn{c} is the number of levels of the interaction of the factors specified by \code{catvar}. In the expanded data frame, the columns specified by \code{catvar} are replaced by a factor specifying the \eqn{r} possible categories for each case, named by the concatenated values of \code{catvar} separated by \code{sep}. The ordering of factor levels will be preserved in the creation of the new factor, but this factor will not be of class \code{"ordered"} unless the argument \code{as.ordered = TRUE}. A variable with name \code{countvar} is added to the data frame which is equal to 1 for the observed category in each case and 0 elsewhere. Finally a factor with name \code{idvar} is added to index the cases. } \value{ The expanded data frame as described in Details. } \author{ Heather Turner } \note{ Re-expressing categorical data in this way allows a multinomial response to be modelled as a poisson response, see examples. } \seealso{ \code{\link{gnm}}, \code{\link[nnet]{multinom}}, \code{\link{reshape}} } \references{ Anderson, J. A. (1984) Regression and Ordered Categorical Variables. \emph{J. R. Statist. Soc. B}, \bold{46(1)}, 1-30. } \examples{ ### Example from help(multinom, package = "nnet") library(MASS) example(birthwt) library(nnet) bwt.mu <- multinom(low ~ ., data = bwt) ## Equivalent using gnm - include unestimable main effects in model so ## that interactions with low0 automatically set to zero, else could use ## 'constrain' argument. bwtLong <- expandCategorical(bwt, "low", group = FALSE) bwt.po <- gnm(count ~ low*(. - id), eliminate = id, data = bwtLong, family = "poisson") summary(bwt.po) # same deviance; df reflect extra id parameters ### Example from ?backPain set.seed(1) summary(backPain) backPainLong <- expandCategorical(backPain, "pain") ## Fit models described in Table 5 of Anderson (1984) noRelationship <- gnm(count ~ pain, eliminate = id, family = "poisson", data = backPainLong) oneDimensional <- update(noRelationship, ~ . + Mult(pain, x1 + x2 + x3)) } \keyword{ manip } \keyword{ models } gnm/man/backPain.Rd0000744000176200001440000000617613152512335013620 0ustar liggesusers\name{backPain} \alias{backPain} \docType{data} \title{ Data on Back Pain Prognosis, from Anderson (1984) } \description{ Data from a study of patients suffering from back pain. Prognostic variables were recorded at presentation and progress was categorised three weeks after treatment. } \usage{backPain} \format{ A data frame with 101 observations on the following 4 variables. \describe{ \item{x1}{length of previous attack.} \item{x2}{pain change.} \item{x3}{lordosis.} \item{pain}{an ordered factor describing the progress of each patient with levels \code{worse} < \code{same} < \code{slight.improvement} < \code{moderate.improvement} < \code{marked.improvement} < \code{complete.relief}. } } } \source{ \url{http://ideas.repec.org/c/boc/bocode/s419001.html} } \references{ Anderson, J. A. (1984) Regression and Ordered Categorical Variables. \emph{J. R. Statist. Soc. B}, \bold{46(1)}, 1-30. } \examples{ set.seed(1) summary(backPain) ### Re-express as count data backPainLong <- expandCategorical(backPain, "pain") ### Fit models described in Table 5 of Anderson (1984) ### Logistic family models noRelationship <- gnm(count ~ pain, eliminate = id, family = "poisson", data = backPainLong) ## stereotype model oneDimensional <- update(noRelationship, ~ . + Mult(pain, x1 + x2 + x3)) ## multinomial logistic threeDimensional <- update(noRelationship, ~ . + pain:(x1 + x2 + x3)) ### Models to determine distinguishability in stereotype model ## constrain scale of category-specific multipliers oneDimensional <- update(noRelationship, ~ . + Mult(pain, offset(x1) + x2 + x3)) ## obtain identifiable contrasts & id possibly indistinguishable slopes getContrasts(oneDimensional, pickCoef(oneDimensional, "[.]pain")) \dontrun{ ## (this part not needed for package testing) ## fit simpler models and compare .pain <- backPainLong$pain levels(.pain)[2:3] <- paste(levels(.pain)[2:3], collapse = " | ") fiveGroups <- update(noRelationship, ~ . + Mult(.pain, x1 + x2 + x3)) levels(.pain)[4:5] <- paste(levels(.pain)[4:5], collapse = " | ") fourGroups <- update(fiveGroups) levels(.pain)[2:3] <- paste(levels(.pain)[2:3], collapse = " | ") threeGroups <- update(fourGroups) ### Grouped continuous model, aka proportional odds model library(MASS) sixCategories <- polr(pain ~ x1 + x2 + x3, data = backPain) ### Obtain number of parameters and log-likelihoods for equivalent ### multinomial models as presented in Anderson (1984) logLikMultinom <- function(model, size){ object <- get(model) if (inherits(object, "gnm")) { l <- sum(object$y * log(object$fitted/size)) c(nParameters = object$rank - nlevels(object$eliminate), logLikelihood = l) } else c(nParameters = object$edf, logLikelihood = -deviance(object)/2) } size <- tapply(backPainLong$count, backPainLong$id, sum)[backPainLong$id] models <- c("threeDimensional", "oneDimensional", "noRelationship", "fiveGroups", "fourGroups", "threeGroups", "sixCategories") t(sapply(models, logLikMultinom, size)) } } \keyword{datasets} gnm/man/wedderburn.Rd0000744000176200001440000000503113152512335014236 0ustar liggesusers\name{wedderburn} \alias{wedderburn} \title{ Wedderburn Quasi-likelihood Family } \description{ Creates a \code{\link{family}} object for use with \code{\link{glm}}, \code{\link{gnm}}, etc., for the variance function \eqn{[\mu(1-\mu)]^2} introduced by Wedderburn (1974) for response values in [0,1]. } \usage{ wedderburn(link = "logit") } \arguments{ \item{link}{ The name of a link function. Allowed are "logit", "probit" and "cloglog". } } \value{ An object of class \code{\link{family}}. } \references{ Gabriel, K R (1998). Generalised bilinear regression. \emph{Biometrika} \bold{85}, 689--700. McCullagh, P and Nelder, J A (1989). \emph{Generalized Linear Models} (2nd ed). Chapman and Hall. Wedderburn, R W M (1974). Quasilikelihood functions, generalized linear models and the Gauss-Newton method. \emph{Biometrika} \bold{61}, 439--47. } \author{ Modification of \code{\link{binomial}} by the R Core Team. Adapted for the Wedderburn quasi-likelihood family by David Firth. } \note{ The reported deviance involves an arbitrary constant (see McCullagh and Nelder, 1989, p330); for estimating dispersion, use the Pearson chi-squared statistic instead. } \seealso{ \code{\link{glm}}, \code{\link{gnm}}, \code{\link{family}} } \examples{ set.seed(1) ### Use data from Wedderburn (1974), see ?barley ### Fit Wedderburn's logit model with variance proportional to the ### square of mu(1-mu) logitModel <- glm(y ~ site + variety, family = wedderburn, data = barley) fit <- fitted(logitModel) print(sum((barley$y - fit)^2 / (fit * (1-fit))^2)) ## Agrees with the chi-squared value reported in McCullagh and Nelder ## (1989, p331), which differs slightly from Wedderburn's reported value. ### Fit the biplot model as in Gabriel (1998, p694) biplotModel <- gnm(y ~ -1 + instances(Mult(site, variety), 2), family = wedderburn, data = barley) barleySVD <- svd(matrix(biplotModel$predictors, 10, 9)) A <- sweep(barleySVD$v, 2, sqrt(barleySVD$d), "*")[, 1:2] B <- sweep(barleySVD$u, 2, sqrt(barleySVD$d), "*")[, 1:2] ## These are essentially A and B as in Gabriel (1998, p694), from which ## the biplot is made by plot(rbind(A, B), pch = c(LETTERS[1:9], as.character(1:9), "X")) ### Fit the double-additive model as in Gabriel (1998, p697) variety.binary <- factor(match(barley$variety, c(2,3,6), nomatch = 0) > 0, labels = c("Rest", "2,3,6")) doubleAdditive <- gnm(y ~ variety + Mult(site, variety.binary), family = wedderburn, data = barley) } \keyword{ models } gnm/man/exitInfo.Rd0000744000176200001440000000315613152512335013670 0ustar liggesusers\name{exitInfo} \alias{exitInfo} \title{ Print Exit Information for gnm Fit } \description{ A utility function to print information on final iteration in \code{gnm} fit, intended for use when \code{gnm} has not converged. } \usage{ exitInfo(object) } \arguments{ \item{object}{ a \code{gnm} object. } } \details{ If \code{gnm} has not converged within the pre-specified maximum number of iterations, it may be because the algorithm has converged to a non-solution of the likelihood equations. In order to determine appropriate action, it is necessary to differentiate this case from one of near-convergence to the solution. \code{exitInfo} prints the absolute score and the corresponding convergence criterion for all parameters which failed to meet the convergence criterion at the last iteration. Clearly a small number of parameters with scores close to the criterion suggests near-convergence. } \references{ Vargas, M, Crossa, J, van Eeuwijk, F, Sayre, K D and Reynolds, M P (2001). Interpreting treatment by environment interaction in agronomy trials. \emph{Agronomy Journal} \bold{93}, 949--960. } \author{ Heather Turner } \seealso{ \code{\link{gnm}}} \examples{ ## Fit a "double UNIDIFF" model with low iterMax for illustration! set.seed(1) doubleUnidiff <- gnm(Freq ~ election*vote + election*class*religion + Mult(Exp(election), religion:vote) + Mult(Exp(election), class:vote), family = poisson, data = cautres, iterMax = 10) exitInfo(doubleUnidiff) } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } gnm/man/termPredictors.Rd0000744000176200001440000000314613152512335015110 0ustar liggesusers\name{termPredictors} \alias{termPredictors} \title{ Extract Term Contributions to Predictor } \description{ \code{termPredictors} is a generic function which extracts the contribution of each term to the predictor from a fitted model object. } \usage{ termPredictors(object, ...) } \arguments{ \item{object}{ a fitted model object. } \item{\dots}{ additional arguments for method functions. } } \details{ The default method assumes that the predictor is linear and calculates the contribution of each term from the model matrix and fitted coefficients. A method is also available for \code{\link{gnm}} objects. } \value{ A matrix with the additive components of the predictor in labelled columns. } \author{ Heather Turner } \seealso{ \code{\link{gnm}} } \examples{ ## Linear model G <- gl(4, 6) x <- 1:24 y <- rnorm(24, 0, 1) lmGx <- lm(y ~ G + x) contrib <- termPredictors(lmGx) contrib all.equal(as.numeric(rowSums(contrib)), as.numeric(lmGx$fitted)) #TRUE ## Generalized linear model y <- cbind(rbinom(24, 10, 0.5), rep(10, 24)) glmGx <- glm(y ~ G + x, family = binomial) contrib <- termPredictors(glmGx) contrib all.equal(as.numeric(rowSums(contrib)), as.numeric(glmGx$linear.predictors)) #TRUE ## Generalized nonlinear model A <- gl(4, 6) B <- gl(6, 1, 24) y <- cbind(rbinom(24, 10, 0.5), rep(10, 24)) set.seed(1) gnmAB <- gnm(y ~ A + B + Mult(A, B), family = binomial) contrib <- termPredictors(gnmAB) contrib all.equal(as.numeric(rowSums(contrib)), as.numeric(gnmAB$predictors)) #TRUE } \keyword{ models } \keyword{ regression } gnm/man/voting.Rd0000744000176200001440000000412213152512335013403 0ustar liggesusers\name{voting} \alias{voting} \docType{data} \title{Data on Social Mobility and the Labour Vote} \description{ Voting data from the 1987 British general election, cross-classified by the class of the head of household and the class of their father. } \usage{voting} \format{ A data frame with 25 observations on the following 4 variables. \describe{ \item{\code{percentage}}{the percentage of the cell voting Labour.} \item{\code{total}}{the cell count.} \item{\code{origin}}{a factor describing the father's class with levels \code{1:5}.} \item{\code{destination}}{a factor describing the head of household's class with levels \code{1:5}.} } } \source{ Clifford, P. and Heath, A. F. (1993) The Political Consequences of Social Mobility. \emph{J. Roy. Stat. Soc. A}, \bold{156(1)}, 51-61. } \examples{ ### Examples from Clifford and Heath paper ### (Results differ slightly - possible transcription error in ### published data?) set.seed(1) ## reconstruct counts voting Labour/non-Labour count <- with(voting, percentage/100 * total) yvar <- cbind(count, voting$total - count) ## fit diagonal reference model with constant weights classMobility <- gnm(yvar ~ -1 + Dref(origin, destination), family = binomial, data = voting) DrefWeights(classMobility) ## create factors indicating movement in and out of salariat (class 1) upward <- with(voting, origin != 1 & destination == 1) downward <- with(voting, origin == 1 & destination != 1) ## fit separate weights for the "socially mobile" groups socialMobility <- gnm(yvar ~ -1 + Dref(origin, destination, delta = ~ 1 + downward + upward), family = binomial, data = voting) DrefWeights(socialMobility) ## fit separate weights for downwardly mobile groups only downwardMobility <- gnm(yvar ~ -1 + Dref(origin, destination, delta = ~ 1 + downward), family = binomial, data = voting) DrefWeights(downwardMobility) } \keyword{datasets} gnm/man/MultHomog.Rd0000744000176200001440000000570013152512335014013 0ustar liggesusers\name{MultHomog} \alias{MultHomog} \title{Specify a Multiplicative Interaction with Homogeneous Effects in a gnm Model Formula} \description{ A function of class \code{"nonlin"} to specify a multiplicative interaction with homogeneous effects in the formula argument to \code{\link{gnm}}. } \usage{ MultHomog(..., inst = NULL) } \arguments{ \item{\dots}{ a comma-separated list of two or more factors. } \item{inst}{ (optional) an integer specifying the instance number of the term. } } \details{ \code{MultHomog} specifies instances of a multiplicative interaction in which the constituent multipliers are the effects of two or more factors and the effects of these factors are constrained to be equal when the factor levels are equal. Thus the interaction effect would be \deqn{\gamma_i\gamma_j...}{gamma_i gamma_j ...} for an observation with level \eqn{i} of the first factor, level \eqn{j} of the second factor and so on, where \eqn{\gamma_l}{gamma_l} is the effect for level \eqn{l} of the homogeneous multiplicative factor. If the factors passed to \code{MultHomog} do not have exactly the same levels, the set of levels is taken to be the union of the factor levels, sorted into increasing order. } \value{ A list with the anticipated components of a \code{"nonlin"} function: \item{ predictors }{ the factors passed to \code{MultHomog}} \item{ common }{ an index to specify that common effects are to be estimated across the factors } \item{ term }{ a function to create a deparsed mathematical expression of the term, given labels for the predictors.} \item{ call }{ the call to use as a prefix for parameter labels. } } \references{ Goodman, L. A. (1979) Simple Models for the Analysis of Association in Cross-Classifications having Ordered Categories. \emph{J. Am. Stat. Assoc.}, \bold{74(367)}, 537-552. } \note{Currently, \code{MultHomog} can only be used to specify a one-dimensional interaction. See examples for a workaround to specify interactions with more than one dimension. } \author{ Heather Turner } \seealso{\code{\link{gnm}}, \code{\link{formula}}, \code{\link{instances}}, \code{\link{nonlin.function}}, \code{\link{Mult}}} \examples{ set.seed(1) ### Fit an association model with homogeneous row-column effects rc1 <- gnm(Freq ~ r + c + Diag(r,c) + MultHomog(r, c), family = poisson, data = friend) rc1 \dontrun{ ### Extend to two-component interaction rc2 <- update(rc1, . ~ . + MultHomog(r, c, inst = 2), etastart = rc1$predictors) rc2 } ### For factors with a large number of levels, save time by ### setting diagonal elements to NA rather than fitting exactly; ### skipping start-up iterations may also save time dat <- as.data.frame(friend) id <- with(dat, r == c) dat[id,] <- NA rc2 <- gnm(Freq ~ r + c + instances(MultHomog(r, c), 2), family = poisson, data = dat, iterStart = 0) } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } gnm/man/barleyHeights.Rd0000744000176200001440000000326713152512335014700 0ustar liggesusers\name{barleyHeights} \alias{barleyHeights} \docType{data} \title{ Heights of Barley Plants } \description{ Average heights for 15 genotypes of barley recorded over 9 years. } \usage{barleyHeights} \format{ A data frame with 135 observations on the following 3 variables. \describe{ \item{\code{height}}{average height over 4 replicates (cm)} \item{\code{year}}{a factor with 9 levels \code{1974} to \code{1982}} \item{\code{genotype}}{a factor with 15 levels \code{1:15}} } } \source{ Aastveit, A. H. \& Martens, H. (1986). ANOVA interactions interpreted by partial least squares regression. \emph{Biometrics}, \bold{42}, 829--844. } \references{ Chadoeuf, J \& Denis, J B (1991). Asymptotic variances for the multiplicative interaction model. \emph{J. App. Stat.} \bold{18(3)}, 331--353. } \examples{ set.seed(1) ## Fit AMMI-1 model barleyModel <- gnm(height ~ year + genotype + Mult(year, genotype), data = barleyHeights) ## Get row and column scores with se's gamma <- getContrasts(barleyModel, pickCoef(barleyModel, "[.]y"), ref = "mean", scaleWeights = "unit") delta <- getContrasts(barleyModel, pickCoef(barleyModel, "[.]g"), ref = "mean", scaleWeights = "unit") ## Corresponding CI's similar to Chadoeuf & Denis (1991) Table 8 ## (allowing for change in sign) gamma[[2]][,1] + (gamma[[2]][,2]) \%o\% c(-1.96, 1.96) delta[[2]][,1] + (delta[[2]][,2]) \%o\% c(-1.96, 1.96) ## Multiplier of row and column scores height <- matrix(scale(barleyHeights$height, scale = FALSE), 15, 9) R <- height - outer(rowMeans(height), colMeans(height), "+") svd(R)$d[1] } \keyword{datasets} gnm/man/confint.gnm.Rd0000744000176200001440000001073213615560322014324 0ustar liggesusers\name{confint.gnm} \alias{confint.gnm} \alias{confint.profile.gnm} \title{ Compute Confidence Intervals of Parameters in a Generalized Nonlinear Model } \description{ Computes confidence intervals for one or more parameters in a generalized nonlinear model, based on the profiled deviance. } \usage{ \method{confint}{gnm}(object, parm = ofInterest(object), level = 0.95, trace = FALSE, ...) \method{confint}{profile.gnm}(object, parm = names(object), level = 0.95, ...) } \arguments{ \item{object}{ an object of class \code{"gnm"} or \code{"profile.gnm"}} \item{parm}{ (optional) either a numeric vector of indices or a character vector of names, specifying the parameters for which confidence intervals are to be estimated. If \code{parm} is \code{NULL}, confidence intervals are found for all parameters.} \item{level}{ the confidence level required. } \item{trace}{ a logical value indicating whether profiling should be traced. } \item{\dots}{ arguments passed to or from other methods } } \details{ These are methods for the generic function \code{confint} in the \code{base} package. For \code{"gnm"} objects, \code{profile.gnm} is first called to profile the deviance over each parameter specified by \code{parm}, or over all parameters in the model if \code{parm} is \code{NULL}. The method for \code{"profile.gnm"} objects is then called, which interpolates the deviance profiles to estimate the limits of the confidence interval for each parameter, see \code{\link{profile.gnm}} for more details. If a \code{"profile.gnm"} object is passed directly to \code{confint}, parameters specified by \code{parm} must be a subset of the profiled parameters. For unidentified parameters a confidence interval cannot be calculated and the limits will be returned as \code{NA}. If the deviance curve has an asymptote and a limit of the confidence interval cannot be reached, the limit will be returned as \code{-Inf} or \code{Inf} appropriately. If the range of the profile does not extend far enough to estimate a limit of the confidence interval, the limit will be returned as \code{NA}. In such cases, it may be desirable create a profile object directly, see \code{\link{profile.gnm}} for more details. } \value{ A matrix (or vector) with columns giving lower and upper confidence limits for each parameter. These will be labelled as (1-level)/2 and 1 - (1-level)/2 in \% (by default 2.5\% and 97.5\%). } \author{ Modification of \code{MASS:::confint.glm} by W. N. Venables and B. D. Ripley. Adapted for \code{"gnm"} objects by Heather Turner. } \seealso{ \code{\link{profile.gnm}}, \code{\link{gnm}}, \code{\link{confint.glm}}, \code{\link{profile.glm}}} \examples{ ### Example in which profiling doesn't take too long count <- with(voting, percentage/100 * total) yvar <- cbind(count, voting$total - count) classMobility <- gnm(yvar ~ -1 + Dref(origin, destination), constrain = "delta1", family = binomial, data = voting) ## profile diagonal effects confint(classMobility, parm = 3:7, trace = TRUE) \dontrun{ ### Profiling takes much longer here, but example more interesting! unidiff <- gnm(Freq ~ educ*orig + educ*dest + Mult(Exp(educ), orig:dest), ofInterest = "[.]educ", constrain = "[.]educ1", family = poisson, data = yaish, subset = (dest != 7)) ## Letting 'confint' compute profile confint(unidiff, trace = TRUE) ## 2.5 \% 97.5 \% ## Mult(Exp(.), orig:dest).educ1 NA NA ## Mult(Exp(.), orig:dest).educ2 -0.5978901 0.1022447 ## Mult(Exp(.), orig:dest).educ3 -1.4836854 -0.2362378 ## Mult(Exp(.), orig:dest).educ4 -2.5792398 -0.2953420 ## Mult(Exp(.), orig:dest).educ5 -Inf -0.7007616 ## Creating profile object first with user-specified stepsize prof <- profile(unidiff, trace = TRUE, stepsize = 0.1) confint(prof, ofInterest(unidiff)[2:5]) ## 2.5 \% 97.5 \% ## Mult(Exp(.), orig:dest).educ2 -0.5978324 0.1022441 ## Mult(Exp(.), orig:dest).educ3 -1.4834753 -0.2362138 ## Mult(Exp(.), orig:dest).educ4 NA -0.2950790 ## Mult(Exp(.), orig:dest).educ5 NA NA ## For 95\% confidence interval, need to estimate parameters for which ## z = +/- 1.96. Profile has not gone far enough for last two parameters range(prof[[4]]$z) ## -1.566601 2.408650 range(prof[[5]]$z) ## -0.5751376 1.1989487 } } \keyword{ models } \keyword{ nonlinear } gnm/man/Dref.Rd0000744000176200001440000002221613152512335012761 0ustar liggesusers\name{Dref} \alias{Dref} \alias{DrefWeights} \title{Specify a Diagonal Reference Term in a gnm Model Formula} \description{ Dref is a function of class \code{"nonlin"} to specify a diagonal reference term in the formula argument to \code{\link{gnm}}. } \usage{ Dref(..., delta = ~ 1) } \arguments{ \item{\dots}{a comma-separated list of two or more factors.} \item{delta}{a formula with no left-hand-side specifying the model for each factor weight.} } \details{ \code{Dref} specifies diagonal reference terms as introduced by Sobel (1981, 1985). Such terms comprise an additive component for each factor of the form \deqn{w_f\gamma_l}{w_f gamma_l} where \eqn{w_f} is the weight for factor \eqn{f}, \eqn{\gamma_l}{gamma_l} is the diagonal effect for level \eqn{l} and \eqn{l} is the level of factor \eqn{f} for the given data point. The weights are constrained to be nonnegative and to sum to one as follows \deqn{w_f = \frac{e^{\delta_f}}{\sum_i e^{\delta_i}}}{ w_f = exp(delta_f)/sum_i(exp(delta_i))} and the \eqn{\delta_f}{delta_f} are modelled as specified by the \code{delta} argument (constant weights by default). The returned parameters are those in the model for \eqn{\delta_f}{delta_f}, rather than the implied weights \eqn{w_f}. The \code{DrefWeights} function will take a fitted gnm model and return the weights \eqn{w_f}, along with their standard errors. If the factors passed to \code{Dref} do not have exactly the same levels, the set of levels in the diagonal reference term is taken to be the union of the factor levels, sorted into increasing order. } \value{ A list with the anticipated components of a "nonlin" function: \item{ predictors }{ the factors passed to \code{Dref} and the formulae for the weights. } \item{ common }{ an index to specify that common effects are to be estimated across the factors. } \item{ term }{ a function to create a deparsed mathematical expression of the term, given labels for the predictors.} \item{ start }{ a function to generate starting values for the parameters.} \item{ call }{ the call to use as a prefix for parameter labels. } } \references{Sobel, M. E. (1981), Diagonal mobility models: A substantively motivated class of designs for the analysis of mobility effects. \emph{American Sociological Review} \bold{46}, 893--906. Sobel, M. E. (1985), Social mobility and fertility revisited: Some new models for the analysis of the mobility effects hypothesis. \emph{American Sociological Review} \bold{50}, 699--712. Clifford, P. and Heath, A. F. (1993) The Political Consequences of Social Mobility. \emph{J. Roy. Stat. Soc. A}, \bold{156(1)}, 51-61. Van der Slik, F. W. P., De Graaf, N. D and Gerris, J. R. M. (2002) Conformity to Parental Rules: Asymmetric Influences of Father's and Mother's Levels of Education. \emph{European Sociological Review} \bold{18(4)}, 489 -- 502. } \author{ Heather Turner } \seealso{\code{\link{gnm}}, \code{\link{formula}}, \code{\link{nonlin.function}}} \examples{ ### Examples from Clifford and Heath paper ### (Results differ slightly - possible transcription error in ### published data?) set.seed(1) ## reconstruct counts voting Labour/non-Labour count <- with(voting, percentage/100 * total) yvar <- cbind(count, voting$total - count) ## fit diagonal reference model with constant weights classMobility <- gnm(yvar ~ -1 + Dref(origin, destination), family = binomial, data = voting) DrefWeights(classMobility) ## create factors indicating movement in and out of salariat (class 1) upward <- with(voting, origin != 1 & destination == 1) downward <- with(voting, origin == 1 & destination != 1) ## fit separate weights for the "socially mobile" groups socialMobility <- gnm(yvar ~ -1 + Dref(origin, destination, delta = ~ 1 + downward + upward), family = binomial, data = voting) DrefWeights(socialMobility) ## fit separate weights for downwardly mobile groups only downwardMobility <- gnm(yvar ~ -1 + Dref(origin, destination, delta = ~ 1 + downward), family = binomial, data = voting) DrefWeights(downwardMobility) \dontrun{ ### Examples from Van der Slik paper ### For illustration only - data not publically available ### Using data in data.frame named 'conformity', with variables ### MCFM - mother's conformity score ### FCFF - father's conformity score ### MOPLM - a factor describing the mother's education with 7 levels ### FOPLF - a factor describing the father's education with 7 levels ### AGEM - mother's birth cohort ### MRMM - mother's traditional role model ### FRMF - father's traditional role model ### MWORK - mother's employment ### MFCM - mother's family conflict score ### FFCF - father's family conflict score set.seed(1) ## Models for mothers' conformity score as specified in Figure 1 A <- gnm(MCFM ~ -1 + AGEM + MRMM + FRMF + MWORK + MFCM + Dref(MOPLM, FOPLF), family = gaussian, data = conformity, verbose = FALSE) A ## Call: ## gnm(formula = MCFM ~ -1 + AGEM + MRMM + FRMF + MWORK + MFCM + ## Dref(MOPLM, FOPLF), family = gaussian, data = conformity, ## verbose = FALSE) ## ## Coefficients: ## AGEM MRMM ## 0.06363 -0.32425 ## FRMF MWORK ## -0.25324 -0.06430 ## MFCM Dref(MOPLM, FOPLF)delta1 ## -0.06043 -0.33731 ## Dref(MOPLM, FOPLF)delta2 Dref(., .).MOPLM|FOPLF1 ## -0.02505 4.95121 ## Dref(., .).MOPLM|FOPLF2 Dref(., .).MOPLM|FOPLF3 ## 4.86329 4.86458 ## Dref(., .).MOPLM|FOPLF4 Dref(., .).MOPLM|FOPLF5 ## 4.72343 4.43516 ## Dref(., .).MOPLM|FOPLF6 Dref(., .).MOPLM|FOPLF7 ## 4.18873 4.43378 ## ## Deviance: 425.3389 ## Pearson chi-squared: 425.3389 ## Residual df: 576 ## Weights as in Table 4 DrefWeights(A) ## Refitting with parameters of first Dref weight constrained to zero ## $MOPLM ## weight se ## 0.4225636 0.1439829 ## ## $FOPLF ## weight se ## 0.5774364 0.1439829 F <- gnm(MCFM ~ -1 + AGEM + MRMM + FRMF + MWORK + MFCM + Dref(MOPLM, FOPLF, delta = ~1 + MFCM), family = gaussian, data = conformity, verbose = FALSE) F ## Call: ## gnm(formula = MCFM ~ -1 + AGEM + MRMM + FRMF + MWORK + MFCM + ## Dref(MOPLM, FOPLF, delta = ~1 + MFCM), family = gaussian, ## data = conformity, verbose = FALSE) ## ## ## Coefficients: ## AGEM ## 0.05818 ## MRMM ## -0.32701 ## FRMF ## -0.25772 ## MWORK ## -0.07847 ## MFCM ## -0.01694 ## Dref(MOPLM, FOPLF, delta = ~ . + MFCM).delta1(Intercept) ## 1.03515 ## Dref(MOPLM, FOPLF, delta = ~ 1 + .).delta1MFCM ## -1.77756 ## Dref(MOPLM, FOPLF, delta = ~ . + MFCM).delta2(Intercept) ## -0.03515 ## Dref(MOPLM, FOPLF, delta = ~ 1 + .).delta2MFCM ## 2.77756 ## Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF1 ## 4.82476 ## Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF2 ## 4.88066 ## Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF3 ## 4.83969 ## Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF4 ## 4.74850 ## Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF5 ## 4.42020 ## Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF6 ## 4.17957 ## Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF7 ## 4.40819 ## ## Deviance: 420.9022 ## Pearson chi-squared: 420.9022 ## Residual df: 575 ## ## ## Standard error for MFCM == 1 lower than reported by Van der Slik et al DrefWeights(F) ## Refitting with parameters of first Dref weight constrained to zero ## $MOPLM ## MFCM weight se ## 1 1 0.02974675 0.2277711 ## 2 0 0.74465224 0.2006916 ## ## $FOPLF ## MFCM weight se ## 1 1 0.9702532 0.2277711 ## 2 0 0.2553478 0.2006916 } } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } gnm/man/profile.gnm.Rd0000744000176200001440000001735213615560322014331 0ustar liggesusers\name{profile.gnm} \alias{profile.gnm} \alias{plot.profile.gnm} \title{ Profile Deviance for Parameters in a Generalized Nonlinear Model } \description{ For one or more parameters in a generalized nonlinear model, profile the deviance over a range of values about the fitted estimate. } \usage{ \method{profile}{gnm}(fitted, which = ofInterest(fitted), alpha = 0.05, maxsteps = 10, stepsize = NULL, trace = FALSE, ...) } \arguments{ \item{fitted}{ an object of class \code{"gnm"}. } \item{which}{ (optional) either a numeric vector of indices or a character vector of names, specifying the parameters over which the deviance is to be profiled. If \code{NULL}, the deviance is profiled over all parameters. } \item{alpha}{ the significance level of the z statistic, indicating the range that the profile must cover (see details). } \item{maxsteps}{ the maximum number of steps to take either side of the fitted parameter. } \item{stepsize}{ (optional) a numeric vector of length two, specifying the size of steps to take when profiling down and up respectively, or a single number specifying the step size in both directions. If \code{NULL}, the step sizes will be determined automatically. } \item{trace}{ logical, indicating whether profiling should be traced. } \item{\dots}{ further arguments. } } \details{ This is a method for the generic function \code{profile} in the \code{base} package. For a given parameter, the deviance is profiled by constraining that parameter to certain values either side of its estimate in the fitted model and refitting the model. For each updated model, the following "z statistic" is computed \deqn{z(\theta) = (\theta - \hat{\theta}) * \sqrt{\frac{D_{theta} - D_{\hat{theta}}}{\delta}}}{ z(theta) = (theta - theta.hat) * sqrt((D_theta - D_theta.hat)/delta)} where \eqn{\theta}{theta} is the constrained value of the parameter; \eqn{\hat{\theta}}{theta.hat} is the original fitted value; \eqn{D_{\theta}}{D_theta} is the deviance when the parameter is equal to \eqn{\theta}{theta}, and \eqn{\delta}{delta} is the dispersion parameter. When the deviance is quadratic in \eqn{\theta}{theta}, z will be linear in \eqn{\theta}{theta}. Therefore departures from quadratic behaviour can easily be identified by plotting z against \eqn{\theta}{theta} using \code{plot.profile.gnm}. \code{confint.profile.gnm} estimates confidence intervals for the parameters by interpolating the deviance profiles and identifying the parameter values at which z is equal to the relevant percentage points of the normal distribution. The \code{alpha} argument to \code{profile.gnm} specifies the significance level of z which must be covered by the profile. In particular, the profiling in a given direction will stop when \code{maxsteps} is reached or two steps have been taken in which \deqn{z(\theta) > (\theta - \hat{\theta}) * z_{(1 - \alpha)/2}}{ z(theta) > (theta - theta.hat) * z_{(1 - alpha)/2}} By default, the stepsize is \deqn{z_{(1 - \alpha)/2} * s_{\hat{\theta}}}{ z_{(1 - alpha)/2} * s_theta.hat} where \eqn{s_{\hat{\theta}}}{s_theta.hat} is the standard error of \eqn{\hat{\theta}}{theta.hat}. Strong asymmetry is detected and the stepsize is adjusted accordingly, to try to ensure that the range determined by \code{alpha} is adequately covered. \code{profile.gnm} will also attempt to detect if the deviance is asymptotic such that the desired significance level cannot be reached. Each profile has an attribute \code{"asymptote"}, a two-length logical vector specifying whether an asymptote has been detected in either direction. For unidentified parameters the profile will be \code{NA}, as such parameters cannot be profiled. } \value{ A list of profiles, with one named component for each parameter profiled. Each profile is a data.frame: the first column, "z", contains the z statistics and the second column "par.vals" contains a matrix of parameter values, with one column for each parameter in the model. The list has two attributes: "original.fit" containing \code{fitted} and "summary" containing \code{summary(fitted)}. } \references{ Chambers, J. M. and Hastie, T. J. (1992) \emph{Statistical Models in S} } \author{ Modification of \code{\link[MASS]{profile.glm}} from the MASS package. Originally D. M. Bates and W. N. Venables, ported to R by B. D. Ripley, adapted for \code{"gnm"} objects by Heather Turner. } \seealso{ \code{\link{confint.gnm}}, \code{\link{gnm}}, \code{\link[MASS]{profile.glm}}, \code{\link{ofInterest}} } \examples{ set.seed(1) ### Example in which deviance is near quadratic count <- with(voting, percentage/100 * total) yvar <- cbind(count, voting$total - count) classMobility <- gnm(yvar ~ -1 + Dref(origin, destination), constrain = "delta1", family = binomial, data = voting) prof <- profile(classMobility, trace = TRUE) plot(prof) ## confint similar to MLE +/- 1.96*s.e. confint(prof, trace = TRUE) coefData <- se(classMobility) cbind(coefData[1] - 1.96 * coefData[2], coefData[1] + 1.96 * coefData[2]) \dontrun{ ### These examples take longer to run ### Another near quadratic example RChomog <- gnm(Freq ~ origin + destination + Diag(origin, destination) + MultHomog(origin, destination), ofInterest = "MultHomog", constrain = "MultHomog.*1", family = poisson, data = occupationalStatus) prof <- profile(RChomog, trace = TRUE) plot(prof) ## confint similar to MLE +/- 1.96*s.e. confint(prof) coefData <- se(RChomog) cbind(coefData[1] - 1.96 * coefData[2], coefData[1] + 1.96 * coefData[2]) ## Another near quadratic example, with more complex constraints count <- with(voting, percentage/100 * total) yvar <- cbind(count, voting$total - count) classMobility <- gnm(yvar ~ -1 + Dref(origin, destination), family = binomial, data = voting) wts <- prop.table(exp(coef(classMobility))[1:2]) classMobility <- update(classMobility, constrain = "delta1", constrainTo = log(wts[1])) sum(exp(parameters(classMobility))[1:2]) #=1 prof <- profile(classMobility, trace = TRUE) plot(prof) ## confint similar to MLE +/- 1.96*s.e. confint(prof, trace = TRUE) coefData <- se(classMobility) cbind(coefData[1] - 1.96 * coefData[2], coefData[1] + 1.96 * coefData[2]) ### An example showing asymptotic deviance unidiff <- gnm(Freq ~ educ*orig + educ*dest + Mult(Exp(educ), orig:dest), ofInterest = "[.]educ", constrain = "[.]educ1", family = poisson, data = yaish, subset = (dest != 7)) prof <- profile(unidiff, trace = TRUE) plot(prof) ## clearly not quadratic for Mult1.Factor1.educ4 or Mult1.Factor1.educ5! confint(prof) ## 2.5 \% 97.5 \% ## Mult(Exp(.), orig:dest).educ1 NA NA ## Mult(Exp(.), orig:dest).educ2 -0.5978901 0.1022447 ## Mult(Exp(.), orig:dest).educ3 -1.4836854 -0.2362378 ## Mult(Exp(.), orig:dest).educ4 -2.5792398 -0.2953420 ## Mult(Exp(.), orig:dest).educ5 -Inf -0.7006889 coefData <- se(unidiff) cbind(coefData[1] - 1.96 * coefData[2], coefData[1] + 1.96 * coefData[2]) ### A far from quadratic example, also with eliminated parameters backPainLong <- expandCategorical(backPain, "pain") oneDimensional <- gnm(count ~ pain + Mult(pain, x1 + x2 + x3), eliminate = id, family = "poisson", constrain = "[.](painworse|x1)", constrainTo = c(0, 1), data = backPainLong) prof <- profile(oneDimensional, trace = TRUE) plot(prof) ## not quadratic for any non-eliminated parameter confint(prof) coefData <- se(oneDimensional) cbind(coefData[1] - 1.96 * coefData[2], coefData[1] + 1.96 * coefData[2]) } } \keyword{ models } \keyword{ nonlinear } gnm/man/Symm.Rd0000744000176200001440000000142713311462272013030 0ustar liggesusers\name{Symm} \alias{Symm} \title{ Symmetric Interaction of Factors } \description{ \code{Symm} codes the symmetric interaction of factors having the same set of levels, for use in regression models of symmetry or quasi-symmetry. } \usage{ Symm(..., separator = ":") } \arguments{ \item{\dots}{ one or more factors. } \item{separator}{ a character string of length 1 or more, to be used in naming the levels of the resulting interaction factor. } } \value{ A factor whose levels index the symmetric interaction of all factors supplied as input. } \author{ David Firth and Heather Turner } \seealso{ \code{\link{Diag}}} \examples{ rowfac <- gl(4, 4, 16) colfac <- gl(4, 1, 16) symm4by4 <- Symm(rowfac, colfac) matrix(symm4by4, 4, 4) } \keyword{ models } gnm/man/barley.Rd0000744000176200001440000000464313152512335013363 0ustar liggesusers\name{barley} \alias{barley} \docType{data} \title{ Jenkyn's Data on Leaf-blotch on Barley } \description{ Incidence of \emph{R. secalis} on the leaves of ten varieties of barley grown at nine sites. } \usage{barley} \format{ A data frame with 90 observations on the following 3 variables. \describe{ \item{y}{the proportion of leaf affected (values in [0,1])} \item{site}{a factor with 9 levels \code{A} to \code{I}} \item{variety}{a factor with 10 levels \code{c(1:9, "X")}} } } \note{ This dataset was used in Wedderburn's original paper (1974) on quasi-likelihood. } \source{ Originally in an unpublished Aberystwyth PhD thesis by J F Jenkyn. } \references{ Gabriel, K R (1998). Generalised bilinear regression. \emph{Biometrika} \bold{85}, 689--700. McCullagh, P and Nelder, J A (1989) \emph{Generalized Linear Models} (2nd ed). Chapman and Hall. Wedderburn, R W M (1974). Quasilikelihood functions, generalized linear models and the Gauss-Newton method. \emph{Biometrika} \bold{61}, 439--47. } \examples{ set.seed(1) ### Fit Wedderburn's logit model with variance proportional to [mu(1-mu)]^2 logitModel <- glm(y ~ site + variety, family = wedderburn, data = barley) fit <- fitted(logitModel) print(sum((barley$y - fit)^2 / (fit * (1-fit))^2)) ## Agrees with the chi-squared value reported in McCullagh and Nelder ## (1989, p331), which differs slightly from Wedderburn's reported value. ### Fit the biplot model as in Gabriel (1998, p694) biplotModel <- gnm(y ~ -1 + instances(Mult(site, variety), 2), family = wedderburn, data = barley) barleySVD <- svd(matrix(biplotModel$predictors, 10, 9)) A <- sweep(barleySVD$v, 2, sqrt(barleySVD$d), "*")[, 1:2] B <- sweep(barleySVD$u, 2, sqrt(barleySVD$d), "*")[, 1:2] ## These are essentially A and B as in Gabriel (1998, p694), from which ## the biplot is made by plot(rbind(A, B), pch = c(levels(barley$site), levels(barley$variety))) ## Fit the double-additive model as in Gabriel (1998, p697) variety.binary <- factor(match(barley$variety, c(2,3,6), nomatch = 0) > 0, labels = c("rest", "2,3,6")) doubleAdditive <- gnm(y ~ variety + Mult(site, variety.binary), family = wedderburn, data = barley) ## It is unclear why Gabriel's chi-squared statistics differ slightly ## from the ones produced in these fits. Possibly Gabriel adjusted the ## data somehow prior to fitting? } \keyword{datasets} gnm/man/parameters.Rd0000744000176200001440000000172013152512335014241 0ustar liggesusers\name{parameters} \alias{parameters} \title{ Extract Constrained and Estimated Parameters from a gnm Object} \description{ A function to extract non-eliminated parameters from a \code{"gnm"} object, including parameters that were constrained. } \usage{ parameters(object) } \arguments{ \item{object}{ an object of class \code{"gnm"}. } } \details{ \code{parameters} acts like \code{coefficients} except that for constrained parameters, the value at which the parameter was constrained is returned instead of \code{NA}. } \value{ A vector of parameters. } \author{ Heather Turner } \seealso{ \code{\link{coefficients}}, \code{\link{gnm}} } \examples{ RChomog <- gnm(Freq ~ origin + destination + Diag(origin, destination) + MultHomog(origin, destination), family = poisson, data = occupationalStatus, ofInterest = "MultHomog", constrain = "MultHomog.*1") coefficients(RChomog) parameters(RChomog) } \keyword{ models } gnm/man/model.matrix.gnm.Rd0000744000176200001440000000201313152512335015255 0ustar liggesusers\name{model.matrix.gnm} \alias{model.matrix.gnm} \title{ Local Design Matrix for a Generalized Nonlinear Model } \description{ This method extracts or evaluates a local design matrix for a generalized nonlinear model } \usage{ \method{model.matrix}{gnm}(object, coef = NULL, ...) } \arguments{ \item{object}{ an object of class \code{gnm}. } \item{coef}{ if specified, the vector of (non-eliminated) coefficients at which the local design matrix is evaluated. } \item{...}{ further arguments. } } \value{ If \code{coef = NULL}, the local design matrix with columns corresponding to the non-eliminated parameters evaluated at \code{coef(object)} (extracted from \code{object} if possible). Otherwise, the local design matrix evaluated at \code{coef}. } \author{ Heather Turner } \seealso{ \code{\link{gnm}}, \code{\link{model.matrix}} } \examples{ example(mentalHealth) model.matrix(RC1model) model.matrix(RC1model, coef = seq(coef(RC1model))) } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } gnm/man/House2001.Rd0000744000176200001440000001351113152512335013465 0ustar liggesusers\name{House2001} \alias{House2001} \docType{data} \title{ Data on twenty roll calls in the US House of Representatives, 2001 } \description{ The voting record of every representative in the 2001 House, on 20 roll calls selected by \emph{Americans for Democratic Action}. Each row is the record of one representative; the first column records the representative's registered party allegiance. } \usage{House2001} \format{ A data frame with 439 observations on the following 21 variables. \describe{ \item{\code{party}}{a factor with levels \code{D} \code{I} \code{N} \code{R}} \item{\code{HR333.BankruptcyOverhaul.Yes}}{a numeric vector} \item{\code{SJRes6.ErgonomicsRuleDisapproval.No}}{a numeric vector} \item{\code{HR3.IncomeTaxReduction.No}}{a numeric vector} \item{\code{HR6.MarriageTaxReduction.Yes}}{a numeric vector} \item{\code{HR8.EstateTaxRelief.Yes}}{a numeric vector} \item{\code{HR503.FetalProtection.No}}{a numeric vector} \item{\code{HR1.SchoolVouchers.No}}{a numeric vector} \item{\code{HR1836.TaxCutReconciliationBill.No}}{a numeric vector} \item{\code{HR2356.CampaignFinanceReform.No}}{a numeric vector} \item{\code{HJRes36.FlagDesecration.No}}{a numeric vector} \item{\code{HR7.FaithBasedInitiative.Yes}}{a numeric vector} \item{\code{HJRes50.ChinaNormalizedTradeRelations.Yes}}{a numeric vector} \item{\code{HR4.ANWRDrillingBan.Yes}}{a numeric vector} \item{\code{HR2563.PatientsRightsHMOLiability.No}}{a numeric vector} \item{\code{HR2563.PatientsBillOfRights.No}}{a numeric vector} \item{\code{HR2944.DomesticPartnerBenefits.No}}{a numeric vector} \item{\code{HR2586.USMilitaryPersonnelOverseasAbortions.Yes}}{a numeric vector} \item{\code{HR2975.AntiTerrorismAuthority.No}}{a numeric vector} \item{\code{HR3090.EconomicStimulus.No}}{a numeric vector} \item{\code{HR3000.TradePromotionAuthorityFastTrack.No}}{a numeric vector} } } \details{ Coding of the votes is as described in ADA (2002). } \source{ Originally printed in ADA (2002). Kindly supplied in electronic format by Jan deLeeuw, who used the data to illustrate methods developed in deLeeuw (2006). } \references{ Americans for Democratic Action, ADA (2002). 2001 voting record: Shattered promise of liberal progress. \emph{ADA Today} \bold{57}(1), 1--17. deLeeuw, J (2006). Principal component analysis of binary data by iterated singular value decomposition. \emph{Computational Statistics and Data Analysis} \bold{50}, 21--39. } \examples{ \dontrun{ ## This example takes some time to run! summary(House2001) ## Put the votes in a matrix, and discard members with too many NAs etc: House2001m <- as.matrix(House2001[-1]) informative <- apply(House2001m, 1, function(row){ valid <- !is.na(row) validSum <- if (any(valid)) sum(row[valid]) else 0 nValid <- sum(valid) uninformative <- (validSum == nValid) || (validSum == 0) || (nValid < 10) !uninformative}) House2001m <- House2001m[informative, ] ## Make a vector of colours, blue for Republican and red for Democrat: parties <- House2001$party[informative] partyColors <- rep("black", length(parties)) partyColors <- ifelse(parties == "D", "red", partyColors) partyColors <- ifelse(parties == "R", "blue", partyColors) ## Expand the data for statistical modelling: House2001v <- as.vector(House2001m) House2001f <- data.frame(member = rownames(House2001m), party = parties, rollCall = factor(rep((1:20), rep(nrow(House2001m), 20))), vote = House2001v) ## Now fit an "empty" model, in which all members vote identically: baseModel <- glm(vote ~ -1 + rollCall, family = binomial, data = House2001f) ## From this, get starting values for a one-dimensional multiplicative term: Start <- residSVD(baseModel, rollCall, member) ## ## Now fit the logistic model with one multiplicative term. ## For the response variable, instead of vote=0,1 we use 0.03 and 0.97, ## corresponding approximately to a bias-reducing adjustment of p/(2n), ## where p is the number of parameters and n the number of observations. ## voteAdj <- 0.5 + 0.94*(House2001f$vote - 0.5) House2001model1 <- gnm(voteAdj ~ Mult(rollCall, member), eliminate = rollCall, family = binomial, data = House2001f, na.action = na.exclude, trace = TRUE, tolerance = 1e-03, start = -Start) ## Deviance is 2234.847, df = 5574 ## ## Plot the members' positions as estimated in the model: ## memberParameters <- pickCoef(House2001model1, "member") plot(coef(House2001model1)[memberParameters], col = partyColors, xlab = "Alphabetical index (Abercrombie 1 to Young 301)", ylab = "Member's relative position, one-dimensional model") ## Can do the same thing with two dimensions, but gnm takes around 40 ## slow iterations to converge (there are more than 600 parameters): Start2 <- residSVD(baseModel, rollCall, member, d = 2) House2001model2 <- gnm( voteAdj ~ instances(Mult(rollCall - 1, member - 1), 2), eliminate = rollCall, family = binomial, data = House2001f, na.action = na.exclude, trace = TRUE, tolerance = 1e-03, start = Start2, lsMethod = "qr") ## Deviance is 1545.166, df = 5257 ## memberParameters1 <- pickCoef(House2001model2, "1).member") memberParameters2 <- pickCoef(House2001model2, "2).member") plot(coef(House2001model2)[memberParameters1], coef(House2001model2)[memberParameters2], col = partyColors, xlab = "Dimension 1", ylab = "Dimension 2", main = "House2001 data: Member positions, 2-dimensional model") ## ## The second dimension is mainly due to rollCall 12, which does not ## correlate well with the rest -- look at the coefficients of ## House2001model1, or at the 12th row of cormat <- cor(na.omit(House2001m)) } } \keyword{datasets} gnm/man/predict.gnm.Rd0000744000176200001440000000712113152512335014311 0ustar liggesusers\name{predict.gnm} \alias{predict.gnm} \title{ Predict Method for Generalized Nonlinear Models } \description{ Obtains predictions and optionally estimates standard errors of those predictions from a fitted generalized nonlinear model object. } \usage{ \method{predict}{gnm}(object, newdata = NULL, type = c("link", "response", "terms"), se.fit = FALSE, dispersion = NULL, terms = NULL, na.action = na.exclude, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{object}{ a fitted object of class inheriting from \code{"gnm"}. } \item{newdata}{ optionally, a data frame in which to look for variables with which to predict. If omitted, the fitted predictors are used. } \item{type}{ the type of prediction required. The default is on the scale of the predictors; the alternative \code{"response"} is on the scale of the response variable. Thus for a default binomial model the default predictions are of log-odds (probabilities on logit scale) and \code{type = "response"} gives the predicted probabilities. The \code{"terms"} option returns a matrix giving the fitted values of each term in the model formula on the predictor scale. The value of this argument can be abbreviated. } \item{se.fit}{ logical switch indicating if standard errors are required. } \item{dispersion}{ the dispersion of the fit to be assumed in computing the standard errors. If omitted, that returned by \code{summary} applied to the object is used. } \item{terms}{ with \code{type="terms"} by default all terms are returned. A character vector specifies which terms are to be returned } \item{na.action}{ function determining what should be done with missing values in \code{newdata}. The default is to predict \code{NA}. } \item{\dots}{ further arguments passed to or from other methods. } } \details{ If \code{newdata} is omitted the predictions are based on the data used for the fit. In that case how cases with missing values in the original fit is determined by the \code{na.action} argument of that fit. If \code{na.action = na.omit} omitted cases will not appear in the residuals, whereas if \code{na.action = na.exclude} they will appear (in predictions and standard errors), with residual value \code{NA}. See also \code{\link{napredict}}. } \value{ If \code{se = FALSE}, a vector or matrix of predictions. If \code{se = TRUE}, a list with components \item{ fit }{ predictions.} \item{ se.fit }{ estimated standard errors.} \item{ residual.scale }{ a scalar giving the square root of the dispersion used in computing the standard errors.} } \references{ Chambers, J. M. and Hastie, T. J. (1992) \emph{Statistical Models in S }} \author{ Heather Turner } \note{Variables are first looked for in 'newdata' and then searched for in the usual way (which will include the environment of the formula used in the fit). A warning will be given if the variables found are not of the same length as those in 'newdata' if it was supplied.} \seealso{ \code{\link{gnm}} } \examples{ set.seed(1) ## Fit an association model with homogeneous row-column effects RChomog <- gnm(Freq ~ origin + destination + Diag(origin, destination) + MultHomog(origin, destination), family = poisson, data = occupationalStatus) ## Fitted values (expected counts) predict(RChomog, type = "response", se.fit = TRUE) ## Fitted values on log scale predict(RChomog, type = "link", se.fit = TRUE) } \keyword{ models } \keyword{ nonlinear } gnm/man/asGnm.Rd0000744000176200001440000000311113152512335013137 0ustar liggesusers\name{asGnm} \alias{asGnm} \title{ Coerce Linear Model to gnm Object } \description{ \code{asGnm} is a generic function which coerces objects of class "glm" or "lm" to an object of class "gnm". } \usage{ asGnm(object, ...) } \arguments{ \item{object}{ an object of class "glm" or "lm". } \item{\dots}{ additional arguments for method functions. } } \details{ Components are added to or removed from \code{object} to produce an object of class "gnm". This can be useful in model building, see examples. } \value{ An object of class "gnm" - see \code{\link{gnm}} for full description. } \references{ Vargas, M, Crossa, J, van Eeuwijk, F, Sayre, K D and Reynolds, M P (2001). Interpreting treatment by environment interaction in agronomy trials. \emph{Agronomy Journal} \bold{93}, 949--960. } \author{ Heather Turner } \seealso{ \code{\link{gnm}}, \code{\link{glm}}, \code{\link{lm}} } \examples{ set.seed(1) ## Scale yields to reproduce analyses reported in Vargas et al (2001) yield.scaled <- wheat$yield * sqrt(3/1000) treatment <- interaction(wheat$tillage, wheat$summerCrop, wheat$manure, wheat$N, sep = "") ## Fit linear model mainEffects <- lm(yield.scaled ~ year + treatment, data = wheat) ## Convert to gnm object to allow addition of Mult() term svdStart <- residSVD(mainEffects, year, treatment, 3) bilinear1 <- update(asGnm(mainEffects), . ~ . + Mult(year, treatment), start = c(coef(mainEffects), svdStart[,1])) } \keyword{ models } \keyword{ regression } gnm/man/yaish.Rd0000744000176200001440000000471313152512335013220 0ustar liggesusers\name{yaish} \alias{yaish} \docType{data} \title{ Class Mobility by Level of Education in Israel} \description{ A 3-way contingency table of father/son pairs, classified by father's social class (\code{orig}), son's social class (\code{dest}) and son's education level (\code{educ}). } \usage{yaish} \format{ A table of counts, with classifying factors \code{educ} (levels \code{1:5}), \code{orig} (levels \code{1:7}) and \code{dest} (levels \code{1:7}). } \source{Originally in Yaish (1998), see also Yaish (2004, p316).} \references{ Yaish, M (1998). Opportunities, Little Change. Class Mobility in Israeli Society: 1974-1991. D.Phil. Thesis, Nuffield College, University of Oxford. Yaish, M (2004). \emph{Class Mobility Trends in Israeli Society, 1974-1991.} Lewiston: Edwin Mellen Press. } \examples{ set.seed(1) ## Fit the "UNIDIFF" mobility model across education levels, leaving out ## the uninformative subtable for dest == 7: ## unidiff <- gnm(Freq ~ educ*orig + educ*dest + Mult(Exp(educ), orig:dest), family = poisson, data = yaish, subset = (dest != 7)) ## Deviance should be 200.3, 116 d.f. ## ## Look at the multipliers of the orig:dest association: ofInterest(unidiff) <- pickCoef(unidiff, "[.]educ") coef(unidiff) ## ## Coefficients of interest: ## Mult(Exp(.), orig:dest).educ1 Mult(Exp(.), orig:dest).educ2 ## -0.5513258 -0.7766976 ## Mult(Exp(.), orig:dest).educ3 Mult(Exp(.), orig:dest).educ4 ## -1.2947494 -1.5902644 ## Mult(Exp(.), orig:dest).educ5 ## -2.8008285 ## ## Get standard errors for the contrasts with educ1: ## getContrasts(unidiff, ofInterest(unidiff)) ## estimate SE quasiSE ## Mult(Exp(.), orig:dest).educ1 0.0000000 0.0000000 0.09757438 ## Mult(Exp(.), orig:dest).educ2 -0.2253718 0.1611874 0.12885847 ## Mult(Exp(.), orig:dest).educ3 -0.7434236 0.2335083 0.21182123 ## Mult(Exp(.), orig:dest).educ4 -1.0389386 0.3434256 0.32609380 ## Mult(Exp(.), orig:dest).educ5 -2.2495026 0.9453764 0.93560643 ## quasiVar ## Mult(Exp(.), orig:dest).educ1 0.00952076 ## Mult(Exp(.), orig:dest).educ2 0.01660450 ## Mult(Exp(.), orig:dest).educ3 0.04486823 ## Mult(Exp(.), orig:dest).educ4 0.10633716 ## Mult(Exp(.), orig:dest).educ5 0.87535940 ## ## Table of model residuals: ## residuals(unidiff) } \author{David Firth} \keyword{ datasets } gnm/man/Mult.Rd0000744000176200001440000000700613152512335013022 0ustar liggesusers\name{Multiplicative interaction} \alias{Mult} \title{Specify a Product of Predictors in a gnm Model Formula} \description{ A function of class \code{"nonlin"} to specify a multiplicative interaction in the formula argument to \code{\link{gnm}}. } \usage{ Mult(..., inst = NULL) } \arguments{ \item{\dots}{a comma-separated list of two or more symbolic expressions representing the constituent multipliers in the interaction.} \item{inst}{a positive integer specifying the instance number of the term.} } \details{ \code{Mult} specifies instances of a multiplicative interaction, i.e. a product of the form \deqn{m_1 m_2 ... m_n,} where the constituent multipliers \eqn{m_1, m_2, ..., m_n} are linear or nonlinear predictors. Models for the constituent multipliers are specified symbolically as unspecified arguments to \code{Mult}. These symbolic expressions are interpreted in the same way as the right hand side of a formula in an object of class \code{"formula"}, except that an intercept term is not added by default. Offsets can be added to constituent multipliers, using \code{offset}. The family of multiplicative interaction models include row-column association models for contingency tables (e.g., Agresti, 2002, Sec 9.6), log-multiplicative or UNIDIFF models (Erikson and Goldthorpe, 1992; Xie, 1992), and GAMMI models (van Eeuwijk, 1995). } \value{ A list with the required components of a \code{"nonlin"} function: \item{ predictors }{ the expressions passed to \code{Mult}} \item{ term }{ a function to create a deparsed mathematical expression of the term, given labels for the predictors.} \item{ call }{ the call to use as a prefix for parameter labels. } } \references{ Agresti, A (2002). \emph{Categorical Data Analysis} (2nd ed.) New York: Wiley. Erikson, R and Goldthorpe, J H (1992). \emph{The Constant Flux}. Oxford: Clarendon Press. van Eeuwijk, F A (1995). Multiplicative interaction in generalized linear models. \emph{Biometrics} \bold{51}, 1017-1032. Vargas, M, Crossa, J, van Eeuwijk, F, Sayre, K D and Reynolds, M P (2001). Interpreting treatment by environment interaction in agronomy trials. \emph{Agronomy Journal} \bold{93}, 949--960. Xie, Y (1992). The log-multiplicative layer effect model for comparing mobility tables. \emph{American Sociological Review} \bold{57}, 380-395. } \author{Heather Turner} \seealso{\code{\link{gnm}}, \code{\link{formula}}, \code{\link{instances}}, \code{\link{nonlin.function}}, \code{\link{MultHomog}} } \examples{ set.seed(1) ## Using 'Mult' with 'Exp' to constrain the first constituent multiplier ## to be non-negative ## Fit the "UNIDIFF" mobility model across education levels unidiff <- gnm(Freq ~ educ*orig + educ*dest + Mult(Exp(educ), orig:dest), family = poisson, data = yaish, subset = (dest != 7)) \dontrun{ ## (this example can take quite a while to run) ## ## Fitting two instances of a multiplicative interaction (i.e. a ## two-component interaction)) yield.scaled <- wheat$yield * sqrt(3/1000) treatment <- factor(paste(wheat$tillage, wheat$summerCrop, wheat$manure, wheat$N, sep = "")) bilinear2 <- gnm(yield.scaled ~ year + treatment + instances(Mult(year, treatment), 2), family = gaussian, data = wheat) formula(bilinear2) ## yield.scaled ~ year + treatment + Mult(year, treatment, inst = 1) + ## Mult(year, treatment, inst = 2) } } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } gnm/man/nonlin.function.Rd0000744000176200001440000001564713152512335015234 0ustar liggesusers\name{nonlin.function} \alias{nonlin.function} \title{ Functions to Specify Nonlinear Terms in gnm Models } \description{ Nonlinear terms maybe be specified in the formula argument to gnm by a call to a function of class \code{"nonlin"}. A \code{"nonlin"} function takes a list of arguments and returns a list of arguments for the internal \code{nonlinTerms} function. } \arguments{ \item{...}{ arguments required to define the term, e.g. symbolic representations of predictors in the term. } \item{inst}{(optional) an integer specifying the instance number of the term - for compatibility with \code{\link{instances}}. } } \value{ The function should return a list with the following components: \item{predictors}{ a list of symbolic expressions or formulae with no left hand side which represent (possibly nonlinear) predictors that form part of the term. Intercepts will be added by default to predictors specified by formulae. If predictors are named, these names will be used as a prefix for parameter labels or the parameter label itself in the single parameter case (in either case, prefixed by the call if supplied.) Predictors that may include an intercept should always be named or matched to a call. } \item{variables}{ an optional list of expressions representing variables in the term. } \item{term}{ a function which takes the arguments \code{predLabels} and \code{varLabels}, which are vectors of labels defined by \code{gnm} that correspond to the specified predictors and variables, and returns a deparsed mathematical expression of the full term. Only functions recognised by \code{deriv} should be used in the expression, e.g. \code{+} rather than \code{sum}.} \item{common}{ an optional numeric index of \code{predictors} with duplicated indices identifying single factor predictors for which homologous effects are to be estimated. } \item{call}{ an optional call to be used as a prefix for parameter labels, specified as an R expression. } \item{match}{ (if \code{call} is non-\code{NULL}) a numeric index of \code{predictors} specifying which arguments of \code{call} the predictors match to - zero indicating no match. If \code{NULL}, predictors will not be matched. It is recommended that matches are specified wherever possible, to ensure parameter labels are well-defined. Parameters in matched predictors are labelled using "dot-style" labelling, see examples.} \item{start}{ an optional function which takes a named vector of parameters corresponding to the predictors and returns a vector of starting values for those parameters. This function is ignored if the term is nested within another nonlinear term.} } \author{ Heather Turner } \seealso{ \code{\link{Const}} to specify a constant, \code{\link{Dref}} to specify a diagonal reference term, \code{\link{Exp}} to specify the exponential of a predictor, \code{\link{Inv}} to specify the reciprocal of a predictor, % \code{\link{Log}} to specify the natural logarithm of a predictor, % \code{\link{Logit}} to specify the logit of a predictor, \code{\link{Mult}} to specify a multiplicative interaction, \code{\link{MultHomog}} to specify a homogeneous multiplicative interaction, % \code{\link{Raise}} to raise a predictor to a constant power. } \examples{ ### Equivalent of weighted.MM function in ?nls weighted.MM <- function(resp, conc){ list(predictors = list(Vm = substitute(conc), K = 1), variables = list(substitute(resp), substitute(conc)), term = function(predictors, variables) { pred <- paste("(", predictors[1], "/(", predictors[2], " + ", variables[2], "))", sep = "") pred <- paste("(", variables[1], " - ", pred, ")/sqrt(", pred, ")", sep = "") }) } class(weighted.MM) <- "nonlin" ## use to fitted weighted Michaelis-Menten model Treated <- Puromycin[Puromycin$state == "treated", ] Pur.wt.2 <- gnm( ~ -1 + weighted.MM(rate, conc), data = Treated, start = c(Vm = 200, K = 0.1), verbose = FALSE) Pur.wt.2 ## ## Call: ## gnm(formula = ~-1 + weighted.MM(rate, conc), data = Treated, ## start = c(Vm = 200, K = 0.1), verbose = FALSE) ## ## Coefficients: ## Vm K ## 206.83477 0.05461 ## ## Deviance: 14.59690 ## Pearson chi-squared: 14.59690 ## Residual df: 10 ### The definition of MultHomog MultHomog <- function(..., inst = NULL){ dots <- match.call(expand.dots = FALSE)[["..."]] list(predictors = dots, common = rep(1, length(dots)), term = function(predictors, ...) { paste("(", paste(predictors, collapse = ")*("), ")", sep = "") }, call = as.expression(match.call())) } class(MultHomog) <- "nonlin" ## use to fit homogeneous multiplicative interaction set.seed(1) RChomog <- gnm(Freq ~ origin + destination + Diag(origin, destination) + MultHomog(origin, destination), ofInterest = "MultHomog", family = poisson, data = occupationalStatus, verbose = FALSE) RChomog ## ## Call: ## ## gnm(formula = Freq ~ origin + destination + Diag(origin, destination) + ## MultHomog(origin, destination), ofInterest = "MultHomog", family = poisson, ## data = occupationalStatus, verbose = FALSE) ## ## Coefficients of interest: ## MultHomog(origin, destination)1 ## -1.50089 ## MultHomog(origin, destination)2 ## -1.28260 ## MultHomog(origin, destination)3 ## -0.68443 ## MultHomog(origin, destination)4 ## -0.10055 ## MultHomog(origin, destination)5 ## -0.08338 ## MultHomog(origin, destination)6 ## 0.42838 ## MultHomog(origin, destination)7 ## 0.84452 ## MultHomog(., .).`origin|destination`8 ## 1.08809 ## ## Deviance: 32.56098 ## Pearson chi-squared: 31.20716 ## Residual df: 34 ## ## the definition of Exp Exp <- function(expression, inst = NULL){ list(predictors = list(substitute(expression)), term = function(predictors, ...) { paste("exp(", predictors, ")", sep = "") }, call = as.expression(match.call()), match = 1) } class(Exp) <- "nonlin" ## use to fit exponentional model x <- 1:100 y <- exp(- x / 10) set.seed(4) exp1 <- gnm(y ~ Exp(1 + x), verbose = FALSE) exp1 ## ## Call: ## gnm(formula = y ~ Exp(1 + x), verbose = FALSE) ## ## Coefficients: ## (Intercept) Exp(. + x).(Intercept) ## 1.549e-11 -7.934e-11 ## Exp(1 + .).x ## -1.000e-01 ## ## Deviance: 9.342418e-20 ## Pearson chi-squared: 9.342418e-20 ## Residual df: 97 } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } gnm/man/ofInterest.Rd0000744000176200001440000000442413311460701014220 0ustar liggesusers\name{ofInterest} \alias{ofInterest} \alias{ofInterest<-} \title{ Coefficients of Interest in a Generalized Nonlinear Model } \description{ Retrieve or set the \code{"ofInterest"} component of a \code{"gnm"} (generalized nonlinear model) object. } \usage{ ofInterest(object) ofInterest(object) <- value } \arguments{ \item{object}{ an object of class \code{"gnm"}. } \item{value}{ a numeric vector of indices specifying the subset of (non-eliminated) coefficients of interest, or \code{NULL} to specify that all non-eliminated coefficients are of interest. } } \details{ The \code{"ofInterest"} component of a \code{"gnm"} object is a named numeric vector of indices specifying a subset of the non-eliminated coefficients which are of specific interest. If the \code{"ofInterest"} component is non-NULL, printed summaries of the model only show the coefficients of interest. In addition methods for \code{"gnm"} objects which may be applied to a subset of the parameters are by default applied to the coefficients of interest. These functions provide a way of extracting and replacing the \code{"ofInterest"} component. The replacement function prints the replacement value to show which parameters have been specified by \code{value}. } \value{ A named vector of indices, or \code{NULL}. } \author{ Heather Turner } \note{ Regular expression matching is performed using \code{grep} with default settings. } \seealso{ \code{\link{grep}}, \code{\link{gnm}}, \code{\link{se.gnm}}, \code{\link{getContrasts}},\code{\link{profile.gnm}}, \code{\link{confint.gnm}}} \examples{ set.seed(1) ## Fit the "UNIDIFF" mobility model across education levels unidiff <- gnm(Freq ~ educ*orig + educ*dest + Mult(Exp(educ), orig:dest), ofInterest = "[.]educ", family = poisson, data = yaish, subset = (dest != 7)) ofInterest(unidiff) ## Get all of the contrasts with educ1 in the UNIDIFF multipliers getContrasts(unidiff, ofInterest(unidiff)) ## Get estimate and se for the contrast between educ4 and educ5 in the ## UNIDIFF multiplier mycontrast <- numeric(length(coef(unidiff))) mycontrast[ofInterest(unidiff)[4:5]] <- c(1, -1) se(unidiff, mycontrast) } \keyword{ models } gnm/man/pickCoef.Rd0000744000176200001440000000556313615560322013635 0ustar liggesusers\name{pickCoef} \alias{pickCoef} \title{ Get Indices or Values of Selected Model Coefficients } \description{ Get the indices or values of a subset of non-eliminated coefficients selected via a Tk dialog or by pattern matching. } \usage{ pickCoef(object, pattern = NULL, value = FALSE, ...) } \arguments{ \item{object}{ a model object. } \item{pattern}{ character string containing a regular expression or (with \code{fixed = TRUE}) a pattern to be matched exactly. If \code{NULL}, a Tk dialog will open for coefficient selection. } \item{value}{ if \code{FALSE}, a named vector of indices, otherwise the value of the selected coefficients. } \item{\dots}{ arguments to pass on to \link[relimp]{pickFrom} if \code{pattern} is missing, otherwise \code{grep}. In particular, \code{fixed = TRUE} specifies that \code{pattern} is a string to be matched as is.} } \value{ If \code{value = FALSE} (the default), a named vector of indices, otherwise the values of the selected coefficients. If no coefficients are selected the returned value will be \code{NULL}. } \author{ Heather Turner } \seealso{ \code{\link{regexp}}, \code{\link{grep}}, \code{\link[relimp]{pickFrom}}, \code{\link{ofInterest}}} \examples{ set.seed(1) ### Extract indices for use with ofInterest ## fit the "UNIDIFF" mobility model across education levels unidiff <- gnm(Freq ~ educ*orig + educ*dest + Mult(Exp(educ), orig:dest), family = poisson, data = yaish, subset = (dest != 7)) ## set coefficients in first constituent multiplier as 'ofInterest' ## using regular expression ofInterest(unidiff) <- pickCoef(unidiff, "[.]educ") ## summarise model, only showing coefficients of interest summary(unidiff) ## get contrasts of these coefficients getContrasts(unidiff, ofInterest(unidiff)) ### Extract coefficients to use as starting values ## fit diagonal reference model with constant weights set.seed(1) ## reconstruct counts voting Labour/non-Labour count <- with(voting, percentage/100 * total) yvar <- cbind(count, voting$total - count) classMobility <- gnm(yvar ~ -1 + Dref(origin, destination), family = binomial, data = voting) ## create factors indicating movement in and out of salariat (class 1) upward <- with(voting, origin != 1 & destination == 1) downward <- with(voting, origin == 1 & destination != 1) ## extract diagonal effects from first model to use as starting values diagCoef <- pickCoef(classMobility, "Dref(., .)", fixed = TRUE, value = TRUE) ## fit separate weights for the "socially mobile" groups ## -- there are now 3 parameters for each weight socialMobility <- gnm(yvar ~ -1 + Dref(origin, destination, delta = ~ 1 + downward + upward), family = binomial, data = voting, start = c(rep(NA, 6), diagCoef)) } \keyword{ models } gnm/man/MPinv.Rd0000744000176200001440000000337213152512335013134 0ustar liggesusers\name{MPinv} \alias{MPinv} \title{ Moore-Penrose Pseudoinverse of a Real-valued Matrix } \description{ Computes the Moore-Penrose generalized inverse. } \usage{ MPinv(mat, tolerance = 100*.Machine$double.eps, rank = NULL, method = "svd") } \arguments{ \item{mat}{ a real matrix.} \item{tolerance}{ A positive scalar which determines the tolerance for detecting zeroes among the singular values. } \item{rank}{Either \code{NULL}, in which case the rank of \code{mat} is determined numerically; or an integer specifying the rank of \code{mat} if it is known. No check is made on the validity of any non-\code{NULL} value.} \item{method}{Character, one of \code{"svd", "chol"}. The specification \code{method = "chol"} is valid only for symmetric matrices. } } \details{ Real-valuedness is not checked, neither is symmetry when \code{method = "chol"}. } \value{ A matrix, with an additional attribute named \code{"rank"} containing the numerically determined rank of the matrix. } \references{ Harville, D. A. (1997). \emph{Matrix Algebra from a Statistician's Perspective}. New York: Springer. Courrieu, P. (2005). Fast computation of Moore-Penrose inverse matrices. \emph{Neural Information Processing} \bold{8}, 25--29 } \author{ David Firth and Heather Turner } \seealso{\code{\link[MASS]{ginv}}} \examples{ A <- matrix(c(1, 1, 0, 1, 1, 0, 2, 3, 4), 3, 3) B <- MPinv(A) A \%*\% B \%*\% A - A # essentially zero B \%*\% A \%*\% B - B # essentially zero attr(B, "rank") # here 2 ## demonstration that "svd" and "chol" deliver essentially the same ## results for symmetric matrices: A <- crossprod(A) MPinv(A) - MPinv(A, method = "chol") ## (essentially zero) } \keyword{ array } gnm/man/wheat.Rd0000744000176200001440000001063513152512335013213 0ustar liggesusers\name{wheat} \alias{wheat} \docType{data} \title{ Wheat Yields from Mexican Field Trials } \description{ Data from a 10-year experiment at the CIMMYT experimental station located in the Yaqui Valley near Ciudad Obregon, Sonora, Mexico --- factorial design using 24 treatments in all. In each of the 10 years the experiment was arranged in a randomized complete block design with three replicates. } \usage{wheat} \format{ A data frame with 240 observations on the following 33 variables. \describe{ \item{yield}{numeric, mean yield in kg/ha for 3 replicates} \item{year}{a factor with levels \code{1988:1997}} \item{tillage}{a factor with levels \code{T} \code{t}} \item{summerCrop}{a factor with levels \code{S} \code{s}} \item{manure}{a factor with levels \code{M} \code{m}} \item{N}{a factor with levels \code{0} \code{N} \code{n}} \item{MTD}{numeric, mean max temp sheltered (deg C) in December} \item{MTJ}{same for January} \item{MTF}{same for February} \item{MTM}{same for March} \item{MTA}{same for April} \item{mTD}{numeric, mean min temp sheltered (deg C) in December} \item{mTJ}{same for January} \item{mTF}{same for February} \item{mTM}{same for March} \item{mTA}{same for April} \item{mTUD}{numeric, mean min temp unsheltered (deg C)in December} \item{mTUJ}{same for January} \item{mTUF}{same for February} \item{mTUM}{same for March} \item{mTUA}{same for April} \item{PRD}{numeric, total precipitation (mm) in December} \item{PRJ}{same for January} \item{PRF}{same for February} \item{PRM}{same for March} \item{SHD}{numeric, mean sun hours in December} \item{SHJ}{same for January} \item{SHF}{same for February} \item{EVD}{numeric, total evaporation (mm) in December} \item{EVJ}{same for January} \item{EVF}{same for February} \item{EVM}{same for March} \item{EVA}{same for April} } } \source{ Tables A1 and A3 of Vargas, M, Crossa, J, van Eeuwijk, F, Sayre, K D and Reynolds, M P (2001). Interpreting treatment by environment interaction in agronomy trials. \emph{Agronomy Journal} \bold{93}, 949--960. } \examples{ set.seed(1) ## Scale yields to reproduce analyses reported in Vargas et al (2001) yield.scaled <- wheat$yield * sqrt(3/1000) ## Reproduce (up to error caused by rounding) Table 1 of Vargas et al (2001) aov(yield.scaled ~ year*tillage*summerCrop*manure*N, data = wheat) treatment <- interaction(wheat$tillage, wheat$summerCrop, wheat$manure, wheat$N, sep = "") mainEffects <- lm(yield.scaled ~ year + treatment, data = wheat) svdStart <- residSVD(mainEffects, year, treatment, 3) bilinear1 <- update(asGnm(mainEffects), . ~ . + Mult(year, treatment), start = c(coef(mainEffects), svdStart[,1])) bilinear2 <- update(bilinear1, . ~ . + Mult(year, treatment, inst = 2), start = c(coef(bilinear1), svdStart[,2])) bilinear3 <- update(bilinear2, . ~ . + Mult(year, treatment, inst = 3), start = c(coef(bilinear2), svdStart[,3])) anova(mainEffects, bilinear1, bilinear2, bilinear3) ## Examine the extent to which, say, mTF explains the first bilinear term bilinear1mTF <- gnm(yield.scaled ~ year + treatment + Mult(1 + mTF, treatment), family = gaussian, data = wheat) anova(mainEffects, bilinear1mTF, bilinear1) ## How to get the standard SVD representation of an AMMI-n model ## ## We'll work with the AMMI-2 model, which here is called "bilinear2" ## ## First, extract the contributions of the 5 terms in the model: ## wheat.terms <- termPredictors(bilinear2) ## ## That's a matrix, whose 4th and 5th columns are the interaction terms ## ## Combine those two interaction terms, to get the total estimated ## interaction effect: ## wheat.interaction <- wheat.terms[, 4] + wheat.terms[, 5] ## ## That's a vector, so we need to re-shape it as a 24 by 10 matrix ## ready for calculating the SVD: ## wheat.interaction <- matrix(wheat.interaction, 24, 10) ## ## Now we can compute the SVD: ## wheat.interaction.SVD <- svd(wheat.interaction) ## ## Only the first two singular values are nonzero, as expected ## (since this is an AMMI-2 model, the interaction has rank 2) ## ## So the result object can be simplified by re-calculating the SVD with ## just two dimensions: ## wheat.interaction.SVD <- svd(wheat.interaction, nu = 2, nv = 2) } \keyword{datasets} gnm/man/erikson.Rd0000744000176200001440000000616413311222714013553 0ustar liggesusers\name{erikson} \alias{erikson} \docType{data} \title{Intergenerational Class Mobility in England/Wales, France and Sweden} \description{ Intergenerational class mobility among the male populations of England and Wales; France, and Sweden. } \usage{erikson} \format{ A table of counts, with classifying factors \code{origin} (father's class; levels \code{I}, \code{II}, \code{III}, \code{IVa}, \code{IVb}, \code{IVc}, \code{V/VI}, \code{VIIa}, \code{VIIb}) \code{destination} (son's class; levels as before), and \code{country} (son's country of residence; levels \code{EW}, \code{F}, \code{S}). } \source{ Hauser, R. M. (1984) Vertical Class Mobility in England, France and Sweden. \emph{Acta Sociol.}, \bold{27(2)}, 87-110. } \references{ Erikson, R., Goldthorpe, J. H. and Portocarero, L. (1982) Social Fluidity in Industrial Nations: England, France and Sweden. \emph{Brit. J. Sociol.} \bold{33(1)}, 1-34. Xie, Y. (1992) The Log-multiplicative Layer Effect Model for Comparing Mobility Tables. \emph{Am. Sociol. Rev.} \bold{57(3)}, 380-395. } \examples{ set.seed(1) ### Collapse to 7 by 7 table as in Erikson (1982) erikson <- as.data.frame(erikson) lvl <- levels(erikson$origin) levels(erikson$origin) <- levels(erikson$destination) <- c(rep(paste(lvl[1:2], collapse = " + "), 2), lvl[3], rep(paste(lvl[4:5], collapse = " + "), 2), lvl[6:9]) erikson <- xtabs(Freq ~ origin + destination + country, data = erikson) ### Fit the models given in first half of Table 3 of Xie (1992) ## Null association between origin and destination nullModel <- gnm(Freq ~ country*origin + country*destination, family = poisson, data = erikson) ## Full interaction, common to all countries commonInteraction <- update(nullModel, ~ . + origin:destination) ## Full Interaction, different multiplier for each country multInteraction <- update(nullModel, ~ . + Mult(Exp(country), origin:destination)) ### Create array of interaction levels as in Table 2 of Xie (1992) levelMatrix <- matrix(c(2, 3, 4, 6, 5, 6, 6, 3, 3, 4, 6, 4, 5, 6, 4, 4, 2, 5, 5, 5, 5, 6, 6, 5, 1, 6, 5, 2, 4, 4, 5, 6, 3, 4, 5, 5, 4, 5, 5, 3, 3, 5, 6, 6, 5, 3, 5, 4, 1), 7, 7, byrow = TRUE) ### Fit models in second half of Table 3 in Xie (1992) ## Interaction specified by levelMatrix, common to all countries commonTopo <- update(nullModel, ~ . + Topo(origin, destination, spec = levelMatrix)) ## Interaction specified by levelMatrix, different multiplier for ## each country multTopo <- update(nullModel, ~ . + Mult(Exp(country), Topo(origin, destination, spec = levelMatrix))) ## Interaction specified by levelMatrix, different effects for ## each country separateTopo <- update(nullModel, ~ . + country:Topo(origin, destination, spec = levelMatrix)) } \keyword{datasets} gnm/man/se.gnm.Rd0000744000176200001440000000547013615560322013276 0ustar liggesusers\name{se.gnm} \alias{se.gnm} \title{ Standard Errors of Linear Parameter Combinations in gnm Models } \description{ Computes approximate standard errors for (a selection of) individual parameters or one or more linear combinations of the parameters in a \code{\link{gnm}} (generalized nonlinear model) object. By default, a check is made first on the estimability of each specified combination. } \usage{ \method{se}{gnm}(object, estimate = NULL, checkEstimability = TRUE, Vcov = NULL, dispersion = NULL, ...) } \arguments{ \item{object}{ a model object of class \code{"gnm"}.} \item{estimate}{ (optional) specifies parameters or linear combinations of parameters for which to find standard errors. In the first case either a character vector of names, a numeric vector of indices or \code{"[?]"} to select from a Tk dialog. In the second case coefficients given as a vector or the rows of a matrix, such that \code{NROW(estimate)} is equal to \code{length(coef(object))}. If \code{NULL}, standard errors are returned for all (non-eliminated) parameters in the model.} \item{checkEstimability}{ logical: should the estimability of all specified combinations be checked?} \item{Vcov}{ either NULL, or a matrix } \item{dispersion}{ either NULL, or a positive number } \item{\dots}{ possible further arguments for \code{\link{checkEstimable}}. } } \note{ In the case where \code{estimate} is a numeric vector, \code{se} will assume that indices have been specified if all the values of \code{estimate} are in \code{seq(length(coef(object))}. Where both \code{Vcov} and \code{dispersion} are supplied, the variance-covariance matrix of estimated model coefficients is taken to be \code{Vcov * dispersion}. } \value{ A data frame with two columns: \item{Estimate }{The estimated parameter combinations} \item{Std. Error }{Their estimated standard errors} If available, the column names of \code{coefMatrix} will be used to name the rows. } \author{ David Firth and Heather Turner } \seealso{ \code{\link{gnm}}, \code{\link{getContrasts}}, \code{\link{checkEstimable}}, \code{\link{ofInterest}}} \examples{ set.seed(1) ## Fit the "UNIDIFF" mobility model across education levels unidiff <- gnm(Freq ~ educ*orig + educ*dest + Mult(Exp(educ), orig:dest), ofInterest = "[.]educ", family = poisson, data = yaish, subset = (dest != 7)) ## Deviance is 200.3 ## Get estimate and se for the contrast between educ4 and educ5 in the ## UNIDIFF multiplier mycontrast <- numeric(length(coef(unidiff))) mycontrast[ofInterest(unidiff)[4:5]] <- c(1, -1) se(unidiff, mycontrast) ## Get all of the contrasts with educ5 in the UNIDIFF multipliers getContrasts(unidiff, rev(ofInterest(unidiff))) } \keyword{ models } \keyword{ regression } \keyword{ nonlinear } gnm/man/friend.Rd0000744000176200001440000000211113152512335013340 0ustar liggesusers\name{friend} \alias{friend} \docType{data} \title{ Occupation of Respondents and Their Closest Friend } \description{ Cross-classification of the occupation of respondent and that of their closest friend. Data taken from wave 10 (year 2000) of the British Household Panel Survey. } \usage{friend} \format{ A table of counts, with classifying factors \code{r} (respondent's occupational category; levels \code{1:31}) and \code{c} (friend's occupational category; levels \code{1:31}). } \source{ Chan, T.W. and Goldthorpe, J.H. (2004) Is there a status order in contemporary British society: Evidence from the occupational structure of friendship, \emph{European Sociological Review}, \bold{20}, 383--401. } \examples{ set.seed(1) ### Fit an association model with homogeneous row-column effects rc1 <- gnm(Freq ~ r + c + Diag(r,c) + MultHomog(r, c), family = poisson, data = friend) rc1 \dontrun{ ### Extend to two-component interaction rc2 <- update(rc1, . ~ . + MultHomog(r, c, inst = 2), etastart = rc1$predictors) rc2 } } \keyword{datasets} gnm/TODO0000744000176200001440000000073613462075212011534 0ustar liggesusers- estfun, bread, vcovHC - fix issue in profile.gnm (Matthias Pohlig) - adapt DrefWeights and getContrasts to accept alternative vcov BUG in anova.gnm e.g. rc1 <- gnm(Freq ~ r + c + Diag(r,c) + MultHomog(r, c), constrain = "MultHomog(r, c)SM", family = poisson, data = friend, verbose = FALSE) anova(rc1) because constraining one element of 4th term, treats as if all constrained!! (Although shouldn't have to refit full model anyway!) gnm/DESCRIPTION0000744000176200001440000000342013616026022012537 0ustar liggesusersPackage: gnm Title: Generalized Nonlinear Models Version: 1.1-1 Authors@R: c(person("Heather", "Turner", email = "ht@heatherturner.net", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-1256-3375")), person("David", "Firth", role = "aut", comment = c(ORCID = "0000-0003-0302-2312")), person("Brian", "Ripley", role = "ctb"), person("Bill", "Venables", role = "ctb"), person(c("Douglas", "M."), "Bates", role = "ctb"), person("Martin", "Maechler", role = "ctb", comment = c(ORCID = "0000-0002-8685-9910"))) Description: Functions to specify and fit generalized nonlinear models, including models with multiplicative interaction terms such as the UNIDIFF model from sociology and the AMMI model from crop science, and many others. Over-parameterized representations of models are used throughout; functions are provided for inference on estimable parameter combinations, as well as standard methods for diagnostics etc. URL: https://github.com/hturner/gnm BugReports: https://github.com/hturner/gnm/issues License: GPL-2 | GPL-3 Depends: R (>= 3.0.0) Imports: graphics, grDevices, MASS, Matrix, methods, nnet, qvcalc (>= 0.8-3), relimp, stats, utils Suggests: testthat, vcdExtra LazyData: yes Language: en-GB NeedsCompilation: yes Packaged: 2020-02-02 19:31:05 UTC; hturner Author: Heather Turner [aut, cre] (), David Firth [aut] (), Brian Ripley [ctb], Bill Venables [ctb], Douglas M. Bates [ctb], Martin Maechler [ctb] () Maintainer: Heather Turner Repository: CRAN Date/Publication: 2020-02-03 14:20:02 UTC gnm/build/0000755000176200001440000000000013615621570012140 5ustar liggesusersgnm/build/vignette.rds0000644000176200001440000000040613615621570014477 0ustar liggesusers}QMk@|4VAZoC-^wK7a \;Dyω"Q0m4)#mnI3j 4% *4hl 1͡!0)r%x_r/=aS ++aI<]Z_LL{Gz&0J}rޗndcg9m?##+1&J2׷tgnm/tests/0000755000176200001440000000000013615610030012170 5ustar liggesusersgnm/tests/testthat/0000755000176200001440000000000013615606627014051 5ustar liggesusersgnm/tests/testthat/test-doubleUnidiff.R0000744000176200001440000000156213615614703017727 0ustar liggesuserscontext("datasets [cautres]") # set seed to compare to saved values (not all identifiable) suppressWarnings(RNGversion("3.0.0")) set.seed(1) test_that("double unidiff model as expected for cautres data", { doubleUnidiff <- gnm(Freq ~ election*vote + election*class*religion + Mult(Exp(election), religion:vote) + Mult(Exp(election), class:vote), family = poisson, data = cautres, verbose = FALSE) expect_equal(round(deviance(doubleUnidiff), 2), 133.04) expect_known_value(doubleUnidiff, file = test_path("outputs/doubleUnidiff.rds")) contr <- getContrasts(doubleUnidiff, rev(pickCoef(doubleUnidiff, ", class:vote"))) expect_known_value(contr, file = test_path("outputs/doubleUnidiff-contrasts.rds")) }) gnm/tests/testthat/test-RChomog.R0000744000176200001440000000254313615617260016507 0ustar liggesuserscontext("implementation [multHomog]") # Goodman, L. A. (1979) J. Am. Stat. Assoc., 74 (367), 537–552. RChomog <- gnm(Freq ~ origin + destination + Diag(origin, destination) + MultHomog(origin, destination), family = poisson, data = occupationalStatus, verbose = FALSE) test_that("RChomog model as expected for occupationalStatus data", { # Model (8) Table 7A pearson_chi_sq <- sum(na.omit(c(residuals(RChomog, type = "pearson")))^2) expect_equal(round(deviance(RChomog), 2), 32.56) expect_equal(round(pearson_chi_sq, 2), 31.21) expect_equal(df.residual(RChomog), 34) }) # Chan, T.W. and Goldthorpe, J.H. (2004) # European Sociological Review, 20, 383–401. # set seed to compare to saved values (not all identifiable) suppressWarnings(RNGversion("3.0.0")) set.seed(1) ### Fit an association model with homogeneous row-column effects set.seed(4) ### Set diagonal elements to NA (rather than fitting exactly) dat <- as.data.frame(friend) id <- with(dat, r == c) dat[id,] <- NA rc2 <- gnm(Freq ~ r + c + instances(MultHomog(r, c), 2), family = poisson, data = dat, iterStart = 0, verbose = FALSE) test_that("RChomog2 model as expected for friend data", { # association models not reported in original paper expect_known_value(rc2, file = test_path("outputs/RChomog2.rds")) }) gnm/tests/testthat/test-logistic.R0000744000176200001440000000253513615600214016756 0ustar liggesuserscontext("implementation [Logistic]") tol <- 1e-5 DNase1 <- subset(DNase, Run == 1) ## fit logistic model using nls mod_nls <- nls(density ~ SSlogis( log(conc), Asym, xmid, scal ), data = DNase, subset = Run == 1) ## fit using basic nonlin terms mod_basic <- gnm(density ~ -1 + Mult(1, Inv(Const(1) + Exp(Mult(1 + offset(-log(conc)), Inv(1))))), start = c(NA, 0, 1), data = DNase1, verbose = FALSE) ## fit using Logistic() Logistic <- function(x, inst = NULL){ list(predictors = list(Asym = 1, xmid = 1, scal = 1), variables = list(substitute(x)), term = function(predLabels, varLabels) { paste(predLabels[1], "/(1 + exp((", predLabels[2], "-", varLabels[1], ")/", predLabels[3], "))") }, start = function(theta){ theta[3] <- 1 theta } ) } class(Logistic) <- "nonlin" mod_logistic <- gnm(density ~ -1 + Logistic(log(conc)), data = DNase1, verbose = FALSE) test_that("logistic with gnm equivalent to nls", { expect_equivalent(unclass(coef(mod_basic)), coef(mod_nls), tol = tol) expect_equivalent(unclass(coef(mod_logistic)), coef(mod_nls), tol = tol) expect_equivalent(coef(mod_basic), coef(mod_logistic), tol = tol) }) gnm/tests/testthat/test-bwt.R0000744000176200001440000000202713615614173015742 0ustar liggesuserscontext("implementation [multinomial as poisson]") tol <- 1e-4 library(MASS) example(birthwt, echo = FALSE) library(nnet) bwt.mu <- multinom(low ~ ., data = bwt, trace = FALSE) ## Equivalent using gnm - include unestimable main effects in model so ## that interactions with low0 automatically set to zero, else could use ## 'constrain' argument. bwtLong <- expandCategorical(bwt, "low", group = FALSE) bwt.po <- gnm(count ~ low*(. - id), eliminate = id, family = "poisson", data = bwtLong, verbose = FALSE) ## Equivalent using glm bwt.po2 <- glm(formula = count ~ -1 + id + low * (. -id), family = "poisson", data = bwtLong) test_that("gnm agrees with multinom", { cf0 <- coef(bwt.mu) cf1 <- na.omit(coef(bwt.po)) expect_equivalent(cf0, cf1, tol = tol) expect_equivalent(deviance(bwt.mu), deviance(bwt.po), tol = tol) }) test_that("gnm agrees with glm", { cf1 <- coef(bwt.po) all_coef1 <- c(attr(cf1, "eliminated"), cf1) expect_equivalent(all_coef1, coef(bwt.po2), tol = tol) }) gnm/tests/testthat/test-diagonalRef.R0000744000176200001440000000236513615570620017364 0ustar liggesuserscontext("datasets [voting]") count <- with(voting, percentage/100 * total) yvar <- cbind(count, voting$total - count) # standard Dref model classMobility <- gnm(yvar ~ Dref(origin, destination), constrain = "delta1", family = binomial, data = voting, verbose = FALSE) # separate weights for in and out of class 1 upward <- with(voting, origin != 1 & destination == 1) downward <- with(voting, origin == 1 & destination != 1) socialMobility <- gnm(yvar ~ Dref(origin, destination, delta = ~ 1 + downward + upward), constrain = "delta1", family = binomial, data = voting, verbose = FALSE) test_that("standard Dref model as expected for voting data", { expect_equal(round(deviance(classMobility), 2), 21.22) expect_equal(df.residual(classMobility), 19) p <- DrefWeights(classMobility)$origin["weight"] expect_equivalent(round(p, 2), 0.44) }) test_that("modified Dref model as expected for voting data", { expect_equal(round(deviance(socialMobility), 2), 18.97) expect_equal(df.residual(socialMobility), 17) p <- DrefWeights(socialMobility)$origin[, "weight"] expect_equivalent(round(p, 2), c(0.40, 0.60, 0.39)) }) gnm/tests/testthat/test-gammi.R0000744000176200001440000000301513615614513016234 0ustar liggesuserscontext("datasets [wheat]") tol <- 1e-4 # Vargas, M et al (2001). Interpreting treatment by environment interaction in # agronomy trials. Agronomy Journal 93, 949–960. yield.scaled <- wheat$yield * sqrt(3/1000) treatment <- interaction(wheat$tillage, wheat$summerCrop, wheat$manure, wheat$N, sep = "") mainEffects <- gnm(yield.scaled ~ year + treatment, data = wheat, verbose = FALSE) svdStart <- residSVD(mainEffects, year, treatment, 3) bilinear1 <- update(asGnm(mainEffects), . ~ . + Mult(year, treatment), start = c(coef(mainEffects), svdStart[,1])) bilinear2 <- update(bilinear1, . ~ . + Mult(year, treatment, inst = 2), start = c(coef(bilinear1), svdStart[,2])) bilinear3 <- update(bilinear2, . ~ . + Mult(year, treatment, inst = 3), start = c(coef(bilinear2), svdStart[,3])) test_that("bilinear model as expected for wheat data", { # check vs AMMI analysis of the T × E, end of Table 1 txe <- anova(mainEffects, bilinear1, bilinear2, bilinear3) # year x treatment expect_equal(deviance(mainEffects), 279520, tol = tol) expect_equal(df.residual(mainEffects), 207) # diff for bilinear models expect_equal(txe$Deviance, c(NA, 151130, 39112, 36781), tol = tol) expect_equal(txe$Df, c(NA, 31, 29, 27)) # "Deviations" expect_equal(deviance(bilinear3), 52497, tol = tol) expect_equal(df.residual(bilinear3), 120) }) gnm/tests/testthat/outputs/0000755000176200001440000000000013615616770015574 5ustar liggesusersgnm/tests/testthat/outputs/doubleUnidiff.rds0000744000176200001440000007170313615610545021070 0ustar liggesusers]\I{U, E,3ʝbX(фb;{/gｷ^b+z,M6)~̾}7of6;C;+(毱⏱⏻")HodFRJyT|blrL@R4 [aKSgf| WhH#8![xTgJ̲4ͳיFĄ%%\%JcdJLu΋JEHHF*-_X%俩6c;vmYXb[EȊoڈ͞OXe?CGN~Ҝ^*cL؂9&6LэP߂E3vU> Rl)%)5 6ʠ>$0ώŷUdqҰ"eR,)M)(YK9-'ŝvUS^s"ov%xhzxkL^4&5kK[1C*5ݱdw*-iDZDڍr֘%C}?sj1˓_@iV",c_J+l9؉Cv=S_^[k{anfcO9QQ(b޷+EDŽ2W6$_BFiFȼw'  J9RTojӧ6mK.7r^U-LGzڕ;㖎؞>D~:+7\x?WcW}#/Alv~qKta٬fbJюv+-G,|9.ȺInngr,:}ژ5O'ҷB6enx6sEatgd]<\/PMYRC/Tzer 9{q@ uГ_AfGVmH||tJe+8ޥ U.;r8Z4ΧQ}?w^irkds,dݝ=M.2azwt׾GW޲6Ʌ;\8!~XOSzKūf.AG0.tu]+m980x|{?_B񥌦w2P }ٺǭ6s:.ٰQ^|Os1s0t2rΣ.j-BvYkR%{>3z}e4zdmч!iFx?z9X>SJZ_x0J_ c~b맛ҏ_3lCsiS/.|B|٫k?Q51(sߛ&2}O tfgH5Z2 % 'B*8] =+K/{t(:W\zhuuk4by_t¼ZL276Њkgݪ]6s:И:/7.4q;y,(i oֿGosgzز)W+  Sf[Иǒ}# 3XOgʼbs-Q6~ᥞ$j)_ks˒sDK>#֢G#_%hѣ/ђOjѣ/ђOhM%_oɾf-8‹yv$O jh?+(X))e(2_fwՒ%_,B^^^^^^^^^6MkXMk`}N\$$:%X% N ֟dEBS6:YrШ}אШ} ƒFkc|&׾6\$4j_K.E_h}m,HhԾwШ} a4}ƒFkcEBhY% ƒFesK}DX%li;:V~z=C;=uυA7KV$Fk]4; >-^&+CW/2oetLЬtzk?cJIkk}FnII:RsoWh.7_n|ThW7{=. Io:h߇ _|+_$>Aw١/Vf;}z_*ޣsZB?ߠ"4, 7^?˿LDk {eF)U TQzqnF'v*MZe;Xw<:`?bw]7CѺv/= zayW/6XX\>(3t`(:K"z"zDWAK[Ɨ~@eh:͛DGz.)8}ԋu E E7OXFOi/SY41x;g;4+4/F{):z̢hӋE-]Ao ~hӽ%#Zެ}Ѷ+BQ![4eF8-{)EX5`}tD~ύЋcud+R{|[^>wкsIhOnyGߧj[}Tj㥋itV֛5Zu5i.aV'utFMצw {6Й.BQevcQ-^)Qh5dubCWvD:|>]hѦ[\ ٠݂;ОM:tN}=iF[m]b1jtY5hvW-J2u8`5vJOla2"-QnL8?k(:CEЪND*x\NnݔffW<6u9BҚ:.DS' E[ilHz|V;kkZ_eO_fۏŵ/ٿ@9 Kn(z6}C7,pPQI+h]"}vXՑ^<ɷS]2^$\/?ex}Ϫ򷗠\z|ڒ6#p?SZYɯFfk;n;n PgewtMڊ>BGOc+Jï/l Jeʋbvj[,q,ͯ[wy ͯGEjtwЈ{9{wƪWYѕNI1_Ɩj?vxNe[wo13pc*,Ұo_eŜOc 7ٹdL9>mm3ۥFƝz: ſ:zS[ǎE\W#šFm3%|(&+a[.wW*٩G^Σ"=Gk>r缴qxE Çek/®vR {,ZtNƞ~U)™jZ)C{TyK:gO Ǟ/o1)ܮep7CVMz4_RϢ{p;z 8*YzL\\1sso.|nSYyyн"lpYZ1zeb>k#xĤKppE#qŚwmO=ꎽ÷rxW s4uf"7ŪrzZ]^r_3q9GzAAZ^?: 7xH u<{~lzffƸMY򧽱ײotj[8tvKI>_d=>nkΌ+wnǏ۶--Mu?f=`lI5pW 7 {XU{. ,tq d.k;%%5o}omc TL.m{.'t[Y./6Kk6F%iݾg~U{ZmZw[|=`= {0ߣ~^pX[<+J<>i|bwE$i0F\zƊK)c  f{vk#U&~elhȄ4=.g^sJ{U(6Y#m QEa#HU4{4$ĆVPT(H Rə֫IXD7YTocK5#_C)͒dQqJgûK#P-.){T ja"ۘ) @S _QRaLZ cH9pxP8LӄJ݌c uaYEI93I#⪥/!eNCN$hT^$Y6Ң6!QK*RʤIQRY@XqX\@DRDx:顎 Y{%TD\dq l[yVfꄿi(yRs-e5ɕUk6Xhf?Yy+mEE˻_2j;/"ZȳM 5L5cL볣4s΄JD`aךW\ي. [NݮB6{)A\N;rI{'$JdqI"yd*}?՚M[˖Rwne&SV/]t0|J = 8/<ػY=b#`I`;/ J};,s`l+ATB!Kl,N&H)u)Zͯ*7qZDv9}?X$I@UA'zJ=z$K<a11񽤑QGZMQr XރW{sˡ/YOFG} dvO" >Kf 3UT 8L>`VAhU1i@g)If<"n[f"D3y$*3NcԪ4s%1c7MPnʖm6 GX١ Z-cF L#}3R$I.k"ܡ*5ޕ2o5BGyU忕//^ؔM݈~?`}ֿbwxnB$>At%ǜP#B䮽(ͩ[rw#"5;_{cr8i%ylB%JUGJ!يR!Tz^CAgx[5Mֳ+ `'9M4Au^/T2/ ɤP΁G؉J`'lڙ*a*:=JE2oUG<(GcSܶ>)D[;kGʵ5ZB:i^ͨ\9*oSc,W mb)Kb&RJeCFc^DTbkbUO JR G9շ=`‡}:Wn,0.BESd]3ETr5[WF*mJV7i[lO}꿮ČK\@ +m?4 /y}V}jH叐j_^1F;JRד6ًekw GʧM<,EUcb:h&ƪ7A+J'S׀=we S46!G[Q5aDY>x >w;q>.QB~-t݄~ s%|`Laro4ηcd vÚϔ]UôM_$>!~}̋5<;?g_I;rՄʍesw`TLQ|jRhSvUt|ї!4Ax(yC;&߯66K6Vm'K4n>7!:fs+?E}7-(G-u!hshot}&k+"něѪ!ya RBsIq9d$M kLuM2f vͥnµGыvݵz.dL;ytp˜竱%#>oUoˮavPXrZZղk;,{b{–;*[逩g[wZ5zێO7.e:4_,jj~|Kv``Ƽ6֗3S$&gW2n(d8۩|x4l.iF_LUO,*[R{ 5gcy'{^3vhXo l^=;[xsT zوԇ /Q(ɮ]u]>' W|56V4uaۇiUJ[tخb(}s=:)v za{Xڶa*3\Գ츹3Eѫ Q,U}ؽuqOa5W\m9vvw}SgF+G;F0)} `LklQn]Οfaa/a:,㏝mDh^ci1K<a!n+G >*ٽuClჱsdvWQLVT5xｪ:hl[sͺܘ`l锫VeĩsL! & X)6EERBm= aǤO<;ַ߲bGk0vˏ2m=oc ;`+SglCZle;F2cҎ` :ר9Ķcbf/b+~s[ [5ُMhm>e̩[guh1sE]&=|^;*a"OWb#\k-0iu{-*&ao\WۧYܜ3ncK_%Y+]m6ΜM7_};^zhZl[e;Jcie]j=C:I2v.Ҭ‡6i>s6OŅ{Qvz۱E~iSSbŵ6k۪_c%:x߶[خc&qHW^&a2-7tlqɜ b.\ݟ zT{Ufmf`fQ63CfFyhH̐_L.Zɮ:d'S8ki8p(l6s^L,V25dK^dK-M 45%[ [4-MEqKdKZ4(Ҕ"[f-M'-Mcɖri-M 4uliZEi_a-M-M-Mliz^i_-[Բ uliړliI˖dKӫdK}ikS4cKSKɖ[6liZliږli:liڝli:Kǖ+[ڒ-MCuli*ղi2[6 [kt,`K:4ֲ;[%[-M[li't`KӰvA'ؿ==Kl"QpRr4&# vbǬB<c_ƾ0/})ؗǾ*=C 1gsB焾=fiHCҐ9BsBϞ }??{Z_3SA~A?>4SA~A?>4S?`os/C~CoO?' 2t9a|_0ds/C~CoO?' 2t9a|_0ds/C~]|:~/?6~ ~/?6~ ~/ P?@_ x(x@ @G_ _ _ _ _ _ _ _ _ _ _ _ _ _ _  P(x@ <x@_ :W*u9]_.(Nt~mx;_t~AצѝӾ"P3̨ <}\!B.[ o:P7xy[ۯB1e\)eoFW/|U+W8 GW;jw~;fW_@_@_@_@cпппտ/ G؀EEE////?6///AՒȮngc~A?>a~W+ѵk~Ԏ~MELxKߪr?޿S첸S-:uC3l9{jwL]fFoziL~~}G"lGZҼzu2tqͭ<{^rtE<.-|f|7"g{,jLi9@_[Rcza Nu-~}GݺsafUU/JE';΄MV'8o2ˍJb-Oơ M!'J3yvF@tj.סɀa]'~ߌksIV{2F~=rxU@~k?5tO ]SCok?5tO ]SCok?5tO ]SCok?5tO ]SCok?5tO ]SCoT_ ~C{A3tj ݟ~C3tj ݟ~C3tj ݟ~C3tj ݟ~C3tj ݟ~Ci71(,E"(T*{{&&ߍw&}΄b i"ɲH#8aX!!=RVܞ>0lql$X-%QKHʁ/>,9K=b-z4%Z=-D=-DZ%Yja3 yjA'K.ɒDOt"!)z,HHtJhԾXgkHhԾFkcEBh>k_K.% Ƣ/׾6\$4j_;hԾFk0L{kcEB"QX4ƒFkcEBYMcNU{6{`YыK}DX%lq5^˼ΣIHZEj;/VYV솤̻Nq%v宲Qo]TwQIE}.wQ ITwQIE}.GDg13zsyl%vc\HOqQ-qo{). qe9.ߘ~sgļ3oL(=3rlB3FĺS9crvS"D~j<]E \c8BrlI‚4F)P#0ƑXV0.,VNИ)z"%i%I(R,IIlLdD$fΗ"*Et[)=D_QUY"t#m *̌?lC%jf=p05Ƚ{7SL4PН#$+MPMTlbI#glT(B#b(EMBbbPXBH݉=K#: W"ĞLٽ5N1 Wy0QQn&NסМ5&z{b7"4'Z)ŷƞ "ޘݝ=}΃O {R='ׇ{DE;"IlJƎ3ة"T!vpS. Q9x02`lİӧpY41/,^!gLf1?g<))쓒 %U/G$ ɫ=Ky./ =Cj70%&$J{P"y~>5Kc#Zc3\6q,LHlNb [*/iQű>E)7h;/\n׊r9۵\V&Q.tqp^>]5}Co?XZ&tIR.R:<Ȗ=vDnw'QW*+@NۻzuAs6>>BQ81=s}UfPKR:niWR:YJ> &ߌ8tXrKT:>< EW AM'l XYG1"RȈ1;3K&"SgbV`4S=qTDR@JU.2A˵*ڨ^~uYj%lޖ񽼔_C *Z^LX1σWTJӛ4",ّsjF[E Ņq *>*{4IΊąy>oqJribX\RRJ3MzID4*J!YqI0Kie(ME&q對Ha1w&&{XYL { H9RSRr0͘0efK*ƕ6!Q襞iŖ)*7S-dϰ+L.gLc#1ZNƊw)^ٰ(#k{P@~m~L Y.(w?xGw%,gyxqF, EA~QK ݙQj} s/Q%:TQa,%wghەS)PTRc7Fك90ysG>ܑ;pGܑwpGqp>qp>q91!8sbCq91!8$pCqH8 !8$/qr/qr/qq~qq~qq~?qs?qs?qpGqpGqpG Qq8jp58G a]:bP~?l<7ͳyl<7ͳyl<7ól><ól><ólbM̳y61& t#&wU]r?Zvx1ݹ۾!#_kzhtgI})ܧOm$ۖ\FgWoZ>*Zƙ 1+w-=}z,٭tVo`h֋^Co D;FD9^*薏²YF]}tEwV[Ys =~]u͓(Yt1kNomx :lJJC7x̹@_tޛг&ۭ+^ zsz'{{5$}N͎t=Jې1˺W Ao\#qK>1. ]v.q'hO~]ZkT6;tGd[/l97=Y4l ;{PgO M\dd_}+Fe}m+i /GwDkqCz蟌W\a֙]BV=|Sssq` iiKM]d2ءu[Mӯ7=lFiu](6a1N <[J(}c ad=FG]^Z<0%z׾ץԳK-y=}gY~5a5i,7ڢCZ3=:~vrı}B1Hf'`nAxAO7 f؆o^\~Wow~+jrcP7/Le %ҙ:җޙ-ijdC/KOUp]z2WL_6Ptp2)KviBOh…yVd nm+/κU -lKu1}{u^o]h:v }'XPTެ^)eSV8 |jzh)<x@mh}:$}?ǁNQ8~s}H ԣ-7^.$8x i_R'1Z^siqWt0^~۠.cfӓ^SJ]F_6wKNڰt; Bs}r(FӿM߳qgHzD>\xP5#])be&9 0~Ѱ23WIТ|zAege`a1]O^e"ZSx1|ގW\taP=b>kn4*$zOh )G/B6{o}DOI>xRr S+@.|q lm>3Ыcj>G|rȨ(vK6KHEƎqӏ8y.h5WTw0=6^!^ئt'ѡ66SJd t(lٻ&-3:MBn0ݧҋ\v;t5: mhUi*"(y[=J-{ ˛{ CtFё\J W# Z2\UZ$,C?i<$:bsI3^[,ZM/y3zJ}Iʢnމ8{Ġߡ5&^ }1Mљ%+gE^,h zCfu뫠KLpȘ5Ӱyߧ8G&-Y9nf5L]4wM ,+0iK,i,#Zn^#[ %NBۇ\}u˃>>Pے=R/]L#ʴܭ$ԪIst u:՟Nt{.0j6kp߫yTtIߥڏz- LmlOF!KK&)=B65rZ߁|mҡtIc6rnhW3*AGz0oQfh#O7741Tzjf o9iAp3dy(^GЩ-V6pF'WxZvw릴p?803>ɴZԩGO w!%=g(rHfSFoY-\b*{‿7~|F/xJ0a]zT^Pt}D{ۅtg*LZAJ@Sn_hgưҨv(o/HdV":})~VgM\+/Жݟ:ʒN~55[#q^qO8"?(mV<:j~[Q~F}dKPЅ/S^C'_GsWbш;fh~ݺ]o~=/zPXF]t5Vzt7O2\PS/AGTs:(Cߺxc%tvAc ?<2nę {v':CZoJ/J;ҫC=/@  QpPLI7OĒ6U MuigO\ks~c^j:Z]&S;٤ n/jKXl^ Ih"X~Ig"zs";~{㉸Ļ٧p IM|y$E'Pw&aYo͋Ctq73W&GKI^ѣ> ,V7|׹WdJE]ĊpmTiѕke3Fa7[>L 71IoDέ[hȔtm[7Nэ9nï}Wƃ,v|f=߉?F&|6 mq_cq_蜁 Tg}k/.|f}%c}m[n.74۽pphe(Sz-n>vNO.GOѬ(55l?\/fF7_ wqGo:T&N= w9-]wp;Û-J>'/[pWmxov-<ÐjcѢp2 BOUWJ7أ2[ԩ= "NHo>x~|Mqv-/ۧⷪnңzp_ߛkԻWiTfZ7O'2u_ )w{ n_wp뗝 6gՊѓ/cY<qk&& \۾/j+ּk{Qw}Cb3q/V{6C[ͱ= ֺ>n>aUWG)kcCܬ36 e3ZR/p:{"ͺ.[Y{ϺP460O.>|yӥ"4kp`wpRڀ׿xFmy]=.Pp^){AJWf}DcoǕ+:rrs4\khq-7hT:65aurpv!z&o~t{mCjG`o9h~%|vj_|KU 3mZ?퍽~XTFհ[Jwrl ;Qq0.^ufh\qCu?~tܶ֞n1mm:ttux߂1Kc Mz8/NWpվYثĢߗǭWsim8We[%7t.67t];)!(94~G,pxnL ]`rygmuaV%~kϟI|W~7um㌥3==d`yi[u.w8\ryY ]m7*O=s3:nh{`=Q0߃}~-x y|LXavYXł٤GUyB,)){jqL|4edbLQ)n۝d;DM6H [/myی' H< s*Garv "w䓭>0v(ly2U"z)ryV۟ ysO5wB4)I8.R[ۓ{T_渫ɽ7PwzP[0`ad1'2D^U̶(L ~/R\UrLH7Ym;VJx[ڤ 2LWG~H GߕR_UR*sP^.o&lRm/\݄M ۱aYs*3s^NeV-{IY.zT%{7ryc~>\x2wBy+uQg86%cng})rPzgcKjO5o6%{珣4LwcsUłRa3.9{Mb<} Z=ZU%}#-T¤HlMbKې؂$<1zX>3:EO~@Φ7k]96b[s-J%-)Cvg $8`,I`$V vV .fN·{t1aÄcSb7JuL12%qHJSN:"a+O<[yhc}CЗkAwGQ>_~6DZsQ**~0B'#s򋹌۫p^xq~U#nD?'g k^ ʝ//4SC+CT#\X9I䲞R 񈋗{FzD'zȻI=7SN_{vT)_Z]y謢4{Dg0C_5毬,I)۹/ QVcv%TeaXfbrۓy5Ac^1d.SCw 5sa{rpD/| [BBSr2_r F*A[,(~~|Ϩ*}~ (?{;PձscS(g}162ef۩9)36`,M>ÃRqSO%nFΞAUƙ& e_Mt<'_܄xn 4ϭ/s+`>Bˁۨ,:.>Q<Ӕ;M-u!hshouhSGy֔f<]3TjODj-:PyE6;خ7۵TgH-a\s/SVyϵEEf99[ldKPKT÷7G,У4?g c¹:^KpR t/[oɝIwqTrjRדgX?T ;v`g%,N&+ղd^"_`$c"4LuMS2f vͥnµGыvݵz.dL;ytp˜竱%#>oUoˮavPXrZZղk;,{b{–;*[逩g[wZ5zێO7.e:4_,jj~|Kv``Ƽ6֗3S$&gW2n(d8۩|x4l.iF_LUO,*[R{ 5gcy'{^3vhXo l^=;[xsT zوԇ /Q(ɮ]u]>' W|56V4uaۇiUJ[tخb(}s=:)v za{Xڶa*3\Գ츹3Eѫ Q,U}ؽuqOa5W\m9vvw}SgF+G;F0)} `LklQn]Οfaa/a:,㏝mDh^ci1K<a!n+G >*ٽuClჱsdvWQLVT5xｪ:hl[sͺܘ`l锫VeĩsL! & X)6EERBm= aǤO<;ַ߲bGk0vˏ2m=oc ;`+SglCZle;F2cҎ` :ר9Ķcbf/b+~s[ [5ُMhm>e̩[guh1sE]&=|^;*a"OWb#\k-0iu{-*&ao\WۧYܜ3ncK_%Y+]m6ΜM7_};^zhZl[e;Jcie]j=C:I2v.Ҭ‡6i>s6OŅ{Qvz۱E~iSSbŵ6k۪_c%:x߶[خc&qHW^&a2-7tlqɜ b.\ݟw|)R")*;E!|<4/]t-dW2)Nvv/Tkɚ^dM{5qdM\ &E&[ĉ㚸dM-k> QdM\Y7%kdM\5qkk] k5qɚ8S-k░5qȚ_k %khY7S˚5quIuҲ&ΕJ%5qɚ dMk&)kFXg)X7%XD&(YזOu'kfXR&Ζ ձ&NeM\&n`M,dM\5qcɚ5quֲ&YAǚdM+Y XwR&O&n`M\Xĝ"k>5qյ{K č"k5q Țy[׏Ҳ&`M-Y[ǚOZױ&>Y7O&"Y^& 5a sMkR0ׄ&5ɞ/l@ 1Cs0c`=|oהRe)̊ $fVlXXR+GIlLdD ?>+`s(᪬*^AQ c]ή`\R\Kȵ5H{P.}3JA|I;0+Xz$ݓtE M,Ip$JgiDlE)w&abb#fwRvwbOvN1][g[{2e&":ń3\)D'a*{ nL2 99,C]M rIړ'<'uYCqr}8g MT>CPS6vN  }#ƾ0` c_f~nC 1'= }??{ ~! iHCL }Ϟ }??{?'ia~~Ϡ~OA?_|~OA?_|~O׿ C ]?~Nze =~0無_}ۓ C ]?~Nze =~0無_}ۓ C ]?~Nzeu};_؀/_؀/_~(x@ @_ (x@ /7~/> ~/> ~/> ~/> ~/7~ ~/> ~/> ~/> ~/> ~/7~ ~/> ~/> ~/> ~/> ~/?7(x@ @_<</ P(x@ < P(x@ <x@_ \gKǤG '=i^ ]_.(Nt~mx;_t~AצѣȪ V>+LW_i=2eyz [m%iyA6]-i_[ ;_t~Aצ ']_.(Nt~mkiS Kэ[ӗ)TF_iOѲZN1=f]F|aã>}WK3iw饙޿3?~A]l}kIř67ux=q/ sHAnw܈;3[o~}oJ酁8խ?~A]hw¾υ雕VUݾ(v;6Y Z}/7+ş<т*675>l<*=ѽ#+:oJdzJ[_{'u3*u3uKЯ'.[ EșmVѯg?5tO ]SCׯg?5tO ]SCׯg?5tO ]SCׯg?5tO ]SCׯg?5tO ]S}7xg ~C{_7tj ݟ~_7tj ݟ~_7tj ݟ~_7tj ݟ~_7tj ݟ~Ĉ\Y8R환|7&ߙg*C9yn+4K# $R#|badKYq{9gKԲ"b’SbD-嫖#)(j/ђOȗh'z$ZhK=ZhK=vkɗ[&JcdѪM 3[p橅;ZOI+8%~WQxSS6Qre*5T%OKYb-b-b-b-----lװ.!),HHtJC'K.?ɒDmt"!)Qb!Q% ƢLj}m,HhԾ6\$4j_^XrШ} Qh2% ƒFkck_K.% g%6IWh;W*eE/j/ae. gxUb/ξ;>_$-"iI{VJHZ}fQZr[2:ydۅʾFQ*wQqE%yͻ_E՛W,'QqE%yͻ͞W`fve1&籅!q!=EſQ졧4縜~c*͝ϘR3oȱ 9;dSNE>YgM^Hľ*Mt2.0Kp ɱio$ _gӬכ"ByXxT`LNGbYøXi:aBcƪꩊPYk$ H:$1S;&19_mD"}E WeEW Ѝ5"oLx23 ɗkk2Pw rLy2uP_V@J(Bw"S{(7A7Q% ISE(M6 =j*BaE!ew',M_,Dl\g[{2e&":ń3\)DEt;E\Bsטet6Мk>n{"2{cbww$ɶ;r?I]V&P\NYBd"P '))3c;RbPM(D@dL"YװYTX慂5CoJ$%tIRg,R:<Ȗ=vDnw'QW*k_7]GOJf?-`ߓl=w/S -T=\~W4~uS~_ow۷ 5Tr?}YxOrRh| j&wPp7jY#g Od)^X!E PI^bnj1- U'V-)p(Q/LJI-.KM)M6$F1QdB"90?̯w~gGWod)IEg|Sٿsh8Soעv/-ugn۟ʽ^v\ro?o9~UG'2z`ٿah Zjc%5IĒT()b/,M,΄s9ܰ"4S9Mq^90_RKҊ$pelg!z؄/0o֩aIv_ ESb؟}vZIDdn#} Ӻ_=6m8?v.xTcʍ0Sb0# # #ƔD„\'ҜD4uК&VZCQMI סu0na<ՂU,P" ($#ieBd[ZbnfN%rxg)dPXebfqiťIũ%R&E[$'2A+!F@s2Ԃ1le*^AO((5'V槤$'@ cwNa*„mS gnm/tests/testthat/outputs/doubleUnidiff-contrasts.rds0000744000176200001440000000137413615610545023103 0ustar liggesusersb```b`@YHyL|@ZUЃaϒ.a~3{rFv8 "kߘ@˭ F9ZQ'j*`QtՏPs } Mit @q xN;Qp%Pu`uy%Ҝ ׊ =MbTMԜ<U҈hCнɆJLΞd+1a!Cݡߊ6xZTŇ60uY{ᤶaAxwo, ?NEg7%:fyٯg쓲g ZZa%H-.M,I],L8 K,B3(\C *Q WJbI^Zl¶ScRPv7K0>x֢ޚ2 Z- V15ݕp6T1̈m15]FaĻ̈)HEwz^.ZbO/-IDSX-a,nEP1AZhr\n/P@ Ҭ.JL,=`" Y$+ieA$ HPAd`3Z%fT"cA~fq1ȳ( Y@%Ғ"P RAAh%eK/" RApO-**Ĺ)9ɉ99Xaf*,Y8s gnm/tests/testthat/outputs/RChomog2.rds0000744000176200001440000020007713615616770017735 0ustar liggesusersXUKFADb7 ݈(%`*b+v+b,DEJCAIi6p{kX'30k8D' `gbacًXyyH}Dyzpɷ谅_Ul<B<|y-\X$1w/?g/W?stZ?ۭQGOl=Ľ)˜==-ow??o/KNj4g_NKyo?W(+m<^\[7}?-Ghb/|quw^G ]Aw?̫:{b=*u)'uKY}$βPOyx9{3y??;. *uiitV&l#_%XyW=w/UtI/V*]\}̓ǏL7;g,fNgۏ>?Kٞ rptr?C{2?WNy]E}|]t-⫽'2NMY[wmÓtoOx9_{SU%e%#１z:,)~n^*3 Py_Sܽ\}Id?{X d?fR?N=glmTj4lKmB~Z]]{VSÉ~ddLy.G~wMyOd Ť>FZ.&CC_TO*3m'$Ó>7Xvz@X`D^b7.R/$XF +Aeحg2J,2*=2j,2,II#['l|+{7['l|+{7['l|+{7['l|+{7['l|+{7['l|+{7['l|+{7['߽~̶y94yG4#:8pv\'si9q̱űX劓N=#'`7+âS s#ˍj4uXN-G:[0Sgqa>?w E7|g /+dΛE#װ /a^aSA#ڟaaK?F [F/?5l8ܟAa12aÓzgdaO$a [? ?i׿a wT[7 [jmgn^˰4lgmy3nz8w"zo/j{B6 0cߩ.nʾk;Ǟ[̊}`9zH .]g<3?7l{|re~? y9sSw [Dzy-7N}}77^{N;礓~<Ϯ_?b9\+N9/x_,y98dcN;４3s[><[m'yב~c;q)<ϼ/H;˝rcY,w~;?˝rg tz~g]b<٘=BHtGfp~"[sEW i\ FfrQ`7 FRLn07 Fcp-Tn0:a Ơp1`LKn0&@`"Eb*?oޞms>IC+CJ݆ ?gorB5p \5p \5p \5p \5p \5p \5p \W \hJ|TfG|Ltoeɕ8\Êʕ;\\ݽO su:@\d2Ww?7puP1S1S1s7qS1S1S1swS1SrupS:\T~WOquи:;fi\4:Ww ?7puй1ӹ1ӹ1s313131s7313gpupw3:\LV~&W`ru0:::::&'knx%'K2)XbE:*K&6+ k(++ k*++ k#cmxwk#cmd o"cm>Ű6 VA*(XfeE*(X{(}T Q6̊Q6*ֆwYQ6*F4+FhXfEhX kÛhX϶;Uб :V7Yѱ :VA*7+Vb`mx+kc`m ˳b`m M~VL16cЊ16&ֆZYcm}60bmX5VaU iU`T1*d 2FQAƨ cT1*d 2FQAƨ cT1*d 2FQAƨ cT1*Șd2o$cT1*d 2FQAƨ cT1*d 2FQAƨ cT1*d 2FQAƨ cTi}6bmd2%cT1*d 2FQAƨ cT1*d 2FQAƨ cT1*d 2FQAƨ cT1*d2g3FQAƨ [Q7CcTP0*( FQA`TP0*( FQA`TP0*( F@|QA`TP0*( FQA`TP0*( FQA`TP0*( FQA`>P0(<`TP0*( FQA`TP0*( FQA`TP0*( FQA`TP0*( ?0*( FQA`TP0*(T *FQAŨbTP1*T *FQAŨbTP1*T *@S *FQAŨbTP1*T *FQAŨbTP1*T *FQAŨbTP1*T *FQA|b>P1x*AŨbTP1*TZ8CT *FQAŨbTP1*T *FQAŨbTP1*T *FQA|b>P1}O QAŨbTP1*T *FQAŨbTP1*4 F QAèaT0*h4 F QAèa>0h4"F QAèaT0*h4 F QAèaT0*h4 F QAǨcT1*t :FQA|c>1x*AǨcT1*t>*p0*t :FQAǨcT1*t :FQAǨcT1*t :F@|c>TQAǨcT1*t :FQAǨcT1*t :FQAǨcT1*t :FQAǨcT1tz1ƨcT1*t :FQAǨcT1*t :FQAǨcT1*t :FQ``T00* O% FQ``T00* FQ``T00* FQ``T00* F|`Q``T00* FQ``T00* FQ``T00* FQ``>00>'`T00*  ! FQ``T00* FQ``T00* FQĨ`b>01L<`bT01*L &FQĨ`bT01*L &FQĨ`bT01*L &FQĨ`bT01*L&󁉧L &FQĨ`bT01*L &FQĨ`bT01*L &FQĨ`bT01*L &F|`b>0QĨ`bT01*L &FQĨ`bT01*L &FQĨ`bT01*L &FQĨ`bT01֘x*aQaQaQaQaQaQaQaQaQaQaQaQaQaQaQaQaQaQaQaQaQaQaQaQaQaQaQa```֔>*p0*1*1*1*1*1*1*1*1*1*1*1*1*1*1*1*1*1*1*1*Y~-7*,9ѷgx`?uBڈ:ޅdr%#eE.T8m+18`gKd_vkz5m"'x⎉bҨw >wbsIҼ03 n\3qJ+Ǧ_A.'|?Aċ/ؙy m$ 6ݫy#nڜo1EbaZӟ8կ"/v13(ʿKH 3y6=B_s߄*( G0 gnD|<J52o1 Qo%w r5Pm*sh Iظ+fQ`ٴ!CzDvAM'./+ Cg6+&';?絸}FF~<~_X,Q`HZzijR(|rmY|k1"w޺1gjf76Mp(g9Q^^pC9q=%lĤ$KGAB:s'6:@$t#v\C1#4,Aq_Wu\ۋWm&l+A_|/>YJ-%ϖŇK ӥ|K z}d[,O3}!SpσbGm٩G勏c'v|TS}'|:.2|蔀KvS.}JإO )a>%KإO )a>%ҧ]KvS.}JإO )a>%ҧ]p vS.}JإO )a>}JKvᖰjޞnƾf.f^~#LǧiWN~pWf~p%W~~p?4L?Euq_ǃ;_q?_3_lE}GFW~>ܹFr~p}? B *߀ 7B *俇 7B *߀ 7B *߀ 7B *߀ B{*߀ 7B *߀ B M8']==ݽ]~]s$|=i~M[憊ۍl?ډJ^#1D]I90"UN₮v3}D{c"iUbI8U󾵯Z,8x\Xѝ#F^]T-JUk>˅t@AdBj1=ZTEd~Wd%&ߛLw~E_ YykN͕ic쀘GQ}wp%8p:M%Ƶ{N6JRwFRWP>Y&./&S1y (j@iMin"rHVG4W͈v&y"^4cvbax9#QEά T:^2U\ M\YN$-wX(<|`㿋9!w|Qwrc,g+Z2VQTtm{CLr64GeLbsL/7zIx@͸B|^)7F!OE)vH#>șCS=K*Rnoy,!/3M@KQ)bB"cZ&J]3[⛨Tl$}[z;v}g/H\ߠzs"/vj[1*VF?9}J J8N$onKpg{ efP$mg1ヽUVBy+ #3JBgklwoD"P:ĬA[mL vSgS^"d.IoҼvrٙx3-)~~YDN1v#poÊQN${H܂5Zc$QӏTGAL:o,ڏbC(vԡ9n#!9ehL&Hyփ(f(T>3(~_9CuݳX8hQw &!%ɞ'kY) (w/ QfuZ4m8t9yT LAcW@OnMD/T#>e͈ kJěZuzJIT}\zOYGA"$-$"W\x5wAǝD7M#̈+'NwXWȐ|^1e1:s3P1Mw^4[/M$r_޿E߄Fp2!>XHHRE( K=LdOn8DďZ^.(޾ơaTQ3~:Cs!^e|";k"3gnGMu8<tIHV ) I+~xO\ubsVvK (OXtf `_P\h3cPw啧i+7 C?xlΟ+lޡ;&(lzlP-lU|wuQOЫѓζOO$EZ-d\"^OUG~W~ EOYC\6(^f?u+#aQm壕zt7 P9ѵgG,&&URB՚wb6O\&WUmAIg:k#ԈOأrʄGWn*Mrl3z p5wQuiT:fQćϹ8=G2vdJ%zڹ[}ďDجyD-,{NMkA/GESdQNgF#2 .rܐ"*/д9Bo7KԬA!e|BN< QXtRd3 휻1O8}?PW셗s$ "MZq#k:^$" {sućR'/%^QGctDAID᧏>['o>\x{k_+7U`y e{=PJ%E~:KerFkk#^H=яb k䈄{.U#=O? (lHYkqSD^VMߎāO/._۱ U)vNR#2rbîp7H o]|;|"knO[Os0t$~AJDҥgXFX^=9?zx642extݳW1f(zؓxNd&ʤ ];7і^IhD}>ܛۂO9:EgSZ;גHNV8=fC|]K$FmUk20SY;>TRKѻaL;zP4FQq+1~ag5t]Յ({@)= ESm*Tz|jGZT|O m"EBMgurso%)7O-!^^]j׌)k>Jd 8p"Um>x7qWK΢9olgWRPdRn"-z+Pa` 4$_VEMǿH5/b¬d=DN͂I]Qލ!2裙Q~Ép[壩Ы{9 LPΠ{Lz(`;QA.^6=bǁD|i#ȝ5ώjw/k "VĻƀ1'#ZG;3s:6IV&tMW.b<`VҶ57t_Dg:~GKOt]Bi/\-BUG/ $-#R4tTt%XF gJ&2]D'* xBZ+b=h"2"у/2Gwt I #|;Z7vQÈSIt @'~"'iLJ\(O7mE0s'tBS'JNEtmـ(okPBV\7AD*⾟HV\HV8xX8?Ƅ}<;aMm( ]*?#(݅U!浆3(1Hd}s5f>Cs"xHMj$b$,G7E/ |:28b/ZQN܎bfr0Dҋ|z{xƯ (FtY TpϾaQ8bdJe[ddK^-`GÕ?W#\٧mGLjucW夦3 iM:w6̼s }EtqћK}u+D#U'%*cD_gڈ7ޓJJ~#cT:6' 7gC%*۝bN׃ V"^[=͋D\ٛ>a?[;'\J_S\s(.:sD°c.~ÊODag/@_$ o"O1&zitdi$FNɻv1'DEbyDyɴ(+WtM3tr"Ϲɱu8Aqs'THiZ4J[t'=jFJnYGYaЩhWdzYe!9 ƨ&`4B_؂8c9*(IB#PBeҳۗuN4"f{sۉ믋N{Gm"7VeQ |$XʳD׸%/y$Rx4țݒXCAd:>8~͋3 7$E:?2A?| Odn^u]7~zfVkP+u>@66.A|6L-ߊMQcQc_E_ITxpet# z u8Od\OKvAļNt̏oTGDqty I{W&%!KSG %/F{|A_w'lƜQD%W_~P w~=!/4o}}:?| /y:al Ϝԏ` & #4ٶ6iDn*P37"XRTOd R̙E|*ʛ7̙޶(P o)f\lTFZJvn=o;z2E3D)p@r|^a_; Ay:^&WlFETz wS|d+Q~ҸYDpO|f~"$uG){6ڛsDN}~+4~$ռx^\GQfvZjp9J;1=fE} *t籤!*M, ˿L>*'%=/@wm())`/o׼֊;UiL' )O|Gl0t mDWN 0:Rg)eۉ/ҴWEKF,R5?FUoIsM.&r&疡ě?ҮvAtٵJw;/otŗț-'"W^Mb'ul}'MHn@#kOk8^ tPlW/E_-yFd,ʼgMGDYPq@ӲPl5e鱽Tg9OPޯ1ƵUG<>>ҼC*?߾ع4FaJПH;?Jʧ)(=7chѫu#; iUa(Tj|!)ME~z}У-;'d/gu&:jK%C~V5Dc"o_O &"v$.Aڧ9xnwD*'" t<%7wg\/V@N7s(Q0벚|"3dk m`Iu(C2k㡭Pݢ%)zC*Rv* JMߛJilH1S%^w1A&r־[Zg ]-ބP J]Vas40*۰}T<5# {gS!< ;vv$"}кl2/1YKQyޒDGףϏǭCw~D"}AWLb$—7DYfWԗF*SnR-Qc~ >\1O $翫%|PTM| MMKU]#);OMb~ߖJ/P"jTjxɫ1(3jA|h9E2*1|zlЉ+&ɵ/%9rBOP&y>@׺=L| =c1D.`: ?K=H}U`Ro{+V@)=%'/J$e5ѹMKVAaBn줒FDXqŎ[uDJiC_{(?R#-">di*h̙56Wș_>LG$nK L.|'!f\ >^y{rEO@u7L374OM%JUlvW/qSkkqSH:JZ|zi3j(a[VxpqOV̀nּ]&`JZyT ̮UV5h'N:F2(y:VRӈ.gdž1$L5S[tOeE jj0y)ـ8l17Q㪈b ?3H=@ө^J=UqidR4p2ɤ'LŁI{ŁI{ŁI{ŁI{ŁI{ŁIN&e'!LN&N&N&N&N&N&N&N&N&N&N&N&N&N&N&N&N&N&N&'!LN&N&'ɤG[v`xGBV'`5/=6#Ŗκ-PCj%YeGAE7i3V|E6xf?ѬBAoojGr7@΍FudvvB’Q8LQ0y>=tJ_TʫgU,RNCP6,)*X@ܫGj#ϛtd-4Z苏 tPJ ~0ǍAF| :d  e烎ܳY@;SWSG ݰՖ@'$0넍f`nsҺ0^i8]̕wxt>Q-sA' tR/5tVL8މXM<R c !?0؎}gh_"+7 _V<ՋN Y료fckm"jF2pP;"T KT. a ꞹ}k:t}i gOFv5ãvC:_oϛsu͍~ڋ e~8ϧ 8rsThNy.8&tnm}{dSK}WNZf 2nll~u@Փx+Aiӝ{W`a堚=3`z_oʠ:qCE`.2lmc؁ڎv`01̇}' tޫ:8$ Fy V&ҁwK rEfj\g4s4ׂ|6z{('1]ʼn' pA-Qǁ3b}Q[FbTw-n7>Fv">,z{܎gɁŸ9NNy˸Xu4R-{ 7Ã4?vcX&y烛$}ɠ~IbЛQAHiy-t^}9~䦌!Efyro:sL!* tlʰ| oٖ(H;ED'RAWP8n ?-IAuvN X7,z뽝`Vq8;}.!u7iݙO&I#[,"lg]a0%~ jYM3F!+0uDNp0IU'VfKBƃ6s-u')AL+~> H r?7)0XDA{\**J?@龍bł`4&,4I{iRbj:pPa 0DE7YBb cn  T~'908P%XЎMk] &}w,Ν:iHh'~T7j#r] 5oCn5!ck@d /k}BY֥,1g(}P#b㠮}5`m5>}l !.h J :dI݇@Zlj7~1}]|y`i)] Kܹ$ optK873-2DUmt%[]@wB9{@mO;''+5 jLF2yMٲ 0r\xm]w1:lZHxEڅ3uh"=[rݵJPU#:_M6|c#Ց; YvbqwB~ atCs4T35|gRzq9 :U0-ߞZ:8^[/BW΅##MOÊvT+ASAըӺѠ={ |3T *ssMXĺ3##z>,Ń=`]e`B 1  C8 t$tH|2|0碹Aitq0;f"Ϸ)iV-9 Ovߞ:sd ]GAvet>&m,@wW}PFAaP?Tb XHdxbjڋx9jsɻ_VcfHi\HԼ?NCO`NPu!ƨu6 9<'~̼ !rAaVǷ}ՠy;-zޝ /jxQQ1=}м]jJێdS0L:ZF@qt Po*ݨ5$ LǢն5@F$L!Zw\lnZn|J?WCjZ=M9S" wށ`r&8$+2Q'5>s]~d8@?]Yz[͡ J6kH~X?F-zHJlRd- qz |硦K68WJ5-9=LIqG>Ʃ&D /}BS m=Adz+Lޱ#k2mXy.V~ӝ@ve¾pޝF`zZ.|Q1>nB0 i1XhҺX:ɓkAoOfQYPȞ}hf(ڝ צkPP8c+XG=}k:0,ih>#' CǟYfy̔q0(vΠA|am pj0(o ʫiYۀa~`'@ zP %:aȄkEߔzFDr&|a)U:b$jtX*^ #T/Ė9bd 4EJ0(b]> >ɆS(+?^Pr-t5mf`=w{|G :$(;<3sK@cǑ$qpxzP|xH0|X{wO~/yr]o,&gYԃVeP"qys(n r & ;%4rܻ }~e˳2yoWfhAlņh7:WoNj9>)@vxsZm=ht|w_ŗ;+=/'2].} ;v[͟AcKR}buhgaq[*fKcv#f9;eaȲඅn9Z_no<ڑ5 O̱ЛloJΒOݻc2jItyQ(ֶߏ:ޝu*/nB/:{$GZ)rӚ*#6\}O@UY++g?MݐMڋA9EuB£ף g?&]EekrD8MwYz8Sӷ7 RRc:R%OM k O-:dTơ9 c ՟_lo' W' o]㛃𒃒E0CVHAd=r`*-ikr& 臙ɦ ըmͧ@!wG\=]Yuhܼ{48||O'7aMv+!D`fPas K"_9NU]HCփ&M(!G[-@3p5fܺX!Ǐ s;t` 'k$x z0HZyIJ_/( iB/= EKPӭj#P=]e6xV;(4(V2vzT~7P0`/&< iʁ^A-H,p x,c% ڢ8~|W Jڿִ#oCk]vKRy{;{; Vsw5 j0Ex'6]~Y/_t, =qtG 94d};TX);'t1o&wEG|B\<1#̯nj1[:f°ḫy0ʩE$>|D]e'? ϭ{ JgҶ\ R[&_˷lb8r#tfqv5h <8tSP #k)D'vy -ZT$["E9PꙪˠlǓ@JjdP+'d9A4Bo7VWC/SA=H%bp,=Q4 s]P2Fgmf: ة ?Lz5_|K2|<LG>#ˍ=Bb76ꑎi˴\}AP0P)CU|9 ^ A^:oDj1($4 Mz<7εE !*5`c7oqL}|Ȼzio |V?^ {1ݠhXey_$26'ja0kX7kFJ/ޚ IJkǓZr =s?nvdF=TJ[ [W^]TPM:0O9>Gu"HDOGuKٰ5.53J}ֳ `1,q].J_̾]*Oz)wE/,{@8bh> ].Aș3Ay+ax/Z 7 Wdы3ȸ 0Y5C -_a us$}솽CƂQL%,AeGz9fu>úx-l˕^|%>~X揲-_,lW/{ W" 'i-hGv*{ҡNKQcgSS,Ce:,cS= g0(fYv|֤Ɏ vgQdߕ~9WaݞղǡgG 㳯Z?H~ddAmJ|?"%EY Re<>)쵞ǫ`9cxGGWIGZg_/w/7exQrweVh_,_T /sw]Jf*!&ۃBb?{6In%ϡ'URscgW1ݽ1^$GsO&@z^,s4<+'dOu@@;bT+S'%2,{{9z-u]Kg'^&rEK3\%(=i5vav\bϣ%?CO8yɓ_>?o?Uޜx(<1B}p/Qc>FLjA>F?)tqw/wwg $ܺXƎC !Mؓ_ba}gծ~^k]j/cuiF{F˜==Kon$">^}އ>?Oլ駯?"2'5ON\D[U.?O=EGfp&tK]א~4.F;}l?=s&KV{i= g gLIj;0;LpY3a%]Mͤ>~f9&g/KU@} f;o%gYl^̄L=}LIwaQUBDr*E>.x4H5`Op5}׈kIN4qp֐dFm8K><˳bycH?눰*}i;u;j- l?} Glvuj #î~)'\OӘC4~CChX[W̗]IOѿ:ͪo*=u j2(ǻk;Y3%Oߋ3픜=}'}AquwrqY^.PƩ+>mOU-~* s? O"5[0yi2}G+odϐ}Ma^+{~kj&R,O݉D4י8[ϼ^9؏[o&ؑRoU+;IO]=},zʺ %Rǟa>7;ͣow{ xϜ!~1;Ϻw _WeIXsyV.'hqϻv'u9}-/!yyu.3V+d [yDu{_|!'}3~J{EfvǬ>q !/{o˫G69_s&jfm}Ѽm'1On?7c8/W'~KeyCgWx Lon?Kϝo`6i`msÞ!w~?Av?qg&Q?w$wf:ߗmO.M3@sgg`x_QYۇAP䊰 QjtVw^g -k:rTL7N2ɩn2sۨ~p uBwZ^eZVzfG?. Ruq[kPmوnf|rU.~~pڛnu\kWړro܊s7@ W-Zd#ސ>B=猁t}k.Xe|5FJ@tsbDf,/./<BjeM`NĤ  nCp t=|KfO>WSG%Gc'ۃPoGG}~޽7oE磮 7yLbwr9.Z%[DK.>{4wg cMQw]ޡea72U 5DM uQBI| g"#O?AGԭ\?FL FsNϙIZwi1 4O3~͡CkFQ[!!yujVO ו> D 7ӲO,G͟ԝ$E Xz8= mQǫ#rQI >)YԼ`47d?[^wyDWDSǖmcQՁ5Cyݛ!{[dneTw)5.aܔèÆ.>D6Nm_Bo`[8qKO42C%·&qFsg&>[sgcmGcNa} Kwm}K$v}|^{׭@-Mv߯AɒsQ7'}eN~wfcDn5FݝBnb:{T/bbkVSь*@dyR H77[YDZ@ d} L (>'uO5;Dh΍樥n,|2vAj|meC%jϏXn,XlQ51E&:2'u} `0x⥇i9gd, 4݊>׬3`qK6փ__<3Em㟉jWGf^R}uC&(5׎< iJg{P{;m桪nB>fqu|EMkSZm5#UMnnB_{TZ,qއ;}ڡ[_N?BdfF!ф;+ꢊFAYeӖc#nAk nnCivk@߇rIը4(nx6?m"m p_Y!laGno\ fGx1W|Vӡ |s#-R[O k*>s+h*Giw_iX|`qkkq%pyr>jUy~TV^ǔq*SyRƨ!:Ep&3vPu>`0oߞ:C98^?W'nߊZ IC'G%9#ֽaIтG@pᐥ$MG|@heCHdqkjbqbga LSD\AG}eV' W6{u1e--fj[<H Fկ΋@z7 \+7zR^B}xCP15Q:#Qq}"DVY&A_/ C]^c?Fʼ'8mOJ<|:-Ca-F̜mGALVCgλ BVm)S Ѱ> 4MvC*A6A~ňw5Qdce#S}^i?lBnkaMd{',H-*+;A@뒆M@*C g|*e;Ƹ[_±CAD$ǃȄiIAѬvक臺=jaÛ^MB˿}< |珜:5J$w86Ie j"oPQoEkJ<^Rj˗Y cv+n-j/y|">j_s'luj u.A }G Bmg=]*ԼҿFfjßzU+\9$`1*?xM|`spbT^:3^-{N&Nuu_$jZliN?\sAhen<ݛia쥥,PIC<ܠ&T#wNu }ھl T7d:̓#QskڱcPME[UY:d*^6xoѵEM3šڣRkm QٛWo@WU I3Uq2K:ݳ+fZn^&5NܼZu5?eh vM:"c ,W7<ݏ]>oAPAPSИ 7k;Q륗uόP{it4 >:I5|-xW55\䚉WwjU@]Q*&QKB}3) Z<4n͌Bm߿;?RT P\P}r Ԓ$ Uyj59R">2ojSv>* t>EIB-%QPçT6™;Wۢ$Qw$ЏS;*{) _2Au_A5dAū3G_T· ^@bGQ)CQy;ŪQ>kgQǧF)[P.ҖKj9sFtxmC$agy 򹠶!Ed?w#2_] 1JC_7O?5_sԦHj}"Hxb:=:BVԶM!P[u_Y[ǁ$R '~d};g?*$ /R_7)ļsWI6UY'zC f軁n ADO\U1[]AvQ{a[Q{vN#uhkxH6bGZgM _P=)ON@mG)cρDS dp}g. .(y ИK'_ArUc@D^î1cɏӆՠ1ro*K^G?'ɾ8G|V 5+gݰޫ ֽh~nW4&):45(B2A @sgk DG q,hzյbَ#Z!'FW5ݳ*u/Ң_Cw[BunΑmCܼ@j Ha6V 9_e?>bhQYP1bN.I gԨӬz>þ_evzj ۺe=CmP]MvPAcW5TJS:֦/FFͯ:fXQ@Xܱ9PbhGxVyQYMsPqPchvUEr|$ abO6Ɵ j_@d"V +eB-]Gu}g>hYgv=X+?fɚ1HբCMWC>_\M>U`E6z /}gzИǕ;lAıcR~rWB55?\Q |*W8W SҟWL}7:fd\Bb R0> c1H.Vu6ÞgdW:@vȒQGG;bcbATT">mZ0,I>ZɟjE1T4(RtmT.d{zzAZӂ?z9|&~Bgu'ћP:P&/G"PQߗCQRyC͋ݧ/>1DoK^V\nNX}|*L>m;k|?Fm;Q_ {&(+D7n@Gm.Ai!g}Okû|ЗSmVfcuig[jus7^y'mjFی3~T.K>eow5/.֫+>R>u*"3ȟ;6:Gm[$˚ׄ(߷5Osp\fl~Y4Ǥauв $S81HehJkbeA|̺ }g~lNj4HM*ֺॺ ˑ7EB`ґiJ]3ģg͹v8 +GkqGmV٨GC%dt2j:Cd#;?շmY˚RYV'Qj5I7ߔZcjNwl^ #l7Q1(fjM䧳qͷɨ=;QQ7PeEfݨaҳDecAd(>sDv,U ژRyRћ1 (睁dA.jH,1>շb|ix5:L.tbZԑ\{45Stj 7]n'pm`T+{uRȒGݮ臂B2 3FǭH'fH(EkS)3@  B_ԨZQZPh$-y_^#jPL[fsT/ZZ/tUT4i}<<ܙ4տLK Ξ䇺#aX1Q}ʯՈq>Q]46gCѼeɠA,YaV6l\"$A吵Pi#n6Qu7`F" uok^K ҤҮ˾%c~gm^23Zl8nZjQϐsE br›o 0F< B~ɓ^I6P+Wֱ֥ ;n@.ʔkQ ۾vZ|OoAmgCAz' vGm6wQ}ۺǕY+T܄w/䅚ОRIB{P[OWy\O5GҎ'OkLQOj2s/%αRz }]Z` 9ijH]kb tNF]ú^_[ilJ+M]yjAHu v mu}.p(ʆ^|Ƿu +}^O>V oZٝ&jAבs>7JtosF9RM{@d: .w u7,yԶ0] n%:.MJMŚGNn^ A[@G"V1?tvGo4|uX76j:^8_OOU,)ҡ@'P!QY-[4Phn!~l9x=l-=~$jb7,Nrj, "!G(}fz͏7[x9Dg~}5\Zm\_OF?VM*?u&0NIoqM}npZL^8s[*{qdr[]Y5tVa^Xf- w,? *v.I[@/A%33umPha\f-e *}|+W<rn4; K,3`j:\Wĉgr܆ɋAtyS P^=C<grRgiNTy l^%.W=PxޔŠ#;Ho#bJc%؋l@ {X{gmP Spx9 > kɗCИ h(?tr\ډe?RXf:!A7g_'l4#uӗ֕aJ+`cc v/n : @}Yeǯb@N8`دo:@Rp>VNAFAv=;@$_AͽH|f2XTP^\vjZe45[+mU5iφ݉ n˺Πti aP̭u[09sN{9}41-+U" .Phzu}ܘx'son>=^/y>۝BsAvsa6IלJй1n0ȦvrV@d؆#X;~mDI'+Au=@iӝ{aa堚=`z_oʠ:qCE`.2lmc؃ڎv0g0hwYP] :]U Ă+ tH L+f:ܐ S cނȭMk.>1F@lԽ ~iŶ4qg]'4j 1)u AEIq1j QڻGU&)BH#(jxa5 }׃FƝ]Y`Cqř@e9P6\f0֢<(4Uش" 3&r- K.ʽ٨G7 Cwt툍H4owW*&T[+ rK_G<%ryytdjкrۼ/M> S#h`i1)EO r֎QrA+.L 3!wo% HAk$X( LQ_e@`)EP{W㮷RgLg!ߍ.A廬0Ojp|jhU]R2ǚƃP@ U̮e&:'|[@p'W ʩLJ?S³d@ㆀxpP|rb+)2}H~(* ҭsJsRza্?^F<{d,9A쁢ͽsT)HTu3.V}6C^)IC2Q#S@|Nb ǟ /[Oᶳ[Ig>.ŨZ>n} Dv}X8ϒqsf:: -b>[`0JYthI/d h ۍ[2q<% %=&w-:ެ@Nk'˹ 7eLޗ (bl5c<ȓ& ~+ԙfB QcS ؁e[<8?v? N^_He<7G8Ȩ_wtV]v-0iI juźa[߇RwyM0Fܝd h.4 :)1R*R9 y֕xPRѱƸ4c4#_aK|@'8PDP$ }Z˪+3ZA%!@BÖu')AL+~> H r?7)0XDA{\**J?@龍fb`4F,4I{iRbj:3n `|ߋo峄D2$ݘ V T~'908P%XЎMk]&}w,Ν:iHh'(~WI5Lwznې[a/PG/Ī>@~ u) lJi0HFX8k(s Xu lm2ڧ:;YtAZ;$ <}(Nv-7uɊ](y`.qK | Xx=g\¹@|mY 2lC-(zjӞ~ځ<@_ɆsA[y1Y:rGe(|,]v߯!A0.quu"Bj&ơZ*z^@Z/n7G~;l5.Z&?= tqL ^D }GFŇwT+FS@Pu#v ^`.RUϱYH/7]ugf^GF&m,@wW};PFAaP?Tb XHdxbjڋڀKsS@`'{XY=!ɨ; (x>pu~9]3>i57+s,5ޏ_&gUWβMZNR;z= rD0Ybx܊":n^9 ut#Ncd-QؑhǫЏhiC91NtBRTfw[Ԩuơ"EgAviJeTkl| x/j C&E%E㎃̭+ow2`vnHŚF,ڵg'y|#s2 0W2i} LP"?YbZgs̓|.7wA1qb].:4oǣeTOлsPE /*Բ<gS {ٕqA# 0Qx`ǤLPz\;@YtT,L3 52"g Ժtbsku SPCi7ЏTחc41ơ&]:`Aӡ ucݕ%%i:oA1j@j4&EVnВ~ :nq.jtn;Ԟ52x"RJi:-g.SRܟt@qHP-޾4zz5H W8FTc3Gdk3o iG X[^}ȮL7uZ<߻ LoT_iqo/vQ![ =\gvј\t5c~:PWq{ ht`Y|LGOFDr 0*}P 1tw#|5:,? \Eޛ@' `aB2IePA.Cj}@\pC} ĝM TPEqAYdt$g89ܚ:Un^S=̟}T~t]_9[κ|3q\-rܡ#w)w?x֏>082_nefy3^:ޫ?WNϝcw+}ro~g=.xmy+_nz+c!r)kg\ϛ/{pw=G6)7oW?]{>rK~v{?WzK_27{oۏlyܾc{~ŗ?og\P>.o}g=/-W{x[7ߴr g2{__O91=ys+;w{ 'b9S:r;=)Տ=sd9#Ǖ<銟u'p}E{//+=W'S g[8\Ӟrܻ_>'}[>vetgy IeK}Ĕ[ʉm閯;Ϟzo^N՗-.wP9yfr̾kr&S~u[?|G+7˷Yi>csv5w'>rk~l ŭ-r>w,IK_;Xurƃ=xyZeZߌKqCN;;._l唝krw|v[9~7]# >ʍ?tM}^nTN8wʍλsNݢ/=cCk_^ۙ7#=y5{}qͯ;uflVN~K7=5_]|K17^uAŌğ%_~e_(=o/|簧Ƕ)o]Gg_('mq'~ߓ?so[~ Q9r~O=ZN\Y}}O.zgr̳ﹳ۟)2N]wݷ=Nޣ\_~WUns_vOi)]WnrW˵=>Z^߸:'.(z/lrל,7=buC?UN=;wڿsf|N~o|}WuMٷ\LoVyvz޿\_:c1K>^r wG珘k>Uyn.߯3O}=W{8w )7soreƛeS{+7=O9 Np,7O/|rj߽r5z7_evIy[9?oVnԏ6SƯ1~}}9Ɵ)~|r9.wYp9O߾UCǟݼч?/Y﾿/߳prg;t\_N~y?_9u+~GO>pcOYw_5;rݙ'_N~~ xodwOv䈾ߺh^sC~5k}ϿM׳}`~Yr\ԇx__墲{ĽZm]Yއ畓w﷗;#bf9LJtɣӿ0GssV;3\k\m{Ͻr]=.w|Un߸ mگo)}5~swس.YGt^sʹOuowCvVߚ֝Wnf6%B[gY9o6]G>exE9w]N{v[Z\n}lk-+{W}<'EF?w|b5+r'ov_o>zA}~`r}ڟ[ΙsyW=~_wR9.>co73]nx_r1+ǟס_>嬋{ڭ'nWުoou9U?tޚ÷?;i|9浿ɷ^nImtI)Wc}켲|zrglr۟}ƃo,73sq9?&זc]SOr¸Y}dv_<ݶ_{~^v/}}Vg]2n3~/_R3]9]|ᛨNͫ^}2}WݲI977}>_N[\ZiюＶr]~ݝ,w_GzaG[\_ueqqe]yO(] r#+w[_yʩY߰_\Ynp_sN+gcopr5svXo<wΧ.竮(>_1;_{ڙc[n9۝yr\{o엟|5솻z ; ]rLcy?o75뽿yUL?ێ+5fy4^uݮ9Sv,>ow&匳v>7o_ozM8}>|%޹-.[n]]1n~ҷ.\Wl_hM' _=|5gzVϻ'k镟*'m7{Nu5~o}y~51NyDžw-}#GO:hrg^zWvm[뎗|v._t=s&~E?+*K?2H'>[iϽ%w]s֢pٔ-\6MeSpٔlM\6e&.2pM˦ eSeS7qٔ7qٔM\6e&.2pM˦ eSn)7qٔlM\6e&.2pM˦ eSn)7qٔlM\6e&.M7qٔ7qٔM\6&.o)7[}ٔK=ԵXXXXXXXXXXXXXXXXXXXXXXXXXXX,.]ҼK%t .]2x.K ĥKn%7q钁ttI&.]&.]ҸK ĥKn%7q钁tM\d&.]2p.K ĥKn%7q钁tM\d&.]2p.K ĥKo%&.]&.]ҸKĥKM\df/]ҵl/cRnѵrۆ۰viY koݰհS{e[a?lѰ^8ߪay~۬<fnMjXmg}9 ;yzf Yσ8g:qy~4I+Әw1˟q=LOg8<4jnSr{sYl~?_OǍӜ߿<͸ݬݿ:o֟|z%u1~|e=.}۰qB4q/g^}8ϻyyذ먋c:}Iv~|_^{XNz?Nqۙ|^~غNwfwkX?_o݅p+e|;?_cg5Q9|ݽC>WMe>+'_Ei=9Sxnc!C~[1u;YoV$6Ǜ,b=,``n7 WYa_z<}y?~kg|;]7KyTCU?yZ!bYG_yq}>iX}fHy ~l֏.rOaȷa>?NhRgsE+[{|~ܣag5^=̲!GsXv?]+[~jj7Gk/鬽Ds^ߩa?{~?׵_^'~#v.w~}z߷qais>|֏?DŽːד/Ǥ|{x6?K'vw COxnwފ.}^!uɿecy#}r#l埧X???]ظG9g}ܩ??c/.?|iyqy0_eKy}Ͽf? i>u [x= W?!ߏBz{6y װ{FC7!O.W?':χt>߿}n .cҼ˘2& .c2x1˘ eLn2&7q򛸌I&.c&.cҸ˘ eLn2&7qM\d&.c2p1˘ eLn2&7qM\d&.c2p1˘ eLo2&&.c&.cҸ˘eLM\df/cf˘]Ukƶ m:yFi| M67mo ߴAi| M67m/HN{o ߴAi| M67mo ߴAi| M RӞg67mo ߴAi| M67mo ߴAi| M67mo ߴAi| M67mo ߴA E:yFi| M67mo ߴAi| M67m/HN{o ߴAi| M67mo ߴAi| M RӞg67mo ߴAi| M67mo ߴAi| M67mo ߴAi| M67mo ߴA E:yFi| M67mo ߴAi| M67m/HN{o ߴAi| M67mo ߴAi| M RӞg67mo ߴAi| M67mo ߴAi| M67mo ߴAi| M67mo ߴA E:yFi| M67mo ߴAi| M67m/HN{o ߴAi| M67mo ߴAi| M RӞg67mo ߴAi| M67mo ߴAi| M67mo ߴAi| M67mo ߴA E:yFi| M67mo ߴAi| M67m/HN{o ߴAi| M67mo ߴAi| M RӞg67mo ߴAi| M67mo ߴAi| M67mo ߴAi| M67mo ߴA E:yFi| M67mo ߴAi| M67m/HN{o ߴAi| M67mo ߴAi| M RӞg67mo ߴAi| M67mo ߴAi| M67mo ߴAi| M67mo ߴA E:yFi| M67mo ߴAi| M67m/HN{o ߴAi| M67mo ߴAi| M RӞg67mo ߴAi| M67mo ߴAi| M67mo ߴAi| M67mo ߴA E:yFi| M67mo ߴAi| M67m/H owۭVŕKxUOyfR_duhڹ.K:xh\ %YmZQMy\E~Qjָx)6D꺨cufRN:^#.q̗~WZ)4u[_oIѵZ)4uOG#U] _TR|i~x)6O/Y:BKyx~QZ:^ͣjֺR:^cewEV'o/U_o*E5+œ淎iXyլuxtQi4uOOtQ:XƓ|o%]Ժ>.t=yb颮ﭦZi^7Ef颮ﭦJquOtQz8Z|kR@MvE]E_+ők|k<׬O5GƏMꢮYH#[}hW]U5?Jqup:U@m\E_3)nj5Eh{ጾJEyKk)UuvhNE%[tёUtQxoW|lM[G}Qxkպ3@+ő~_:Z{i.[O}Qxm}FuQW׬4^}QxkZ?Yiڵ~V_xE㹯kfZs_kY}J֮s]4tN}Q-65kֺ>N}Q-65kֺ>N}Q-65kֺ>N}Q-65kֺ>N}Q-6O[u};E&.*V+ő!Go'Vk]_]Q-o5o#~W#.*V+ő-}Q-݉Jqux+6~]\Ej8:~_o1ZG]4mb[G[~QQ~josp连P]UV#:EhTEѷZ)4u_dR<߮颡$+淎vM %Yi4uϷC]WѷZ mvi]te\Ej8:B5]44>_f8:B5]44>_f8:Bۡ[GZ4^ۡ[GZpCMoRiR^V1of/Y-Cr)w-ؽ˾v؇]}?~nv侫.i [wsw|lweO=w}KWܶNEmM[?ξ__oMs_te]onws߽~mｻWW{ nU^VWH6뗏"4S>n|mcߟwm,B>n}"4mc.붱?uXsm,B||6-1ҎZuVc+z#)D^Hk:F _1R7[ujȶ[^HuVczR1Rxݬ)=WL]Ïec)||ޯ"4W벱ׯcuX}:^Eh|ߟk"4ϻec/ececk"4?9^Eh|s.X{]6UCMi]4m tѴ]5ױm]4m tzm,}ym$]4yXh,BtXc颱Ec"4>KEh|?.,]4yXh,BtX 7>tѴ.6Eh@MuQغh]4mM袮ac颱nuQXDcwuX_.Ec~ݺh,Bޯ[Eh|u뢱{n]4y׭"4>uX_.CMi]4m tѴIUuKmW tѴI]u֭ƢNEc~Dc_>KEh|1[.c.]4yl]h,BٺtXu颱;fEcw֥"4>KE񡋦 tѴ.6Ehڤ:n]݁.6E&U] .]4uOMum]h,BٺtXuEh|U;Dvh,BNEcw.puX`"4>;\]4y'ꢱ;WEEh@Mi]4mREs[.:Z.6E&5])vh,bOEupuX`"4>;\]4y'Eh|wmU]4yتh,BNUuXbꢱ;VEcw"4>[UEEh@Mi]4mF._EGEhڤ:"vѮ:lU]4yتh,BNUuXbꢱ;V'!h,BhCuXцꢱ; EcwF"4>6TEi]4m tѴ.6Uu٪hh@MѮ@"v|hEk6TEh|m.3P]4ygh,BhCuXцEh!V]4yhh,B.ZuX]ꢱ@kEc;>h@Mi]4mhE[m.:ځ.6Efꢮꢱ3tQ'VkEcw֪"4>UEh|Z. V]4yhh,B.Z"4_C_o5]4yWjh,BtX]E颱_h@Mi]4mhEZ. Ehڌ6] jh,bǗ-P颱VEcw"4>*ZMEh|U.h5]4yWjh,B"4~m!.tX0"v| i]4m tѴ.6:j5]45 tѴ-Jh,bhw] ~U+颱aZIEh| Jh,BnVEcwô.tX0"4>i%]4y7L+Eh_C_o.r]4[.6Eh@MiӮZIMi]4m]u5["v|+:h,B&uX]M뢱,Ecw5Y"4>j\Eh|d.r]4yWh,B&"4~4[o`Ʃ=Fi]4m tѴ.6:r]4u tѴiW]EO©=FvEeUקj{eqjUw5[}n8Ǫ:pYfc]?,3NfueqjUw5[.ˌS{z])pYfc]g2j^' \XuWDeƩ=V&ȷ] ]4m tѴ.6EӦ]tQ'u[97|i]4mMum,]ԩ=ZCN붱tQXuEc]$KujUwl,]ԩ=VEtQXuEc]$KujUwl,]ԩ=VEtQXuEc]$KujUwl}N2#6w.6Eh@M#Xh@M袭EuQh.n[CHS.wn]"YOݺ(EuQ?d=u<~hzEy.ԭ]$[CHS.wn]"YOݺ(nz~pi]4m tѴi.?@Mi]tdq-.]TnJu_ԥJ]$˩K[HS.*ŷw,.]To"YN]EtQ)d9uR|krE.ԥJ]$˩K[HS.*ŷw,.]TnZiZOe!h@Mi]4.NcYtѴ.6EGJ W#:J Wk]$+1\]TwpuQ-EEZJ Wk]$+1\]TwpuQ-EEZJ Wk]$+1\]TwpuQ-EEtѴ}->=Eh@MEDzEh@l5HNUuQk|d5RjTE.ըZK]$QUƗHV.j/wFU]_"Y5EUuQk|d5RjTE.ըZEύC~pi]4m֋XVh@MqpP]44~[u_]$k%T HJ.wP]44>"Y+hh|EVBudꢡyZ EC.]$k%T HJ.wP]44~]4mM}m}z tѴ:e@Mi]^\dU݈:ۆbEC. Ū]$U H6.wl(V]44>"Phh|EXudCꢡyɆbEC. Ū]$U H6.Z5~]4m [m}z t? h@M"۪hpuNUtd颡yVEEC.]$[M H*.wlU4]44>"٪hhh|EUtd颡yVEEC.7~]4m tѴ{h~piS.? tѴ.6ElݨKu_..wptd]$;\$]44>""颡yI HvHhh|EEEC...wptd]$;\$]tѴ.6Eϭƨ>=Epi]4mVEuuѺEm뢡yEC. ]$[\ H..wl]p]44>"ٺhh|Euud뢡yEC. ]$[\;~]4m tѴ.6':_C_OU] ~,[Eh@ Eu?7ĊnTEm HndHn/y֍;-4>"ٺ]$[7dwlQB.}Qh|Eu HnEh@Mio#Pױ]d[7Eh@"Xh/m,8B}Qm,8B}Qm,8B}Qm,8B}Qm,8B}Qm,8B}Ԁ.6Eh@MiOt>r tѴ =6>>t ~6>Uu_oEmc[uQ'uXV] ~6>Uu_oEmc[uQ'uXV] ~6>Uu_oEmc[uQ'uXEh@Mi]4m0NcXX6w.6E_ƂLJ.2N붱5]wl,x|M]$ _EyƂtQE5]wl,x|M]$ _EyƂtQE5]wl,x|M]$ _EyƂLJ.6Eh@Mi]teDzsW&9]4mׯlc!Ň.:m,.H6R|I]$ )._EyB/颼dc!ŗtQEK("XH%]wl,.H6R|I]$ ).h@Mi]4m tDz#tѴ&}z"Xh;]u~BuQEs]wl,\]$ ->EyBuQEs]wl,\]$ ->EyBuQEs]wl,\]$ ->tѴ.6Eh@MNEE# tѴ&}zx.5~ꢎH6H6H6}wl,)"XX dca?.5H6."XXdca~]$ k|w"XXCMi]4m tѴT]Աvٶ ih}6Ŏɻ&?O:tBoh_}@{stt/oLdj.ZpIKn4YrA4oW4o{}@Ӽ}>6nK;ټAp{n9xkOgI >rz"|~>{}^?>XLSLkϺ^GgXWG3XܫQr Ρz<0IW?N*Jk8N*J~R5Tz '^IpR5Tz '^IpR5Tz '^IpRO*IpR5Tz '^IW?N*IpR?,p>?7{lav\δ]./zqa/e"܆ް(eOjX{c|f7촆4RN}55s3=jX6+ko\8~K yܶ`35ټ~=ݬ|3۲vkTXm8^#ß_ΐ׽qσwڱa}Qku8f뙿.x~?Ϸ3YDZu #?*7!;<1ϋ~]}?~r^Ϸ<V盿_{_ϟC+?sT{gyDZ}~^܌!3f?v>ױ0^3f5Lb|i, 6vqf~#!hyiGgK~yƷ5_/?پKϟwJ:Zw*sS;?d~叟a~>#M.l<뺇#>;]}Hl}qzqyrհyx0އxqbzuly򯫽|]nzwxxM<_~=yeo$_z?%Οg <ſ[}_7]B;5=lcyOov??=la\s>{x.ǟ~zzoƱǐodϭX;.r[åϕ+?:|>|{C}^ߡt<׳ 7?c;c|;?/|~?7fq>{)a?!.v VϿgozSSt>䟓?_H??3|{vO7`Zh~3ۥD_·Wwo Xz*iܯc,ѱ:+/kұkw g;^j ]ٹtO:W/cC:3ވГp޼-wL yWkἫpq-wλf ]yipZ8ow y'pމ-wR yoSZ8λA }Q ݰNkpލo16iwϧS )7{p6qS n)wZ+bp'J1WR n)wAfQ n(c.MysD1%";5Y kKyEǘc[t֢cZtѢckXE:-:mѱ^[tLh1EǤ[tߢcJ-:6h֢cؤ5h==F1/Y-c@fK-9d1 Zîvq5BThl[g阮l^~ߪSxC֍yDx<<w9tLאu߿Bۋ^s.-pV?%ǟr܂>;p{kۦFɍVl\up/]]6Ѯ1g\qF )woWfYOX`[-\0w3]Ҷműy;kIfy/-xngsiVWonooӸko cg>o)c`]i,]q N>y7]O8EKy {W {GIUn󓐿UY"[ascˮ!cao/Ct:6cӱ?f$Mb:vt̤c{:f1^:1yt@Gu9ջұ5p2ݓ؛}x ұR:^F}:xJ::?xj::^CkxH:@ME"::Db:LDZtx:ND:N-t}R:NT:JitNۺ:IǻxwϠ=tI{xEYtA:ΦCt7q.<:>BG|:>A'3t\@gv_b:HǗ_:L%t|5:N7&ߢR:.r:J:Mw?:K>?*:C:~DǏ ?:~FqqWt鸉 wtBǭtF鸝?qwqw':^:tO_+t<@?'Q:q:I:MStaCeNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wg,tP}TK ;Ωs;Ωs/YS;Ωs;Ωs;Ωs;Ωs;Ωs;Ωs;Ωs;JS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}T9wNS}TZB]Ѝ;%\A]P}TwA]??TwA]P}TN, 껠. 껠. 껠. 껠. 껠. 껠. 껠. bNA]P}TwA]P}TwA]P}ew_A]ltP}TwA]/rWC}ltP}TwA]P}TwA]P}TwA]P}TwA]P}TwA]P}TwA]P}TwA]P}_R}TwA]P}TwA]P}TwA]P}TwA]P}TwA]P}TwA]P}TwA]P}TwA]P}TwA]P}TwA]P}TwA`A]P}TwA]P}TwA]P}TwA]P}TwA]P}TwA]P}TwA]P}TwA]P{gd_k`&Mյ){б踚?tFgtFgtFgtFtNtNtNtNtAtAtAW/6߅s[;;ys͛w^ޝ6͙6g氹mSsؼa6۱9lYa;mag589lvS)vj>"Nd>=$/svQ> _?עKG/E'/k>E.:·[ģ>yQ[d }5SC.X{p O\tы.^tRr'p% )j6zCK\|) XK.:j ;eQ3WZʱ_}'-Yt|qG-:u +/4Wӿf.Z|̛k]%O\2sƵ:z_WHEKYt?c?E Bq 7ootkPE|5gϜ=sDK>gnm/tests/testthat/outputs/biplotModel.rds0000744000176200001440000005322113615564673020570 0ustar liggesusers=|E{KB'p vR6TAx$8H.x9B **|*b)"R"Y@~ ? "J3wmMr(efߛW͛;*L`ȿF_kH|(EN APfYIݝ.q1!JuVB&2dz"ฤP8j+qmyaBCaKv1ptUsp„M[m|ÌyǛ텖rjc  +4ЊG*6WI}mV{b>10񮨯%xbǠ|Kw*E o  D W|ˇ2Vꑲ}6` nQܐpTRĄH7/tuRh-qx-W&-29Ѫw"0R?gpEMvdrfY_F.o-omM әG_ >\R>_p0AC{9ۗ<^{drup/YO1ٹ Ц3Uɠ2LA*S2KkBKg y'dzA7d@/dAj{ ~Bpp8(`VhE R!cLd!LdA&29iBW0z%NV򥔽xZ^e\U֧\*ϙx.y.2y.y0q&ua:L\0q&#H:Ҹ4#H:Ҹ4#H:ҹt#H:ҹt#H:ҹt#:2 #:2 #:2L#:2L#:2L#:,#:,#:l#:l#:l#'EtyQ\  {UcB^W^@dIV&ٿsu]Ojۅ֝|D|}~`\R܄nϾunε{shnD̩XCrKz)?I/^#lZ.?S,>!xb=9q˾$sFe*kZ, OM^q}~ͭc~st#^[ M1w+JV{ge=Nz4tפ[ux Eґ/nSsډG[9jd;t,4m}D zqzV?$~i]+"?–;KZxK #?y$6Znḙ_??Y<_f]ZIGv}Q:>e&qųew'CO8ţKoq5jy͒iҩ=nm"n1/#ePQLxx[EF$.L,ϧOݲ1TӬkhx!;f'LߧagniG~Y*-wlOu[rҶe =SO|ۇϛ5\iJ?&rGw3v/I2;F5I7%Y4 N_exNvOx5ųcm Z^k'bʬ-jdbYg9=9-g_1>mtmw_"ōG쪸~-^-α힨{)MO)07tj+wY5VGU*n-tlq_ĝ΋NQĸE VmkEMoD|;M=y_Yr=EϿ7's횯ďDvLk?$>qՈ{vXvc~q{;.~Rl{CąV<I|#<.Y|7o ?Yq϶;ywc[ CۗA|=v]]\XGZ.~Q|οu7ܵ ;3Veݸ;n's [_hh?m}G;1aʇRb1g:n{P,OrybVn$E◭ g6&E<5َ˻zq;Mn'{^xq)?(R/noorDmѦmxt8VI18_i(.\l/27Zbn}=@XޤL`KN#[1÷BڇJJA~10B#?ȷ+o ̿B6⟶>P=A?i.o`SFĝ$ݣ݅ [F A,dw+{ Fo!$=0A )~ 7g9$=1"i?[3+j?}z"SYhDʧ?iP? Ky6bx 3A22X+$-f$mU#z88T̍I*AI+`r$~[2G:Io0|,T~Vo z5$c.>A:DOb0@&BF ]B퓍 w +TlDߊ7Ac" `v?߉  I%H:w#z+!)V?:v2w>S/)_Z/I: |E:~#lMaF?AaDo oGH:1B??mBؿSu}& H;!O?3z[F+_|_e@?wG)3~ n`k,S DWwš":iC Azk X~xbх#z~27 P(Dlj'Б1GHT?SˮX?o5:". h `GAh>[!168q kDD?$t t;(ۣRwT_o;FַwR|8lq= ~ _fҍffB%#zsa@}-HE]I#w eu}Tҍ Gz^ P,DgGKj>A{dBBBM#=d׿tdFtև>}A?u7(~{k3( :6v'i?m_Cҵ t1?P~?Hx|l(C~@+R>Z6>cӞ)&1|$Qgcy~?1Eǟ[H:-2#z+a1.0hDDo  z;DD NJo2Ig.A<T FR?ѣOnU 1ߑR)Ёt3|=a49CO~LN*ېP툿!`F}wTR~:Eҽ 3ɟE= A*&i?ȿGA?ߋ[  Ah$ݯ@{cA$=FAa~R0ot2|[}!:^%io 1W~B-`#:x'Hz=)$}E4OggHzA,F ?As$-R"ğ I:.ӏ_`xFO}+ tOh A^EfB/&5o  I+אhR A2+Ё9As0t A*Do O~o]Mw  Gג; 'ϷHڤFN vAדo@a~QA?oB|cOBg '#H)B9IzW MMBx@{ d[6ğ};O0?}D72c=A3|@I OHڥ@/g8FE%?߇_@ߏ{2/I"`~ɿJ~ @7f~B38%IPc~Q|Fw-QEtB@A{}Ox94DNh|@'4i@~BF tBڿN OaHC[ *> !B'7F @f2~ћ#zDo >7 z m=.Fc=CCt['9(WG)?7dՙ)D{=iK}Sd0_zҖ )7bڇGOZ߂cd'mW@;zmB ] _AwNbFߖ#~#%?ѣ=>!Hw$ ?#EbUAS)?7)2?ћ#}3÷Dilx'+Έ ԏD:'"BLB\?Y;JAПgp=d_BtNH>Y3|gA~7*N Ad-W#{?Q|A~? *%B|@P <@!$YAPDo \Fo pADo $R(AG#zs&1| >7_1/)7I  _g%i?ȟBL&$)l/"ɮmޜA_i4ES+}nU=3>A?OE $MSi?Z>C0}&;@~BsO(>A_ཾ:JNoNa$!o _O? 6D&i.7B?Bҟ .G3-t6yc "F M?CBo ~o!1(l{[!Lҫ Aj][B~UDc=ߤ_K}D Aқ A*(o"zq :#_o@ ~I#`fFde"Ծ `ޖAH1z&Ⱦ Ao'<ȃ}cvv3z6B<>["}1 E 3E I_(}!z;s /} dVYF6B z[q|C1 ??W1ǟ ADo`I'=`ߏ>ޕU z `YDo`;d/$g8!~Α?w3/(WKDW=сO$ zc ޔAv}8Ys3|#~~~cCvOC~ `2:Gw*Уeo^it9nZO Gd>颲UnР?= :lȸ  z6СPJx=G{p:wdCGuq2ľ70TtL訠*mrVgb4,׻,}+Яm;]-QF+降u\mVu-*4O?mQ C߁CGw\<3:ެXyUһ6snD5쉾lѰLR_MYKJUww}L~3q0n.u.*5ZuP=Vq$1*yՌk/v;m+^T_ aPWTtNu+BEԱ:}اv~u/Q?Ve~uƏsUc{g&˴+Fݐ^urfv%ljcv>QFV98N}ǠB_ae^־73WEMU?D+WӕXNjWnvQegpX" ;Lg$Lu,S}m2 w\\Š9o>A&)TSqNrՂ rUrڂ+7|iSc]j> :>6~4G!jmI}5SM.<y>Uso٥5!rjbW>)p@5դsR|vj{Cz5drC|S=jԇ, ΡprQLUN`IZհ&x`‚N&T=* {J&}O4>^pgWU&Js>y+_{huXϥO% [(uN>!Z|C~0(!Q՝էPQ_2"ȰRPixMA0\kRk.UI|贈 e5U ɹP0N^>YԚUޛR+T&Uje _i _SY]l> W,kvVۙ}ϦSU(Fi+O4R⿍!Elw1&jxXjRjRJR9 AR=Fn_wv/BMTk5BReI*E@(T3ҼTi -CYQ~S"x/!HrWԂ XB2Jnnp\Rb$bٽ2g"7$ˡj,K AI^_(kSI Y9Qiٹ“PLv6u?Ą@#X vrG𵬤P>=M4͡umM\hp1$5LdCㅱz8s%^6|S%qyf8|.V.LM4IH6yڀ%EH~d-2݇')ʩEJO9}l$x>Ӑ௠ǁ~38v\%;#ǧ鏑-ۖeA0*Ndej-)^識|(d%u>Jr[4LiPi=!xmPA5۠tWCuL|.{Raf51en<003mJ3#P!(jkSFgeF@Xuxv_gڮa4ښ)B+:fM\9XU (w\w~4QFG6 ysn}e(xB..66# JPX Åݏ6 @( tlMA7qSM&nSoW׵{@kF֩j}o4On_wh7D cvCT!n^!N;Ϳ)Q~|Zo^0>`$.UR.z_k}:iQp3[ͯ)GWÑ5o(p/C nLo7"cQr*J{F{r\鲋kr{ӵ'l 6*`{ݬz"wDT~z=/X7sSGT2]5(4>~Ү c,v?>>󑏝1󝞑~K"X3>= gdٰ}Lu,p:g;_i||iت{v{ xѐ{^j5ge9&LNY꬗lB!9C=bcN]SlNso\8`3jt˟08#w-gt#8 k{SqIwp!?hKf>F.D}tt]I9#+yvCiOMl2WحAa_j3ۊͯ !NaXfZ_Μ+Zr;_E: ]JΠ/+g+{}lPVp+3@o_RRő{Nݑ?~Ο˨Nҏ"\.~QQʜ'ΠJK-g[>hN&o=xM9l~IiKyX:>(0xtt-`}ג? ㋳lrѓaaOs\6΃knlqDΤIiiC=WZ4cWol3fu3(be=}gwqzG#-ot<+m7K[{e|&\<9y bSJ]t,YRU1}Jǧ,73{<oC}ɓGV^/ \Aˠ6hS6\IS Fґgsxﳒ fI'V:dW_;O:|G6ش\2X}B:+I{r}??="jC5X jP`m?4AhPZРpwt\7M^D̩XC&/ ϽԬ)?__#%O:|_BgGokukhU%-( 2ĵ⺎򮰸.{\:+$|k\Wwhq]Gys\Umq⺎.S -q]C:㺬׵=(j q]C:ʻq]VGOkZ\Qe2v^WOkTS<,y؅lL{Ϣ{=f{B<뫂{D<4뚬fUDW6fAqm/\juiUjKh4y_?4y<M&Ϸ<h4yiC-O-}Z\Mk'O-0n|3oX.YAS I]fh8ݍ I%VrT뭲\,OeU믲rŘ 1TL*˥,\r*e,\rk7ʸ7{ʸ7{ʸ7{ʸ7{7{ʸ7{ʸ7{ʸ7{ʸ7{{\s~Iz?&2G*$' }ݿT&2L*S.ѱhec&y:u0`LRsn[A$(1BP9QlCnrh*p1k9&WuԴulvpi J7p;`(aMH^Μ$0C `rG ĠG}B&ZW+.t*vʖgVE 4dhڝFAhjExV1o0}A;oS1]Bm VJR:]nl.WF<鵸t'k҉g%̒ND1Ywt8hMvt3#l{3ϏlidLt๋+V-~~ ~|o7V(M-i[~nI-7~O70hmX~=텍f]CcI_7;e> [>sK=O{v_WǏn9c}bے[-k8z> exĭO/.W1a1̹}BaXV?*{AZMn=Tu+es>tx%'v({!qXvL:u$euS<(JG4c;7bi ##yvx~!nN5M-i#Z)=1-K cj[!푾xs]o)Ans]n-.SG6MgNĭ#M`hE#ɒsm&}6%#e7җ:8OZȚz }IGqӖW;oʼͤo~ffKnw oN\Di[?mwm42 '!6Yo>I2;F5I7%Y4 N_exNvOx5ųcm Z^k'bʬ-jdbYg9=9-g_1>mtmw_"ōG쪸~-^-α힨{)MO)07tj+wY5VGU*n-tlq_ĝ΋NQĸE VmkEMoD|;M=y_Yr=EϿ7's횯ďDvLk?$>qՈ{vXvc~q{;.~Rl{CąV<I|#<.Y|7o ?Yq϶;ywc[ CۗA|=v]]\XGZ.~Q|οu7ܵ ;3Veݸ;n's [_hh?m}G;1aʇRb1g:n{P,OrybVn$E◭ g6&E<5َ˻zq;Mn'{^xq)?(R/noorDmѦmx553CŅE&7=S,sޤL`x3؍=.ߣ=v`"'s"ϭ D=n)kjXp?AFTAMA灈讕W90Hs5P%5/Otي+]vf %SWL,EMRԍ)xc2e(x" PK4P,N^gqˢtxBNd<tx fP>2}RRb- [zPhG} ~9տݸW미~0RpHMP E > }52Hl0#z"Ӂa ߀Eԅ}0aLC$/y5Bo/{5cv7'h߂o[1!'̴W$t@:o_HR;u`5 eIԎLRH6 u+[<5:\=0õ,ߟk-5I\avTkLF7˲_O*Sj3}:iQCY ӣIae+ GF@ uu8Ƃb1b/0_c,Z06)]RoRV F!}Jpc*|˸Q>Pl7+N>혓PKq~-A'v:`G@deҰ^De(*|QK2$|vIu Fz'bAjuƲ|,;UuphIA]m[&.Ytŵ9]M邯DTVIbPU"m1͑co YodaL[ `__[:V u]Ԁj_৤vsYc+f(7|T>J:}-,R~3 -hj.j:BLBk~TlrJ|Re̜'Ou3yLLJg>3~3BoIӸ>zG_;'<ጬ:ΐ^l`9/ [xnu62}v Ql3'dԉ#KMh4xt}"2gȷ]y̩{jVi 'qFng޷n4dm/w613Bn5D=g~҅>N>9iT7gc%nHw67;M5Y?싕ZMww[ѴÜw1) LҙsEkw].;~H1R#z|؜~qe/ npK ^X8ru5֩;rZ#z|IqsWē˥4* ґ;^]cCp)~wܩGϗ)/I4?bt6}ci;KEeһZrǟAw|q6Mz?zp30luN“˦yP8b͍-ҙ!)?m(XBuJF=tқ> yڌٿ.tE/u.΀Wh$]545}grikoݲL<Óτg0'!^,b*XcU %]8K׶*O\GoxTYaSĸ[}$^!:!0 ϴ ڔlܐVAYo22s崇֟ECWiGwׯ^_}N=.1,dK/jՕ=׬z\ϚSS?W-ߗ_<2y)N) 4ݍ54ԦmѦ+h;l>hoMkM9ڔM9WΔ)'| W jA jC 5 j6PԠ?4@hP]~:?~Ǿ7y;D~Ǿg/y]$Ƀ+BN=KZ\Qe ku]aq]&uhq]GyWH\ָ⺎.ZuMq][⺦uuY ?=k{hq]GyQ\S㺮uw㺬:e켮>Xy>Y< ]-٘Eωz(xWxh5Ygg$5l'\om̂Zc~_ ڭѫ?eՖi.<h4yiC-O*UYrW,_e^(1 b|*˙TKSY.]e 2URY.[eFUn&qoR&qoR&qoR&qoR&5qoR&qoR&qoR&qoR&qoR& 277~Ld UI'O ?@ ]L)Pe RU)T]c >LL:u0M`DTSBHPcs.4Tbp T)L+Wr^MMrFi{/ 1i|)"<A|t+70`XGWׇ3g)l\QިQQȔD*9yN%.y\ t@L ؋JyۋݼQa;S65#e** ض`AtPz,5A<2j.{+Pn$.˓͉^YL{VCXšdujYޟik;ZS5"(eUGUA)yBSS.E6z_Z:DT O3wa$'VxdM\mD/˨aҡoۦY<٘.k3Cd]V>Q>DRݩЩtЩY=_J2Ҡc.̪OMT3\ϥ\e\ea:L\0q&ua:L\Gבuqi\Gבuqi\Gבus\G:בus\G:בus\Gבudp\Gבudp\Gבudr\G&בudr\G&בudr\GבudqY\GבudqY\Gבuds\G6בuds\G6בuds\GNgXaN*,B味5KyB>2Ca b`Z63Š HiKId\@BKXxiGqn JS tvZ?RP`ͳZlWLr *qİb(CLO5s; %?\8JLދ0M[t!R+< fNm bۓ >A+WjO\XTo) J-Jrkn?DZgnm/tests/testthat/test-RC.R0000744000176200001440000000343413615614567015464 0ustar liggesuserscontext("datasets [mentalHealth]") # set seed to fix sign of coef suppressWarnings(RNGversion("3.0.0")) set.seed(1) # Agresti A (2002).Categorical Data Analysis. 2nd edition mentalHealth$MHS <- C(mentalHealth$MHS, treatment) mentalHealth$SES <- C(mentalHealth$SES, treatment) RC1model <- gnm(count ~ SES + MHS + Mult(-1 + SES, -1 + MHS), family = poisson, data = mentalHealth, verbose = FALSE) test_that("RC model as expected for mentalHealth data", { # compare vs results in sec 9.6.2 pearson_chi_sq <- sum(na.omit(c(residuals(RC1model, type = "pearson")))^2) expect_equal(round(pearson_chi_sq, 1), 3.6) expect_equal(df.residual(RC1model), 8) # normalize as in Agresti's eqn 9.15 rowProbs <- with(mentalHealth, tapply(count, SES, sum) / sum(count)) colProbs <- with(mentalHealth, tapply(count, MHS, sum) / sum(count)) mu <- getContrasts(RC1model, pickCoef(RC1model, "[.]SES"), ref = rowProbs, scaleRef = rowProbs, scaleWeights = rowProbs) nu <- getContrasts(RC1model, pickCoef(RC1model, "[.]MHS"), ref = colProbs, scaleRef = colProbs, scaleWeights = colProbs) # change of scale expect_equal(round(-mu$qvframe$Estimate, 2), c(-1.11, -1.12, -0.37, 0.03, 1.01, 1.82)) expect_equal(round(-nu$qvframe$Estimate, 2), c(-1.68, -0.14, 0.14, 1.41)) # association parameter rowScores <- coef(RC1model)[10:15] colScores <- coef(RC1model)[16:19] rowScores <- rowScores - sum(rowScores * rowProbs) colScores <- colScores - sum(colScores * colProbs) beta1 <- sqrt(sum(rowScores^2 * rowProbs)) beta2 <- sqrt(sum(colScores^2 * colProbs)) expect_equal(round(beta1 * beta2, 2), 0.17) })gnm/tests/testthat/test-biplot.R0000744000176200001440000000345413615614642016445 0ustar liggesuserscontext("datasets [barley]") # set seed to fix sign suppressWarnings(RNGversion("3.0.0")) set.seed(1) # Gabriel, K R (1998). Generalised bilinear regression. Biometrika 85, 689–700. test_that("biplot model as expected for barley data", { biplotModel <- gnm(y ~ -1 + instances(Mult(site, variety), 2), family = wedderburn, data = barley, verbose = FALSE) expect_known_value(biplotModel, file = test_path("outputs/biplotModel.rds")) # rotate and scale fitted predictors barleyMatrix <- xtabs(biplotModel$predictors ~ site + variety, data = barley) barleySVD <- svd(barleyMatrix) A <- sweep(barleySVD$u, 2, sqrt(barleySVD$d), "*")[, 1:2] B <- sweep(barleySVD$v, 2, sqrt(barleySVD$d), "*")[, 1:2] rownames(A) <- levels(barley$site) rownames(B) <- levels(barley$variety) colnames(A) <- colnames(B) <- paste("Component", 1:2) # compare vs matrices in Gabriel (1998): allow for sign change # 3rd element in fit is 1.425 vs 1.42 in paper expect_equivalent(round(A, 2), matrix(c(4.19, 2.76, 1.43, 1.85, 1.27, 1.16, 1.02, 0.65, -0.15, -0.39, -0.34, -0.05, 0.33, 0.16, 0.4, 0.73, 1.46, 2.13), nrow = 9)) expect_equivalent(round(B, 2), matrix(c(-2.07, -3.06, -2.96, -1.81, -1.56, -1.89, -1.18, -0.85, -0.97, -0.60, -0.97, -0.51, -0.33, -0.50, -0.08, 1.08, 0.41, 1.15, 1.27, 1.40), nrow = 10)) # chi-square statistic approx equal to that reported expect_equal(round(sum(residuals(biplotModel, type = "pearson")^2)), 54) expect_equal(df.residual(biplotModel), 56) }) gnm/tests/testthat/test-stereotype.R0000744000176200001440000000145213615617210017345 0ustar liggesuserscontext("datasets [backPain]") tol <- 1e-4 backPainLong <- expandCategorical(backPain, "pain") ## stereotype model stereotype <- gnm(count ~ pain + Mult(pain, x1 + x2 + x3), eliminate = id, family = "poisson", data = backPainLong, verbose = FALSE) test_that("sterotype model as expected for backPain data", { # Obtain number of parameters and log-likelihoods for equivalent # "Six groups: one-dimensional" multinomial model presented in Table 5 # maximised log-likelihood size <- tapply(backPainLong$count, backPainLong$id, sum)[backPainLong$id] expect_equal(round(sum(stereotype$y * log(stereotype$fitted/size)), 2), -151.55) # number of parameters expect_equivalent(stereotype$rank - nlevels(stereotype$eliminate), 12) }) gnm/src/0000755000176200001440000000000013615621570011630 5ustar liggesusersgnm/src/Makevars0000744000176200001440000000004113152512335013312 0ustar liggesusersPKG_LIBS = $(BLAS_LIBS) $(FLIBS) gnm/src/gnm.c0000744000176200001440000001204013311175455012552 0ustar liggesusers/* Copyright (C) 2005, 2006, 2008-2010, 2017 Heather Turner */ /* */ /* This program is free software; you can redistribute it and/or modify */ /* it under the terms of the GNU General Public License as published by */ /* the Free Software Foundation; either version 2 or 3 of the License */ /* (at your option). */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU General Public License for more details. */ /* */ /* A copy of the GNU General Public License is available at */ /* http://www.r-project.org/Licenses/ */ /* vector * matrix */ # include /* for length */ # include /* for dgemm */ # include /* for registering routines */ /* copied from src/main/array.c */ static void matprod(double *x, int nrx, int ncx, double *y, int nry, int ncy, double *z) { char *transa = "N", *transb = "N"; int i, j, k; double one = 1.0, zero = 0.0, sum; Rboolean have_na = FALSE; if (nrx > 0 && ncx > 0 && nry > 0 && ncy > 0) { /* Don't trust the BLAS to handle NA/NaNs correctly: PR#4582 * The test is only O(n) here */ for (i = 0; i < nrx*ncx; i++) if (ISNAN(x[i])) {have_na = TRUE; break;} if (!have_na) for (i = 0; i < nry*ncy; i++) if (ISNAN(y[i])) {have_na = TRUE; break;} if (have_na) { for (i = 0; i < nrx; i++) for (k = 0; k < ncy; k++) { sum = 0.0; for (j = 0; j < ncx; j++) sum += x[i + j * nrx] * y[j + k * nry]; z[i + k * nrx] = sum; } } else F77_CALL(dgemm)(transa, transb, &nrx, &ncy, &ncx, &one, x, &nrx, y, &nry, &zero, z, &nrx); } else /* zero-extent operations should return zeroes */ for(i = 0; i < nrx*ncy; i++) z[i] = 0; } /* computes matrix product between submatrix of M and vector v */ SEXP submatprod(SEXP M, SEXP v, SEXP am, SEXP nr, SEXP nc) { R_len_t a = INTEGER(am)[0], nrm = INTEGER(nr)[0], ncm = INTEGER(nc)[0]; SEXP ans; PROTECT(ans = allocVector(REALSXP, nrm)); matprod(REAL(M) + a, nrm, ncm, REAL(v), ncm, 1, REAL(ans)); UNPROTECT(1); return(ans); } /* computes elementwise product between submatrix of M and vector v then puts result in submatrix of X */ SEXP subprod(SEXP X, SEXP M, SEXP v, SEXP a, SEXP z, SEXP nv) { R_len_t i = INTEGER(a)[0], j = 0, last = INTEGER(z)[0], len_v = INTEGER(nv)[0]; double *dX, *dM, *dv; dX = REAL(X); dM = REAL(M); dv = REAL(v); for ( ; i <= last; j = (++j == len_v) ? 0 : j) { dX[i] = dM[i] * dv[j]; i++; } return(X); } /* Computes elementwise products between submatrices of base matrix M and columns of gradient matrix V, summing 'common' results an putting result in submatrix of X. This version has start point in M, V and X for each "term" */ SEXP newsubprod(SEXP M, SEXP V, SEXP X, SEXP a, SEXP b, SEXP c, SEXP nt, SEXP lt, SEXP ls, SEXP nr, SEXP nc, SEXP max) { /* currently set up for single term so nt = 1 and all integers here */ int i, j, k, l, *start, *end, *common, nrow = INTEGER(nr)[0], n = INTEGER(max)[0], final = INTEGER(nt)[0], *jump, *ia, *ib; double *p[n], *q[n], *dM, *dV, *dX; dM = REAL(M); dV = REAL(V); dX = REAL(X); start = INTEGER(c); end = INTEGER(ls); common = INTEGER(nc); jump = INTEGER(lt); ia = INTEGER(a); ib = INTEGER(b); for (i = 0; i < final; i++){ p[0] = &dM[ia[i]]; q[0] = &dV[ib[i]]; for (l = 1; l < common[i]; l++) { p[l] = p[l - 1] + jump[i]; q[l] = q[l - 1] + nrow; } k = 0; for (j = start[i]; j < end[i]; j++, k = (++k == nrow) ? 0 : k) { dX[j] = *(p[0])++ * q[0][k]; for (l = 1; l < common[i]; l++){ dX[j] += *(p[l])++ * q[l][k]; } } } return(X); } /* computes single column of design matrix */ SEXP onecol(SEXP M, SEXP V, SEXP a, SEXP lt, SEXP nr, SEXP nc) { int j, k, l, nrow = INTEGER(nr)[0], common = INTEGER(nc)[0], jump; double *p[common], *q[common], *dcol; SEXP col; jump = INTEGER(lt)[0]; p[0] = &REAL(M)[INTEGER(a)[0]]; q[0] = &REAL(V)[0]; for (l = 1; l < common; l++) { p[l] = p[l - 1] + jump; q[l] = q[l - 1] + nrow; } k = 0; PROTECT(col = allocVector(REALSXP, nrow)); dcol = REAL(col); for (j = 0; j < nrow; j++, k = (++k == nrow) ? 0 : k) { dcol[j] = *(p[0])++ * q[0][k]; for (l = 1; l < common; l++){ dcol[j] += *(p[l])++ * q[l][k]; } } UNPROTECT(1); return(col); } /* register routines */ static const R_CallMethodDef callMethods[] = { {"submatprod", (DL_FUNC) &submatprod, 5}, {"subprod", (DL_FUNC) &subprod, 6}, {"newsubprod", (DL_FUNC) &newsubprod, 12}, {"onecol", (DL_FUNC) &onecol, 6}, {NULL} }; void R_init_gnm(DllInfo *info) { /* Register the C and .Call routines. No .C(), .Fortran() or .External() routines, so pass those arrays as NULL. */ R_registerRoutines(info, NULL, callMethods, NULL, NULL); R_useDynamicSymbols(info, FALSE); R_forceSymbols(info, TRUE); } gnm/vignettes/0000755000176200001440000000000013615621571013052 5ustar liggesusersgnm/vignettes/fig-LCover45.pdf0000744000176200001440000012257413152512335015660 0ustar liggesusers%PDF-1.1 % 1 0 obj << /Pages 3 0 R /Type /Catalog >> endobj 2 0 obj << /CreationDate (D:20061218162601) /Creator (R) /ModDate (D:20061218162601) /Producer (R 2.4.1) /Title (R Graphics Output) >> endobj 3 0 obj << /Count 1 /Kids [ 4 0 R ] /MediaBox [ 0 0 720 720 ] /Type /Pages >> endobj 4 0 obj << /Contents 5 0 R /Parent 3 0 R /Resources 6 0 R /Type /Page >> endobj 5 0 obj << /Length 40898 /Filter /FlateDecode >> stream xA%9vZEHh1hBJBP A94Ǖ{$Z]TE~vkv##s ڿ_9)z#O_o~']̏?~ 㿼]ɏ)[GɊϤ?Rnnӕ6Vڑs"jاULl3OO,☰L````````````````````|1ctX;ٙg:vV9f8ꊟYyWXX9r:ع#ŏs9'eS,ī*',/_.WX銵˵FIc~}d?,$/|sYXBrkA#o^N_yʟvٻimc9Di=IH=_Q71B0&qLX^&00000000000000000000!]6/2!]5G9OU:P::Gy}^yv1,Wd׏T6#K ~fv2v9>EO1'qLX^&00000000000000000000]6Qkk쑭=yοsctUg9e9]bxm9M.A]ՅL(vE*',/_.WX銵˵Fֿ<߿/Zusatݖ>p#ts Fd'4|dO]T;֜~zNe"egdoE Qe8&,/_ΐ.W.#[z@]]Sh]c>-0rϫU}cK9vkHGL4wU.b<>c2Ō8\?Xˑ=yοscgƞe?mYyW^gmGξǑ}N"[NKU~fE /fh tZ#{d_{o&{I`ng3xcOy=S1ݎ]n>'6{Wܤ^ 'mY?1c2 r}} r==Y(H]F%frϫDC0^fլGj>HIbOѷUL.'qLX^&00000000000000000000]6R5kk쑭=yο_5Kw'g7Vt|W^e r;H5٦Yۑes"yyjOH~8c" 3V:jr==t~ ';j]Xx~GݜG%y`\i3˕?Ɇ$ky9?W#w,isQ7i18ͬ? cbDŽej"Z#{d_{訫l(R|v_5趢(k x^53LevmLΉ\a_qS! 3Vfr==7OKѭ2ƶ"mЖ wŵH.YJhrۑіS OqVqw%]&\sMn/H9Y9}y|"<>cwAc```````````````````|MctJW<<9ۮ&kW#rYYWTh'yGx*9 ?'rkY?1qej2\kdl1sGsouAr,g+\{۵G6zc"mkW,RUL.U8&,/_ΐ.WX銵˵Fֿ<}ϩ=JnK>/< /˳ rϫld_ Y9rMK#mrD ؂۶V͛w>YOa-,>0R| YW]wT}fuq9=6ti79 Ƒm bysmw*E /gH tr==oog. q9ȍ̖ wM"YysYvޜߖۮ 8,OQ C 3evc{W]oRYiW;);{쮌;5gqzrX&r[W{c"mfE /fh tZ#{1s/|<-,X$*oZWťHc9H#-ɻi$Wո if" Ɨ3Vfr==oonK.G6ىA . wM"U^RjY둖].DNnnq!.b.噧"ej2\kdl1s۽+wy^Y ,<#KyllnGJY&dnw\KU* /fh tZ#{d_{oax9IRz ErtԖW%XWn9V/U,ufE /fh tZ#{d_{ty}^{e9]qqH%=ٗPqH y:!Ok<_fVqL\>ayrtJW]5G9MW\y+s޵2󮸹";lDZ}K]"pN?﫾wU SU /gH LHk쑭=yw5=r .$-VCy}bDŽej+]vc7]q孺P.י w22,gW<~d/D_gWUlqfE /fhF+]v9r9MW\q_qye9+n.jzG9$i;Қ 2jmf)ej"Z#{d_{^_Ux]|'5wz?~o\ΏE۸䢟Y.iܢ순 '*+G!d[5ۑƥ2V5cX4" 3rY\kdl1sY(aoUJtȱ6 v-˕?廓 a~L϶٫2ݲ*.iSn(*C Ɨ3E&˵Fֿc"3Vbr==]qul(Z3x7U:mz#PF#HIY̩>e/ϥe)ej"Z#{d_{!OVj [,;E.6<9g+Q(6ld¢w+#ȥ)W'qLX^&00000000000000000000]6Qkk쑭=yοQJ?=H~՜j9%ҿ[ x^5#]CueK#%ˮ֜/{y䫸UOX^&000000000000000000001Y\kdl1sUsN8T1R-oc},׉B['4]eT{uqмN.meb/D׉}ܜNh^&_~ D5~׉SLd[^'~׉]Lh^&JWO:_X&4Lh^&v/9=',fLh^'vk˄ezubse-ŵSLuny[>'b׉ζNh^':Q΄eB:>'4/AqLX^'Oә׉vteuu9?9]|zzErŻr+Zײօ+ua-/eaJ[|&/m}6[.X>Ad]'cNNօcNNsm]'/>ٞq+GjOy}h,%Ͻ o3#.?uܿFoxz6:^x^+x^y-xG%h\||֥YC]b]?wA̲S~tlˊ ,^D+ǿ)??=?;6￲:1-?ꃞӿ_˿>?f6Eg-Oӟ_?X>ޗ__\ c_SxL&z4,Bڿ0zFkwD*3/g7J8~S "O4g[P˄Z/~kY1qeKk2{ikl]1sdAAb߃HqבcqI/1˽i[4g_fp|/)kmܳwyS"faeKk,.ٺcy_#0Il-<&+EV,7g/veU^RjOzE?cbDŽeKk,.ٺc[b?,c-).lNYU^#э}l" ^}Y1qeK&ˑK>yοٻfks,gNm;|diޥLvbRUlef4E OlH/m쥭]>u=K_]O>]zXLȕ'ʟ'Wd5g~A\&r=꾊i\f" '66Yv]>u=\꧔k=e٩fܖ>nOkufyB?輮YMzYoW\?N-4?.☰L`````````````````````|ZC{im6^#[|=KG#Y>޻o+5o ڤ?'cVbS Okh/m쥭]>r.9wW涟{b.LQo3]ʘe3$że}{*#0:>3;R79s"y|q38&.bL`````````````````````|ZC{imo^#[|o |zIL߮ s\Q e nml.#{^e-Gs)(ΉCsKsve-̬☸}2i M^{ikK>yο&Wt2Pr{& PGo ]H\,D?%/y.:~.ϬS '6BmLH/mK>yοKp13\3u=.sŶD߽r{w򹋋iq1!O9{m*}fE Okh/m쥭]>u=7w_#67rO{Kqy쐢98w;RlA~N6f{p^ŚgVqL\>ay&KﭽG.9N.lya lpbYy]]\أEsɵyz`ׯ9jXO38&qLX^&000000000000000000000>!{k/mK>yοwc2i M~}G.9/_Gx|G_YN?{z]﯏?z}WnkگEF,<͓7km^i3Y'&jV1fbX1ay&KmG.9v<ȼAs),g.mYi#{v-=*V?c" Ƨ56Yzo]>u=o B|o,dwoPo:/|d-,Ӣ.CvWu)_&O}VsU?oUOX^&000000000000000000000>!ɯ/v%<ܠ6i=Ӳqf9NUlEic><1^v&GțKb*f*E OlH/mK[|d뒏{o{"{ af9vs] HI.e"}bu>" Ƨ56Yzo]>u=ws%?r]'f_3<뽳Ňҷk/mK>yο߷1Ev9'RvjO}\bY1q:ayƖg"K[|d뒏{wٷ]ͷ _]lI6,6ߢ :yXMf%9.)Ky)E Okh/mK[|d뒏{nշ޻uf9wq^ITY9';w=҂ aW{Y[pKY1qeKk,.ٺc{wM]{.3<｛ 3R5琤s#{qaoŞ"mfEƧ56e.ٺcۤAo9/%ׅ%xi~aǓMݘ% ȝ{\)3GOTh{~HS eY1c2 饵M^{ikl]1s )͏]uT\3<ｳ48VC{)y\Llsiiaf" '66Yzo]>u=oPOlek3υw䁟O3˕?P7Y 9 ]+˄|MO1Ul.* Ƨ56e.ٺc(1nK5>vɛrOk\rG7>.ݎmqHAYS*FS8&,/^Zd͵v%Yv?L8zۓ*ufE Okh/mK[|d뒏{}A']t|F.G-<ͫ۶R+G{ۑ}w9,W{|"}fE OlH/mK[|d뒏{͋컞T~6u]XBv)^3cW^~f}{ }* ʑoG&HIjOѻZW1PfVqL,☰L`````````````````````|bCzim__dBzikl]1s}{`r+|`w~-IvO.ZY.ymfTvʑe`;ؑ]DjrjW1-<>c2i M\{ikl]1sۭΥyӇ3h.3u=7N.D?/y.u[*w[VqL,☰L`````````````````````|bCzim^#[|{7Gŵ s7G?]؈Z};Ҽ=Ur}>bpaɯ/2Ѷ]>u=I٫'^jz]9z<~Ӳ\ #IGVjnǑܪ|oJOǰI-OO,☰L`````````````````````|Zc&Km>z.<9y y I6pZXon/(_r4>ay&K߮G.9f{7-BrO{]j 4dqvMs"%Y\*2~c" Ƨ56e.ٺc޻EU*i9$X3x{o.]ל~)-2>e38&qLX^&000000000000000000000>!{k/mK>yοJ n[7gW l[SnaaE>߰ eBI6x:$=@qfwG_zzeb]\ھif" '66Y5G.9o $CⳫ?;n(lct|dYfY>E}s<0MBaHw DŽ`YY]|t!Rs d)_#8&r)ni7WS8&,/{^z3.y1NEs3]3<ｋ #%>Vjm\oGzػ{gX*',/{^z3.y17݀|4f3x{7m=r>l㋝)Mز>eU OlH/mLH/mK>yο![?){,lr{\ ȫ cC򰹺,Ӣ>DCimܲKӡGrڏ՞bp-BY1c2񉍸6YKvy%{>ܠKeܐ qf9wLrk.٦2zD^XN=S^~S8&,/{^z3.y1]ɏmaf9wuM+1[qڹ#r{D}bsyy}bDŽe6z.<9j[6)kvKNurOkqق]Vjn\ݻ oz2c" Ƨ5F/mm棗̳K|̿]R9˖R;'9rN$bR*',/ؐ^Zd齵v%<޻ܙ6ag0Nβ޻J9FmGξ=ԎL {y.bb,8&qLX^&000000000000000000000>!{k/mK>yο7/̱QZYiW#,ʑ/qvVeB)mq)E Okh/mLH/mK>yο7W#h޷"[3x{'W#5]9S)Ds{\L]3O1U Okh/mK[|d뒏{o{4޻)i7\)E6-?'sq38&.g^&000000000000000000000>QF/mK[|c_9nsDZw@KrO{ay&KﭽG.9nddrO{jǝLN;{r]<=bp~Y?1c2g"K[|d뒏{ozy.n ef9r}ʑN⶿iE79'Ru)\\ZZ$[VqL,☰L`````````````````````|bc M[{ikl]1sm]jncR3<ｋG5mGξ{أЭWVö\)E Okh/mK[|d뒏{o{s04޻)o.q#˝[j[&rzw}{y)nqu2i M~}G.9]ƙ {H{sA}d|ގ rOG6c"meKk,.ٺc~}d)?Ȃ 7'l~}?[gΗGm.f x^^+mbGZmb,.Ջ=v[Y1q[yĆ&KmG.9vac JvsY)&;w=Ғ׉M~KY&4EZ&4/%|3|SoмNpмNuB2EW:Qd7eB:.ͼLxnu"_~yn_?1Dk9ay&um,/%~b׉N쮭Z^&Z^'gjy]Z?S˄~׉M2y//ͼNlf^'w׉vnsBCޖOlu{ D_]^>׉,O3_&4յmмL(7M׉,{-׉_'4/[pe*:\]?SDu~L-/)-"u"]~y/ͼLdnu"]~y]\?1D_ue~b׉Y^'aeb мN<'4/zϯωۯ%{/0_$alZ K>l.K.ncKeivIץKO|-?_Ruir;ei^KwSiUyC̲,_Uo&6:{u"gr׉L ˄e"1ayi06G׉U˄euB8?_/_j? ꝅ?-L?%fa?A:O9}ß{3]|?uE}-ߒ_~c+:~=t_w.AW(!w͟_w~췝{jtAWf鳏`e{U&/ TO753w3Ze`/ 5vSth5 ]/zrPqg¢6BM~pǁ5W4/_îZɢ~Y,Z:Yzֳg=Yzֳg=Yz_o-֟/֢Z:sw汉no~o@(Y~Y4(' u;GV|]oZ]6Բ|6^xzֳg=Yzֳg=Yzֳ.EݼջڢjeF+?-7J;Æ_o]/Z~4!di:IW$}-YmѪ#Cx:Yzֳg=Yzֳg=Yzm֟hQ 9|sMAd?P6}e }vF .1xFx]`h!X3dV5^xjVլf5YjVլf5YjV?j'X|}zzV÷8g_\>-[-[?m>֠/):7Q.|nTK&Xef5YjVլf5YjVլf5ízR'gj9|sM]-Ey6o*}(o6/j a3b :6r]YÊ<-uҰƫ_xjVլf5YjVլf5YjV?j'X|}zzV÷84y{%i>kp(oL RFa]Đ\iɦ+{D[V,V:YjVլf5YjVլf5YbIgZq75!UyS6ss9ޯ r.w>nO3?텛l(5nMI1}4j<59g88| VWKJ#[I;oqN>mOB+mZYY|'ٚWVje؎ec"ڏdy݇U\l3OO,☰L`````````````````````|ZC{im^g<{x\}w!,gήJgc9繏#1U}RޜhIvXS~Iԙ'qLX^&000000000000000000000>{k/mK>yοwCW3m~f9wE.ژ[.;w=vW27y՞bu[eYEXEмN`````````````````````|VC{im__f/mK>yοOT=?ᶼ}MVG6rOk)!fGo9pJ;[ĶLȃ%*u=76V.Rg3x{gd? )jsGr<뽓MοȈe9y">}ԜF+#,Kq_S*feuB:Y M\{ikl]1sl{\R\(,+x{gzK.sK>[}=w^ʫ9wcb1sbmUKkfjϼs1绤յ$ٿ%|M-ϚGR,7مT1)r9tp;mGWmbrދ✸Kk,ҫ]>ly|A&/\YV.&0QNs&OO߉=[VqN܉cbm 饵M[{.[.9.6+pjYV>S?ҼRs&0z$._}ZڱdY?9sbm 饵M~ W|%?Gt|R,+x{'E@׻\;/z$$e9}*~/].E&M+o/kh/mKvٲu6!vqh.d˲|sf(EJu]XkG<߾MD_]y]]8,.Ή 56YzoWlٺd\XU8'V&000000000000000000000^ؐ^Zd齵^em1{q }>>K- ݕt}XvkvٞGbk{}'{zıX,8'.Q'V&000000000000000000000^H{H{WWlٺd޻y_fݲi]@.q+=WI6k#1.k".&&M+o/kh/]g,Қl]?sc]g<6.+.6˲wq>BN5-#R1TySnxTŒ-8'16W,쥭]l]?sc]%Iﲂ]e{V^t[Wu瑘\vr/dY9q'dyxY^Z7Wlٺd?|-ܾEp? b >|p!L>[2mey.[H^>+5._w޺p\1ﶉA&/-8'6qNM`````````````````````!Rk/e%c>?<.޲?3tXoŵòy}C.WM}/DcX\ U8'V&000000000000000000000^ؐ^Zd齵^em1?.ޒ;-E~x\̫˲6}>[;޷7@Eg6om"$n_b/&sbmeK6m.[.9Ȧy||n>c}|dYnimރp_/g#W5S}jq>])l96&Kmj-[l=˸׷4W0/\YV>\ȷP@Wjٵ>&ok;ߋYVqN܉cbme M[{.[.9Η1J,+O{RIu/WjnمW9VkC]ewbUw☈WK/&K={ik-[le(`gWd{k޲Y}p\J-בXZΉMlY(96F&Dglٺdwr9bȲp[<ｳ<!yfݏ\>ģCDLKyo9..M8'V&000000000000000000000^֘j˖K|{)ȣ ղy=F^Yjx5!۝%Ʋٲcb^m޳vٲu6ozﱘ07X)yѥbYVy%[rUڹĔe D lj&zy(NɲsN6ꥵM~^z˖K|{i}Ϗq7"do巷x}|ن5eyv#GWՕ˺ Cc-%ߋ=ZVqN܉=Z&000000000000000000000^ؐ^Zd͵^e0u1Eޗ)7ٲy]]ЂzU>͜焬Eͅ`Y9sbmㅍہW?{oWlٺd珋c/^ŻK&/ Un {Kѻ"{D+!Fևn޾Dw1-.Ή W5^mLt˖K>{|6oËs\im;d$ $Zx^'׎[x-5}8HL~mr(tq>]fѕM8'V&000000000000000000000^^Zd͵^em11[}^l~R,76|(ť=nuGbW X\bUwb 5f/dg/mem1_͏)k溼3 ì,76O^Pf^!C&dMZtwb+ÜwXyxYC{imҫ]l]?s;=St!ߢRA +ݲy\p,+xS<jvg_kme&Ή 6B6YzK[lٺdRw׹K5˲wqE+o. VVյe~N?K~].f*ΉM+o/lH/mKvٲu6ϷIIk6)C.d>[ܓ܏<"(OwC]NM+o/k^zovٲu6ol]26)9X, 9n4tWqq=m=rʏ_bʻ•M8'V&000000000000000000000^֘j˖K|{g-ˇeY޻Po!ʕ{qz#e'܃M<ܑ,8'16W,w^e%c>}轛;I]Q J,+x{wyg(0׮eWzDn*oKk1Zjı%WVqN\NM`````````````````````!o2!j-[l{zp|-\KeO{#V(r|]+fO?c-=bWVqNlXyxa#!M{.[.9k1/Oq…1%y_(__y;);1Gu>Zl~?-% _{{kB6}%ťfwqNM`````````````````````1{&KQ?{ikΞZ䷳ǾWYLhu=^`,+x{7ٻ%>\ΝbtMׄtcq~,z;e&Ή 56z.[.9׷<`\eO{e\kCr=Ӹ(_1tKfM .{*Ή;Kk,ҫ]l]?sۇ{,&B ғ ;eYpIS)iɕ>dokW~XKUwb?,o/lH/mKv̫K>{WR%  ղyo!ЛZ\ݝfk-bw![VqNlXyxaCzim^z˖K|{콫7tJ]5;@WdD׾<~Nڽ}b?YDDмO`````````````````````zim߬^W|?foSbL'RW(W~oo6NЙU.G!<;Q+/3Ѷ\-wI~[p'òsN,meK6YjKk|%=>.>ﺹI޻, E?fq^Y zy$(u5Q6܋-[VqN܉-[&000000000000000000000^^Zd齵^W|?f.|w֓T˲gw7oy71|v]`R] BN\Nh'000000000000000000000^א^Z7^zg^]9mC|tIv')YAvX<ｓ<bV]H;\HDw1- 56YzoW|%?އ(.aYV.v0w9ZiŵMToO?En{,beeuB>&Kﭽjϼs1޻\̖e{. !е둞 DMn_b+޲2qkB>&Y/3.67yWN + 61(U\\wGb5Mﶉ^ݲsN+o/kh/mKv̫K>͚^dՕ`YV..y7Esܽ{)_q|lj,8'16†/&K={ik-[l{7ɡ7w[<ｻ;Ҽ>wqY[Vx&b罛<~c-ZVqN\NM`````````````````````!o2!j-[loSy)XR |໴ޗ>\ηЫyy W;ڷjoj Nk_q=KYϰ`/ѷ]L.&M+o/kh/mKvٲu6e#ؓ MihvuvlѕZq?3i;?v>Dl!;]g7]u~^܊u;?~P3nѸ>hg/;kgG~rq;xy^~>_gK>?$wϸ/:?~~|W>?]>?"oϸ-߈VѸѸߢG~}>w\ϊjϸ>Ŷq?_]Ϧ[q?\;3?yv~|i~ߟVӊyMhuu~|3nѸ?M}ϸ/Q~׸?\>?ӸӸϮm|s~4nOIq4i|ݿ?~~>ߟVWyu~|㇐,cHϸ?.g3n|qy^~~nwq??C㏦?:~ލ㟃㯦z CAJ .:_2#~+%]Yve+_?ݕWkWciܯ__Ʒ12"ȿi {4:?~zzu^u>ChWΗcy^u~ݎnw9~d6ٴS>ߕ?l1~^_qYHsk?EzW\ǷCܯjOOo_bmseÏ?_oeis ,?_ov+׾aw6-G_ېϿǸ__O?&7q珥Xe/цͿo}\ z|m꧷r[tYsK< 0ӼRsKoHM#<'9~<`e&Ή 66YK[lٺd r,.1lMe{Gf+5b,}}~]l*%D[ 7b6YzoW|%?<X].բ)M4 <<#ny+( Gb:d sBޕWZ!bV6qLlXyxUz&˖K|x\|\_䊾 aTaeY{EM^.U-[#1W| %+8&6qNM`````````````````````1{&K={ik-x9)|Cq4_cqAoˁWx^W ˁg#e~FD6ȫ`Z-8'16&Kmjϼs1Ż|< ,+x{gR1 WjHKۄtQk-ߋc+1'16†?M~[˖K|Ⱥ[y{ήv˲w2RWjn݅ؒ圐N>tVw1Kysb 1[,쥭]l]?sc},{XAuY<ｋ@v9#R콋eKٲ2q:yxUcҳM{.yucϷY6/#n>3F#P- ywB?yt+m<S5}%cyxxw$&Kԉ 5f/K[v%=}>PW*Mv.rOkcWfپ\ܢk녢z$|&駵-8'16W,쥭]l]?s.+.ieeY޻X7i֮G׎}C.+J{NLh'000000000000000000000^^Zd齵^W|?f{7C*鱂e[e{rޤX,M:|#>7q%x*ΉKԉMx}c^&3+lorT|npIʅe/RZ4rO]9ng6sۄu$xA}$vX1sbme M]{.yuceu^gw65B,76?\˷e]Y#|jD ɵG/1],.7&FsbmeK6YjK[lٺdj$ǣ1U T,76z 8o}zz$.m"^7X꽨( W5^ƛ8l_͋l%]Byi Cϋq]A#nY>E}#qn*(V^ב\f;+C~&w{Uԉ] ƫKk,Eҫ]>lun|PzqjҜ?.>|؋ yVddeyv]/h]>u=Ri(A޼ۗ.&%}U M\{.yucy\6L֥_YVnRZnЬGbkB~mPmbuG✸M`````````````````````1{&K={ik-[l{w/oE_y}|dYV%y}scq#c ξRػeubeB>&Y/3.6N.$^v[E˲/Ki!O{#~s&RGwZK8nYVQ'.Q'4kH/mKv̫K>=xP<=.Gw~x/.[. XYy^]M ;yg"F?3==ȇۗ.6M8'V&000000000000000000000^Xlo_g^]9m }!{R\_ͻ+-懏rj{-[-q^\H<ٚSu!ٗ.w&M+o/j^zovٲugY&, eY;nqr.uwH<dImbrދ*Ή;qLM`````````````````````1{&K={ik-[l{eB7w4˲wuOʙ]R&!ok-܋=[VqN܉=[&000000000000000000000^ؐ^Zd齵^W|?ft)Xt-~MịK>ղ\6gЛm^9s ]QI;&Rvۤu ɲ~sb Kk&Kv̫K>x\\A}W<ｋk w+g>ZmG&r'wc`ĘvqNM`````````````````````{k/3.6nS ;)W'bnZ^ỉ;z^mꥭ]l]?sC=pEV- ;bWj=sz$^l[-8'-o/kh/mKvٲu6BɞUj,+x{y<+=W.]ékGdϕT ;;ZKXU8'V&000000000000000000000^ؐ^Zd齵^em1{y;2]e{Jz'5c}wӮc-XVqN\NM`````````````````````kd]l]?sC;ݛEޖdeY;E-v͵U#xMDQۗ.&&M+o/kh/myҫ]l]?scKEX]le{|\+ɕkrm=ͮGd-NNwfwfxcwbɖUwbɖ 56YzoWlٺd޻.LRdr,+x{w;h.M@׵#1>/+ϟn(⸉UwbK 56z.[.9yeV{ 'WeY;Gٌ%UmW\^P]CZK=v1ɦ+8'6qNM`````````````````````!{k/e%c>翽4ܾEp?"=[8,7o_P://}+oz=sq,wo?!o.觪DSH/\s41w, 56YvW|%?>g^]]Q+]VpxeY޻*O7Y2k#PZeݾw-( W5V/=v̫K>9"ωAO_6ѥYdYnim~&Y\+5vz$";\=vKLa;e&Ή 56YjsW|%PwǒRu>}6OJ|9hYnym~Ct״p#zD 61ߋYVqN܉Y&000000000000000000000^^Zd͵^W|?f6$yî?a/=+ڼ6-zepHmd70wbUԉ] ^eKv̫K>6/.%/'}{.%ʝ(,wo/([ȕ+wz$Ƽ>5/vD/obtXVqNlXyxaCzimdBz.yuc/-4(}9\e{4ѥ+ۮH5QKξD_wplL\Nh'000000000000000000000^^:ǵy^Z/g^]9mKte,'y~]s5T, 58߇e7RsX#YO]>Ś,( 5V/mҫ]>꒯!޻:[6׭Sòy]lcr׻;s#%*ֲׄZJ{NLh'000000000000000000000^טl^g^]9mKjg{t}H-.[H%m͛ٲyk^]QTr 2WDʲnX\K\UԉK Kk,ҫ]>lRp۷z,+z])+rе#)mM%nDDмO`````````````````````zimdBz.yucwirمep!Z<ｓkǼ敚SqysA:kfe/1].7&%}U M[{.yucjў[Wdq+ m}NXKNLh'000000000000000000000^^Zd齵^W|?f{7e\AeO{e#.WjNQ@k_GZ&wGm-^lŲ~:2yxUC{im߬^W|?f{<sٕnYVNuJe<~K뽖T&dss2R.f*%}u 饵M[{.yuc![woZ,+x{RsP]Ck}].f*%}u 饵M[{.yucoo?[}Ϗq7"EQnoo巷gx}|wEvr)>c+~'1MRH?5= Xw ]N+7ΟXy@@@@@@@@@@@@@@@@@@@@;Vt̫=R(G/_^o X, <룋 ;!ϡ˅vlDIvh^ʻ7V&N-|>Z ۞ycOh{ű>z|yetUaYny]\: )([=$5\R=]kaE;o M ՚VY֢u6mqǗޕc]*~{FۺH m⨮͌/p՛/OV&n)|} )|Wo{Ҟ?!X+HKʲr8n=r!dHkvsr5^`rDK\ݻӍAZJaY9q' 6Ɵ6YjsW|%?>]]kZ- M^3᪮]sj'HuMC k-bw![VqNlXyxaCzim^zg^]9mCavR)/,eO{\U܂\9ue]h&J'wQY_DXyxYC{imdBz.yucwrENtE6KYYVή/Avv+5](lDՕNccbKk,ҫ]l]?sc]\7^1]cw)[<｛#JYJ͵f{^\ۄ6-(&Kﭽjϼ8ZqOz_0&piuwyfri;e}{.Φ~8l;Z#зgJ[✸ƫ6z.[.99\gp5Z<ｳ}GJͭ#Q6&oz$'6q|fY9sbm 饵M[{.[.9..[,|n˲wu%7w&Ε{tm퉮GbHs"r/q|MM8'V&000000000000000000000^Xl^˖K|J>!D)?&%wwcsc#- <եYk[Qo}^X&ru%b1sbmU gv.yuck维벂C+_YVEz{Rsy$sWs"hwrދ尬✸^m޳vٲu6leeLV9e{ꢿdgr܂]/qm"v;u;ʽزeĝ8&V&000000000000000000000^^Zd齵^W|?f{wdw\eO{]Ku/W}]LH:\mD n_ky,1'6qNM`````````````````````!o2!jϼs1޻7pX]HsٵbYVNh|Vrwzo=z-f;?c-=bv1ZVQ'.Q'4kH/mKv̫K>ZYPIZ/\kv}>ro1,|iΟEC+5>3=" Jđ$%`DDмO`````````````````````ҷk/3.69>ݻeY޻^tyzF~e~N{_bXǟx&) ƫKkfjϼs1{\M޷\Av9Zt=SG5J <mE;7߭ Rkz[c>?>$Vw[݂ymme>.ݲ?k[t5g Żn\8_*}m`rho7V&N-|:Z Z9n;m_po\( }8r=]ju;?v>58~q?_VyY_g7{^gwu~o|qq|4e;?vDWO~pm4q;_s׸u~|3nu4ǟn|sa|4n{pi|4;G~}> ";~>/3K~;?v~?j>I6ϸ/u~|s5:?~7JϸOQv:kygu~|߿?q~ؿ?on\>{|4 uq;/*>hW׷4nkp~4:?~}~8t׸Om|u~4n߿?Oe~ߟVO~jMu~| 3nCt?\q;cV' uMh&6~B?'V't]ĵ O6) ~?0⯺pf #NvD:N)e<6Z??ay@~Mi|?ooǿֿ[c?ӏ}d#Ǹ__?/7V]?b1 Ccooq[Jendstream endobj 6 0 obj << /ExtGState << >> /Font << /F1 7 0 R /F2 8 0 R /F3 9 0 R >> /ProcSet [ /PDF /Text ] >> endobj 7 0 obj << /BaseFont /ZapfDingbats /Name /F1 /Subtype /Type1 /Type /Font >> endobj 8 0 obj << /BaseFont /Helvetica /Encoding 10 0 R /Name /F2 /Subtype /Type1 /Type /Font >> endobj 9 0 obj << /BaseFont /Helvetica-Bold /Encoding 10 0 R /Name /F3 /Subtype /Type1 /Type /Font >> endobj 10 0 obj << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> endobj xref 0 11 0000000000 65535 f 0000000015 00000 n 0000000064 00000 n 0000000206 00000 n 0000000291 00000 n 0000000371 00000 n 0000041342 00000 n 0000041446 00000 n 0000041529 00000 n 0000041626 00000 n 0000041728 00000 n trailer << /Info 2 0 R /Root 1 0 R /Size 11 /ID [<9ee5058f8357da803511a0a31cecbea3><9ee5058f8357da803511a0a31cecbea3>] >> startxref 41990 %%EOF gnm/vignettes/fig-deaths1921-1940.pdf0000744000176200001440000001701313152512335016464 0ustar liggesusers%PDF-1.1 %ρ\r 1 0 obj << /CreationDate (D:20061218211720) /ModDate (D:20061218211720) /Title (R Graphics Output) /Producer (R 2.4.1) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 5 0 obj << /Type /Font /Subtype /Type1 /Name /F1 /BaseFont /ZapfDingbats >> endobj 6 0 obj << /Type /Page /Parent 3 0 R /Contents 7 0 R /Resources 4 0 R >> endobj 7 0 obj << /Length 8 0 R >> stream q Q q 59.04 73.44 378.72 335.52 re W n 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 70.10 164.14 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 74.54 166.20 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 78.98 164.41 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 83.42 165.75 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 87.86 161.13 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 92.30 160.36 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 96.74 160.11 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 101.18 160.08 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 105.62 163.97 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 110.05 157.73 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 114.49 161.26 Tm (l) Tj 0 Tr 1.000 0.000 0.000 rg 1.000 0.000 0.000 RG /F1 1 Tf 2 Tr 7.48 0 0 7.48 118.93 150.88 Tm (l) Tj 0 Tr 0.000 0.000 0.000 RG /F1 1 Tf 1 Tr 7.48 0 0 7.48 123.37 162.44 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 127.81 159.00 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 132.25 158.34 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 136.69 173.81 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 141.13 168.11 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 145.56 168.35 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 150.00 181.93 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 154.44 175.15 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 158.88 194.09 Tm (l) Tj 0 Tr 1.000 0.000 0.000 RG /F1 1 Tf 2 Tr 7.48 0 0 7.48 163.32 171.99 Tm (l) Tj 0 Tr 0.000 0.000 0.000 RG /F1 1 Tf 1 Tr 7.48 0 0 7.48 167.76 201.84 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 172.20 191.00 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 176.64 190.95 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 181.08 214.42 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 185.51 201.68 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 189.95 209.12 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 194.39 223.31 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 198.83 224.41 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 203.27 248.61 Tm (l) Tj 0 Tr 1.000 0.000 0.000 RG /F1 1 Tf 2 Tr 7.48 0 0 7.48 207.71 221.00 Tm (l) Tj 0 Tr 0.000 0.000 0.000 RG /F1 1 Tf 1 Tr 7.48 0 0 7.48 212.15 255.09 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 216.59 248.91 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 221.02 254.08 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 225.46 265.68 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 229.90 268.95 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 234.34 265.89 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 238.78 287.94 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 243.22 283.84 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 247.66 311.59 Tm (l) Tj 0 Tr 1.000 0.000 0.000 RG /F1 1 Tf 2 Tr 7.48 0 0 7.48 252.10 277.42 Tm (l) Tj 0 Tr 0.000 0.000 0.000 RG /F1 1 Tf 1 Tr 7.48 0 0 7.48 256.54 316.29 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 260.97 326.30 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 265.41 329.90 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 269.85 356.85 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 274.29 326.34 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 278.73 342.85 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 283.17 372.90 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 287.61 363.43 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 292.05 386.06 Tm (l) Tj 0 Tr 1.000 0.000 0.000 RG /F1 1 Tf 2 Tr 7.48 0 0 7.48 296.48 343.44 Tm (l) Tj 0 Tr 0.000 0.000 0.000 RG /F1 1 Tf 1 Tr 7.48 0 0 7.48 300.92 393.94 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 305.36 387.99 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 309.80 386.23 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 314.24 385.71 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 318.68 382.43 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 323.12 355.25 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 327.56 366.53 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 332.00 339.33 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 336.43 335.97 Tm (l) Tj 0 Tr 1.000 0.000 0.000 RG /F1 1 Tf 2 Tr 7.48 0 0 7.48 340.87 288.44 Tm (l) Tj 0 Tr 0.000 0.000 0.000 RG /F1 1 Tf 1 Tr 7.48 0 0 7.48 345.31 299.00 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 349.75 279.67 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 354.19 265.61 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 358.63 240.83 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 363.07 220.97 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 367.51 198.96 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 371.94 175.64 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 376.38 157.71 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 380.82 144.98 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 385.26 123.93 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 389.70 118.38 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 394.14 108.48 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 398.58 101.92 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 403.02 96.13 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 407.46 91.49 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 411.89 89.19 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 416.33 86.12 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 420.77 83.27 Tm (l) Tj 0 Tr ET Q q 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 73.07 73.44 m 428.17 73.44 l S 73.07 73.44 m 73.07 66.24 l S 161.84 73.44 m 161.84 66.24 l S 250.62 73.44 m 250.62 66.24 l S 339.40 73.44 m 339.40 66.24 l S 428.17 73.44 m 428.17 66.24 l S BT 0.000 0.000 0.000 rg /F2 1 Tf 12.00 0.00 -0.00 12.00 66.39 47.52 Tm (20) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 155.17 47.52 Tm (40) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 243.95 47.52 Tm (60) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 332.72 47.52 Tm (80) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 418.16 47.52 Tm (100) Tj ET 59.04 82.29 m 59.04 388.86 l S 59.04 82.29 m 51.84 82.29 l S 59.04 158.93 m 51.84 158.93 l S 59.04 235.58 m 51.84 235.58 l S 59.04 312.22 m 51.84 312.22 l S 59.04 388.86 m 51.84 388.86 l S BT /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 78.95 Tm (0) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 145.59 Tm (5000) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 218.90 Tm (10000) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 295.54 Tm (15000) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 372.18 Tm (20000) Tj ET 59.04 73.44 m 437.76 73.44 l 437.76 408.96 l 59.04 408.96 l 59.04 73.44 l S Q q BT 0.000 0.000 0.000 rg /F3 1 Tf 14.00 0.00 -0.00 14.00 93.98 433.45 Tm (Canada, males: Total deaths 1921-1940 by age) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 237.73 18.72 Tm (Age) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 12.96 208.90 Tm (Total deaths) Tj ET Q endstream endobj 8 0 obj 6282 endobj 3 0 obj << /Type /Pages /Kids [ 6 0 R ] /Count 1 /MediaBox [0 0 468 468] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font << /F1 5 0 R /F2 10 0 R /F3 11 0 R >> /ExtGState << >> >> endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 9 0 R >> endobj xref 0 12 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000006730 00000 n 0000006813 00000 n 0000000212 00000 n 0000000295 00000 n 0000000375 00000 n 0000006710 00000 n 0000006917 00000 n 0000007174 00000 n 0000007271 00000 n trailer << /Size 12 /Info 1 0 R /Root 2 0 R >> startxref 7373 %%EOF gnm/vignettes/fig-LCall.pdf0000744000176200001440000012720413152512335015277 0ustar liggesusers%PDF-1.1 % 1 0 obj << /Pages 3 0 R /Type /Catalog >> endobj 2 0 obj << /CreationDate (D:20061121121611) /Creator (R) /ModDate (D:20061121121611) /Producer (R 2.4.0) /Title (R Graphics Output) >> endobj 3 0 obj << /Count 1 /Kids [ 4 0 R ] /MediaBox [ 0 0 720 720 ] /Type /Pages >> endobj 4 0 obj << /Contents 5 0 R /Parent 3 0 R /Resources 6 0 R /Type /Page >> endobj 5 0 obj << /Length 43210 /Filter /FlateDecode >> stream xM$ɕ}~ _1  @*@"":G׎3w $q$y<EtuUS^=b3[k2>Yc럎r[=?=;C_ޜ~ǷLGtٛTe>S: K5Ⱥ1&[Muz!dR^/NJlך[_:Yzֳg=Yzֳg=Yϸ~Zrk v+)TcGLk/&#|Ȳn;S[\k6-8xzֳg=Yzֳg=YzֳR-l8+TpfbAnj_|LoiG- 6zv&ԼݴjRX6^:Yzֳg=Yzֳg=YO^[Hf 95po {g˯G2..Gvv|?~o~#뼕/W}5=v.o#6ne=7ɮQ>Wulqƕ# _cr=u^!ԟ;5k{j\_:Yzֳg=Yzֳg=Yϸ~Zrk o*zDZ:G/ hb=bz5[rRl~ti.%6^Yzֳg=Yzֳg=YzBj}Vm+|W&#"uh8F/ bJ;dr< %F˃{j.lZjwS_x}g=Yzֳg=Yzֳg=?zm!>|-l8+Tp6Sesuֳg=Yzֳg=Yzֳql!>|-l8+|/8k0VFL k/=ƘlxKBNIT|Qs}u6^Yzֳg=Yzֳg=YzBj}Vmgy·q ,g A޿t5ʗ~YpSe1&m 9a{j6oZ5qjKzg=Yzֳg=Yzֳg\-ևom+|Wlcӣ7!Q9cx˺1&N/QފөYʃ6^ߵYzֳg=Yzֳg=YzmM\,W6lAn[6uֳg=Yzֳg=YzֳtZ5m!gYm\ᧂsWLYvv{še/boMuGysQP{+ضD_2<ؗ.:˚8s_˘]6o˝9ƙUwLkq~4a:'#nq%;g|%ʗ%R׬H<=1- rXȞ_}^8gdz8Wo,;xcIƍuNmWr[5Q}]ƶ588s_ΐ.WX銵˝9H1},;xJ?'84gB9׬H<=1- rZȞ_}^t=UG=L[M#v3/N4f^ɚ$'d9ZV9xzWM3?<聾]t9?đrtIBȞ_}^դ`VR-ߧd_Us0#1'ϳ>6NɁ&}Ү_bӵDwq$%00000000000000000000]6R5k;s뙿+t.t__bY%Wi,;x>srUǕ}%rw{YZ58bOyK````````````````````|1C\m`+.w6<3W+nƵqs~dgj\eWz,&,t'lqK7Yk/53Y?đrtIBȞ_}^alٛUsg erz%%J?<-.F9cKM9o /fh TFgz?ݖW}^ے8$ϲrW,;xgS4fkj+,_)qEN_g!؏g!_XLk^bOlHyK````````````````````|1C\m`+.w6<3WSW\Mg}ƺfˮYK6IW9`JAn5#֬H<=1- r}[]ldyg>{Wq,;7+vєf8ؿWl_D Rojw1׬HlHyK````````````````````|9C\m`+.w6<3WSWLLG WmkܺSYM1pc^,kػ}b11y=#1- rXȞ_}^oO]qV'v Lk슽5wLc嘓k3(JvIJ%77X'%00000000000000000000] rugzw ) Mqkؗ]q0wMЖyIot{+ٷq~ƙ}+{)ai*&ĜƗ3Vbrg#{γ=y=uɄrhMvcXf8bX rIJ뉺%j`_ XLk^bOlHyK````````````````````|1C\m`+.w6<3W￿p?_~=6aGǭߏ_>|G%mIG=gy/`:r!|0g3mi}fB|sY~# - r}[]ldyg>m}}kGawqͲ]q<67o9yoܬJԶ%`/ћV׬H<=1- rXȞ_}^oO]q2j7<\Ŵf8XrGf=4Y%\~E\##1- rXȞ_}^aIη#,>0~EruJVx%O{)9{*&ĜƗ3Vbrg#{γ=y=uդ8N=&'GGYv+n&+cNbR+}nb&5/'.Qs_.WFgzw}}ծ؏3S4Yv+NrvHѕc]z%["u+N$(ְfGA9o /fh tFgzdf)|24h(5x]5g倎q߳s ΄y(Ҽ){ 9wUM9o /gH TFeV˚+*ޓAvre&e^oJM&-V˃}ob&5/MĜ3mu=뙿+EfdA4ѯYv+8y_9`}^|Wﭵ{(fGA,y[j+]v=ٿ??¢/}%GX|ha oYO_Ќ6嗋܃=g^YX 壉+˱ Wo0?KLM,Ɩ588s_ΐ.WX)˝9@dXܴ󪹚 K^⌍k7jnu1'J+-jUs36mb&5/'.Qs_.WFgz;0MHkKGq :'_vyeӯDRhw158bk_.WX銵˝9mJ;|m%FxfylHҿ\+,Iy܈^6G!DҧA fGA9o /gXX˝9t[r5A׿芫;,;x7ic[[<:Ǖnʖɸ1H}}/YőDMyK````````````````````|9C\m`$Ȟ_}^o:IzŴqct,;xW/wu>PgJd%r3} }őbvJW]ldyg>8fRq$s-&5^wYK6َcN~wO;j)K>Q>P5G9$EB ,ou՜sðꇣ^WZYΩ\%&)R֬&vQ: eh TFgzVAawF;g뮸Vnxޟ]*HIn^>ž[׬&Nq&t_͐.W7IH;s뙿+ے RWW1~fLt gy/;jM St|?Ysrb)=8ۗh.ښ(KԄ{kj+v=ٿ?精5Y獷)8$+=gy,G'[dRѶf"F)sUs.f5yO````````````````````|-C\m`j.w6<3W WծWفrƜe& L6u8Wj49mMx졯䶉}/֭YEML'00000000000000000000!]6o.w6<3W%d U ޖ Hiu^VޛqeԹo4֕L["SO׸D3%qyO````````````````````|-C\m`j.w6<3W>j/orn=[vR3GoMXYvz Ex=u^7k_x^Ƨv>hb^q{ȣ u^N>_zDu^/r總M:nuםl5h|:"?L[xǼ=倗-:oR>5=(&=yOD9teK'j%tnĜDwx')-H֤SyO9"}K%tĜD0u'q D+1='-(D&D0y'U%t>=SgJWX&=[B-]wۧ=L{B=噵[B-!ݺ}kA~#sK':o0~SJyO=-&D?_%tS&D{s[=~\hyK_B׼'o Do\[nO}{"<[B=L?9o~5]yO_M׼%t{"?j=a[B+lWO}{"cA{b|zqbcu%kI~u%z_X?0$q[(0}qm۾c懯?C/؇wvWma؇þ~鿮 ? B{cX~5p1[rːA9^Opm0~LNVvwm_,?cw}Vg$o/ǿ;? !yti:??_˿ؿG;]oП+_{y<`ʯ?~/>o揧[_֜/xGqD_5_c?~~o{z?IsGBg;gꞻ?|4VܿzGݼ7m]s'oMC׬H<=1-Y g6{.yug}X9$/mβ׽wSc7ʨFi}wJN^n!5Uaܿuiӡ##1- 饵M[{.}^;}H?%,;x{R?<)+ǜl2~q%bl;?UxU988sؐ^Zd齵9. ||Z ~ǧxEZ|1'мw8JT✓ynő쥵M~[lyvg>Sr0+&;H9^A8Q]V9"oAݸQaK#҃}$K&5/'6q$%000000000000000000000>{k/=s]+{'yDk#/;&5޻ ~srM"%J2=Kr̃(ώYőxKY&Kﭽlyvg>s݌MS7.㹖1,;x{swsN6 0WrȳW<~]YőđĆ&Kﭽlyvg>sL GJNZmA1Yv<1'׿r{W-Qzw;w׼Ğđ&Kﭽlyvg>s]偗)yOzrƕ5^vȣ9vcī{Wrv-Q݋sN}oIaKKĜƧ56mҳ]>%Ow__<4Q;&5^ީ_t,w{yJg[\MbkVq$Ğ&Kﭽlyvg>s)ceŤf;_XTre9[>-Q^b29<ͭYőx{b[Kk,ҳ]>%~wt;Y1iG%/=[g#y-VT׵y31e}8cN>lӺ]^}^b5obߋkVq$.Qsؐ^Z7IH/=s%͋rz316NOюV`_y&/W㙡:'Wo aK/X׭q8s^Zd͵9.ymܨͽ@mMG2@1έY<XI9('[Ww&-qDow1X׼Ğđ&Kml9k|6rym͋T)zŚ`,oumތ |qso=gz3WJ~Մ(fGA9o Okh/mg|Y3W陞}}6w/Ķf޻x=lu>'%?]cS; ?Px7+gŤ＿,eޜ z[>Tgiױz%*7_r>ַ>lvqu*&Ĝ'66Yzog|γK>y{lb,;/{bE0sMn7׽Wsrn_mXM(k^$.Q: jh/mKvg||Lң??&Yjs9;5xU'kMcA c}]1qD_wyDM'000000000000000000000>zimdҳ]>%e}oV?vLhkq/7Ys똔uDJrJn/1XU.JB=Y M[{.}^.. lLyZG &m ܛ;c~*'Y> 1{S8zfٮWZXw뜣?z쥿58bkذ~k/=s]+|g{3^>#9gJYe՚0~BgyԨl6ƕɴ=TR.:m918sؐ^Z7IH/=s]+{]4-Yv&#X9lh]侅DβݾDw1׼Ğđ&Kﭽlyvg>Otq%_Iry37З5x]gS䘺~S`U+%7VKaInKM9o Okh/mKvg|?.^M}s;iK1vsYB{+&9J̇Ͻw3?ŮY?x{b[Kkz.}^.^kgM*8i}}M!v(Eۗ}{,]tw]+)z%R}q&G58bmkp6Yvg|γK>y޷k=kv](|4Sܚ坿۳o̓u/_c@J=|^b2b1YőđĆ&K߮lyvg>(uͫ r3uf,oumwb*&[ü}^ɗQim^|^#qFHM~Dg|γK>y城C$}Gׄ(gYv^Xݬua%Ͻw1͏c&5^8=:T9"ս}\[">XMʏb kVq$ּ%000000000000000000000>mug|x-$ONi-`r^y&#f?9+69BJ~Vq&yUM9o OlH/mKvg|?. qz̦5^$R1'zwJUv%r-w1֬HlHyK`````````````````````|bCzim^z<3W.ri4,;x{VƜ\>d[-[(?<.6횗.ĜƧ56mҳ]>]+cRb6o)ϏI_>S4좿̇5xY'gZ:bIy:'V)>dֶD[/1]&5/'6q$%000000000000000000000>Rk/=s]+ڼRv?0X}{0'wMkwo_.1K@s+[-xebkVq$Ğ&K߮lyvg>,9ŏS3٭Yv&#o6cNǕ|+I^r{[Y# - 饵M[{.}^g}K1 qy(6MKvvg>9ǐq,y_ښe{qpz,8m,_ΣeJIJ%/і]L&5/і]9o Okh/mKvg|?Y qqeͲ׽wc1's"-/[/]&5/]9o Okh/mKvg|?T9ś,;x{glmܫsr^ɶC`f"GyDkbzKX# Ĝg5f/mg|γK>y~s&Ǘ~xxKbkVq$ĞĆ&Kmlyvg>}3InP޻,;x{9E~`1'LXn\!g"'S~X̾v֬HlHyK`````````````````````|bCzim^z<3Wn<3޻ͅ5^՚K&wW-ۗh.:ۚh.Ĝg5f/m$9.꽫7)d_u䕘qsr^f}wJļ%r5=ؗ.F8s^Zd齵9.) 9^X9ť+ǜuJل%r2ǽw\֬H<=1-i M[{.}^޻fR̦3ɮYvnxTLw\_tJ~9`4ڣX'%000000000000000000000>o9.꽛7.ɚ-,;x{ry%h|ʡ}]Ʀ588sؐ^Zd齵9.Z.ϱ;[,;x{ge嘥awWrx˕qrｓieq*&Ĝ'66Yzog|γK>y忽w|#{X?R|Pdߏ_u*?u<9x]7S!pƜl'{[W Lqmތ˗51y=q31-i M~[lyvg>vqY_ܑB4ɍDezliP1'[MIuK.豘z䴘9/'6q$%000000000000000000000>{k/=s]+{G|ߓ;(&5^8>+ǜ]Ǥ+eʖx`/1֬H<=1-i M[{.}^޻q~s҃9Yvn&UNv9hJ{W–H͸`_{%XfG51- 饵M~ҳ]>%Osy^)ye/{oM|c^ݖ}~4AĜUM9o OlH/maҳ]>%Ͻw41X拱~Ͳ׽Ĝ1uN}Cqvz%&ĕ+⏞k);ل%&ĜƧ56Yzog|Y3W.&#*owkܔ.LNNqWZTM%M{{bGb[Kkz.}^oo?,HƥVTS/=[gX qK&5xY{o<ə߲r̲8ouWZ6o1)ޙX)Yőx{b[Kk,ҳ]>%Ohluf;hsS[+_D*/n{QԜU'%000000000000000000000>óM[{i9%Ͻw1^L)kIrL[w9Iޝ^i^V^7{lzqq*&Ĝ'66Yzog|γK>yz`FiYvvfוcN>y{=R&=d9$|β׽w4UNqI1'o5ו+ýSDw1ּĞđ&Kﭽlyvg>sMi<09 MϜe{*GMucD29T/_"7?ŮYőx{b[Kk,ҳ]>%Ͻw3McY,ћ,;x{GϹ:&+--^5?MYőxk[쥵M~[lyvg>SqHo֏$Se{(˩-MW9jlJvUnI9;olbju*&Ĝ'66Yzog|γK>y{lB>u젚,;x{C7^)+ǜ|ZtJx%5j|Y{bGb[Kk,ҳ]>%~wt;Y둤c#EzjGvIN`~_Z9o[}cK 5z7ήY>E}qLɠsrٸC=l\Lq%NG:%&Ĝg5f/mg|γK>ynPsL N&TMkU[1'$2NY/[C>8XU'%000000000000000000000>{k/=s]+{7U}IA>g;[Z7ms9pWDn`{dD'7Y?đĆ&IBz.}^;{ܑ䀕qwpβ׽w0룳Y1JYNYŚqxfGbGb[Kk,ҳ]>%Ͻw'vԿ8;W,;x{gS3M1'Ms{k/=s]+{WR3>Yvn#2vv9&GǕYW-7]{51-i M~[lyvg>S]Q)yOz&5^eK|~]dM [D/ԃXښU5o Okh/mKvvg>sr9;Zb[uMtFƽ:˝qMWcg4S}G58bOyK`````````````````````|bCzim^z<3W2qq^vͲ׽wr>x|^DRv6ŕ589o OlH/m$9.꽫31)yI 5^՛"49EV9Z9M[y9|/] s^bOlHyK`````````````````````|ZC{im^z<3W>kVB?Mi:jZ:o IWb{"{d["8r'g:=Q垁-3?ӭyOּ%}n{">L=Q?9oܿ3?9yOOl{B~%tE7s&'`+?x%t^_w׿w|P^r/qk/?|n.-gcKM.mil ǥKBo.)Z]ol*${@sO:):o$RĜTUlM lzMmK0*5k<.7~_t_gn,o?`+o??~~_N&I#~Z#(VKS??CMU?t͟r̯~Yc?n54DM]{l6w L%Y~}Н0y,ؿW^YSϮ_vR7M^q{g=Yzֳg=Yzֳg=_?[T?f:5so ?1`eI3|Q}'O(7eBs&0A~Ғ:Yzֳg=Yzֳg=YzX/-֟oY[نq+|Wף:yQ?^u Vز^hYh>jw]iU:Yzֳg=Yzֳg=YzX/-֟rhhQgY~m\ᧂMǖ}ZJH  f3\]XPw8QY!eΪ+H6rGrnje,x/}F9z9 eXl;1Uwb.+o/k^zo^ʫK^|?}#rsĶ\y] N|'k='|ΙTŚVVqL܉5M`````````````````````1z&K=z.5c ~{gr{dw;5ݍW+}^K)+8&6qL̼M`````````````````````jjW^]c.rkI +h d{s_r;5vWo㉜kdҗ[.6fVqLl☘yxaCzim^z+.y_1{{k޵F\rO{oLi7SsQ:sVӾxw_wi~%cbme Mx[lwĭ>cbme M[{.5cMm}'kfb\Yy]sbVs=g×X"jWVQ'vQ&4jh/mKvȳK>yz_>ߒrnoV"y7?//o.Ro.5FmW>yp&ȗrSslrxTog%VVqL܉}bm 饵Mx[lIQ/YwjXN_u̩ʓyvMdaҷk/#.5xy39\*ƍk}ݮ,W4?M'̜ƍ+D.rRnL+/Q&NQ'4/j^zoG/g|_̫Z6n_*<јLh+x^G9\OvYv(0_)}mU^,ieubeB>&KmloEZ( W5f/=dg/Vyv5޻"w;'yleL+m̓`ɺlѹfV 9M~;w^m+oߩRGk;{#ϖ5pvN EN)+( xs68A9Ҩ+oD &QN],ƖUԉS Kk,ҳ]>쒏k^w5!hދ;g+x{7͙ǥl]/]_o&m";N_37OOf&[A _i?dB y5B8bwr\A4,WP.T'DQ:xci~K] y2q:yxUC{im^zG]1k|0Eb|]YyLy7^wjvޔy'|%v2n!=$ʽ*.ʄ}U M޻^zG]1k.ɓ jM,+<｛qZ}N 9]_֤M`\X6;Uԉ] ƫe&^zG]1ko?nK7{qoϗ՝qrw֯rO[/J6e[=H\WٰO<3o߭ܬiulmW\횾5p vrI/V/LN&[kk =y|e M#RZlQyc`mF;zZg᫽gK{_, :W+x^(W9TG.R9 jBNs T}ִom}^erߞ먯/߂aeOLKUq<χj|&|l=}= & TW{ZgK{_,r4 ~er2.Jdh۠,+\ hKQ~畺6 ZjO+=lik^r1Vr\A3٭,WP&[ی}{ . 8oƖ;VfToy}`ml5ɣ튫]׼Ưex9-zS埕:Z)eظ^mS&˥Ժ^iTooy@@@@@@@@@@@@@@@@@@@@n)|x )|go{׼?=0hZ( w476l56KWB Lr?dBqy}}w*h=Zȳ=yz(rcq6+hƕ 4{T5 {8WƓo}r1>o^CA4.3oߩ0^iNulmW\횾5Lnq7r}&?-3Zevw1_ s[yN/КfToy}`mf=*|go{׼?ӯo[2.OdM~Ǐobۢ/K_ezڹlBo06 RjO+==lik^_ﱝ:'C7 TSr+|?\Rt'/o|Ws377o ̼M |k6zԽ]quk!Po9G]<;pfOxwEklA}(u1 7gIdN捁 SоWkڏ7ha+h/yˁ=q"ORs,_yLM֌/cru.+ D %'Fnw*h=Zȳ=y ҷ!_&˭MomrδFet16J֘׾|!5)wyyY{jToyM |*Z^mmW\횾5jV/L&;nQk4J=D'K)uiF捁 ViNG-1kC.h缩zԺ\B9lo52NYk켫z"CmU}^J_8"gSkTooy@@@@@@@@@@@@@@@@@@@@n)|BY y5n䝏l5aI=_IV8';w_餫ۄ\Χ.KS ƫKk,ҳ]>쒏k^zh1"WPLL+<ｳq;SةVﭯTo>ߴ wI^neubeB>&Kﭽl&Ʉҳ]>쒏k^_?w;;ë3}䌗SV㜖L +?m͓7)?3g||_D˗.99|fuuB>G,쥵]>쒏k^w())W+x{'S9D6( JRI'f4.oy@@@@@@@@@@@@@@@@@@@@N-|BY y5Or1Y/IT~V+x^(WM6IY3,Y]_ɣ5?'=6ͤeuB>&^zG]1kǏljҌ_?GM"gy&̾۬+qHw^,yeubeB>&Kml';*,wCgVQ'NQ'4k^zR^Z#.5z6yr +n}~śW+x{,'TSG?sǃ:oDs)ڴ& 56M&g|_{l;I)YnYyMם.;5(뵏W r9QLr+/Ol☘yxYC{im^zG]1kCM{Ww&?Yy]-C4[X>^JK,&{ؕUwbyxYC{imnʫK^|zAޮ5T/3<3^h^k3q^C3ٟ޵'ŬVVVqL܉}bmUKkz.5k]qrvIYyMD;G=γ+Z kwy-bjue& 6\Ym޳vȳK>yz_U>ߒboV"Ez7{_~|y|6AnΦi_Ms+x^Vw?9k&͛+əw)ZUvy2q:yxUC{im6^zG]1k}!|vew8\<"'m"uf^b116쥵Mx[l/{䲲\;XknnJlr9ѯwذ~cb ί6M&g|_t齃&$ք4 W+x{ͥ1\IyLxMR-.F*M3o/ldG/W콓[*3<ｳ< GΑurt^a.焫&ݟr.b~%cbme M[{.yv5Oo?ko[2.OH/3?n?ҙ>|[7t3x^7ӤϦGͣo]_ 4Mx/nbv%:16&^zG]1kvMu ,WvAjvW>PsL׮Xc Mn/ћVVqL܉M`````````````````````1z&K=z.5c/Fv`new6!vPΑ}sy~N$;vbVWVqL܉}bm 饵M[{.yv5޻J qPڕ $9O</vNxKy-mbWVVqLN̼M`````````````````````j?dڣ]^yuk;'rO{o9JwM'kR?48G֝7fד<\q_r~>n-7ZyGփ3a|4Ѹyf>kףcx2dc]4s}}=˩Gz_q_fz_mfi֋?n;5Ӹ_fKьz5e|4n͙}>dh׫ \q_rչ>^Lۺsƞߌz4n#E|{+{k׃i[q_/m}m=ק4㾞_fӌzc]㾞ϵ&#n˷Ǻ}=}>jZGֳ7n4ɄӸWO^|[rkףq_򟡝#n}~4^_f֛}q_O3xۿ پҸoC>⾞.x>Xu8\q_E߹>ⶾx|yoM?_|nt$w׼uc_ɾ1|F/M;coawo`sۙmGwF'woٿP;۷ R_/}D~aV}\ߨ.a|;;ҹ*cUӹׇ-zE͟PtϸeOmDσs}ٵOn_C+od7f'w}wb<ʪS;3>m͍"G)27Ⱥb~?>O(e+𗐾WMs]ҿ_7ݲU)'SQ7+ʹVn05;zV=Ff&Oa~wG-1k~iU-؛՟ȆWCQϗrZ측j<-$5}eC-rg3J)}Dra; 75`??ӨX߼106 RjO+}=lik^VƷL1qf[]6qz%GϽ mav^J X?ҨX߼106 RjO+=lik^rCm6.1qA7)^ SogK{_(\nN2`T 1T[dyvzEnD,rAN8({c`m;՞V e-|go{׼ d3BO,WP.ruOs#:z䤋s" r;Xʌ;̼M |Jm<[cc܌M4ver&[ ƍ&Z8CyiH}ȋ݁-ϨXw+H=*|go{׼ س_ԺMK.y-b4.NNh'000000000000000000000^א^Zd齵g|_콓(xr{l.}DysmHhO6o`1!θ~iIaӁ TW{ڏUQ[cCW;5P& ʩ0Xtg؍Ju&m")wzx?zc3oߩR(k;{#ϖ5~u7w{M~|KrʆYlm5?n?RF>|wQV+bRZY>:_n%S13:z8޺Rq~ɑ)VVQ'vQ&4jh/mKvȳK>yCmlWjj+lM+x^7j8d+J&L%M*! Kk&Kv},q&:ki2_ i~ew&KmcMG+Zc6Q4}b0>cbme M[{.yv5;$Otr\Ag+x{'Sc7d;vj+V__.w%Hۧ.y}bKk,ҳ]>쒏k^w٥$/+(VSYy݌ *WnR뵏Wm| ^eeĝ'f&000000000000000000000^^Z䏷KvȳK>y?}R.{9'%V+x{/GHƵ+͍(qr齋3ދ5NLh'000000000000000000000^^Zd齵g|_콣qrR uew2QOqч~)xL+ۄ~>]ƕU8&f&000000000000000000000^pa{k/=#5޻ϱzw3,Wr\ 4ݩ99y^x`j&J0>絴cb m޳vȳK>y?ʁ&Nn Xyewuqgxw{ҒIDrnKM+/Q&NQ'4jh/mg|%׼?ӯo[K7?"ěsոx{ǏKgEn.&kmedfyimv9켍jfJ-rG9rmM"f^LNh'000000000000000000000^^Zd͵g|_zm^iZ11}CmM{ċI$L+x^Wmb9+6/0;{{ڕUwbyxYC{im6^zG]1kᔕfhFi1,Wn΄4w7K>:__B*:s޻VVQ'vQ&4kH/mg|%׼vfB_v[0^7ord_Yހ}ZGyr9+ZS6ߑKwiv,3cb 6Yjsg|%׼oRRf[Yy]L?WsY>^﷉% ޻v]3/Ol☘yxYC{im^zG]1kn&%9<پnW+x{'kM79%Ss9*^SuQ>& 5V/mg|%׼~LJKcRW916&KmlW^]czxsߙT)g+x{8nd\|}#XVvYO WVqL܉}bm W,W5w3^Y錕+pΔ\Y*N5yʵ+>&9!ӝ}^KM +1&6qL̼M`````````````````````!o2!lW^]cAD1|fw0hq7C3Џ \nM+/Ol☘yxYcҳM{ҫ]^yuk;$d9e\W+x{g!]m&Α儕f+ɽ&;}b[y>☘yxYcңM{.yv5>S/)eٿ|cV xp'3xZ{+x?vjne=Ps3՝>ܝjf]Y?1q' 5F/=䏷Kvy%k>n]>W+O{ kT9Ƶ+d'!g{ݽX*;O̼M`````````````````````1z&K=~W콓<,s_Lq+<ｳqndoϣ+u< M>],ƖU8&f&000000000000000000000^ؐ^Zd齵g|_콫 &t0SYyLC`ܲ.>8eޫ>_Iy<3Tkimcubm 饵Mx g|%׼zLŭDy"rO{M;lg7Stui%M3o/k^z{^zoGO]ccN wb|]Yyu7W޺bkDHrI$܉9☸Kk,ҳ]>r.5{ƣ5,Wnrr'ykN_~;IK&{Uԉ] ƫKkz.yv5Oo?o[2.OdCoN$yǏKg{8ɻy09,oim d̝MiD^KU8&f&000000000000000000000^h6G]1kvM`YljZYyLifxfi䌍ۄo}r&f*M3o/lH/mKvȳK>yv8鋗+.}t<쒏k^޼j+H\;9R7M#{ۿv}Eލy>'_}~slf^b116&KﭽlK>y?r.dr{$G94e2_dMkZK]Y1q' 56Yzog|%׼{blyFsf[Yy]M7WTsdoIWZ4n_Rk^leeĝ'f&000000000000000000000^ؐ^Zd齵g|_轳5^ΦyK,W$9Ś쒏k^w6߼/&56r{b年F6wQzJK'ωhSyܤ>& 56Yzog|%׼{&7v{WP yewq).qfo+!D;{t/cN,amUKkz.yv5Oo?o[ެD6~iqoϗG] $QHw՛1o,pN#;˝ ܉ͯ☸ Kk,ҳ]>쒏k^,~^)qew1t9#^fvބJrB9!}^K Xs+ 5\[mKvȳK>yvy⥘vfB|3yRlYڼZ '&>_ M9'G)Z'm%M3oj^Z7^zG]1kj:#ޤo8e1GOHrT9%NͭG+>zyLxLOѻ]&֕'6qL̼M`````````````````````1z&Km>z.5kiMjd<3I-o{Yڼ=qmf)pJr〙c"۝lsYY1q'6&Kmly?'ᴦ(r{`99EOzo}%69qMt~-b46116†&Kﭽl쒏k^_?Ei}fxVM8(d-+x^7S͵ /o}+o>EO1[kbXy.✘yxYC{im?V/=#.5]\9-Frzlij59#{[ӝr;͡e=] &'6qL̼M`````````````````````{k/=#.5{Gw]E)e\A11,WƕI.Yv;v}%;!Ή;VVqL܉}bme M[{.yv5޻1*nΚW+x{79yUg[+ry焜?Mb*Sԉ 6l[mǛLx+.y_1{;g|yMs aewIicbme M^{.yv5ԋr{new5-\ &jc+>9;.SmIe%M3o/k^zoG/ʫK^|?}˼rO{ocghoGnGﭯ茋EK%:X*;䕷 5F/=dG/W콣Z0M TW+x{'::k kxLm焷A6r/cNlim 饵M[{.5$a`qǃbcQx͔y;]pN٩VWtb o_|gwɟ̬116†&KmlW^]cv`Mt:ni޴\;8ͥj|;5bܼ^_#W;'Si ~%M3o/kh/mǛLH/=W콃N'wdi|fwj09s&^_#7O]L&. 56Yzog5w6Ex0Y>쒏k^w KW:3IWr{hb-3fg?_i}ZӾxv:q:yx]Õ&Kﭽl1ueykb9׌]s(rܹu}%G9?(%fX*.ʄ}U M\{.yv5o_%&^"GTƃC3,oim r+5u|83$o}RxD6o7O̬NNh'000000000000000000000^א^Z7^zG]1kpMy?D9%ʽrش\;Rnz٩;ֵ+ﶉ;vȓAg^LNh'000000000000000000000^^Zd齵g|_콫ukW+x{7r7/r(LrDj빛޻7XKC W56mҳ]>쒏k^w_q\A4ѯ,WR%Nͱhc^iZ6Q);Uԉ] ƫKk,ҳ]>쒏k^w_{ V+x{g$O٩9:ֵW&m6)wbVWVqL܉}bm 饵M[{.yv5޻J;5ծ,WnM쒏k^~~WwsϷ$؛՟H%lb~}ll~82i`Z[YӺzEkl;5dBЏL_>G5BRu[w1W^b116&Kݮl@G׋<1\q[7kzR\q_o':z ౮q_`s}}?zh׫qq[o΄ѸGG^L>z}|fףqn[q_/ s}mg}=/ zuo忓95A,\q_ >Lzn}=QXz}q[~i}=>͸WSG!oq_8G׫qgghף)q_/mi֋3v4wӸss}m]~>?z0u4Eq74_fӌz}\O?5Y\q_o-ɹ>I3㾞Lz5-l#nw~~3IrW~\q[ z4u4ӸGgiӌz}q[Ovi}=>͸?\q[+a|4An9G7$q_9Gxͱq_g#mQ|Nh&n.oD˞ }o^ǿ`s}+[OMbQ:N6?+7~Sdߟz2;9xBF?̅c1^0[?}?m }twP}][So}?/>BKoZX18'Ck^~/|endstream endobj 6 0 obj << /ExtGState << >> /Font << /F1 7 0 R /F2 8 0 R /F3 9 0 R >> /ProcSet [ /PDF /Text ] >> endobj 7 0 obj << /BaseFont /ZapfDingbats /Name /F1 /Subtype /Type1 /Type /Font >> endobj 8 0 obj << /BaseFont /Helvetica /Encoding 10 0 R /Name /F2 /Subtype /Type1 /Type /Font >> endobj 9 0 obj << /BaseFont /Helvetica-Bold /Encoding 10 0 R /Name /F3 /Subtype /Type1 /Type /Font >> endobj 10 0 obj << /BaseEncoding /WinAnsiEncoding /Differences [ 45 /minus 96 /quoteleft 144 /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space ] /Type /Encoding >> endobj xref 0 11 0000000000 65535 f 0000000015 00000 n 0000000064 00000 n 0000000206 00000 n 0000000291 00000 n 0000000371 00000 n 0000043654 00000 n 0000043758 00000 n 0000043841 00000 n 0000043938 00000 n 0000044040 00000 n trailer << /Info 2 0 R /Root 1 0 R /Size 11 /ID [<65afc89bde22018dca44f46b641d2111><65afc89bde22018dca44f46b641d2111>] >> startxref 44302 %%EOF gnm/vignettes/gnmOverview.Rnw0000744000176200001440000037613313544666014016072 0ustar liggesusers%\VignetteIndexEntry{Generalized nonlinear models in R: An overview of the gnm package} %\VignetteKeywords{Generalized Nonlinear Models} %\VignettePackage{gnm} \documentclass[a4paper]{article} \usepackage[english]{babel} % to avoid et~al with texi2pdf \usepackage{Sweave} %\usepackage{alltt} % now replaced by environments Sinput, Soutput, Scode \usepackage{amsmath} %\usepackage{times} %\usepackage[scaled]{couriers} \usepackage{txfonts} % Times, with Belleek math font and txtt for monospaced \usepackage[scaled=0.92]{helvet} %\usepackage[T1]{fontenc} %\usepackage[expert,altbullet,lucidasmallerscale]{lucidabr} \usepackage{booktabs} \usepackage[round,authoryear]{natbib} \usepackage[left=2cm,top=2.5cm,nohead]{geometry} \usepackage{hyperref} \usepackage{array} % for paragraph columns in tables %\usepackage{moreverb} \setkeys{Gin}{width=0.6\textwidth} %% The next few definitions from "Writing Vignettes for Bioconductor Packages" %% by R Gentleman \newcommand{\Robject}[1]{{\emph{\texttt{#1}}}} \newcommand{\Rfunction}[1]{{\emph{\texttt{#1}}}} \newcommand{\Rcode}[1]{{\emph{\texttt{#1}}}} \newcommand{\Rpackage}[1]{{\textsf{#1}}} \newcommand{\Rclass}[1]{{\emph{#1}}} \newcommand{\Rmethod}[1]{{\emph{\texttt{#1}}}} \newcommand{\Rfunarg}[1]{{\emph{\texttt{#1}}}} \newcommand{\R}{\textsf{R}} \newcommand\twiddle{{\char'176}} %\setlength{\oddsidemargin}{0.5in} %\setlength{\evensidemargin}{0.5in} %\setlength{\textwidth}{5.5in} \setlength{\itemindent}{1cm} \title{Generalized nonlinear models in \R: An overview of the \Rpackage{gnm} package} \author{Heather Turner and David Firth\footnote{ This work was supported by the Economic and Social Research Council (UK) through Professorial Fellowship RES-051-27-0055.}\\ \emph{University of Warwick, UK} } \date{For \Rpackage{gnm} version \Sexpr{packageDescription("gnm")[["Version"]]} , \Sexpr{Sys.Date()}} \begin{document} \maketitle {\small \tableofcontents } <>= options(SweaveHooks = list(eval = function() options(show.signif.stars = FALSE))) @ \section{Introduction} The \Rpackage{gnm} package provides facilities for fitting \emph{generalized nonlinear models}, i.e., regression models in which the link-transformed mean is described as a sum of predictor terms, some of which may be non-linear in the unknown parameters. Linear and generalized linear models, as handled by the \Rfunction{lm} and \Rfunction{glm} functions in \R, are included in the class of generalized nonlinear models, as the special case in which there is no nonlinear term. This document gives an extended overview of the \Rpackage{gnm} package, with some examples of applications. The primary package documentation in the form of standard help pages, as viewed in \R\ by, for example, \Rcode{?gnm} or \Rcode{help(gnm)}, is supplemented rather than replaced by the present document. We begin below with a preliminary note (Section \ref{sec:glms}) on some ways in which the \Rpackage{gnm} package extends \R's facilities for specifying, fitting and working with generalized \emph{linear} models. Then (Section \ref{sec:nonlinear} onwards) the facilities for nonlinear terms are introduced, explained and exemplified. The \Rpackage{gnm} package is installed in the standard way for CRAN packages, for example by using \Rfunction{install.packages}. Once installed, the package is loaded into an \R\ session by <>= library(gnm) @ \section{Generalized linear models} \label{sec:glms} \subsection{Preamble} Central to the facilities provided by the \Rpackage{gnm} package is the model-fitting function \Rfunction{gnm}, which interprets a model formula and returns a model object. The user interface of \Rfunction{gnm} is patterned after \Rfunction{glm} (which is included in \R's standard \Rpackage{stats} package), and indeed \Rfunction{gnm} can be viewed as a replacement for \Rfunction{glm} for specifying and fitting generalized linear models. In general there is no reason to prefer \Rfunction{gnm} to \Rfunction{glm} for fitting generalized linear models, except perhaps when the model involves a large number of incidental parameters which are treatable by \Rfunction{gnm}'s \emph{eliminate} mechanism (see Section \ref{sec:eliminate}). While the main purpose of the \Rpackage{gnm} package is to extend the class of models to include nonlinear terms, some of the new functions and methods can be used also with the familiar \Rfunction{lm} and \Rfunction{glm} model-fitting functions. These are: three new data-manipulation functions \Rfunction{Diag}, \Rfunction{Symm} and \Rfunction{Topo}, for setting up structured interactions between factors; a new \Rclass{family} function, \Rfunction{wedderburn}, for modelling a continuous response variable in $[0,1]$ with the variance function $V(\mu) = \mu^2(1-\mu)^2$ as in \citet{Wedd74}; and a new generic function \Rfunction{termPredictors} which extracts the contribution of each term to the predictor from a fitted model object. These functions are briefly introduced here, before we move on to the main purpose of the package, nonlinear models, in Section \ref{sec:nonlinear}. \subsection{\Rfunction{Diag} and \Rfunction{Symm}} When dealing with \emph{homologous} factors, that is, categorical variables whose levels are the same, statistical models often involve structured interaction terms which exploit the inherent symmetry. The functions \Rfunction{Diag} and \Rfunction{Symm} facilitate the specification of such structured interactions. As a simple example of their use, consider the log-linear models of \emph{quasi-independence}, \emph{quasi-symmetry} and \emph{symmetry} for a square contingency table. \citet{Agre02}, Section 10.4, gives data on migration between regions of the USA between 1980 and 1985: <>= count <- c(11607, 100, 366, 124, 87, 13677, 515, 302, 172, 225, 17819, 270, 63, 176, 286, 10192 ) region <- c("NE", "MW", "S", "W") row <- gl(4, 4, labels = region) col <- gl(4, 1, length = 16, labels = region) @ The comparison of models reported by Agresti can be achieved as follows: <>= independence <- glm(count ~ row + col, family = poisson) quasi.indep <- glm(count ~ row + col + Diag(row, col), family = poisson) symmetry <- glm(count ~ Symm(row, col), family = poisson) quasi.symm <- glm(count ~ row + col + Symm(row, col), family = poisson) comparison1 <- anova(independence, quasi.indep, quasi.symm) print(comparison1, digits = 7) comparison2 <- anova(symmetry, quasi.symm) print(comparison2) @ The \Rfunction{Diag} and \Rfunction{Symm} functions also generalize the notions of diagonal and symmetric interaction to cover situations involving more than two homologous factors. \subsection{\Rfunction{Topo}} More general structured interactions than those provided by \Rfunction{Diag} and \Rfunction{Symm} can be specified using the function \Rfunction{Topo}. (The name of this function is short for `topological interaction', which is the nomenclature often used in sociology for factor interactions with structure derived from subject-matter theory.) The \Rfunction{Topo} function operates on any number ($k$, say) of input factors, and requires an argument named \Rfunarg{spec} which must be an array of dimension $L_1 \times \ldots \times L_k$, where $L_i$ is the number of levels for the $i$th factor. The \Rfunarg{spec} argument specifies the interaction level corresponding to every possible combination of the input factors, and the result is a new factor representing the specified interaction. As an example, consider fitting the `log-multiplicative layer effects' models described in \citet{Xie92}. The data are 7 by 7 versions of social mobility tables from \citet{Erik82}: <>= ### Collapse to 7 by 7 table as in Erikson et al. (1982) erikson <- as.data.frame(erikson) lvl <- levels(erikson$origin) levels(erikson$origin) <- levels(erikson$destination) <- c(rep(paste(lvl[1:2], collapse = " + "), 2), lvl[3], rep(paste(lvl[4:5], collapse = " + "), 2), lvl[6:9]) erikson <- xtabs(Freq ~ origin + destination + country, data = erikson) @ From sociological theory --- for which see \citet{Erik82} or \citet{Xie92} --- the log-linear interaction between origin and destination is assumed to have a particular structure: \begin{Sinput} > levelMatrix <- matrix(c(2, 3, 4, 6, 5, 6, 6, + 3, 3, 4, 6, 4, 5, 6, + 4, 4, 2, 5, 5, 5, 5, + 6, 6, 5, 1, 6, 5, 2, + 4, 4, 5, 6, 3, 4, 5, + 5, 4, 5, 5, 3, 3, 5, + 6, 6, 5, 3, 5, 4, 1), 7, 7, byrow = TRUE) \end{Sinput} The models of table 3 of \citet{Xie92} can now be fitted as follows: \begin{Sinput} > ## Null association between origin and destination > nullModel <- gnm(Freq ~ country:origin + country:destination, + family = poisson, data = erikson, verbose = FALSE) > > ## Interaction specified by levelMatrix, common to all countries > commonTopo <- update(nullModel, ~ . + + Topo(origin, destination, spec = levelMatrix), + verbose = FALSE) > > ## Interaction specified by levelMatrix, different multiplier for each country > multTopo <- update(nullModel, ~ . + + Mult(Exp(country), Topo(origin, destination, spec = levelMatrix)), + verbose = FALSE) > > ## Interaction specified by levelMatrix, different effects for each country > separateTopo <- update(nullModel, ~ . + + country:Topo(origin, destination, spec = levelMatrix), + verbose = FALSE) > > anova(nullModel, commonTopo, multTopo, separateTopo) \end{Sinput} \begin{Soutput} Analysis of Deviance Table Model 1: Freq ~ country:origin + country:destination Model 2: Freq ~ Topo(origin, destination, spec = levelMatrix) + country:origin + country:destination Model 3: Freq ~ Mult(country, Topo(origin, destination, spec = levelMatrix)) + country:origin + country:destination Model 4: Freq ~ country:origin + country:destination + country:Topo(origin, destination, spec = levelMatrix) Resid. Df Resid. Dev Df Deviance 1 108 4860.0 2 103 244.3 5 4615.7 3 101 216.4 2 28.0 4 93 208.5 8 7.9 \end{Soutput} Here we have used \Rfunction{gnm} to fit all of these log-link models; the first, second and fourth are log-linear and could equally well have been fitted using \Rfunction{glm}. \subsection{The \Rfunction{wedderburn} family} In \citet{Wedd74} it was suggested to represent the mean of a continuous response variable in $[0,1]$ using a quasi-likelihood model with logit link and the variance function $\mu^2(1-\mu)^2$. This is not one of the variance functions made available as standard in \R's \Rfunction{quasi} family. The \Rfunction{wedderburn} family provides it. As an example, Wedderburn's analysis of data on leaf blotch on barley can be reproduced as follows: <>= ## data from Wedderburn (1974), see ?barley logitModel <- glm(y ~ site + variety, family = wedderburn, data = barley) fit <- fitted(logitModel) print(sum((barley$y - fit)^2 / (fit * (1-fit))^2)) @ This agrees with the chi-squared value reported on page 331 of \citet{McCu89}, which differs slightly from Wedderburn's own reported value. \subsection{\Rfunction{termPredictors}} \label{sec:termPredictors} The generic function \Rfunction{termPredictors} extracts a term-by-term decomposition of the predictor function in a linear, generalized linear or generalized nonlinear model. As an illustrative example, we can decompose the linear predictor in the above quasi-symmetry model as follows: <>= print(temp <- termPredictors(quasi.symm)) rowSums(temp) - quasi.symm$linear.predictors @ Such a decomposition might be useful, for example, in assessing the relative contributions of different terms or groups of terms. \section{Nonlinear terms} \label{sec:nonlinear} The main purpose of the \Rpackage{gnm} package is to provide a flexible framework for the specification and estimation of generalized models with nonlinear terms. The facility provided with \Rfunction{gnm} for the specification of nonlinear terms is designed to be compatible with the symbolic language used in \Rclass{formula} objects. Primarily, nonlinear terms are specified in the model formula as calls to functions of the class \Rclass{nonlin}. There are a number of \Rclass{nonlin} functions included in the \Rpackage{gnm} package. Some of these specify simple mathematical functions of predictors: \Rfunction{Exp}, \Rfunction{Mult}, and \Rfunction{Inv}. %\Rfunction{Log}, \Rfunction{Raise} (to raise to a constant power), and \Rfunction{Logit}. Others specify more specialized nonlinear terms, in particular \Rfunction{MultHomog} specifies homogeneous multiplicative interactions and \Rfunction{Dref} specifies diagonal reference terms. Users may also define their own \Rclass{nonlin} functions. \subsection{Basic mathematical functions of predictors} \label{sec:Basic} Most of the \Rclass{nonlin} functions included in \Rpackage{gnm} are basic mathematical functions of predictors: \begin{description} \setlength{\itemindent}{-0.5cm} \item[\Rfunction{Exp}:] the exponential of a predictor \item[\Rfunction{Inv}:] the reciprocal of a predictor %\item[\Rfunction{Log}:] the natural logarithm of a predictor %\item[\Rfunction{Logit}:] the logit of a predictor \item[\Rfunction{Mult}:] the product of predictors %\item[\Rfunction{Raise}:] a predictor raised to a constant power \end{description} Predictors are specified by symbolic expressions that are interpreted as the right-hand side of a \Rclass{formula} object, except that an intercept is \textbf{not} added by default. The predictors may contain nonlinear terms, allowing more complex functions to be built up. For example, suppose we wanted to specify a logistic predictor with the same form as that used by \Rfunction{SSlogis} (a selfStart model for use with \Rfunction{nls} --- see section~\ref{sec:gnmVnls} for more on \Rfunction{gnm} vs.\ \Rfunction{nls}): \[\frac{\text{Asym}}{1 + \exp((\text{xmid} - x)/\text{scal})}.\] This expression could be simplified by re-parameterizing in terms of xmid/scal and 1/scal, however we shall continue with this form for illustration. We could express this predictor symbolically as follows \begin{Scode} ~ -1 + Mult(1, Inv(Const(1) + Exp(Mult(1 + offset(-x), Inv(1))))) \end{Scode} where \Rfunction{Const} is a convenience function to specify a constant in a \Rclass{nonlin} term, equivalent to \Rcode{offset(rep(1, nObs))} where \Robject{nObs} is the number of observations. However, this is rather convoluted and it may be preferable to define a specialized \Rclass{nonlin} function in such a case. Section \ref{sec:nonlin.functions} explains how users can define custom \Rclass{nonlin} functions, with a function to specify logistic terms as an example. One family of models usefully specified with the basic functions is the family of models with multiplicative interactions. For example, the row-column association model \[ \log \mu_{rc} = \alpha_r + \beta_c + \gamma_r\delta_c, \] also known as the Goodman RC model \citep{Good79}, would be specified as a log-link model (for response variable \Robject{resp}, say), with formula \begin{Scode} resp ~ R + C + Mult(R, C) \end{Scode} where \Robject{R} and \Robject{C} are row and column factors respectively. In some contexts, it may be desirable to constrain one or more of the constituent multipliers\footnote{ A note on terminology: the rather cumbersome phrase `constituent multiplier', or sometimes the abbreviation `multiplier', will be used throughout this document in preference to the more elegant and standard mathematical term `factor'. This will avoid possible confusion with the completely different meaning of the word `factor' --- that is, a categorical variable --- in \R. } in a multiplicative interaction to be nonnegative . This may be achieved by specifying the multiplier as an exponential, as in the following `uniform difference' model \citep{Xie92, Erik92} \[ \log \mu_{rct} = \alpha_{rt} + \beta_{ct} + e^{\gamma_t}\delta_{rc}, \] which would be represented by a formula of the form \begin{Scode} resp ~ R:T + C:T + Mult(Exp(T), R:C) \end{Scode} \subsection{\Rfunction{MultHomog}} \Rfunction{MultHomog} is a \Rclass{nonlin} function to specify multiplicative interaction terms in which the constituent multipliers are the effects of two or more factors and the effects of these factors are constrained to be equal when the factor levels are equal. The arguments of \Rfunction{MultHomog} are the factors in the interaction, which are assumed to be objects of class \Rclass{factor}. As an example, consider the following association model with homogeneous row-column effects: \[\log \mu_{rc} = \alpha_r + \beta_c + \theta_{r}I(r=c) + \gamma_r\gamma_c.\] To fit this model, with response variable named \Robject{resp}, say, the formula argument to \Rfunction{gnm} would be \begin{Scode} resp ~ R + C + Diag(R, C) + MultHomog(R, C) \end{Scode} If the factors passed to \Rfunction{MultHomog} do not have exactly the same levels, a common set of levels is obtained by taking the union of the levels of each factor, sorted into increasing order. \subsection{\Rfunction{Dref}} \label{sec:Dref function} \Rfunction{Dref} is a \Rclass{nonlin} function to fit diagonal reference terms \citep{Sobe81, Sobe85} involving two or more factors with a common set of levels. A diagonal reference term comprises an additive component for each factor. The component for factor $f$ is given by \[ w_f\gamma_l \] for an observation with level $l$ of factor $f$, where $w_f$ is the weight for factor $f$ and $\gamma_l$ is the ``diagonal effect'' for level $l$. The weights are constrained to be nonnegative and to sum to one so that a ``diagonal effect'', say $\gamma_l$, is the value of the diagonal reference term for data points with level $l$ across the factors. \Rfunction{Dref} specifies the constraints on the weights by defining them as \[ w_f = \frac{e^{\delta_f}}{\sum_i e^{\delta_i}} \] where the $\delta_f$ are the parameters to be estimated. Factors defining the diagonal reference term are passed as unspecified arguments to \Rfunction{Dref}. For example, the following diagonal reference model for a contingency table classified by the row factor \Robject{R} and the column factor \Robject{C}, \[ \mu_{rc} =\frac{e^{\delta_1}}{e^{\delta_1} + e^{\delta_2}}\gamma_r + \frac{e^{\delta_2}}{e^{\delta_1} + e^{\delta_2}}\gamma_c, \] would be specified by a formula of the form \begin{Scode} resp ~ -1 + Dref(R, C) \end{Scode} The \Rfunction{Dref} function has one specified argument, \Rfunarg{delta}, which is a formula with no left-hand side, specifying the dependence (if any) of $\delta_f$ on covariates. For example, the formula \begin{Scode} resp ~ -1 + x + Dref(R, C, delta = ~ 1 + x) \end{Scode} specifies the generalized diagonal reference model \[ \mu_{rci} = \beta x_i + \frac{e^{\xi_{01} + \xi_{11}x_i}}{e^{\xi_{01} + \xi_{11}x_i} + e^{\xi_{02} + \xi_{12}x_i}}\gamma_r + \frac{e^{\xi_{02} + \xi_{12}x_i}}{e^{\xi_{01} + \xi_{11}x_i} + e^{\xi_{02} + \xi_{12}x_i}}\gamma_c. \] The default value of \Rfunarg{delta} is \Robject{\twiddle 1}, so that constant weights are estimated. The coefficients returned by \Rfunction{gnm} are those that are directly estimated, i.e. the $\delta_f$ or the $\xi_{.f}$, rather than the implied weights $w_f$. However, these weights may be obtained from a fitted model using the \Rfunction{DrefWeights} function, which computes the corresponding standard errors using the delta method. \subsection{\Rfunction{instances}} \label{sec:instances} Multiple instances of a linear term will be aliased with each other, but this is not necessarily the case for nonlinear terms. Indeed, there are certain types of model where adding further instances of a nonlinear term is a natural way to extend the model. For example, Goodman's RC model, introduced in section \ref{sec:Basic} \[ \log \mu_{rc} = \alpha_r + \beta_c + \gamma_r\delta_c, \] is naturally extended to the RC(2) model, with a two-component interaction \[ \log \mu_{rc} = \alpha_r + \beta_c + \gamma_r\delta_c + \theta_r\phi_c. \] Currently all of the \Rclass{nonlin} functions in \Rpackage{gnm} except \Rpackage{Dref} have an \Rfunarg{inst} argument to allow the specification of multiple instances. So the RC(2) model could be specified as follows \begin{Scode} resp ~ R + C + Mult(R, C, inst = 1) + Mult(R, C, inst = 2) \end{Scode} The convenience function \Rfunction{instances} allows multiple instances of a term to be specified at once \begin{Scode} resp ~ R + C + instances(Mult(R, C), 2) \end{Scode} The formula is expanded by \Rfunction{gnm}, so that the instances are treated as separate terms. The \Rfunction{instances} function may be used with any function with an \Rfunarg{inst} argument. \subsection{Custom \Rclass{nonlin} functions} \label{sec:nonlin.functions} \subsubsection{General description} Users may write their own \Rclass{nonlin} functions to specify nonlinear terms which can not (easily) be specified using the \Rclass{nonlin} functions in the \Rpackage{gnm} package. A function of class \Rclass{nonlin} should return a list of arguments for the internal function \Rfunction{nonlinTerms}. The following arguments must be specified in all cases: \begin{description} \setlength{\itemindent}{-0.5cm} \item[\Robject{predictors}:] a list of symbolic expressions or formulae with no left hand side which represent (possibly nonlinear) predictors that form part of the term. \item[\Robject{term}:] a function that takes the arguments \Rfunarg{predLabels} and \Rfunarg{varLabels}, which are labels generated by \Rfunction{gnm} for the specified predictors and variables (see below), and returns a deparsed mathematical expression of the nonlinear term. Only functions recognised by \Rfunction{deriv} should be used in the expression, e.g. \Rfunction{+} rather than \Rfunction{sum}. \end{description} If predictors are named, these names are used as a prefix for parameter labels or as the parameter label itself in the single-parameter case. The following arguments of \Rfunction{nonlinTerms} must be specified whenever applicable to the nonlinear term: \begin{description} \setlength{\itemindent}{-0.5cm} \item[\Robject{variables}:] a list of expressions representing variables in the term (variables with a coefficient of 1). \item[\Robject{common}:] a numeric index of \Rfunarg{predictors} with duplicated indices identifying single factor predictors for which homologous effects are to be estimated. \end{description} The arguments below are optional: \begin{description} \setlength{\itemindent}{-0.5cm} \item[\Robject{call}:] a call to be used as a prefix for parameter labels. \item[\Robject{match}:] (if \Robject{call} is non-\Rcode{NULL}) a numeric index of \Robject{predictors} specifying which arguments of \Robject{call} the predictors match to --- zero indicating no match. If \Rcode{NULL}, predictors will not be matched to the arguments of \Robject{call}. \item[\Robject{start}:] a function which takes a named vector of parameters corresponding to the predictors and returns a vector of starting values for those parameters. This function is ignored if the term is nested within another nonlinear term. \end{description} Predictors which are matched to a specified argument of \Robject{call} should be given the same name as the argument. Matched predictors are labelled using ``dot-style'' labelling, e.g. the label for the intercept in the first constituent multiplier of the term \Rcode{Mult(A, B)} would be \Rcode{"Mult(.\ + A, 1 + B).(Intercept)"}. It is recommended that matches are specified wherever possible, to ensure parameter labels are well-defined. The arguments of \Rclass{nonlin} functions are as suited to the particular term, but will usually include symbolic representations of predictors in the term and/or the names of variables in the term. The function may also have an \Rfunarg{inst} argument to allow specification of multiple instances (see \ref{sec:instances}). \subsubsection{Example: a logistic function} As an example, consider writing a \Rclass{nonlin} function for the logistic term discussed in \ref{sec:Basic}: \[\frac{\text{Asym}}{1 + \exp((\text{xmid} - x)/\text{scal})}.\] We can consider \emph{Asym}, \emph{xmid} and \emph{scal} as the parameters of three separate predictors, each with a single intercept term. Thus we specify the \Rfunarg{predictors} argument to \Rfunction{nonlinTerms} as \begin{Scode} predictors = list(Asym = 1, xmid = 1, scal = 1) \end{Scode} The term also depends on the variable $x$, which would need to be specified by the user. Suppose this is specified to our \Rclass{nonlin} function through an argument named \Rfunarg{x}. Then our \Rclass{nonlin} function would specify the following \Rfunarg{variables} argument \begin{Scode} variables = list(substitute(x)) \end{Scode} We need to use \Rfunction{substitute} here to list the variable specified by the user rather than the variable named \Rcode{``x''} (if it exists). Our \Rclass{nonlin} function must also specify the \Rfunarg{term} argument to \Rfunction{nonlinTerms}. This is a function that will paste together an expression for the term, given labels for the predictors and the variables: \begin{Scode} term = function(predLabels, varLabels) { paste(predLabels[1], "/(1 + exp((", predLabels[2], "-", varLabels[1], ")/", predLabels[3], "))") } \end{Scode} We now have all the necessary ingredients of a \Rclass{nonlin} function to specify the logistic term. Since the parameterization does not depend on user-specified values, it does not make sense to use call-matched labelling in this case. The labels for our parameters will be taken from the labels of the \Rfunarg{predictors} argument. Since we do not anticipate fitting models with multiple logistic terms, our \Rclass{nonlin} function will not specify a \Rfunarg{call} argument with which to prefix the parameter labels. We do however, have some idea of useful starting values, so we will specify the \Rfunarg{start} argument as \begin{Scode} start = function(theta){ theta[3] <- 1 theta } \end{Scode} which sets the initial scale parameter to one. Putting all these ingredients together we have \begin{Scode} Logistic <- function(x){ list(predictors = list(Asym = 1, xmid = 1, scal = 1), variables = list(substitute(x)), term = function(predLabels, varLabels) { paste(predLabels[1], "/(1 + exp((", predLabels[2], "-", varLabels[1], ")/", predLabels[3], "))") }, start = function(theta){ theta[3] <- 1 theta }) } class(Logistic) <- "nonlin" \end{Scode} \subsubsection{Example: \Rfunction{MultHomog}} The \Rfunction{MultHomog} function included in the \Rpackage{gnm} package provides a further example of a \Rclass{nonlin} function, showing how to specify a term with quite different features from the preceding example. The definition is \begin{Scode} MultHomog <- function(..., inst = NULL){ dots <- match.call(expand.dots = FALSE)[["..."]] list(predictors = dots, common = rep(1, length(dots)), term = function(predLabels, ...) { paste("(", paste(predLabels, collapse = ")*("), ")", sep = "")}, call = as.expression(match.call())) } class(MultHomog) <- "nonlin" \end{Scode} Firstly, the interaction may be based on any number of factors, hence the use of the special ``\Rfunarg{...}'' argument. The use of \Rfunction{match.call} is analogous to the use of \Rfunction{substitute} in the \Rfunction{Logistic} function: to obtain expressions for the factors as specified by the user. The returned \Rfunarg{common} argument specifies that homogeneous effects are to be estimated across all the specified factors. The term only depends on these factors, but the \Rfunarg{term} function allows for the empty \Robject{varLabels} vector that will be passed to it, by having a ``\Rfunarg{...}'' argument. Since the user may wish to specify multiple instances, the \Rfunarg{call} argument to \Rfunction{nonlinTerms} is specified, so that parameters in different instances of the term will have unique labels (due to the \Rfunarg{inst} argument in the call). However as the expressions passed to ``\Rfunarg{...}'' may only represent single factors, rather than general predictors, it is not necessary to use call-matched labelling, so the \Rfunarg{match} argument is not specified here. % Dref starting values as example of ensuring the arbitrariness of the final % parameterization is emphasised (see old plug-in section)? \section{Controlling the fitting procedure} The \Rfunction{gnm} function has a number of arguments which affect the way a model will be fitted. Basic control parameters can be set using the arguments %\Rfunarg{checkLinear}, \Rfunarg{lsMethod}, \Rfunarg{ridge}, \Rfunarg{tolerance}, \Rfunarg{iterStart} and \Rfunarg{iterMax}. Starting values for the parameter estimates can be set by \Rfunarg{start} or they can be generated from starting values for the predictors on the link or response scale via \Rfunarg{etastart} or \Rfunarg{mustart} respectively. Parameters can be constrained via \Rfunarg{constrain} and \Rfunarg{constrainTo} arguments, while parameters of a stratification factor can be handled more efficiently by specifying the factor in an \Rfunarg{eliminate} argument. These options are described in more detail below. \subsection{Basic control parameters} %By default, \Rfunction{gnm} will use \Rfunction{glm.fit} to fit models where the %predictor is linear and \Rfunarg{eliminate} is \Rcode{NULL}. This behaviour can %be overridden by setting \Rfunarg{checkLinear} to \Rcode{FALSE}. %%% At present there is no advantage to doing this! Parameterization would be %%% the same. The arguments \Rfunarg{iterStart} and \Rfunarg{iterMax} control respectively the number of starting iterations (where applicable) and the number of main iterations used by the fitting algorithm. The progress of these iterations can be followed by setting either \Rfunarg{verbose} or \Rfunarg{trace} to \Robject{TRUE}. If \Rfunarg{verbose} is \Robject{TRUE} and \Rfunarg{trace} is \Robject{FALSE}, which is the default setting, progress is indicated by printing the character ``.'' at the beginning of each iteration. If \Rfunarg{trace} is \Robject{TRUE}, the deviance is printed at the beginning of each iteration (over-riding the printing of ``.'' if necessary). Whenever \Rfunarg{verbose} is \Robject{TRUE}, additional messages indicate each stage of the fitting process and diagnose any errors that cause that cause the algorithm to restart. Prior to solving the (typically rank-deficient) least squares problem at the heart of the \Rfunction{gnm} fitting algorithm, the design matrix is standardized and regularized (in the Levenberg-Marquardt sense); the \Rfunarg{ridge} argument provides a degree of control over the regularization performed (smaller values may sometimes give faster convergence but can lead to numerical instability). The fitting algorithm will terminate before the number of main iterations has reached \Rfunarg{iterMax} if the convergence criteria have been met, with tolerance specified by \Rfunarg{tolerance}. Convergence is judged by comparing the squared components of the score vector with corresponding elements of the diagonal of the Fisher information matrix. If, for all components of the score vector, the ratio is less than \Robject{tolerance\^{}2}, or the corresponding diagonal element of the Fisher information matrix is less than 1e-20, the algorithm is deemed to have converged. \subsection{Specifying starting values} \label{sec:start} \subsubsection{Using \Rfunarg{start}} In some contexts, the default starting values may not be appropriate and the fitting algorithm will fail to converge, or perhaps only converge after a large number of iterations. Alternative starting values may be passed on to \Rfunction{gnm} by specifying a \Rfunarg{start} argument. This should be a numeric vector of length equal to the number of parameters (or possibly the non-eliminated parameters, see Section \ref{sec:eliminate}), however missing starting values (\Robject{NA}s) are allowed. If there is no user-specified starting value for a parameter, the default value is used. This feature is particularly useful when adding terms to a model, since the estimates from the original model can be used as starting values, as in this example: \begin{Scode} model1 <- gnm(mu ~ R + C + Mult(R, C)) model2 <- gnm(mu ~ R + C + instances(Mult(R, C), 2), start = c(coef(model1), rep(NA, 10))) \end{Scode} The \Rfunction{gnm} call can be made with \Rcode{method = "coefNames"} to identify the parameters of a model prior to estimation, to assist with the specification of arguments such as \Rfunarg{start}. For example, to get the number \Rcode{10} for the value of \Rfunarg{start} above, we could have done \begin{Scode} gnm(mu ~ R + C + instances(Mult(R, C), 2), method = "coefNames") \end{Scode} from whose output it would be seen that there are 10 new coefficients in \Robject{model2}. When called with \Rcode{method = "coefNames"}, \Rfunction{gnm} makes no attempt to fit the specified model; instead it returns just the names that the coefficients in the fitted model object would have. The starting procedure used by \Rfunction{gnm} is as follows: \begin{enumerate} \item Begin with all parameters set to \Rcode{NA}. \item \label{i:nonlin} Replace \Rcode{NA} values with any starting values set by \Rclass{nonlin} functions. \item \label{i:start} Replace current values with any (non-\Rcode{NA}) starting values specified by the \Rfunarg{start} argument of \Rfunction{gnm}. \item \label{i:constrain} Set any values specified by the \Rfunarg{constrain} argument to the values specified by the \Rfunarg{constrainTo} argument (see Section \ref{sec:constrain}). \item \label{i:gnmStart} Categorise remaining \Rcode{NA} parameters as linear or nonlinear, treating non-\Rcode{NA} parameters as fixed. Initialise the nonlinear parameters by generating values $\theta_i$ from the Uniform($-0.1$, $0.1$) distribution and shifting these values away from zero as follows \begin{equation*} \theta_i = \begin{cases} \theta_i - 0.1 & \text{if } \theta_i < 1 \\ \theta_i + 0.1 & \text{otherwise} \end{cases} \end{equation*} \item Compute the \Rfunction{glm} estimate of the linear parameters, offsetting the contribution to the predictor of any terms fully determined by steps \ref{i:nonlin} to \ref{i:gnmStart}. \item \label{i:iter} Run starting iterations: update nonlinear parameters one at a time, jointly re-estimating linear parameters after each round of updates. \end{enumerate} Note that no starting iterations (step \ref{i:iter}) will be run if all parameters are linear, or if all nonlinear parameters are specified by \Rfunarg{start}, \Rfunarg{constrain} or a \Rclass{nonlin} function. \subsubsection{Using \Rfunarg{etastart} or \Rfunarg{mustart}} An alternative way to set starting values for the parameters is to specify starting values for the predictors. If there are linear parameters in the model, the predictor starting values are first used to fit a model with only the linear terms (offsetting any terms fully specified by starting values given by \Rfunarg{start}, \Rfunarg{constrain} or a \Rclass{nonlin} function). In this case the parameters corresponding to the predictor starting values can be computed analytically. If the fitted model reproduces the predictor starting values, then these values contain no further information and they are replaced using the \Rfunction{initialize} function of the specified \Rfunarg{family}. The predictor starting values or their replacement are then used as the response variable in a nonlinear least squares model with only the unspecified nonlinear terms, offsetting the contribution of any other terms. Since the model is over-parameterized, the model is approximated using \Rfunarg{iterStart} iterations of the ``L-BFGS-B'' algorithm of \Rfunction{optim}, assuming parameters lie in the range (-10, 10). Starting values for the predictors can be specified explicitly via \Rfunarg{etastart} or implicitly by passing starting values for the fitted means to \Rfunarg{mustart}. For example, when extending a model, the fitted predictors from the first model can be used to find starting values for the parameters of the second model: \begin{Scode} model1 <- gnm(mu ~ R + C + Mult(R, C)) model2 <- gnm(mu ~ R + C + instances(Mult(R, C), 2), etastart = model1$predictors) \end{Scode} %$ Using \Rfunction{etastart} avoids the one-parameter-at-a-time starting iterations, so is quicker than using \Rfunction{start} to pass on information from a nested model. However \Rfunction{start} will generally produce better starting values so should be used when feasible. For multiplicative terms, the \Rfunction{residSVD} functions provides a better way to avoid starting iterations. \subsection{Using \Rfunarg{constrain}} \label{sec:constrain} By default, \Rfunction{gnm} only imposes identifiability constraints according to the general conventions used by \Robject{R} to handle linear aliasing. Therefore models that have any nonlinear terms will be typically be over-parameterized, and \Rfunction{gnm} will return a random parameterization for unidentified coefficients (determined by the randomly chosen starting values for the iterative algorithm, step 5 above). To illustrate this point, consider the following application of \Rfunction{gnm}, discussed later in Section \ref{sec:RCmodels}: <>= set.seed(1) RChomog1 <- gnm(Freq ~ origin + destination + Diag(origin, destination) + MultHomog(origin, destination), family = poisson, data = occupationalStatus, verbose = FALSE) @ Running the analysis again from a different seed <>= set.seed(2) RChomog2 <- update(RChomog1) @ gives a different representation of the same model: <>= compareCoef <- cbind(coef(RChomog1), coef(RChomog2)) colnames(compareCoef) <- c("RChomog1", "RChomog2") round(compareCoef, 4) @ Even though the linear terms are constrained, the parameter estimates for the main effects of \Robject{origin} and \Robject{destination} still change, because these terms are aliased with the higher order multiplicative interaction, which is unconstrained. Standard errors are only meaningful for identified parameters and hence the output of \Rmethod{summary.gnm} will show clearly which coefficients are estimable: <>= summary(RChomog2) @ Additional constraints may be specified through the \Rfunarg{constrain} and \Rfunarg{constrainTo} arguments of \Rfunction{gnm}. These arguments specify respectively parameters that are to be constrained in the fitting process and the values to which they should be constrained. Parameters may be specified by a regular expression to match against the parameter names, a numeric vector of indices, a character vector of names, or, if \Rcode{constrain = "[?]"} they can be selected through a \emph{Tk} dialog. The values to constrain to should be specified by a numeric vector; if \Rfunarg{constrainTo} is missing, constrained parameters will be set to zero. In the case above, constraining one level of the homogeneous multiplicative factor is sufficient to make the parameters of the nonlinear term identifiable, and hence all parameters in the model identifiable. Figure~\ref{fig:Tk} illustrates how the coefficient to be constrained may be specified via a \emph{Tk} dialog, an approach which can be helpful in interactive R sessions. % here illustrate TclTk dialog, but explain other methods better for reproducibility \begin{figure}[tp] \centering \begin{tabular}[!h]{m{0.6\linewidth}m{0.4\linewidth}} \scalebox{0.9}{\includegraphics{screenshot1.png}} & When \Rfunction{gnm} is called with \Rcode{constrain = "[?]"}, a \emph{Tk} dialog is shown listing the coefficients in the model.\\ \scalebox{0.9}{\includegraphics{screenshot2.png}} & Scroll through the coefficients and click to select a single coefficient to constrain. To select multiple coefficients, hold down the \texttt{Ctrl} key whilst clicking. The \texttt{Add} button will become active when coefficient(s) have been selected.\\ \scalebox{0.9}{\includegraphics{screenshot3.png}} & Click the \texttt{Add} button to add the selected coefficients to the list of coefficients to be constrained. To remove coefficients from the list, select the coefficients in the right pane and click \texttt{Remove}. Click \texttt{OK} when you have finalised the list.\\ \end{tabular} \caption{Selecting coefficients to constrain with the \emph{Tk} dialog.} \label{fig:Tk} \end{figure} However for reproducible code, it is best to specify the constrained coefficients directly. For example, the following code specifies that the last level of the homogeneous multiplicative factor should be constrained to zero, <>= set.seed(1) RChomogConstrained1 <- update(RChomog1, constrain = length(coef(RChomog1))) @ Since all the parameters are now constrained, re-fitting the model will give the same results, regardless of the random seed set beforehand: <>= set.seed(2) RChomogConstrained2 <- update(RChomogConstrained1) identical(coef(RChomogConstrained1), coef(RChomogConstrained2)) @ It is not usually so straightforward to constrain all the parameters in a generalized nonlinear model. However use of \Rfunarg{constrain} in conjunction with \Rfunarg{constrainTo} is usually sufficient to make coefficients of interest identifiable . The functions \Rfunction{checkEstimable} or \Rfunction{getContrasts}, described in Section \ref{sec:Methods}, may be used to check whether particular combinations of parameters are estimable. \subsection{Using \Rfunarg{eliminate}} \label{sec:eliminate} When a model contains the additive effect of a factor which has a large number of levels, the iterative algorithm by which maximum likelihood estimates are computed can usually be accelerated by use of the \Rfunarg{eliminate} argument to \Rfunction{gnm}. A factor passed to \Rfunarg{eliminate} specifies the first term in the model, replacing any intercept term. So, for example \begin{Scode} gnm(mu ~ A + B + Mult(A, B), eliminate = strata1:strata2) \end{Scode} is equivalent, in terms of the structure of the model, to \begin{Scode} gnm(mu ~ -1 + strata1:strata2 + A + B + Mult(A, B)) \end{Scode} However, specifying a factor through \Rfunarg{eliminate} has two advantages over the standard specification. First, the structure of the eliminated factor is exploited so that computational speed is improved --- substantially so if the number of eliminated parameters is large. Second, eliminated parameters are returned separately from non-eliminated parameters (as an attribute of the \Robject{coefficients} component of the returned object). Thus eliminated parameters are excluded from printed model summaries by default and disregarded by \Rclass{gnm} methods that would not be relevant to such parameters (see Section \ref{sec:Methods}). The \Rfunarg{eliminate} feature is useful, for example, when multinomial-response models are fitted by using the well known equivalence between multinomial and (conditional) Poisson likelihoods. In such situations the sufficient statistic involves a potentially large number of fixed multinomial row totals, and the corresponding parameters are of no substantive interest. For an application see Section \ref{sec:Stereotype} below. Here we give an artificial illustration: 1000 randomly-generated trinomial responses, and a single predictor variable (whose effect on the data generation is null): <>= set.seed(1) n <- 1000 x <- rep(rnorm(n), rep(3, n)) counts <- as.vector(rmultinom(n, 10, c(0.7, 0.1, 0.2))) rowID <- gl(n, 3, 3 * n) resp <- gl(3, 1, 3 * n) @ The logistic model for dependence on \Robject{x} can be fitted as a Poisson log-linear model\footnote{For this particular example, of course, it would be more economical to fit the model directly using \Rfunction{multinom} (from the recommended package \Rpackage{nnet}). But fitting as here via the `Poisson trick' allows the model to be elaborated within the \Rpackage{gnm} framework using \Rfunction{Mult} or other \Rclass{nonlin} terms.}, using either \Rfunction{glm} or \Rfunction{gnm}: \begin{Sinput} > ## Timings on a Xeon 2.33GHz, under Linux > system.time(temp.glm <- glm(counts ~ rowID + resp + resp:x, family = poisson))[1] \end{Sinput} \begin{Soutput} user.self 37.126 \end{Soutput} \begin{Sinput} > system.time(temp.gnm <- gnm(counts ~ resp + resp:x, eliminate = rowID, family = poisson, verbose = FALSE))[1] \end{Sinput} \begin{Soutput} user.self 0.04 \end{Soutput} \begin{Sinput} > c(deviance(temp.glm), deviance(temp.gnm)) \end{Sinput} \begin{Soutput} [1] 2462.556 2462.556 \end{Soutput} Here the use of \Rfunarg{eliminate} causes the \Rfunction{gnm} calculations to run much more quickly than \Rfunction{glm}. The speed advantage increases with the number of eliminated parameters (here 1000). By default,the eliminated parameters do not appear in printed model summaries as here: \begin{Sinput} > summary(temp.gnm) \end{Sinput} \begin{Soutput} Call: gnm(formula = counts ~ resp + resp:x, eliminate = rowID, family = poisson, verbose = FALSE) Deviance Residuals: Min 1Q Median 3Q Max -2.852038 -0.786172 -0.004534 0.645278 2.755013 Coefficients of interest: Estimate Std. Error z value Pr(>|z|) resp2 -1.961448 0.034007 -57.678 <2e-16 resp3 -1.255846 0.025359 -49.523 <2e-16 resp1:x -0.007726 0.024517 -0.315 0.753 resp2:x -0.023340 0.037611 -0.621 0.535 resp3:x 0.000000 NA NA NA (Dispersion parameter for poisson family taken to be 1) Std. Error is NA where coefficient has been constrained or is unidentified Residual deviance: 2462.6 on 1996 degrees of freedom AIC: 12028 Number of iterations: 4 \end{Soutput} although the \Rmethod{summary} method has a logical \Rfunarg{with.eliminate} that can toggled so that the eliminated parameters are included if desired. The \Rfunarg{eliminate} feature as implemented in \Rpackage{gnm} extends the earlier work of \cite{Hatz04} to a broader class of models and to over-parameterized model representations. \section{Methods and accessor functions} \label{sec:Methods} \subsection{Methods} \label{sec:specificMethods} The \Rfunction{gnm} function returns an object of class \Robject{c("gnm", "glm", "lm")}. There are several methods that have been written for objects of class \Rclass{glm} or \Rclass{lm} to facilitate inspection of fitted models. Out of the generic functions in the \Rpackage{base}, \Rpackage{stats} and \Rpackage{graphics} packages for which methods have been written for \Rclass{glm} or \Rclass{lm} objects, Figure \ref{fig:glm.lm} shows those that can be used to analyse \Rclass{gnm} objects, whilst Figure \ref{fig:!glm.lm} shows those that are not implemented for \Rclass{gnm} objects. \begin{figure}[!tbph] \centering \begin{fbox} { \begin{tabular*}{7.5cm}{@{\extracolsep{\fill}}lll@{\extracolsep{\fill}}} add1$^*$ & family & print \\ anova & formula & profile \\ case.names & hatvalues & residuals \\ coef & labels & rstandard \\ cooks.distance & logLik & summary \\ confint & model.frame & variable.names \\ deviance & model.matrix & vcov \\ drop1$^*$ & plot & weights \\ extractAIC & predict & \\ \end{tabular*} } \end{fbox} \caption{Generic functions in the \Rpackage{base}, \Rpackage{stats} and \Rpackage{graphics} packages that can be used to analyse \Rclass{gnm} objects. Starred functions are implemented for models with linear terms only.} \label{fig:glm.lm} \end{figure} \begin{figure}[!tbph] \centering \begin{fbox} { \begin{tabular*}{4.5cm}{@{\extracolsep{\fill}}ll@{\extracolsep{\fill}}} alias & effects \\ dfbeta & influence \\ dfbetas & kappa \\ dummy.coef & proj \\ \end{tabular*} } \end{fbox} \caption{Generic functions in the \Rpackage{base}, \Rpackage{stats} and \Rpackage{graphics} packages for which methods have been written for \Rclass{glm} or \Rclass{lm} objects, but which are \emph{not} implemented for \Rclass{gnm} objects.} \label{fig:!glm.lm} \end{figure} In addition to the accessor functions shown in Figure \ref{fig:glm.lm}, the \Rpackage{gnm} package provides a new generic function called \Rfunction{termPredictors} that has methods for objects of class \Rclass{gnm}, \Rclass{glm} and \Rclass{lm}. This function returns the additive contribution of each term to the predictor. See Section \ref{sec:termPredictors} for an example of its use. Most of the functions listed in Figure \ref{fig:glm.lm} can be used as they would be for \Rclass{glm} or \Rclass{lm} objects, however care must be taken with \Rmethod{vcov.gnm}, as the variance-covariance matrix will depend on the parameterization of the model. In particular, standard errors calculated using the variance-covariance matrix will only be valid for parameters or contrasts that are estimable! Similarly, \Rmethod{profile.gnm} and \Rmethod{confint.gnm} are only applicable to estimable parameters. The deviance function of a generalized nonlinear model can sometimes be far from quadratic and \Rmethod{profile.gnm} attempts to detect asymmetry or asymptotic behaviour in order to return a sufficient profile for a given parameter. As an example, consider the following model, described later in Section \ref{sec:Unidiff}: \begin{Scode} unidiff <- gnm(Freq ~ educ*orig + educ*dest + Mult(Exp(educ), orig:dest), constrain = "[.]educ1", family = poisson, data = yaish, subset = (dest != 7)) prof <- profile(unidiff, which = 61:65, trace = TRUE) \end{Scode} If the deviance is quadratic in a given parameter, the profile trace will be linear. We can plot the profile traces as follows: \begin{figure}[!tbph] \begin{center} \scalebox{1.1}{\includegraphics{fig-profilePlot.pdf}} \end{center} \caption{Profile traces for the multipliers of the orig:dest association} \label{fig:profilePlot} \end{figure} From these plots we can see that the deviance is approximately quadratic in \Robject{Mult(Exp(.), orig:dest).educ2}, asymmetric in \Robject{Mult(Exp(.), orig:dest).educ3} and \Robject{Mult(Exp(.), orig:dest).educ4} and asymptotic in \Robject{Mult(Exp(.), orig:dest).educ5}. When the deviance is approximately quadratic in a given parameter, \Rmethod{profile.gnm} uses the same stepsize for profiling above and below the original estimate: \begin{Sinput} > diff(prof[[2]]$par.vals[, "Mult(Exp(.), orig:dest).educ2"]) \end{Sinput} \begin{Soutput} [1] 0.1053072 0.1053072 0.1053072 0.1053072 0.1053072 0.1053072 0.1053072 [8] 0.1053072 0.1053072 0.1053072 \end{Soutput} When the deviance is asymmetric, \Rmethod{profile.gnm} uses different step sizes to accommodate the skew: \begin{Sinput} > diff(prof[[4]]$par.vals[, "Mult(Exp(.), orig:dest).educ4"]) \end{Sinput} \begin{Soutput} [1] 0.2018393 0.2018393 0.2018393 0.2018393 0.2018393 0.2018393 0.2018393 [8] 0.2018393 0.2018393 0.2243673 0.2243673 0.2243673 0.2243673 0.2243673 \end{Soutput} Finally, the presence of an asymptote is recorded in the \Robject{"asymptote"} attribute of the returned profile: \begin{Sinput} > attr(prof[[5]], "asymptote") \end{Sinput} \begin{Soutput} [1] TRUE FALSE \end{Soutput} This information is used by \Rmethod{confint.gnm} to return infinite limits for confidence intervals, as appropriate: \begin{Sinput} > confint(prof, level = 0.95) \end{Sinput} \begin{Soutput} 2.5 % 97.5 % Mult(Exp(.), orig:dest).educ1 NA NA Mult(Exp(.), orig:dest).educ2 -0.5978901 0.1022447 Mult(Exp(.), orig:dest).educ3 -1.4836854 -0.2362378 Mult(Exp(.), orig:dest).educ4 -2.5792398 -0.2953420 Mult(Exp(.), orig:dest).educ5 -Inf -0.7006889 \end{Soutput} \subsection{\Rfunction{ofInterest} and \Rfunction{pickCoef}} \label{sec:ofInterest} It is quite common for a statistical model to have a large number of parameters, but for only a subset of these parameters be of interest when it comes to interpreting the model. The \Rfunarg{ofInterest} argument to \Rfunction{gnm} allows the user to specify a subset of the parameters which are of interest, so that \Rclass{gnm} methods will focus on these parameters. In particular, printed model summaries will only show the parameters of interest, whilst methods for which a subset of parameters may be selected will by default select the parameters of interest, or where this may not be appropriate, provide a \emph{Tk} dialog for selection from the parameters of interest. Parameters may be specified to the \Rfunarg{ofInterest} argument by a regular expression to match against parameter names, by a numeric vector of indices, by a character vector of names, or, if \Rcode{ofInterest = "[?]"} they can be selected through a \emph{Tk} dialog. The information regarding the parameters of interest is held in the \Robject{ofInterest} component of \Rclass{gnm} objects, which is a named vector of numeric indices, or \Robject{NULL} if all parameters are of interest. This component may be accessed or replaced using \Rfunction{ofInterest} or \Rfunction{ofInterest<-} respectively. The \Rfunction{pickCoef} function provides a simple way to obtain the indices of coefficients from any model object. It takes the model object as its first argument and has an optional \Rfunarg{regexp} argument. If a regular expression is passed to \Rfunarg{regexp}, the coefficients are selected by matching this regular expression against the coefficient names. Otherwise, coefficients may be selected via a \emph{Tk} dialog. So, returning to the example from the last section, if we had set \Robject{ofInterest} to index the education multipliers as follows \begin{Scode} ofInterest(unidiff) <- pickCoef(unidiff, "[.]educ") \end{Scode} then it would not have been necessary to specify the \Rfunarg{which} argument of \Rfunction{profile} as these parameters would have been selected by default. \subsection{\Rfunction{checkEstimable}} \label{sec:checkEstimable} The \Rfunction{checkEstimable} function can be used to check the estimability of a linear combination of parameters. For non-linear combinations the same function can be used to check estimability based on the (local) vector of partial derivatives. The \Rfunction{checkEstimable} function provides a numerical version of the sort of algebraic test described in \citet{CatcMorg97}. Consider the following model, which is described later in Section \ref{sec:Unidiff}: <>= doubleUnidiff <- gnm(Freq ~ election:vote + election:class:religion + Mult(Exp(election), religion:vote) + Mult(Exp(election), class:vote), family = poisson, data = cautres) @ The effects of the first constituent multiplier in the first multiplicative interaction are identified when the parameter for one of the levels --- say for the first level --- is constrained to zero. The parameters to be estimated are then the differences between each other level and the first. These differences can be represented by a contrast matrix as follows: <>= coefs <- names(coef(doubleUnidiff)) contrCoefs <- coefs[grep(", religion:vote", coefs)] nContr <- length(contrCoefs) contrMatrix <- matrix(0, length(coefs), nContr, dimnames = list(coefs, contrCoefs)) contr <- contr.sum(contrCoefs) # switch round to contrast with first level contr <- rbind(contr[nContr, ], contr[-nContr, ]) contrMatrix[contrCoefs, 2:nContr] <- contr contrMatrix[contrCoefs, 2:nContr] @ Then their estimability can be checked using \Rfunction{checkEstimable} <>= checkEstimable(doubleUnidiff, contrMatrix) @ which confirms that the effects for the other three levels are estimable when the parameter for the first level is set to zero. However, applying the equivalent constraint to the second constituent multiplier in the interaction is not sufficient to make the parameters in that multiplier estimable: <>= coefs <- names(coef(doubleUnidiff)) contrCoefs <- coefs[grep("[.]religion", coefs)] nContr <- length(contrCoefs) contrMatrix <- matrix(0, length(coefs), length(contrCoefs), dimnames = list(coefs, contrCoefs)) contr <- contr.sum(contrCoefs) contrMatrix[contrCoefs, 2:nContr] <- rbind(contr[nContr, ], contr[-nContr, ]) checkEstimable(doubleUnidiff, contrMatrix) @ \subsection{\Rfunction{getContrasts}, \Rfunction{se}} \label{sec:getContrasts} To investigate simple ``sum to zero'' contrasts such as those above, it is easiest to use the \Rfunction{getContrasts} function, which checks the estimability of possibly scaled contrasts and returns the parameter estimates with their standard errors. Returning to the example of the first constituent multiplier in the first multiplicative interaction term, the differences between each election and the first can be obtained as follows: <>= myContrasts <- getContrasts(doubleUnidiff, pickCoef(doubleUnidiff, ", religion:vote")) myContrasts @ %def Visualization of estimated contrasts using `quasi standard errors' \citep{Firt03,FirtMene04} is achieved by plotting the resulting object: <>= plot(myContrasts, main = "Relative strength of religion-vote association, log scale", xlab = "Election", levelNames = 1:4) @ \begin{figure}[!tbph] \begin{center} \includegraphics{gnmOverview-qvplot.pdf} \end{center} \caption{Relative strength of religion-vote association, log scale} \label{fig:qvplot} \end{figure} %Attempting to obtain the equivalent contrasts for the second %(religion-vote association) multiplier produces the %following result: %<>= %coefs.of.interest <- grep("[.]religion", names(coef(doubleUnidiff))) %getContrasts(doubleUnidiff, coefs.of.interest) %@ %def By default, \Rfunction{getContrasts} uses the first parameter of the specified set as the reference level; alternatives may be set via the \Rfunarg{ref} argument. In the above example, the simple contrasts are estimable without scaling. In certain other applications, for example row-column association models (see Section~\ref{sec:RCmodels}), the contrasts are identified only after fixing their scale. A more general family of \emph{scaled} contrasts for a set of parameters $\gamma_r, r = 1, \ldots, R$ is given by \begin{equation*} \gamma^*_r = \frac{\gamma_r - \overline{\gamma}_w}{ \sqrt{\sum_r v_r (\gamma_r - \overline{\gamma}_u)^2}} \end{equation*} where $\overline{\gamma}_w = \sum w_r \gamma_r$ is the reference level against which the contrasts are taken, $\overline{\gamma}_u = \sum u_r \gamma_r$ is a possibly different weighted mean of the parameters to be used as reference level for a set of ``scaling contrasts'', and $v_r$ is a further set of weights. Thus, for example, the choice \[ w_r= \begin{cases} 1&(r=1)\\ 0&\hbox{(otherwise)} \end{cases}, \qquad u_r=v_r=1/R \] specifies contrasts with the first level, with the coefficients scaled to have variance 1\null. This general type of scaling can be obtained by specifying the form of $\overline{\gamma}_u$ and $v_r$ via the \Rfunarg{scaleRef} and \Rfunarg{scaleWeights} arguments of \Rfunction{getContrasts}. As an example, consider the following model, described in Section~\ref{sec:RCmodels}: @ <>= mentalHealth$MHS <- C(mentalHealth$MHS, treatment) mentalHealth$SES <- C(mentalHealth$SES, treatment) RC1model <- gnm(count ~ SES + MHS + Mult(SES, MHS), family = poisson, data = mentalHealth) @ %def The effects of the constituent multipliers of the multiplicative interaction are identified when both their scale and location are constrained. A simple way to achieve this is to set the first parameter to zero and the last parameter to one: @ <>= RC1model2 <- gnm(count ~ SES + MHS + Mult(1, SES, MHS), constrain = "[.]SES[AF]", constrainTo = c(0, 1), ofInterest = "[.]SES", family = poisson, data = mentalHealth) summary(RC1model2) @ %def Note that a constant multiplier must be incorporated into the interaction term, i.e., the multiplicative term \Rcode{Mult(SES, MHS)} becomes \Rcode{Mult(1, SES, MHS)}, in order to maintain equivalence with the original model specification. The constraints specified for \Robject{RC1model2} result in the estimation of scaled contrasts with level \Rcode{A} of \Rcode{SES}, in which the scaling fixes the magnitude of the contrast between level \Rcode{F} and level \Rcode{A} to be equal to 1\null. The equivalent use of \Rfunction{getContrasts}, together with the \emph{unconstrained} fit (\Robject{RC1model}), in this case is as follows: @ <>= getContrasts(RC1model, pickCoef(RC1model, "[.]SES"), ref = "first", scaleRef = "first", scaleWeights = c(rep(0, 5), 1)) @ %def Quasi-variances and standard errors are not returned here as they can not (currently) be computed for scaled contrasts. When the scaling uses the same reference level as the contrasts, equal scale weights produce ``spherical'' contrasts, whilst unequal weights produce ``elliptical'' contrasts. Further examples are given in Sections~\ref{sec:RCmodels} and \ref{sec:GAMMI}. For more general linear combinations of parameters than contrasts, the lower-level \Rfunction{se} function (which is called internally by \Rfunction{getContrasts} and by the \Rmethod{summary} method) can be used directly. See \Rcode{help(se)} for details. \subsection{\Rfunction{residSVD}} \label{sec:residSVD} Sometimes it is useful to operate on the residuals of a model in order to create informative summaries of residual variation, or to obtain good starting values for additional parameters in a more elaborate model. The relevant arithmetical operations are weighted means of the so-called \emph{working residuals}. The \Rfunction{residSVD} function facilitates one particular residual analysis that is often useful when considering multiplicative interaction between factors as a model elaboration: in effect, \Rfunction{residSVD} provides a direct estimate of the parameters of such an interaction, by performing an appropriately weighted singular value decomposition on the working residuals. As an illustration, consider the barley data from \citet{Wedd74}. These data have the following two-way structure: <>= xtabs(y ~ site + variety, barley) @ In Section~\ref{sec:biplot} a biplot model is proposed for these data, which comprises a two-component interaction between the cross-classifying factors. In order to fit this model, we can proceed by fitting a smaller model, then use \Rfunction{residSVD} to obtain starting values for the parameters in the bilinear term: @ <>= emptyModel <- gnm(y ~ -1, family = wedderburn, data = barley) biplotStart <- residSVD(emptyModel, barley$site, barley$variety, d = 2) biplotModel <- gnm(y ~ -1 + instances(Mult(site, variety), 2), family = wedderburn, data = barley, start = biplotStart) @ %def In this instance, the use of purposive (as opposed to the default, random) starting values had little effect: the fairly large number of iterations needed in this example is caused by a rather flat (quasi-)likelihood surface near the maximum, not by poor starting values. In other situations, the use of \Rfunction{residSVD} may speed the calculations dramatically (see for example Section \ref{sec:GAMMI}), or it may be crucial to success in locating the MLE (for example see \Rcode{help(House2001)}, where the number of multiplicative parameters is in the hundreds). The \Rfunction{residSVD} result in this instance provides a crude approximation to the MLE of the enlarged model, as can be seen in Figure \ref{fig:residSVDplot}: @ <>= plot(coef(biplotModel), biplotStart, main = "Comparison of residSVD and MLE for a 2-dimensional biplot model", ylim = c(-2, 2), xlim = c(-4, 4)) abline(a = 0, b = 1, lty = 2) @ %def \begin{figure}[!tbph] \begin{center} \includegraphics{gnmOverview-residSVDplot} \end{center} \caption{Comparison of residSVD and the MLE for a 2-dimensional biplot model} \label{fig:residSVDplot} \end{figure} \section{\Rfunction{gnm} or \Rfunction{(g)nls}?} \label{sec:gnmVnls} The \Rfunction{nls} function in the \Rpackage{stats} package may be used to fit a nonlinear model via least-squares estimation. Statistically speaking, \Rfunction{gnm} is to \Rfunction{nls} as \Rfunction{glm} is to \Rfunction{lm}, in that a nonlinear least-squares model is equivalent to a generalized nonlinear model with \Rcode{family = gaussian}. A \Rfunction{nls} model assumes that the responses are distributed either with constant variance or with fixed relative variances (specified via the \Rfunarg{weights} argument). The \Rfunction{gnls} function in the \Rpackage{nlme} package extends \Rfunction{nls} to allow correlated responses. On the other hand, \Rfunction{gnm} allows for responses distributed with variances that are a specified (via the \Rfunarg{family} argument) function of the mean; as with \Rfunction{nls}, no correlation is allowed. The \Rfunction{gnm} function also differs from \Rfunction{nls}/\Rfunction{gnls} in terms of the interface. Models are specified to \Rfunction{nls} and \Rfunction{gnls} in terms of a mathematical formula or a \Rclass{selfStart} function based on such a formula, which is convenient for models that have a small number of parameters. For models that have a large number of parameters, or can not easily be represented by a mathematical formula, the symbolic model specification used by \Rfunction{gnm} may be more convenient. This would usually be the case for models involving factors, which would need to be represented by dummy variables in a \Rfunction{nls} formula. When working with artificial data, \Rfunction{gnm} has the minor advantage that it does not fail when a model is an exact fit to the data (see \Rcode{help(nls)})\null. Therefore it is not necessary with \Rfunction{gnm} to add noise to artificial data, which can be useful when testing methods. \section{Examples} \label{sec:Examples} \subsection{Row-column association models} \label{sec:RCmodels} There are several models that have been proposed for modelling the relationship between the cell means of a contingency table and the cross-classifying factors. The following examples consider the row-column association models proposed by \citet{Good79}. The examples shown use data from two-way contingency tables, but the \Rpackage{gnm} package can also be used to fit the equivalent models for higher order tables. \subsubsection{RC(1) model} The RC(1) model is a row and column association model with the interaction between row and column factors represented by one component of the multiplicative interaction. If the rows are indexed by $r$ and the columns by $c$, then the log-multiplicative form of the RC(1) model for the cell means $\mu_{rc}$ is given by \[\log \mu_{rc} = \alpha_r + \beta_c + \gamma_r\delta_c. \] We shall fit this model to the \Robject{mentalHealth} data set from \citet[][page 381]{Agre02}, which is a two-way contingency table classified by the child's mental impairment (MHS) and the parents' socioeconomic status (SES). Although both of these factors are ordered, we do not wish to use polynomial contrasts in the model, so we begin by setting the contrasts attribute of these factors to \Rcode{treatment}: <>= set.seed(1) mentalHealth$MHS <- C(mentalHealth$MHS, treatment) mentalHealth$SES <- C(mentalHealth$SES, treatment) @ The \Rclass{gnm} model is then specified as follows, using the poisson family with a log link function: <>= RC1model <- gnm(count ~ SES + MHS + Mult(SES, MHS), family = poisson, data = mentalHealth) RC1model @ %def The row scores (parameters 10 to 15) and the column scores (parameters 16 to 19) of the multiplicative interaction can be normalized as in Agresti's eqn (9.15): <>= rowProbs <- with(mentalHealth, tapply(count, SES, sum) / sum(count)) colProbs <- with(mentalHealth, tapply(count, MHS, sum) / sum(count)) rowScores <- coef(RC1model)[10:15] colScores <- coef(RC1model)[16:19] rowScores <- rowScores - sum(rowScores * rowProbs) colScores <- colScores - sum(colScores * colProbs) beta1 <- sqrt(sum(rowScores^2 * rowProbs)) beta2 <- sqrt(sum(colScores^2 * colProbs)) assoc <- list(beta = beta1 * beta2, mu = rowScores / beta1, nu = colScores / beta2) assoc @ %def Alternatively, the elliptical contrasts \Robject{mu} and \Robject{nu} can be obtained using \Rfunction{getContrasts}, with the advantage that the standard errors for the contrasts will also be computed: @ <>= mu <- getContrasts(RC1model, pickCoef(RC1model, "[.]SES"), ref = rowProbs, scaleWeights = rowProbs) nu <- getContrasts(RC1model, pickCoef(RC1model, "[.]MHS"), ref = colProbs, scaleWeights = colProbs) mu nu @ %def Since the value of \Robject{beta} is dependent upon the particular scaling used for the contrasts, it is typically not of interest to conduct inference on this parameter directly. The standard error for \Robject{beta} could be obtained, if desired, via the delta method. \subsubsection{RC(2) model} The RC(1) model can be extended to an RC($m$) model with $m$ components of the multiplicative interaction. For example, the RC(2) model is given by \[ \log \mu_{rc} = \alpha_r + \beta_c + \gamma_r\delta_c + \theta_r\phi_c. \] Extra instances of the multiplicative interaction can be specified by the \Rfunarg{multiplicity} argument of \Rfunction{Mult}, so the RC(2) model can be fitted to the \Robject{mentalHealth} data as follows <>= RC2model <- gnm(count ~ SES + MHS + instances(Mult(SES, MHS), 2), family = poisson, data = mentalHealth) RC2model @ \subsubsection{Homogeneous effects} If the row and column factors have the same levels, or perhaps some levels in common, then the row-column interaction could be modelled by a multiplicative interaction with homogeneous effects, that is \[\log \mu_{rc} = \alpha_r + \beta_c + \gamma_r\gamma_c.\] For example, the \Robject{occupationalStatus} data set from \citet{Good79} is a contingency table classified by the occupational status of fathers (origin) and their sons (destination). \citet{Good79} fits a row-column association model with homogeneous effects to these data after deleting the cells on the main diagonal. Equivalently we can account for the diagonal effects by a separate \Rfunction{Diag} term: @ <>= RChomog <- gnm(Freq ~ origin + destination + Diag(origin, destination) + MultHomog(origin, destination), family = poisson, data = occupationalStatus) RChomog @ %def To determine whether it would be better to allow for heterogeneous effects on the association of the fathers' occupational status and the sons' occupational status, we can compare this model to the RC(1) model for these data: <>= RCheterog <- gnm(Freq ~ origin + destination + Diag(origin, destination) + Mult(origin, destination), family = poisson, data = occupationalStatus) anova(RChomog, RCheterog) @ In this case there is little gain in allowing heterogeneous effects. \subsection{Diagonal reference models} \label{sec:Dref} Diagonal reference models, proposed by \citet{Sobe81, Sobe85}, are designed for contingency tables classified by factors with the same levels. The cell means are modelled as a function of the diagonal effects, i.e., the mean responses of the `diagonal' cells in which the levels of the row and column factors are the same. \subsubsection*{\Rfunction{Dref} example 1: Political consequences of social mobility} To illustrate the use of diagonal reference models we shall use the \Robject{voting} data from \citet{Clif93}. The data come from the 1987 British general election and are the percentage voting Labour in groups cross-classified by the class of the head of household (\Robject{destination}) and the class of their father (\Robject{origin}). In order to weight these percentages by the group size, we first back-transform them to the counts of those voting Labour and those not voting Labour: @ <>= set.seed(1) count <- with(voting, percentage/100 * total) yvar <- cbind(count, voting$total - count) @ %def The grouped percentages may be modelled by a basic diagonal reference model, that is, a weighted sum of the diagonal effects for the corresponding origin and destination classes. This model may be expressed as \[ \mu_{od} = \frac{e^{\delta_1}}{e^{\delta_1} + e^{\delta_2}}\gamma_o + \frac{e^{\delta_2}}{e^{\delta_1} + e^{\delta_2}}\gamma_d . \] See Section \ref{sec:Dref function} for more detail on the parameterization. The basic diagonal reference model may be fitted using \Rfunction{gnm} as follows @ <>= classMobility <- gnm(yvar ~ Dref(origin, destination), family = binomial, data = voting) classMobility @ %def and the origin and destination weights can be evaluated as below @ <>= DrefWeights(classMobility) @ %def These results are slightly different from those reported by \citet{Clif93}. The reason for this is unclear: we are confident that the above results are correct for the data as given in \citet{Clif93}, but have not been able to confirm that the data as printed in the journal were exactly as used in Clifford and Heath's analysis. \citet{Clif93} suggest that movements in and out of the salariat (class 1) should be treated differently from movements between the lower classes (classes 2 - 5), since the former has a greater effect on social status. Thus they propose the following model \begin{equation*} \mu_{od} = \begin{cases} \dfrac{e^{\delta_1}}{e^{\delta_1} + e^{\delta_2}}\gamma_o + \dfrac{e^{\delta_2}}{e^{\delta_1} + e^{\delta_2}}\gamma_d & \text{if } o = 1\\ \\ \dfrac{e^{\delta_3}}{e^{\delta_3} + e^{\delta_4}}\gamma_o + \dfrac{e^{\delta_4}}{e^{\delta_3} + e^{\delta_4}}\gamma_d & \text{if } d = 1\\ \\ \dfrac{e^{\delta_5}}{e^{\delta_5} + e^{\delta_6}}\gamma_o + \dfrac{e^{\delta_6}}{e^{\delta_5} + e^{\delta_6}}\gamma_d & \text{if } o \ne 1 \text{ and } d \ne 1 \end{cases} \end{equation*} To fit this model we define factors indicating movement in (upward) and out (downward) of the salariat @ <>= upward <- with(voting, origin != 1 & destination == 1) downward <- with(voting, origin == 1 & destination != 1) @ %def Then the diagonal reference model with separate weights for socially mobile groups can be estimated as follows @ <>= socialMobility <- gnm(yvar ~ Dref(origin, destination, delta = ~ 1 + downward + upward), family = binomial, data = voting) socialMobility @ %def The weights for those moving into the salariat, those moving out of the salariat and those in any other group, can be evaluated as below @ <>= DrefWeights(socialMobility) @ %def Again, the results differ slightly from those reported by \citet{Clif93}, but the essence of the results is the same: the origin weight is much larger for the downwardly mobile group than for the other groups. The weights for the upwardly mobile group are very similar to the base level weights, so the model may be simplified by only fitting separate weights for the downwardly mobile group: @ <>= downwardMobility <- gnm(yvar ~ Dref(origin, destination, delta = ~ 1 + downward), family = binomial, data = voting) downwardMobility DrefWeights(downwardMobility) @ %def \subsubsection*{\Rfunction{Dref} example 2: conformity to parental rules} %\SweaveInput{vanDerSlikEg.Rnw} Another application of diagonal reference models is given by \citet{Vand02}. The data from this paper are not publicly available\footnote{ We thank Frans van der Slik for his kindness in sending us the data.}, but we shall show how the models presented in the paper may be estimated using \Rfunction{gnm}. The data relate to the value parents place on their children conforming to their rules. There are two response variables: the mother's conformity score (MCFM) and the father's conformity score (FCFF). The data are cross-classified by two factors describing the education level of the mother (MOPLM) and the father (FOPLF), and there are six further covariates (AGEM, MRMM, FRMF, MWORK, MFCM and FFCF). In their baseline model for the mother's conformity score, \citet{Vand02} include five of the six covariates (leaving out the father's family conflict score, FCFF) and a diagonal reference term with constant weights based on the two education factors. This model may be expressed as \[ \mu_{rci} = \beta_1x_{1i} + \beta_2x_{2i} + \beta_3x_{3i} +\beta_4x_{4i} +\beta_5x_{5i} + \frac{e^{\delta_1}}{e^{\delta_1} + e^{\delta_2}}\gamma_r + \frac{e^{\delta_2}}{e^{\delta_1} + e^{\delta_2}}\gamma_c . \] The baseline model can be fitted as follows: \begin{Sinput} > set.seed(1) > A <- gnm(MCFM ~ -1 + AGEM + MRMM + FRMF + MWORK + MFCM + + Dref(MOPLM, FOPLF), family = gaussian, data = conformity, + verbose = FALSE) > A \end{Sinput} \begin{Soutput} Call: gnm(formula = MCFM ~ -1 + AGEM + MRMM + FRMF + MWORK + MFCM + Dref(MOPLM, FOPLF), family = gaussian, data = conformity, verbose = FALSE) Coefficients: AGEM MRMM FRMF 0.06363 -0.32425 -0.25324 MWORK MFCM Dref(MOPLM, FOPLF)delta1 -0.06430 -0.06043 -0.33731 Dref(MOPLM, FOPLF)delta2 Dref(., .).MOPLM|FOPLF1 Dref(., .).MOPLM|FOPLF2 -0.02505 4.95121 4.86329 Dref(., .).MOPLM|FOPLF3 Dref(., .).MOPLM|FOPLF4 Dref(., .).MOPLM|FOPLF5 4.86458 4.72343 4.43516 Dref(., .).MOPLM|FOPLF6 Dref(., .).MOPLM|FOPLF7 4.18873 4.43378 Deviance: 425.3389 Pearson chi-squared: 425.3389 Residual df: 576 \end{Soutput} The coefficients of the covariates are not aliased with the parameters of the diagonal reference term and thus the basic identifiability constraints that have been imposed are sufficient for these parameters to be identified. The diagonal effects do not need to be constrained as they represent contrasts with the off-diagonal cells. Therefore the only unidentified parameters in this model are the weight parameters. This is confirmed in the summary of the model: \begin{Sinput} > summary(A) \end{Sinput} \begin{Soutput} Call: gnm(formula = MCFM ~ -1 + AGEM + MRMM + FRMF + MWORK + MFCM + Dref(MOPLM, FOPLF), family = gaussian, data = conformity, verbose = FALSE) Deviance Residuals: Min 1Q Median 3Q Max -3.63688 -0.50383 0.01714 0.56753 2.25139 Coefficients: Estimate Std. Error t value Pr(>|t|) AGEM 0.06363 0.07375 0.863 0.38859 MRMM -0.32425 0.07766 -4.175 3.44e-05 FRMF -0.25324 0.07681 -3.297 0.00104 MWORK -0.06430 0.07431 -0.865 0.38727 MFCM -0.06043 0.07123 -0.848 0.39663 Dref(MOPLM, FOPLF)delta1 -0.33731 NA NA NA Dref(MOPLM, FOPLF)delta2 -0.02505 NA NA NA Dref(., .).MOPLM|FOPLF1 4.95121 0.16639 29.757 < 2e-16 Dref(., .).MOPLM|FOPLF2 4.86329 0.10436 46.602 < 2e-16 Dref(., .).MOPLM|FOPLF3 4.86458 0.12855 37.842 < 2e-16 Dref(., .).MOPLM|FOPLF4 4.72343 0.13523 34.929 < 2e-16 Dref(., .).MOPLM|FOPLF5 4.43516 0.19314 22.963 < 2e-16 Dref(., .).MOPLM|FOPLF6 4.18873 0.17142 24.435 < 2e-16 Dref(., .).MOPLM|FOPLF7 4.43378 0.16903 26.231 < 2e-16 --- (Dispersion parameter for gaussian family taken to be 0.7384355) Std. Error is NA where coefficient has been constrained or is unidentified Residual deviance: 425.34 on 576 degrees of freedom AIC: 1507.8 Number of iterations: 15 \end{Soutput} The weights have been constrained to sum to one as described in Section \ref{sec:Dref function}, so the weights themselves may be estimated as follows: \begin{Sinput} > prop.table(exp(coef(A)[6:7])) \end{Sinput} \begin{Soutput} Dref(MOPLM, FOPLF)delta1 Dref(MOPLM, FOPLF)delta2 0.4225638 0.5774362 \end{Soutput} However, in order to estimate corresponding standard errors, the parameters of one of the weights must be constrained. If no such constraints were applied when the model was fitted, \Rfunction{DrefWeights} will refit the model constraining the parameters of the first weight to zero: \begin{Sinput} > DrefWeights(A) \end{Sinput} \begin{Soutput} Refitting with parameters of first Dref weight constrained to zero $MOPLM weight se 0.4225636 0.1439829 $FOPLF weight se 0.5774364 0.1439829 \end{Soutput} giving the values reported by \citet{Vand02}. All the other coefficients of model A are the same as those reported by \citet{Vand02} except the coefficients of the mother's gender role (MRMM) and the father's gender role (FRMF). \citet{Vand02} reversed the signs of the coefficients of these factors since they were coded in the direction of liberal values, unlike the other covariates. However, simply reversing the signs of these coefficients does not give the same model, since the estimates of the diagonal effects depend on the estimates of these coefficients. For consistent interpretation of the covariate coefficients, it is better to recode the gender role factors as follows: \begin{Sinput} > MRMM2 <- as.numeric(!conformity$MRMM) > FRMF2 <- as.numeric(!conformity$FRMF) > A <- gnm(MCFM ~ -1 + AGEM + MRMM2 + FRMF2 + MWORK + MFCM + + Dref(MOPLM, FOPLF), family = gaussian, data = conformity, + verbose = FALSE) > A \end{Sinput} \begin{Soutput} Call: gnm(formula = MCFM ~ -1 + AGEM + MRMM2 + FRMF2 + MWORK + MFCM + Dref(MOPLM, FOPLF), family = gaussian, data = conformity, verbose = FALSE) Coefficients: AGEM MRMM2 FRMF2 0.06363 0.32425 0.25324 MWORK MFCM Dref(MOPLM, FOPLF)delta1 -0.06430 -0.06043 0.08440 Dref(MOPLM, FOPLF)delta2 Dref(., .).MOPLM|FOPLF1 Dref(., .).MOPLM|FOPLF2 0.39666 4.37371 4.28579 Dref(., .).MOPLM|FOPLF3 Dref(., .).MOPLM|FOPLF4 Dref(., .).MOPLM|FOPLF5 4.28708 4.14593 3.85767 Dref(., .).MOPLM|FOPLF6 Dref(., .).MOPLM|FOPLF7 3.61123 3.85629 Deviance: 425.3389 Pearson chi-squared: 425.3389 Residual df: 576 \end{Soutput} The coefficients of the covariates are now as reported by \citet{Vand02}, but the diagonal effects have been adjusted appropriately. \citet{Vand02} compare the baseline model for the mother's conformity score to several other models in which the weights in the diagonal reference term are dependent on one of the covariates. One particular model they consider incorporates an interaction of the weights with the mother's conflict score as follows: \[ \mu_{rci} = \beta_1x_{1i} + \beta_2x_{2i} + \beta_3x_{3i} +\beta_4x_{4i} +\beta_5x_{5i} + \frac{e^{\xi_{01} + \xi_{11}x_{5i}}}{e^{\xi_{01} + \xi_{11}x_{5i}} + e^{\xi_{02} + \xi_{12}x_{5i}}}\gamma_r + \frac{e^{\xi_{02} + \xi_{12}x_{5i}}}{e^{\xi_{01} + \xi_{11}x_{5i}} + e^{\xi_{02} + \xi_{12}x_{5i}}}\gamma_c. \] This model can be fitted as below, using the original coding for the gender role factors for ease of comparison to the results reported by \citet{Vand02}, \begin{Sinput} > F <- gnm(MCFM ~ -1 + AGEM + MRMM + FRMF + MWORK + MFCM + + Dref(MOPLM, FOPLF, delta = ~ 1 + MFCM), family = gaussian, + data = conformity, verbose = FALSE) > F \end{Sinput} \begin{Soutput} Call: gnm(formula = MCFM ~ -1 + AGEM + MRMM + FRMF + MWORK + MFCM + Dref(MOPLM, FOPLF, delta = ~1 + MFCM), family = gaussian, data = conformity, verbose = FALSE) Coefficients: AGEM 0.05818 MRMM -0.32701 FRMF -0.25772 MWORK -0.07847 MFCM -0.01694 Dref(MOPLM, FOPLF, delta = ~ . + MFCM).delta1(Intercept) 1.03515 Dref(MOPLM, FOPLF, delta = ~ 1 + .).delta1MFCM -1.77756 Dref(MOPLM, FOPLF, delta = ~ . + MFCM).delta2(Intercept) -0.03515 Dref(MOPLM, FOPLF, delta = ~ 1 + .).delta2MFCM 2.77756 Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF1 4.82476 Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF2 4.88066 Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF3 4.83969 Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF4 4.74850 Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF5 4.42020 Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF6 4.17957 Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF7 4.40819 Deviance: 420.9022 Pearson chi-squared: 420.9022 Residual df: 575 \end{Soutput} In this case there are two sets of weights, one for when the mother's conflict score is less than average (coded as zero) and one for when the score is greater than average (coded as one). These can be evaluated as follows: \begin{Sinput} > DrefWeights(F) \end{Sinput} \begin{Soutput} Refitting with parameters of first Dref weight constrained to zero $MOPLM MFCM weight se 1 1 0.02974675 0.2277711 2 0 0.74465224 0.2006916 $FOPLF MFCM weight se 1 1 0.9702532 0.2277711 2 0 0.2553478 0.2006916 \end{Soutput} giving the same weights as in Table 4 of \citet{Vand02}, though we obtain a lower standard error in the case where MFCM is equal to one. \subsection{Uniform difference (UNIDIFF) models} \label{sec:Unidiff} Uniform difference models \citep{Xie92, Erik92} use a simplified three-way interaction to provide an interpretable model of contingency tables classified by three or more variables. For example, the uniform difference model for a three-way contingency table, also known as the UNIDIFF model, is given by \[ \mu_{ijk} = \alpha_{ik} + \beta_{jk} + \exp(\delta_k)\gamma_{ij}. \] The $\gamma_{ij}$ represent a pattern of association that varies in strength over the dimension indexed by $k$, and $\exp(\delta_k)$ represents the relative strength of that association at level $k$. This model can be applied to the \Robject{yaish} data set \citep{Yais98,Yais04}, which is a contingency table cross-classified by father's social class (\Robject{orig}), son's social class (\Robject{dest}) and son's education level (\Robject{educ}). In this case, we can consider the importance of the association between the social class of father and son across the education levels. We omit the sub-table which corresponds to level 7 of \Robject{dest}, because its information content is negligible: @ <>= set.seed(1) unidiff <- gnm(Freq ~ educ*orig + educ*dest + Mult(Exp(educ), orig:dest), ofInterest = "[.]educ", family = poisson, data = yaish, subset = (dest != 7)) coef(unidiff) @ %def The \Robject{ofInterest} component has been set to index the multipliers of the association between the social class of father and son. We can contrast each multiplier to that of the lowest education level and obtain the standard errors for these parameters as follows: @ <>= getContrasts(unidiff, ofInterest(unidiff)) @ %def Four-way contingency tables may sometimes be described by a ``double UNIDIFF'' model \[ \mu_{ijkl} = \alpha_{il} + \beta_{jkl} + \exp(\delta_l)\gamma_{ij} + \exp(\phi_l)\theta_{ik}, \] where the strengths of two, two-way associations with a common variable are estimated across the levels of the fourth variable. The \Robject{cautres} data set, from \citet{Caut98}, can be used to illustrate the application of the double UNIDIFF model. This data set is classified by the variables vote, class, religion and election. Using a double UNIDIFF model, we can see how the association between class and vote, and the association between religion and vote, differ between the most recent election and the other elections: @ <>= set.seed(1) doubleUnidiff <- gnm(Freq ~ election*vote + election*class*religion + Mult(Exp(election), religion:vote) + Mult(Exp(election), class:vote), family = poisson, data = cautres) getContrasts(doubleUnidiff, rev(pickCoef(doubleUnidiff, ", class:vote"))) getContrasts(doubleUnidiff, rev(pickCoef(doubleUnidiff, ", religion:vote"))) @ %def \subsection{Generalized additive main effects and multiplicative interaction (GAMMI) models} \label{sec:GAMMI} Generalized additive main effects and multiplicative interaction models, or GAMMI models, were motivated by two-way contingency tables and comprise the row and column main effects plus one or more components of the multiplicative interaction. The singular value corresponding to each multiplicative component is often factored out, as a measure of the strength of association between the row and column scores, indicating the importance of the component, or axis. For cell means $\mu_{rc}$ a GAMMI-K model has the form \begin{equation} \label{eq:GAMMI} g(\mu_{rc}) = \alpha_r + \beta_c + \sum_{k=1}^K \sigma_k\gamma_{kr}\delta_{kc}, \end{equation} in which $g$ is a link function, $\alpha_r$ and $\beta_c$ are the row and column main effects, $\gamma_{kr}$ and $\delta_{kc}$ are the row and column scores for multiplicative component $k$ and $\sigma_k$ is the singular value for component $k$. The number of multiplicative components, $K$, is less than or equal to the rank of the matrix of residuals from the main effects. The row-column association models discussed in Section \ref{sec:RCmodels} are examples of GAMMI models, with a log link and poisson variance. Here we illustrate the use of an AMMI model, which is a GAMMI model with an identity link and a constant variance. We shall use the \Robject{wheat} data set taken from \citet{Varg01}, which gives wheat yields measured over ten years. First we scale these yields and create a new treatment factor, so that we can reproduce the analysis of \citet{Varg01}: @ <>= set.seed(1) yield.scaled <- wheat$yield * sqrt(3/1000) treatment <- interaction(wheat$tillage, wheat$summerCrop, wheat$manure, wheat$N, sep = "") @ %def Now we can fit the AMMI-1 model, to the scaled yields using the combined treatment factor and the year factor from the \Robject{wheat} dataset. We will proceed by first fitting the main effects model, then using \Rfunction{residSVD} (see Section \ref{sec:residSVD}) for the parameters of the multiplicative term: @ <>= mainEffects <- gnm(yield.scaled ~ year + treatment, family = gaussian, data = wheat) svdStart <- residSVD(mainEffects, year, treatment, 3) bilinear1 <- update(mainEffects, . ~ . + Mult(year, treatment), start = c(coef(mainEffects), svdStart[,1])) @ %def We can compare the AMMI-1 model to the main effects model, @ <>= anova(mainEffects, bilinear1, test = "F") @ %def giving the same results as in Table 1 of \citet{Varg01} (up to error caused by rounding). Thus the significance of the multiplicative interaction can be tested without applying constraints to this term. If the multiplicative interaction is significant, we may wish to apply constraints to obtain estimates of the row and column scores. We illustrate this using the \Robject{barleyHeights} data, which records the average height for 15 genotypes of barley over 9 years. For this small dataset the AMMI-1 model is easily estimated with the default settings: @ <>= set.seed(1) barleyModel <- gnm(height ~ year + genotype + Mult(year, genotype), data = barleyHeights) @ %def To obtain the parameterization of Equation \ref{eq:GAMMI} in which $\sigma_k$ is the singular value for component $k$, the row and column scores must be constrained so that the scores sum to zero and the squared scores sum to one. These contrasts can be obtained using \Robject{getContrasts}: @ <>= gamma <- getContrasts(barleyModel, pickCoef(barleyModel, "[.]y"), ref = "mean", scaleWeights = "unit") delta <- getContrasts(barleyModel, pickCoef(barleyModel, "[.]g"), ref = "mean", scaleWeights = "unit") gamma delta @ %def Confidence intervals based on the assumption of asymptotic normality can be computed as follows: @ <>= gamma[[2]][,1] + (gamma[[2]][,2]) %o% c(-1.96, 1.96) delta[[2]][,1] + (delta[[2]][,2]) %o% c(-1.96, 1.96) @ %def which broadly agree with Table 8 of Chadoeuf and Denis (1991), allowing for the change in sign. On the basis of such confidence intervals we can investigate simplifications of the model such as combining levels of the factors or fitting an additive model to a subset of the data. The singular value $\sigma_k$ may be obtained as follows @ <>= svd(termPredictors(barleyModel)[, "Mult(year, genotype)"])$d @ %def This parameter is of little interest in itself, given that the significance of the term as a whole can be tested using ANOVA. The SVD representation can also be obtained quite easily for AMMI and GAMMI models with interaction rank greater than 1\null. See \Rcode{example(wheat)} for an example of this in an AMMI model with rank 2\null. (The calculation of \emph{standard errors} and \emph{confidence regions} for the SVD representation with rank greater than 1 is not yet implemented, though.) \subsection{Biplot models} \label{sec:biplot} Biplots are graphical displays of two-dimensional arrays, which represent the objects that index both dimensions of the array on the same plot. Here we consider the case of a two-way table, where a biplot may be used to represent both the row and column categories simultaneously. A two-dimensional biplot is constructed from a rank-2 representation of the data. For two-way tables, the generalized bilinear model defines one such representation: \begin{equation*} g(\mu_{ij}) = \eta_{ij} = \alpha_{1i}\beta_{1j} + \alpha_{2i}\beta_{2j} \end{equation*} since we can alternatively write \begin{align*} \boldsymbol{\eta} &= \begin{pmatrix} \alpha_{11} & \alpha_{21} \\ \vdots & \vdots \\ \alpha_{1n} & \alpha_{2n} \\ \end{pmatrix} \begin{pmatrix} \beta_{11} & \dots & \beta_{1p} \\ \beta_{21} & \dots & \beta_{2p} \\ \end{pmatrix} \\ &= \boldsymbol{AB}^T \end{align*} where the columns of $A$ and $B$ are linearly independent by definition. To demonstrate how the biplot is obtained from this model, we shall use the \Robject{barley} data set which gives the percentage of leaf area affected by leaf blotch for ten varieties of barley grown at nine sites \citep{Wedd74,Gabr98}. As suggested by \citet{Wedd74} we model these data using a logit link and a variance proportional to the square of that of the binomial, implemented as the \Rfunction{wedderburn} family in \Rpackage{gnm} (see also Section \ref{sec:glms}): @ <>= set.seed(83) biplotModel <- gnm(y ~ -1 + instances(Mult(site, variety), 2), family = wedderburn, data = barley) @ %def The effect of site $i$ can be represented by the point \[ (\alpha_{1i}, \alpha_{2i}) \] in the space spanned by the linearly independent basis vectors \begin{align*} a_1 = (\alpha_{11}, \alpha_{12}, \ldots \alpha_{19})^T\\ a_2 = (\alpha_{21}, \alpha_{22}, \ldots \alpha_{29})^T\\ \end{align*} and the variety effects can be similarly represented. Thus we can represent the sites and varieties separately as follows \begin{Sinput} sites <- pickCoef(biplotModel, "[.]site") coefs <- coef(biplotModel) A <- matrix(coefs[sites], nc = 2) B <- matrix(coefs[-sites], nc = 2) par(mfrow = c(1, 2)) plot(A, pch = levels(barley$site), xlim = c(-5, 5), ylim = c(-5, 5), main = "Site Effects", xlab = "Component 1", ylab = "Component 2") plot(B, pch = levels(barley$variety), xlim = c(-5, 5), ylim = c(-5, 5), main = "Variety Effects", xlab = "Component 1", ylab = "Component 2") \end{Sinput} \begin{figure}[!tbph] \begin{center} \includegraphics[width = 6in]{fig-Effect_plots.pdf} \end{center} \caption{Plots of site and variety effects from the generalized bilinear model of the barley data.} \label{fig:Effect_plots} \end{figure} Of course the parameterization of the bilinear model is not unique and therefore the scale and rotation of the points in these plots will depend on the random seed. By rotation and reciprocal scaling of the matrices $A$ and $B$, we can obtain basis vectors with desirable properties without changing the fitted model. In particular, if we rotate the matrices $A$ and $B$ so that their columns are orthogonal, then the corresponding plots will display the euclidean distances between sites and varieties respectively. If we also scale the matrices $A$ and $B$ so that the corresponding plots have the same units, then we can combine the two plots to give a conventional biplot display. The required rotation and scaling can be performed via singular value decomposition of the fitted predictors: @ <>= barleyMatrix <- xtabs(biplotModel$predictors ~ site + variety, data = barley) barleySVD <- svd(barleyMatrix) A <- sweep(barleySVD$u, 2, sqrt(barleySVD$d), "*")[, 1:2] B <- sweep(barleySVD$v, 2, sqrt(barleySVD$d), "*")[, 1:2] rownames(A) <- levels(barley$site) rownames(B) <- levels(barley$variety) colnames(A) <- colnames(B) <- paste("Component", 1:2) A B @ %def These matrices are essentially the same as in \citet{Gabr98}. From these the biplot can be produced, for sites $A \ldots I$ and varieties $1 \dots 9, X$: @ <>= barleyCol <- c("red", "blue") plot(rbind(A, B), pch = c(levels(barley$site), levels(barley$variety)), col = rep(barleyCol, c(nlevels(barley$site), nlevels(barley$variety))), xlim = c(-4, 4), ylim = c(-4, 4), main = "Biplot for barley data", xlab = "Component 1", ylab = "Component 2") text(c(-3.5, -3.5), c(3.9, 3.6), c("sites: A-I","varieties: 1-9, X"), col = barleyCol, adj = 0) @ %def \begin{figure}[!tbph] \begin{center} \includegraphics{gnmOverview-Biplot1.pdf} \end{center} \caption{Biplot for barley data} \label{fig:Biplot1} \end{figure} The biplot gives an idea of how the sites and varieties are related to one another. It also allows us to consider whether the data can be represented by a simpler model than the generalized bilinear model. We see that the points in the biplot approximately align with the rotated axes shown in Figure \ref{fig:Biplot2}, such that the sites fall about a line parallel to the ``h-axis'' and the varieties group about two lines roughly parallel to the ``v-axis''. @ <>= plot(rbind(A, B), pch = c(levels(barley$site), levels(barley$variety)), col = rep(barleyCol, c(nlevels(barley$site), nlevels(barley$variety))), xlim = c(-4, 4), ylim = c(-4, 4), main = "Biplot for barley data", xlab = "Component 1", ylab = "Component 2") text(c(-3.5, -3.5), c(3.9, 3.6), c("sites: A-I","varieties: 1-9, X"), col = barleyCol, adj = 0) abline(a = 0, b = tan(pi/3)) abline(a = 0, b = -tan(pi/6)) abline(a = 2.6, b = tan(pi/3), lty = 2) abline(a = 4.5, b = tan(pi/3), lty = 2) abline(a = 1.3, b = -tan(pi/6), lty = 2) text(2.8, 3.9, "v-axis", font = 3) text(3.8, -2.7, "h-axis", font = 3) @ %def %abline(a = 0, b = tan(3*pi/10), lty = 4) %abline(a = 0, b = -tan(pi/5), lty = 4) \begin{figure}[!tbph] \begin{center} \includegraphics{gnmOverview-Biplot2.pdf} \end{center} \caption{Biplot for barley data, showing approximate alignment with rotated axes.} \label{fig:Biplot2} \end{figure} This suggests that the sites could be represented by points along a line, with co-ordinates \begin{equation*} (\gamma_i, \delta_0). \end{equation*} and the varieties by points on two lines perpendicular to the site line: \begin{equation*} (\nu_0 + \nu_1I(i \in \{2, 3, 6\}), \omega_j) \end{equation*} This corresponds to the following simplification of the bilinear model: \begin{align*} &\alpha_{1i}\beta_{1j} + \alpha_{2i}\beta_{2j} \\ \approx &\gamma_i(\nu_0 + \nu_1I(i \in \{2, 3, 6\})) + \delta_0\omega_j \end{align*} or equivalently \begin{equation*} \gamma_i(\nu_0 + \nu_1I(i \in \{2, 3, 6\})) + \omega_j, \end{equation*} the double additive model proposed by \citet{Gabr98}. We can fit this model as follows: @ <>= variety.binary <- factor(match(barley$variety, c(2,3,6), nomatch = 0) > 0, labels = c("rest", "2,3,6")) doubleAdditive <- gnm(y ~ variety + Mult(site, variety.binary), family = wedderburn, data = barley) @ %def Comparing the chi-squared statistics, we see that the double additive model is an adequate model for the leaf blotch incidence: @ <>= biplotModChiSq <- sum(residuals(biplotModel, type = "pearson")^2) doubleAddChiSq <- sum(residuals(doubleAdditive, type = "pearson")^2) c(doubleAddChiSq - biplotModChiSq, doubleAdditive$df.residual - biplotModel$df.residual) @ %def \subsection{Stereotype model for multinomial response} \label{sec:Stereotype} The stereotype model was proposed by \citet{Ande84} for ordered categorical data. It is a special case of the multinomial logistic model, in which the covariate coefficients are common to all categories but the scale of association is allowed to vary between categories such that \[ p_{ic} = \frac{\exp(\beta_{0c} + \gamma_c \boldsymbol{\beta}^T\boldsymbol{x}_{i})}{\sum_{k = 1}^K \exp(\beta_{0k} + \gamma_k \boldsymbol{\beta}^T\boldsymbol{x}_{i})} \] where $p_{ic}$ is the probability that the response for individual $i$ is category $c$ and $K$ is the number of categories. Like the multinomial logistic model, the stereotype model specifies a simple form for the log odds of one category against another, e.g. \begin{equation*} \log\left(\frac{p_{ic}}{p_{ik}}\right) = (\beta_{0c} - \beta_{0k}) + (\gamma_c - \gamma_k)\boldsymbol{\beta}^T\boldsymbol{x}_{i} \end{equation*} In order to model a multinomial response in the generalized nonlinear model framework, we must re-express the data as category counts $Y_i = (Y_{i1}, \ldots, Y_{iK})$ for each individual (or group). Then assuming a Poisson distribution for the counts $Y_{ic}$, the joint distribution of $Y_i$ is Multinomial$(N_i, p_{i1}, \ldots, p_{iK})$ conditional on the total count for each individual $N_i$. The expected counts are then $\mu_{ic} = N_ip_{ic}$ and the parameters of the stereotype model can be estimated through fitting the following model \begin{align*} \log \mu_{ic} &= \log(N_i) + \log(p_{ic}) \\ &= \alpha_i + \beta_{0c} + \gamma_c\sum_r \boldsymbol{\beta}_{r}\boldsymbol{x}_{ir} \\ \end{align*} where the ``nuisance'' parameters $\alpha_i$ ensure that the multinomial denominators are reproduced exactly, as required. The \Rpackage{gnm} package includes the utility function \Rfunction{expandCategorical} to re-express the categorical response as category counts. By default, individuals with common values across all covariates are grouped together, to avoid redundancy. For example, the \Robject{backPain} data set from \citet{Ande84} describes the progress of patients with back pain. The data set consists of an ordered factor quantifying the progress of each patient, and three prognostic variables. We re-express the data as follows: @ <>= set.seed(1) subset(backPain, x1 == 1 & x2 == 1 & x3 == 1) backPainLong <- expandCategorical(backPain, "pain") head(backPainLong) @ %def We can now fit the stereotype model to these data: @ <>= oneDimensional <- gnm(count ~ pain + Mult(pain, x1 + x2 + x3), eliminate = id, family = "poisson", data = backPainLong) oneDimensional @ %def specifying the \Robject{id} factor through \Rfunarg{eliminate} so that the 12 \Robject{id} effects are estimated more efficiently and are excluded from printed model summaries by default. This model is one dimensional since it involves only one function of $\mathbf{x} = (x1, x2, x3)$. We can compare this model to one with category-specific coefficients of the $x$ variables, as may be used for a qualitative categorical response: @ <>= threeDimensional <- gnm(count ~ pain + pain:(x1 + x2 + x3), eliminate = id, family = "poisson", data = backPainLong) threeDimensional @ %def This model has the maximum dimensionality of three (as determined by the number of covariates). The ungrouped multinomial log-likelihoods reported in \citet{Ande84} are given by \begin{equation*} \sum_{i,c} y_{ic}\log(p_{ic}) = \sum_{i,c} y_{ic}\log(\mu_{ic}/n_{ic}) \end{equation*} We write a simple function to compute this and the corresponding degrees of freedom, then compare the log-likelihoods of the one dimensional model and the three dimensional model: @ <>= logLikMultinom <- function(model, size){ object <- get(model) l <- sum(object$y * log(object$fitted/size)) c(nParameters = object$rank - nlevels(object$eliminate), logLikelihood = l) } size <- tapply(backPainLong$count, backPainLong$id, sum)[backPainLong$id] t(sapply(c("oneDimensional", "threeDimensional"), logLikMultinom, size)) @ %def showing that the \Robject{oneDimensional} model is adequate. To obtain estimates of the category-specific multipliers in the stereotype model, we need to constrain both the location and the scale of these parameters. The latter constraint can be imposed by fixing the slope of one of the covariates in the second multiplier to \Robject{1}, which may be achieved by specifying the covariate as an offset: @ <>= ## before constraint summary(oneDimensional) oneDimensional <- gnm(count ~ pain + Mult(pain, offset(x1) + x2 + x3), eliminate = id, family = "poisson", data = backPainLong) ## after constraint summary(oneDimensional) @ %def The location of the category-specific multipliers can constrained by setting one of the parameters to zero, either through the \Rfunarg{constrain} argument of \Rfunction{gnm} or with \Rfunction{getContrasts}: @ <>= getContrasts(oneDimensional, pickCoef(oneDimensional, "[.]pain")) @ %def giving the required estimates. \subsection{Lee-Carter model for trends in age-specific mortality} In the study and projection of population mortality rates, the model proposed by \cite{LeeCart92} forms the basis of many if not most current analyses. Here we consider the quasi-Poisson version of the model \citep{Wilm93, Alho00, BrouDenuVerm02, RensHabe03}, in which the death count $D_{ay}$ for individuals of age $a$ in year $y$ has mean $\mu_{ay}$ and variance $\phi\mu_{ay}$ (where $\phi$ is 1 for Poisson-distributed counts, and is respectively greater than or less than 1 in cases of over-dispersion or under-dispersion). In the Lee-Carter model, the expected counts follow the log-bilinear form \[ \log(\mu_{ay}/e_{ay}) = \alpha_a + \beta_a \gamma_y, \] where $e_{ay}$ is the `exposure' (number of lives at risk). This is a generalized nonlinear model with a single multiplicative term. The use of \Rpackage{gnm} to fit this model is straightforward. We will illustrate by using data downloaded on 2006-11-14 from the Human Mortality Database\footnote{Thanks to Iain Currie for helpful advice relating to this section} (HMD, made available by the University of California, Berkeley, and Max Planck Institute for Demographic Research, at \texttt{http://www.mortality.org}) on male deaths in Canada between 1921 and 2003. The data are not made available as part of \Rpackage{gnm} because of license restrictions; but they are readily available via the web simply by registering with the HMD. We assume that the data for Canadian males (both deaths and exposure-to-risk) have been downloaded from the HMD and organised into a data frame named \Robject{Canada} in \R, with columns \Robject{Year} (a factor, with levels \Rcode{1921} to \Rcode{2003}), \Robject{Age} (a factor, with levels \Rcode{20} to \Rcode{99}), \Robject{mDeaths} and \Robject{mExposure} (both quantitative). The Lee-Carter model may then be specified as \begin{Sinput} LCmodel.male <- gnm(mDeaths ~ Age + Mult(Exp(Age), Year), offset = log(mExposure), family = "quasipoisson", data = Canada) \end{Sinput} Here we have acknowledged the fact that the model only really makes sense if all of the $\beta_a$ parameters, which represent the `sensitivity' of age group $a$ to a change in the level of general mortality \citep[e.g.,][]{BrouDenuVerm02}, have the same sign. Without loss of generality we assume $\beta_a>0$ for all $a$, and we impose this constraint by using \Rcode{Exp(Age)} instead of just \Rcode{Age} in the multiplicative term. Convergence is to a fitted model with residual deviance 32419.83 on 6399 degrees of freedom --- representing clear evidence of substantial overdispersion relative to the Poisson distribution. In order to explore the lack of fit a little further, we plot the distribution of Pearson residuals in Figure \ref{fig:LCresplot}: \begin{Sinput} par(mfrow = c(2,2)) age <- as.numeric(as.character(Canada$Age)) with(Canada,{ res <- residuals(LCmodel.male, type = "pearson") plot(Age, res, xlab="Age", ylab="Pearson residual", main = "(a) Residuals by age") plot(Year, res, xlab="Year", ylab="Pearson residual", main = "(b) Residuals by year") plot(Year[(age>24) & (age<36)], res[(age>24) & (age<36)], xlab = "Year", ylab = "Pearson residual", main = "(c) Age group 25-35") plot(Year[(age>49) & (age<66)], res[(age>49) & (age<66)], xlab = "Year", ylab = "Pearson residual", main = "(d) Age group 50-65") }) \end{Sinput} %$ \begin{figure}[!tbph] \begin{center} \includegraphics[width=6in]{fig-LCall.pdf} \end{center} \caption{Canada, males: plots of residuals from the Lee-Carter model of mortality} \label{fig:LCresplot} \end{figure} Panel (a) of Figure \ref{fig:LCresplot} indicates that the overdispersion is not evenly spread through the data, but is largely concentrated in two age groups, roughly ages 25--35 and 50--65\null. Panels (c) and (d) focus on the residuals in each of these two age groups: there is a clear (and roughly cancelling) dependence on \Robject{Year}, indicating that the assumed bilinear interaction between \Robject{Age} and \Robject{Year} does not hold for the full range of ages and years considered here. A somewhat more satisfactory Lee-Carter model fit is obtained if only a subset of the data is used, namely only those males aged 45 or over: \begin{Sinput} LCmodel.maleOver45 <- gnm(mDeaths ~ Age + Mult(Exp(Age), Year), offset = log(mExposure), family = "quasipoisson", data = Canada[age>44,]) \end{Sinput} The residual deviance now is 12595.44 on 4375 degrees of freedom: still substantially overdispersed, but less severely so than before. Again we plot the distributions of Pearson residuals (Figure \ref{fig:LCresplot2}). \begin{figure}[!tbph] \begin{center} \includegraphics[width=6in]{fig-LCover45.pdf} \end{center} \caption{Canada, males over 45: plots of residuals from the Lee-Carter model of mortality} \label{fig:LCresplot2} \end{figure} Still clear departures from the assumed bilinear structure are evident, especially for age group 81--89; but they are less pronounced than in the previous model fit. The main purpose here is only to illustrate how straightforward it is to work with the Lee-Carter model using \Rfunction{gnm}, but we will take this example a little further by examining the estimated $\beta_a$ parameters from the last fitted model. We can use \Rfunction{getContrasts} to compute quasi standard errors for the logarithms of $\hat\beta_a$ --- the logarithms being the result of having used \Rcode{Exp(Age)} in the model specification --- and use these in a plot of the coefficients: \begin{Sinput} AgeContrasts <- getContrasts(LCmodel.maleOver45, 56:100) ## ages 45 to 89 only \end{Sinput} \begin{figure}[!tbph] \begin{center} \includegraphics{fig-LCqvplot.pdf} \end{center} \caption{Canada, males over 45, Lee-Carter model: relative sensitivity of different ages to change in total mortality.} \label{fig:LCqvplot} \end{figure} The plot shows that sensitivity to the general level of mortality is highest at younger ages, as expected. An \emph{unexpected} feature is the clear outlying positions occupied by the estimates for ages 51, 61, 71 and 81: for each of those ages, the estimated $\beta_a$ coefficient is substantially less than it is for the neighbouring age groups (and the error bars indicate clearly that the deviations are larger than could plausibly be due to chance variation). This is a curious finding. An explanation comes from a look back at the raw death-count data. In the years between 1921 and 1940, the death counts for ages 31, 41, 51, 61, 71 and 81 all stand out as being very substantially lower than those of neighbouring ages (Figure \ref{fig:deaths2140}: the ages concerned are highlighted in solid red). The same does \emph{not} hold for later years: after about 1940, the `1' ages fall in with the general pattern. This apparent `age heaping\footnote{Age heaping is common in mortality data: see \url{http://www.mortality.org/Public/Overview.php}}' explains our finding above regarding the $\beta_a$ coefficients: whilst all age groups have benefited from the general trend of reduced mortality, the `1' age groups appear to have benefited least because their starting point (in the 1920s and 1930s) was lower than would have been indicated by the general pattern --- hence $\hat\beta_a$ is smaller for ages $a=31$, $a=41$,\ldots, $a=81$. \begin{figure}[!tbph] \begin{center} \includegraphics{fig-deaths1921-1940.pdf} \end{center} \caption{Canada, males: Deaths 1921 to 1940 by age} \label{fig:deaths2140} \end{figure} \subsection{Exponential and sum-of-exponentials models for decay curves} A class of nonlinear functions which arise in various application contexts --- a notable one being pharmacokinetic studies -- involves one or more \emph{exponential decay} terms. For example, a simple decay model with additive error is \begin{equation} \label{eq:singleExp} y = \alpha + \exp(\beta + \gamma x) + e \end{equation} (with $\gamma<0$), while a more complex (`sum of exponentials') model might involve two decay terms: \begin{equation} \label{eq:twoExp} y = \alpha + \exp(\beta_1 + \gamma_1 x) + \exp(\beta_2+ \gamma_2 x) + e. \end{equation} Estimation and inference with such models are typically not straightforward, partly on account of multiple local maxima in the likelihood \citep[e.g.,][Ch.3]{Sebe89}. We illustrate the difficulties here, with a couple of artificial examples. These examples will make clear the value of making repeated calls to \Rfunction{gnm}, in order to use different, randomly-generated parameterizations and starting values and thus improve the chances of locating both the global maximum and all local maxima of the likelihood. \subsubsection{Example: single exponential decay term} Let us first construct some data from model (\ref{eq:singleExp}). For our illustrative purposes here, we will use \emph{noise-free} data, i.e., we fix the variance of $e$ to be zero; for the other parameters we will use $\alpha=0$, $\beta = 0$, $\gamma = -0.1$. @ <>= x <- 1:100 y <- exp(- x / 10) set.seed(1) saved.fits <- list() for (i in 1:100) saved.fits[[i]] <- gnm(y ~ Exp(1 + x), verbose = FALSE) table(zapsmall(sapply(saved.fits, deviance))) @ %def The \Robject{saved.fits} object thus contains the results of 100 calls to \Rfunction{gnm}, each using a different, randomly-generated starting value for the vector of parameters $(\alpha, \beta, \gamma)$. Out of 100 fits, 52 reproduce the data exactly, to machine accuracy. The remaining 48 fits are all identical to one another, but they are far from globally optimal, with residual sum of squares 3.61: they result from divergence of $\hat\gamma$ to $+\infty$, and correspondingly of $\hat\beta$ to $-\infty$, such that the fitted `curve' is in fact just a constant, with level equal to $\bar{y}=0.09508$. For example, the second of the 100 fits is of this kind: @ <>= saved.fits[[2]] @ %def The use of repeated calls to \Rfunction{gnm}, as here, allows the local and global maxima to be easily distinguished. \subsubsection{Example: sum of two exponentials} We can conduct a similar exercise based on the more complex model (\ref{eq:twoExp}): @ <>= x <- 1:100 y <- exp(- x / 10) + 2 * exp(- x / 50) set.seed(1) saved.fits <- list() for (i in 1:100) { saved.fits[[i]] <- suppressWarnings(gnm(y ~ Exp(1 + x, inst = 1) + Exp(1 + x, inst = 2), verbose = FALSE)) } table(round(unlist(sapply(saved.fits, deviance)), 4)) @ %def In this instance, only 27 of the 100 calls to \Rfunction{gnm} have successfully located a local maximum of the likelihood: in the remaining 73 cases the starting values generated were such that numerical problems resulted, and the fitting algorithm was abandoned (giving a \Robject{NULL} result). Among the 27 `successful' fits, it is evident that there are three distinct solutions (with respective residual sums of squares equal to 0.1589, 41.64, and essentially zero --- the last of these, the exact fit to the data, having been found 20 times out of the above 27). The two non-optimal local maxima here correspond to the best fit with a single exponential (which has residual sum of squares 0.1589) and to the fit with no dependence at all on $x$ (residual sum of squares 41.64), as we can see by comparing with: @ <>= singleExp <- gnm(y ~ Exp(1 + x), start = c(NA, NA, -0.1), verbose = FALSE) singleExp meanOnly <- gnm(y ~ 1, verbose = FALSE) meanOnly plot(x, y, main = "Two sub-optimal fits to a sum-of-exponentials curve") lines(x, fitted(singleExp)) lines(x, fitted(meanOnly), lty = "dashed") @ %def \begin{figure}[!tbph] \centering \includegraphics{gnmOverview-doubleExp2.pdf} \caption{Two sub-optimal fits to a sum-of-exponentials curve} \label{fig:doubleExp} \end{figure} In this example, it is clear that even a small amount of noise in the data would make it practically impossible to distinguish between competing models containing one and two exponential-decay terms. In summary: the default \Rfunction{gnm} setting of randomly-chosen starting values is useful for identifying multiple local maxima in the likelihood; and reasonably good starting values are needed if the global maximum is to be found. In the present example, knowing that $\gamma_1$ and $\gamma_2$ should both be small and negative, we might perhaps have tried @ <>= gnm(y ~ instances(Exp(1 + x), 2), start = c(NA, NA, -0.1, NA, -0.1), verbose = FALSE) @ %def which reliably yields the (globally optimal) perfect fit to the data. \newpage \appendix \section{User-level functions} We list here, for easy reference, all of the user-level functions in the \Rpackage{gnm} package. For full documentation see the package help pages. \begin{table}[!h] \begin{tabular*}{\textwidth}{@{}p{0.2in}p{1.3in}p{4.5in}@{}} \toprule \multicolumn{3}{l}{\textbf{Model Fitting}} \\ \midrule & \Rfunction{gnm} & fit generalized nonlinear models \\ \midrule \multicolumn{3}{l}{\textbf{Model Specification}} \\ \midrule & \Rfunction{Diag} & create factor differentiating diagonal elements \\ & \Rfunction{Symm} & create symmetric interaction of factors \\ & \Rfunction{Topo} & create `topological' interaction factors \\ & \Rfunction{Const} & specify a constant in a \Rclass{nonlin} function predictor \\ & \Rfunction{Dref} & specify a diagonal reference term in a \Rfunction{gnm} model formula \\ & \Rfunction{Mult} & specify a product of predictors in a \Rfunction{gnm} formula \\ & \Rfunction{MultHomog} & specify a multiplicative interaction with homogeneous effects in a \Rfunction{gnm} formula \\ & \Rfunction{Exp} & specify the exponential of a predictor in a \Rfunction{gnm} formula \\ % & \Rfunction{Log} & specify the natural logarithm of a predictor in a % \Rfunction{gnm} formula \\ % & \Rfunction{Logit} & specify the logit of a predictor in a % \Rfunction{gnm} formula \\ & \Rfunction{Inv} & specify the reciprocal of a predictor in a \Rfunction{gnm} formula \\ % & \Rfunction{Raise} & specify a predictor raised to a constant % power in a \Rfunction{gnm} formula \\ & \Rfunction{wedderburn} & specify the Wedderburn quasi-likelihood family \\ \midrule \multicolumn{3}{l}{\textbf{Methods and Accessor Functions}} \\ \midrule & \Rmethod{confint.gnm} & compute confidence intervals of \Rclass{gnm} parameters based on the profiled deviance \\ & \Rmethod{confint.profile.gnm} & compute confidence intervals of parameters from a \Rclass{profile.gnm} object \\ & \Rmethod{predict.gnm} & predict from a \Rclass{gnm} model \\ & \Rmethod{profile.gnm} & profile deviance for parameters in a \Rclass{gnm} model \\ & \Rmethod{plot.profile.gnm} & plot profile traces from a \Rclass{profile.gnm} object \\ & \Rmethod{summary.gnm} & summarize \Rclass{gnm} fits \\ & \Rfunction{residSVD} & multiplicative approximation of model residuals \\ & \Rfunction{exitInfo} & print numerical details of last iteration when \Rfunction{gnm} has not converged \\ & \Rfunction{ofInterest} & extract the \Robject{ofInterest} component of a \Rclass{gnm} object \\ & \Rfunction{ofInterest<-} & replace the \Robject{ofInterest} component of a \Rclass{gnm} object \\ & \Rfunction{parameters} & get model parameters from a \Rclass{gnm} object, including parameters that were constrained \\ & \Rfunction{pickCoef} & get indices of model parameters \\ & \Rfunction{getContrasts} & estimate contrasts and their standard errors for parameters in a \Rclass{gnm} model \\ & \Rfunction{checkEstimable} & check whether one or more parameter combinations in a \Rclass{gnm} model is identified \\ & \Rfunction{se} & get standard errors of linear parameter combinations in \Rclass{gnm} models \\ & \Rfunction{Dref} & estimate weights and corresponding standard errors for a diagonal reference term in a \Rclass{gnm} model \\ & \Rfunction{termPredictors} & (\emph{generic}) extract term contributions to predictor \\ \midrule \multicolumn{3}{l}{\textbf{Auxiliary Functions}} \\ \midrule & \Rfunction{asGnm} & coerce an object of class \Rclass{lm} or \Rclass{glm} to class \Rclass{gnm} \\ & \Rfunction{expandCategorical} & expand a data frame by re-expressing categorical data as counts \\ & \Rfunction{getModelFrame} & get the model frame in use by \Rfunction{gnm} \\ & \Rfunction{MPinv} & Moore-Penrose pseudoinverse of a real-valued matrix \\ & \Rfunction{qrSolve} & Minimum-length solution of a linear system\\ \end{tabular*} \end{table} \newpage \bibliography{gnm} \bibliographystyle{jss} \end{document} gnm/vignettes/fig-LCqvplot.pdf0000744000176200001440000001625513152512335016057 0ustar liggesusers%PDF-1.1 %ρ\r 1 0 obj << /CreationDate (D:20061218174133) /ModDate (D:20061218174133) /Title (R Graphics Output) /Producer (R 2.4.1) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 5 0 obj << /Type /Font /Subtype /Type1 /Name /F1 /BaseFont /ZapfDingbats >> endobj 6 0 obj << /Type /Page /Parent 3 0 R /Contents 7 0 R /Resources 4 0 R >> endobj 7 0 obj << /Length 8 0 R >> stream q Q q 59.04 73.44 378.72 335.52 re W n 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 70.10 359.09 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 78.07 339.04 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 86.04 340.06 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 94.01 340.98 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 101.98 336.39 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 109.95 346.70 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 117.92 313.89 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 125.89 337.12 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 133.86 326.43 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 141.83 318.49 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 149.80 317.46 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 157.77 310.69 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 165.74 302.80 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 173.71 314.78 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 181.68 303.23 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 189.65 307.08 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 197.62 268.32 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 205.59 294.42 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 213.56 293.54 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 221.53 285.33 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 229.50 292.74 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 237.47 251.85 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 245.44 259.33 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 253.41 271.84 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 261.38 261.43 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 269.35 256.54 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 277.32 221.27 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 285.29 259.30 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 293.26 252.63 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 301.23 242.81 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 309.20 241.76 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 317.17 237.95 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 325.14 223.36 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 333.10 236.22 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 341.07 220.15 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 349.04 200.67 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 357.01 156.14 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 364.98 191.07 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 372.95 188.09 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 380.92 192.73 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 388.89 165.53 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 396.86 171.70 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 404.83 162.30 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 412.80 134.21 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 420.77 131.07 Tm (l) Tj 0 Tr ET Q q 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 112.92 73.44 m 431.70 73.44 l S 112.92 73.44 m 112.92 66.24 l S 192.61 73.44 m 192.61 66.24 l S 272.31 73.44 m 272.31 66.24 l S 352.01 73.44 m 352.01 66.24 l S 431.70 73.44 m 431.70 66.24 l S BT 0.000 0.000 0.000 rg /F2 1 Tf 12.00 0.00 -0.00 12.00 106.24 47.52 Tm (50) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 185.94 47.52 Tm (60) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 265.64 47.52 Tm (70) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 345.33 47.52 Tm (80) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 425.03 47.52 Tm (90) Tj ET 59.04 98.78 m 59.04 361.69 l S 59.04 98.78 m 51.84 98.78 l S 59.04 186.42 m 51.84 186.42 l S 59.04 274.05 m 51.84 274.05 l S 59.04 361.69 m 51.84 361.69 l S BT /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 86.94 Tm (-1.5) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 174.57 Tm (-1.0) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 262.21 Tm (-0.5) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 353.35 Tm (0.0) Tj ET 59.04 73.44 m 437.76 73.44 l 437.76 408.96 l 59.04 408.96 l 59.04 73.44 l S Q q BT 0.000 0.000 0.000 rg /F3 1 Tf 14.00 0.00 -0.00 14.00 44.73 442.09 Tm (Canada, males over 45, Lee-Carter model: relative sensitivity) Tj /F3 1 Tf 14.00 0.00 -0.00 14.00 102.47 424.81 Tm (of different ages to change in total mortality) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 237.73 18.72 Tm (Age) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 12.96 217.52 Tm (log\(beta\)) Tj ET Q q 59.04 73.44 378.72 335.52 re W n 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 73.07 352.73 m 73.07 370.64 l S 81.04 331.98 m 81.04 351.29 l S 89.01 333.36 m 89.01 351.94 l S 96.98 334.69 m 96.98 352.45 l S 104.95 330.15 m 104.95 347.82 l S 112.92 341.22 m 112.92 357.37 l S 120.88 307.06 m 120.88 325.91 l S 128.85 331.73 m 128.85 347.69 l S 136.82 320.80 m 136.82 337.27 l S 144.79 312.80 m 144.79 329.37 l S 152.76 311.90 m 152.76 328.21 l S 160.73 305.08 m 160.73 321.49 l S 168.70 297.04 m 168.70 313.75 l S 176.67 309.76 m 176.67 324.99 l S 184.64 297.95 m 184.64 313.70 l S 192.61 302.22 m 192.61 317.14 l S 200.58 261.85 m 200.58 279.97 l S 208.55 289.47 m 208.55 304.56 l S 216.52 288.73 m 216.52 303.53 l S 224.49 280.41 m 224.49 295.45 l S 232.46 288.37 m 232.46 302.29 l S 240.43 245.83 m 240.43 263.07 l S 248.40 253.92 m 248.40 269.92 l S 256.37 267.16 m 256.37 281.72 l S 264.34 256.50 m 264.34 271.56 l S 272.31 251.58 m 272.31 266.68 l S 280.28 214.69 m 280.28 233.05 l S 288.25 254.70 m 288.25 269.09 l S 296.22 247.83 m 296.22 262.62 l S 304.19 237.67 m 304.19 253.14 l S 312.16 236.61 m 312.16 252.10 l S 320.13 232.67 m 320.13 248.43 l S 328.10 217.35 m 328.10 234.56 l S 336.07 230.82 m 336.07 246.81 l S 344.04 213.92 m 344.04 231.58 l S 352.01 193.33 m 352.01 213.20 l S 359.98 145.60 m 359.98 171.87 l S 367.95 182.70 m 367.95 204.63 l S 375.92 179.22 m 375.92 202.15 l S 383.88 183.77 m 383.88 206.88 l S 391.85 154.03 m 391.85 182.23 l S 399.82 160.09 m 399.82 188.51 l S 407.79 149.06 m 407.79 180.73 l S 415.76 116.95 m 415.76 156.66 l S 423.73 111.76 m 423.73 155.58 l S BT 0.000 0.000 0.000 rg /F2 1 Tf 12.00 0.00 -0.00 12.00 340.96 130.85 Tm (Age 81) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 261.26 200.96 Tm (Age 71) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 181.57 248.28 Tm (Age 61) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 101.87 292.10 Tm (Age 51) Tj ET Q endstream endobj 8 0 obj 5932 endobj 3 0 obj << /Type /Pages /Kids [ 6 0 R ] /Count 1 /MediaBox [0 0 468 468] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font << /F1 5 0 R /F2 10 0 R /F3 11 0 R >> /ExtGState << >> >> endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 9 0 R >> endobj xref 0 12 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000006380 00000 n 0000006463 00000 n 0000000212 00000 n 0000000295 00000 n 0000000375 00000 n 0000006360 00000 n 0000006567 00000 n 0000006824 00000 n 0000006921 00000 n trailer << /Size 12 /Info 1 0 R /Root 2 0 R >> startxref 7023 %%EOF gnm/vignettes/fig-profilePlot.pdf0000744000176200001440000002411513152512335016604 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20060922120623) /ModDate (D:20060922120623) /Title (R Graphics Output) /Producer (R 2.3.1) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 5 0 obj << /Type /Font /Subtype /Type1 /Name /F1 /BaseFont /ZapfDingbats >> endobj 6 0 obj << /Type /Page /Parent 3 0 R /Contents 7 0 R /Resources 4 0 R >> endobj 7 0 obj << /Length 8 0 R >> stream q Q q 49.00 258.21 123.52 87.29 re W n Q q 0.00 0.00 395.25 394.50 re W n /GS1 gs 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 70.08 258.21 m 156.96 258.21 l S 70.08 258.21 m 70.08 252.23 l S 91.80 258.21 m 91.80 252.23 l S 113.52 258.21 m 113.52 252.23 l S 135.24 258.21 m 135.24 252.23 l S 156.96 258.21 m 156.96 252.23 l S BT /GS257 gs 0.000 0.000 0.000 rg /F2 1 Tf 10.00 0.00 0.00 10.00 60.21 236.69 Tm (-0.6) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 103.65 236.69 Tm (-0.2) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 150.01 236.69 Tm (0.2) Tj ET 49.00 270.41 m 49.00 339.93 l S 49.00 270.41 m 43.03 270.41 l S 49.00 284.31 m 43.03 284.31 l S 49.00 298.22 m 43.03 298.22 l S 49.00 312.12 m 43.03 312.12 l S 49.00 326.03 m 43.03 326.03 l S 49.00 339.93 m 43.03 339.93 l S BT /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 264.71 Tm (-2) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 295.44 Tm (0) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 309.34 Tm (1) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 323.25 Tm (2) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 337.15 Tm (3) Tj ET 49.00 258.21 m 172.53 258.21 l 172.53 345.50 l 49.00 345.50 l 49.00 258.21 l S Q q 0.00 197.25 197.62 197.25 re W n BT /GS257 gs 0.000 0.000 0.000 rg /F2 1 Tf 10.00 0.00 0.00 10.00 47.61 212.79 Tm (Mult\(Exp\(.\), orig:dest\).educ2) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 10.76 299.35 Tm (z) Tj ET Q q 49.00 258.21 123.52 87.29 re W n /GS1 gs 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 107.60 298.22 m 113.93 298.22 l S 110.76 295.05 m 110.76 301.39 l S 53.58 261.44 m 57.15 263.38 l 60.73 265.37 l 64.30 267.41 l 67.87 269.51 l 71.45 271.65 l 75.02 273.84 l 78.60 276.08 l 82.17 278.37 l 85.75 280.70 l 89.32 283.08 l 92.89 285.51 l 96.47 287.97 l 100.04 290.48 l 103.62 293.02 l 107.19 295.60 l 110.76 298.22 l 114.34 300.86 l 117.91 303.54 l 121.49 306.23 l 125.06 308.96 l 128.64 311.70 l 132.21 314.46 l 135.78 317.23 l 139.36 320.01 l 142.93 322.80 l 146.51 325.60 l 150.08 328.39 l 153.65 331.18 l 157.23 333.97 l 160.80 336.75 l 164.38 339.51 l 167.95 342.26 l S Q q 246.63 258.21 123.52 87.29 re W n Q q 0.00 0.00 395.25 394.50 re W n /GS1 gs 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 260.61 258.21 m 364.24 258.21 l S 260.61 258.21 m 260.61 252.23 l S 295.15 258.21 m 295.15 252.23 l S 329.69 258.21 m 329.69 252.23 l S 364.24 258.21 m 364.24 252.23 l S BT /GS257 gs 0.000 0.000 0.000 rg /F2 1 Tf 10.00 0.00 0.00 10.00 250.74 236.69 Tm (-1.5) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 285.28 236.69 Tm (-1.0) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 319.82 236.69 Tm (-0.5) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 357.29 236.69 Tm (0.0) Tj ET 246.63 265.03 m 246.63 341.28 l S 246.63 265.03 m 240.65 265.03 l S 246.63 280.28 m 240.65 280.28 l S 246.63 295.53 m 240.65 295.53 l S 246.63 310.78 m 240.65 310.78 l S 246.63 326.03 m 240.65 326.03 l S 246.63 341.28 m 240.65 341.28 l S BT /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 259.33 Tm (-2) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 292.75 Tm (0) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 308.00 Tm (1) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 323.25 Tm (2) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 338.50 Tm (3) Tj ET 246.63 258.21 m 370.15 258.21 l 370.15 345.50 l 246.63 345.50 l 246.63 258.21 l S Q q 197.62 197.25 197.62 197.25 re W n BT /GS257 gs 0.000 0.000 0.000 rg /F2 1 Tf 10.00 0.00 0.00 10.00 245.24 212.79 Tm (Mult\(Exp\(.\), orig:dest\).educ3) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 208.38 299.35 Tm (z) Tj ET Q q 246.63 258.21 123.52 87.29 re W n /GS1 gs 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 309.71 295.53 m 316.05 295.53 l S 312.88 292.36 m 312.88 298.70 l S 251.20 261.44 m 254.21 262.58 l 257.22 263.77 l 260.23 265.00 l 263.24 266.29 l 266.25 267.62 l 269.26 269.01 l 272.27 270.45 l 275.28 271.94 l 278.29 273.49 l 281.30 275.10 l 284.31 276.76 l 287.32 278.48 l 290.33 280.26 l 293.34 282.10 l 296.35 284.00 l 299.36 285.97 l 302.37 287.99 l 305.38 290.08 l 308.39 292.22 l 311.40 294.43 l 314.41 296.69 l 317.42 299.01 l 320.43 301.40 l 323.44 303.83 l 326.45 306.32 l 329.46 308.86 l 332.47 311.45 l 335.48 314.09 l 338.49 316.77 l 341.50 319.49 l 344.51 322.25 l 347.52 325.04 l 350.53 327.86 l 353.54 330.71 l 356.55 333.58 l 359.56 336.46 l 362.57 339.36 l 365.58 342.26 l S Q q 49.00 60.96 123.52 87.29 re W n Q q 0.00 0.00 395.25 394.50 re W n /GS1 gs 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 67.42 60.96 m 164.72 60.96 l S 67.42 60.96 m 67.42 54.98 l S 86.88 60.96 m 86.88 54.98 l S 106.34 60.96 m 106.34 54.98 l S 125.80 60.96 m 125.80 54.98 l S 145.26 60.96 m 145.26 54.98 l S 164.72 60.96 m 164.72 54.98 l S BT /GS257 gs 0.000 0.000 0.000 rg /F2 1 Tf 10.00 0.00 0.00 10.00 57.55 39.44 Tm (-2.5) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 96.47 39.44 Tm (-1.5) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 135.39 39.44 Tm (-0.5) Tj ET 49.00 65.60 m 49.00 144.92 l S 49.00 65.60 m 43.03 65.60 l S 49.00 81.47 m 43.03 81.47 l S 49.00 97.33 m 43.03 97.33 l S 49.00 113.19 m 43.03 113.19 l S 49.00 129.06 m 43.03 129.06 l S 49.00 144.92 m 43.03 144.92 l S BT /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 59.90 Tm (-2) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 94.55 Tm (0) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 110.41 Tm (1) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 126.28 Tm (2) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 142.14 Tm (3) Tj ET 49.00 60.96 m 172.53 60.96 l 172.53 148.25 l 49.00 148.25 l 49.00 60.96 l S Q q 0.00 0.00 197.62 197.25 re W n BT /GS257 gs 0.000 0.000 0.000 rg /F2 1 Tf 10.00 0.00 0.00 10.00 47.61 15.54 Tm (Mult\(Exp\(.\), orig:dest\).educ4) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 10.76 102.10 Tm (z) Tj ET Q q 49.00 60.96 123.52 87.29 re W n /GS1 gs 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 121.12 97.33 m 127.45 97.33 l S 124.28 94.16 m 124.28 100.50 l S 53.58 64.19 m 56.18 64.63 l 58.78 65.10 l 61.38 65.61 l 63.98 66.16 l 66.58 66.75 l 69.17 67.38 l 71.77 68.05 l 74.37 68.78 l 76.97 69.56 l 79.57 70.39 l 82.17 71.29 l 84.77 72.25 l 87.37 73.28 l 89.97 74.38 l 92.57 75.56 l 95.17 76.82 l 97.77 78.17 l 100.37 79.60 l 102.97 81.12 l 105.57 82.74 l 108.17 84.46 l 110.76 86.27 l 113.36 88.19 l 115.96 90.21 l 118.56 92.32 l 121.16 94.54 l 123.76 96.85 l 126.36 99.26 l 128.96 101.76 l 131.56 104.35 l 134.16 107.02 l 136.76 109.76 l 139.36 112.57 l 141.96 115.44 l 144.56 118.37 l 147.16 121.34 l 149.76 124.35 l 152.35 127.39 l 154.95 130.45 l 157.55 133.49 l 160.15 136.50 l 162.75 139.43 l 165.35 142.28 l 167.95 145.01 l S Q q 246.63 60.96 123.52 87.29 re W n Q q 0.00 0.00 395.25 394.50 re W n /GS1 gs 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 256.84 60.96 m 362.65 60.96 l S 256.84 60.96 m 256.84 54.98 l S 283.29 60.96 m 283.29 54.98 l S 309.74 60.96 m 309.74 54.98 l S 336.20 60.96 m 336.20 54.98 l S 362.65 60.96 m 362.65 54.98 l S BT /GS257 gs 0.000 0.000 0.000 rg /F2 1 Tf 10.00 0.00 0.00 10.00 251.14 39.44 Tm (-8) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 277.59 39.44 Tm (-6) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 304.04 39.44 Tm (-4) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 330.50 39.44 Tm (-2) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 359.87 39.44 Tm (0) Tj ET 246.63 62.64 m 246.63 128.34 l S 246.63 62.64 m 240.65 62.64 l S 246.63 84.54 m 240.65 84.54 l S 246.63 106.44 m 240.65 106.44 l S 246.63 128.34 m 240.65 128.34 l S BT /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 56.94 Tm (-1) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 81.76 Tm (0) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 103.66 Tm (1) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 125.56 Tm (2) Tj ET 246.63 60.96 m 370.15 60.96 l 370.15 148.25 l 246.63 148.25 l 246.63 60.96 l S Q q 197.62 0.00 197.62 197.25 re W n BT /GS257 gs 0.000 0.000 0.000 rg /F2 1 Tf 10.00 0.00 0.00 10.00 245.24 15.54 Tm (Mult\(Exp\(.\), orig:dest\).educ5) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 208.38 102.10 Tm (z) Tj ET Q q 246.63 60.96 123.52 87.29 re W n /GS1 gs 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 329.73 84.54 m 336.07 84.54 l S 332.90 81.37 m 332.90 87.71 l S 251.20 64.19 m 253.80 64.20 l 256.40 64.21 l 259.00 64.22 l 261.60 64.24 l 264.20 64.26 l 266.80 64.29 l 269.40 64.32 l 272.00 64.36 l 274.60 64.41 l 277.20 64.46 l 279.80 64.53 l 282.40 64.62 l 285.00 64.72 l 287.59 64.84 l 290.19 64.99 l 292.79 65.18 l 295.39 65.40 l 297.99 65.68 l 300.59 66.01 l 303.19 66.41 l 305.79 66.90 l 308.39 67.50 l 310.99 68.22 l 313.59 69.10 l 316.19 70.16 l 318.79 71.45 l 321.39 73.00 l 323.99 74.88 l 326.59 77.13 l 329.18 79.82 l 331.78 83.00 l 334.38 86.76 l 336.98 91.11 l 339.58 96.06 l 342.18 101.63 l 344.78 107.67 l 347.38 113.90 l 349.98 120.03 l 352.58 125.82 l 355.18 131.14 l 357.78 135.86 l 360.38 139.85 l 362.98 142.95 l 365.58 145.01 l S Q q 0.00 0.00 395.25 394.50 re W n BT /GS257 gs 0.000 0.000 0.000 rg /F3 1 Tf 11.00 0.00 0.00 11.00 56.26 361.03 Tm (Profile traces for the multipliers of the orig:dest association) Tj ET Q endstream endobj 8 0 obj 8744 endobj 3 0 obj << /Type /Pages /Kids [ 6 0 R ] /Count 1 /MediaBox [0 0 395 394] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font << /F1 5 0 R /F2 10 0 R /F3 11 0 R >> /ExtGState << /GS1 12 0 R /GS257 13 0 R >> >> endobj 9 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 9 0 R >> endobj 11 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 9 0 R >> endobj 12 0 obj << /Type /ExtGState /CA 1.000 >> endobj 13 0 obj << /Type /ExtGState /ca 1.000 >> endobj xref 0 14 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000009192 00000 n 0000009275 00000 n 0000000212 00000 n 0000000295 00000 n 0000000375 00000 n 0000009172 00000 n 0000009405 00000 n 0000009662 00000 n 0000009759 00000 n 0000009861 00000 n 0000009910 00000 n trailer << /Size 14 /Info 1 0 R /Root 2 0 R >> startxref 9959 %%EOF gnm/vignettes/screenshot3.png0000744000176200001440000020165713152512335016025 0ustar liggesusersPNG  IHDR2pTsRGB pHYs  tIME 3c IDATxw|UǙ9vuTAH $!QEl 8q vvױ7mwdc;=&v8qQ A4K4!!DPnǽP rι<3gt~̙!R&( U($IA  ch"0 C0 GBR?DFw3=&_~tq7\~= e}.^˫{{.b ^|T@Soד/>]$|_>=wsqK+?CּOP U\E}.︄һskJ}1:~߃&S3 (E>00vA-nB8EQz]@?KAAngE@AA,˜1*T PR WRJ(!0,˸ PJ !x3Ad`M}xYEQeYnfY±,q]gQJ @""ˊ(20 ð,s ˲ CAGAk(/SQgv\䔨C^Sg7nqZVq R*劉  0۷Uϲ,G H2%,ރ_dn6N`qX;JPnZLrem.0_T7kz\RSDY3 >d^Q\.q:mL^E* a`°2/yRJ]|FzzPP%XaYc(XߕRis؝$S R>ѨlAh|V*Ezw?hUed^ S>tjȦ K tZ_W/:mөrO*0 wBQT[I*ׄ ?g×e8B@Q@e?BRmEB De|{̮!S.1f Zw6- <(uJ?y}"|'-jwRER OĨU':/Zgs@vmn+c "29'M4k8wQQ @ן~V`A} TItdZgmr:_dmڟ&GDz"\i(6zAڐ$3:t=bC,I ~)=[B7sZ.Qa`XFtvRdJJѫOP*;%°!lI[sSX8Kw"Zf9ZFͩԦ,[:5ٻ{%IUi2n2;~.v  4*"9DLFmאJ7;o 2Zcа"pX(S ,vP ;hT[VU*⟙Kl*afӑt]SwXj]G == ܥ4*P^bzJAąPjjI:e&g#*n,4Xe)**RVlvwO(J!(i4ȨȆzAVWק@]?Qx$$d^M%Y[&gĦ_|*N:AsyU@lybȫԌ1?Z9!\ wY[wW!x3̚4*fWņ3i1ZQ_zj߷j" RV\{CvoQf[YBdEHX³ SO?dJwd'kjbwyksFPgjIGݹ=kg.M7%}6f==/ydRW}%ÿJd 8\9ܹ 䰒u.:z +mv P*PW D>'O?[23'a7.oTs?U՟J.gq8U9FugUPdPÀgz|%9}F*HbCmaEK[]p)OI֌!Q)YR""#v(((I$I~nGFFH܋,: %n^xCŁF g42xmy"#"UDq9bӿ%Z5O j(Tv{GG477km .2}đCt,N 4Ls$ڐ@inM. wkЃivdM⼨,0)_8JPq)cEE1 ɑZYP%x'V⼫%UYqڹO=12m3J*)PQ{O;QhSVϟO=D(.Kb{ʑ2m1ZdjnivGkɮtjJwk]ZGT`!T1Qj ,SjcC~4]EHb6CuE !T:弣{vD&ȲjL,ᱡE&^# 8PDaֺ9A?wy- G [b޷ $w~\M._g†azT]{uݧmz[fxOǁ-2Qkl}毼ߠ z?{zd1[[[}^'KӾ6/BoV\ʒIEU[c,]n~i G;~k4m(Sxk*r>+3pT?[g>r>8|&\x]?KKWn9@4 ULaXl$QΏ7¨0NKvÌ;B:64ץnWVߥU1{ jlP )(MRkS[=P $IBȉ=cT*5]齚Ōǥ=U~\}}T=69SSJ`D.XR"-[o=sxS";WM AӮog:N :!'M+ L56 _9Ftʠz׈Nw0֊Z<Tz%WL02Pei>>GɁ"Z͂oE*pGաL! ۏ *9G=k^eN12S .Nރ|O:xCGZՍʝC RY)!NPv,Uiiw$ڞ B62dd#{Jn+T!v=* <&`V^2Edg::'(q/שa];AB5SQ|ٲcc,yy?~JBɝQP\.fW֡M.;.{~^tsM{<<=x:˺;\me}Omՙ6 z郏>걣ޖlT >:UPxt^rԣӜROav.OJԣwoT``5UD/!Ƞϓ ^5;((,*XlߙpYP\bOQ\8aLfYVc6nvbYeY%Ie{satX>-KuaM #޾t c?43TY\/^XA*?^k |ڤe4"RX[R./*T[G;w #kayFR ֝?ڼq܃-K]ݧZ{a}FZq P RmgaP[2mbjqI'#Yҝ^tg]$->lkV]UQ}?y?}νWc$j/M# _0MUJ6V8( N#2! (݃RڸpW__ϳAtۦl(.jYvQr'l0_~۞fL,=տ#ShB@q:M'}$t#SLnZ B7Lm W 1ItdU޽a9'?C?(*<ϸ_^˭8#M9 3r _l=dGܳWW>1~NNz񗟬eg]z9rqvNo:V>‰U]*'ÞZ)AL˜=Iieo9R 'ت:*KrsH󭡂Be0LLMQQ]].j"DQ6M&}C\׾e5wbo,/gJx?}s W+@DzLj=Ny$^o[20(N(JL=q˱j]^7U-6TZ%V@v:-NXOǂ,첬a8רRa]{MN9蔈*\vQϨ4r* /x_h@wSrh(ύd{_ecJ=wΧ.YvWi8Riq:(ZNE&# j{jo` *WuA1.Hf͜^A*c_$&{:-tms J>(tʒj2ݒojjjYxAd\04lץ jN pkD OFGej˲TYJb0%cmj M!,&B"l6h4 yIG 62Ǐ ө9p|Rp8 SE!fN8֗9cνȊB0 <ږZDYdEjϰ,O"2 Ot;$QV/X, w$}Oߩ%",h!y!0*FE=qS @J)ExU&#]ks` wŁ>  SzZA1=  fGGA{,A|7 d! `AAPAAGA+?͜"G/EZu'>~_>Ћ w[;ͤ ˖l)t[.x(/jg_/-RS\*-iǁ:}OIbϿнۋ/DV4)go&ƽ|b #o'?ye_߼VUu2gOOE>/<ᮋ?=tJiQ/#~JAA\ߗ1V?aúQ]r+m\s~OOqy䕧Q~8 ~ix.ޔIPDwF/|֜!=zM=7ݦ};?C5+裳]5S&^)\0"0z8n\z}GG,d^n ;3^ ^a QD'TBb'[6!mD9=-*J$ծtRs5`Rl9Ot~nӔj!u*@=;g._k d0QVVvWJlC_ ?=s~r Fj٢WEhmbsEC瓼a{7!.0TrNz6MGvgAg&/~iGޜ<A_rrrh>=;$W,R5ge;^"0Qp|U\&[:ZeW@7>8feGJ8^n{s}undC*;{4K3 KCA6>C4C'xO^=o}ߞ4}?gs7tź.Wͬ_.O0fZ{Ռ{~1%GNYڽ-{}qnb|!?gNH^S-/oc'._|?E3A 5s*Z _e}}{ /wEAA*= # J  ȣF'$$` c믿e f!Jd,yٵk$''{cz>()}nr'NT]BpR쉡% G4wtH3E!+MzZ`S7tx8]n .+!YDJ.Fc٠KV<ưq<0kv$tu{'ef8bdM]F@("/=VT>yܐ)O@Fn8`E[@a= (=O\8lg 5ĥ-NO4;tC& qYYt2Z;?SuwW{g?X:fB׎mWEW,e65w.}ƾr& eeFt͞rWa3VѼ*m M^>iւ&@=kWkeU`.Y:1h j=rGCRGt|-?/6qG))ÛM ^l*:*%z~ *ZBnjs7Z?0\1nq./N MS:4iڌqZFDbkSltly<7luj̥Ϯ; [Mr9SO5(@o[SAҳ)62Y]Pk{!5,g`&S /k9F\'EXU flރڤ0J^uAvV/9"]A{RzȎJ*ŞjߥD IDATr+zn"tZsB͵ '%f?ZfkeޓfTڴuypm}d ,?U-RP=ǦZ%Rk1fDkOE1WtvԒƇ.vV;'! AŤ/X3W$I/&sEjFY&gf?PDQ[ h1QYfY :X}G8|*.xX_g<&,J&Iy@#2vac',Ȉe&,0J\rhޢJ8FԕT{~my)sצ1"5q(@_^خegd(-%w5>A~Cf8dAe222233_>{ߵ6''gÆ 8EAwEyeY,A,J  Z9TzAp# YÂ@A1=  Ad 2czTzAAw_?&>7N#^Z?-v֬}fͺuRTX A]-Ź۝ꁱIȞ#6fewpXv@*+dϧ >\~,޲#Z/r]#g͏(ڶwA+3999Wr㸾za,:]SuC9J8* _iح1ĥ/JlYql"huSdt1w_Qs.]T`u'{oM\rv}7X۵#ct?)3stq '+.LLK +wG}zBdЊq貝9[$8=?vo$eeg-liUL)w_(^6|c ];]]\|û'?ؒg'.]jOwRrhGw HY]_|،i4oJcSOڻI+F:={f^qK9_} }V^ߧ熤$ۏ.mqZ~-56%qxċME))!m J1c"C,8*t@};+b\^j uhRg֮]O-H O*s?܊o^*0ix}4`Β~ VBA>ӳ.#b-K M]fjQ{ƛ l :%:@K9@ӎp*J?O.01LH֕ټ;esIa;>f k`+?qjxfGAcL߫Fv|PR.|PtP ٛ*j*j?˭A`QKk͵ 5.FtjՇkX㑭ƶ|S@,[JXmQ:?"iՊF}e1GA3,׳K 4sF;YI/MO8͛"maz|iFeMn? Q 7Guo! :.JS-RPޝ)FjitR{Keǫ,e<=#\=~gRŲCx.xdk-# S>ާW{w1 LI {\ڻQrVəQm*ZLtTֺ~D):8V;+~nd*6z~ FuRp>-eG9oؘ 2bɵ; 5(hk//2u2՞=Fv@b[^ʜi H Ew\4ЗWlԔOr<'|QJ ȃDVV(-q=Nl5`Nׁ(ۅ{6vK{َ-VJg3m7otavzŹ{. ݶXp^yZ75gvn>5AJmX\`YܵAdAF"Y·x}zAqzGѥllxT5ܪmq f(x&)tlJ# Iy[c$Z}V 7~\|*zb# ܟAd Yq*076;)boj-Kgo{ר {{Ayl-6ȏ%@T@̪yƌ<{: 6pAdUʭ*Sj2:"Q\{^A@z8 ϷAG*6ox0GWͲz=""ZzVtFqJ)BbJ<AA bK WAfP U\.-ZexleYo p `&w>ѡ'.`;wyW_gwy g$N~8Gf㿝2=ئ}_Lm[/L:WX ypǎcY_C*)Rݩ]뚄9bh⨿Ya6Ǯ|g k=rJ4<?~|ڴij^G{hoN#d?8J缶ŒWKXy$1bD^^̙3j?PS8޲ヒ&qtNu:+'ΞQpQYp(Js|1E!+MzZ`S7tx8]n .+jnr=ʩ4Oo~٠KV<ưq<0kv$tu{'ef8bd{~`4əi R cENWX#\9-bDDѣG9r$##CR[Nբ?1}o1ąvlXC\(tYqKcJo>dE.TTTrzU)KǬ^ڱjϮr|û'?ؒg'.]jr-%vxudRVfD)w.6cE۹Ҧn-h}ʻX -g]XyD$e &۷o޼y*jժU:_{ eznHJw.&g.lJb'ǮJ H1c\MVG*ug#W܊:16M%Фi3EjE].~"o]%Ԩ=[* [n [s뎾n?Ōp^)ƹx<1,M2e݋/VT˖-j(*=ko-b-˳ bt/1d|p7l?uJt4=e@ ،*J?O.01LH֕ټesIa;>n1h+{Xyczk0k֬m۶XBReeei4A"T=,z*BSEMEg=h7 :jivڅN`}&l-5u廜eQ 1-JG:{OOaCINNcr|ϝ;wƍ~̊C"`lՏul6~3wLw_x{ｷ~TJb?(k]L5yEdž}Ak2Wd.hUy;irf3,E%0neʰΪ3;wΊçⲟ[.%zfh¢kb:zD;"s1|k6&p‚X&krD%-Z,c ˟L]LgOQ]kؖ2'{mC)!RC2WF(eEf\dAG=zp+կO.cٖ؉8dɒI&a!#KFFFff믿K,)++lNNΆ zJaْ+++Um2{첆QLzS6\AX .(Rݩ]Ӛ9blc8oVXāC?d@G"*rʅcM/#999@,-;©UlmY`W2._nt7ׄ8v <JJɢeo(:UYRgO (a8,8c6(}^9da 3[WlpʢMd}EzvSiե-4qف6.cm׎䞮nYq@.LLK +ۧWK7N޲)߈˗D CUzFpqtΜ-kK[şn;7nivL͇LA㲲e6 SP*3C6|c ];]]\|û'?ؒg'.]jp-%vxu`RVfD)w.6cE۹Ҧn-h}Ji-Ŭ^zi[k6\{AyJ IIVey¦8o*6yx@~쪔 2dh 36U^djuTbvV>r,Ź:16M%Фi3EjE].~".>5xϖJ<:rxnԘK]wO:緮e.0i9#>;pÎb <=ftQ0v1ٺNesIa;>kf$SɱKt7,( CSzȎJ*Şjߥr+zn"tZsB͵ '%f?Z~f L5Zjlw9%: ocj[t#@dCIf,@GA'ν i2pXIvk:1mބPU azOQkӆOt5M9|[ :.JWGwOgik;-qvxE3cdo:|j'JoHzif|Ay1=(ҽk&$b=dV](9vgY(Jbkya~[6-&:*kl?"˔aUgvOe?o]2Kk=?̀фEi:)8ouvD#c`7lLqLڝFK[YB Lj?rjϞB ~-/eN4RB;.e+_*9g-jAG':O*#BE <2JbSP.ܳ_vlu |GW=}8/ ;߽+zn.pi`Ƃ{ ˍ8A{膏 d͊*m҈\GA @U]CbKͭۍf!Æ8ju p54XDFJʫl g (ƪZMV=,Xr8"'Xn].'ÓIW؛X` <>PE6NV{U34q VD@q5r'E7Zѣ'SKj!f̄ cboܶ( hqOVlV2=@PAxkť/\,Va#I ¨kUXjBB,0Z AL#!>4ҟTVV 0=@A䱀膏ֆ Ge([*.3RԒBY ,ރ<P0RKap*VȔZc`o43# `XGGA3>4:vC>B<3:ӫŠŇdFqJ2ó Q4 anM xA3:D4!LVB* : '- V@6Դ_ _^[]k{5`L ܫs`I 9"L^6b#++o\Dr/8F8CEYޣ AY5IZo/b_DcF}gGo և Oi'&ч8ʲ *}|dK޿G#>(~@=zfύ=(+.t{,]5?TWeRKYޡs;&c(I[y @|8wS\=0i爹n8p~])Aj6lW(4 |^6ݗ7?R`4C/_9 6"Ge?|}NRB~] O:sڢZ#(}^u*l섢O-}7&X]{w1럔9:@8Nz*ḻA$+J땓7GPٳ۳!2eBs?LLK +oj`S74y;aP[*}ܻW dn ñkGrOW;>79EPtY!8)uP#ʂCW;ʐ1ĥ/JlYqlb{A Md}EO~{.PˍI­r>AqCb }7>j]\rhGG5{65{[ KǬ{nڪZ/qQћ}yo}yl3J@u}e;sH!.mqz߸172I΢[ve:;I{KǬ^ڱj-/}•K@3XtmQ&M1.R(rC 9:i\ˑ7ܫ'+['_LNt!5wPGtQ{TzdaSc.}vuTP4[|) _ g#W̲[KysCRGeI6_ϋMk.lJbGĦRB7%t8Wy}Q=巗|}nrj AT˫\'E\HE IDATXUO +T5T$CeJBhoٺ2ڤ0GŦZ-W=B;,REuXC|Kon].(`h5ӽĐUTe_xtl)a\z5?=׻߯qaq>Dm3 Pjx|u|6p0r͙yDP6#]|wp̑:,AP G AA1"@ATzAAPAAGAAA"@[= 8DȬ7S >c]Gnd?|̼3U}@,>|D擉Ww~E.hܹ9e\_Ȼ^')<Ԙ~)=tR]e"K-ey:Eq߬+'ly @|8wS\=0i爹n8p~])Ayxa97m p/e|Zħ 5)lKsؼ1Pq!r:ifV( ÷wԺ((Ӷ\λ1C/DžV3Ho\ 42}gUQunZ=IL]nhGXwp{ߡzm{/КZ$ғ>Nꉁzn";yRzJF(^|&\YQAĎ8QOyvE gS֥?<_?g@Ev\?"{TZ ]uSKѩ"sOWcIEͅc!I9t;'He(m橬QT^* }#Sej#'Q^Цd4D$z7,WRR}Ϟ,$0,)5>-ՎKQº'z`lL@Fs65drV $r,ҟ?W4lp姁oVtuz-34sYsT:[oG7 3#O稽R杗owW&;Swk 6OoƸaQiZCW a/۶g޽{v4ߕgƂ0aj$YQ_'1 ꬧[՘Si+yhGFYʠ^ ]59"Vî.3pc~ ]IqjDHuKyYG}U8q,Z&eCA9*bt2ՂP?O7g63^w;?Hݠƛ|cčnʻ 9sK[:gvǎo|yO ^фۉ(E ]oz#0|ڦ.n?+V<;YSo]X4 .qBvk޹K G 7O8/ߕ=~ol)=6/ hͶ#&\Ċ˧d@̱Y2>Ę-dLղݸ(uIrr56{:G'fzxrM3)v[Ao̍9*Pʔ#JYL~>O6v#L> ](7(uWtW=m;>sck{-R;מtXyn=w<_x};ioO> Y?Z5ڂ]S<{cׯb;6撗 {``g?/#Q̀=３G5Pu ִ jɀW/.WQ}=ʚzuo:BX ֟g{wH|t0zm3\ח~cz'Go_?CჇ_/go҇۳öU6񽌷[*hIgp^tֵyq'>%8e\f5Qd\~w?OC'7&&15%ǞH{MΙ6A  ?Ob\1Ƥm=^@7x瓛uq%ϟ}~mֹ1 ui(WyƎXҫB5H/0s-.,9woT?HEATa{ۺ~c$/ nϻ#QߏGQ,^QWۚ}w>9Ty\1Lſ>1Cz_^4*:hA*mI ߺ/.__~ #,wFq7S,kϣ;~0iM`Yj=iMe%=^EaUߤxmw6-pX MݣYbz&Pc} ~s~mhegEu7K^+jz!:#JO*j}\ce#;'-1h?>H6XhL6_uUʳ&o,} (݃Ǫ&:Xl*[eimk[eqYhb8ėf?ߛM'qf`9''nNzT-8|w}5e{kvx/ix\w.OY{q<1)]ym?^),Ǹ%yS$*m5V.J}Vq&X`L" .wn|)Ph7ÃU߷N4s^ S:{5 jz T`_ۇWPwWgfۤ54|:Cm>3R=ޟ 4IzBv+ƛ_$y2lqگ^Z^dB3{KPR5#ME(h_ o۟c:gƽz$qwF~2|h꩹p,+xpj˦(Fp>x-s{k^LXezxt} `oUf͎Q׶K#KbW.c*{wI/Hz?w[}lƆm]|6eYfǤUhmc[])0dc6cslؙww>$"H^dn]F(s [yCz0Z^RȢhajY*q /|OW͹cw{?,xeYo& J|(GNg5913VMZ~RUmF6>K/ >/Ֆ_ ׎c2oXv>Y?c!7v{e?朌I(/zwl-ACf{t˘H mgUȜR[_/V7~w׻ w]QUo?(! 8:? iҽb?jݷ(lr0~9q#6OZ0Y6y:w ]ddtfF?gZۯ[vn}e*[e)EѯsۼOh^*6O_3?L9^~˨α[į-f:?wYտׯ^ixy`NќO~b1y82Ҙtl8^#?a&% 7:͏VYvѷkPؿ2 sy *_G˥gʪiCն죃P7}Z2o? b )~?iM2WC'AgΪ銀s ;_ڧC@ G&*7@ *=@ WqϤ_]2{|av׌nqYoMy!I{^}@S;W흕zq.dN^HK%|@ _x}J@KM@S$ݒƽ4b%L)-SXWvǩ16/X"Y*`2 &Q/ϯifw{x$T$E ݭhOcWdW?rt;3_[W>TB(@h vIiC%ՀFln(8n1c]94DMimlń[vĻ^j]i[.螙 +`7\}*58:>|FP**pQ_XՓ~PU.6vпq;׶iUK"=$/Ydy@RF|Qc`1kCD77k2/*'1Ϯ(?49a Ѻ4_U'{=CeR`a> 2Lut05,ȯNHnC:C^9:Rv%}wV=e'd:@{:^& +|WMU{p VzfՈ,2qPY"͢eR6#@ T BB}!,lF#)@  &^*o.cydcŜ!;=y@o%[9gJF>'$V/R':F&iEs1++Z@~&L^@fUbu~'MQ3b|7Mk4);Fy\;:-cbl|0PV:P$XJG616Po) (B1usBia7C HyDk3$V\>ݬ$s IDATfM ,̕y"`yBPEX`EjŠ9{mՓƣkIy ~en̦QDž"WܼQzdyIaf@A*!fsXC>c<7W=Oʠg f: \qLr`g]*W…/n'i@Vq =̜O ڕ]<ި}D^ΌE_u>IwrSW?BA7g^ /Gul|7!眯 eiMsMZ?SVMP(Ϯ2?#ME(hn)r>%{*s'ArgΪiB V~9ps [yvJt4SgGM yv@ P!@@ @ Tz@ P!̺Ie ¨}s#6z{m I¸Oƹjԋ{HvI8l-v?yi)OItwIh$TҲ[rø3_(}_L3k'{b. y7fGlNj;kp6C" L]oʻjx흫zM} #Q'*/E][lsy'5q)Pm;tRY?{ꕠ̾DgOfQs޹j^5\t|?k֔ޞXVu=OpqZc,+g,,0 Wȴc;=<^*D Vű+s9ᯭ+wP.\!  4 Rqϒj\#6o v7~eOX1mٶU6b-;]j/. -nKqap d0?>Wkpt| DYUT~X|ͱ-ՎKQº'z`lL@Fs65d:L$ :*냓&R9Тn@WcΩNs~Դ]s{}mDO"Pƞΰת0Ȋ/U#b<1?b$Y5"KL`k}Ah $2ՂP?c{rpH/?,c6vxJ/A'q X^@ ϵң832VoO9S0`ыOHv+f_Bե4&AʺbR {AkRmߪIj)jFvta|7Mk4);Fq+xGe,p0FRʪSǝW撂=?צ {?EhA.q6^:"/:qE[Jx0y@fb.Ab K2h h\w,Ƙ-d<1PELjŠ9mՓƣkIy ~en̦QDž"WܼQzdyIaf@A*!fsXC>c<7WeٟvTyg:Q8&9ƎXҫB6R'IO pBFz~\̒먓oT?'R6Zge'=,9J䄚c%}]i;v[p|bc_\ӲG~`dU9%>LO*k$,_t.hYbKqSxG/r\h^Vt-ϋsw>ATP!1׈bd׾H@(՝̚G;qrܽDb \,@ 6ݏ5۷GɩVR7fRFaѠW)-'ԹF4%HPmI~5,b}o?W -VG&o\"l~dcMVYidk_m1U,OI+YU*b:;s/+q H@]%a$-]5@ʲ=0P&aj.ifO$bsV; ~uMMrN'׶@1&_maM˼}< 5 $@ _kGBWo``-["##!]MXTE^wVMhܯ~Y9Jx9Df7`]\\D"y:4OpCIIᘁ@Yzzzjoڪg eiMsMZ?SVMP(Ϯ2?#ME(h!s4a(/ ~S|JT N"`ϜUӄs8r/@iZigcz2p9d&{Hiw^޷ z-0;$vP|%eyRz@۷I a/^Rh 2Lut05,ȯNHnC:C^9:Rv%}wV=e'd:@{:^& +|WMU{p VzfՈ,2qPY"͢eR6#@ T BB}!,lF#)@  ڞvBN/,{:C IQ 9z{"VΙR㇦'^xB[i5.5$=Vjm ݃lwz_?_R&MocVM =V#MQ3 㻑nZKI١0c\;:-cbl|0PV:P$XJG616Po) (BSbRXAT|)=6/ hͶ#\Ċ˧-?sFA3&gʼe0uo JB7䟫W#7.ux[v?ۦSXe,X5~/ضޘUܪE]'Ѥ*s1 ye˝S͹Č8Ei.0Cͮ ]eY Iy(0 W[۴I3H'wFHF1CWRhYuW:HҦr9p{kx΁}.kvH TMٍj NkyHhq ܲeKdd3+xQ*|?OnaqGU(`8w^ /Gul|5<..N"{Jvĉ'p@ ,===j7vm3݈BL9i.I\gʪir Pv C gúQ^@ -DKW9 5Xp5Do^ *ӁH OIy6@  #X@@ @ Tz@ P!@@ 2J{&[4 Kf9< 6/$iϫo>窽R/!%}]5c}ңXp@ _ox}J@KM@S$ݒƝBdY;s Oϻ18b,w HUcY6|'0u)b)w55NyR`0~y~L;6%B )jnEZ2'ۙںq@B!KJ,yc,Cxº|6wtn5ͶQoR{uQPmwc^ c7pg&Qp2]0he ΪnZ=IL]nhGXwp{ߡzm{/КZ$ғ3=#eeP!R%2b#PiI)6LtsSѹ&qC\kmKOUx~x}q]Qi1tYN-Gn=]5%55;&}#Fw̳-FYRY{4/OIRc<t;~FyAEҬ*߰\uKIm>{h°$TT;g,F W1=\8{\ W$wr;Tm\f OE 8Vu~}Xnnzf!s(| rΔ*4?4=y"JٗPu)rIAz++Z@~&L^8fUBHSԌDߍ|pZ"MѼ} ik c q"qU"w>򰹤fad}zOA`z-gpr@~zƪP!ؼ5ێ0s +.nVXFA3&gʼe0ܪm}Տ>1^ /Gul|c8D{:tH*Nvۉ'솒1%}c ݥ&)PIˊn |}m2iL\nh<R՘w)zT IDAT=3 L]oʻjx흫zM} #Q@ "TOS#ɂउ&\Тn@WcΩNs~Դ]s{}mDO"Pƞΰת0Ȋ/eҴ7ag̏X+lVn)/%*B_|q,Z&eCA8=~y? ĠL $ާflj ;ޟ n ⡠wnSzgC{dޞȿsTaɣ1VZ;Kih3M ce]^R=vc5)er=oդc5Eτ0঵D y8 2Z!8#)eթ EիD|asI͞k=ޟ "4ik#N"?nNSzl^@њmGO7+,\c sec9ǐCZC3QP\TƦBv[({ gR^{ߪlsTqȕ)7/F|lF|.iiPnP讯 {fum;>sck{mg{ p~@ 2$vRz!\FJ1)Nh_SϏY2rugDJF줇WC6GPs̻$v+mzG;nOlbyCbZVUH/0瀸чIe5 Xe-Xl1oEK4y.eY yqݶwr|6iCac1Ȯ}/P;E5ؙwH{92\XҡV74$l޻jוoޱS n7ASZOshJgjfYԽ1(M#ߐ^AZL޸Emn6Oab%`zcVquY'FVʳ;#T04uN/wN 7^Dc3VAK IZ*+7j0te+${aL&4^]no& ퟴ/!I ]JvdR_94:#IO^m:.c4f؍p j NyHhq ܲeKdd3+x) ٙ⋼ΧzrSW?B2w^ /Gul|<..N"{Jvĉ'p@ ,===j7vm3{KP2紦&-rş) ](PgWCۑ&"n4k`@oFy"3@P2lp$k/]}欚&`嗟7{a7@ OJ#-<%}zٴ @ '`a@ @ Tz@ P!@@ @ Ȭ+=k\foр/.78b&ؼ=y jJd{v0l{i߶('@ _x}J@KM@S$ݒƝAdl'ݘ y;1i{f>ޔw;W$&G[`5_)8qxBA oғKe8yT({k OV?r:ΟcJPsx`f_"ͳާ `9h\ HE]5ZQ`w. ,. 拮!#' 7Ut] gG5:⸲~V>NyR`0~y~L;6%B )jnEZ2'ۙںq@B!KJ,5b0owCYulܦ!jJm[e,& ߲#ޥR0 Lr9 4nX MseGLJ/`@UEw!#zjݦю7?X{'C=^5jI'}o7Vth)y m$ sR%2b#PiI)6LtsSѹ&qC\kmKOUx~x}q]Qi1tYN-Gn=]5%55;&}#Fwk [6OeRi >_*Sx)vX*P^Цd4D$z7,WRR}Ϟ,$0,)5>-ՎKQº'z`lL@Fs65d:L$ :*냓&R9Тn@WcΩNs~Դ]s{}mDO"Pƞΰת0Ȋ/U#b<1?b$Y5"KL`k}Ah $2ՂP?c{rpH/?,c6vxJ/A'TX%5p ސ~V{\)==[n'o)Ui0~hzE'$V/RY| M ce]^R=vc5)ei[5)X4E͈D`|7Mk4);Fq+xGeCp0FRʪSǝW撂=?צ {?EhA[~EMҚ-~ܶ z)=6/ hͶ#L\Ċ˧d@̱Y2tY1[xcȡ^-ۍ ФFA{pQ=\ {IQ5AΤmaU27fSB+Sn^(e=2<$ڍ0\Z3RRw ܠ]]_9l{!̀1[۫~l'1u 1fʄ@ !y^c;Pz!\FJ1)Nh_SϏY2rugDJF줇WC6G;c%}]i;v[p|bc_\ӲG~`dU9%>LO*k$,_t.hYbKqSxG/r\hqVt-ϋC䶽H3}僴SzrM {jkDbx1k $ NQf#v8@9^N W.tM GhuۣwleT+@ ){0h+vD\m#$z$Y>uo JB7䟫W#7.ux[v?ۦSXe,X5~/ضޘUܪE]'Ѥ*s1 ye˝S͹Č8Ei.0Cͮ ]eY Iy(0 W[۴I3H'wFHF1CWRhYuW:HҦr9p{kx΁}H͋U6D6C ;gM}H ¬T (ᖷ{^^^uuVݶVQA y  ! DL$g߽~ /GŽߐcǎƮ!3ĝMҁ?׼Uk#;ACA0) vpBT*oVRBuu eddDE?om$}BØW>gt]卌LTV\]/n؞&&w`y#[Ya85n "HM{Z#?Bhȱ'UcP үNUq]jdsZ*Pz@Pz#$e:N⪎ISa{}nzubKXZW2BnտA$=g>+y[Oo_ Ur_96n+W~[8OϽ,rZn$d_6$,"?eDKDH3Cwl([TJQ3J{SuO8LG鍪~7>my7*_xordYg껫n}> 7쉦6YB"oᢐXAgk񺂻4ZKy]a*i IԱSInzvDx"J;*dWhe6'{,G+>)jpfh_mģABRohô3rlOpĖ]JN1bq8u}Yz!Cn}{Zj^> K#dhl1UHsQ5t[S'8`޾—kWǁꀞF3O-h;Lo c'/$/1Ԭ$e+-BH[o\Η}7S[ms՚XM?zWm"r_%&L8WB[VNU~Mއ|?֬bT뽚S|.^Rfd'x]*v CTE3$B(0!=ћkDF_׍kI[\/VY2\a%O3 pv0fopLv1>n}Z06Ŭq%(M[/vWhIr\+[0ApwGIÀ%;+U}w!R79b̈xllմm3U=s4B em3˕KuYe9R{e„ZkU+ԕUZjAnNF=_]5 KU}m?['PY1m-T{y='fqc&9#A]s}*/۶Kq"'///ЭR3B?5?m aw=뿦Gѽl;?ji['L5 wYB)1/}Jiy|aB 5t938eZnC1a1k<_d~Vn924픹!r:SťC$bKĐ'B .W]{bcb )پP3=}Kxb}3_)wxY}vЈ'!C+ߣgC3ϝgHQӪAF4u2|oY Pݝ~gTW> nD1Q!0xR/)i}>7}2U; ژ̼a0h/٦\)b5p۝.DĖWLB}(#A55eu7?Zm>Ʀ&n~gcmxR:l*n@9nm#zXƮځ鹮w86MyY=I2+{i41̜-h45[یY7Mr( 5Kv7*/,oO9wc0n}V_w2qnIhGkifu/%ݳy |iv_ {!!!ǎO~Le b°ӹ;U:`DV_z< &7wQ(JoU*J_/TWW_pZ6-###Z/ykp c^-u722){SYfpvd~c{ě|\ޥx|!}'Bé'wkWAjރMg\}!ǞTA5J>:UuXBVPJ(=J)=.H=?~uНU{JoޜJWN8Ėe`ݪIe{*(}V Ò;{1iJu_77FHʏ~w =ʕk/fy૘oϿ?-!!8?o]MSq[TJQ3J{SuO8LG鍪~7>my7*_xord0.ܙ~ģN˗~Z1~Ћ #cK'jf a\MK#Bb=TKE1ퟌG߾e@M.4zf78I^"KM=-.ۀƧ-F(ͳf~Qyފޅ@tþQCf#nf#;IB>T7Bt#{ﯼ4"mwZj/TG^!1GGZW+Z"ayuMAK@rvNz#qMKh?(,}mz-<hz7(K{RRNvWLYǪE0V򹿈'휥b4._C3VHKHJrk׳#“pUUI%E{(4?\9]IQX 0@7o&M zE'f{#%R*w9, P[ߞV`t=Ze=''ۖVXi_8O24}gd*ptY8 IDATdjwЩV0Oo_ f˵@VS[tu@O#D'b4MQi˷1‹YjVDp!S7.>ۭjM,뫶dk~/K&+r-C6S_S!,5Xe#-5z&߆k… ^ʇ^#2UQ~ ! LHOf?~ui!ĖDe1׋U W~X}? !=7)/5yfpq)lh[߾V0Mr1o|eKs$Mݍ)Hk{d+4y$^tWbvxW 8޻a֕xѾs̈~1fDR<6jZֶ؈ڞ9!ʋ jVYF^+j0!hVgmՊs5ueUZ9^DWWv,}U_Ofy1TuL[D<^^YܘINgzdP\4wbm'rrΜ>*:cj+PFp_$!K=v~N]#^6jurН4⭓e]?S/)4σ6մJᥛș)rp CYU)&K[r ͑i;5Ըlט,.B g_"='ZpqL5]]&޻G!tU78KV*/}TQKɿk4&!B jUZpWQies!P]ѝvmvvxJ=< vt3jiRZ ! k3cf֭l]WsWO C'ME=z-2U(ǭmB\pUZ;69=uǦI2O>+'Ufer7M"&Zm6پz1릙IE18a|rfNCe)Ga ͣNƟ:-)|m=pאݬwq}G,On5WKQq7$$رc=Iܹ̹ALv:wGÿJLȪÑKР;Z BT~w~JZk .@eddDE?om{m9gt]卌LTV\]/n؞&&w-<b*x_IGbpjDn`YF'Fhȱ'UcP үNUq]V,TJ(=aJ ss_t'~qU~۩7簽>7|:%,-?}!Xߠ~|ٞ3J.;>K:wى"lߺ/'/=;}ٸˍ@= Ov6=5b{]c~HfNχa.3qܡGއy_߫g6GnQ)!|(mUqFNirݨ|C1Qxu ݺ48O#~ԑ(M7pNP6YB"oᢐXAgkndӬyl\/Z. K_hi[i-p=hz7(K{RRNvWLYǪE0V򹿈'휥b4._C3VHKHJrk׳#“pUUI%E{(4?\9]IQX 0@7o&M zE'f{#%R*w9, v UْpB'Di )=BƁƾlcY4nYL_:uc +]a_1,|va{J`ji<>D݂)J3 T{0B2Qx#K͊NR"pQxz9|Y~36^T#cUK|}٧g^0\ mYA:U5o:VFZj^M) j) C3.;,0HLU_1C"DُFdduݸvD%iib-ÕVr>B|gc GKt޿ii7\sJ!)39ַ jS\[>-!>>]OCix;B\N5psd{.n}% `甮TdzݝcFHH1#B~ⱱUӲFT!D7,W^\7N/]ԭfkH B6jykU+ԕUZjAnNF=_]5 KU}m?['PY1m-T{y='fqc&9#A]s֩ʋR9s"tTv@O•~Tˍ_O]\aO\#^6jurН4⭓e]?S闾N<>ڰKVi Z"8\P cB2OG6Yߪ[m M;eFܩƥfTdq'>+w1$xI>ЂcU2y=2q褾RyY{OZJ]11tdhW c e#-Nٮ>SzLCuEwڵF>8-ɔNC{x @f"By1h0 gr̎yΰjcף|}h~&΁EgKdRΨe22Q*UG$`t#z3?UnrMUA7I}mw~LVڨG|.cb֏ }0j:-GlLI_Ê^V&̩Îe@QuGӒOD!B߁ ,lRO#Vn>objHᬎ\U-|eN\p VZ4KܶH,ю1e%?roҋ 3dB="\(Ov6OZo_wz<܃`sh!ySH۵F> @oWE_=czy2_ۭoO+ 5d7xx1ոg%l6ܬ` `£oHHȱcbccӫz&sus0t6Uk#;ACa`{?0_ء[BT*oVRBuu u`222jm6^[0]Wy##7UklkꋛA7I]:O1@}#[Ya85n "HM{Z#?Bo4ؓ1@Z_ @Pz@0Iٹgǯco?pRԛs^iji՟[oPy?IlO*vpNpoݗ_1RjA|zue+J_.w?$W1ϟ.#ZB Bql^[TJQ )ujFUIwVy}79Fbk>=>~Ak`O4մ¸QF :[{ Ëb,w?}o}}}ˀj]htI77 ҽ~$Mu1A-Dg;'K#"vFBuzBsp5{pE𽢕 !baFiW״$g4'8b״4񋖋ZVZ#*I.Igzܾ'%nx{ZZdc?Q)xBx]Y-FJ򥼮?Կ?i$ة${=;"<gWUti>[+P2M޽ϕ#`8 3 4ݯ~qQ` !7PaZϙRP9lo8R^b.rb8LA`ϡ|m=zZX/N2Rs\ӳK /Mpȅ i e~0Y*i{5_6\^. NT>I+fHQ`Bz7S׈LO!$"-3^eJg@!`޾Hy7;-톋cN)d#%}&GaTmY}D៻wTw߶ʋR9s"tTv@O~0snt'[#^6jurН*L5 wYB)1/(4σ62NK%Vi Z `8!Ĭ*zt~m%ZдSjȝj\h6OkL!}r/,Ǟ-8_u.#aoGN;+d5! NwJv*a8Pv`4C,>΅jy3wZ 0NTzLCuEwڵF>)3ہͨLKi5Db*`->28z{V^>v=J>|!jX{D&Z&#SR ڍqDF7;ȫg.<?S){*Tti|d8'&pǴI]g|:2Zs/`"uZt 쿆?7.L#z 1S = s-ˀģ~/z %' B!pIA=z<9(IKȉm !%@/:_P3)ꂪADl KYyŴ!Dk;؇2hzQS^VZ;Pq󣷫+O&w}[ml[e+-<N$*{[d"P[!2v`msz<157M$e|VrO-n$EL23g !l&ͳ}V6cM3Aig\1bp8f͒h+ h;SG՗?u[Rb9Zn}{Z!Y+϶Iԑ>^tZ`'Xarرᇞ$\] & ;_MdȎǃh@) viߝBP*}ݷ~RVZ~~}… :ij[[0]Wy##7UklkꋛA7I]O2@}#[Ya85n "HM{Z#?Bo4ؓ1@Z_ @Pz@0Iٹgǯco?pRԛs^iji՟[oPy?IlOJv_|%s8w8 5dlݗ쏞]>ˍl\F'V BϽ,xއ|l.eo<9Lwa^ƦWQq[TJDc3J{:uj儓b7>my7*_xPjzGG3=6NV6YB"oᢐXAgkmy7*_Di5S{?-7!uSzbL|{g8IH#fcZvdOUFDNK~q+4_k`BV&1Ay^]>ndӬyl\/Z. K_hi[i-p=hz7(K{RRNvWLY{,[OX"cT"3^WpsFҸ|) lZe#-!:v*ɭ^ώO6YUUc']ϖJ<FDwsHw'Emc1 M߼C\x41HH msTزK)X,Ӿ/kP/s(_ۭoO+0V2֋߷Գ9y6 > IDATAǩ{3]8K24}gd*pt˚djwЩV0Oo_ f˵@VS[tu@O#D'b4MQi˷1‹YjVDp!S7.>ۭjM,ZR_>=҄ \h ֩ʯӱU6RSj¿NmxVK!\u|aGe!B~l5"#ӯƵ$B-HLc,nB{8;o8R^jNKS HI|m}`UbVkͣܙ"|2z{k{d+4y$^tWbvxŭo 8޻a֕xѾs̈~1fDR<6jZֶ؈ڞ9!ʋ լ~V2aBF={jŹ[K-U_ל Y[c+fdҾ'q\<*:-ej/,n$3]y2~.rt*/۶Kq"'///ЭR3v5?m E92UyQz{v6]8oM{٨Cw~҈Nknw:"RbL_:O28a*6kǮG>qB]և5VM9bϖȤQddJ=U^A1HfG^=y!g!?e!B嚪.Knd$Fɷ y1[U[w&I;~oxQi>G"g[dJV 01X-fNU7v.58x&R$ ]$f9ed;zZ6v[}SF gu䚬jn+w抄k"uazja_J6u"o1~Pf^oCX(*0CJ/#…`l(zg>PzcyGws,ߒwyCǮ)r7շkq}2>=z<9Yd'ڊ}á2y0cge}'O疔XV|d[ߞV@knVG-{~!Ί- Cv_ {!!!ǎO~Le b°ӹ;U:`DV_z< ,7whBP*}ݷ~RVZ~~}… :ij[`c-[hj献Iٛʪ5 5 $.,C T' N:S#ON tΪ5BO?#4FC=j~}u* ` Pz@ Sz\{;:'N9q-ai9_UTQC={6;ޛyrѳg+?SqjQוP2C2ͥwz> s'眉ut^=9*pJ (}lvCixZg^Ct0pRLƧ-FkoJM$;p<dwʘa )DSM,! iipQHjip \G!FGw֏42|n6&lGP_yiDԨ^WBHcv{/|heBcQ5Fa.; 5-o".>% i-p=hz7(K{RRNvWLYǪE0V򹿈'휥b4._C3VHKHJrk׳#“pUUI%E{(4?\9]IQX 0@7o&M zE'f{#%R*w9, v U} u}-<F24}gd*pt˚djwЩV0Oo_ f˵@VS[tu@O#D'b4MQi˷1‹YjVDp!S7.>ۭjM,ZR_>=҄ \hMTT˿X*i{5_6\^. NT>I+fHQ`Bz7S׈LO!$"-3^eJg@!`޾Hy7;-톋cN)d#%}&GaTmY}G=F iu|?^#mm؝^q.['a8^ٹV=axKsJ[WYG1#BnrŘ!J?KتiYb#fj{hf+/.p.V5rZQ˄ !D۪jʪn- V}]sR7'l#dmY%J-rc,똶y1Vl rwȠ.|Ymmۥ8s EVhU[6݅"16mz\.qpW841_?tG-xdiv~a.!B(%TLJ;< 88m%jxj3Sv93FSMj|#CN"wjq<կ1Y\:@"ݿD{O j~uLwC.o1:T^ޓhL B(<;)C-ӁuQ#BHQԩ`׎7iJiN߈6ihO>:Ch=݌yVCDH9/#L.1=]Njcף|}h~&΁EgKdRΨe22Q*UG$`t#z3?UnrMUA7I}mw~LVZ?jHf kz֏ }0j:-GlLI_Ê^V&̩Îe@QuGӒOD!B߁ ,lRO#Vn>objHᬎ\U-|eN\p VZ4KƵNYc5K-~( xXfHzDPmt޾X_ \]?F!4 nD1Q!0xR_Ʀ&n~gcmxR:l*n@9nm#zXƮځ鹮w86MyY=I2+{i41̜-h45[یY7Mr( 5Kv7*/,oO9wc0n}V_w2qnIhGkifu/;ۢg>ړz E4Tk(0RxT{ 9vXllzCdw.sn&jpdǿ?4xl l ;tkY+ Rw}*j/\Vk ^rx1?|Z3`XS_ 2=MM>.ҁKO1@}#[Ya85n "HM{Z#?Bo4ؓ1@Z_ @Pz@ɧd&K|8ba.3qܡGއy_߫g6GnQ)!|(mUqFNirݨ|C1QByQwy%KgP-\is~oƅ۴4B($VC4O8^c/}o}}}ˀj]htI7mG7=~ jiqt7>my7*_Di5S{?-YO4/J=4/H G!FGw֏42|n6&lGP_yiDԨ^WBHcv{/|heBcQ5Fa.; 5-o".>􅖶#*I.Igzܾ'%nx{ZZdc?Q)xBx]Y-FJ򥼮i$ة${=;"<gWUti>[+P2M޽ϕ#`8 3 4ݯ~qQ` !7PaZϙRP9lo8R^b.rb8LA`ϡ|m=zZX/NIĖfp#dhl1UHsQ5t[S'8`޾x8]By|ػMSuuyg@ad!F!Q=lEi=s4ϳf*vW,ܛd`jI~/K&+r-+HZ*ZMjVHKMޫ :ŷZ-pahFvץaI+fHQ`Bz7S׈LO!$"-3^eJg@!`޾Hy7;-톋cN)d#%}&GaTmY}+/qWk6^N8筓z99^ٹV=axKsJ[WYG1#BnrŘ!J?KتiYb#fj{hf+/.p.V5rZQ˄ !D۪jʪ7kN|1Օ]3 Di_EY{b e2O{b KrrZ=-,<ݕG rlU^mDN^^^Ι'[BglJWmj~w6gW~؋1_?tG-xdiv~a.!B(%TS)4σ6vZB(938e.W%FSMj|#CN"wjq<կ1Y\:@"ݿD {O j~uLwC.otT^ޓhL B(<;)C,;NWzLCuEwڵF6ihO>:Ch=݌yVCDH9/:H8א[5Ivt,=["rF-)zVz8"ylճfb4#B嚪.Օo2 g<]<`eF-o>â8T)bgAn[DŞI(.Dc/1b`QPJo˲]"av{g;;3vjiAJ8/g'? ma־3~IAa)LIG#TGe@o5f첃O"ֵ.N4XDDLvREgd&˞iKVZ'^gOg+UK_To.+}ߨf/.붔#159 hd7Qݨ lIy"_Q oNݪNOH; thdDG['Cwr')ǣ%W*s30R3N(#+/G?K:L $2QZܵ)C렾2OH:2\?a3ډ)1ⷱ.!bupqj呫)ұtw|qr무,4s~GfWt(s1͚E5>0if\riw nkUUYZ{A};nE/WԱt؎YGDD*,LGg"kw\t8s=G*KDi:;uQibaRqHm"X,7|c2)JڹC R9u֊nս_^ ߒdWuZIbsGZXWX󽽽zFSp CZ{&ժ&f7et<va^m"ŋ-,,pʕ)Swׯ_V~WuCǬ_7#34ZSek'?잦k$ Ӿ^vD J$3FWZf޷So_NE3"}Ð%\=Od&@Ѱ+!"ooo"_DxbLX~ömdЈ%''W>vc 46/_]vMY=e0h 5ĬzҀhsz45u ͺK_rk:ῇ/U> kIC;q꥟L|օz, v3NiCqڭ=s]?4:@G{y+GxXpE "7YWtnRrk>U}&>$"Qҩ|78n;{WR'NL IDATs<ٽvuQRM/뇹GDDl#Y3#O"e2In6qbjLf6Bպm\!N+p>c}gra;xW'nj{a֤Ve>rS;竟kۼvタun""i͟LjI#kUEYѫk B E=9^SR0)b϶OX*jjmPīv)d]Oۧ廪I޳~ϭtiL54xJM|^qꕝ;BA!u>J~XV5ޮ6 f#jDo\{! <_|Kb?bg:dp,y ~XWVsh厗6,^J  7o6Hqwߊeg.l6i˝jWˢ~]pzsfO'ՆSUY"]Z%q+tX$͉=8:q8WcHԡOGu eՖwv:,""VW鞗CM2Wv٫UDWiܒ)VL"b֠!j\+eԭ|G-V6N^R#p  =>fBt )rV\yS17}L~}F.^jP_jZzsgWv>>K=dī)~n{-SLTdAFg=zvZe666=DLݞCYfIIy T3U K5\-9y@$LU'{Q ^ieғ8|2r[v6W^ f$Қ Ⱥf6qb0D2I$#cp+zyH*ƖyŧtY)/3͔&986YoG4Y+I|:unJ?őocLv)xml&_]/Ȥ]yߐ\=}}q[9Mt}Y6e'Z眞yܼ]Չ*\s_{ާ8KǘISQQJ&e[%:w. E)qIA;EsVUqw>wpN'n5KEi/L(XM'}cdYӼSzEeA;jʭ]KyWLXh,oIa >>Y3^jwh^OP0X\X(*;}xxahUKߦɚ߬Ҩm0H&xvѹ5'mǯ%CJE3C{EiwlkF]rtO߹vHێLLv ;[Fll~jU=rczZjw)E殟dQF^5o9󬠸Ge£[L{cټ}q%/ed1xecMNy;$Eof>>Y3bd6v-*{s ~=@FDҼG 3+O,N`N_՜FO{M;:CVծ[qF lT5=o\ӪaCwӚCҌ?;LHҜqٱ՘ c&XjGt5#n1PKWa "fݵrǝ{9~A G3P?VI*~w{%LLm>{wc4ή-gR oJ䳛Y-ԙĩ무,Su Uab.O]i„fWG0*m*,JF?KyCL]0bV&|o (9;|S|gxx8&PY7kK3nnxPƐI٦Cg7TFC]jjM|hþh_2 gjjZvj_H=SWzV)|F^9=H׳Uh&7 ׯ_Rb="= "= GA"Wאh Dz9I-3{|s['6Ζ4 r[F^3g7-eH/,`֋cmuEoa$ \W~!eC-Rb:iUmfd6sm&ow18P|H5u9 ~é9v钼k˯AQ2'J ;o 4˭O dJAqk=~`]W3.CB~)+ 6uSVv8+0.ǎ.nJ$t:Rj7k|qoܗq0nOo,\Ȅ :o]iĽwk XJarDƲ'G >q`xKsz;;ٵ/D$?zmtl]IG oʠv "FUe0ſ15M,a2Msjx̘bthL^un>ӘKb"%"=( ʼV;u#~cBLv♿~;ml4 4čsa޻YIֽkϳ\xFsIy/>?wNbXY 5Q>gn$DpRL*bN]{yQ.ݺZ{ҜaHmsۜwν5 ضFŸm;dS|aeOKs~h.ff>_`Yڵ!a`[s~>sFgI*ATz8v d%$$)>o(>ehDzd>aᄕQbS][=)&صX#ThHH|.( RzDF)SXb3,@1!&a`0H(xFUpXi}w\eHK%:27~v_d8l照ŜhgVz!Ҩ6e8 ?ϧelY5JNszC= a9iтbit@DDL Xڶ8?o┸bcaqEIrc_z 3Uݚd<:vY>ǯ&ݼW3UK*Yy2@ed2l^&eBW\GF,#dHϊeD KJs\bt)aʈXLk<["Oۭ\Jܛ"p͇L뿓ϣ궫xUS68'@>G +^N 3""BWzE̳e{^ )9#|K@諱{>\ iB""*JOUozʤe;/?֎پN*D궫dUT6.[ZAJCD7yRJU13/7=}Lyٲx sΖy0GjXE_nDso5Ue8&ۭIv]U. Iu#_ZQBBB{%(<[>+9[S<}{^JZ;΢Ŀl֒GSZ8vIih5ɮаq|!-]|"@-!k-' Yk>qHSdgQƭنk_;Q=C|闲ef@NTݶ[odHPr/Oٗ$bNV>YvC4lq؈ŇO_t`xbhԊqmL̟lVG|sW;Z"!"SdVrkDzK&"חG}1HAWښYzzvRigKgv2}ymx|ttHiY%HR8 KZ^rIvľS]GM޿ ))W^ss1ϊIf+H2d9 ҃r SR$eIAeq$$|,|Y"*%dٷ^)󝛍Ua[_H_qI$DIflSmm2ߩbv_y>e2%iTp3\Vr… .\ٛdJ*K> MdDClߺCw/qn𱻛J&e.\U2mYb5KjסZ"S{m]|蟹+m?ovg4.Yk?m?1׸@ k-'S?< 9=`N)%$$w!닾C|?\]C%0"w㗰!PdO-a#DeJJ]G̔I^ r 8$B5\;-|>uR͚bέrNml4 @P??E1fs~{'|YmF'+A#g_[ۊYuz y;DObm/|VjGw >o:nեT/L߹Ib"&Y|+/Co 4f][͢-z-МUzli\ _{4X w2( C #>}ҁቡ'G?EwvY0hBWWXz|<-ZX,NPW=LU}3:,ćp7ͩ g1cѽ1yhZ"I==2$'@JDҔۙ 7Q:q'ysTLt_}UD!j8 ꮣbts$LI^P&.HofgZnYQ ""(a#6.hX-Ԅ/3 eVQ$٩L-=5&qm؅qhN4h(:j)+eJ 2"IVDi DzP\-:_B_{vg-r/kd?M-NeN0pn Pj7[#obguMF>1o,nXvh~v*sD? |¡Oi`()*d9BUƚ,8x澃,(Ji$3~v+I)Ii .U""F3GfwN[sqFaQnsfǨ40u۷iG_kfu㔐wrW1f(Hqu3|:= UKgXQCdDEy;>.O{A^M' _m}o~uz> |1njG Xr΋la1AH{<ЋI |$The+װK雡));@oڄ ˞l1*ǁ-Y򔋮Oo,\Ȅ :Z9X}QǪB'uT1oڹDr aS%$ˎ:tMmpyo&}t}_WMyf:(]o0o`0*Lb\^{8ݻKk \,=cXB0_o݀nΓY.i3L۵pmɈ+)Lj6Eva4 QnKX\%o?򹻩KBŬ] +S}p2g"q[-Tɲvl)v3רTe;ʅ1ZU::5yF^+]S*2"\Wܮ~|MJ+7@@&DbaSs9M6%ܻ~M3IЄ`ׅ!8IDAToil'] @{4!i{v>S6"}S59!_ n%;}>d0mzO]?pjqݺ9O>"!*J>j5Ϸr2FH5߱+;YC_Hzq*^ΖIR.,s4u&V$=bD|>uܪKe 0bӈ{sNYm/QѫWtv1>6}w}.BQXEkUW*@ fDU%,U=/V] *()[+hpci4W}WENؚ\'|~ԝ\e 0qkmLqJo3:,Y³kC.=}Ϊѕ߿ڣϗujsBs0TQ\BM|HHHHUcу(4' CIENDB`gnm/vignettes/screenshot2.png0000744000176200001440000020065113152512335016015 0ustar liggesusersPNG  IHDR1MIzTXtRaw profile type exifxU 0 "%>rBH L -}6`YR Xcל<[Tf[_z+,›~HTVYhX1K F2>zH,Hz+ iTXtXML:com.adobe.xmp L)sBITO IDATxy\םY~Ȫ,(*hԘ *Ĩi34iIiLӚMMNI%H܂+_.p,ǽlrp!{s9(ɲ^ }&'KoN1לӾz0ZaXe `;AAt:K)ŪAA.AdD"Ie(O)Le@ @SRJ(!0,BBJ  wMe*SIA$InyfY±,qwOJRY$YdY)eaaYeJ  KTÙ6#?ʠ֩,V-;֪TJt &S|vmUURϲ,G *%,އ_hn5dNgk9lc_&lXQ 74uYfK cm&U>א4`AFdaV/.0J&ubNIe d2a`°.59%^R 'cYeGR(X^)6) *JF13*;,|@?g1ohƬZ~?z*T/KV~ƚKTI3aW5e@[5f?.Oڴ* CTFda6[,b};=AM|w`b$rG2T(ϟrbPTvr Z:k}DAAz5J.k̜% gO7J6\;-{ ~HngŤ|r<4=|,H>qcx'T{2$"/X 9FǶK~s_ъh.Li3x=] f 0 # n QpdV gmq:'*O_:Dz,\iOS*m"@W̞=^ʂ$WF#1O*EesXHVV<㢒ldR ,TuJJNtI0,ճ@anT%KeawDkPQ<x^U8T?P={S`}x|DR°J=fK|%ndIpZID(VVh:g*[° R,BwB;V HZ%}^>$ O }_o^$)v7rVVm>-vzj{Q>/qK|J|AFS (, Q 6W]HкTl: )%9DgX;`t,'HbxxJ|Y)u?{B j&,<Nr_N oyITTVb⯯͚>֗Z}Y8tgˋ&* rخ (jT)s~&cJ dg͓n3NwWME翖5m|(- `uv_S4 o;J:n vkF-tOarγH6".&GO6n8ޤTq^ee~ɖ:# ۝JfP\}֨Iap4]W-[o KYlv_yn^8P[QE2jnB.rXIxgNb_FT]>\ 2U[^~}gYo%#cs#oOU#eG9Arz+ں5#o,2a(> R(hmEA5dQ(onM>%ZGQ$Q (((Jbq*JR?nx>O}&I U?cWJ\6[jX_(_ϖ;-N>6WIdC?:퟾R ׾pJJjk3 Z̭-f̂>9wQZj]$M4YPŧ qr*LyAvY` ?#uݩ6Miq^enwJbC%NnP1 lܤ0$/SyCvS2+,;\?gg`7$zQT>N*w+*?KF)A$벹D9sJ;֚-m-VWg;pZ[Zr~tn˄>9Fw5`h?yl?A>yD1*"[mT`R{K~QUm/JI$,֪eI"PYi.ZJ )}>{߹"UpM"6B%QLjӢ]?N:"$YwCSrD/=0R[@nm +g$ 'O[NQɂL)E!ǎ;ٳg+Ug@ .C($y'[>\W:>Ĝ+L0Oe)N-o=Uk{f]UzRRpiWMZofN) 4-˔2r^I;S8N{Rp:f=aե0=:KZT`W7_MN/}RJłwU*zpWӡEM";:ʢDt}/FnY8ZσL?N롫ԍO02π>!N$Sm,YIyۚ'',)踭2BBJ@~$S v]2!Ry5eI{n%3$Q1UKyfٯ͘}lB))s/" L~t惗yi^D3&ޟE/:nr:>ΎUO:,`{P(ȲwUJt[wCYL)QH=ٳ>)fǏ3wG pWV[SH4gM!a+fYY*[u2X/?lS,NeaUdxfvp٬$J(Irkkò0 gp`W^{95JπKfM"#ܾxT?apЧ2c@(~JXU_-u2kZ Y%tYV*K'° #5^iU™h}> X@XTٳF9,6qR%>'YHoks=-݀e*Az~O3eYG։"hԚOp5 Mqz f)oP*5 ^q\ssV$ad"Rҷ,sȳެKʖW3_Ag^n;qa9ݦofYwy' lZ@!hж77۸k-rFbi6Qa/|# MWoX TշJmSGЗYtU߻aŹDzޘK|(23Snkx9#N6g>vvkIondXS 3C3eAbxݗQ"9ݗr)~{ۮ)hzp­5c^S;%hzDyB*a )V+4PIZǙoVT Ü#x qjeYrKp:.A(-Vyf 2<׸gohe=+ۛN)Kgk,20 Uom*z,4V 1@/%vwEְvcFA*7zm.,:.&Dl-tASnE)JٿWJgdKÍz(yoS4^'^L OvkgkE >|2^?o鹛0TEǷzR<2\.IǍrGt0D]r2ky,; DD,Ǫq.( n)QhTj$━UhY]d # JTr^xhxzd⾟J.]$$a9WtOi~y+ga*ngKT: og*SN"%\8ƸwjJBwg9tIV1}.,QaB+XA{@%@ZpH,˩j!1<J%)2 <$ 摻[;X- 4RYv PGmxAdduAAFp4  #VQAddB***Ad_*  #yAAGAeAA/s?͘RG,# 꼱S'O}jkl]?AyeU̸XN_]zd~o.}綾T'zV 9ۧRs <Ѽvt˧n@IC# 0ZMz~gg,[D`;AAF̫bWdѼW.g'2OmlVB\\̥tJ@6_x[MO:"uomo)sj\\ܔ̯QӤf߯_Dw?%e^>a=W~}%㿋/]*K߼/,Ro幏J.lAt'v4?^(;A;M lݝ>y_vv6g{Oɾ|72N_姳r-{~O? _><G]7GŊM?^6|; < +-}iKi]ڥE)/W `׾?oo+{yXgA7_州Ĺ;Z~P%@W_y7g9˜^TrH5Oַ=Kk`"~3]+C=s&V_N2n"77+AFVZ=٠jo᯻6'=A"0~^k}2=h"}ݏESY) @3m˽ȼzjy7[0u<%?`~@5 b|? |؏<[+AFWOX_.ӗ[>lyw;{/yQ*s-Ϊy_ԘE}KNCA6,CԣL>[M}ߜ7ExBmo-dڟ]43~Iۧ+4yBY9>SrvS'LH^Mڻ-}u^TD-{%{zB\ҚZ|y돗Ϝ?5gF! ܈AԸpAF_4nD  #yAAGAeAAG^ޛzAǂ{X|ejgٳg8eNM ,nCϞ= H'lAFVBGeAFI< (2|= n8o-<ŭ;ah ]ؕߘin(^9W,bC< q "RۥNRUd ehQm^]'[.X(9dC΀)| yXS):-g쯴#.&mQxhsHdSOm+؀EGGUkgHBҮM_]l'U7w b߹}$p9뛐18N kWdA`aIqB)xF'+FXv `FܕPzAyFpqDm"I]Ο8듸$'|ǖ&xĬ,uO=,<**rX~g'ZڹJ粥`K%sGjwdk",_25lcAG4;m=E\!=>RkډfGhXǸEQWpxf|EFt;g! ȃAͤ-X=EQ_#u|/40A,2  ( GAA2Nzo}PaYWK]]\ <87gt GT=&iɎ>Krwl9hOɢ[Tʓީr"篌l.||⪅ۯ:x.[* T>wy]}G&6/[0%+S6zF٥;f͚{vizP< ؔKyk# YnͯMRydNv=I> 2lJpu;"4Z嫟즄oV񖒭}B"cgΈ֓_9sSY8sټO]OZxhzD}]2ךTjC+갩GYtlUNL]sAayNTt*=-uW!DRK{uWF\ʭ a-_|жrc)RP,Yrpo?i{%Բfa?Dk  -}Kt:#s`}b$t4/;5oJt1<I<5h۔6Ѕuj!"&\;xٓmE\!=>RkډfGhXǸEQWpxt2Q<0i6 Ay)x|n&m,|>o9ʽ{JE筢]4)#y_,^ucX v$ʰ[vi Յ'br^z[. ez5>|D369`ikWu7eAzL45~WQ沂yּ@(|e)+Q6 Bۋ3s֤2"6y(@^k3,[xN"Q ȃ~`ѿ3LTyuyy@nYXޭ`}:o[Sέ>*+ >{{Az- Mw{~WhRǗ/ݎTr^y6uvm9Aڰ!-s?Qeq#ZA`mbOlnb #BzH 溿`ի܉:4hAdD Vl8qrƴ 7Hs˔Jd q## oAd`ۼǞlToQ|Sy`oqD=Í櫣=s:`4 a\8!څ]7$6@h|/ui2yASe? 2d{++C5B} jF ȣlsH|W|ew?PF%iV |UǑ'F 7;3Aϡ3M~g^eGk'L qd u =LskJy(0_rv$82¢ye8oxw?(>o,n ӃL5`;|¿n6 <2/],.q9BhQmǮzO{2B<o%AGF©R˙=G]l9`㕣 2pP'M $7hqV2gjG GM.b1iDC&~j[a$/8:2Z;CLvU7w{Y+w}Lb( ڮ?Y   bVx{ۼA`aIqB)xF'ʫ+q*N A3#*whX}LpdY%9Q;4'fdѭ{*m3'7SPE_.I2lSU ];tڳW>wy]}G&6/[0%+S6zdSj+;z4$H˫r .<{y*-ڵ&蔜n+i{#-g\A~^F%'o/osjqQt5h۔6EW Ø.(;D{$0s*ۥʣ6~zM`E][GRlx2\j<򽻙(JB}3()ivѤ}Y B{am*XLt|9>D(:oy+wVyn$*4{~DvRp>M،g挋]mߔ1L]%F J-ZcxFw(.o/JYPJTyխBR3 <HEEⲳM ,ׯOJJ?evvveee_gsss׭[OA#xwCA < # 2  <  ( # 2  ( ,`~ fQQJzxjy #Xb|2/],U ]u\Nz?;ʎahOdO~,(Þ^piDžvzAB 77w&֠=TJvE˙=+-H /7KW>AFBܤ`N.{S鉆2gjG GM֮}Lڢ:dɦVX+ɋ' ΐ$Ӆ}zST_m[j9~]ñOvFoBF8?]Fg )l;WڋI׏ߴɬؤl} ÓyFpqDm"I]Ο8듸$'|ǖ&xĬ,uOͽ2z~w+c'Z6lSU ];_u\Tl>|ȻBsLzm^%`tKVm,VvpggCwƐ"=.5X|婴h SrNۻE+Ҿϟ~o3v>jMA'ܨ$m]2_-.j.xFp%'|ZJ W&^+nDSu[I1SzGC洳PYr+sUuJTA f'iY\.~IM 3qN8*%{+fK s CyV(> -7.0:e')!,{@dfؙ3"pu!rv $p3-ПEX `*{L̵&U  S;%MeGfhoZPA#󒹙(Tz?"@Q.TU_݇p^K-uW]= m|s)64_|жrc)RP,Yrpo?i{3U "I].c < 2=^l:}V9 > rcּ)AJaЏgMhUIAK]ݦI6.̏"bµ/;D{*=N]$VCz}ڥʣ͎0qi`*?;)X@TgR\fA̓l-߻I[z:/$4:cyrfyhMyޗ% (W.֦DgC$2֩GByguቘ^KBsYq秞<0pMh'tьxfθ(XUxMYdMUbtޢ5/J8F?_jYʊgyy P̜5 Mw^0J0W ]^P `R UA UF  X17;eggO6 kAY322֯_~l]n.2$KMR{JK?Vvoh#F<dJpA$,*~ʆfH#@.QG srMep55YFDnDF=6DͷjM6X!,bLU_q?-7/WȄ1:r GxkA,X[LNV lZݮ?y0TuU Z۹ɓXSՕm S&MdKZ>j)}߶J?lqmv0kL (  s/\cGE Q0Q+-Ve Pb+Km-7,X|iN ]hf jO#<mF6U]ojj|8*9R}C(@%ʔ;a˳ % C)*dF{ deD7@Qol f3cb=< 2Z𺠈MAP%_Ԅo/Q0S%OƶYX5 jyK 8I?Gln0DǴݮow,:ۭ^=8g4*H֦6 P3 Pk-s&AyNVַ>A"oݮ(uJU:W.<:: X!ll{U1457-P?g>M ( w®M]aV Z1qBww\o0@@΀>02.8 3уM 8h wX,Ae,/!eC | ;1bAY|X|hsˈQ?=s隯מ `ր ȠA{6 yqY$U<[chQmM΋k?90wK;N)|}Xv 'tE`UY>mI42/+Knt0O.]1M=Z?|1]pfihr>oy0S)Pއe$W ?s>DK!wEW['+WΉ+䒅tT?~)f}22&)|xj[׭]U?efwn1<0kz(dsh: is9IpM'zU$̙QpQSr}Lڢ:dɦVX+tVTd]v .+m,`7WZ3gL Sܬr_? (=CJ.m-[* -7.dqVo|ݔUj=RuOHDtzZ~:5Tmxs 0J2Lb% ̳=^_|жrc)REם&(.P/wl*P@{]YP-S&wCF`o^{uzY>Rc^5e5JG(==Onky.ֆu:^5USYYj*mt⸚ QhCܫ'N]$Vӹt>=u<=gd 1FIj :_Zs̚7%HQ~5&u֠n'0?O`  *;WцGm(|ɣy6 yAjX'$"]>Lt<0pMh'tPsYAEk^ pPxղ(NE͗.Y3]NG#GnܹK̒xn9 o/JYPJT'FwL1_as8 IDAT،g挋]mߔ1L]%]:)sېl-߻I[z:/$4:cyrfyhMyޗ% (W.֦DgC$2֩GM=sVyn$*4˃.W M.ehFϨµQk"vgx@qTTTq(...;;{ڴi us9͗lw1?ȯy?սx?1|x:6w%p>===##cIIIήlnnuI cϕ< ws~_2/hDHyu0xiœ ȗ 39 #՝[dC%ӹ}?r^#ԇNjj@e [*l} MA>WAAGAeAAyAAPA8AX 򈓞>2χe}cqNi>dv݇n C | ;q~Pj} Vy.,Cz_R4wnǰ/ F䑥l6߿̳KVΏ#%zȎaMהrH a.Hmw85KUC:.'S} ,N 0 _ؑ{&7y[ x+A䱦OgOV:'u`!rfBgN35yx!J)?>, ϟd=7 w]DӥcUN ko#22e~D~9q\rEKLP~R&ddL0(8S(Zն[2x꜌I(r{㗧+N9c+vEXx;eaIqB)xƎA6 y:况zNxt޲vy@߲SW;P]=r&stٛJO\U2gjG GMc͌>&mQxhsHdSOm+:+*c+;6?(_}o\?gΘYu΋ͥW!/|idJ.m-[*$!^sf1>stu4BQjȨk߈n|¬.^㬾N.xI/SAG#BH"3U Z`|y#;W29>OdVqT$ts^J?f1bg&ުLsm C|_F0"TOës>!Z9rkx~/| .'gt]RnO9aL<&NM1}NL B2ʶNj"& r8eYXgqKxu}WpݜRl%elx|AOkGkg T.qJCD_lgufqWvCvod@CW ;|jjBtRll;U*bW^zoS`#)x~/Z7BWD$۽KQYyʪe JuMӤr3W(,HfBN7ܫ_D6U˄om÷ ̯QUq]њccZB< 2<+)KZ5"`EqUSMhZ^]rI?)EbYtpm_d9wܷOggdž 4B,CSzU̓˼d.yWm}WLzh-WK@;JoZ)U姅1֞K'+nv);%\buejISDIqfмT^_CIq{عqֺyoq"9\,h틪"wptoE/"H{̒6;ɳ4&dWm~$9a:J9ˡmhkzJJa1umC\r4%TD4c7qnTf*ȑo^2?^}[:+^`=-E?ϙ~]6!\d!DU*NfhE!ƨ*Bdn|p.$dl>⨬tL2Ⱦ Wv<$='}ٚ+&!B$O=F2,m2'^pfRV9yֵܯ>=5ᢈdˇ \q$K*Z"!Y)SU`k))dLmƓV>3Ba35w~UF~szՂw껸*׹]Y&%Sc|ƫ>G͌k0] 8C٬Vr!8[oL2em28=57ÄaI%+_F \{bB`t%\j1,ʇ]zZ1^$r[9b iM u5tVs|ř+t˦k/BWDFXFtfueugu}wpKz"D8Yx.{~ﭥ~{#tL|d'Ҟ$%Uk,B8*?k6`I!ݜꬼY 0g*\h8W6~jө5S \jQYYHoG_ko'RI`R^9JH1↮ϭ2y}2_1NYUlزBg:[K;_۪{>'6Q=. {W\RXõZ(;;2khoAzq6Jc DVoM|!fC*ڨe|F̎~^픻QV}l$*ܛIkZR[5Fv(=)ys5N=.U/"W,dݭݭ.=4S0}ʹ xMo Knd,&$a0DiP>Pet!JezJUDL?)'y̌hs85yu#81-ϲ |o/+&c$;<(j{V}$&Բjz.P)af^u- {GmwvG Bs$g. %B:GhYE:YHŝ{ߝrW0  }_Fکi~Fw\F|;v4Ba晷I | r8eYXgqKxu}WpݜYުF:~VJ4V <-\׫R.8\".y¿_>δ? hX5y\Hڸj: ҧ+Z;6r}w޴x_!q}׫\H899J~*lX5$}ʌB GKA뚋V/ۿ5_[3bݱyu`>YWֶ6h._8G^ۣ€OYKY#/N >)U姅1֞K'+nv);%\buejISDIqfмT^_CIq{عqֺyoq"9\,h틪"wptoE/"H{̒6;ɳ4&dWm~$9a:J9ˡmhkzJJa1umC\r4%TD4c7qnTf*ȑo^2?^}[:+^`=-E?olK70d!DU*NfhE!ƨ*Bdn|p.$dl>⨬tL2Ⱦ Wv<$='}ٚ+&!B$O=F2,m2'^pfRV9yֵܯ>=5ᢈdˇ^uEGdz !B@>u\ V޼`BLz4fdܖyةB~ZhCw]<"ݮ}q+vŲq>Fi-Q!־Y]vYb]Y}x\^-F}(ྺ"H_+8Gw '2K~ZYqT~EB$ts^J?f1bg&ުLsm C|_|[mU9}ĸP>Pet!JezJUDL?)'y`3ahs85yu#81-ϲ |o/+&c$;<(j{V}$&Բjz.P)af^u- {ob3ɁBΑ.d{9D tsS xa}zp>hHoNF!ѿ|P<6}?4po@naMݪ~3B=sqpDc&-CGqy(L"AY-f$rAks"$Mssi=,Qeڴ;$mvjV9{خ8#?h-1^{2RCx^MQ=rE8ei̙I彻xJF^(6Zr_Z+n,5El"&CF&ڬ8ΆfMh `í9[,'!@N4k0nw |νQZV%W}W\OqJXoLs^ |8;>'p864hbҫjk |RO oc:ܱ _~'Ħ] N pu]Y4;|cQRf74/PR^*v\n^x ceFk_TU8︣}-+Ĥ]qGjo`ٹUN%1'ӼZl#!LKЁtWʡX_mXVs6 IDATF۟\+{WRZKp%t\ Ro_~ms5\szE1ѕpժŰ+viSNxml*T56t#Zg1nW,NnF!j\bэOe+u׉/zj"hm3R_ֽ<$߹œDyoZ+!ϚHnIuV_,cB[i ah+_g?ԚrݪEagKdfE6rbͳhkP* L+80G >9& ^5^U&ۿO+)ʟ [V,V_w5\^0c;1m6tkZ(;;2khoAzq6Jc oM|!&fFeڨe|F̎~^픻9]c#QAބOZrݪ1bs`FI̛DtavzƸb!knn}paD*SνVȇozkXrS'o6hC6.G+P>PFYOI'E0l&Lmn&{'Yv!eeDsd'UCGe=ݑr4Umݖp٪DфZUM;%13,5cK9!}q9m;ZL{&9?sQ(9G"/1'BǯνN+}\?y3Gwp$֖~`Dw\F|;v4Ba晷I | r8eYXgqKxu}WpݜZWK71wVw!}vV"Nwt>Ou{΋[|cߟ} d@CW ;*K.]xQR-vիW? .@ `p~Ҹq""_2gg̛PV-\U+n_ߞ& + |U0. K; jQ@z g2a~z-4 kcTU\WmؘVG2< 2J<Vo@nM<XqܱybSd|>ZV%W}W\OqJ<!>p邳gx0DiLРFehJy\c̅1I-}c*w h}GMq| ]I鮔CfN?yV-9yA]׻6!)GSBEL3qwFm%CwqUsbPs>y\4RB^l&;Vbk*D Z:KNʆKC+.JnK$p`}_nM3N"Sy71/)2`b"Dn4N/;*#ϞOzEIϣV'`C3ɳ~uA?^1E'\>3.8%S]S䬔gtNnBFgf׋U6+xO{!Að՚;*#9bUj;]nyQ[Ndp@c 'I>2se?!~^["Df.")=3RAu=,b8!>MU@ySNZ^ UΖ2̊ā؇~l>tZ}8!J +O 7tׯxnwʪgÖ<שj W0 XzN̚M͓hXBObNyv43ybSXSBJxEȵo(5\b#tgS;oM|!f#*ڨe|F̎~^픻V}l$*ܛIkZR[5Fv(=)ys5N=.U/"W,dݭݭ.=4S0}ʹ xMo ndLo<,b 8WO1\(O 22f=%*"ɓs<0yMc:gمdm1TEMyhwGWfw[e>APJFW{DFjYV5=(LϰԌ]3/Ӻ=[x刷h1Ah@EDZm2Hǜ@" /lνN+}\ںMef!8Q{E; ︌dv/h3oCx Yޭ7#:ӏ9iZN$<+)iR1tr$bֽO"<'B4=gQaM38b5^vMK;:K6n6/ag1ci;֢'#5Dg5#w_cQ ,oɜT޻d%mc%\޽12XS*rOo"0lmαڌlh4OY 6ܪ̢| qJ: v}Ǘx9# N}۽'2N|!9*- C6XWW׼ó Aĩ\Ӈ".V뚷V-}zPu H6qjaӏSSS ťK.^RիwCUUՅ exx`08Ehi{xED dX7Z6pD[W=M@=-Wa%g[qQXڑ0nW3-m8 3?7ۆo_j5ƴ >2|&y@dyVRI?~zrk Eͫ^_"3Oµ*q*~S+_ǟ By0BLРFehJy\c̅1ղI-}c*w h}GMq| gM;]Om0@ZF$3L__ֶ+sV#tO 0aXR@Gm-&)9Q5Xc1]i WZ ascr2ƋDn{*6RX}z߭pKxpubCBwݛLMaaTO *!>:pΎZ"ڛrС^MR؇_CO5}8i=3;yYSw٪D{"΁'2o>ѩ՚ۥE㊅qbu1…^խeνVȇozl=? {Un. Y5]FTƬ[E"yr~N6&6SwL_=B,m9Fڡȣ2H9nKlG"JHjhH-˪kyZ؜g Ѹq-&=ȟ(YMfHd!BTw}w]€ WO;Qpzu4Oxe$˷c~A#_>(lyξD7CV nU!Yޞ~98MZWw"1^IIBZtE pUқ:AxA[wʵȊ^#aN";X~ !W'Dl}i_\w2U6\bZqqTVw_z& d_+rmrqyʓylMѕ!'wqz6Uy|B/J <c`8y)`_$<6jb,+-UaQW>2Jէ"2;UUOkm讫G۵/\ycܮX6]{ytZ}8!J QBO 7tׯxnwʪgÖ<שj W0 XNoڹyr@#aotEMaaTO *!>:pΎZ"ڛrС^MR؇_CO5}8LٱˢrwGV}l$*ܛIkZR[5Fv(=)ys5N=.U/"W,dݭݭ.=4S0}ʹ xMo l.FӳP4!"N1>A\~5ʓj\nnO9aL<&NM1}NL B2ʶNL_ IDATj"&/5)G_m HA))_MeY\8S2=#u΃E2׮SQxxxvvv||Y!8Kܽa>QY://nʎ}_ 2 ġO_SSS ťK.^RիwCUUՅ exx`08Ehiyr""_2gg̛PV-\U+n_ߞ& + |U0. K; jQ@z g2a~z-4 kcTU\WmؘVG2< 2W0+HqᎴ߿ʇݵ5"`E!3]Ϻ)2w>-\_J"p>8sރ_z~GoN8?eϦbɏ?Oovm{fu_Vrb3y;+%!9o?' >Bc[/e#jm͟uZQzay,7VUmM8"NJz޺b#XTGۂ'pqA ;[zM18|k꭫QBw -Y^ӆJߋ/ɵlp,7VU.M?`Ѵ7iXba`~Nz+ᓸwr1yTXҞRtg1i()N 3Uk()nz/Az7ۆ8$hJ2i:k^0k$7BJf"ZƏEV\I~3{0aXR@GI=:m-U%C}W[ Bql[ BiؒrGL2!Lח/.XƧsKY帍V|Ԋb, jUNԕ R)'V` gs\TUR?IZg,+M^^ىI["B}<2.Yw;/߲+3gΜ>Ԉޢ=5n`/=k#_=3A52:T}<`c!BMU 6 }kXu,!CswWQAuY,b8!.*NZLul,ìDo]_Vb!J QBO 7tׯxnwʪgÖ;՗DyoZ+!Z]^0cid i=3;yYS-}9P/Φ@)wlxkq4U>6M5-_h)׭#vp;fʼLDVknn+ƉFJbxU׫  ֱoP,w>|[ #++I74E @G=/#֧MfcJd!BWla'UCGe=ܑr4Umg6qjBGpbZ(e^Vm;V9e>APJFW{DFjYV5=(L ϰԌ]3/Ӻ=[xY GmwvG Bs$g. %BJ7f=%:ݎɓsGs=g( z Y4=5}kiWUwj-sRC=xcbmo5EF~WSԨI |IH.S)+:4 BarűX~~Sѣ DualG5qs$,ah{٭6-#5}vW75ڝp"ӧm^Yb e䡜3eu/Eω4= N:K6nm*gbvE=&kOFjw!x~Q2EYZ3%sfRy.Qd(ܗ(ry(`M=cQ:Dz6k3g<1fq2pzֳE[e GϜX4ue}'N㕔_r{/ 3|7xw(}[H\%@|&XݩRa5ygggm#8Kܽ+(m,n WvC H6qjaq9IMMU(.]xJZ춫W~ UUU.\exx`08EhisxED dX7Z6pD[W=M@=-Wa1@'|#9a8=pf|[?pV-fm÷ ̯QUq]V@dy@X Dž; +wn=w ^Z?>Ħ|p͚*~SEpQ Μ=wp  SvlS؟tzffu_Vrbӽ̧y;+%!9o?0FxŤVKHZg[g݇w|o^:խzkit0Nd:u꯿|JXDW$ [΢=Xܓ5xw(!;,[m(Fߋ/lp,7VU.MHފ?x㾯cCol=G!&=QSqM\;o]__Y;3#f??.R;z8:0ȑm^6V p Ʋ/G,,.8V.# K_g:+|cQRf74/wqQeg/lŮR "₶;ɴdNfό3$u2] *"( **Uz*s`չ9Ky{;y\qS5T*s]dgsa[<qE֕If?y?|~`*i vxg%t >a]pg#M=.:>l5p魹^ib]~"Rh͸U<7oXR^vL֎b8L񨲰{Z@-t ^!tt=hSjsJ2zm$ZQ~=7i;crA]~xa;oÔUH7JVzTZ⓬+?}iw<>u$qh9JJ 88%ѱ)pdk~?^jznTϭgC&l,76وaEځ} s2Zvgթ pQ`jzgE(pg= Ƥĺo? IMjp8 ld|^! ÕqoA#3oXR^jCv$]:K5浂f[-cu=?Rri@,b^Pyk]Gɥs\c3G̼ĄnU)egEA8Է kH`a-xllՑ!%S4*lЉWk5r\N݈hBiښmռ65T]SVxZ.-n$J񰲼 Zr).l7(~1Xd#@]iբЦʋV{833{W9͌_($H%pj\٧E7(T+ܷ?c %2K7Pvlf:c9aKJ10s4 3M%DUDߘnY `80J?=^L|o924m!vgǗc=r!Cܣgl='c5جH7n8'EՃ֒rڸ/I\2 )VЬ_0 ׏KIvi\p e@_ۤxSJ9"ć&解V-LK)D#~QX9399 qx\^Gm oޓ[5Jw(=A2Dƺ.t#G,d6\v(k9}T^*7FuZ,w|V8oHMxxxL^bH8|ML^O4"WcI|݄LW "'v׃Niɑ f.d$XezIIBEJrQVe k u3橱MY K>Xc|ẇB;!, bfIcSݣ}3yb]Ξ=r_(--=~8jb288P(Lנ3s1d([#{EYhp;ye^-inV%z@ ^\pjΕyzcYH;>FܐwJQ5 $KlvY@ /@ $@ #@2@ <@ $@ BqO|zFƑ~mNk쓹Yxk7d/uZ!l7BKVTW/EvH>-:㵔_ѣGK9X _pf74~/pW!qt푅զg=s|HKvx&&>o5s}*fea0Rp[o͇ҚǝJjVJ7^my+_OgݑjM7\OMpl93Lu :1@X*#5e^(*@Өpq@ =T1GV ] R+F.=#W iWW[(yC-ulݼH er-h;':@ dQ2ѡN-I14X]S10} >Եw?~}rR+Twj+ULj];B=׵=wa|pYL0Q{eM `몟xK\ TZ\xYNR4=V?u'?9~J%cU쬽~6,q'<Ⱥ2Ig\#GOLZe"-@}6,Bඕg;̢ZzֳǵrELJf145+۞HUi 506Kmȉ1w* 0fVǺԋ)o-4G2Q#NT~G3s{ͳGtpc5 g1zPk3_yYN%R&188=* Czu kگ =+rr=Z6aKm/.B|h~:ʺkj´BN8rՋe1*IV-`V'whC ߼''ͷjXiQzđ3duv]*G1X('6 >l 00Pt'Ws@$Un$Y>4O5Xpy U @9?Z550E*|wu IDAT#guhb"|}J#N&4fb h7>Ttj,MKm\%ޏ0s|g'#`*ӘmKM*T/KXk7=K$lloj6%#c}~i1vBFGY7Ś at=.Ƥ ƟxAn;q#ۏ#˽yPa\8_7w︮*F681o=-9j(FN%; $R-Ч.lRhK =>^Xz*f߼ԍO^*T3]3 #M&K s֓U6> lm7-h+doOB:f~YYO4{NoSjgs6d12eZ{;wBgq+VJ e{}`o.Cۇ&Jqcp]%,mkAyBT\<6)#M$mȿ!۟ƽW3JjspYa[Z']ư6W3~Gm0bpBwb٬g (Zwe* E7lx|M9MzVs==f(@Yu<XX[[s{ȿJ#ṟEsAnYx8=o|ݏ-,lc[f7+'..N&0y8&sFZTH+ʪE +j/oOsp#o*vU 1 >U, \)G7VUsc 9|dU@2kۑU @2@ <@ $@ #@2@ b)dħgdD|ꍽf>Ua&MR6([y#DdտL}%]dd ܢ=~i-2jo?~{KO=፫mOO=*s':݋{T1tW~=@zol Vν\}XbȽ!Jkwv& `uMdk;7PIaPީT!#vq4^܅mfD Ი;aJ˚k> )k#;U? xsX,')lWU?UC1ǪEv^{?G[qWd]ia3.ߑz&2p} ޾jG pzXRpJnwfQzN=tZ9V gaޚmO!.'"U֌8;Yzs%%ldk8,* ͳ(_ӭoN+0ʎz,ҕ5γVEl Xª2zm$ZQ~=7i;crA]~xa;oÔUH7JVzTZ⓬+?}iw<>u$qh9JJ 88%ѱ)pdk~?^jznTϭgC&l,76وwEځ} s2Zvgթ pQ`jzgEGqQI{k$!Iuc6~jzq!ivC@+!. sG?fn߰D-v"ItkkP.Zjz2Z.xS;jZ@x&76"׺F ՏK7ƦgIvY ݚz SΊnh/qokZJ5I؂iY#C&J;hZSU81Wyq_;-dk`Z 5۪y'j%m jZZn*"\]Z:1Iaey!BS\Vos z @峭?aBH fzb`i M%DUDߘnY `80J?=^L|o924m!vgǗc=r!CܣglV='c5جH7n8'EՃZ+rڸ/I\2 )VЬ_0 vqj1IsZ2mRh^X )vvCQ^+Wr"đsϨ^,[wV8P*/j#:-pO>MS +^Po]wG2?_E@ 9 wiP CTա ދ)Fj\b;[][$WzPѩ4-9rQ#"pזx?%󝝌cvLcU/ 36)v[hRI.ʪ:,a,KZ7iٔk#5Kˌq|(2:@/Lkp4&=='?C'9@,7*>rynוuCo=ƐQ%G Id6|g7$Ce@_[cŷ|Ӿ|Vum0T' KOM؆ڵIF'/t.HHˌȑ‹r %z۹n*~}btwVIA6ϛV4fn!HV3v'=7㩁vU&L8FXkon\2nue*Si1lOMwpФ8_)nl#Km-(]\Ȝj&eDi W2dӸWjFIm_y.K;lK`@~fq/H FQ Nh\,l޾aQyEKQṢpPCea׾{/7 Xj{=#W6' Wo5[ܬz<5omǗ:Aɇ!%e*+ɗ";$sw_?i(' @,yUg&xCr gq{NgYzQq#`m9}AnNjǹaiCQ[3gjkΟީbVFa#|(y٭/yZˡ& .h{tM}Ֆw?nOJpwo\ȀԔ5zMqO–vC1;ឌ|Ucu}Ŋx(uψ.C}ՖwJPKv7G42(jP$smڻ?a>9)*;*cĮ!ڞmapk,&c(ҲZ0OBzZ}ǎuO¥b.Fv}m*sX,')lWU?UCs'쬽~6,q'<Ⱥ2Ig\#GOLZe"-@}6,Bඕg;̢ZzֳǵrELJf145+۞tpo\*G5 Dsi`eܯ|&t  \J<|Pxs܏4,@峭?aBH fBHUi 506Kmȉ1w* 0fVǺԋ)o-4G2Q#NT~G3s{ͳGtpc5 g1zPk3_yYN%R&188=* C-|-Q0.@ '&EqRK)崳.Z0-!}Fbٺ;pFx䰊$aU lU/ݣ6PC7I%;qZzg q f"c݃C n#2 n. L;ɵAU>P*/j5ئtZ,w|V,<ʃ5RK @9~za" t:41{>҈\Kc'uc 3^1kDJ]^*:5%G6b|D.cdxZbi̶%{&n M*EYU[Ǘ%%6qIf6Sc75CWs@c}~i1vBFGY7Ś at=.Ƥ ƟxA~3ww%-h{%J;?(\ާǤxue]P1iG1$`x{mQC95rҸ. 8M ɐjW>mw-ߴ/gjG[*hL S3nxRIЍ򈄴a0i*(0O\b붞! 'Fwga8mihEs^!{{ji5czs\}3hW;k');۹r?t]TZL-{t9*>4)W,ai[ {2ZIQl$)hCU 4QRWÄz=쪭4rK>oQھ;f-=oXT^FRԔ+(`,\?PYص/n~a#Kkimֳ8R=Zo{M1P4FO\kVhB f=_wk~4"[1Q ?VU#7Jxlfb<..N&0y8&sFZTH+ʪE +j/oOsp#o*@ ^\pjΕyzcYH;>FܐwJQ5 $KlvY@ /@ $@ #@2@ <@ $@ BqO|zFƑ~mNk쓹Yxk7d/uZ!l7BKVTW/EvHnByOF#Gңݸ@ f2Ug&xCr gq{NgYzQq#`m9}AnNjǹaiCQ[3gjkΟީbVFa#|(y٭/yZˡ& .h{tM}Ֆw?nOJpt qْԒχ ud~kE{4.wPu#_xܹdT˭+V]6FO|Q5v7pҮ8˕/PZfy="v4e_hD"+<heCZ*chb2`ε|k~@ 0WxWv{k{¶Ი;aJ˚k> )k#;U?  z͓9,^쀓MOUuvϫ}*vkRɘc";k K-8+L0sk=QVHK8>o_#ą 8P=,)mb;(ViquaY 0Moʶ'O* EkU9}Òdv`GUY7eGBzA9ݕH+ymoukJwȸ?Kܑ7,)/5rbpq.n}ZA3ԭڱuh7mykEI #550Jp~\a$=ef&vkί5\^N);+ xơeX @*Gk($cc e ()huOUa\ŅN|z;UƯrFt@k5۪y'j%m jZZn*"\]Z:1Iaey!BS\Vos xKdnVuư!r$U#b`ikNKYjCNZP cHcC̷͔j|#CVb'zv|Y?#9=zYbEأ|`:1Vs{ZZT=Rߙ,u)Bb jZpF_5u!-n ;o\ud@_ۤ1[j{)vvCQ^+Wr"đsϨ^,[wV8<}]jU lU/ݣ6PC7I%;qZzg q f"c݃C n#2 n. L;ɵA IDATU>P*/j#:-pO>MS +^\B 9&țG fc΀A^H8|ML^O4"WcI|݄LW "'v׃Niɑ f.d$XezIIBEJrQVe kg\ҺMXMͦ\,%Xm1_Zf;oCQzftX3]1lg(tĺ:'꺱ik*618Jr޼w\b}Z{Ljw\WQvCFۖ5S#'ـ mEniavMqZQ~rRٞx/,=?o^F'/t.HHˌȑ‹r %z۹n*~}btwVIA6ϛV4fn!HV3v'=7㩁v9|2cq!3˸MוiL޲=>^7ASܡC|.wq!szJ.ŦIҏ6_uȐO^ɫ%}9L,-דɮJcX+#6E18slҳyEe-EM2b C ]6Rd[ߜV&`=9S-zʭ I^,r:TN @ ޽;22n҈3slDA3<\Ы[AV-do8x*-ؖxqqq2ɓ'NhookgϞ}/?~bT(k[yAù73֢jF^QV-\N^W4~y{yU"U 1 >U, \)G7VUsc 9|dU@2kۑU @2@ <@ $@ #@2@ blC.۹+p}Q-vXUkR|qzIZasK ijiJe>X7Ǒ<̯IχeL@ M3{]1+v:B7Sm~9>% r;^04(n3\5\T1+Āzk>9)*;*cĮ!ڞmapk,&c(ҲZ0OBzZ}ǎuO¥b.Fv}m*sX,')lWU?UC1ǪEv^{?G[qWd]ia3.ߑz&2p} ޾jG pzXRpJnwfQzN=tZ9V gaޚmO!.'"U֌8;Yzs%%ldk8,* ͳ(_ӭoN+0ʎz,ҕe.$} [J2zm$ZQ~=7i;crA]~wl-c3*IF^ɪTJZ|u/ `'٧N3!7G)Si$:_81EΗlM5QKϽnfIݨ[HUi 506Kmȉ1w* 0fVǺԋ)o-4G2Q#NTlR?#9=zYJHأ|`:1Vs{ZZTm5,u)Bb jZpLu`L ڮј@ +&ExaYj{)vvCQ^+Wr"đsf[݁3:c&U<'!5ZfszYO)ІyONo(މ;l#g0T=pcQN>l|ppa`ڡO ҥe}T^*7FuZ,w|6=(R! @,sǡUC]S/ YRww>rV&&x/קT1rq$nBsla+vmp_AEҴFq\^[x 3wv2VK2V$|ؤmI%(jvӳD?.ipoj6%g,oc2cy3 턌o,Ћ5Úz\$IO`'?C'9AP) YJ޼w\b}Z{Ljw\WQvCFۖ5S#'ـ mEniavMqZQ~rRٞx/,=?o^F'/t.HHˌȑ‹r %z۹n*~}btwVIA6ϛV4fn!HV3v'=7㩁v9|2cq!3˸MוiL޲=>^7ASܡC|.wq!szJ.ŦIҏ6_uȐO^ɫ%}9L,-דɮJcX+#6E18slҳyEe-EM2b C ]6Rd[ߜV&`=9; ޤш@  ޽;22n҈3slDA3<\Ы[AV-do8x*9:re`%2p6Yd'Oټrss҈.))Af,P4X'0܄jX<a[.O;?6g=/\i~oX8r i-.?kO*+W?2Յ?~L8țG V%xOUC;8 6oǮ&Xq翩Vz{kU^}ޛ;w{w'V)a@k{yqwd[괖r?zo.W\ibPsh+_ٯ_ӿ6B#o@?B_ß.VУ7rvEwWM)96KG|?Z/‰rab6iڳ.Ao<{-}?|cҮ4LWZힴg~7䅉b~oTҫݱ$I@ 脯{|쓂nQ)[Sp&Sio]ڟY`p^s.rE ~6 on_c|-\1D80,/yzw~S R *Ǯ}.uy*;'o8zUG{f bն7O~8k.W&ͱjV[ ᏄsfD)HUcU/^EiL_Ow`緢km7pFm_{#k!g>NzFyj%閜c+bbW;w 7,)/9\ejVրkGpѢ|M9Gt(:$\= ˿u(ĖЏ6%p+@ ,O 𗦩o_h ٷ_x3wHOloӟ<'X3~쇿ȱ~9od;|#?oڟ}O~x,ۜ6߼ۻ~iO=;'׼w?+bK7ȵ_>-?QS L0S /7s%e9Ǿ8|⨡ܓ7'oi϶>嵧~K~g;VDaSwU<鷏$=mFz?`<͟={eey푴CMw&ӓ4fiZFy78nN+045Tv8Oqysύ_~8ۛ>@ ^ƛ;X"xnۧ^&9aNd*sUvc LcU/*ZrΕ?f<1*G<^SppV`<5'`oc +'~5պ\:W>]/`jI}K_T:!3z>^XI5=3}7?c'N@#W n›_X qX5ܫ`ԝWVa mcmZ?ts6[Xϛ&.G"De{&?ӝ1?US&kud4FY*ӘmKδ?}V0ʑ(V|An#UW;e{SehQF?z0PcT˔C?K^o, bgv߃zjjy%}*oT)۪>өi7=og#W0fn;סfV6gSlpŸ7?#țכ_#r_j?>+ h~oe*ET@%, .J#j,1Ć&*b|X{0QSPbCb!P|M,b# ˖"Rv!9̰>3;;&T~_%a2d2na 3I.ǷYM6!q-WL5'q᙭kVz,S3bn b._M-,rOlo!ui'WKK}g[<|"7g~4˯eJ2v9KK~Zv\'/ƿUyT]oѺ!sHΤ%W\J/߈y_[9Ƙj>y1#eeORbT8*CLM_=q8$U\6 2u=f()C* cɞ-"˸]]UIJn?112ɓ?zhuuLS-QA7p[b|gJJ Мrli/_nn!M'( ܐvwU! D"H$l6رcÇr|>Ѥ{""nq|4SyxYwuu턑3h֊A*x|xAAs{={̟??::ޞ}ÙlL{3M&@I`2wܑ$-[ K~NNAo޿, 1c͛'Nb8NϞ=g|IOߘGz> (++>}+lUUU p8(@x燄o޼>?~JJڛG) kkK/X`Æ 7n;L ٹtLҸzqU%p o ~aо}.pӓtj - 8v yhٷkCqy] -j1dU7^HX$Li\t 3b\=#7M=w-!0<45r/UܺrevWRX K9qo0'wQIDATt<֪+«[O;kHWFwU9T4-_8w)<pIߔk&d(A(ej l3rBHQａYhN!oLh985D$=tJh6[aj0os=t<&v1X*gn+ej[Y걅Gv{ϝau(UG)=GoT#.+EhKyh v׮={bTizk Kƫh / Pot3䂆#Ҋo875r(;>"|GK1vf#veJP([q-@xtX<Prr2*a:XT@:&|6vhaŒWu5o"lio蚲<|r l oOE(((HQˊU.=|{O+LfxW>3 FuLLL,,ҖiV9/r6K#$"%LvV')|u٘-{J^Z,w>0Ӻ2,T:aGUҊgx%Z7=SO}glXu5I۝EDcUf~ys?[~PBTF|9?FpO5 |Ag)sr2}q8:LHI3}7^,oHug팵k~_DDϮ<o*(RFu s?>vb4c {3g@ݩBXe7ˈ$%J3"}] ""Ymä\(!Vs.T|kdDD.]Upu{jT-ȳhZ@-3wOWWqQ0aJkG7;Zp&/xIW:OY2نPWpɕJ**]'kjnD""=Pz]5r1dBߜI_u^%EQÄlUD"-}R)5VG 3&à?u)O&_a;Hkx}4X$yzq_C*/$R*gِ:lT?,n/lMgԨܖ% sy=O%D?Lڲ? ۝&[^PLqWF3|'.:d|CK?mo1`I <-K-owEmI\M֏"bp Vbam,o, CQ;bc^qΡGK^# 9S&{% *”$,*'.[(OO5O,kC'~m5Y٥}gEzZ[[C_%KD 6}sDL/;e.$(HJ3wnHWi֓]3cݱsSSSSSO&ɏsdJ*' UxBܔCttqԻWpoF+d0%o*i'~H 컢kh_}պM3m.4yqXĮ:zf  @Do aFR/\dIm"HD Б!tX0hБa=TߖC!wPrrrPPmZaa;,+<=V&pkEnm<3}c_ &})@`>!%o@ː%2""_g|=~̯E]8n֨@`B?|õ]k'Xw UF3clӈ]NY5􋰉eU#~t"6xa}kFqPgm4ןxK)\R1:; bBW(-a@ |?L5S ##狉D¼l>wKon(_.i<ӍcwDcLp }c6nm'8wlG-L\?) 3b\=#7M=w-a݃no鳼{tt%R.dPptܙ m}wwٹW1UcU$M`՜['UIͬҕU`a~  e@5M[P|#<?}foĸ["|{'fcmin7vp=u_aX5J3janY݋dL̵Y$M>Rx[{ ìCٕZ"Iœ*]]>6V7 IyQ/\*7N14[GoT#.+ED%6vca*ښ, ;W^\^Q-),gUϺw5*B\r4#ו "V0Lʅ} :=jjևIYaSSWID\Q2!ڴijڪ*eJ2"IioR}yW0z]]jn}pҮ{5Y57VM{Bb^vm0boJ{>^_/;o//U^|ɇ5ψֆ &'ڬiګD|wLq{[Ҩ[PHkx}4X$yzq_C͂Fk[xP*yz+3TB|+ $>K?ɪDD.sL,[բEV ]oXZ΋w' ?1}͚%*G3]/ fl Jy\֧ no1hh?Ni;ȷo[5fH33nVʈ;\V3+Q@7l[rUΧ!-Oh~@F4Gލ9M_n=iۡΏv`c3x"  (qKlt-g@011C= AAAh;]\@oB@y@\hS8!\nV,bccѿ;ihWSa7 U㽨6нo*fټn "QK%_3rv@G|r|*q{$G:+/tti_y|ˬ;F1RƆ+֟TRi'^WVb^!X$sqd|SHVe):N -8#/'؝%Ϣ] OƇ-\7%]ddTwS}/WDKߩ_kЍEY_xoPm|N t%Z<):8kg'Oޛ1լCRvEWO;CgvЖ0QZy n9 z’' 8`XH䳅eHWh87`:ϚPܠt+|dg@o>z)J0"ن̻oye+vsFMgLx& B+o[P5HO≡jЫ.\vEWXYxg@~<ߪ)xJJhG 5]t%x-%ەj*X/=-i\=T8DT[RjL튮PqYF=GT?MVQEc뢛3;n5SW-5h:fONa~[i,uOS ;.>d+*Л v׏-w$0c7B8&j;NB 1DDB7ԍ?M{`O?XB$*8e#>HX$!fĸYmd7 !{2B6\*I u2[;AR0B XypPXWCkIM:k#"<"紷mVvdθ/{5';kHWFwU9N<&vlrUG*,m_ĻoȤs%UX 4< ɞDŒWԲy}R[tuE ϮwTm\ 4*h0h^Ի*W$kKf=y e UV o3v[\ $| .yؙ ؕYڢyҊo875r(;3|'.:d&Wfh߰=@DŽ5:2yy@y@yh}=;!?sFP/IENDB`gnm/vignettes/screenshot1.png0000744000176200001440000014216413152512335016020 0ustar liggesusersPNG  IHDR3YGzTXtRaw profile type exifxU "%E^ψD(sW+w_ EG\xz^ĘEYƮ9yI%]5΀ӿ4C]OӚ +oSc߾.|H,LR?k iTXtXML:com.adobe.xmp EsBITO IDATxy\T0seA\P!EcLmb.I{nMoto6Is6i5& 5`1.ʦ 0s lQ~'0 YyHpXBۺ>ʃX#l[U^H^y8' jΏ'XZ,YYؐ5`Yת?Ħ\!lZ,ݫ06opki}̆Ο 8q&02dk"Bx`d22p!B#CXXhG@A!F$UU !l Y2 X0IB &c B\`c!BCCfsa80RYUUUiY aHnufRNg 1Ȋ'$$XKj\VW]]h@#<&QEeUNLafgڽQ)*s 0 !iwdprݔ糜Ȝͦ!"=~WVzSGOuz~2zIe$<_ EB"=A}^@&0s(z99OIz 7oJ(y?^+S2BA%O B ]adXWgF^HK8uz'+;N|n, 0O<sP},vެPvZ57m{; kg<וn0{?2!?s9M!z-߄hCEEG3 MWb5VpxL"cҪ^g)lY*1:)nC4~Ȳbbcq+&3h?+u(Q rF1LX Kg d>vUK|jبP-UMG%EOdMZk?ycMvݍ<ެ Aene<ɶzN @Rg`J\t9uDk܌15޻KQ䆗*tzmp·sC 11ѕ6TSݢO|WyzAKb'bN'Q^o4ᱞq1`u(nLѧ٦6e--m">^VT@UhtLeYYEQEUW>z11ъRUiO@??/+ r}Z2YB9` '?~&Rr)~2s\tP8_xn}gٴ(ToZGv -ʃE<0-iYR@ϵ+j-nto(s(ZfݛFٍT^~{?~lXuKOsZDܭnAGBꧡ)dž8*|d1UEN_on!L%0k/c'm6E8QLVT%F+&{h˯dN*bXWHp39[-u-nw^jҕRԁNO`y8Շ??wO@PU#a@ﯚ<禒vtjQOU¨j2~麞@7~'*!DU(z*gUG4:D }9x ?E-K_0f}.Ty_o2ΘO.\"FqPj ZݟʉRg&?*dN1P1 I֩S-۫VO嵬kʗ]f~iږ|g:zgL=qLv_̼k "OXʿޘ?k.#_=I38/l^k5|熬3%˜'?_>/_Z1.-15hOUF15=/+o7>Ѕ ;\?>wB8^#tlo?~ᄇNK4uӊלq}&BIX؃Cg?Tv'>I+:{83096O2fXMvyi@tTܘEQǟ;#Z?TGDn^*BBJ<U"w&)uI5QVq3-&~ٹDuf`jϫ hեl77w/5[һhJ>SUJbSb׾صVXEPiGxkFC3!fIÓ֋HC B!1![]{RF # =;FOP9ʉ\w#z]ȇ~5!!~ǿY Sf|ṉ?&[Gu8BcoĀ}O{xZ/HqeQࣞ{c3vcg5>ic%p0 LXG9 6sd{0F;&|F [4`I!;dy_Wu'>'0NmMĀO!4q_qELU g/}Z;.FwJFU;ZG?_|MfJ<6 'vnwmKɼn, >8NmeD0bt 2ɐ{O+@QRWApTeJJ A׻'0eJ:Ȕ O)Ոb=u0E&ٖdޒMUL-F4p l4UU%r La LK)I f%_w>G' Ⴇ;~W/})o a3q%So~dy?eloi@msw2>QLQ4J&u\rA)/4G?VDE&Wp֏~/ÔOzJ(rΟ.39e\4Ox!:sю˟n_́ku#>~rwgҟeן[~8#=`{6 dq>'+c{3KFgp;_+!S:S-I8 eB8ŎxA hvʲ~~/_eƘpԨBNr7TԻ}R]t[xQ-_<}EM{aU^k_lȹ6y0h?Ыѷ{/e zm}7>pR7?jSM1Gs>\i7RyV:~CE 0784IPufDz>O_5JO_*2 hykUDylN"^3p'ƾJҵ \qt}O`"{p2HO~@0Hw"Ӳv"EQJ&%%Z]stϮqTe/_@$ɲBU:^eTDF.IaDcP%%Q5!FTUU4^q>Wӕ(@LߪUvܡxA5=,ﻃ[yҙJ8N2۷c)}^xΤ!V#3L0ˆ&v$ζ\€;$ NY%NQ0n-}7Q%nGN5KqޞWui:BhU!sf?σ5Y~!Z xmu_$i_o4zVu_R&I11Qgf {<Q**(zt3_|Ds{hnޯ8s!"U[$iZhgyzo 9eE<՟MN+D1je5d2u:!cnۥxop{Ua4HKmٺ"cF!sf? |0 qB`;JUJEQE>{ΉY|yQ1*cgiY9 O4QnAaPe\W_!DyAs!=qNiYDŽ݌0c쇎g 6P3H^ AulS݂B`!-{!Bxm!~p,Bh`BaG!{Bݛ[Ӭ_\~gYY/nnRՖMNN{w~ eݚ Bw|iIVs<'M4ظ-y/s(P~U}{i.dE~!/B-{c*?5{m _0_XIY?b !^7ѥlﮋ/#-zl>왧lypʤISX ]4m䴬 _M4iڂc:`ҕ|eI&M^U*Om^Xvg?vun~-ܬ_W,[0z\~mu|y{zW6Ն'%O6{K^惗R!Zq~ k' E}7عs^YpSs_b;g }]y`Xw/_AWr~p-}k?8/\8ǓdKtc}wswg4ezJui?߶üw]O4`|!2ɷ >DK^y؟~x/|U!# &aЯl+m^g\Fl h^yп_?\,]?mH5`ofFkW,ve'_~~wX=D$ό{soM\_=- F,8 ϙΩkuQ9^˹.Lg/@xg:zd֭a֯_?`BFoo.Y2^ ?H o<ECmpQck-|~\ `Ll~zaes7Z3Z ^"j8է}.ۿ/j2G twxp' 4TTT 7>?:6?# !1j&ojGjC v@EX:ao? ]!,v)Kou+ﱴz@.4_/d[ɦ=xY<ՀKmݺ{pf?6nEdwSU??uUU[O|)١kQ9o~+?ژ˿ꥠz[*g#s/RKyхVus{,NiYsFO8&!'!9Mh}ϱl~#cʔ͍k~3Oy^zd~v!%G)~ws*~fIS\*j S({qe3?/w/NGɼL4u}`jrr?fqB;3|-B@v#4"E_^!0#BB!!Bw,wBw 翻n:-{Bw?0}>}OV\`߿tAݱϟÕ+W>}wB'gH~z! L+W7Bc!tc^x$+VĽ6BVw|ظG]gE&4aYENkhjt#5OZ@޿nz uJ-Y1#vO-y6 G݃:]^~`&zG]c[a8".cCY)RP=~<جjw513&x>AV>m)έ-'KR'ƍb7RTGXN-0 wcJgށҡrEǙu&MS}X O)QguF>nV͙XqmMpp\w\ؙh>f=6BBXbZ{l^{4Ec=ߩgJ^.3f:@`sO8juBٮm:S^ʶ@˦nxuݻscӚ 49eǔl?ܮ )2TΪTNSZ*2i#+ٻuҡP㟛&T7)xvϳY{а=gKü-.wU]NP']Y3|y[9:l/=x,q݌ǚ{Ԁ(>2ՑxTtkRoG;7rf}G. j{yf.;dVIl O.t7v5`S`ʟu( 2-o zv^'y^4xdɇDuD;,k=/G-W< S)Y6ڽ{7#nBW=#!)@}*L לo(g1|lXlh x IDATщm w}^mbcL7q3X:'@c߃֒kf tl؂IBgΣR|quJTLp>0lʂlfe:wOcXR]Ն^!-1*93佞@q{hﶢ~lE9*Jr ?g&z@3>ڂ!t*;)tv*,s<BwLO|TGqG#wO_쁄X {[F<Ba-{AFTOBhx>jx !m  Bhd{Al#B#eBJ`B={Bhd{{1f+Z7qAo[Z!Ż6U)p&~{ȴ8hs{{SΔj]fƃ [ v!`ߐĹwUUf]Քm9@%g0؅m+zk(icèTwܩ VKߗaS,(U 7B{;d<=UgCz&klXp@ij+ֽ6mӧ\_KnG!tcf/4ث.6rtErx?kT6>֪C5fm&r%g˽Ў!`zn {(<#9iUZ|s{ W=+~gphܮ%qYg'%JgdDn̆Bڱ}#!CgO7:{u_-! ɱ.]Oy/5 y >XZj^w-gr^?ߗEݣISCq2tcK#KTvG#gVOͩ0O cL֟ܗt!YbnU-JhHښ6?hLVA>G#-`Uqh;+B7[kˆ/6]W٠:J\.V,,>{YҪCNk -^{;FGxBsTT}Fd~GB5TwKj %L#F*;14ڎ>G#- }!nGw֞/9lhNQ@/ |F^^;Bw>7;!dl@^UdFG@u3*hr@PF\TsB&zͅՉyKj;:>6atmmzQuFXns4wOM4-lKqnh8\:'I&xBݳ-#3f-W<7%]&}ߎB N}lꆧ\Xٽ;769@;:;]'.\;59e"kMn >~ my_2j/=ܢޞT3%Z`]·Ox݂Ǒƒ/@!tO{'΍=O |5&zo9*9.NOm;_[{@IpTwܩ V񥿟 Z<5D!t4&+9Mu9t^d{MwxMg{\(mWafzO~~߬(5B{Ԡ.6r m;JG[$lW6>ժpsԜi%H%5Bvغu+tW{([<ǵ -OYUOWg&wKΐ=Aǚo&icgʹoQpr8!tUTT_= V?1F\z[xޚbdKX\[a :J疶wGOH vus@\ ^K>Gkvue=ks*=eڒ3r m X4vΚ "S){0#`?V{saT[QTwsq_)`i2o˫yݵpyLNn֋1\B`zÒ<]QyBҖ0M^>J Zr_CB`O]W1@!nmwB!!BB!tG1#B#a!wB!4GĘϮh i8䇟X=?/P#n'Na0-Bo}`qӂnlFJӾ5 3B#n֭[`O9pjb)~1oU =9)0D=rIh+EJ^ˑg֙4M;o:ު+汖&FegsJi{ kkOSdSMˇ|4R[9&5ZN=¨=]j!i!6l)q5vUveS7<ݹiqubµc\CSV,Tg[Ж%!Ӫܣ)-{N8Su1usa)#:QF!tOSU:h71N{n+@V]Uk&MBR-t 0:=p~Po%mù..w2"vU4qvBr#B螗A[7VxzMYE˾Oe{MwxxSZgqU]ɂu(QhM [~2oeK7>mW!o UFF6-YͪƧZ5;qᚖU=oVsBݫ4͠]QP7uyF!oNUbd8CBFgBLQ! ̟`c(ͥ+u4ykœ-aqQlY*(ٟ[X1^NkzG wo.oj+\4`xn.KJ Zr_{BhPnCPOåЄD ]\] @BR}z^U^}0yFjxjeRPW]e7| Fp7VVV^&YjP -‚.;m>`O]$!lq G nWBDh8mhTdcMCy BhT'Zuꌣ-:ilS4 4:&捍jmJXH6'6N_%r7;w|B@cNdwsues;"0UUWͅs`LB;1!E`cr&yN-O]*#P֮y[\8<6*B.hZvy)ZˋhIo5u0ER9'bH\%J~@wµ]khS*v̌%!<5U\!V=@P,F@wɯ`!h/|E]4RIe3YbA5L1WTWׇŌ qFp֥hIu SL`Bw~xGO3Vc:քD )~ФЮ.]"㧅_דзtWaBQ}ַŘϮh ]i=&3xhoa!=`O}MU5f?~w[  B;~jρ!-B! >fzV0v&[g,_)z-GJ[4{Yg4wB׻zlӛZ W)*ǫ&>wOM4-lKqnh8\: f=a8tR!k3Y~Ζ+ ^oG]Pm>\6uS{ޝl7;]'.\g'gNYZkSnmB[+Lڋs[f?P=vatzjJ7Jچs];\TenE^H= @gviQ"kByz7VxzWu]T4x77uWJU_;,XwAW}Nf3b֭'w.6r m;JG[$~ƒUOj.\w6C5-d+EB֫X~=tuSgy.T>kJ̤!!#{ݜ' V>M`s_?:!g 1@Onhg#Di.=^#p'[ TQ?5c<>2x@VHܞUOd_/=Z;`ia\I f?'Y-?>[:!Цx._̠RBsIP#7>{V{saT[QTwsq_)`i2o˫yݵpyLNK{yx|B!v[,S٥^#BDϱl41{Y(pj}B`O]W1@!nmwB!4IB!l#B=B!0#B!.@ȑ#͟?bgWn|㄃ִfe=h˵G>(S 4L< XNTU;ojZMtƺQbxB `O9pӊ1sGUڎ/A!~8}Ia1 쑣Mme:cԸHk9Rڢ:`Ǿ][ue[f?P=vatzjJ7JچN5p]P]ZZޜ>';ٸuOY؂)!!B! MVӳ7\u9t^d{Mwx g{\(mWafL|(ܢT|BM!~.6rtErx?picMиp 9D=.xLU!3 xsҼ  |XTy~f tfVWK*"fO%֔˗pB{䆏vXL1B:̼5}ɖ(~,@u-m ,O/5?(1>R<瀸p| G>XZbpvRYɫpiKOl))}[ɾ< R#65B! k7Hl.0a`u'M|Y\c{CBHqBo k 7+zE Ʉǒ8]B! j?L41a>>v@CB8}Ia1 쑣MR kxS"CHif3LηSzwVoՕmzXukmdZvVJ8v=E6eд|xG-ŹcREsOXMk+D#B}Ȍ,?gMsWI߷ЮSl.=~v΍~Nk6ЎcœbxצJ7N?{ڄW/qVMynoowWˌxoH̉c]exBݻOƞ{'UWUstWSncFίtS=~ RMx.s[-b[gJ'<B|cHxYЅ{%5 ^6bySZgqU]^QoRb_aF!~F#\(m^U6>֪ אq؉eBl<+ .ψ7VI'\,}bS%I&3$ddO1vsM;I\fxBӆ'7|3ƂOdr4x14X<oE%ҵGj}@z"W~ڹ]KK NJ5 9y2mҙ 9 hZQxBa^+ܽE(gsр o*޻/}u}SռZ8~&ރxBKTv#Be+/4L֟ܗImB쩫 <!Эm].@!0#B=B!0#B=B!0#BhnwbgWn|㄃޶yœ%1F}؁55!^ IDAT[jyMK[_:@3e)]%Bݛn}7j?@޾Qc…5pfUCB[] cgeN #Qmg-mXgzũqҡrEǙu&MS})tN6ypiY)ᜢR^~j{ٔAi+ͶVIxϥ?X_;\8=x!/P#`/12cm&rCxSk(˦nxuݻscӚ %:1vڱ}!)+YwmtS׭Mh{iU{qє=| )yպ̘:":m?ќbuyc%!=kn|b87W:5&zo9*9.NOm;_[{@IpTwܩ VؽMGoQ5B! MV@vYЅ{%5 5ySZgqU]^Q#):y=Qpɩ8!}=B! P]6mzEh~֑Z5=q᚛ !"!3 xsҼ  |XTy~f tXWeU#5D B{䆏vXL1B:'[ TQ?5c<>2x@VHܞUOd_/=Z;`ia\I f?'Y-?>[:!Цjtw_xb6!0z\oVh7\>y >XZj^\WvexxB;fn|<]~T!Be+/4L֟ܗP B#)SWšx B[ۺ]BaG!{BaG!{BaG!0 ;>teU-c>u'w[SpaEx_VO@BwV^m;Zy_ '^9N;*TUMwoie廷n޴-ZW̉C!t:-?Ԟ.:tBա*P>:=B`n|1|ʼ#UjSfRᱞ}Ӝy&O>G=#N3/N^]ꭺMok1.lKqnh8\:)YY4 h4y؁5 1ӳ2'ƀG6I,Z)-%=w\8/B}3%/[_Pٻӯ}os$ ( (-h"b);Nyx>Ͻũ9ǩ}wVM MAA $1$4/K (+`%s53s!, #,M,VF/k4Q!RX,`Wkl~|w绯!ď_yZΆ??~Yyx#DkI8CNr!!rĄ1a=5ݽJgD>ľxf>6sX'ā{Se|jpr=K!''B.rc2y̞4TP77ӭTısYHA͏-'!N(-Z Q\cN[FM|bgl> DS}txžL;óyOJd\gʨiko+I]&…c#]ӭ gp0ӧtP,w%>iכw\iZqogeHzkh|j@}I@d gyӾ7oWroٙULA<3?P'd󾥦mvQ?9se' .n$"p{\$,-^ ,Ҵ|pOǶm%t8R' ֹe)+xV~n(5US')S(yW'(HkPD`q(PjuYMlt_Ypܭlk;M;EN[4U=o'.9]i~jGVšmpiώU6twTCG2tero\lMUg,axw}CZVA0()?uу1x {{w~zs sZSy^Rpo%1 7mMginkWռ{潣OVܙmCw}pXl|= a{ƛ<w =wZڑT61R.%Uaò8nިk{b q[aO{j/9|Whveʀ9oؠZU^r91[gFG$.q] qE6ޯ R/αx ';II\־d)v9ݷa1هU}/qQYY"fƝ{iԅR?1<"=~2F! xoT%$Iw lI !!lkζԉMq ?.r1U-{*eB 4YcYцG-cvIoKnu`(i*)qTfQVygfob2R}\Be{ZccB;}=dG!~O?pV^|`z#DkIiכwfD=!gM¾)33$I{kG25@$ |cㄳgiߛ+h68-;S<)Vgg sހ7fsc\?YTpڌLIEp<83ۖNiF e>c[VaAR K0AwIScWM7nhhhfY&+9z/M2E&j$e%juib 1.Ptt..84-cszvwi봓f]*筞1$0Y"dz+O٪8-uV5 p]Qr`@ކO0.}~HCrB.)Le1ﮯ|hB !sXGOJHf ުl_=BhxxYP|h eV;?I=j`YG͹9kݦ=}4˲iӦ삂#Gq8a`C6f֛mt}:ەW>65$U?"=ajz׺eٳ}}&ԩSvq\m۶@ `C6uy\iz"7tnq ~D"D?Yx<&l`~gOJ%K9 I 퍪spqTVaVinq^hu!DO fLB6=~1;V3OWjbԸ$κ-!$9zQ 6);,OTU.BdEv?eF5t9% !ٜ~D1p䭱cǎP?_|?t$ID6qQ"⚙BGeewf&+#՗5()I,P56w'߯!;B#xZNO?pV^|XdsdؾWݝu- E|F(43Lèߝ66Vzθ_lfȹr"%lka!g(^nP+%|s4Bu NJJJA;w>}T&q8h60)MjN[UO)sRHRM=&OSenPi)3}IkO Ȯ?lwhYhw>f?(.>>9@7`˜[^D[j1 |95aXvvvZZZpp?177ѣGw˞9e|jpr=KW >9! rwϟ cɤb셺αB5wO40sp?d" E+R ! klÚR,R+Dl8ýaeal~ؕFUF޽{1 s+aؖ-[:400ﰧ-@nlޓYWi:r5qB:wD0Vy,ck:jUOr jLAܕdj`!B\of?a^Jcݩ_=u0ݲe B8fBk5ޥ=>+S`2U{e˜}lPku*WC+ w5Wi8\ {R/Yʡ]x/-e$qX `FUߋi\U-lvlF])#'hMk_'૿F51or8BthglKPr8.pObsi))2v7@vʤ5'D d֟nxR6]|RO0~P\'}|8;vsh%1a=5ݽjc2"Kbl!Y$xW0 G m@=缿O NgPQR<$䄀@Enl?7X&ٓ&{: ՜2/=Gj~l18YqBiъHi˨/O"zm><*Wװ-@nlޓYWi:r5qB:wD0Vy,ckU݌_P|N;]OF"ff.C鷹?y g6-E?%' ?cM޼]AKStؖUmоzD,/2|:9X޿fWYeIhDWMLQ]n#UlByb!\Cne5's|1fq1rel-6ݎR9mvҬkW3&D@#+;Xxva>[rEùΪ+?;JW(НWX bܥR8zWSaQ.Bȥq5%WY,Q 4BhZ!d{\W}#s  {{w~zs sZSy^Rpo%1 7mMginkWռ{潣OVܙmC[ !ǾV81!@+0暂68{`#㿶Bв=6D N|ŧµZ*K#?8TV~Ҍ0VݛLN{j/9|Whveʀ9oؠZU^rBܐ҂ޚx` 8|"3\D~?I$.k_C_ne$qX `FUߋypqTVaVinq^hu!DO fLB6=~1;g9 ` I9u[CHs[;-ubSBÏp\DUK랊oY".MVdnXaQsKh74%\jN=.=P$TU\3S̢0RbeҹF IDAT"%|+xwzȎB1i~P?଼xtsdؾWݝu- E|F(43Lèߝ66Vzq2]͐s"DJK2֪6!B$PNzH/V0Hp0J zAlNInnRݍuүj}JHRM=&OSenPi)IkO Ȯ?lwhYhw>e?(.>>9@V`˜[^D[j1Պ;w.>SQ= 7CX=!sz %~%eCON]g}e=i2{nnsPٹF10sp?d" E+R ! kl{i˨/O"BC@نnN:cӖ bg wx6I,4܍ZVVƸb!kwn"\<15+D / 3}NrWiqazIq؞O8f4в 5@$ |cfo7{v+)[ED+3 ~B9omBg1,*LcfJ,r䙥1>KStؖUmоQ5&o&B[ z۲G̔<+l7P誩)JcMV(Ol"0ĸ\krC5ͺ&6d/F,N8FV5ڦQߝ"NuMzēH|derڮ4?#gPζHt8Y4`wgGvZz ?X]#Gjj: 2E7.*3q0jF-V+4?z;-qɡtj 4`eTTTFvLBW|嗩xgeggVTT$''{5 477:u 3,NgXG?l7/ = a{@xܯĦ鱼{ԚԎ -gim! c|r_)~xc;0elWj x;>6Vvק\mu= 8 8|" gx~cK=蘷%QR6 @@ؓ}Rr8ǻo?i)7 .#')b87^%.*̊Q6;M6 M.i4BѦu/fxoT$κ-!$9zٖ:)Np8\.fyuOŷrB&+2a,0𨹥{.Vab4UB8*(+37XtD!HIb=_!x ޝ#?bigbyp8+/.5c4 2l_I+κ"n}{B#\[\zaT/hLW3\nL찍A3S^h7K*GXpXu^Þ9%ynӖ~U<6ϓiZlӔwTҔ'q!(3&Ct7cRO%h&V1~PP\N'YвdԜv :V+=ⵚ C-ʽ=!ݛ.SY*g}0/ >9! rwϟ cɤb셺n2e~d_8{bpҢ)5_ӖQ_*ؙEj5GE]e{R" ?SFN\}M|c\Nt]7.UnUr jLAܕdj`!B\of?a~a1~¡hCuE?%' ?cM޼]Ak06]8e_~ejj*l#Y١_yAF_}ի/hnn>ulgY:bx~ׯgag! = a{)w =wZڑT6eW\BQ-|Um jKןWhvXx^ce6B'W}O?7" UE㆔eKrh9=} a1هU}/xQYY"fƝ{iԅR?1<"=~2F! xoT%$Iw lI !!lk:f_)Np8\.fy0_V! B0Emx=`T+#˾d6ݚ,3 UvEdkf !BYFޙYXT_:hB$@Y<~w_B43Q!D(И4i֮֟Xڦ}ڝC$*ۛ3$7rr.HLSs~3JgD>ľxpQl^-4?n_~ ӐV>OI,J3J>ȍ1{dR1BpOXʳs12/=Gj~l18YqBiъH皗ӖQ_*ؙEjM;v1/[hems0J8ms=m vr{gzϔQ/j_W,d.]M c2FVsXaOXJ|2m50!73s0L/e Fp1Kv !a`5|u4>5@$ |cㄳgiߛ+4[vly>S, . Yo. 'g dQa͔$Xn䙥1>KStؖUmоKzP,"߳ g`}3z/M2E&j$e%juib 1.Ptt..84-cszvwi봓f]*筞1$0Y"dz+O٪8-uV5 p]Qr`@ކO0.}~HCrB.)Le1ﮯ|hB !D]ipO|X!֫fzM"vLBW}嗩xgeggVTT$''{5VTT|WԩSxgt:?Qg< {@= #@ؿ -g{WHQ+˨󪯯WĦ}ipJ\]r1EkfFw.? 0=H).ݿ M5_LVתR;+ZrS{s2'خu^pWgE)ӷW~b9Iӆu$}ƎB G^;wkYjik߅ٍW62Q]5qWQfh^bJd]]Dg槤 ('!''Bc2y̞4TP779VyzK 1faSjz U?Vn~Amu:(;w~6ܟGf2)\xc6~Gfj`!B\of a^{ɵzV |X_ZyZz&ټ'%s=b˵7 Y뤮KuX屌V_>ZO73YbefJ,r߬䙥1>lyCqv6r'2='ϲ +"WOvJ6_.=-mYK[Ddg}K4iިV~ 37&;?n&{yӾ7oWofr[vlbheyf8vO:mBə+?YTpw{)w>. h#LVBc?7^?{ߝg4p4GV&wJS;B;8Kߥ:q@!S]O+.O'(ni`uű~vo\lMUg,axw}C=SԢ;g{4kb>[rEùΪ+?;JW{Zǡm~NtfJ} _d(vMtI%J 1Z&+'6b\.59ԡf]V]p2i'#w+[ LshnG)wN;i5ѫ3^Eۗ}/e/ wNNOpQtnaZ „LS vLBW|嗩kWA1%ql*?.rkk渲C*2@rayMciZQQh4[ZQQW_SN1;KY,я:?ޑ'scoJg{,|jpaAUIG$Ӡ<{u[DzqQL΁0ݽjzMҦκ\c[oןf@دƪv^mwV۷ca=  =}oaOw@QCuSU__M'>DZ^*!cÑ$+++?'lIg_ťc#!)aؠZZIykh˩*"hsO%a|`2U{e^ƺHNϛka.Qt@RŠAEEY5L~]k4I_>#.ѽix~w!{v'V)˩8|^"AO9 ^kt!Dzn}D>l5=rVS,xoTdbSBÏp\DUKk;I9 N 3wk0$7t㥩޹)Ѷ./fɊ~"6)ڗ,.sz|e$qX `FUߋm EN3v;}BӨkvCEL {YzK uӢH >ESoV3êk#8K~J?yӰI>XJ&'pϑ|[ N!BPZ4w6IQ0e1:y | Kas kl@[FM|b˨OorKks% î^"ā{Se|jpzB_xFI!wGY``#?0M11@p0ӫtP,wl ?dgS;Гm@!&gOHC%@0skRA#ZM;óyOJd\zĨiko+I]&…c#]QydyG+ Q ܲP=WVYYM̸PY}Ϻ+c7S`~HYZ6?ggns/}"s,P-yd4m2ݖUmо܍Z%ADV~GDVj@Ώɞ6v޴ěٸ)[g ZYΟ]%y IDAT(y1GPrO&\r] "A/t8R' ,r}~|+v?!1/ޟ3fD@#+;Xxv!НWX bܥR8zWSac驮'a74\0:{XyE7.*3q0j򡁞uj~3_΋{1C9"\gUӀ ߕ% v=x^HP׶Y':3z/M2E&j$e%juib 1.Ptt..84-9M;EN[4Ue"{}'yI]FI' ͮkQpa+$$~u_~vSW^(-^;\Z9Jo7 0{ayMcgggVTT$''{5VTT|WԩSptwxY+ ߩZ1\gPUw@ү& 4<:cٸ(&@fBN^m5&iSgݍwVo1op7a3 c\;y׶ȻY+۱ F6$=Ťn62ab"=o_'C ~^ջn ӏ(V:˩󪯯WĦ}ipJ\]r1E}CщO>oKb.l۱ ДY@0}lPkuV- wVyw0e>N]몽2X]r]cR$͵0|fdA~@=ڕ. ZIy!pAvKS׾ ٳ?=O]NWw}uX*цݯ~\ 0s1ǹ PMLܮՔl=˭g~2 /Pr8.^d9r^̐q$*M45^ĭ7}6>#Aq{C}pr9fCBN&_b]Oo?+X(脁G&9?%m.?{k=רfBb]B\^=iYhw^ IlNIn6ZyHRMg{LrTҔ'q!(3&ڕZ^r,a/iC+W ٕgڽi$ٗ4bHA͏-'!N(-k<$q 2>Y 0ع5u-&T?e߬YZ;W"0+*$ā{Se|jpzB_xFI!wGY`u3t:by(?6_t֪nwVo T{I¨; j+Wu,HAiݫ mꬻ 1 F={9lak5y7k};6a{@X'C ~^ջn ӏ(V:˩󪯯WĦ}ipJ\]r1E"sO3`CXťc#!)wqQ\.&( JTf.EEXbSLn/&jɽܘjLL)&ڢ EF^n H٥D_/g9g8ϜJ ϩ}li@i QK=z1ocd{( E၊cd|O긊!3";cTVYu9B+w1Ųbo9^8@yLv%tX4>ժ~ٖ6u `vP!l=y*Bh};ٞG''f?wg^7*st tU 핹R-SvA.lߗX]ݞ;La+>P$63ךwSCó=Y$L]BC}qzu\sBÂ#쩦?wg&?s[MIwW{w~ZAZ#3fIs1vlpYBJ!%^7)ӄI.VR!\"'KT) ';j tzBIgmqd_^,S{1H7ݕ6[MYd%d5ΖJYΩӷjuΪs3n{ wə*udbj$%95Dl8= qKQda~7!eeNh쒊jiΉ9=vw~wt;lFR):sHI}Ot)`{O@;r 1z䏳r9bFӇ)SPѬVVWu4eXCQ5T ,GK9E=aRi>:"R^9J(-7w_t&0)ck]*UUƌ6 qj=Sv^:!hNcr zU. 6.OKAWR|=csyBqG+A2_}T]7\pObT U8aH,Ǣ  {UW&<Is{:)c?vFC.zu'u帼! my&מ[Hm,/s.:x7̈`U_ªe8"Y0*iZ*"m$*=vGН2?SqLwgv'*ޓ>*J0yQs>;E?^e5@ LyQ<>B8BMH{E"5 ERw[fS{ tTO|q S~-ynuj\`v%ɿxL J#C=iO#4d5U@\.ϧj&Sױt w6(օd_>";cTVC-GdL,gΦ4N8fӃ]l,e ?M~@/9hf2_vM7ept.ЋyNS-B&_lWw8\J|2Gu1;w^ʨ| M51=`{竽u[3KfkA,0W'+K J,e !DU++&Sp,BJ=3E ,&Lr娔 7:9!p-<]NWRO^8q)TS3H(={o#f YFzq讴jĽ's$,!D%LetTrNUèUvV t;syKdU#Ss')!!bs-yHOɨl[$I !(+s,F;gTTVKsN鱫ma+0JACJ\M7;Wh,sx"}ؙ\sB l%6p!oT4CUr aP!mbq}205K!REENkYuTZȪT=m`<3h(4Ek(::` ʰg3Cx3?LRIiv>3u!siu?9'`>k;TY9:'rF#|}RMa!SW*TB@Gcmh#{"tB  uxƄ>3cS/շ25ێXq{9zèUm]Woki=3F['^#j !P'cR~w4pֺd,=8{&WJ[4}Kq9kI'xϛsHJj2N\i [#OqMFw4(͊ښT7ظ<).^iKY kcXm Io0s^>X%2is"U{ҔŗOӳo>@Ƿ@IM=`'J雥^=d(R=M?!'@_zMKJ ~~~#{`W_ ^@D;L<"## =6z.cIDATFUaa!*-??o:ko.EM C0~X6Q$9zΦ_\^\jCe]*OxJxrNʹ Re͙&^{:F}(i Vz|sFBa;gH4~7XB$tFU\`scriq+PWӘɑ%yAD"ј/gjֵ܃M4NKyvNb-  ]}÷&>քO?Kb#ϝ˿qCBdo>󑝀IÐUF ZVr '?-`U#^Z{ۣ?M6.>ᅷ-hQFV(v;w {L90s(#Om^e .~+#Hnyi)k eL)!k2u,;EniN]^͜JŜ+}}B˭Ƥṽ^ c;er%@C>Ã^bw,X֞%QVڙvF*!64x-pW‰%QV?LX{Z`+/'0R%W"騯c9nыܴB9ZVg7eCxBSf9Fn~Ηl{gc"sjI.o7rmGS޿\q;NzU__#rtaŊGа@﫚<;g|Kgr !#Gu^ݗq|o~A\1CHCZ^Ls;V* E ?֮?UBA Rn\uz׿IIH>˿">gp *BK{ q5쪖% x?IH<8UW`g/++jymuq) ?Է_gy 6Sg8A-m66|q0t%vzP*F?wl\Ϡ- G% U$$򎎫yWĤy*^euADst5lԼsN'#22rÆ [yiKSۼ匭,9񉧖4[]mw8ҲϦTy[&#D"/ϫbD?ʟ;Gϥ,x}o%^4}!eWy*^j%!|s'}X,n5oij[F{M jZ_i!߉7oӸS~5yC֫{UHϥ-|"G_;xN3x)}w}~Ӝs|xyRÌ~;C[~ )n{{@{7eEZ{kdCg|#H%q+q==#ѷM.:_Bu Cϫ9W|d$E3 k/;mCZ߮qW;mif{[dg?>|,~К!lGOe}\qP̵ }͠z#]nK,=3lE"Bjdն\:F4ݖGfڳJ !<ClNbNroƮ!! uO7e{*]O668k<%!Z3jYq` ҆uk ڵH)[X pLtKFxNDkd3f}wruFg4dղ]Wuhf$SVfYi !-Sv[uyjnj3vޏ9?bnKe%!#-!yږ%9̥b%!#%U?lݹ-[+aoNus;7֟B=iWb?}mx·<7| u{MwZ,rRZدX8xCn0"Ui0%޾Yt[˔'n\L X*2 m'7s}zD纅kS72q lB#oofI4u}u]i~Kp.9<>MU'NH ilX!-:JffJ? XT%K$߾ڃi7oݴA"DKk9}pzfڟk,1|@!һ )2ySMߨa !ʂCkF G@5Mej4w}YAGOe}&]b &yj1.NsӦOh!B5뵙7eK%7=ÄɄ&*|}g- ^jLZ-^LH5[FY0*BJi.=NM<1DGP!~]}㌸\Aqj:T*=--v):ԛOB% 1Bm`+˭D)0U5C3]!3z+wtT4Z>BGaJaD@Շ"27inw͖KdH2>R !\cR2l?x Q-Fz44B}֦:[kT!2X꒕- ^k:'n>jB(6jՄ24SF% FЄ);+"tet-$*V͇ :. ;wg%*HI@+!PޫpHMnUH5yY%[7w7={51rY5͔5+G_ 1IoV-i.kRյB#o2JGt/N1}Zʭ?(=!|նj/բc\=nozMv~,{i^6i޻^ &Xi(%6^HDrv^,HڮKn%3U{~3CdFIzӥ]ޥcR'DEE5-ٰa!>X ГGG,`O"}?Z$ ~G[yRNi\*RyA7| _19xEGwo|2o3[b"5mGSD׎n 3B꯼|MeZ+9U F}:&뿽z|jHC4FZ%dFk]*m Qv`z  1VgOOlxFnkɬRKۧnKB /ʝ:oް ;t\K\snc E ьҵ%wL~Qzዥ+Bղ\S yeb1BA/z}m3ʬ&xoɖTe$V{uѠ$i%vf Z4R}!lU$-h̜u*h;hk+.T-+FLSF6_/ε OEjlK?W7rbM% #[XZs܂zQհj-5R`DFFnذA]z@OKZza9HTKllp-c-G_H2v;ל9pn}Q!DVeKH;5P|E{CHTA/^hHO1@8K=tk2dBJ]:M̹~lŽ2yT\c ZVʭ9|6V`>r5·aCph7LQ~)CE~?>:Lյ+N 1bbj5J%z]7'x SsGI=iYVނ2νz췙n%t%:I{e>fht*}3c־3ňB} ,~`әj#{@^Гyizڛ+CxDr5ʧY*=9 !Dyu+|{XW1 7&|9C$yw{|񼏳H5#Ot/|JE!LQ§K|\DNc&GnJr'n\:ץKuo81lm܌l]Cr;%ն.JC 5%%Цo>nN/zЙ6%)yRB(ZSu3R1uu1r)mg4&0&60 !yF y*%D6On&#  Mif5ekzEX4$w۳ocEW/{gӛYKc[ n5/}hAvv8Y#Wj,ܐϥ)/՘Vö-K sk}qt#t^ug=E'ږS«jn6tPjBWN XNx+۶* C[~ )n{{xjQB#{(Eq !7ҒQtdPWWWWWW__/J$9&@i;Ɂ?+{[t+Kdpe)`J/os \l/|Py\o ˲JRTdw>"#\-4!+KفRBɤFNMY Z|a+U6B;E5Kq("?pCa7KIENDB`gnm/vignettes/gnm.bib0000744000176200001440000001612113152512335014304 0ustar liggesusers%% This BibTeX bibliography file was created using BibDesk. %% http://www.cs.ucsd.edu/~mmccrack/bibdesk.html %% Created for David at 2005-07-14 15:46:53 +0100 @book{Agre02, author={A Agresti}, title={Categorical Data Analysis}, publisher={New York: Wiley}, year={2002}, edition={2nd} } @article{Alho00, author={Alho, J. M.}, title={Discussion of {Lee} (2000)}, journal={North American Actuarial Journal}, volume={4}, year={2000}, pages={91--93} } @article{Ande84, author={J. A. Anderson}, title={Regression and Ordered Categorical Variables}, journal={J. R. Statist. Soc. B}, volume={46}, year={1984}, pages={1-30}, number={1} } @article{BrouDenuVerm02, author={Brouhns, N. and Denuit, M. and Vermunt, J. K.}, title={A Poisson log-bilinear regression approach to the construction of projected lifetables}, journal={Insurance Mathematics and Economics}, volume= 31, year= 2002, pages={373-393} } @article{CatcMorg97, author={Catchpole, E.A. and Morgan, B.J.T.}, title={Detecting parameter redundancy}, journal={Biometrika}, volume={84}, year={1997}, pages={187--196} } @article{Caut98, author={B Cautres and A F Heath and D Firth}, title={Class, religion and vote in {B}ritain and {F}rance}, journal={La Lettre de la Maison Fran{\c{c}}aise}, volume={8}, year={1998} } @article{Clif93, author={P Clifford and A F Heath}, title={The Political Consequences of Social Mobility}, journal={J. Roy. Stat. Soc. A}, volume={156}, year={1993}, pages={51-61}, number={1} } @article{deLe06, author={J de Leeuw}, title={Principal component analysis of binary data by iterated singular value decomposition}, journal={Comp. Stat. Data Anal.}, volume={50}, year={2006}, pages={21-39}, number={1} } @article{Erik82, author={Erikson, R and Goldthorpe, J H and Portocarero, L}, title={Social fluidity in Industrial nations: {E}ngland, {F}rance and {S}weden}, journal={British Journal of Sociology}, volume={33}, year={1982}, pages={1--34} } @book{Erik92, author={R Erikson and J H Goldthorpe}, title={The Constant Flux}, publisher={Oxford: Clarendon Press}, year={1992} } @article{Firt03, author={D. Firth}, title={Overcoming the reference category problem in the presentation of statistical models}, journal={Sociological Methodology}, volume={33}, year={2003}, pages={1--18} } @inproceedings{Firt98, author={Firth, David}, title={LLAMA: An object-oriented system for log multiplicative models}, booktitle={COMPSTAT 1998, Proceedings in Computational Statistics}, year={1998}, publisher={Heidelberg: Physica-Verlag}, editor={Payne, Roger and Green, Peter}, pages={305--310} } @article{FirtMene04, author={D. Firth and R. X. {de Menezes}}, title={Quasi-variances}, journal={Biometrika}, volume={91}, year={2004}, pages={65--80} } @Book{Franc93, ALTauthor = {}, editor = {Francis, B J and Green, M and Payne, C D}, title = {The GLIM System, Release 4 Manual}, publisher = {Oxford: Clarendon Press}, year = {1993}, OPTkey = {}, OPTvolume = {}, OPTnumber = {}, OPTseries = {}, OPTaddress = {}, OPTedition = {}, OPTmonth = {}, OPTnote = {}, OPTannote = {} } @article{Gabr98, author={K. R. Gabriel}, title={Generalised bilinear regression}, journal={Biometrika}, volume={85}, year={1998}, pages={689-700} } @article{Good79, author={L A Goodman}, title={Simple models for the analysis of association in cross-classifications having ordered categories}, journal={J. Amer. Statist. Assoc.}, volume={74}, year={1979}, pages={537-552} } @article{Good85, author={L A Goodman}, title={The analysis of cross-classified data having ordered and/or unordered categories: Association models, correlation models, and asymmetry models for contingency tables with or without missing entries.}, journal={Ann Statist}, volume={13}, year={1985}, pages={10-69} } @techreport{Hatz04, author={Hatzinger, R and Francis, B J}, title={Fitting Paired Comparison Models in {R}}, institution={Department of Statistics and Mathematics, Wirtschaftsuniversit{\"a}t Wien}, year={2004}, number={3} } @article{LeeCart92, author={Lee, R. D. and Carter, L.}, title={Modelling and forecasting the time series of {US} mortality}, journal={Journal of the American Statistical Association}, volume={87}, year={1992}, pages={659-671} } @book{McCu89, author={McCullagh, P. and Nelder, J. A.}, title={Generalized Linear Models ({S}econd Edition)}, publisher={Chapman \& Hall Ltd}, year={1989}, pages={500} } @article{RensHabe03, author={Renshaw, A. and Haberman, S.}, title={Lee-Carter mortality forecasting: a parallel generalized linear modelling approach for {England} and {Wales} mortality projections}, journal={Applied Statistics}, volume={52}, year={2003}, pages={119--137} } @book{Sebe89, author={Seber, G. A. F. and Wild, C. J.}, title={Nonlinear Regression}, publisher={Wiley}, year={1989} } @article{Sobe81, author={M. E. Sobel}, title={Diagonal mobility models: A substantively motivated class of designs for the analysis of mobility effects}, journal={Amer. Soc. Rev.}, volume={46}, year={1981}, pages={893-906} } @article{Sobe85, author={M. E. Sobel}, title={Social mobility and fertility revisited: Some new models for the analysis of the mobility effects hypothesis}, journal={Amer. Soc. Rev.}, volume={50}, year={1985}, pages={699-712} } @article{Vand02, author={F. W. P. {van der Slik} and N. D. {de Graaf} and J. R. M. Gerris}, title={Conformity to Parental Rules: Asymmetric Influences of Father's and Mother's Levels of Education}, journal={Europ. Soc. Rev.}, volume={18}, year={2002}, pages={489-502}, month={4} } @article{vanE, author={F A {van Eeuwijk}}, title={Multiplicative interaction in generalized linear models}, journal={Biometrics}, volume={51}, year={1995}, pages={1017-1032} } @article{Varg01, author={M Vargas and J Crossa and F {van Eeuwijk} and K D Sayre and M P Reynolds}, title={Interpreting treatment by environment interaction in agronomy trials}, journal={Agronomy Journal}, volume={93}, year={2001}, pages={949-960} } @article{Wedd74, author={Wedderburn, R. W. M.}, title={Quasi-likelihood Functions, Generalized Linear Models, and the {G}auss-{N}ewton Method}, journal={Biometrika}, volume={61}, year={1974}, pages={439--447}, keywords={Estimation; Exponential family; Maximum likelihood} } @techreport{Wilm93, author={Wilmoth, J. R.}, title={Computational methods for fitting and extrapolating the {Lee-Carter} model of mortality change}, institution={Department of Demography, University of California, Berkeley}, year={1993} } @article{Xie92, author={Y Xie}, title={The log-multiplicative layer effect model for comparing mobility tables}, journal={American Sociological Review}, volume={57}, year={1992}, pages={380-395} } @book{Yais04, author={Yaish, Meir}, title={Class Mobility Trends in Israeli Society, 1974-1991}, publisher={Edwin Mellen Press}, year={2004}, address={Lewiston} } @phdthesis{Yais98, author={M Yaish}, title={Opportunities, Little Change. Class Mobility in {I}sraeli Society, 1974--1991}, school={Nuffield College, University of Oxford}, year={1998} } gnm/vignettes/fig-Effect_plots.pdf0000744000176200001440000001241513152512335016722 0ustar liggesusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20100416145338) /ModDate (D:20100416145338) /Title (R Graphics Output) /Producer (R 2.10.1) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 5 0 obj << /Type /Page /Parent 3 0 R /Contents 6 0 R /Resources 4 0 R >> endobj 6 0 obj << /Length 7 0 R >> stream q Q q 28.34 31.10 180.06 156.56 re W n BT 0.000 0.000 0.000 rg /F2 1 Tf 7.00 0.00 -0.00 7.00 44.97 51.31 Tm (A) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 67.68 72.28 Tm (B) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 93.33 85.85 Tm (C) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 94.07 69.87 Tm (D) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 99.71 83.19 Tm (E) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 106.20 78.95 Tm (F) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 113.86 73.01 Tm (G) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 133.51 60.60 Tm (H) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 159.70 56.30 Tm (I) Tj ET Q q 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 51.68 31.10 m 185.06 31.10 l S 51.68 31.10 m 51.68 27.65 l S 85.02 31.10 m 85.02 27.65 l S 118.37 31.10 m 118.37 27.65 l S 151.71 31.10 m 151.71 27.65 l S 185.06 31.10 m 185.06 27.65 l S BT 0.000 0.000 0.000 rg /F2 1 Tf 7.00 0.00 -0.00 7.00 47.69 18.66 Tm (-4) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 81.03 18.66 Tm (-2) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 116.42 18.66 Tm (0) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 149.77 18.66 Tm (2) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 183.11 18.66 Tm (4) Tj ET 28.34 51.40 m 28.34 167.37 l S 28.34 51.40 m 24.88 51.40 l S 28.34 80.39 m 24.88 80.39 l S 28.34 109.38 m 24.88 109.38 l S 28.34 138.37 m 24.88 138.37 l S 28.34 167.37 m 24.88 167.37 l S BT /F2 1 Tf 0.00 7.00 -7.00 0.00 20.04 47.41 Tm (-4) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 20.04 76.40 Tm (-2) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 20.04 107.44 Tm (0) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 20.04 136.43 Tm (2) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 20.04 165.42 Tm (4) Tj ET 28.34 31.10 m 208.40 31.10 l 208.40 187.66 l 28.34 187.66 l 28.34 31.10 l S Q q 0.00 0.00 216.00 216.00 re W n BT 0.000 0.000 0.000 rg /F3 1 Tf 9.00 0.00 -0.00 9.00 93.91 198.60 Tm [(Site Eff) 10 (ects)] TJ ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 97.36 4.84 Tm (Component 1) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 6.22 88.37 Tm (Component 2) Tj ET Q q 244.34 31.10 180.06 156.56 re W n Q q 244.34 31.10 180.06 156.56 re W n BT 0.000 0.000 0.000 rg /F2 1 Tf 7.00 0.00 -0.00 7.00 347.42 123.78 Tm (1) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 360.67 127.41 Tm (2) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 360.77 126.05 Tm (3) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 347.84 119.97 Tm (4) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 347.93 116.64 Tm (5) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 358.95 113.00 Tm (6) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 347.20 111.99 Tm (7) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 348.58 106.53 Tm (8) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 350.60 106.68 Tm (9) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 347.28 103.77 Tm (X) Tj ET Q q 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 267.68 31.10 m 401.06 31.10 l S 267.68 31.10 m 267.68 27.65 l S 301.02 31.10 m 301.02 27.65 l S 334.37 31.10 m 334.37 27.65 l S 367.71 31.10 m 367.71 27.65 l S 401.06 31.10 m 401.06 27.65 l S BT 0.000 0.000 0.000 rg /F2 1 Tf 7.00 0.00 -0.00 7.00 263.69 18.66 Tm (-4) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 297.03 18.66 Tm (-2) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 332.42 18.66 Tm (0) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 365.77 18.66 Tm (2) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 399.11 18.66 Tm (4) Tj ET 244.34 51.40 m 244.34 167.37 l S 244.34 51.40 m 240.88 51.40 l S 244.34 80.39 m 240.88 80.39 l S 244.34 109.38 m 240.88 109.38 l S 244.34 138.37 m 240.88 138.37 l S 244.34 167.37 m 240.88 167.37 l S BT /F2 1 Tf 0.00 7.00 -7.00 0.00 236.04 47.41 Tm (-4) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 236.04 76.40 Tm (-2) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 236.04 107.44 Tm (0) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 236.04 136.43 Tm (2) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 236.04 165.42 Tm (4) Tj ET 244.34 31.10 m 424.40 31.10 l 424.40 187.66 l 244.34 187.66 l 244.34 31.10 l S Q q 216.00 0.00 216.00 216.00 re W n BT 0.000 0.000 0.000 rg /F3 1 Tf 9.00 0.00 -0.00 9.00 303.42 198.60 Tm [(V) 60 (ariety Eff) 10 (ects)] TJ ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 313.36 4.84 Tm (Component 1) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 222.22 88.37 Tm (Component 2) Tj ET Q endstream endobj 7 0 obj 4095 endobj 3 0 obj << /Type /Pages /Kids [ 5 0 R ] /Count 1 /MediaBox [0 0 432 216] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font <> /ExtGState << >> >> endobj 8 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 9 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 8 0 R >> endobj 10 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 8 0 R >> endobj xref 0 11 0000000000 65535 f 0000000021 00000 n 0000000164 00000 n 0000004461 00000 n 0000004544 00000 n 0000000213 00000 n 0000000293 00000 n 0000004441 00000 n 0000004636 00000 n 0000004893 00000 n 0000004989 00000 n trailer << /Size 11 /Info 1 0 R /Root 2 0 R >> startxref 5091 %%EOF gnm/R/0000755000176200001440000000000013615560322011237 5ustar liggesusersgnm/R/confint.profile.gnm.R0000744000176200001440000000332313431055247015244 0ustar liggesusers# Modification of confint.profile.glm from the MASS package for R. # # Copyright (C) 1994-2006 W. N. Venables and B. D. Ripley # Copyright (C) 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ confint.profile.gnm <- function (object, parm = names(object), level = 0.95, ...) { of <- attr(object, "original.fit") pnames <- names(coef(of)) if (is.numeric(parm)) parm <- pnames[parm] a <- (1 - level)/2 a <- c(a, 1 - a) pct <- paste(round(100 * a, 1), "%") ci <- array(NA, dim = c(length(parm), 2), dimnames = list(parm, pct)) cutoff <- qnorm(a) std.err <- attr(object, "summary")$coefficients[parm, "Std. Error"] parm <- parm[!is.na(std.err)] for (pm in parm) { pro <- object[[pm]] if (is.matrix(pro[, "par.vals"])) sp <- spline(x = pro[, "par.vals"][, pm], y = pro[, 1]) else sp <- spline(x = pro[, "par.vals"], y = pro[, 1]) est <- approx(sp$y, sp$x, xout = cutoff)$y ci[pm, ] <- ifelse(is.na(est) & attr(pro, "asymptote"), c(-Inf, Inf), est) } drop(ci) } gnm/R/labels.gnm.R0000744000176200001440000000157313152512335013410 0ustar liggesusers# Copyright (C) 2005, 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ labels.gnm <- function(object, ...) { labels <- attr(terms(object), "term.labels") termAssign <- attr(model.matrix(object), "assign") if (length(object$constrain)) termAssign <- termAssign[-object$constrain] unique(labels[termAssign]) } gnm/R/dummy.coef.gnm.R0000744000176200001440000000144213152512335014207 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ dummy.coef.gnm <- function (object, ...) { if (inherits(object, "gnm", TRUE) == 1) stop("dummy.coef is not implemented for gnm objects") else NextMethod } gnm/R/pprod.R0000744000176200001440000000216413311200272012476 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ pprod <- function(...) { factorList <- list(...) nFactors <- length(factorList) if (nFactors == 0) return(1) else if (nFactors == 1) return(factorList[[1]]) else { tryProduct <- try(factorList[[1]] * do.call("Recall", factorList[-1]), silent = TRUE) if (inherits(tryProduct, "try-error")) stop("multiplication not implemented for types of ", "argument supplied") else tryProduct } } gnm/R/variable.names.gnm.R0000744000176200001440000000152513152512335015032 0ustar liggesusers# Copyright (C) 2005, 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ variable.names.gnm <- function(object, full = FALSE, ...) { if (full) names(coef(object)) else { setToZero <- object$constrain[object$constrainTo == 0] names(coef(object)[-setToZero]) } } gnm/R/alias.gnm.R0000744000176200001440000000142713152512335013235 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ alias.gnm <- function (object, ...){ if (inherits(object, "gnm", TRUE) == 1) stop("alias is not implemented for gnm objects") else NextMethod } gnm/R/asGnm.glm.R0000744000176200001440000000306713152512335013211 0ustar liggesusers# Copyright (C) 2006, 2008, 2010 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ asGnm.glm <- function(object, ...) { glmExtra <- match(c("effects", "R", "qr", "null.deviance", "df.null", "boundary", "control", "contrasts"), names(object)) modelData <- model.frame(object) object[glmExtra] <- NULL object$call[[1]] <- as.name("gnm") constrain <- which(is.na(coef(object))) object$terms <- gnmTerms(object$formula, data = modelData) object <- c(list(eliminate = NULL, ofInterest = NULL, na.action = na.action(modelData), constrain = constrain, constrainTo = numeric(length(constrain))), object) names(object)[match("linear.predictors", names(object))] <- "predictors" if (is.null(object$offset)) object$offset <- rep.int(0, length(coef(object))) object$tolerance <- object$iterStart <- object$iterMax <- "Not available - model fitted by glm()" class(object) <- c("gnm", "glm", "lm") object } gnm/R/coef.gnm.R0000744000176200001440000000143213152512335013054 0ustar liggesusers# Copyright (C) 2005, 2006, 2010, 2012 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ coef.gnm <- function(object, ...) { structure(object$coefficients, ofInterest = object$ofInterest, class = c("coef.gnm", "numeric")) } gnm/R/proj.gnm.R0000744000176200001440000000142613152512335013115 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ proj.gnm <- function (object, ...) { if (inherits(object, "gnm", TRUE) == 1) stop("proj is not implemented for gnm objects") else NextMethod } gnm/R/DrefWeights.R0000744000176200001440000000424113152512335013574 0ustar liggesusers# Copyright (C) 2007 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ DrefWeights <- function(model) { ind <- pickCoef(model, "delta[1-9]") if (any(!checkEstimable(model, diag(seq(along = coef(model)))[,ind]), na.rm = TRUE)){ message("Refitting with parameters of first Dref weight constrained ", "to zero") constrain <- pickCoef(model, "delta1") model <- update(model, constrain = constrain, start = coef(model), trace = FALSE, verbose = FALSE) } t <- terms(formula(model), specials = "Dref") DrefCall <- attr(t, "variables")[[attr(t, "specials")$Dref + 1]] preds <- match.call(Dref, DrefCall, expand.dots = FALSE)[["..."]] formula <- as.formula(DrefCall$delta) if (length(formula)) { dat <- model.frame(formula, data = model.frame(model)) X <- unique(model.matrix(formula, data = dat)) dat <- dat[rownames(X), , drop = FALSE] rownames(dat) <- rownames(X) <- NULL } else { dat <- numeric(0) X <- matrix(1) } nw <- length(preds) nmod <- nrow(X) delta <- matrix(parameters(model)[ind], nmod) ind <- c(t(matrix(ind, nmod, nw))) vcovDelta <- vcov(model)[ind, ind, drop = FALSE] wc <- 1/rowSums(exp(X %*% delta)) wu <- exp(X %*% delta)*wc XX <- matrix(apply(X, 2, rep, nw), nrow(X)) out <- list() for (i in 1:nw) { d <- -wu[,i] * wu d <- c(wu[,i] * (col(wu) == i) + d) * XX se <- sqrt(rowSums(d %*% vcovDelta * d)) out[[i]] <- drop(cbind(dat, weight = wu[,i], se = se)) } names(out) <- as.character(preds) out } gnm/R/residuals.gnm.R0000744000176200001440000000163413152512335014137 0ustar liggesusers# Copyright (C) 2005, 2008, 2013 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ residuals.gnm <- function(object, type = "deviance", ...) { if (type == "partial") stop("type = \"partial\" not implemented for gnm objects.") else res <- NextMethod("residuals") if (!is.null(object$table.attr)) attributes(res) <- object$table.attr res } gnm/R/Symm.R0000744000176200001440000000322613311442647012315 0ustar liggesusers# Copyright (C) 2005, 2006, 2008 David Firth and Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ Symm <- function(..., separator = ":"){ if (!(is.character(separator) && nchar(separator) > 0)) stop( "separator must be a non-empty character string") dots <- list(...) if (any(diff(vapply(dots, length, 1)) != 0)) stop( "arguments to Symm() must all have same length") dots <- lapply(dots, as.factor) Levels <- levels(dots[[1]]) check <- vapply(dots[-1], function(x) identical(levels(x), Levels), TRUE) if (!all(check)) stop("factors must have the same levels") facMatrix <- vapply(dots, unclass, numeric(length(dots[[1]]))) f <- function(row){ string <- paste(Levels[sort(row)], collapse = separator) if (any(is.na(row))) is.na(string) <- TRUE string } n <- length(Levels) seqn <- seq_len(n) factor(apply(facMatrix, 1, f), paste(Levels[rep(seqn, rev(seqn))], Levels[unlist(lapply(seqn, function(x) seq(x, n)))], sep = separator)) } gnm/R/MPinv.R0000744000176200001440000000521213152512335012411 0ustar liggesusers# Copyright (C) 2005, 2006, 2010 David Firth and Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ MPinv <- function (mat, tolerance = 100 * .Machine$double.eps, rank = NULL, method = "svd") { theRank <- rank if (!is.matrix(mat)) stop("mat must be a matrix") m <- nrow(mat) n <- ncol(mat) Rownames <- rownames(mat) Colnames <- colnames(mat) if (method == "svd") { Svd <- svd(mat) Positive <- rep(FALSE, length(Svd$d)) if (is.null(theRank)) { Positive <- Svd$d > max(tolerance * Svd$d[1], 0) } else Positive[1:theRank] <- TRUE result <- { if (all(Positive)) Svd$v %*% (1/Svd$d * t(Svd$u)) else if (!any(Positive)) array(0, dim(mat)[2:1]) else Svd$v[, Positive, drop = FALSE] %*% ((1/Svd$d[Positive]) * t(Svd$u[, Positive, drop = FALSE])) } attr(result, "rank") <- sum(Positive) } if (method == "chol") { ## Generalized inverse of a symmetric matrix using a ## streamlined version of the "fast" method of ## Courrieu, P. (2005). Fast computation of Moore-Penrose ## inverse matrices. Neural Information Processing 8, 25-29. ## ## No test for symmetry performed here! if (!(m == n)) stop("the matrix is not symmetric") S <- suppressWarnings(chol(mat, pivot = TRUE)) ## (non-full-rank case) if (is.null(theRank)) { theRank <- qr(S)$rank ## fails only on the bwt.po example ## theRank <- attr(S, "rank") ## seems less reliable in general } pivot <- attr(S, "pivot") oPivot <- order(pivot) Lt <- S[oPivot[oPivot %in% 1:theRank], oPivot, drop = FALSE] LLinv <- chol2inv(chol(tcrossprod(Lt))) result <- crossprod(Lt, crossprod(LLinv)) %*% Lt attr(result, "rank") <- theRank } if (!is.null(Rownames)) colnames(result) <- Rownames if (!is.null(Colnames)) rownames(result) <- Colnames return(result) } gnm/R/exitInfo.R0000744000176200001440000000214313152512335013145 0ustar liggesusers# Copyright (C) 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ exitInfo <- function(object){ conv <- object$converged if (conv) cat("Algorithm converged\n") else { cat("\nTolerance: ", object$tolerance, "\n") cat("\nAbsolute scores >= ", "tolerance * sqrt(tolerance + diag(information matrix)):\n\n") score <- abs(attr(conv, "score")) fail <- score >= attr(conv, "criterion") print(data.frame(abs.score = score, criterion = attr(conv, "criterion"))[fail,]) } } gnm/R/zzz.R0000744000176200001440000000032013311427341012207 0ustar liggesusers.onUnload <- function(libpath) { library.dynam.unload("gnm", libpath) } messageVector <- function(x){ message(paste(strwrap(paste(x, collapse = ", ")), collapse = "\n")) } gnm/R/se.R0000744000176200001440000000707113311460237011774 0ustar liggesusers# Copyright (C) 2005, 2006, 2010 David Firth and Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ ## now only computes se for non-eliminated parameters se <- function(object, ...) { UseMethod("se", object) } se.default <- function(object, ...){ stop("No se method defined for this class of object") } se.gnm <- function(object, estimate = NULL, checkEstimability = TRUE, Vcov = NULL, dispersion = NULL, ...){ if (!is.null(Vcov) && !is.null(dispersion)){ Vcov <- Vcov * dispersion } else { Vcov <- vcov(object, dispersion = dispersion, use.eliminate = FALSE) } if (!length(Vcov)) return("Model has no non-eliminated parameters") coefs <- coef(object) coefNames <- names(coefs) eliminate <- object$eliminate nelim <- nlevels(eliminate) l <- length(coefs) if (identical(estimate, "[?]")) estimate <- pickCoef(object, title = paste("Estimate standard errors", "for one or more gnm coefficients")) if (is.null(estimate)){ if (!is.null(object$ofInterest)) estimate <- ofInterest(object) else estimate <- seq(object$coefficients) } if (is.character(estimate)) estimate <- match(estimate, coefNames, 0) if (is.vector(estimate) && all(estimate %in% seq(coefs))) { if (!length(estimate)) stop("no non-eliminated coefficients specified by 'estimate'", "argument") comb <- naToZero(coefs[estimate]) var <- Vcov[estimate, estimate] coefMatrix <- matrix(0, l, length(comb)) coefMatrix[cbind(estimate, seq(length(comb)))] <- 1 colnames(coefMatrix) <- names(comb) } else { coefMatrix <- as.matrix(estimate) if (!is.numeric(coefMatrix)) stop("'estimate' should specify parameters using ", "\"pick\" or a vector of \n names/indices; ", "or specify linear combinations using ", "a numeric vector/matrix.") if (nrow(coefMatrix) != l) stop("NROW(estimate) should equal ", "length(coef(model)) - nlevels(model$eliminate)") comb <- drop(crossprod(coefMatrix, naToZero(coefs))) var <- crossprod(coefMatrix, crossprod(Vcov, coefMatrix)) } estimable <- rep(TRUE, ncol(coefMatrix)) if (checkEstimability) { estimable <- checkEstimable(object, coefMatrix, ...) if (any(!na.omit(estimable))) message("Std. Error is NA where estimate is fixed or ", "unidentified") } if (is.matrix(var)) sterr <- sqrt(diag(var)) else sterr <- sqrt(var) is.na(sterr[estimable %in% c(FALSE, NA)]) <- TRUE result <- data.frame(comb, sterr) rowNames <- colnames(coefMatrix) if (is.null(rowNames)) rowNames <- paste("Combination", ncol(coefMatrix)) dimnames(result) <- list(rowNames, c("Estimate", "Std. Error")) result } gnm/R/plot.profile.gnm.R0000744000176200001440000000276513311212070014555 0ustar liggesusers# Modification of plot.profile from the stats package for R. # # File MASS/profiles.q copyright (C) 1996 D. M. Bates and W. N. Venables. # port to R by B. D. Ripley copyright (C) 1998 # corrections copyright (C) 2000,3,6 B. D. Ripley # Copyright (C) 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ plot.profile.gnm <- function (x, nseg, ...) { nulls <- vapply(x, is.null, TRUE) if (all(nulls)) return(NULL) x <- x[!nulls] pnames <- names(x) pnames <- pnames[!is.na(x[pnames])] nr <- ceiling(sqrt(length(pnames))) oldpar <- par(mfrow = c(nr, nr)) on.exit(par(oldpar)) for (nm in pnames) { z <- x[[nm]][[1]] parval <- x[[nm]][[2]][, nm] plot(parval, z, xlab = nm, ylab = "z", type = "n") if (sum(z == 0) == 1) points(parval[z == 0], 0, pch = 3) splineVals <- spline(parval, z) lines(splineVals$x, splineVals$y) } } gnm/R/asGnm.R0000744000176200001440000000132613152512335012427 0ustar liggesusers# Copyright (C) 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ asGnm <- function(object, ...){ if (is.null(object)) return(NULL) UseMethod("asGnm") } gnm/R/Topo.R0000744000176200001440000000241613311211560012275 0ustar liggesusers# Copyright (C) 2005 David Firth # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ "Topo" <- function (..., spec = NULL) { if (is.null(spec)) stop("No spec given") dots <- list(...) factorLengths <- vapply(dots, length, 1) lengthsEqual <- {if (length(factorLengths) == 1) TRUE else sd(factorLengths) == 0} if (!lengthsEqual) stop("Factors have different lengths") specDim <- if (is.vector(spec)) length(spec) else dim(spec) dots <- lapply(dots, as.factor) facMat <- cbind(...) spec.ok <- identical(vapply(dots, nlevels, 1L), specDim) if (!spec.ok) stop( "Dimensions of spec do not match the factor arguments") return(as.factor(spec[facMat])) } gnm/R/effects.gnm.R0000744000176200001440000000143413152512335013561 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ effects.gnm <- function (object, ...) { if (inherits(object, "gnm", TRUE) == 1) stop("effects is not implemented for gnm objects") else NextMethod } gnm/R/naToZero.R0000744000176200001440000000126313152512335013123 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ naToZero <- function(vec){ vec[is.na(vec)] <- 0 return(vec) } gnm/R/gnm-defunct.R0000744000176200001440000000225313152512335013571 0ustar liggesusers# Copyright (C) 2012 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ Nonlin <- function(functionCall){ .Defunct(msg = paste("'Nonlin' is defunct.", "\nUse functions of class \"nonlin\" instead.", "\nSee ?nonlin.function for more details.")) } class(Nonlin) <- "nonlin" getModelFrame <- function() { .Defunct(msg = paste("'getModelFrame' is deprecated as it was designed to ", "work with the old plug-in architecture for nonlinear terms.")) } qrSolve <- function(A, b, rank = NULL, ...) { .Defunct(msg = paste("'qrSolve' is deprecated as it is no longer used ", "by gnm.")) } gnm/R/termPredictors.gnm.R0000744000176200001440000000267613152512335015161 0ustar liggesusers# Copyright (C) 2005, 2008, 2010, 2012 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ termPredictors.gnm <- function(object, ...) { if (is.null(object$termPredictors)){ modelData <- model.frame(object) modelTerms <- terms(object) if (!is.empty.model(modelTerms)) { modelTools <- gnmTools(modelTerms, modelData) theta <- parameters(object) varPredictors <- modelTools$varPredictors(theta) termPredictors <- modelTools$predictor(varPredictors, term = TRUE) rownames(termPredictors) <- rownames(modelData) } else termPredictors <- modelData[,0] if (!is.null(object$eliminate)) termPredictors <- cbind("(eliminate)" = as.vector(attr(coef(object), "eliminated")[object$eliminate]), termPredictors) termPredictors } else object$termPredictors } gnm/R/Logit.R0000744000176200001440000000167213152512335012444 0ustar liggesusers# Copyright (C) 2006, 2008 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ Logit <- function(expression, inst = NULL){ list(predictors = list(substitute(expression)), term = function(predLabels, ...) { paste("log((", predLabels, ")/(1 - (", predLabels, ")))", sep = "") }, call = as.expression(match.call()), match = 1) } class(Logit) <- "nonlin" gnm/R/print.vcov.gnm.R0000744000176200001440000000147313152512335014255 0ustar liggesusers# Copyright (C) 2005, 2006, 2010 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ print.vcov.gnm <- function(x, ...) { if (!is.null(attr(x, "ofInterest"))){ print.default(x[attr(x, "ofInterest"), attr(x, "ofInterest")]) } else print.default(x) } gnm/R/print.coef.gnm.R0000744000176200001440000000205313152512335014207 0ustar liggesusers# Copyright (C) 2005, 2006, 2010 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ print.coef.gnm <- function(x, ...) { if (!is.null(attr(x, "ofInterest"))) { if (length(attr(x, "ofInterest"))){ cat("Coefficients of interest:\n", sep = "") print.default(format(x[attr(x, "ofInterest")]), quote = FALSE) } else cat("No coefficients of interest\n") } else { cat("Coefficients:\n") print.default(format(x), quote = FALSE) } } gnm/R/model.frame.gnm.R0000744000176200001440000000233313152512335014332 0ustar liggesusers# Modification of model.frame.glm from the stats package for R. # # Copyright (C) 1995-2005 The R Core Team # Copyright (C) 2005, 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ model.frame.gnm <- function (formula, ...) { dots <- list(...) nargs <- dots[match(c("data", "na.action", "subset"), names(dots), 0)] if (length(nargs) || is.null(formula$model)) { fcall <- formula$call fcall$method <- "model.frame" fcall[[1]] <- as.name("gnm") fcall[names(nargs)] <- nargs env <- environment(formula$terms) if (is.null(env)) env <- parent.frame() eval(fcall, env) } else formula$model } gnm/R/rstudent.gnm.R0000744000176200001440000000143413152512335014012 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ rstudent.gnm <- function (model, ...) { if (inherits(model, "gnm", TRUE) == 1) stop("rstudent is not implemented for gnm objects") else NextMethod } gnm/R/nonlinTerms.R0000744000176200001440000002403613311213234013666 0ustar liggesusers# Copyright (C) 2006-2010, 2012 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ nonlinTerms <- function(predictors, variables = NULL, term = NULL, common = seq(predictors), call = NULL, match = numeric(length(predictors)), start = NULL, nonlin.function = NULL, data = NULL) { shadow <- predictor <- predvars <- vars <- unitLabels <- hashLabels <- offsetLabels <- varLabels <- blockList <- matchID <- suffix <-list() if (length(names(predictors))) { suffix <- as.list(names(predictors)) ID <- match(suffix, unique(suffix)) for (i in unique(ID[duplicated(suffix) & suffix != ""])) { dup <- ID == i suffix[dup] <- paste(suffix[dup], seq(sum(dup)), sep = "") } } else suffix <- as.list(rep("", length(predictors))) common <- as.list(common) adj <- 0 hash <- 0 dup <- duplicated(match) for (i in order(match)) { if (inherits(predictors[[i]], "formula")){ nonlinTerms <- terms(predictors[[i]], specials = "Const", keep.order = TRUE, data = data) twiddle <- "~ " } else { nonlinTerms <- terms(eval(substitute(~ -1 + p, list(p = predictors[[i]]))), specials = "Const", keep.order = TRUE, data = data) twiddle <- "" } if (attr(nonlinTerms, "intercept") & !match[i] & !nchar(suffix[[i]])) stop("\"nonlin\" function ", nonlin.function, " must either name ", "predictors that may include an intercept \n or match them ", "to a call") if (is.empty.model(nonlinTerms)) { predvars[[i]] <- vars[[i]] <- as.list(attr(nonlinTerms, "variables"))[-1] offsetLabels[[i]] <- vars[[i]][attr(nonlinTerms, "offset")] varLabels[[i]] <- predictor[[i]] <- unitLabels[[i]] <- NULL blockList[[i]] <- numeric(0) suffix[[i]] <- character(0) } else { unitLabels[[i]] <- as.list(c("1"[attr(nonlinTerms, "intercept")], attr(nonlinTerms, "term.labels"))) vars[[i]] <- predvars[[i]] <- as.list(attr(nonlinTerms, "variables"))[-1] specials <- vapply(vars[[i]], function(x) { length(x) > 1 && inherits(match.fun(x[[1]]), "nonlin")}, TRUE) const <- attr(nonlinTerms, "specials")$Const if (length(const)) { unitLabels[[i]] <- unitLabels[[i]][!unitLabels[[i]] %in% vars[[i]][const]] predvars[[i]][const] <- lapply(vars[[i]][const], eval) } offsetLabels[[i]] <- vars[[i]][c(attr(nonlinTerms, "offset"), const)] varLabels[[i]] <- as.list(paste("#", adj, gsub("`", ".", unitLabels[[i]]), sep = "")) predictor[[i]] <- paste("`", varLabels[[i]], "`", sep = "") n <- length(unitLabels[[i]]) shadow[[i]] <- rep("#", n) hashLabels[[i]] <- unitLabels[[i]] matchID[[i]] <- as.list(numeric(n)) suffix[[i]] <- as.list(rep(suffix[[i]], n)) if (length(specials)) { nonlinear <- unitLabels[[i]] %in% vars[[i]][specials] vars[[i]] <- vars[[i]][!specials] predvars[[i]] <- predvars[[i]][!specials] } else nonlinear <- rep(FALSE, n) blockList[[i]] <- as.list(nonlinear - min(nonlinear)) if (dup[i]) hash <- last.hash else last.hash <- hash for (j in seq(n)) { if (nonlinear[j]) { tmp <- do.call("Recall", eval(parse(text = unitLabels[[i]][[j]]))) if (match[i]) { if (any(tmp$matchID > 0)) { shadow[[i]][[j]] <- tmp$prefix matchID[[i]][[j]] <- tmp$matchID matchID[[i]][[j]][tmp$matchID != 0] <- hash + matchID[[i]][[j]][tmp$matchID != 0] hashLabels[[i]][[j]] <- tmp$unitLabels } else { lbl <- ifelse(length(tmp$prefix), tmp$prefix, hashLabels[[i]][[j]]) nlbl <- length(tmp$matchID) tmp$suffix <- paste(lbl, tmp$suffix, sep = "") hashLabels[[i]][[j]] <- rep(lbl, nlbl) matchID[[i]][[j]] <- rep(hash + 1, nlbl) } } else { ## could paste call to suffix - but potentially v. long ## and would get cut off anyway: better to rely on ## make.unique for awkward cases ##if (any(tmp$matchID) | !length(tmp$prefix)) ## lbl <- hashLabels[[i]][[j]] ## else ## lbl <- tmp$prefix ## tmp$suffix <- paste(lbl, tmp$suffix, sep = "") if (any(tmp$matchID)) warning("Function using argument-matched ", "labelling (", parse(text = unitLabels[[i]][[j]])[[1]][1], ") used in unmatched predictor\n (see ", "?nonlin) - labels may be ill-defined.\n", call. = FALSE) nlbl <- length(tmp$matchID) hashLabels[[i]][[j]] <- rep(hashLabels[[i]][[j]], nlbl) matchID[[i]][[j]] <- rep(0, nlbl) } varLabels[[i]][[j]] <- gsub("#", paste("#", adj, sep = ""), tmp$varLabels) unitLabels[[i]][[j]] <- tmp$unitLabels blockList[[i]][[j]] <- blockList[[i]][[j]] + tmp$block suffix[[i]][[j]] <- paste(suffix[[i]][[j]], tmp$suffix, sep = "")[!is.null(tmp$suffix)] predictor[[i]][[j]] <- gsub("#", paste("#", adj, sep = ""), tmp$predictor) vars[[i]] <- c(vars[[i]], tmp$variables) predvars[[i]] <- c(predvars[[i]], tmp$predvars) common[[i]] <- common[[i]] * 10 + tmp$common } else { if (match[i]) matchID[[i]][[j]] <- hash + 1 common[[i]] <- common[[i]]*10 + seq(varLabels[[i]]) } hash <- max(c(hash, matchID[[i]][[j]])) } } blockList[[i]] <- unlist(blockList[[i]]) + adj adj <- max(c(-1, blockList[[i]])) + 1 shadow[[i]] <- paste(twiddle, paste(c(unlist(shadow[i]), offsetLabels[[i]]), collapse = " + "), sep = "") if (length(offsetLabels[[i]])) predictor[i] <- paste(c(unlist(predictor[i]), paste("`", offsetLabels[[i]], "`", sep = "")), collapse = " + ") else predictor[i] <- paste(unlist(predictor[i]), collapse = " + ") } common <- unlist(common) if (any(duplicated(common))) { common <- match(common, common) #common <- unlist(varLabels[common]) #common <- match(common, unique(common)) blockList <- unlist(blockList)[common] } else common <- seq(unlist(varLabels)) if (!is.null(call) && sum(match)) { fn <- call[[1]][[1]] call <- as.list(call[[1]][-1]) call[match] <- shadow[match > 0] if (is.null(names(predictors))) names(call)[match] <- "" else names(call)[match] <- names(predictors)[match > 0] sep <- character(length(call)) sep[names(call) != ""] <- " = " call <- paste(names(call), sep, call, sep = "") prefix <- paste(fn, "(", paste(call, collapse = ", "), ")", sep = "") } else prefix <- paste(c(call[[1]])) predictor <- term(unlist(predictor), vapply(variables, function(x) { paste("`", deparse(x), "`", sep = "")}, character(1))) list(prefix = prefix, matchID = unlist(matchID), variables = c(unlist(vars), variables), predvars = c(unlist(predvars), variables), varLabels = unlist(varLabels), unitLabels = unlist(unitLabels), hashLabels = unlist(hashLabels), block = unlist(blockList), common = common, type = rep.int("Special", length(common)), predictor = predictor, suffix = unlist(suffix), start = start) } gnm/R/Inv.R0000744000176200001440000000163313152512335012117 0ustar liggesusers# Copyright (C) 2006, 2008 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ Inv <- function(expression, inst = NULL){ list(predictors = list(substitute(expression)), term = function(predLabels, ...) { paste("(", predLabels, ")^-1", sep = "") }, call = as.expression(match.call()), match = 1) } class(Inv) <- "nonlin" gnm/R/predict.gnm.R0000744000176200001440000001745713615560322013613 0ustar liggesusers# Copyright (C) 2005, 2008, 2010, 2012, 2014, 2015 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ predict.gnm <- function (object, newdata = NULL, type = c("link", "response", "terms"), se.fit = FALSE, dispersion = NULL, terms = NULL, na.action = na.exclude, ...) { type <- match.arg(type) if (type == "terms") { hasintercept <- attr(object$terms, "intercept") > 0L ## do not include eliminate term - cannot check estimability without ## creating full matrix, defeating point of eliminate if (is.null(terms)) { terms <- attr(object$terms, "term.labels") } else { terms <- setdiff(terms, "(eliminate)") } } if (is.null(newdata)) { pred <- switch(type, link = object$predictors, response = object$fitted.values, terms = {pred <- termPredictors(object) ## see 6.3.6 white book & predict.lm if (hasintercept) { predc <- sweep(pred, 2, colMeans(pred)) const <- sum(pred[1,]) - sum(predc[1,]) structure(predc[, terms, drop = FALSE], constant = const) } else structure(pred[, terms, drop = FALSE], constant = 0)}) if (!is.null(na.act <- object$na.action)){ pred <- napredict(na.act, pred) } if (!inherits(pred, "matrix") && !is.null(object$table.attr)) attributes(pred) <- object$table.attr } else { modelTerms <- delete.response(terms(object)) if (is.null(object$eliminate)){ modelData <- model.frame(modelTerms, newdata, na.action = na.action, xlev = object$xlevels) } else { ## eliminate is evaluated in data/environment of formula ## => need to substitute here modelData <- eval(substitute( model.frame(modelTerms, newdata, eliminate = eliminate, na.action = na.action, xlev = object$xlevels), list(eliminate = object$call$eliminate))) } ## use same contrasts as in original model contr <- lapply(model.frame(object)[names(modelData)], attr, "contrasts") for (i in which(!vapply(contr, is.null, TRUE))){ modelData[[i]] <- C(modelData[[i]], contr[[i]]) } if (length(offID <- attr(modelTerms, "offset"))){ offset <- eval(attr(modelTerms, "variables")[[offID + 1]], newdata) } else offset <- eval(object$call$offset, newdata) modelTools <- gnmTools(modelTerms, modelData) varPredictors <- modelTools$varPredictors(parameters(object)) pred <- modelTools$predictor(varPredictors, term = type == "terms") if (type == "terms") { rownames(pred) <- rownames(modelData) } else names(pred) <- rownames(modelData) if (!is.null(offset)) pred <- offset + pred if (!is.null(object$eliminate)) { prede <- attr(coef(object), "eliminate") if (type != "terms") pred <- prede[modelData$`(eliminate)`] + pred } switch(type, response = {pred <- family(object)$linkinv(pred)}, terms = {if (hasintercept) { predc <- sweep(pred, 2, colMeans(termPredictors(object))) const <- sum(pred[1,]) - sum(predc[1,]) pred <- structure(predc[, terms, drop = FALSE], constant = const) } else structure(pred[, terms, drop = FALSE], constant = 0)}, link = ) if (!is.null(na.act <- attr(modelData, "na.action"))) pred <- napredict(na.act, pred) } if (se.fit) { V <- vcov(object, dispersion = dispersion, with.eliminate = TRUE) residual.scale <- as.vector(sqrt(attr(V, "dispersion"))) if (is.null(newdata)) { X <- model.matrix(object) elim <- object$eliminate } else { X <- modelTools$localDesignFunction(parameters(object), varPredictors) elim <- modelData$`(eliminate)` } covElim <- attr(V, "covElim")[elim, , drop = FALSE] varElim <- attr(V, "varElim")[elim] switch(type, link = { if (is.null(elim)) se.fit <- sqrt(diag(X %*% tcrossprod(V, X))) else se.fit <- sqrt(diag(X %*% tcrossprod(V, X)) + 2 * rowSums(X * covElim) + varElim)}, response = { eta <- na.omit(c(family(object)$linkfun(pred))) d <- family(object)$mu.eta(eta) if (is.null(object$eliminate)) se.fit <- sqrt(diag(X %*% tcrossprod(V, X))) else se.fit <- sqrt(diag(X %*% tcrossprod(V, X)) + 2*rowSums(X * covElim) + varElim) se.fit <- d * se.fit}, terms = { if (is.null(newdata)) { assign <- split(seq(ncol(X)), attr(X, "assign")) } else { M <- model.matrix(object) assign <- split(seq(ncol(X)), attr(M, "assign")) } if (hasintercept) { if (is.null(newdata)) { X <- sweep(X, 2, colMeans(X)) } else X <- sweep(X, 2, colMeans(M)) } se.fit <- matrix(, nrow = nrow(X), ncol = length(terms)) s <- 0 adj <- hasintercept for (i in match(terms, colnames(pred))) { s <- s + 1 t <- assign[[i + adj]] se.fit[, s] <- sqrt(diag(X[, t] %*% tcrossprod(V[t, t], X[, t]))) ## check estimability of term Xt <- X Xt[, -t] <- 0 estimable <- checkEstimable(object, t(Xt)) is.na(se.fit)[estimable %in% c(FALSE, NA), s] <- TRUE } }) ## check estimability of predictions if (!is.null(newdata) && type != "terms"){ estimable <- checkEstimable(object, t(X)) is.na(se.fit)[estimable %in% c(FALSE, NA)] <- TRUE } if (!is.null(na.act)) { se.fit <- napredict(na.act, se.fit) } if (inherits(pred, "table")) attributes(se.fit) <- object$table.attr else attributes(se.fit) <- attributes(pred) pred <- list(fit = pred, se.fit = se.fit, residual.scale = residual.scale) } pred } gnm/R/update.gnm.R0000744000176200001440000000415713615614004013431 0ustar liggesusers# Modification of update.default from the stats package for R. # # Copyright (C) 1995-2010 The R Core Team # Copyright (C) 2010, 2012 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ update.gnm <- function (object, formula., ..., evaluate = TRUE) { call <- object$call if (is.null(call)) stop("need an object with call component") extras <- match.call(expand.dots = FALSE)$... if (!missing(formula.)) { ## update.formula reorders nonlin terms as lin (main effects) ## therefore use substitute to keep order formula. <- as.formula(formula.) rhs <- formula.[[length(formula.)]] rhs <- do.call(substitute, list(rhs, env = list("." = object$formula[[3]]))) if (length(formula.) == 3) { lhs <- formula.[[2]] lhs <- do.call(substitute, list(lhs, env = list("." = object$formula[[2]]))) call$formula <- call("~", lhs, rhs) } else call$formula <- call("~", object$formula[[2]], rhs) f <- formula(terms.formula(call$formula, simplify = TRUE, keep.order = TRUE)) environment(f) <- environment(formula.) call$formula <- f } if (length(extras)) { existing <- !is.na(match(names(extras), names(call))) for (a in names(extras)[existing]) call[[a]] <- extras[[a]] if (any(!existing)) { call <- c(as.list(call), extras[!existing]) call <- as.call(call) } } if (evaluate) eval(call, parent.frame()) else call } gnm/R/Exp.R0000744000176200001440000000165313152512335012121 0ustar liggesusers# Copyright (C) 2005, 2006 Heather Turner and David Firth # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ Exp <- function(expression, inst = NULL){ list(predictors = list(substitute(expression)), term = function(predLabels, ...) { paste("exp(", predLabels, ")", sep = "") }, call = as.expression(match.call()), match = 1) } class(Exp) <- "nonlin" gnm/R/weighted.MM.R0000744000176200001440000000214613152512335013473 0ustar liggesusers# Copyright (C) 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ weighted.MM <- function(resp, conc){ list(predictors = list(Vm = substitute(conc), K = 1), variables = list(substitute(resp), substitute(conc)), term = function(predLabels, varLabels) { pred <- paste("(", predLabels[1], "/(", predLabels[2], " + ", varLabels[2], "))", sep = "") pred <- paste("(", varLabels[1], " - ", pred, ")/sqrt(", pred, ")", sep = "") }) } class(weighted.MM) <- "nonlin" gnm/R/rstandard.gnm.R0000744000176200001440000000173413152512335014127 0ustar liggesusers# Copyright (C) 2005, 2006, 2008 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ rstandard.gnm <- function(model, ...) { so <- summary(model) res <- na.omit(so$deviance.resid[model$prior.weights != 0]) res <- naresid(model$na.action, res) res <- res/sqrt(so$dispersion * (1 - hatvalues(model))) res[is.infinite(res)] <- NaN if (!is.null(model$table.attr)) attributes(res) <- model$table.attr res } gnm/R/checkEstimable.R0000744000176200001440000000404013152512335014261 0ustar liggesusers# Copyright (C) 2005, 2006, 2008, 2010, 2015 David Firth and Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ checkEstimable <- function(model, combMatrix = diag(length(coef(model))), tolerance = NULL) { if (!inherits(model, "gnm")) stop("model not of class gnm") coefs <- coef(model) l <- length(coefs) combMatrix <- as.matrix(combMatrix) if (nrow(combMatrix) != l) stop( "dimensions of combMatrix do not match coef(model)") ## remove constrained coefficients X <- model.matrix(model)[, !is.na(coefs), drop = FALSE] combMatrix <- scale(combMatrix[!is.na(coefs), , drop = FALSE], center = FALSE) resultNA <- apply(combMatrix, 2, function(col) any(is.na(col))) result <- logical(ncol(combMatrix)) is.na(result) <- resultNA eliminate <- model$eliminate if (!is.null(eliminate)) { ## sweeps needed to get the rank right subtracted <- rowsum(X, eliminate)/tabulate(eliminate) if (attr(terms(model), "intercept") == 1) subtracted[,1] <- 0 X <- X - subtracted[eliminate, , drop = FALSE] } rankX <- model$rank - nlevels(eliminate) check.1 <- function(comb){ Xc <- rbind(X, comb) rankXc <- quickRank(Xc, tol = tolerance) return(rankXc == rankX) } result[!resultNA] <- apply(combMatrix[, !resultNA, drop = FALSE], 2, check.1) names(result) <- colnames(combMatrix) return(result) } gnm/R/Dref.R0000744000176200001440000000366113152512335012246 0ustar liggesusers# Copyright (C) 2005-2007, 2012 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ Dref <- function(..., delta = ~ 1){ preds <- match.call(expand.dots = FALSE)[["..."]] n <- length(preds) preds <- c(delta = rep(list(delta), n), preds) common <- c(1:n, rep(n + 1, n)) extra <- setdiff(names(match.call()[-1]), c("", "delta")) if (length(extra)) stop(paste(c("invalid argument passed to Dref:", extra), collapse = " ")) nf <- match(c("delta"), names(match.call()[-1]), 0) if ("formula" %in% names(match.call()[-1])) stop("formula argument of old plug-in has been renamed ", "\"delta\" in this function.") match <- c(rep(nf, n), 1:n) names(preds) <- c(rep("delta", n), rep("", n)) list(predictors = preds, common = common, match = match, term = function(predLabels, ...){ delta <- predLabels[1:n] gamma <- predLabels[-c(1:n)] paste("(((exp(", delta, "))/(", paste("exp(", delta, ")", collapse = " + "), "))*", gamma, ")", sep = "", collapse = " + ")}, start = function(theta) { ifelse(attr(theta, "assign") == n + 1, 0.5, runif(length(theta)) - 0.5) }, call = as.expression(match.call())) } class(Dref) <- "nonlin" gnm/R/Diag.R0000744000176200001440000000302513311441525012223 0ustar liggesusers# Copyright (C) 2005, 2008 David Firth and Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ Diag <- function(..., binary = FALSE){ dots <- list(...) dots <- lapply(dots, as.factor) Levels <- levels(dots[[1]]) check <- vapply(dots[-1], function(x) identical(levels(x), Levels), TRUE) if (!all(check)){ message("Levels are not identical, new factor will be based ", "on sorted combined levels.") Levels <- sort(unique(unlist(lapply(dots, levels)))) } facMatrix <- vapply(dots, as.character, character(length(dots[[1]]))) f <- function(row){ if (all(is.na(row))) return(NA) if (all(!is.na(row)) && all(row == row[1])) return(row[1]) row <- na.omit(row) if (!all(row == row[1])) return(".") return(NA) } result <- factor(apply(facMatrix, 1, f), levels = c(".", Levels)) if (binary) result <- ifelse(result == ".", 0, 1) result } gnm/R/hatvalues.gnm.R0000744000176200001440000000263313152512335014140 0ustar liggesusers# Copyright (C) 2005, 2006, 2008, 2010, 2012 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ hatvalues.gnm <- function(model, ...) { X <- as(model.matrix(model), "sparseMatrix") var <- unclass(vcov(model, with.eliminate = TRUE)) eliminate <- model$eliminate scale <- model$weights/attr(var, "dispersion") hat <- rowSums((X %*% var) * X) * scale if (!is.null(eliminate)) { ## no covElim! if (length(model$constrain)) X <- X[, -model$constrain, drop = FALSE] hat <- hat + (2 * rowSums(X * attr(var, "covElim")[eliminate, , drop = FALSE]) + attr(var, "varElim")[eliminate]) * scale } hat <- naresid(model$na.action, hat) hat[is.na(hat)] <- 0 hat[hat > 1 - 100 * .Machine$double.eps] <- 1 if (!is.null(model$table.attr)) attributes(hat) <- model$table.attr hat } gnm/R/sumExpression.R0000744000176200001440000000142213152512335014243 0ustar liggesusers# Copyright (C) 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ sumExpression <- function(exprList) { expr <- exprList[[1]] for (i in seq(exprList)[-1]) { expr <- call("+", expr, exprList[[i]]) } expr } gnm/R/pickCoef.R0000744000176200001440000000323013615560322013104 0ustar liggesusers# Copyright (C) 2006, 2010, 2012, 2013 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ pickCoef <- function(object, pattern = NULL, value = FALSE, ...){ coefs <- names(coef(object)) if (is.null(coefs)) stop("Coefficient names cannot be extracted from 'object'") if (is.null(pattern)) { default <- list(setlabels = "Selected coefficients", title = "Select coefficients of interest", items.label = "Model coefficients:", return.indices = TRUE, edit.setlabels = FALSE, warningText = "No subset of coefficients selected") dots <- list(...) dotArgs <- match(names(default), names(dots)) allArgs <- c(list(coefs), dots, default[is.na(dotArgs)]) selection <- unname(unlist(do.call(pickFrom, allArgs))) } else { selection <- grep(pattern, coefs, value = FALSE, ...) } if (!length(selection)) selection <- NULL else if (!value) names(selection) <- coefs[selection] else selection <- parameters(object)[selection] selection } gnm/R/kappa.gnm.R0000744000176200001440000000141613152512335013236 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ kappa.gnm <- function (z, ...) { if (inherits(z, "gnm", TRUE) == 1) stop("kappa is not implemented for gnm objects") else NextMethod } gnm/R/Raise.R0000744000176200001440000000165713152512335012434 0ustar liggesusers# Copyright (C) 2006, 2008 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ Raise <- function(expression, power = 1, inst = NULL){ list(predictors = list(substitute(expression)), term = function(predLabels, ...) { paste("(", predLabels, ")^", power, sep = "") }, call = as.expression(match.call()), match = 1) } class(Raise) <- "nonlin" gnm/R/Log.R0000744000176200001440000000163313152512335012104 0ustar liggesusers# Copyright (C) 2006, 2008 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ Log <- function(expression, inst = NULL){ list(predictors = list(substitute(expression)), term = function(predLabels, ...) { paste("log(", predLabels, ")", sep = "") }, call = as.expression(match.call()), match = 1) } class(Log) <- "nonlin" gnm/R/confint.gnm.R0000744000176200001440000000235613311430551013602 0ustar liggesusers# Modification of confint.glm from the MASS package for R. # # Copyright (C) 1994-2006 W. N. Venables and B. D. Ripley # Copyright (C) 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ confint.gnm <- function (object, parm = ofInterest(object), level = 0.95, trace = FALSE, ...) { pnames <- names(coef(object)) if (is.null(parm)) parm <- seq(along = pnames) else if (is.character(parm)) parm <- match(parm, pnames, nomatch = 0) message("Waiting for profiling to be done...") flush.console() object <- profile(object, which = parm, alpha = 1 - level, trace = trace) confint(object, level = level, ...) } gnm/R/fitted.gnm.R0000744000176200001440000000143413152512335013421 0ustar liggesusers# Copyright (C) 2008 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ fitted.gnm <- function(object, ...) { fitted <- NextMethod("fitted") if (!is.null(object$table.attr)) attributes(fitted) <- object$table.attr fitted } gnm/R/influence.gnm.R0000744000176200001440000000145613152512335014116 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ influence.gnm <- function (model, do.coef = TRUE, ...) { if (inherits(model, "gnm", TRUE) == 1) stop("influence is not implemented for gnm objects") else NextMethod } gnm/R/checkCall.R0000744000176200001440000000160313152512335013231 0ustar liggesusers# Copyright (C) 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ checkCall <- function(){ badCall <- lapply(sys.calls(), "[[", 1) %in% c("model.frame.default", "model.matrix.default") if (any(badCall)) stop(paste(sys.call(-1)[[1]], "terms are only valid in gnm models.")) } gnm/R/Logistic.R0000744000176200001440000000206113152512335013134 0ustar liggesusers# Copyright (C) 2007 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ Logistic <- function(x, inst = NULL){ list(predictors = list(Asym = 1, xmid = 1, scal = 1), variables = list(substitute(x)), term = function(predLabels, varLabels) { paste(predLabels[1], "/(1 + exp((", predLabels[2], "-", varLabels[1], ")/", predLabels[3], "))") }, start = function(theta){ c(NA, mean(x), sd(x)) } ) } class(Logistic) <- "nonlin" gnm/R/asGnm.default.R0000744000176200001440000000137313152512335014054 0ustar liggesusers# Copyright (C) 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ asGnm.default <- function (object, ...) { stop("\nCannot coerce objects of class \"", class(object), "\" to class \"gnm\".") } gnm/R/instances.R0000744000176200001440000000176213152512335013355 0ustar liggesusers# Copyright (C) 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ instances <- function(term, instances = 1){ term <- match.call()$term if (!"inst" %in% names(formals(match.fun(term[[1]])))) stop(term[[1]], " has no inst argumnt") termList <- vector(mode = "list", length = instances) for (i in seq(instances)) { termList[[i]] <- term termList[[i]]$inst <- i } paste(unlist(termList), collapse = " + ") } gnm/R/ofInterest.R0000744000176200001440000000125013152512335013500 0ustar liggesusers# Copyright (C) 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ ofInterest <- function(object) { object$ofInterest } gnm/R/dropterm.gnm.R0000744000176200001440000000143613152512335014000 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ dropterm.gnm <- function (object, ...) { if (inherits(object, "gnm", TRUE) == 1) stop("dropterm is not implemented for gnm objects") else NextMethod } gnm/R/quick.glm.fit.R0000744000176200001440000000645213152512335014042 0ustar liggesusers# Copyright (C) 2006 David Firth # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ "quick.glm.fit" <- ## A wrapper for glm.fit, which is much faster when a large number ## of parameters can be eliminated, but which typically (if nIter is small) ## stops before convergence. Useful for getting gnm starting values. ## ## The eliminate argument is assumed numeric (no. of columns in X). No ## check is done here on "eliminability" of the specified columns. ## ## The non-eliminated columns are assumed not to include the intercept (ie ## no column of ones). ## ## When eliminate is used, only the "coefficients" component is returned. ## (for reasons of speed/laziness). This is fine for gnm purposes, but if ## quick.glm.fit is made into a `method' for glm() fits then the result ## needs to have various other components added. ## ## No account is taken of NAs -- will that be a problem, or have they gone by ## the time glm.fit gets called? ## function (x, y, weights = rep(1, length(y)), offset = rep(0, length(y)), family = gaussian(), eliminate = 0, nIter = 2, verbose = FALSE) { if (eliminate == 0) return(suppressWarnings(glm.fit(x, y, weights = weights, offset = offset, family = family)$coef)) ## The rest handles the case of eliminated columns in X xElim <- x[ , seq(eliminate), drop = FALSE] if (eliminate < ncol(x)) xNotElim <- cbind(1, x[ , (eliminate + 1):ncol(x), drop = FALSE]) else xNotElim <- matrix(1, nrow(x), 1) os.by.level <- numeric(eliminate) model <- suppressWarnings(glm.fit(xNotElim, y, weights = weights, offset = offset, family = family, control = glm.control(maxit = 1))) for (i in 1:nIter) { if (verbose) cat("quick.glm.fit iteration", i, "deviance =", deviance(model), "\n") w <- xElim * model$weights wz <- w * model$residuals os.by.level <- os.by.level + colSums(wz)/colSums(w) + coef(model)[1] os.vec <- offset + colSums(os.by.level * t(xElim)) model <- suppressWarnings(glm.fit(xNotElim, y, weights = weights, offset = os.vec, etastart = model$linear.predictors, family = family, control = glm.control(maxit = 2))) } structure(c(os.by.level + coef(model)[1], coef(model)[-1]), names = colnames(x)) } gnm/R/summary.gnm.R0000744000176200001440000001027313311205306013632 0ustar liggesusers# Modification of summary.glm from the stats package for R. # # Copyright (C) 1995-2005 The R Core Team # Copyright (C) 2005, 2006, 2010, 2015 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ summary.gnm <- function (object, dispersion = NULL, correlation = FALSE, symbolic.cor = FALSE, with.eliminate = FALSE, ...) { est.disp <- (!object$family$family %in% c("poisson", "binomial") && is.null(dispersion) && object$df.residual > 0) coefs <- parameters(object) if (with.eliminate) coefs <- c(attr(coef(object), "eliminated"), coefs) if (object$rank > 0) { cov.scaled <- vcov(object, dispersion = dispersion, with.eliminate = with.eliminate) ## non-eliminated par only if (nrow(cov.scaled)) { estimable <- checkEstimable(object, ...) estimable[is.na(estimable)] <- FALSE } if (is.matrix(cov.scaled)) sterr <- sqrt(diag(cov.scaled)) else sterr <- diag(cov.scaled) if (length(sterr)) is.na(sterr[!estimable]) <- TRUE if (with.eliminate){ ## check estimability of eliminated coefficients X <- cbind(1, model.matrix(object)[,!is.na(coef(object))]) estimable2 <- vapply(split(seq_len(nrow(X)), object$eliminate), function(i) { quickRank(X[i, , drop = FALSE]) == quickRank(X[i, -1, drop = FALSE]) + 1}, TRUE) sterr <- c(ifelse(estimable2, sqrt(attr(cov.scaled, "varElim")), NA), sterr) } tvalue <- coefs/sterr dn <- c("Estimate", "Std. Error") if (!est.disp) { pvalue <- 2 * pnorm(-abs(tvalue)) coef.table <- cbind(coefs, sterr, tvalue, pvalue) dimnames(coef.table) <- list(names(coefs), c(dn, "z value", "Pr(>|z|)")) } else if (object$df.residual > 0) { pvalue <- 2 * pt(-abs(tvalue), object$df.residual) coef.table <- cbind(coefs, sterr, tvalue, pvalue) dimnames(coef.table) <- list(names(coefs), c(dn, "t value", "Pr(>|t|)")) } else { coef.table <- cbind(coefs, Inf) dimnames(coef.table) <- list(names(coefs), dn) } } else { coef.table <- matrix(, 0, 4) dimnames(coef.table) <- list(NULL, c("Estimate", "Std. Error", "t value", "Pr(>|t|)")) cov.scaled <- matrix(, 0, 0) } df.f <- nrow(coef.table) non.elim <- seq_along(object$coef) + nlevels(object$eliminate) * with.eliminate elim <- seq(length.out = nlevels(object$eliminate) * with.eliminate) ans <- c(object[c("call", "ofInterest", "family", "deviance", "aic", "df.residual", "iter")], list(deviance.resid = residuals(object, type = "deviance"), coefficients = coef.table[non.elim, , drop = FALSE], eliminated = coef.table[elim, , drop = FALSE], dispersion = attr(cov.scaled, "dispersion"), df = c(object$rank, object$df.residual, df.f), cov.scaled = as.matrix(cov.scaled))) if (correlation & object$rank > 0) { dd <- sqrt(diag(cov.scaled)) ans$correlation <- cov.scaled/outer(dd, dd) ans$symbolic.cor <- symbolic.cor } class(ans) <- "summary.gnm" ans } gnm/R/boxcox.gnm.R0000744000176200001440000000143213152512335013442 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ boxcox.gnm <- function (object, ...) { if (inherits(object, "gnm", TRUE) == 1) stop("boxcox is not implemented for gnm objects") else NextMethod } gnm/R/prattle.R0000744000176200001440000000125013152512335013031 0ustar liggesusers# Copyright (C) 2005 David Firth # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ prattle <- function(...) { cat(...) flush.console() } gnm/R/wedderburn.R0000744000176200001440000000437513152512335013532 0ustar liggesusers# Modification of binomial from the stats package for R. # # Copyright (C) 1995-2005 The R Core Team # Copyright (C) 2005 David Firth # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ "wedderburn" <- function (link = "logit") { linktemp <- substitute(link) if (!is.character(linktemp)) { linktemp <- deparse(linktemp) if (linktemp == "link") linktemp <- eval(link) } if (any(linktemp == c("logit", "probit", "cloglog"))) stats <- make.link(linktemp) else stop(paste(linktemp, "link not available for wedderburn quasi-family;", "available links are", "\"logit\", \"probit\" and \"cloglog\"")) variance <- function(mu) mu^2 * (1-mu)^2 validmu <- function(mu) { all(mu > 0) && all(mu < 1)} dev.resids <- function(y, mu, wt){ eps <- 0.0005 2 * wt * (y/mu + (1 - y)/(1 - mu) - 2 + (2 * y - 1) * log((y + eps)*(1 - mu)/((1- y + eps) * mu))) } aic <- function(y, n, mu, wt, dev) NA initialize <- expression({ if (any(y < 0 | y > 1)) stop(paste( "Values for the wedderburn family must be in [0,1]")) n <- rep.int(1, nobs) mustart <- (y + 0.1)/1.2 }) structure(list(family = "wedderburn", link = linktemp, linkfun = stats$linkfun, linkinv = stats$linkinv, variance = variance, dev.resids = dev.resids, aic = aic, mu.eta = stats$mu.eta, initialize = initialize, validmu = validmu, valideta = stats$valideta), class = "family") } gnm/R/expandCategorical.R0000744000176200001440000000376713152512335015012 0ustar liggesusers# Copyright (C) 2006, 2009, 2013, 2014 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ expandCategorical <- function(data, catvar, sep = ".", countvar = "count", idvar = "id", as.ordered = FALSE, group = TRUE) { cat <- interaction(data[catvar], sep = sep) ncat <- nlevels(cat) covar <- data[, -match(catvar, names(data)), drop = FALSE] catvar <- paste(catvar, collapse = sep) if (group == TRUE) { if (length(covar)) { ord <- do.call("order", covar) vars <- covar[ord, , drop = FALSE] dupvars <- duplicated(vars) d <- diff(c(which(!dupvars), length(dupvars) + 1)) n <- sum(!dupvars) id <- factor(rep(seq(n), d)) counts <- as.data.frame(table(list(cat = cat[ord], id = id))) newData <- vars[which(!dupvars)[counts$id], , drop = FALSE] rownames(newData) <- NULL newData[c(catvar, idvar, countvar)] <- counts } else { newData <- data.frame(table(cat)) colnames(newData) <- c(catvar, countvar) newData[[idvar]] <- factor(1) } } else { n <- nrow(covar) id <- gl(n, ncat) newData <- covar[id, , drop = FALSE] newData[[catvar]] <- gl(ncat, 1, n * ncat, labels = levels(cat), ordered = as.ordered) newData[[countvar]] <- as.vector(t(class.ind(cat))) newData[[idvar]] <- id } newData } gnm/R/weights.gnm.R0000744000176200001440000000147713152512335013623 0ustar liggesusers# Copyright (C) 2008 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ weights.gnm <- function(object, type = c("prior", "working"), ...) { weights <- NextMethod("weights") if (!is.null(object$table.attr)) attributes(weights) <- object$table.attr weights } gnm/R/quickRank.R0000744000176200001440000000174613152512335013320 0ustar liggesusers# as tolNorm2 method in rankMatrix from the Matrix package, but avoids validity # checks - much faster if need to do repeated rank calculations # # Copyright (C) 2007 Martin Maechler # Copyright (C) 2010 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ quickRank <- function(X, tol = NULL) { sval <- svd(X, 0, 0)$d if (is.null(tol)) sum(sval >= max(dim(X)) * .Machine$double.eps * sval[1]) else sum(sval >= tol) } gnm/R/anova.gnm.R0000744000176200001440000001015313311200274013235 0ustar liggesusers# Modification of anova.glm from the stats package for R. # # Copyright (C) 1995-2005 The R Core Team # Copyright (C) 2005, 2006, 2008, 2012 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ anova.gnm <- function (object, ..., dispersion = NULL, test = NULL) { dotargs <- list(...) named <- if (is.null(names(dotargs))) rep(FALSE, length(dotargs)) else (names(dotargs) != "") if (any(named)) warning("the following arguments to 'anova.gnm' ", "are invalid and dropped: ", paste(deparse(dotargs[named]), collapse = ", ")) dotargs <- dotargs[!named] is.gnm <- unlist(lapply(dotargs, function(x) inherits(x, c("gnm", "glm")))) dotargs <- dotargs[is.gnm] if (length(dotargs) > 0) return(anova(structure(c(list(object), dotargs), class="glmlist"), dispersion = dispersion, test = test)) x <- model.matrix(object) varlist <- attr(terms(object), "term.labels") varseq <- attr(x, "assign") pars <- setdiff(unique(varseq), c(0, varseq[object$constrain])) nvars <- length(varlist) nonlinear <- match(TRUE, attr(terms(object), "type") != "Linear") if (is.na(nonlinear)) nonlinear <- nvars + 1 resdev <- resdf <- fit <- NULL origConstrain <- object$constrain origConstrainTo <- object$constrainTo if (nvars > 0) { for (i in pars) { if (i < nonlinear && is.null(object$eliminate)){ fit <- glm.fit(x = x[, varseq < i, drop = FALSE], y = c(object$y), offset = c(object$offset), start = object$start, weights = c(object$prior.weights), family = object$family) } else { f <- update.formula(formula(object), paste(". ~ . -", paste(varlist[i:nvars], collapse = " - "))) f <- update.formula(formula(object), f) fit <- update(object, formula = f, verbose = FALSE) } resdev <- c(resdev, fit$deviance) resdf <- c(resdf, fit$df.residual) } resdf <- c(resdf, object$df.residual) resdev <- c(resdev, object$deviance) table <- data.frame(c(NA, -diff(resdf)), c(NA, pmax(0, -diff(resdev))), resdf, resdev) } else table <- data.frame(NA, NA, object$df.residual, object$deviance) dimnames(table) <- list(c("NULL", labels(object)), c("Df", "Deviance", "Resid. Df", "Resid. Dev")) title <- paste("Analysis of Deviance Table", "\n\nModel: ", object$family$family, ", link: ", object$family$link, "\n\nResponse: ", as.character(formula(object)[[2]]), "\n\nTerms added sequentially (first to last)\n\n", sep = "") df.dispersion <- Inf if (is.null(dispersion)) { dispersion <- attr(vcov(object), "dispersion") df.dispersion <- if (dispersion == 1) Inf else object$df.residual } if (!is.null(test)) table <- stat.anova(table = table, test = test, scale = dispersion, df.scale = df.dispersion, n = NROW(x)) structure(table, heading = title, class = c("anova", "data.frame")) } gnm/R/plot.gnm.R0000744000176200001440000002601513311213141013110 0ustar liggesusers# Modification of plot.lm from the stats package for R. # # Copyright (C) 1995-2005 The R Core Team # Copyright (C) 2005, 2006, 2008 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ plot.gnm <- function (x, which = c(1:3, 5), caption = c("Residuals vs Fitted", "Normal Q-Q", "Scale-Location", "Cook's distance", "Residuals vs Leverage"), panel = if (add.smooth) panel.smooth else points, sub.caption = NULL, main = "", ask = prod(par("mfcol")) < length(which) && dev.interactive(), ..., id.n = 3, labels.id = names(residuals(x)), cex.id = 0.75, qqline = TRUE, cook.levels = c(0.5, 1.0), add.smooth = getOption("add.smooth"), label.pos = c(4, 2), cex.caption = 1) { if (!is.numeric(which) || any(which < 1) || any(which > 5)) stop("'which' must be in 1:5") show <- rep(FALSE, 5) show[which] <- TRUE r <- residuals(x) yh <- predict(x) # != fitted() for glm w <- weights(x) if (!is.null(w)) { # drop obs with zero wt: PR#6640 wind <- w != 0 r <- r[wind] yh <- yh[wind] w <- w[wind] labels.id <- labels.id[wind] } n <- length(r) if (any(show[2:5])) { s <- sqrt(deviance(x)/df.residual(x)) hii <- c(hatvalues(x)) if (any(show[4:5])) { cook <- c(cooks.distance(x)) } } if (any(show[2:3])) { ylab23 <- "Std. deviance resid." r.w <- if (is.null(w)) r else sqrt(w) * r } if (show[5]) { ylab5 <- "Std. Pearson resid." r.w <- residuals(x, "pearson") if(!is.null(w)) r.w <- r.w[wind] # drop 0-weight cases r.hat <- range(hii, na.rm = TRUE) # though should never have NA isConst.hat <- all(r.hat == 0) || diff(r.hat) < 1e-10 * mean(hii) } dropInf <- function(x) { if(any(isInf <- is.infinite(x))) { warning("Not plotting observations with leverage one:\n ", paste(which(isInf), collapse=", ")) x[isInf] <- NaN } x } if (any(show[c(2:3,5)])) rs <- dropInf( r.w/(s * sqrt(1 - hii)) ) if (any(show[c(1, 3)])) l.fit <- "Predicted values" if (is.null(id.n)) id.n <- 0 else { id.n <- as.integer(id.n) if (id.n < 0 || id.n > n) stop(gettextf("'id.n' must be in {1,..,%d}", n), domain = NA) } if (id.n > 0) { ## label the largest residuals if (is.null(labels.id)) labels.id <- paste(1:n) iid <- 1:id.n show.r <- sort.list(abs(r), decreasing = TRUE)[iid] if (any(show[2:3])) show.rs <- sort.list(abs(rs), decreasing = TRUE)[iid] text.id <- function(x, y, ind, adj.x = TRUE) { labpos <- if (adj.x) label.pos[1 + as.numeric(x > mean(range(x)))] else 3 text(x, y, labels.id[ind], cex = cex.id, xpd = TRUE, pos = labpos, offset = 0.25) } } getCaption <- function(k) # allow caption = "" , plotmath etc as.graphicsAnnot(unlist(caption[k])) if (is.null(sub.caption)) { ## construct a default: cal <- x$call if (!is.na(m.f <- match("formula", names(cal)))) { cal <- cal[c(1, m.f)] names(cal)[2] <- "" # drop " formula = " } cc <- deparse(cal, 80) # (80, 75) are ``parameters'' nc <- nchar(cc[1], "c") abbr <- length(cc) > 1 || nc > 75 sub.caption <- if (abbr) paste(substr(cc[1], 1, min(75, nc)), "...") else cc[1] } one.fig <- prod(par("mfcol")) == 1 if (ask) { oask <- devAskNewPage(TRUE) on.exit(devAskNewPage(oask)) } ##---------- Do the individual plots : ---------- if (show[1]) { ylim <- range(r, na.rm = TRUE) if (id.n > 0) ylim <- extendrange(r = ylim, f = 0.08) plot(yh, r, xlab = l.fit, ylab = "Residuals", main = main, ylim = ylim, type = "n", ...) panel(yh, r, ...) if (one.fig) title(sub = sub.caption, ...) mtext(getCaption(1), 3, 0.25, cex = cex.caption) if (id.n > 0) { y.id <- r[show.r] y.id[y.id < 0] <- y.id[y.id < 0] - strheight(" ")/3 text.id(yh[show.r], y.id, show.r) } abline(h = 0, lty = 3, col = "gray") } if (show[2]) { ## Normal ylim <- range(rs, na.rm = TRUE) ylim[2] <- ylim[2] + diff(ylim) * 0.075 qq <- qqnorm(rs, main = main, ylab = ylab23, ylim = ylim, ...) if (qqline) qqline(rs, lty = 3, col = "gray50") if (one.fig) title(sub = sub.caption, ...) mtext(getCaption(2), 3, 0.25, cex = cex.caption) if (id.n > 0) text.id(qq$x[show.rs], qq$y[show.rs], show.rs) } if (show[3]) { sqrtabsr <- sqrt(abs(rs)) ylim <- c(0, max(sqrtabsr, na.rm = TRUE)) yl <- as.expression(substitute(sqrt(abs(YL)), list(YL = as.name(ylab23)))) yhn0 <- if (is.null(w)) yh else yh[w != 0] plot(yhn0, sqrtabsr, xlab = l.fit, ylab = yl, main = main, ylim = ylim, type = "n", ...) panel(yhn0, sqrtabsr, ...) if (one.fig) title(sub = sub.caption, ...) mtext(getCaption(3), 3, 0.25, cex = cex.caption) if (id.n > 0) text.id(yhn0[show.rs], sqrtabsr[show.rs], show.rs) } if (show[4]) { if (id.n > 0) { show.r <- order(-cook)[iid]# index of largest 'id.n' ones ymx <- cook[show.r[1]] * 1.075 } else ymx <- max(cook, na.rm = TRUE) plot(cook, type = "h", ylim = c(0, ymx), main = main, xlab = "Obs. number", ylab = "Cook's distance", ...) if (one.fig) title(sub = sub.caption, ...) mtext(getCaption(4), 3, 0.25, cex = cex.caption) if (id.n > 0) text.id(show.r, cook[show.r], show.r, adj.x = FALSE) } if (show[5]) { ylim <- range(rs, na.rm = TRUE) if (id.n > 0) { ylim <- extendrange(r = ylim, f = 0.08) show.r <- order(-cook)[iid] } do.plot <- TRUE if (isConst.hat) {## leverages are all the same caption[5] <- "Constant Leverage:\n Residuals vs Factor Levels" ## plot against factor-level combinations instead aterms <- attributes(terms(x)) ## classes w/o response dcl <- aterms$dataClasses[-aterms$response] facvars <- names(dcl)[dcl %in% c("factor", "ordered")] mf <- model.frame(x)[facvars]# better than x$model if(ncol(mf) > 0) { ## now re-order the factor levels *along* factor-effects ## using a "robust" method {not requiring dummy.coef}: effM <- mf for(j in seq_len(ncol(mf))) effM[, j] <- vapply(split(yh, mf[, j]), mean, 1)[mf[, j]] ord <- do.call(order, effM) dm <- data.matrix(mf)[ord, , drop = FALSE] ## #{levels} for each of the factors: nf <- length(nlev <- unlist(unname(lapply(x$xlevels, length)))) ff <- if(nf == 1) 1 else rev(cumprod(c(1, nlev[nf:2]))) facval <- ((dm-1) %*% ff) ## now reorder to the same order as the residuals facval[ord] <- facval xx <- facval # for use in do.plot section. plot(facval, rs, xlim = c(-1/2, sum((nlev-1) * ff) + 1/2), ylim = ylim, xaxt = "n", main = main, xlab = "Factor Level Combinations", ylab = ylab5, type = "n", ...) axis(1, at = ff[1]*(1:nlev[1] - 1/2) - 1/2, labels= x$xlevels[[1]][order(vapply(split(yh,mf[,1]), mean, 1))]) mtext(paste(facvars[1],":"), side = 1, line = 0.25, adj=-.05) abline(v = ff[1]*(0:nlev[1]) - 1/2, col="gray", lty="F4") panel(facval, rs, ...) abline(h = 0, lty = 3, col = "gray") } else { # no factors message("hat values (leverages) are all = ", format(mean(r.hat)), "\n and there are no factor predictors; no plot no. 5") frame() do.plot <- FALSE } } else { ## Residual vs Leverage xx <- hii ## omit hatvalues of 1. xx[xx >= 1] <- NA plot(xx, rs, xlim = c(0, max(xx, na.rm = TRUE)), ylim = ylim, main = main, xlab = "Leverage", ylab = ylab5, type = "n", ...) panel(xx, rs, ...) abline(h = 0, v = 0, lty = 3, col = "gray") if (one.fig) title(sub = sub.caption, ...) if (length(cook.levels)) { p <- length(coef(x)) usr <- par("usr") hh <- seq.int(min(r.hat[1], r.hat[2]/100), usr[2], length.out = 101) for (crit in cook.levels) { cl.h <- sqrt(crit * p * (1 - hh)/hh) lines(hh, cl.h, lty = 2, col = 2) lines(hh, -cl.h, lty = 2, col = 2) } legend("bottomleft", legend = "Cook's distance", lty = 2, col = 2, bty = "n") xmax <- min(0.99, usr[2]) ymult <- sqrt(p * (1 - xmax)/xmax) aty <- c(-sqrt(rev(cook.levels)) * ymult, sqrt(cook.levels) * ymult) axis(4, at = aty, labels = paste(c(rev(cook.levels), cook.levels)), mgp = c(.25, .25, 0), las = 2, tck = 0, cex.axis = cex.id, col.axis = 2) } } # if(const h_ii) .. else .. if (do.plot) { mtext(getCaption(5), 3, 0.25, cex = cex.caption) if (id.n > 0) { y.id <- rs[show.r] y.id[y.id < 0] <- y.id[y.id < 0] - strheight(" ")/3 text.id(xx[show.r], y.id, show.r) } } } if (!one.fig && par("oma")[3] >= 1) mtext(sub.caption, outer = TRUE, cex = 1.25) invisible() } gnm/R/addterm.gnm.R0000744000176200001440000000143413152512335013562 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ addterm.gnm <- function (object, ...) { if (inherits(object, "gnm", TRUE) == 1) stop("addterm is not implemented for gnm objects") else NextMethod } gnm/R/print.summary.gnm.R0000744000176200001440000000720013152512335014767 0ustar liggesusers# Modification of print.summary.glm from the stats package for R. # # Copyright (C) 1995-2006 The R Core Team # Copyright (C) 2006, 2008, 2009, 2015 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ print.summary.gnm <- function (x, digits = max(3, getOption("digits") - 3), signif.stars = getOption("show.signif.stars"), symbolic.cor = x$symbolic.cor, ...) { cat("\nCall:\n", deparse(x$call), "\n", sep = "", fill = TRUE) cat("Deviance Residuals: \n") if (length(x$deviance.resid) > 5) { x$deviance.resid <- quantile(x$deviance.resid, na.rm = TRUE) names(x$deviance.resid) <- c("Min", "1Q", "Median", "3Q", "Max") } print.default(x$deviance.resid, digits = digits, na.print = "", print.gap = 2) tidy.zeros <- function(vec) ifelse(abs(vec) < 100 * .Machine$double.eps, 0, vec) coefs <- tidy.zeros(coef(x)) if (length(ofInterest(x)) > 0) coefs <- coefs[ofInterest(x), , drop = FALSE] non.elim <- length(coefs) elim <- length(x$eliminated) if (non.elim | elim) { cat("\nCoefficients", " of interest"[!is.null(ofInterest(x))], ":\n", sep = "") printCoefmat(coefs, digits = digits, signif.stars = signif.stars, signif.legend = !elim, na.print = "NA", ...) if (elim){ cat("\nEliminated coefficients:\n", sep = "") printCoefmat(x$eliminated, digits = digits, signif.stars = signif.stars, na.print = "NA", ...) } coefs <- c(coefs[,2], x$eliminated[,2]) if (any(!is.na(coefs))) cat("\n(Dispersion parameter for ", x$family$family, " family taken to be ", format(x$dispersion), ")\n", sep = "") if (any(is.na(coefs))) cat("\nStd. Error is NA where coefficient has been constrained or", "is unidentified\n") } else cat("\nNo coefficients", " of interest"[!is.null(ofInterest(x))], ". \n\n", sep = "") cat("\nResidual deviance: ", format(x$deviance, digits = max(5, digits + 1)), " on ", format(x$df.residual, digits = max(5, digits + 1)), " degrees of freedom\n", "AIC: ", format(x$aic, digits = max(4, digits + 1)), "\n\n", "Number of iterations: ", x$iter, "\n", sep = "") correl <- x$correlation if (!is.null(correl)) { if (attr(x$cov.scaled, "eliminate")) { eliminate <- seq(attr(x$cov.scaled, "eliminate")) correl <- correl[-eliminate, -eliminate] } p <- NCOL(correl) if (p > 1) { cat("\nCorrelation of Coefficients:\n") if (is.logical(symbolic.cor) && symbolic.cor) { print(symnum(correl, abbr.colnames = NULL)) } else { correl <- format(round(correl, 2), nsmall = 2, digits = digits) correl[!lower.tri(correl)] <- "" print(correl[-1, -p, drop = FALSE], quote = FALSE) } } } cat("\n") invisible(x) } gnm/R/getData.R0000744000176200001440000000146613311213547012740 0ustar liggesusers# Copyright (C) 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ getData <- function() { nFrame <- match(TRUE, vapply(sys.calls(), function(x) { identical(x[[1]], as.name("gnmTerms"))}, TRUE)) get("data", sys.frame(nFrame)) } gnm/R/glm.fit.e.R0000744000176200001440000001466513311426207013156 0ustar liggesusers# This fits a glm with eliminated factor, and should be much quicker # than glm.fit when the number of levels of the eliminated factor is large. # # Copyright (C) 2009, 2010, 2012 David Firth and Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ glm.fit.e <- function( x, y, weights = rep(1, NROW(y)), start = NULL, etastart = NULL, mustart = NULL, offset = rep(0, NROW(y)), family = gaussian(), control = glm.control(), ## only for compatibility with glm.fit intercept = TRUE, ## only for compatibility with glm.fit eliminate = NULL, ## alternatively a factor ridge = 1e-8, coefonly = FALSE) { if (is.null(eliminate)) { ## just revert to glm.fit ## can make a difference in timing! tmp <- glm.fit(x, y, weights = weights, start = start, etastart = etastart, mustart = mustart, offset = offset, family = family, control = control, intercept = intercept) if (coefonly) return(tmp$coef) else return(tmp) } ## The rest handles the case of an eliminated factor names(y) <- rownames(x) <- NULL nobs <- NROW(y) non.elim <- ncol(x) if (is.null(weights)) weights <- rep.int(1, nobs) if (is.null(offset)) offset <- rep.int(0, nobs) link <- family$linkfun linkinv <- family$linkinv linkder <- family$mu.eta variance <- family$variance dev.resids <- family$dev.resids aic <- family$aic ## sort data to help compute group means quickly ord <- order(xtfrm(eliminate)) if (ordTRUE <- !identical(ord, seq(eliminate))) { y <- as.numeric(y[ord]) weights <- weights[ord] offset <- offset[ord] if (non.elim) x <- x[ord, , drop = FALSE] eliminate <- eliminate[ord] } size <- tabulate(eliminate) end <- cumsum(size) nelim <- rank <- nlevels(eliminate) elim <- seq.int(nelim) if (is.null(start)) { # use either y or etastart or mustart if (!is.null(etastart)) mustart <- linkinv(etastart) if (!is.null(mustart)) z <- mustart else z <- y elim.means <- grp.sum(z, end)/size os.by.level <- link(0.999 * elim.means + 0.001 * mean(z)) - grp.sum(offset, end)/size } else os.by.level <- start[elim] os.vec <- os.by.level[eliminate] eta.stored <- eta <- offset + os.vec mu <- linkinv(eta) mu.eta <- linkder(eta) z <- eta - offset + (y - mu) / mu.eta w <- weights * (mu.eta)^2/variance(mu) counter <- 0 devold <- 0 if (intercept) x <- x[, -1, drop = FALSE] #non-null eliminate if (non.elim) { ## sweeps needed to get the rank right subtracted <- rowsum.default(x, eliminate, reorder = FALSE)/size x <- x - subtracted[eliminate, , drop = FALSE] ## initial fit to drop aliased columns model <- lm.wfit(x, z, w, offset = os.vec) full.theta <- model$coefficients eta <- model$fitted + offset rank <- model$rank + nelim rm(model) mu <- linkinv(eta) mu.eta <- linkder(eta) z <- eta - offset + (y - mu) / mu.eta w <- weights * (mu.eta)^2/variance(mu) est <- !is.na(full.theta) x <- x[, est, drop = FALSE] theta <- full.theta[est] } Z <- cbind(z, x) I1 <- numeric(ncol(Z)) I1[1] <- 1 for (i in 1:control$maxit) { ## try without scaling etc - already of full rank Tvec <- sqrt(grp.sum(w, end)) Umat <- rowsum.default(w * Z, eliminate, reorder = FALSE) Umat <- Umat/Tvec Wmat <- crossprod(sqrt(w) * Z) diag(Wmat) <- diag(Wmat) + ridge Qi <- solve(Wmat - crossprod(Umat), I1) theta <- -Qi[-1]/Qi[1] os.by.level <- ((Umat %*% Qi)/Qi[1])/Tvec if (non.elim) eta <- drop(x %*% theta + offset + os.by.level[eliminate]) else eta <- offset + os.by.level[eliminate] mu <- linkinv(eta) dev <- sum(dev.resids(y, mu, weights)) if (control$trace) cat("Deviance =", dev, "Iterations -", i, "\n") if (abs(dev - devold)/(0.1 + abs(dev)) < control$epsilon) { conv <- TRUE break } devold <- dev mu.eta <- linkder(eta) Z[,1] <- eta - offset + (y - mu) / mu.eta w <- weights * (mu.eta)^2/variance(mu) } converged <- !(i == control$maxit) if (!converged) warning(paste("The convergence criterion was not met after", control$maxit, "iterations.")) names(os.by.level) <- paste("(eliminate)", elim, sep = "") if (non.elim) { full.theta[est] <- theta os.by.level <- os.by.level - subtracted %*% naToZero(full.theta) } else full.theta <- numeric(0) if (ordTRUE) { reorder <- order(ord) y <- y[reorder] mu <- mu[reorder] eta <- eta[reorder] weights <- weights[reorder] } mu.eta <- linkder(eta) w <- weights * (mu.eta)^2/variance(mu) if (coefonly) return(structure(full.theta, eliminated = c(os.by.level))) aic.model <- aic(y, sum(weights > 0), mu, weights, dev) + 2 * rank eliminated <- structure(c(os.by.level), names = levels(eliminate)) list(coefficients = structure(full.theta, eliminated = eliminated), residuals = (y - mu) / linkder(eta), fitted.values = mu, rank = rank, family = family, linear.predictors = eta, deviance = dev, aic = aic.model, iter = i, weights = w, prior.weights = weights, df.residual = nobs - sum(weights == 0) - rank, y = y, converged = converged) ## NB: some components of the result of glm.fit are missing from this list } gnm/R/print.profile.gnm.R0000744000176200001440000000220113311212000014705 0ustar liggesusers# Copyright (C) 2006, 2008, 2009 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ print.profile.gnm <- function (x, digits = max(3, getOption("digits") - 3), ...) { #if (attr(x, "eliminate")) # coefs <- coefs[-seq(attr(x$cov.scaled, "eliminate")), ] if (length(x)) { if (any(vapply(x, function(x) isTRUE(is.na(x)), TRUE))) cat("\nProfile is NA where coefficient has been constrained or", "is unidentified\n\n") print.default(x) } else cat("\nNo coefficients profiled.\n\n", sep = "") invisible(x) } gnm/R/dfbeta.gnm.R0000744000176200001440000000143013152512335013363 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ dfbeta.gnm <- function (model, ...) { if (inherits(model, "gnm", TRUE) == 1) stop("dfbeta is not implemented for gnm objects") else NextMethod } gnm/R/meanResiduals.R0000744000176200001440000000672413311213263014160 0ustar liggesusers# Copyright (C) 2010, 2012, 2013 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ meanResiduals <- function(object, by = NULL, standardized = TRUE, as.table = TRUE, ...){ if (is.null(by)) stop("`by' must be specified in order to compute grouped residuals") if (inherits(by, "formula")){ ## check single factor only if (ncol(attr(terms(by), "factors")) != 1) stop("`by' should only specify a single term") ## find factors as in mosaic.glm (own code) by <- do.call("model.frame", list(formula = by, data = object$data, subset = object$call$subset, na.action = na.pass, drop.unused.levels = TRUE)) ## following loop needed due to bug in model.frame.default ## (fixed for R 2.12) for(nm in names(by)) { f <- by[[nm]] if(is.factor(f) && length(unique(f[!is.na(f)])) < length(levels(f))) by[[nm]] <- by[[nm]][, drop = TRUE] } if (!is.null(object$na.action)) by <- by[-object$na.action,] } if (!all(vapply(by, is.factor, TRUE))) warning("Coercing variables specified by `by' to factors") fac <- factor(interaction(by)) # drop unused levels if (length(fac) != length(object$y)) stop("Grouping factor of length", length(fac), "but model frame of length", length(object$y)) r <- object$residuals ## recompute weights for better accuracy w <- as.numeric(object$prior.weights * object$family$mu.eta(predict(object, type = "link"))^2/ object$family$variance(object$fitted)) #unlike rowsum, following keeps all levels of interaction agg.wts <- tapply(w, by, sum) res <- tapply(r * w, by, sum)/agg.wts if (standardized) res <- res * sqrt(agg.wts) ## now compute degrees of freedom Xreduced <- rowsum(model.matrix(object), fac, na.rm = TRUE) ## suppressWarnings in rankMatrix re coercion to dense matrix if (as.table){ res <- structure(as.table(res), call = object$call, by = paste(names(by), collapse = ":"), df = nlevels(fac) - suppressWarnings(rankMatrix(Xreduced)), standardized = standardized, weights = as.table(agg.wts)) class(res) <- c("meanResiduals", "table") } else { res <- structure(c(res), call = object$call, by = paste(names(by), collapse = ":"), df = nlevels(fac) - suppressWarnings(rankMatrix(Xreduced)), standardized = standardized, weights = c(agg.wts)) class(res) <- c("meanResiduals", "numeric") } return(res) } gnm/R/dfbetas.gnm.R0000744000176200001440000000143213152512335013550 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ dfbetas.gnm <- function (model, ...) { if (inherits(model, "gnm", TRUE) == 1) stop("dfbetas is not implemented for gnm objects") else NextMethod } gnm/R/print.meanResiduals.R0000744000176200001440000000212613311200272015277 0ustar liggesusers# Copyright (C) 2010-2012 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ print.meanResiduals <- function (x, digits = max(3, getOption("digits") - 3), ...) { cat("\nModel call:\n", deparse(attr(x, "call"), width.cutoff = options()$width), "\n", sep = "", fill = TRUE) cat("Mean residuals by ", attr(x, "by"), ":\n\n", sep = "") if (!inherits(x, "table")) x <- as.numeric(x) NextMethod(object = x, digits = digits, print.gap = 2, ...) } gnm/R/profile.gnm.R0000744000176200001440000001704513152512335013607 0ustar liggesusers# Modification of profile.glm from the MASS package for R. # # File MASS/profiles.q copyright (C) 1996 D. M. Bates and W. N. Venables. # # port to R by B. D. Ripley copyright (C) 1998 # # corrections copyright (C) 2000,3,6,7 B. D. Ripley # Copyright (C) 2005, 2006, 2008, 2012 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ profile.gnm <- function (fitted, which = ofInterest(fitted), alpha = 0.05, maxsteps = 10, stepsize = NULL, trace = FALSE, ...) { fittedCoef <- parameters(fitted) coefNames <- names(fittedCoef) p <- length(coefNames) if (is.null(which)) which <- 1:p else if (is.numeric(which)) which <- which else if (is.character(which)) which <- match(which, coefNames) summ <- summary(fitted) sterr <- summ$coefficients[, "Std. Error"] fittedDev <- deviance(fitted) disp <- summ$dispersion ## use z cutoffs as in confint.profile.gnm zmax <- abs(qnorm(alpha/2)) fittedConstrain <- fitted$constrain fittedConstrainTo <- fitted$constrainTo auto <- is.null(stepsize) if (!auto) stepsize[1:2] <- stepsize prof <- as.list(rep(NA, length(which))) names(prof) <- coefNames[which] which <- which[!is.na(sterr)[which]] for (i in which) { par <- coefNames[i] prof[[par]] <- numeric(2 * maxsteps + 1) par.vals <- matrix(nrow = 2 * maxsteps + 1, ncol = p, dimnames = list(NULL, coefNames)) par.vals[maxsteps + 1,] <- fittedCoef asymptote <- c(FALSE, FALSE) if (auto) { ## set defaults sub <- 3 # no. of steps from MLE to zmax*se stepsize <- c(zmax/sub * sterr[i], zmax/sub * sterr[i]) ## estimate quadratic in the region MLE +/- zmax*se margin <- zmax * sterr[i] updatedDev <- numeric(2) for (sgn in c(-1, 1)) { val <- fittedCoef[i] + sgn * margin updated <- suppressWarnings(update(fitted, constrain = c(fittedConstrain, i), constrainTo = c(fittedConstrainTo, val), trace = FALSE, verbose = FALSE, start = fittedCoef)) if (is.null(updated)) break updatedDev[(sgn + 1)/2 + 1] <- deviance(updated) prof[[par]][maxsteps + 1 + sgn * sub] <- sgn * sqrt((deviance(updated) - fittedDev)/disp) par.vals[maxsteps + + 1 + sgn * sub,] <- parameters(updated) } if (all(updatedDev != 0)) { quad <- (sum(updatedDev) - 2 * fittedDev)/(2 * margin^2) lin <- (fittedDev - updatedDev[1])/margin + quad * (margin - 2 * fittedCoef[i]) int <- fittedDev - lin * fittedCoef[i] - quad * fittedCoef[i]^2 ## adjust so roots approx where deviance gives z = zmax int.adj <- int - zmax^2 * disp - fittedDev for (sgn in c(-1, 1)) { dir <- (sgn + 1)/2 + 1 root <- (-lin + sgn * sqrt(lin^2 - 4 * int.adj * quad))/ (2 * quad) firstApprox <- par.vals[maxsteps + 1 + sgn * sub, i] ## if likelihood approx quadratic use default stepsize, else if (sgn * (root - firstApprox) > 0) { ## not gone out far enough, check for asymptote val <- fittedCoef[i] + sgn * 10 * sterr[i] updated <- suppressWarnings(update(fitted, constrain = c(fittedConstrain, i), constrainTo = c(fittedConstrainTo, val), trace = FALSE, verbose = FALSE, start = fittedCoef)) if (!is.null(updated) && sqrt((deviance(updated) - fittedDev)/disp) < zmax) asymptote[dir] <- TRUE } ## if root more than one step away from firstApprox, i.e. ## less than two steps away from fittedCoef, halve stepsize if (abs(sgn * (firstApprox - root)) > stepsize[dir] && !asymptote[dir]) { prof[[par]][maxsteps + 1 + sgn * sub] <- 0 par.vals[maxsteps + 1 + sgn * sub, ] <- NA stepsize[dir] <- abs(root - fittedCoef[i])/(maxsteps/2) } } } } for (sgn in c(-1, 1)) { if (trace) prattle("\nParameter:", par, c("down", "up")[(sgn + 1)/2 + 1], "\n") step <- 0 init <- parameters(fitted) while ((step <- step + 1) <= maxsteps) { if (step > 2 && abs(prof[[par]][maxsteps + 1 + sgn * (step - 2)]) > zmax) break if (prof[[par]][maxsteps + 1 + sgn * step] != 0) next val <- fittedCoef[i] + sgn * step * stepsize[(sgn + 1)/2 + 1] updated <- suppressWarnings(update(fitted, constrain = c(fittedConstrain, i), constrainTo = c(fittedConstrainTo, val), trace = FALSE, verbose = FALSE, start = init)) if (is.null(updated)) { message("Could not complete profile for", par, "\n") break } init <- parameters(updated) zz <- (deviance(updated) - fittedDev)/disp if (zz > -0.001) zz <- max(zz, 0) else stop("profiling has found a better solution, ", "so original fit had not converged") prof[[par]][maxsteps + 1 + sgn * step] <- sgn * sqrt(zz) par.vals[maxsteps + 1 + sgn * step,] <- init #print(data.frame(step = step, val = bi, deviance = fm$deviance, #zstat = z)) } } prof[[par]] <- structure(data.frame(prof[[par]][!is.na(par.vals[,1])]), names = "z") prof[[par]]$par.vals <- par.vals[!is.na(par.vals[,1]), , drop = FALSE] attr(prof[[par]], "asymptote") <- asymptote } val <- structure(prof, original.fit = fitted, summary = summ) class(val) <- c("profile.gnm", "profile.glm", "profile") val } gnm/R/model.matrix.gnm.R0000744000176200001440000000226413152512335014547 0ustar liggesusers# Copyright (C) 2005, 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ model.matrix.gnm <- function(object, coef = NULL, ...) { if (!"x" %in% names(object) || !is.null(coef)) { xcall <- object$call xcall$method <- "model.matrix" xcall$constrain <- object$constrain xcall$constrainTo <- object$constrainTo xcall$data <- model.frame(object) xcall[c("weights", "offset")] <- NULL xcall$verbose <- FALSE if (!is.null(coef)) xcall$start <- coef else xcall$start <- coef(object) eval(xcall) } else object[[match("x", names(object))]] } gnm/R/cooks.distance.gnm.R0000744000176200001440000000220113152512335015042 0ustar liggesusers# Modification of cooks.distance.glm from the stats package for R. # # Copyright (C) 1995-2005 The R Core Team # Copyright (C) 2005, 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ cooks.distance.gnm <- function(model, hat = hatvalues(model), dispersion = attr(vcov(model), "dispersion"), ...){ p <- model$rank res <- na.omit(residuals(model, type = "pearson"))[model$prior.weights != 0] res <- naresid(model$na.action, res) res <- (res/(1 - hat))^2 * hat/(dispersion * p) res[is.infinite(res)] <- NaN res } gnm/R/asGnm.lm.R0000744000176200001440000000361313152512335013037 0ustar liggesusers# Copyright (C) 2006, 2008, 2010 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ asGnm.lm <- function(object, ...) { lmExtra <- match(c("effects", "assign", "qr", "contrasts"), names(object)) modelData <- model.frame(object) object[lmExtra] <- NULL object$call[[1]] <- as.name("gnm") constrain <- which(is.na(coef(object))) object <- c(list(formula = formula(object), eliminate = NULL, ofInterest = NULL, na.action = na.action(modelData), constrain = constrain, constrainTo = numeric(length(constrain)), family = gaussian(), predictors = fitted.values(object), deviance = deviance(object), y = model.response(modelData)), object) object$terms <- gnmTerms(object$formula, data = modelData) object$weights <- object$prior.weights <- rep.int(1, length(object$y)) object$aic <- 2 * object$rank + object$family$aic(object$y, object$weights, object$fitted.values, object$weights, object$deviance) if (is.null(object$offset)) object$offset <- rep.int(0, length(coef(object))) object$tolerance <- object$iterStart <- object$iterMax <- object$iter <- object$converged <- "Not available - model fitted by lm()" class(object) <- c("gnm", "glm", "lm") object } gnm/R/hashSplit.R0000744000176200001440000000226513152512335013324 0ustar liggesusers# Copyright (C) 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ hashSplit <- function(string){ ## An adaptation of some Python code by 'tim' ## http://forum.textdrive.com/viewtopic.php?id=3095 if (!length(string) || !nchar(string)) return(string) s <- strsplit(string, "")[[1]] a <- 0 ans <- vector("list", length(s)) iq <- FALSE for (z in seq(s)) { if (s[z] == "#" & !iq) { ans[z] <- paste(s[a:(z - 1)], collapse = "") a <- z + 1 } else if (s[z] == "\""){ iq <- !iq } } ans[z] <- paste(s[a:z], collapse = "") unlist(ans) } gnm/R/unlistOneLevel.R0000744000176200001440000000236413311210342014323 0ustar liggesusers# Copyright (C) 2005 David Firth and Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ unlistOneLevel <- function(theList){ result <- vector(length = sum(vapply(theList, function(x) if(is.list(x)) length(x) else 1, 1)), mode = "list") count <- 0 for (i in seq(theList)){ theItem <- theList[[i]] if (is.list(theItem)){ for (j in seq(theItem)){ count <- count + 1 result[[count]] <- theItem[[j]] } } else { count <- count + 1 result[[count]] <- theItem } } return(result[1:count]) } gnm/R/MultHomog.R0000744000176200001440000000175513152512335013303 0ustar liggesusers# Copyright (C) 2005, 2006, 2008 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ MultHomog <- function(..., inst = NULL){ dots <- match.call(expand.dots = FALSE)[["..."]] list(predictors = dots, common = rep(1, length(dots)), term = function(predLabels, ...) { paste("(", paste(predLabels, collapse = ")*("), ")", sep = "") }, call = as.expression(match.call())) } class(MultHomog) <- "nonlin" gnm/R/updateLinear.R0000744000176200001440000000250713152512335014001 0ustar liggesusers# Copyright (C) 2005, 2006, 2010 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ updateLinear <- function(which, theta, y, mu, eta, offset, weights, family, modelTools, X, eliminate) { dmu <- family$mu.eta(eta) vmu <- family$variance(mu) w <- weights * dmu * dmu / vmu theta[which] <- 0 offsetVarPredictors <- modelTools$varPredictors(theta) offset <- offset + modelTools$predictor(offsetVarPredictors) z <- eta - offset + (y - mu)/dmu if (is.null(eliminate)) naToZero(lm.wfit(X[,which, drop = FALSE], z, w)$coef) else suppressWarnings(glm.fit.e(X[,which, drop = FALSE], z, weights = w, intercept = FALSE, eliminate = eliminate, coefonly = TRUE)) } gnm/R/Mult.R0000744000176200001440000000216213152512335012302 0ustar liggesusers# Copyright (C) 2005, 2006, 2008 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ Mult <- function(..., inst = NULL){ if ("multiplicity" %in% names(match.call()[-1])) stop("multiplicity argument of Mult has been replaced by", "\"inst\" argument.") dots <- match.call(expand.dots = FALSE)[["..."]] list(predictors = dots, term = function(predLabels, ...) { paste("(", paste(predLabels, collapse = ")*("), ")", sep = "") }, call = as.expression(match.call()), match = seq(dots)) } class(Mult) <- "nonlin" gnm/R/gnm.R0000744000176200001440000003505613615612763012164 0ustar liggesusers# Designed to take similar arguments to glm from the stats package from R; # some of the code to handle the arguments is copied/modified from glm. # # Copyright (C) 1995-2005 The R Core Team # Copyright (C) 2005-2010, 2012, 2013 Heather Turner and David Firth # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ gnm <- function(formula, eliminate = NULL, ofInterest = NULL, constrain = numeric(0), #index of non-eliminated parameters constrainTo = numeric(length(constrain)), family = gaussian, data = NULL, subset, weights, na.action, method = "gnmFit", checkLinear = TRUE, offset, start = NULL, etastart = NULL, mustart = NULL, tolerance = 1e-6, iterStart = 2, iterMax = 500, trace = FALSE, verbose = TRUE, model = TRUE, x = TRUE, termPredictors = FALSE, ridge = 1e-8, ...) { call <- match.call() modelTerms <- gnmTerms(formula, substitute(eliminate), data) modelData <- as.list(match.call(expand.dots = FALSE)) if (inherits(data, "table") && missing(na.action)) modelData$na.action <- "na.exclude" argPos <- match(c("eliminate", "data", "subset", "weights", "na.action", "offset", "etastart", "mustart"), names(modelData), 0) modelData <- as.call(c(as.name("model.frame"), formula = modelTerms, modelData[argPos], drop.unused.levels = TRUE)) modelData <- eval(modelData, parent.frame()) eliminate <- modelData$`(eliminate)` if (!is.null(eliminate)) { if (!is.factor(eliminate)) stop("'eliminate' must be a factor") xtf <- xtfrm(modelData$`(eliminate)`) ord <- order(xtf) if (ordTRUE <- !identical(ord, xtf)) { modelData <- modelData[ord, , drop = FALSE] eliminate <- modelData$`(eliminate)` } nElim <- nlevels(eliminate) } else nElim <- 0 if (method == "model.frame") return(modelData) else if (!method %in% c("gnmFit", "coefNames", "model.matrix") && !is.function(get(method))) { warning("function ", method, " can not be found. Using \"gnmFit\".\n", call. = FALSE) method <- "gnmFit" } nobs <- nrow(modelData) y <- model.response(modelData, "any") if (length(dim(y)) == 1L) { nm <- rownames(y) dim(y) <- NULL if (!is.null(nm)) names(y) <- nm } if (is.null(y)) y <- rep(0, nobs) weights <- as.vector(model.weights(modelData)) if (!is.null(weights) && any(weights < 0)) stop("negative weights are not allowed") if (is.null(weights)) weights <- rep.int(1, nobs) offset <- as.vector(model.offset(modelData)) if (is.null(offset)) offset <- rep.int(0, nobs) mustart <- model.extract(modelData, "mustart") etastart <- model.extract(modelData, "etastart") if (is.character(family)) family <- get(family, mode = "function", envir = parent.frame()) if (is.function(family)) family <- family() if (is.null(family$family)) { stop("`family' not recognized") } if (family$family %in% c("binomial", "quasibinomial")) { if (is.factor(y) && NCOL(y) == 1) y <- y != levels(y)[1] else if (NCOL(y) == 2) { n <- y[, 1] + y[, 2] y <- ifelse(n == 0, 0, y[, 1]/n) weights <- weights * n } } if (is.empty.model(modelTerms) && is.null(eliminate)) { if (method == "coefNames") return(numeric(0)) else if (method == "model.matrix") return(model.matrix(modelTerms, data = modelData)) if (!family$valideta(offset)) stop("invalid predictor values in empty model") mu <- family$linkinv(offset) if (!family$validmu(mu)) stop("invalid fitted values in empty model") dmu <- family$mu.eta(offset) dev <- sum(family$dev.resids(y, mu, weights)) modelAIC <- suppressWarnings(family$aic(y, rep.int(1, nobs), mu, weights, dev)) fit <- list(coefficients = numeric(0), constrain = numeric(0), constrainTo = numeric(0), eliminate = NULL, predictors = offset, fitted.values = mu, deviance = dev, aic = modelAIC, iter = 0, weights = weights*dmu^2/family$variance(mu), residuals = (y - mu)/dmu, df.residual = nobs, rank = 0, family = family, prior.weights = weights, y = y, converged = NA) if (x) fit <- c(fit, x = model.matrix(modelTerms, data = modelData)) if (termPredictors) fit <- c(fit, termPredictors = matrix(, nrow(modelData), 0)) } else { onlyLin <- checkLinear && all(attr(modelTerms, "type") == "Linear") if (onlyLin) { if (nElim) { X <- model.matrix(update(modelTerms, . ~ . + 1), modelData) asgn <- attr(X, "assign") X <- X[,-1, drop = FALSE] attr(X, "assign") <- asgn[-1] } else X <- model.matrix(modelTerms, modelData) coefNames <- colnames(X) } else { modelTools <- gnmTools(modelTerms, modelData, method == "model.matrix" | x) coefNames <- names(modelTools$start) } if (method == "coefNames") return(coefNames) nParam <- length(coefNames) if (identical(constrain, "[?]")) call$constrain <- constrain <- unlist(pickFrom(coefNames, edit.setlabels = FALSE, title = "Constrain one or more gnm coefficients", items.label = "Model coefficients:", warningText = "No parameters were specified to constrain", return.indices = TRUE)) if (is.character(constrain)) { res <- match(constrain, coefNames, 0) if (res == 0 && length(constrain) == 1){ constrain <- match(grep(constrain, coefNames), seq_len(nParam), 0) } else constrain <- res } ## dropped logical option if (!all(constrain %in% seq_len(nParam))) stop(" cannot match 'constrain' to non-eliminated parameters. ") if (is.null(start)) start <- rep.int(NA, nElim + nParam) else if (length(start) != nElim + nParam) { if (!is.null(eliminate) && length(start) == nParam) start <- c(rep.int(NA, nElim), start) else stop("length(start) must either equal the no. of parameters\n", "or the no. of non-eliminated parameters.") } if (onlyLin) { if (length(constrain)) { offset <- drop(offset + X[, constrain, drop = FALSE] %*% constrainTo) X[, constrain] <- 0 } if (method == "model.matrix") return(X) } else if (method == "model.matrix"){ theta <- modelTools$start theta[!is.na(start)] <- start[!is.na(start)] theta[constrain] <- constrainTo theta[is.na(theta)] <- seq(start)[is.na(theta)] varPredictors <- modelTools$varPredictors(theta) X <- modelTools$localDesignFunction(theta, varPredictors) attr(X, "assign") <- modelTools$termAssign return(X) } if (!is.numeric(tolerance) || tolerance <= 0) stop("value of 'tolerance' must be > 0") if (!is.numeric(iterMax) || iterMax < 0) stop("maximum number of iterations must be >= 0") if (onlyLin) { if (any(is.na(start))) start <- NULL fit <- glm.fit.e(X, y, weights = weights, start = start, etastart = etastart, mustart = mustart, offset = offset, family = family, control = glm.control(tolerance, iterMax, trace), intercept = attr(modelTerms, "intercept"), eliminate = eliminate) if (sum(is.na(coef(fit))) > length(constrain)) { extra <- setdiff(which(is.na(coef(fit))), constrain) ind <- order(c(constrain, extra)) constrain <- c(constrain, extra)[ind] constrainTo <- c(constrainTo, numeric(length(extra)))[ind] } if (!is.null(fit$null.deviance)) { extra <- match(c("effects", "R", "qr", "null.deviance", "df.null", "boundary"), names(fit)) fit <- fit[-extra] } names(fit)[match("linear.predictors", names(fit))] <- "predictors" fit$constrain <- constrain fit$constrainTo <- constrainTo if (x) { fit$x <- X } if (termPredictors) { modelTools <- gnmTools(modelTerms, modelData) varPredictors <- modelTools$varPredictors(naToZero(coef(fit))) fit$termPredictors <- modelTools$predictor(varPredictors, term = TRUE) } } else if (method != "gnmFit") fit <- do.call(method, list(modelTools = modelTools, y = y, constrain = constrain, constrainTo = constrainTo, eliminate = eliminate, family = family, weights = weights, offset = offset, nobs = nobs, start = start, etastart = etastart, mustart = mustart, tolerance = tolerance, iterStart = iterStart, iterMax = iterMax, trace = trace, verbose = verbose, x = x, termPredictors = termPredictors, ridge = ridge, ...)) else fit <- gnmFit(modelTools = modelTools, y = y, constrain = constrain, constrainTo = constrainTo, eliminate = eliminate, family = family, weights = weights, offset = offset, nobs = nobs, start = start, etastart = etastart, mustart = mustart, tolerance = tolerance, iterStart = iterStart, iterMax = iterMax, trace = trace, verbose = verbose, x = x, termPredictors = termPredictors, ridge = ridge) } if (is.null(fit)) { warning("Algorithm failed - no model could be estimated", call. = FALSE) return() } if (is.null(ofInterest) && !is.null(eliminate)) ofInterest <- seq_len(nParam) if (identical(ofInterest, "[?]")) call$ofInterest <- ofInterest <- pickCoef(fit, warningText = paste("No subset of coefficients selected", "- assuming all are of interest.")) if (is.character(ofInterest)) { if (length(ofInterest) == 1) ofInterest <- match(grep(ofInterest, coefNames), seq_len(nParam), 0) else ofInterest <- match(ofInterest, coefNames, 0) if (!sum(ofInterest)) ofInterest <- seq_len(nParam) } if (!is.null(ofInterest)) { if (!all(ofInterest %in% seq_len(nParam))) stop("'ofInterest' does not specify a subset of the ", "non.eliminated coefficients.") names(ofInterest) <- coefNames[ofInterest] } if (is.null(data)) data <- environment(formula) fit <- c(list(call = call, formula = formula, terms = modelTerms, data = data, eliminate = eliminate, ofInterest = ofInterest, na.action = attr(modelData, "na.action"), xlevels = .getXlevels(modelTerms, modelData), offset = offset, tolerance = tolerance, iterStart = iterStart, iterMax = iterMax), fit) if (!is.null(eliminate) && ordTRUE) { reorder <- order(ord) fit <- within(fit, { y <- y[reorder] fitted.values <- fitted.values[reorder] predictors <- predictors[reorder] residuals <- residuals[reorder] weights <- weights[reorder] prior.weights <- prior.weights[reorder] eliminate <- eliminate[reorder] offset <- offset[reorder] }) modelData <- modelData[reorder, , drop = FALSE] y <- y[reorder] if (x) { asgn <- attr(fit$x, "assign") fit$x <- fit$x[reorder, , drop = FALSE] attr(fit$x, "assign") <- asgn } } asY <- c("predictors", "fitted.values", "residuals", "prior.weights", "weights", "y", "offset") if (inherits(data, "table") && (is.null(fit$na.action) | inherits(fit$na.action, "exclude"))) { attr <- attributes(data) if (!missing(subset)) { ind <- as.numeric(names(y)) lev <- do.call("expand.grid", attr$dimnames)[ind,, drop = FALSE] attr$dimnames <- apply(lev, 2, unique) attr$dim <- unname(vapply(attr$dimnames, length, 1)) } fit$table.attr <- attr } fit[asY] <- lapply(fit[asY], structure, dim = NULL, names = names(y)) if (termPredictors) rownames(fit$termPredictors) <- names(y) if (model) fit$model <- modelData class(fit) <- c("gnm", "glm", "lm") attr(fit, ".Environment") <- environment(gnm) fit } gnm/R/vcov.gnm.R0000744000176200001440000000654213311210067013116 0ustar liggesusers# Code to estimate dispersion from summary.glm from the stats package for R. # # Copyright (C) 1995-2005 The R Core Team # Copyright (C) 2005, 2006, 2010 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ ## returns vcov for the non-eliminated parameters vcov.gnm <- function(object, dispersion = NULL, with.eliminate = FALSE, ...){ if (is.null(dispersion)) { if (any(object$family$family == c("poisson", "binomial"))) dispersion <- 1 else if (object$df.residual > 0) { if (any(object$weights == 0)) warning("observations with zero weight ", "not used for calculating dispersion") dispersion <- sum(object$weights * object$residuals^2)/ object$df.residual } else dispersion <- Inf } constrain <- object$constrain eliminate <- object$eliminate nelim <- nlevels(eliminate) w <- as.vector(object$weights) X <- model.matrix(object) ind <- !(seq_len(ncol(X)) %in% constrain) cov.unscaled <- array(0, dim = rep(ncol(X), 2), dimnames = list(colnames(X), colnames(X))) if (!length(ind)) { if (nelim && with.eliminate) { Ti <- 1/vapply(split(w, eliminate), sum, 1) attr(cov.unscaled, "varElim") <- dispersion * Ti } return(structure(cov.unscaled, dispersion = dispersion, ofInterest = NULL, class = "vcov.gnm")) } if (length(constrain)) X <- X[, -constrain, drop = FALSE] W.X <- sqrt(w) * X if (object$rank == ncol(W.X)) { cov.unscaled[ind, ind] <- chol2inv(chol(crossprod(W.X))) } else { if (is.null(eliminate)) { cov.unscaled[ind, ind] <- MPinv(crossprod(W.X), method = "chol", rank = object$rank) } else { ## try without ridge and generalized inverse of Q Ti <- 1/vapply(split(w, eliminate), sum, 1) U <- rowsum(sqrt(w) * W.X, eliminate) W <- crossprod(W.X) Ti.U <- Ti * U UTU <- crossprod(U, Ti.U) cov.unscaled[ind, ind] <- MPinv(W - UTU, method = "chol", rank = object$rank - nelim) if (with.eliminate) { rownames(Ti.U) <- names(attr(coef(object), "eliminated")) attr(cov.unscaled, "covElim") <- dispersion * -Ti.U %*% cov.unscaled[ind, ind] attr(cov.unscaled, "varElim") <- dispersion * -rowSums(attr(cov.unscaled, "covElim") * Ti.U) + Ti } } } structure(dispersion * cov.unscaled, dispersion = dispersion, ofInterest = ofInterest(object), class = "vcov.gnm") } gnm/R/psum.R0000744000176200001440000000206113152512335012343 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ psum <- function(...) { summandList <- list(...) nSummands <- length(summandList) if (nSummands == 0) return(0) else if (nSummands == 1) return(summandList[[1]]) else { trySum <- try(summandList[[1]] + do.call("Recall", summandList[-1]), silent = TRUE) if (inherits(trySum, "try-error")) stop("addition not implemented for types of argument supplied") else trySum } } gnm/R/gnmStart.R0000744000176200001440000000134213152512335013157 0ustar liggesusers# Copyright (C) 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ gnmStart <- function(n, scale = 0.1) { theta <- runif(n, -1, 1) * scale theta + (-1)^(theta < 0) * scale } gnm/R/logtrans.gnm.R0000744000176200001440000000143613152512335013775 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ logtrans.gnm <- function (object, ...) { if (inherits(object, "gnm", TRUE) == 1) stop("logtrans is not implemented for gnm objects") else NextMethod } gnm/R/termPredictors.default.R0000744000176200001440000000210513152512335016007 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ termPredictors.default <- function(object, ...) { if (is.null(object$termPredictors)){ X <- model.matrix(object) termPredictors <- t(rowsum(t(X %*% diag(naToZero(coef(object)))), attr(X, "assign"))) colnames(termPredictors) <- c("(Intercept)"[0 %in% attr(X, "assign")], attr(object$terms, "term.labels")) termPredictors } else object$termPredictors } gnm/R/getContrasts.R0000744000176200001440000001310413544676476014065 0ustar liggesusers# Copyright (C) 2005-2017 David Firth and Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ getContrasts <- function(model, set = NULL, ref = "first", scaleRef = "mean", scaleWeights = NULL, dispersion = NULL, check = TRUE, ...){ coefs <- parameters(model) l <- length(coefs) if (!l) stop("Model has no non-eliminated parameters") of.interest <- ofInterest(model) if (!length(of.interest)) of.interest <- seq(l) coefNames <- names(coefs) if (is.null(set)) set <- unlist(pickFrom(coefNames[of.interest], 1, ...)) setLength <- length(set) if (setLength == 0) stop( "No non-empty parameter set specified") if (setLength < 1.5) stop( "For contrasts, at least 2 parameters are needed in a set") if (is.numeric(set)) set <- coefNames[set] for (refName in c("ref", "scaleRef"[!is.null(scaleWeights)])) { refSpec <- c(get(refName)) if (is.numeric(refSpec)){ assign(refName, refSpec) if (length(refSpec) == 1){ if (refSpec %in% seq(setLength)) { temp <- rep(0, setLength) temp[refSpec] <- 1 assign(refName, temp) } else stop("The specified ", refName, " is out of range") } if (length(refSpec) != setLength) stop("The specified ", refName, " has the wrong length") if ((sum(refSpec) - 1) ^ 2 > 1e-10) stop("The ", refName, " weights do not sum to 1") } else assign(refName, switch(refSpec, "first" = c(1, rep.int(0, setLength - 1)), "last" = c(rep.int(0, setLength - 1), 1), "mean"= rep.int(1/setLength, setLength), stop("Specified ", refName, " is not an opton."))) } setCoefs <- coefs[set] contr <- setCoefs - as.vector(ref %*% setCoefs) grad <- diag(rep(1, setLength)) grad <- grad - ref rownames(grad) <- set if (!is.null(scaleWeights)) { if (is.numeric(scaleWeights)) { scaleWeights <- c(scaleWeights) if (length(scaleWeights) != setLength) stop("The specified scaleWeights has the wrong length") } else scaleWeights <- switch(scaleWeights, unit = rep.int(1, setLength), setLength = rep.int(1/setLength, setLength), stop("Specified scaleWeights is not an opton.")) d <- setCoefs - as.vector(scaleRef %*% setCoefs) vd <- scaleWeights * d vdd <- sqrt(drop(vd %*% d)) contr <- contr/vdd grad <- ((scaleRef * sum(vd) - vd) %o% contr/vdd + grad)/vdd } combMatrix <- matrix(0, l, setLength) combMatrix[match(set, coefNames), ] <- grad colnames(combMatrix) <- set Vcov <- vcov(model, dispersion = dispersion) if (!is.logical(check) && !(all(check %in% seq(setLength)))) { stop("check must be TRUE or FALSE or a suitable numeric index vector") } iden <- rep(TRUE, ncol(combMatrix)) ## all unchecked as yet names(iden) <- colnames(combMatrix) if (is.logical(check)) { if (check) iden <- checkEstimable(model, combMatrix) } else iden[check] <- checkEstimable(model, combMatrix[, check]) if (any(!na.omit(iden))) { if (all(!na.omit(iden))) { warning("None of the specified contrasts is estimable", call. = FALSE) return(NULL) } message("Note: the following contrasts are unestimable:") messageVector(names(iden)[iden %in% FALSE]) } not.unestimable <- iden | is.na(iden) combMatrix <- combMatrix[, not.unestimable, drop = FALSE] V <- crossprod(combMatrix, crossprod(Vcov, combMatrix)) result <- data.frame(contr[not.unestimable], sqrt(diag(V))) dimnames(result) <- list(set[not.unestimable], c("Estimate", "Std. Error")) relerrs <- NULL if (sum(not.unestimable) > 2 && is.null(scaleWeights)) { estimable.names <- names(not.unestimable)[not.unestimable] Vcov <- Vcov[estimable.names, estimable.names, drop = FALSE] QVs <- try(qvcalc(Vcov), silent = TRUE) if (inherits(QVs, "try-error")) message("Quasi-variances could not be computed") else { quasiSE <- sqrt(QVs$qvframe$quasiVar) result <- cbind(result, quasiSE) names(result)[1:2] <- c("estimate", "SE") result$quasiVar <- QVs$qvframe$quasiVar relerrs <- QVs$relerrs } } return(structure(list(covmat = Vcov, qvframe = result, relerrs = relerrs, modelcall = model$call), class = "qv") ) } gnm/R/summary.meanResiduals.R0000744000176200001440000000346513311200273015650 0ustar liggesusers# Copyright (C) 2010, 2012 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ # this should always be a summary based on single grouping factor summary.meanResiduals <- function (object, digits = max(3, getOption("digits") - 3), ...) { cat("\nModel call:\n", deparse(attr(object, "call"), width.cutoff = options()$width), "\n", sep = "", fill = TRUE) cat("Mean residuals by ", attr(object, "by"), ":\n\n", sep = "") q <- quantile(object, na.rm = TRUE) names(q) <- c("Min", "1Q", "Median", "3Q", "Max") print.default(q, digits = digits, na.print = "", print.gap = 2) if (attr(object, "standardized")) { cat("\nTest of Normality:\n") df <- attr(object, "df") if (df > 0) { chi.sq <- sum(as.vector(object)^2) p.value <- pchisq(chi.sq, df, lower.tail = FALSE) test <- c(chi.sq, df, p.value) cat("\nChi^2 =", format(chi.sq, digits = digits), "on", df, "df, p-value =", format(p.value, digits = digits), "\n") } else cat("\n(zero degrees of freedom)\n") } else cat("\nResiduals are not standardized\n") } gnm/R/gnmTools.R0000744000176200001440000002416213311240600013155 0ustar liggesusers# Copyright (C) 2005-2017 Heather Turner and David Firth # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ "gnmTools" <- function(modelTerms, gnmData = NULL, x = TRUE) { eliminate <- attr(modelTerms, "eliminate") unitLabels <- attr(modelTerms, "unitLabels") common <- attr(modelTerms, "common") prefixLabels <- attr(modelTerms, "prefixLabels") match <- attr(modelTerms, "match") varLabels <- attr(modelTerms, "varLabels") block <- attr(modelTerms, "block") type <- attr(modelTerms, "type") nFactor <- length(varLabels) seqFactor <- seq(nFactor) termTools <- factorAssign <- thetaID <- vector(mode = "list", length = nFactor) blockID <- unique(block) adj <- 1 for (i in blockID) { b <- block == i if (all(common[b])) { ## get full set of levels facs <- vapply(unitLabels[b], function(x) { is.factor(eval(parse(text = x), gnmData))}, TRUE) if (!all(facs)) stop(paste(c("The following should be factors:", unitLabels[b][!facs]), collapse = "\n")) allLevels <- lapply(unitLabels[b], function(x) levels(eval(parse(text = x), gnmData))) labels <- unique(unlist(allLevels)) if (!all(mapply(identical, allLevels, list(labels)))) { labels <- sort(labels) } nLevels <- length(labels) ## create design matrices termTools[b] <- lapply(unitLabels[b], function(x) { class.ind(factor(eval(parse(text = x), gnmData), levels = labels)) }) ## create labels i <- which(b) nm <- paste(prefixLabels[i], labels, sep = "") factorAssign[b] <- lapply(i, function(x, nLevels, nm) structure(rep(x, nLevels), names = nm), nLevels, nm) adj <- adj + nLevels } else { intercept <- as.numeric(i == 0 && eliminate) tmp <- model.matrix(terms(reformulate(c(intercept, unitLabels[b])), keep.order = TRUE), data = gnmData) tmpAssign <- attr(tmp, "assign") if (intercept) { tmp <- tmp[,-1, drop = FALSE] tmpAssign <- tmpAssign[-1] } tmpAssign <- which(b)[tmpAssign + !tmpAssign[1]] ## don't paste "(Intercept)" if non-empty prefix and only parameter prefixOnly <- {identical(colnames(tmp), "(Intercept)") && prefixLabels[tmpAssign] != ""} nm <- paste(prefixLabels[tmpAssign], colnames(tmp)[!prefixOnly], sep = "") names(tmpAssign) <- nm termTools[b] <- lapply(split(seq_len(ncol(tmp)), tmpAssign), function(i, M) M[, i , drop = FALSE], tmp) factorAssign[b] <- split(tmpAssign, tmpAssign) adj <- adj + length(tmpAssign) } } factorAssign <- unlist(factorAssign) uniq <- !(duplicated(block) & common)[factorAssign] parLabels <- names(factorAssign) nTheta <- length(factorAssign) thetaID <- numeric(nTheta) thetaID[uniq] <- seq(sum(uniq)) thetaID[!uniq] <- thetaID[common[factorAssign] & uniq] nr <- dim(gnmData)[1] tmp <- seq(factorAssign) * nr first <- c(0, tmp[-nTheta]) firstX <- first[thetaID] last <- tmp - 1 lastX <- last[thetaID] + 1 nc <- tabulate(factorAssign) tmp <- cumsum(nc) a <- c(1, tmp[-nFactor] + 1) z <- tmp lt <- last[z] - first[a] + 1 storage.mode(firstX) <- storage.mode(first) <- storage.mode(lastX) <- storage.mode(last) <- storage.mode(a) <- storage.mode(z) <- storage.mode(lt) <- "integer" baseMatrix <- matrix(1, nrow = nr, ncol = nTheta) for (i in seq(termTools)) if (is.matrix(termTools[[i]])) baseMatrix[, factorAssign == i] <- termTools[[i]] X <- baseMatrix colID <- match(thetaID, thetaID) thetaID <- split(thetaID, factorAssign) names(thetaID) <- varLabels if (any(duplicated(parLabels[uniq]))){ parLabels[uniq] <- make.unique(parLabels[uniq]) warning("Using make.unique() to make default parameter labels unique", call. = FALSE) } colnames(X) <- parLabels X <- X[, uniq, drop = FALSE] ## check for zero columns constrain <- which(colSums(X) == 0) theta <- rep(NA, nTheta) for (i in blockID) { b <- block == i if (sum(b) == 1 && is.list(termTools[[which(b)]]) && !is.null(termTools[[which(b)]]$start)){ theta[unlist(thetaID[b])] <- termTools[[which(b)]]$start } } names(theta) <- parLabels termAssign <- attr(modelTerms, "assign")[factorAssign] block <- block[factorAssign] for (i in seq(attr(modelTerms, "predictor"))) { if (!is.null(attr(modelTerms, "start")[[i]])) { termID <- termAssign == i & uniq split <- block[termID] split <- match(split, unique(split)) theta[termID] <- attr(modelTerms, "start")[[i]](structure(theta[termID], assign = split)) } } theta <- theta[uniq] if (attr(modelTerms, "intercept")) termAssign <- termAssign - 1 prodList <- vector(mode = "list", length = nFactor) names(prodList) <- varLabels type <- type == "Special" varPredictors <- function(theta) { for (i in seqFactor) { prodList[[i]] <- .Call(C_submatprod, baseMatrix, theta[thetaID[[i]]], first[a[i]], nr, nc[i]) } prodList } predictor <- function(varPredictors, term = FALSE) { if (term) { es <- lapply(attr(modelTerms, "predictor"), function(x) { do.call("bquote", list(x, gnmData))}) tp <- vapply(es, eval, double(nr), c(varPredictors, gnmData)) colnames(tp) <- c("(Intercept)"[attr(modelTerms, "intercept")], attr(modelTerms, "term.labels")) tp } else eval(e, c(varPredictors, gnmData)) } gnmData <- lapply(gnmData[, !names(gnmData) %in% varLabels, drop = FALSE], drop) e <- sumExpression(attr(modelTerms, "predictor")) varDerivs <- lapply(varLabels, deriv, expr = e) commonAssign <- factorAssign[colID] nCommon <- table(commonAssign[!duplicated(factorAssign)]) tmpID <- unique(commonAssign) tmpID <- tmpID[type[tmpID]] nCommon <- as.integer(nCommon[as.character(tmpID)]) if (any(type)) specialVarDerivs <- deriv(e, varLabels[type]) convID <- colID[uniq] vID <- cumsum(c(1, nCommon))[seq(nCommon)] localDesignFunction <- function(theta, varPredictors, ind = NULL) { if (!any(common)) { if (!is.null(ind)){ i1 <- convID[ind] tmpID <- commonAssign[i1] } for (i in tmpID) { fi <- unique(factorAssign[commonAssign == i]) if (is.null(ind)){ i1 <- a[fi][1] i2 <- z[fi][1] } else { i2 <- i1 a <- ind if (factorAssign[ind] > 1) ind <- ind - z[factorAssign[ind] - 1] } if (type[fi]) { v <- attr(eval(varDerivs[[fi]], c(varPredictors, gnmData)), "gradient") .Call(C_subprod, X, baseMatrix, as.double(v), first[i1], last[i2], nr) } } if(!is.null(ind)) X[, a, drop = FALSE] else X } else { if (is.null(ind)){ v <- attr(eval(specialVarDerivs, c(varPredictors, gnmData)), "gradient") .Call(C_newsubprod, baseMatrix, as.double(v), X, first[a[tmpID]], first[vID], firstX[a[tmpID]], as.integer(length(nCommon)), lt[tmpID], lastX[z[tmpID]], nr, nCommon, max(nCommon)) } else { i1 <- convID[ind] fi <- unique(factorAssign[commonAssign == commonAssign[i1]]) v <- list() for(j in fi) v[[j]] <- attr(eval(varDerivs[[j]], c(varPredictors, gnmData)), "gradient") .Call(C_onecol, baseMatrix, as.double(unlist(v[fi])), first[i1], lt[fi[1]], nr, as.integer(length(fi))) } } } toolList <- list(start = theta, constrain = constrain, varPredictors = varPredictors, predictor = predictor, localDesignFunction = localDesignFunction) toolList$termAssign <- termAssign[uniq] toolList } gnm/R/parameters.R0000744000176200001440000000131613152512335013524 0ustar liggesusers# Copyright (C) 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ parameters <- function(object) replace(coef(object), object$constrain, object$constrainTo) gnm/R/grp.sum.R0000744000176200001440000000131213152512335012750 0ustar liggesusers# Copyright (C) 2010 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ grp.sum <- function(x, grp.end){ x <- cumsum(x)[grp.end] x - c(0, x[-length(x)]) } gnm/R/gnmFit.R0000744000176200001440000004515513311200272012605 0ustar liggesusers# Copyright (C) 2005-2013 Heather Turner and David Firth # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ gnmFit <- function (modelTools, y, constrain = numeric(0), # index of non-elimindated parameters constrainTo = numeric(length(constrain)), eliminate = NULL, # now a factor family = poisson(), weights = rep.int(1, length(y)), offset = rep.int(0, length(y)), nobs = length(y), start = rep.int(NA, length(modelTools$start) + nlevels(eliminate)), etastart = NULL, mustart = NULL, tolerance = 1e-6, iterStart = 2, iterMax = 500, trace = FALSE, verbose = FALSE, x = FALSE, termPredictors = FALSE, ridge = 1e-8) { names(y) <- NULL eps <- 100*.Machine$double.eps ridge <- 1 + ridge if (verbose) width <- as.numeric(options("width")) nTheta <- length(modelTools$start) nelim <- nlevels(eliminate) non.elim <- seq.int(nelim + 1, length(start)) ## add constraints specified by modelTools and glm tmpTheta <- as.double(rep.int(NA, nTheta)) varPredictors <- modelTools$varPredictors(tmpTheta) X <- modelTools$localDesignFunction(tmpTheta, varPredictors) isLinear <- unname(!is.na(colSums(X))) tmpTheta[constrain] <- constrainTo unspecified <- unname(is.na(tmpTheta)) if (any(isLinear & unspecified)) { tmpTheta[isLinear & unspecified] <- suppressWarnings(glm.fit.e(X[, isLinear & unspecified, drop = FALSE], y, family = family, intercept = FALSE, eliminate = if (nelim) eliminate else NULL, coefonly = TRUE, control = glm.control(maxit = 1))) extraLin <- which(isLinear & is.na(tmpTheta)) } else extraLin <- numeric() extra <- setdiff(c(modelTools$constrain, extraLin), constrain) ind <- order(c(constrain, extra)) constrain <- c(constrain, extra)[ind] constrainTo <- c(constrainTo, numeric(length(extra)))[ind] notConstrained <- !seq.int(nTheta) %in% constrain status <- "not.converged" unspecifiedNonlin <- FALSE dev <- numeric(2) if (nelim) { elim <- seq.int(nelim) alpha <- start[elim] } else { eliminate <- 1 alpha <- 0 } if (any(is.na(start))) { if (verbose == TRUE) prattle("Initialising", "\n", sep = "") ## only use start for elim par if all specified initElim <- any(is.na(alpha)) if (initElim) alpha[] <- numeric(nelim) theta <- start[non.elim] theta[is.na(theta)] <- modelTools$start[is.na(theta)] names(theta) <- names(modelTools$start) theta[constrain] <- constrainTo ## update any unspecified linear parameters unspecified <- unname(is.na(theta)) unspecifiedLin <- unspecified & isLinear unspecifiedNonlin <- unspecified & !isLinear if (!is.null(mustart)) etastart <- family$linkfun(mustart) if (any(unspecifiedNonlin) && is.null(etastart)){ theta[unspecifiedNonlin] <- gnmStart(sum(unspecifiedNonlin)) } if (any(unspecifiedLin) || initElim) { ## offset nonLin terms (currently NA if using etastart) ## plus offset contribution of any specified lin par if (!is.null(etastart)) z <- family$linkinv(etastart) else z <- y varPredictors <- modelTools$varPredictors(theta) tmpOffset <- modelTools$predictor(varPredictors, term = TRUE) tmpOffset <- rowSums(naToZero(tmpOffset)) tmpOffset <- offset + alpha[eliminate] + tmpOffset ## starting values for elim ignored here tmpTheta <- suppressWarnings({ glm.fit.e(X[, unspecifiedLin, drop = FALSE], z, weights = weights, etastart = etastart, offset = tmpOffset, family = family, intercept = FALSE, eliminate = if (nelim) eliminate else NULL, coefonly = TRUE)}) ## if no starting values for elim, use result of above if (initElim) alpha <- unname(attr(tmpTheta, "eliminated")) theta[unspecifiedLin] <- naToZero(tmpTheta) } if (any(unspecifiedNonlin) && !is.null(etastart)){ ## offset linear terms ## plus contribution of specified nonlin terms varPredictors <- modelTools$varPredictors(theta) tmpOffset <- modelTools$predictor(varPredictors, term = TRUE) tmpOffset <- rowSums(naToZero(tmpOffset)) tmpOffset <- offset + alpha[eliminate] + tmpOffset if (any(isLinear) && isTRUE(all.equal(unname(etastart), tmpOffset))) { etastart <- mustart <- NULL eval(family$initialize) etastart <- family$linkfun(mustart) } tmpOffset <- offset + alpha[eliminate] rss <- function(par) { theta[unspecifiedNonlin] <<- par varPredictors <<- modelTools$varPredictors(theta) eta <<- tmpOffset + modelTools$predictor(varPredictors) sum((etastart - eta)^2) } gr.rss <- function(par) { X <- modelTools$localDesignFunction(theta, varPredictors) -2 * t(X[, unspecifiedNonlin]) %*% ((etastart - eta)) } theta[unspecifiedNonlin] <- optim(gnmStart(sum(unspecifiedNonlin)), rss, gr.rss, method = c("L-BFGS-B"), control = list(maxit = iterStart), lower = -10, upper = 10)$par } varPredictors <- modelTools$varPredictors(theta) tmpOffset <- offset + alpha[eliminate] eta <- tmpOffset + modelTools$predictor(varPredictors) mu <- family$linkinv(eta) dev[1] <- sum(family$dev.resids(y, mu, weights)) if (trace) prattle("Initial Deviance = ", format(dev[1], nsmall = 6), "\n", sep = "") niter <- iterStart * (any(unspecifiedNonlin) && is.null(etastart)) for (iter in seq_len(niter)) { if (verbose) { if (iter == 1) prattle("Running start-up iterations", "\n"[trace], sep = "") if ((iter + 25)%%width == (width - 1)) cat("\n") } round <- 1 pmsh <- FALSE do <- seq_len(nTheta)[unspecifiedNonlin] maxDo <- max(do) for (i in rep.int(do, 2)) { dmu <- family$mu.eta(eta) vmu <- family$variance(mu) Xi <- modelTools$localDesignFunction(theta, varPredictors, i) wXi <- weights * (abs(dmu) >= eps) * dmu * dmu/vmu * Xi step <- sum((abs(y - mu) >= eps) * (y - mu)/dmu * wXi)/sum(wXi * Xi) otheta <- theta[i] theta[i] <- as.vector(otheta + step) if (!is.finite(theta[i])) { status <- "bad.param" break } varPredictors <- modelTools$varPredictors(theta) eta <- tmpOffset + modelTools$predictor(varPredictors) mu <- family$linkinv(eta) if (iter == 1 && (round == 1 || pmsh)) { dev[2] <- dev[1] dev[1] <- sum(family$dev.resids(y, mu, weights)) if (!is.finite(dev[1])) { status <- "bad.param" break } ## poor man's step-halving if (dev[1] > dev[2]) { pmsh <- TRUE theta[i] <- otheta + step/4 varPredictors <- modelTools$varPredictors(theta) eta <- tmpOffset + modelTools$predictor(varPredictors) mu <- family$linkinv(eta) dev[1] <- sum(family$dev.resids(y, mu, weights)) } } if (iter == 1 && i == maxDo) round <- 2 } if (status == "not.converged" && any(isLinear)) { if (iter == 1) { which <- which(isLinear & notConstrained) if(!exists("X")) X <- modelTools$localDesignFunction(theta, varPredictors) } tmpTheta <- updateLinear(which, theta, y, mu, eta, offset, weights, family, modelTools, X, if(nelim) eliminate else NULL) if (nelim){ alpha <- unname(attr(tmpTheta, "eliminated")) tmpOffset <- offset + alpha[eliminate] } theta[which] <- tmpTheta varPredictors <- modelTools$varPredictors(theta) eta <- tmpOffset + modelTools$predictor(varPredictors) mu <- family$linkinv(eta) } dev[1] <- sum(family$dev.resids(y, mu, weights)) if (!is.finite(dev[1])) { status <- "bad.param" break } if (trace) prattle("Start-up iteration ", iter, ". Deviance = ", format(dev[1], nsmall = 6), "\n", sep = "") else if (verbose) prattle(".") cat("\n"[iter == iterStart & verbose & !trace]) } } else { theta <- structure(replace(start[non.elim], constrain, constrainTo), names = names(modelTools$start)) varPredictors <- modelTools$varPredictors(theta) eta <- offset + alpha[eliminate] + modelTools$predictor(varPredictors) if (any(!is.finite(eta))) { stop("Values of 'start' and 'constrain' produce non-finite ", "predictor values") } mu <- family$linkinv(eta) dev[1] <- sum(family$dev.resids(y, mu, weights)) if (trace) prattle("Initial Deviance = ", format(dev[1], nsmall = 6), "\n", sep = "") } if (status == "not.converged") { X <- modelTools$localDesignFunction(theta, varPredictors) X <- X[, notConstrained, drop = FALSE] np <- ncol(X) + 1 ZWZ <- array(dim = c(np, np)) I1 <- numeric(np) I1[1] <- 1 if (nelim) Umat <- array(dim = c(nelim, np)) if (nelim){ grp.size <- tabulate(eliminate) grp.end <- cumsum(grp.size) } tmpAlpha <- 0 for (iter in seq_len(iterMax + 1)) { if (verbose) { if (iter == 1) prattle("Running main iterations", "\n"[trace], sep = "") if ((iter + 21)%%width == (width - 1)) cat("\n") } dmu <- family$mu.eta(eta) vmu <- family$variance(mu) w <- sqrt(weights * (abs(dmu) >= eps) * dmu * dmu/vmu) X <- w * X z <- w * (abs(dmu) >= eps) * (y - mu)/dmu ZWZ[-1,-1] <- crossprod(X) score <- ZWZ[1,-1] <- ZWZ[-1,1] <- crossprod(z, X) ZWZ[1,1] <- sum(z * z) diagInfo <- diag(ZWZ) ## only check for non-eliminated coefficients if (any(!is.finite(diagInfo))) { status <- "fail" break } if (all(diagInfo < 1e-20) || all(abs(score) < tolerance * sqrt(tolerance + diagInfo[-1]))) { status <- "converged" break } Zscales <- sqrt(diagInfo) Zscales[Zscales < 1e-3] <- 1e-3 ## to allow for zeros if (iter > iterMax) break if (nelim){ elimXscales <- grp.sum(w * w, grp.end) elimXscales <- sqrt(elimXscales * ridge) Umat[,1] <- rowsum.default(w * z, eliminate, reorder = FALSE) Umat[,-1] <- rowsum.default(w * X, eliminate, reorder = FALSE) Umat <- Umat/(elimXscales %o% Zscales) ZWZ <- ZWZ/(Zscales %o% Zscales) diag(ZWZ) <- ridge z <- solve(ZWZ - crossprod(Umat), I1, tol = .Machine$double.eps) thetaChange <- -z[-1]/z[1] * Zscales[1]/Zscales[-1] alphaChange <- c(Umat %*% (z * sqrt(ridge)))/z[1] * Zscales[1]/elimXscales } else { ZWZ <- ZWZ/(Zscales %o% Zscales) diag(ZWZ) <- ridge z <- solve(ZWZ, I1, tol = .Machine$double.eps)/Zscales thetaChange <- -z[-1]/z[1] } dev[2] <- dev[1] j <- scale <- 1 while (!is.nan(dev[1]) && dev[1] >= dev[2] && j < 11) { if (nelim) tmpAlpha <- alpha + alphaChange/scale tmpTheta <- replace(theta, notConstrained, theta[notConstrained] + thetaChange/scale) varPredictors <- modelTools$varPredictors(tmpTheta) eta <- offset + tmpAlpha[eliminate] + modelTools$predictor(varPredictors) mu <- family$linkinv(eta) dev[1] <- sum(family$dev.resids(y, mu, weights)) scale <- scale*2 j <- j + 1 } if (!is.finite(dev[1])) { status <- "no.deviance" break } if (trace){ prattle("Iteration ", iter, ". Deviance = ", format(dev[1], nsmall = 6), "\n", sep = "") } else if (verbose) prattle(".") if (nelim) alpha <- tmpAlpha theta <- tmpTheta X <- modelTools$localDesignFunction(theta, varPredictors) X <- X[, notConstrained, drop = FALSE] } } if (status %in% c("converged", "not.converged")) { if (verbose) prattle("\n"[!trace], "Done\n", sep = "") } else { if (any(!is.finite(eta))) status <- "eta.not.finite" if (exists("w") && any(!is.finite(w))) status <- "w.not.finite" if (any(is.infinite(X))) status <- "X.not.finite" if (verbose) message("\n"[!trace], switch(status, bad.param = "Bad parameterisation", eta.not.finite = "Predictors are not all finite", w.not.finite = "Iterative weights are not all finite", X.not.finite = "Local design matrix has infinite elements", no.deviance = "Deviance is not finite")) return() } theta[constrain] <- NA X <- modelTools$localDesignFunction(theta, varPredictors) X <- X[, notConstrained, drop = FALSE] ## suppress warnings in rankMatrix re coercion to dense matrix if (nelim) { ## sweeps needed to get the rank right subtracted <- rowsum.default(X, eliminate, reorder = FALSE)/grp.size if (modelTools$termAssign[1] == 0) subtracted[,1] <- 0 theRank <- suppressWarnings( rankMatrix(X - subtracted[eliminate, , drop = FALSE])) + nelim names(alpha) <- paste("(eliminate)", elim, sep = "") } else theRank <- suppressWarnings(rankMatrix(X)) modelAIC <- suppressWarnings(family$aic(y, rep.int(1, nobs), mu, weights, dev[1]) + 2 * theRank) fit <- list(coefficients = structure(theta, eliminated = alpha), constrain = constrain, constrainTo = constrainTo, residuals = z/w, fitted.values = mu, rank = theRank, family = family, predictors = eta, deviance = dev[1], aic = modelAIC, iter = iter - (iter != iterMax), weights = w * w, prior.weights = weights, df.residual = c(nobs - theRank), y = y) if (status == "not.converged") { warning("Fitting algorithm has either not converged or converged\n", "to a non-solution of the likelihood equations.\n", "Use exitInfo() for numerical details of last iteration.\n") fit$converged <- structure(FALSE, score = score, criterion = tolerance * sqrt(tolerance + diagInfo[-1])) } else fit$converged <- TRUE if (x) { X <- modelTools$localDesignFunction(theta, varPredictors) fit$x <- structure(X, assign = modelTools$termAssign) } if (termPredictors) { theta[is.na(theta)] <- 0 varPredictors <- modelTools$varPredictors(theta) fit$termPredictors <- modelTools$predictor(varPredictors, term = TRUE) } fit } gnm/R/add1.gnm.R0000744000176200001440000001277713311213644012765 0ustar liggesusers# Modification of add1.glm from the stats package for R. # # Copyright (C) 1994-8 W. N. Venables and B. D. Ripley # Copyright (C) 1998-2005 The R Core Team # Copyright (C) 2005, 2010 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ add1.gnm <- function (object, scope, scale = 0, test = c("none", "Chisq", "F"), x = NULL, k = 2, ...) { if (any(attr(terms(object), "type") != "Linear")) stop("add1 is not implemented for gnm objects with nonlinear terms.") Fstat <- function(table, rdf) { dev <- table$Deviance df <- table$Df diff <- pmax(0, (dev[1L] - dev)/df) Fs <- (diff/df)/(dev/(rdf - df)) Fs[df < .Machine$double.eps] <- NA P <- Fs nnas <- !is.na(Fs) P[nnas] <- pf(Fs[nnas], df[nnas], rdf - df[nnas], lower.tail = FALSE) list(Fs = Fs, P = P) } if (!is.character(scope)) scope <- add.scope(object, update.formula(object, scope)) if (!length(scope)) stop("no terms in scope for adding to object") oTerms <- attr(object$terms, "term.labels") int <- attr(object$terms, "intercept") ns <- length(scope) dfs <- dev <- numeric(ns + 1) names(dfs) <- names(dev) <- c("", scope) add.rhs <- paste(scope, collapse = "+") add.rhs <- eval(parse(text = paste("~ . +", add.rhs))) new.form <- update.formula(object, add.rhs) Terms <- terms(new.form) y <- object$y if (is.null(x)) { fc <- object$call fc$formula <- Terms fob <- list(call = fc, terms = Terms) class(fob) <- oldClass(object) m <- model.frame(fob, xlev = object$xlevels) offset <- model.offset(m) wt <- model.weights(m) x <- model.matrix(Terms, m, contrasts.arg = object$contrasts) oldn <- length(y) y <- model.response(m) if (!is.factor(y)) storage.mode(y) <- "double" if (NCOL(y) == 2) { n <- y[, 1] + y[, 2] y <- ifelse(n == 0, 0, y[, 1]/n) if (is.null(wt)) wt <- rep.int(1, length(y)) wt <- wt * n } newn <- length(y) if (newn < oldn) warning(gettextf("using the %d/%d rows from a combined fit", newn, oldn), domain = NA) } else { wt <- object$prior.weights offset <- object$offset } n <- nrow(x) if (is.null(wt)) wt <- rep.int(1, n) Terms <- attr(Terms, "term.labels") asgn <- attr(x, "assign") ousex <- match(asgn, match(oTerms, Terms), 0L) > 0L if (int) ousex[1L] <- TRUE X <- x[, ousex, drop = FALSE] z <- glm.fit.e(X, y, wt, offset = offset, family = object$family, eliminate = object$eliminate) dfs[1L] <- z$rank dev[1L] <- z$deviance sTerms <- vapply(strsplit(Terms, ":", fixed = TRUE), function(x) paste(sort(x), collapse = ":"), character(1)) for (tt in scope) { stt <- paste(sort(strsplit(tt, ":")[[1L]]), collapse = ":") usex <- match(asgn, match(stt, sTerms), 0L) > 0L X <- x[, usex | ousex, drop = FALSE] z <- glm.fit.e(X, y, wt, offset = offset, family = object$family, eliminate = object$eliminate) dfs[tt] <- z$rank dev[tt] <- z$deviance } if (scale == 0) dispersion <- summary(object, dispersion = NULL)$dispersion else dispersion <- scale fam <- object$family$family if (fam == "gaussian") { if (scale > 0) loglik <- dev/scale - n else loglik <- n * log(dev/n) } else loglik <- dev/dispersion aic <- loglik + k * dfs aic <- aic + (extractAIC(object, k = k)[2L] - aic[1L]) dfs <- dfs - dfs[1L] dfs[1L] <- NA aod <- data.frame(Df = dfs, Deviance = dev, AIC = aic, row.names = names(dfs), check.names = FALSE) if (all(is.na(aic))) aod <- aod[, -3] test <- match.arg(test) if (test == "Chisq") { dev <- pmax(0, loglik[1L] - loglik) dev[1L] <- NA LRT <- if (dispersion == 1) "LRT" else "scaled dev." aod[, LRT] <- dev nas <- !is.na(dev) dev[nas] <- pchisq(dev[nas], aod$Df[nas], lower.tail = FALSE) aod[, "Pr(Chi)"] <- dev } else if (test == "F") { if (fam == "binomial" || fam == "poisson") warning(gettextf("F test assumes quasi%s family", fam), domain = NA) rdf <- object$df.residual aod[, c("F value", "Pr(F)")] <- Fstat(aod, rdf) } head <- c("Single term additions", "\nModel:", deparse(as.vector(formula(object))), if (scale > 0) paste("\nscale: ", format(scale), "\n")) class(aod) <- c("anova", "data.frame") attr(aod, "heading") <- head aod } gnm/R/residSVD.R0000744000176200001440000000403113615611217013044 0ustar liggesusers# Copyright (C) 2005, 2012 David Firth and Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ residSVD <- function(model, fac1, fac2, d = 1) { if (!is.null(model$call$data)) { Data <- as.data.frame(eval(model$call$data, parent.frame())) fac1 <- eval(match.call()$fac1, Data, parent.frame()) fac2 <- eval(match.call()$fac2, Data, parent.frame()) } if (!inherits(model, "glm") && class(model) != "lm") stop( "model not of class lm, glm or gnm") if (!is.factor(fac1)) stop("fac1 must be a factor") if (!is.factor(fac2)) stop("fac2 must be a factor") Data <- data.frame(fac1, fac2) if (!is.null(model$na.action)) Data <- Data[-model$na.action, ] weights <- if (!is.null(model$weights)) as.vector(model$weights) else 1 X <- data.frame(rw = as.vector(model$residuals) * weights, w = weights) X <- lapply(X, tapply, Data, sum, simplify = TRUE) X <- X$rw/X$w X <- svd(naToZero(X), d, d) uPart <- sqrt(X$d[seq(d)]) * t(X$u) vPart <- sqrt(X$d[seq(d)]) * t(X$v) # uPartNegative <- apply(uPart, 1, function(row) all(row < 0)) # vPartNegative <- apply(vPart, 1, function(row) all(row < 0)) # multiplier <- ifelse(uPartNegative + vPartNegative == 1, -1, 1) multiplier <- 1 result <- t(cbind(uPart, vPart) * multiplier) rownames(result) <- c(paste("fac1", levels(fac1), sep = "."), paste("fac2", levels(fac2), sep = ".")) colnames(result) <- 1:d drop(result) } gnm/R/termPredictors.R0000744000176200001440000000127313152512335014371 0ustar liggesusers# Copyright (C) 2005 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ termPredictors <- function(object, ...) { UseMethod("termPredictors") } gnm/R/ofInterestReplacement.R0000744000176200001440000000174313311427552015672 0ustar liggesusers# Copyright (C) 2006 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ "ofInterest<-" <- function(object, value = NULL) { coefNames <- names(coef(object)) if (!is.null(value)) { if (!all(value %in% seq(coefNames))) stop("One or more replacement values is invalid.") names(value) <- coefNames[value] } object$ofInterest <- value messageVector(names(value)) object } gnm/R/gnmTerms.R0000744000176200001440000001740213615560322013163 0ustar liggesusers# Copyright (C) 2005-2010, 2012 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ gnmTerms <- function(formula, eliminate = NULL, data = NULL) { env <- environment(formula) if (!is.null(eliminate)){ formula <- as.formula(substitute(a ~ b - e - 1, list(a = formula[[2]], b = formula[[3]], e = eliminate))) environment(formula) <- env } fullTerms <- terms(formula, specials = "instances", simplify = TRUE, keep.order = TRUE, data = data) if (is.empty.model(fullTerms)) return(fullTerms) inst <- attr(fullTerms, "specials")$instances if (length(inst)) { termLabels <- c("0"[!attr(fullTerms, "intercept")], attr(fullTerms, "term.labels")) instLabels <- as.list(attr(fullTerms, "variables"))[inst + 1] termLabels[termLabels %in% instLabels] <- vapply(instLabels, eval, character(1)) variables <- as.character(attr(fullTerms, "variables"))[-1] offsetLabels <- variables[attr(fullTerms, "offset")] response <- variables[attr(fullTerms, "response")][1][[1]] new <- reformulate(c(termLabels, offsetLabels), ".") fullTerms <- terms(update.formula(formula, new), keep.order = TRUE, data = data) environment(fullTerms) <- env } termLabels <- c("1"[attr(fullTerms, "intercept")], attr(fullTerms, "term.labels")) variables <- predvars <- as.list(attr(fullTerms, "variables"))[-1] specials <- which(vapply(variables, function(x) { length(x) > 1 && inherits(match.fun(x[[1]]), "nonlin") }, TRUE)) if (!length(specials)) { n <- length(termLabels) attributes(fullTerms) <- c(attributes(fullTerms), list(eliminate = !is.null(eliminate), unitLabels = termLabels, common = logical(n), block = numeric(n), match = !logical(n), assign = seq(length = n), type = rep.int("Linear", n), prefixLabels = character(n), varLabels = termLabels, predictor = lapply(termLabels, as.name), class = c("gnmTerms", "terms", "formula"))) return(fullTerms) } specialTerms <- rownames(attr(fullTerms, "factors"))[specials] specialTerms <- strsplit(specialTerms, ", inst = |,? ?\\)$", perl = TRUE) term <- vapply(specialTerms, "[", character(1), 1) inst <- as.numeric(vapply(specialTerms, "[", character(1), 2)) patch <- term %in% term[inst > 1] & is.na(inst) termLabels[termLabels %in% specials[patch]] <- paste(term[patch], ", inst = 1)") inst[patch] <- 1 nonsense <- tapply(inst, term, FUN = function(x) {!all(is.na(x)) && !identical(as.integer(x), seq(x))}) if (any(nonsense)) stop("Specified instances of ", paste(names(nonsense)[nonsense], ")"), " are not in sequence") offsetVars <- variables[attr(fullTerms, "offset")] nonlinear <- termLabels %in% variables[specials] variables <- variables[-specials] predvars <- predvars[-specials] unitLabels <- varLabels <- as.list(termLabels) predictor <- lapply(termLabels, as.name) names(predictor) <- unitLabels n <- length(unitLabels) blockList <- as.list(numeric(n)) match <- as.list(!logical(n)) common <- as.list(logical(n)) class <- as.list(rep.int("Linear", n)) prefixLabels <- as.list(character(n)) start <- vector("list", n) adj <- 1 for (j in which(nonlinear)) { nonlinCall <- parse(text = unitLabels[[j]])[[1]] args <- eval(nonlinCall, as.data.frame(data), environment(formula)) args <- c(args, nonlin.function = deparse(nonlinCall[[1]]), list(data = data)) tmp <- do.call("nonlinTerms", args) unitLabels[[j]] <- tmp$unitLabels if (!identical(tmp$prefix, "#")) { bits <- hashSplit(tmp$prefix) if (length(bits) > 1) { n <- length(tmp$hashLabels) matched <- tmp$matchID > 0 & !duplicated(tmp$matchID) dot <- (tmp$hashLabels[matched])[order(tmp$matchID[matched])] prefix <- matrix(dot, max(tmp$matchID), n) prefix[cbind(tmp$matchID, seq(n))] <- "." prefix <- rbind(character(n), prefix) sep <- rep(".", n) sep[!tmp$matchID] <- "" prefixLabels[[j]] <- paste(apply(prefix, 2, paste, bits, sep = "", collapse = ""), sep, tmp$suffix, sep = "") for (i in unique(tmp$common[duplicated(tmp$common)])) { dotCommon <- dot commonID <- tmp$common == i dotCommon[tmp$matchID[commonID]] <- "." prefixLabels[[j]][commonID] <- paste(paste(c("", dotCommon), bits, sep = "", collapse = ""), tmp$suffix[commonID], sep[commonID], paste(tmp$unitLabels[commonID], collapse = "|"), sep = "") } } else prefixLabels[[j]] <- paste(tmp$prefix, tmp$suffix, sep = "") } else prefixLabels[[j]] <- tmp$varLabels varLabels[[j]] <- gsub("#", j, tmp$varLabels) predictor[[j]] <- parse(text = gsub("#", j, tmp$predictor))[[1]] blockList[[j]] <- tmp$block + adj match[[j]] <- as.logical(tmp$matchID) common[[j]] <- tmp$common %in% tmp$common[duplicated(tmp$common)] class[[j]] <- tmp$type start[j] <- list(tmp$start) adj <- max(c(0, blockList[[j]])) + 1 variables <- c(variables, tmp$variables) predvars <- c(predvars, tmp$predvars) } if (length(predvars) > 1) nObs <- call("length", predvars[[1]]) else if (!is.null(data)) nObs <- call("length", as.name(names(data)[1])) else nObs <- 1 attributes(fullTerms) <- c(attributes(fullTerms), list(eliminate = !is.null(eliminate), offset = which(unique(variables) %in% offsetVars), variables = as.call(c(quote(list), unique(variables))), predvars = {do.call("substitute", list(as.call(c(quote(list), unique(predvars))), list(nObs = nObs)))}, unitLabels = unlist(unitLabels), common = unlist(common), block = unlist(blockList), match = unlist(match), assign = rep(seq(class), vapply(class, length, 1)), type = unlist(class), prefixLabels = unlist(prefixLabels), varLabels = unlist(varLabels), start = start, predictor = predictor, class = c("gnmTerms", "terms", "formula"))) fullTerms } gnm/R/print.gnm.R0000744000176200001440000000313013152512335013271 0ustar liggesusers# Copyright (C) 2005-2008, 2010 Heather Turner and David Firth # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ print.gnm <- function (x, digits = max(3, getOption("digits") - 3), ...) { cat("\nCall:\n", deparse(x$call), "\n", sep = "", fill = TRUE) if (length(coef(x)) && (is.null(ofInterest(x)) || length(ofInterest(x)))) { cat("Coefficients", " of interest"[!is.null(ofInterest(x))], ":\n", sep = "") if (!is.null(ofInterest(x))) print.default(format(coef(x)[ofInterest(x)], digits = digits), print.gap = 2, quote = FALSE) else print.default(format(coef(x), digits = digits), print.gap = 2, quote = FALSE) } else cat("No coefficients", " of interest"[!is.null(ofInterest(x))], ". \n\n", sep = "") cat("\nDeviance: ", format(x$deviance, digits), "\nPearson chi-squared:", format(sum(na.omit(c(residuals(x, type = "pearson")))^2), digits), "\nResidual df: ", x$df.residual, "\n") invisible(x) } gnm/R/Const.R0000744000176200001440000000160013152512335012443 0ustar liggesusers# Copyright (C) 2006, 2008 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ Const <- function(const) { badCall <- !"nonlinTerms" %in% lapply(sys.calls(), "[[", 1) if (any(badCall)) stop("Const terms are only valid in the predictors of \"nonlin\" ", "functions.") call("rep", substitute(const), quote(nObs)) } gnm/R/drop1.gnm.R0000744000176200001440000001007613311200273013161 0ustar liggesusers# Modification of drop1.glm from the stats package for R. # # Copyright (C) 1994-8 W. N. Venables and B. D. Ripley # Copyright (C) 1998-2005 The R Core Team # Copyright (C) 2005, 2010, 2013 Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ drop1.gnm <- function (object, scope, scale = 0, test = c("none", "Chisq", "F"), k = 2, ...) { if (any(attr(terms(object), "type") != "Linear")) stop("add1 is not implemented for gnm objects with nonlinear terms.") x <- model.matrix(object) n <- nrow(x) asgn <- attr(x, "assign") tl <- attr(object$terms, "term.labels") if (missing(scope)) scope <- drop.scope(object) else { if (!is.character(scope)) scope <- attr(terms(update.formula(object, scope)), "term.labels") if (!all(match(scope, tl, 0L) > 0L)) stop("scope is not a subset of term labels") } ndrop <- match(scope, tl) ns <- length(scope) rdf <- object$df.residual chisq <- object$deviance dfs <- numeric(ns) dev <- numeric(ns) y <- object$y if (is.null(y)) { y <- model.response(model.frame(object)) if (!is.factor(y)) storage.mode(y) <- "double" } wt <- object$prior.weights if (is.null(wt)) wt <- rep.int(1, n) for (i in 1L:ns) { ii <- seq_along(asgn)[asgn == ndrop[i]] jj <- setdiff(seq(ncol(x)), ii) z <- glm.fit.e(x[, jj, drop = FALSE], y, wt, offset = object$offset, family = object$family, eliminate = object$eliminate) dfs[i] <- z$rank dev[i] <- z$deviance } scope <- c("", scope) dfs <- c(object$rank, dfs) dev <- c(chisq, dev) dispersion <- if (is.null(scale) || scale == 0) summary(object, dispersion = NULL)$dispersion else scale fam <- object$family$family loglik <- if (fam == "gaussian") { if (scale > 0) dev/scale - n else n * log(dev/n) } else dev/dispersion aic <- loglik + k * dfs dfs <- dfs[1L] - dfs dfs[1L] <- NA aic <- aic + (extractAIC(object, k = k)[2L] - aic[1L]) aod <- data.frame(Df = dfs, Deviance = dev, AIC = aic, row.names = scope, check.names = FALSE) if (all(is.na(aic))) aod <- aod[, -3] test <- match.arg(test) if (test == "Chisq") { dev <- pmax(0, loglik - loglik[1L]) dev[1L] <- NA nas <- !is.na(dev) LRT <- if (dispersion == 1) "LRT" else "scaled dev." aod[, LRT] <- dev dev[nas] <- pchisq(dev[nas], aod$Df[nas], lower.tail = FALSE) aod[, "Pr(Chi)"] <- dev } else if (test == "F") { if (fam == "binomial" || fam == "poisson") warning(gettextf("F test assumes 'quasi%s' family", fam), domain = NA) dev <- aod$Deviance rms <- dev[1L]/rdf dev <- pmax(0, dev - dev[1L]) dfs <- aod$Df rdf <- object$df.residual Fs <- (dev/dfs)/rms Fs[dfs < 1e-04] <- NA P <- Fs nas <- !is.na(Fs) P[nas] <- pf(Fs[nas], dfs[nas], rdf, lower.tail = FALSE) aod[, c("F value", "Pr(F)")] <- list(Fs, P) } head <- c("Single term deletions", "\nModel:", deparse(as.vector(formula(object))), if (!is.null(scale) && scale > 0) paste("\nscale: ", format(scale), "\n")) class(aod) <- c("anova", "data.frame") attr(aod, "heading") <- head aod } gnm/R/cholInv.R0000744000176200001440000000617313311200273012761 0ustar liggesusers# Copyright (C) 2006, 2010 David Firth and Heather Turner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 or 3 of the License # (at your option). # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ cholInv <- function (mat, eliminate = numeric(0), onlyFirstCol = FALSE, onlyNonElim = FALSE) { .Deprecated(msg = paste("'cholInv' is deprecated as it is no longer used ", "by gnm.")) m <- nrow(mat) n <- ncol(mat) if (length(eliminate) == 0) { ## the basic routine, no eliminated submatrix if (!is.matrix(mat)) stop("mat is not a matrix") Rownames <- rownames(mat) Colnames <- colnames(mat) result <- chol2inv(chol(mat)) if (!is.null(Rownames)) colnames(result) <- Rownames if (!is.null(Colnames)) rownames(result) <- Colnames if (onlyFirstCol) result <- result[, 1, drop = FALSE] return(result) } ## Now allow for the possibility of an eliminated submatrix if (m != n) stop("mat must be a symmetric matrix") n <- nrow(mat) elim <- 1:n %in% eliminate diag.indices <- (n * (0:(n - 1)) + 1:n) Tmat <- mat[diag.indices[eliminate]] if (any(Tmat == 0)) stop("an eliminated submatrix must have all diagonal entries non-zero.") W <- mat[!elim, !elim, drop = FALSE] U <- mat[elim, !elim, drop = FALSE] Ti <- 1/Tmat k <- length(Tmat) Ti.U <- Ti * U V.Ti <- t(Ti.U) Qmat <- W - crossprod(Ti.U, U) Qi <- cholInv(Qmat) result <- matrix(NA, if (onlyNonElim) n - k else n, if (onlyFirstCol) 1 else if (onlyNonElim) n - k else n) cols.notElim <- if (onlyFirstCol) 1 else if (onlyNonElim) 1:(n - k) else !elim rows.notElim <- if (onlyNonElim) 1:(n - k) else !elim if (onlyFirstCol) Qi <- Qi[, 1, drop = FALSE] result[rows.notElim, cols.notElim] <- Qi if (!onlyNonElim) { temp <- -crossprod(Qi, V.Ti) result[elim, cols.notElim] <- t(temp) } if (!onlyFirstCol && !onlyNonElim) { result[!elim, elim] <- temp temp <- crossprod(V.Ti, Qi) %*% V.Ti diag.indices <- k * (0:(k - 1)) + 1:k temp[diag.indices] <- Ti + temp[diag.indices] result[elim, elim] <- temp } theNames <- colnames(mat) rownames(result) <- if (onlyNonElim) theNames[!elim] else theNames colnames(result) <- if (onlyFirstCol) theNames[!elim][1] else if (onlyNonElim) theNames[!elim] else theNames result } gnm/NEWS.md0000744000176200001440000006653713615620650012157 0ustar liggesusersChanges in gnm 1.1-1 ==================== Bug fixes --------- * `confint.profile.gnm()` now works for a single parameter ![(#10)](https://github.com/hturner/gnm/issues/10) * `gnm()` now works when `eliminate` is specified as `NULL` ![(#14)](https://github.com/hturner/gnm/issues/14) * allow `set` argument of `getContrasts()` to be numeric, as documented * convert old tests to unit tests. Changes in gnm 1.1-0 ==================== Changes in behaviour -------------------- * generalize `Diag` and `Symm` to work with factors with levels that are not in alphabetical order. Factor levels are now only sorted by `Diag` if the input factors have different sets of levels. * make `se()` generic to allow methods to be added (e.g. as in **logmult** package). Improvements ------------ * C routines now registered to avoid accidental clashes with other packages. - use of `R_forceSymbols` routine requires R >= 3.0.0. * use jss.bst vs chicago.bst in vignette. * update imports to include recommended packages. * avoid warnings regarding recycling a length 1 array. * avoid using `print` or `cat` outside print methods, so print output always optional (e.g. by setting `verbose` argument or using `suppressMessages`). Bug fixes --------- * environment of formula preserved when using `gnm()` with `eliminate` argument. * allow factor response in binomial gnms. * allow matrix response in quasibinomial gnms. * make `x = FALSE` also work when using `gnm()` with `eliminate` argument. * allow response in formula to be specified as an expression (e.g. `D/E`) when formula uses `instances`. Changes in gnm 1.0-8 ==================== Improvements ------------- * now use lazy data loading. * improvements to vignette (with thanks to Michael Friendly). * copyright notices added to source files to clarify authorship, with appropriate credit given to contributors in Rd and DESCRIPTION files. Changes in behaviour -------------------- * predict.gnm now includes eliminate term in predictions on new data. Bug fixes --------- * `expandCategorical` now works when there are no covariates in the data. * better handling of single-column model matrices. * `predict.gnm` now works with `se.fit = TRUE` for models with eliminated terms; correctly handles new data without all levels of homogeneous factors present, and respects contrasts settings. * environment of formula preserved when using instances. Changes in gnm 1.0-7 ==================== Bug fixes --------- * corrected use of `anova.glmlist` in `anova.gnm`. Changes in gnm 1.0-6 ==================== Bug fixes --------- * added catch for when deviance becomes `NaN`. Changes in gnm 1.0-5 ==================== Improvements ------------ * eliminated coefficients now returned as named vector. * step-quartering introduced to start-up iterations to avoid increasing deviance. Changes in behaviour -------------------- * `gnm` no longer restarts if algorithm fails - better to provide improved starting values in this case. Bug fixes --------- * fixed bug in the way `etastart` is used to initialise the linear parameters when `eliminate` is used as well. Changes in gnm 1.0-4 ==================== Bug fixes --------- * restarting mechanism now reinitialises correctly. * removed call to external C function that is no longer available. * `gnm` now works with `eliminate` argument when remaining linear part of predictor only involves one parameter. Changes in gnm 1.0-3 ==================== Improvements ------------ * `pickCoef` extended to allow fixed pattern matching and to optionally return actual coefficients rather than their indices. * `gnm` now looks for exact match in coefficient names when a single character string is passed to the `constrain` argument before treating as regular expression. * `hatvalues.gnm` has been reimplemented to work more efficiently for large model matrices. * `"nonlin"` terms defined for homogeneous factors will now accept factors specified as an interaction (using `:`). Bug fixes --------- * results now returned in original order for models fitted with `eliminate` argument. * bug introduced into `residSVD` reverted so that now correctly aggregates working residuals. * `anova.gnm` now works when model is a single `"nonlin"` term. Changes in gnm 1.0-2 ==================== Improvements ------------ * factors specified as homogenous in nonlin functions can now be specified as interactions of factors. Bug fixes --------- * fixed bug so that variables handled correctly in nonlinTerms. * corrected rank calculation for constrained models. * removed calls to Internal Changes in gnm 1.0-1 ==================== New Features ------------ * added `meanResiduals` function * `check` argument added to getContrasts. Improvements ------------ * added example SVD calculation to `?wheat`; also in vignette. Bug fixes --------- * added `update.gnm` so that nonlinear terms were no ordered as linear, first order terms. Changes in gnm 1.0-0 ==================== Improvements ------------ * eliminated coefficients now treated entirely separately, in particular the design matrix no longer has columns for these coefficients, making the algorithm far more efficient for models with many eliminated coefficients. * more reliable calculation of rank Changes in Behaviour -------------------- * `ofInterest` and `constrain` now index non-eliminated coefficients only. * eliminated coefficients now returned as attribute of returned coefficient vector. * `"lsMethod"` argument to `gnm` removed as now the LAPACK routines are always used to determine the least squares solution at the heart of the fitting algorithm. Hence `qrSolve` and `cholInv` deprecated. * the `"eliminate"`, `"onlyFirstCol"` and `"onlyNonElim"` arguments to `MPinv` have been removed as no longer used. Bug fixes --------- * `etastart` now works for models with no linear parameters. * `anova` now ignores terms that are completely constrained. Changes in gnm 0.10-0 ===================== Improvements ------------ * `mustart`/`etastart` now used to obtain starting values for linear and nonlinear parameters separately, improving performance. Changes in Behaviour -------------------- * `expandCategorical` now groups together individuals with common covariate values, by default. New `group` argument added to switch this behaviour. Bug fixes --------- * `print.profile.gnm` now prints full result. * data now read in correctly for Lee-Carter example in vignette. Changes in gnm 0.9-9 ==================== New Features ------------ * `etastart` and `mustart` arguments added to `gnm`. Changes in gnm 0.9-8 ==================== Improvements ------------ * `gnm` now returns `data` argument as `glm` does. Changes in gnm 0.9-7 ==================== Bug fixes --------- * more minor corrections in documentation. Changes in gnm 0.9-6 ==================== Bug fixes --------- * minor corrections in documentation. Changes in gnm 0.9-5 ==================== Improvements ------------ * `getContrasts` can now estimate _scaled_ contrasts with more flexibility in how the reference level is defined. * changed tolerance level in checkEstimable to `1e6 * .Machine$double.eps` as previous tolerance too strict for some examples. Changes in Behaviour -------------------- * `getContrasts` now only handles one set of parameters at a time. * use of `Const` is now restricted to the symbolic predictors of `"nonlin"` functions. * `Nonlin` - the wrapper function for plug-in functions - is now defunct. Use `"nonlin"` functions to specify custom nonlinear terms. Bug fixes --------- * `plot.gnm` now uses standardised Pearson residuals for plot `which = 5` so that the Cook's distance contours are correct Changes in gnm 0.9-4 ==================== New Features ------------ * `predict` now implemented for `"gnm"` objects Improvements ------------ * results formatted as contingency tables where appropriate by extractor functions (`fitted`, etc), rather than `gnm` Changes in Behaviour -------------------- * default for `match` argument of `nonlinTerms` now zero vector (i.e. no matching to arguments of `call` by default) Bug fixes --------- * `termPredictors` now works on `"gnm"` objects fitted with `glm.fit` * intercept removed when `eliminate` argument of `gnm` is non-`NULL` * models with all parameters eliminated now summarised sensibly * `Diag` and `Symm` now work for factors of length 1 * as`gnm` now returns object with `"gnm"`-type terms component * print method for `"profile.gnm"` objects now exported Changes in gnm 0.9-3 ==================== New Features ------------ * added `DrefWeights` for computing the weights in a diagonal reference term and the corresponding standard errors. Improvements ------------ * `"assign"` attribute now attached to the parameter vector when passed to start functions defined by `"nonlin"` functions, specifying the correspondence between parameters and predictors in the nonlinear term. Bug fixes --------- * start function in `Dref` now identifies weight parameters correctly. * can now evaluate term predictors for `"nonlin"` terms that depend on covariates. Changes in gnm 0.9-2 ==================== Improvements ------------ * Calls to `"nonlin"` functions now evaluated in the same environment and enclosure as call to create model frame, so `"nonlin"` functions should be able to find variables in gnm calls - potentially useful for setting starting values. Bug fixes --------- * `gnm` algorithm now reinitiates correctly when restarting after non-convergence. * `gnm` now works correctly when a model is specified with nonlinear terms in between linear terms. Changes in gnm 0.9-1 ==================== New Features ------------ * introduction of functions of class `"nonlin"` for the unified specification of nonlinear terms. `Mult`, `Exp`, `Dref` and `MultHomog` have all been converted to functions of this class. * added `Inv` to specify the reciprocal of a predictor. * added `Const` to specify a constant in a predictor. * added `instances` to specify multiple instances of a nonlinear term. Improvements ------------ * nonlinear terms can now be nested. * `Exp` can now be used outside of `Mult` or to exponentiate part of a constituent multiplier. Changes in Behaviour -------------------- * to accommodate the increased functionality introduced by `"nonlin"` functions, new labelling conventions have been introduced. In particular, most `"nonlin"` functions use argument-matched parameter labels. * in the new implementation of `Dref` the `formula` argument has been re-named `delta` to provide more informative parameter labels under the new conventions. Bug fixes --------- * specifying `ofInterest = "[?]"` in `gnm` now works as documented. Changes in gnm 0.8-5 ==================== New Features ------------ none in this release Improvements ------------ * added a new `ridge` argument to gnm, to allow some control over the Levenberg-Marquardt regularization of the internal least squares calculation * changed the default ridge constant to 1e-8 (from 1e-5), to increase speed of convergence (especially in cases where there are infinite parameter estimates) * modified the `"qr"` method so that it no longer checks for rank deficiency (it was both unreliable, and not necessary since the matrix is regularized prior to solving) * substantial speed improvements in model fitting when there are large numbers of eliminated parameters, achieved mainly via a new internal function `cholInv1`. Corresponding example timings changed in the Overview document (vignette). * speed improvements in `vcov.gnm` when there are eliminated parameters; new logical argument `use.eliminate` gives control over this * in `getContrasts`, added new arguments `dispersion` and `use.eliminate`, both of which are passed on to `vcov` * implemented faster alternatives to `ifelse` in `gnmFit` * speed gains from use of `tcrossprod`. Because of this the gnm package now requires R 2.3.0 or later. Changes in Behaviour -------------------- * in `gnm`, changed the default value of argument x to `TRUE` (it was previously `FALSE`) * in `checkEstimable`, changed the name of the first argument from `coefMatrix` to `combMatrix` (to reflect better that it is a matrix of coefficient *combinations*); and changed the default tolerance value to one which should give more reliable results. Also, more fundamentally, changed the check to be whether combinations are in the column span of `crossprod(X)` instead of the row span of `X`; the results should be the same, but the new version is much faster for large n. * `model.matrix.gnm` no longer passes extra arguments to gnm as it's unlikely to be useful/sensible. For the same reasons it will not pass extra arguments to `model.frame`, unlike `model.matrix.lm` * `getContrasts` now results in a list only when the `sets` argument itself is a list; otherwise (i.e., normally) the result is a single object (rather than a list of objects) of class `qv` Bug fixes --------- * fixed a bug in internal function `quick.glm.fit`, which greatly improves its performance. Also changed the default value of the `nIter` argument from 3 to 2. * fixed a small bug in `demo(gnm)` * fixed a bug in `vcov.gnm`, which previously gave an error when data were of class `"table"`) * fixed `summary.gnm` so that it now takes proper account of the dispersion argument * in `se`, added new arguments `Vcov` and `dispersion`; the latter fixes a bug, while the former minimizes wasted computation in `summary.gnm` * fixed bug in `model.matrix.gnm` so that it can compute the model matrix even when original data is not available - unless model frame has not been saved. Original data still needed to update model frame - this is the same as for glms, etc. * fixed bug in `gnm` so that reconstructing `"table"`-class data works for models with weights/offsets Changes in gnm 0.8-4 ==================== New Features ------------ * added `"gnm"` methods for `profile` and `confint`. Use of `alpha` argument differs slightly from `"glm"` methods: see help files. * `constrain` argument to `gnm` now supplemented by `constrainTo` argument, allowing specification of values to which parameters should be constrained. * `gnm` now has `ofInterest` argument to specify a subset of coefficients which are of interest - returned in `ofInterest` component of `"gnm"` object as named numeric vector. `print` summaries of model object/its components extracted by accessor functions only print coefficients of interest and (where appropriate) methods for `"gnm"` objects select coefficients of interest by default. * added `ofInterest` and `ofInterest<-` to extract/replace `ofInterest` component of `"gnm"` object. * added `parameters` which returns coefficient vector with constrained parameters replaced by their constrained value. * added `pickCoef` function to aid selection of coefficients - returns numeric indices of coefficients selected by Tk dialog or regular expression matching. Improvements ------------ * `constrain` argument to `gnm` now accepts a regular expression to match against coefficient names. Changes in Behaviour -------------------- * `constrain` component of `"gnm"` objects is now a numeric, rather than logical, vector of indices. * all `"gnm"` methods for which a subset of the coefficients may be specified by numeric indices now interpret those indices as referencing the full coefficient vector (not just non-eliminated parameters). * `gnm` now preserves order of terms rather than moving all linear terms to the start (this fixes bug in `anova.gnm`). * the `"pick"` option for the `constrain` argument to `gnm` and the `estimate` argument to `se` has been replaced by `"[?]"` to avoid possible conflict with coefficient names/regular expressions. Bug Fixes --------- * fixed bug in `se` so will now work for single parameter. * fixed bug in `summary.gnm` so will now work for models with one parameter. * fixed bug in `anova` so that rows of returned table are correct for models with eliminated terms. * fixed bug in `eliminate` so that it now accepts interactions. * fixed bug in `MPinv` so that it works for models in which all parameters are eliminated. Changes in gnm 0.8-3 ==================== Improvements ------------ * improved use of functions from other packages Bug Fixes --------- * fixed bug in `asGnm.lm` where object not fully identified * corrected maintainer address in DESCRIPTION! Changes in gnm 0.8-2 ==================== New Features ------------ * added demonstration script to run using `demo` * added package help file, opened by package?gnm Improvements ------------ * improved existing documentation Changes in gnm 0.8-1 ==================== New Features ------------ * added the `method` argument to `MPinv`, to allow the method of calculation to be specified. Permitted values are `"svd"` to compute the pseudo-inverse by singular value decomposition, and `"chol"` to use the Cholesky decomposition instead. The latter is valid only for symmetric matrices, but is usually faster and more accurate. * added the `lsMethod` argument to `gnm`, to allow specification of the numerical method used for least-squares calculations in the core of the iterative algorithm. Permitted options are `"chol"` and `"qr"`. * added new function `qrSolve`, which behaves like `base::qr.coef` but in the non-full-rank case gives the minimum-length solution rather than an arbitrary solution determined by pivoting. * added `.onUnload` so that compiled code is unloaded when namespace of package is unloaded using `unloadNamespace`. * added `coef` argument to `model.matrix.gnm` so that the model matrix can be evaluated at any specified value of the parameter vector. * added as`gnm` generic to coerce linear model objects to gnm objects. * added `exitInfo` for printing numerical details of last iteration on non-convergence of `gnm`. * added new dataset, friend, to illustrate a workaround to fit a homogeneous RC(2) using `gnm` - documented in help file for `MultHomog`. Improvements ------------ * `gnm` now takes less time per (main) iteration, due to improvements made internally in the iterative algorithm. These include pre-scaling of the local design matrix, and Levenberg-Marquardt adjustment of the least-squares solvers so that rank determination is no longer necessary. * the default convergence tolerance has been tightened (from 1e-4 to 1e-6) * modified `model.matrix.gnm` so it can be used when only the namespace of gnm is loaded. Bug Fixes --------- * fixed bug in `gnm` so that `subset` now works with table data. * fixed bug in `model.matrix.gnm` so can construct model matrix from `"gnm"` object even when original call not made in `.GlobalEnv`. * fixed bug in the examples on help page for `House2001` data. * fixed bug so that `formula` in `gnm` now accepts `.` in formulae even when `eliminate = NULL`. * fixed bug in `getContrasts`, so that the first two columns of the qvframe component of each element of the result list are correctly named as "estimate" and "SE", as required for objects of class "qv". Changes in gnm 0.8-0 ======================= New Features ------------ * added `"model.matrix"` option for `method` argument of `gnm` so that model matrix can be obtained much faster. The new method is used in `model.matrix.gnm` and `vcov.gnm`. * added new utility function `residSVD`, to facilitate the calculation of good starting values for parameters in certain `Mult` terms. * added new dataset `House2001`, to illustrate the use of `gnm` in Rasch-type scaling of legislator votes. * added new utility function `expandCategorical` for expanding data frame on the basis of a categorical variable. * added `formula.gnm` method - returns formula from `"gnm"` object excluding the `eliminate`d factor where necessary. Improvements ------------ * `gnm` now takes less time to run due to improvements made in internal functions. * the fitting algorithm used by `gnm` now copes better with zero-valued residuals. * output given by `gnm` when `trace = TRUE` or `verbose = TRUE` is now displayed as it is generated on console-based versions of R. * `plot.gnm` now includes option `which = 5` as in `plot.lm` in R >= 2.2.0. Now has separate help page. * the `constrain` argument to `gnm` now accepts the names of parameters. * the `formula` argument to `gnm` now accepts `.` as described in `?terms.formula`, ignoring eliminated factor if in `data`. * interface for `se` extended - can now use to find standard errors for all parameters or (a selection of) individual parameters in a gnm model. * made it possible to use `gnm` with alternative fitting function. * `".Environment"` attribute now attached to `"gnm"` objects so that gnm package loaded when workspace containing `"gnm"` objects is loaded. Changes in Behaviour -------------------- * start-up iterations now only update column of design matrix required in next iteration. Therefore plug-in functions using the default start-up procedure for nonlinear parameters need a `localDesignFunction` with the argument `ind` specifying the column that should be returned. * modified output given by `gnm` when `trace = TRUE`: now prints initial deviance and the deviance at the end of each iteration. * modified updates of linear parameters in starting procedure: now offset contribution of fully specified terms only. * results of `summary.gnm`, `vcov.gnm` and `coef.gnm` now include any eliminated parameters. Print methods have been added for `"vcov.gnm"` and `"coef.gnm"` objects so that any eliminated parameters are not shown. * `Mult` terms are no longer split into components by `anova.gnm`, `termPredictors.gnm`, `labels.gnm` or the `"assign"` attribute of the model matrix - consistent with `terms` output. * the `eliminate` argument to `gnm` must now be an expression that evaluates to a factor - this reverts the extension of 0.7-2. * when using `gnm` with `constrain = "pick"`, the name(s) of the chosen parameter(s) will replace `"pick"` in the returned model call. * `getContrasts` now uses first level of a factor as the reference level (by default). * `gnmControl` replaced by arguments to `gnm`. * `gnm` now uses `glm.fit` for linear models (with control parameters at the `gnm` defaults) unless `eliminate` is non-`NULL`. * `vcov.gnm` and `summary.gnm` now return variance-covariance matrices including any aliased parameters. * `summary.gnm` now returns standard errors with test statistics etc, where estimated parameters are identified. Bug Fixes --------- * fixed bug in `summary.gnm`, `anova.gnm`, `termPredictors.gnm` and `model.matrix.gnm` where search for model variables was incorrect. * fixed bug preventing estimation of weight parameters in `Dref` terms and changed default starting values so that these parameters no longer sum to one or appear to be estimable. * corrected options for `method` argument in `gnm` help file: replaced `method = "coef"` with `method = "coefNames"`. * fixed bug in `gnm` so that it can handle tables with missing values when formatting components of fit. * `hatvalues.gnm` now works for objects produced from table data. * `residuals.gnm` now returns table not matrix when `type = "deviance"` for `"gnm"` objects produced from table data. * `hatvalues.gnm`, `cooks.distance.gnm` and `plot.gnm` now handle cases which are fitted exactly (giving a hat value of 1). * example fitting proportional odds model in `backPain` help file now works. * fixed bug in `Mult` terms so that an offset can be added to a constituent multiplier without an unspecified intercept being added also. * `gnm` argument `constrain = "pick"` now allows selection of more than one constraint and is compatible with use of `eliminate`. * `gnm` can now fit models which only have the term specified by `eliminate`. Changes in gnm 0.7-2 ======================= Improvements ------------ * Extended use of the `eliminate` argument of `gnm` to allow crossed factors - this also fixes bug which occurred when interactions were eliminated in the presence of lower order terms involving other factors Changes in Behaviour -------------------- * `vcov` returned by `gnm` now has no rank attribute (as before, the rank is returned as the separate component `rank`). Bug Fixes --------- * Changed the calculation of `df.residual` returned by `gnm` to correctly take account of zero-weighted observations (as in `glm`). * When `gnm` is called with arguments `x = TRUE` or `VCOV = TRUE`, the returned matrices now include columns of zeros for constrained parameters. * Corrected evaluation of model frame in `gnm` so that if data is missing, variables are taken from `environment(formula)`, as documented. Modified evaluation of plug-in functions to be consistent with this, i.e. objects are taken from `environment(formula)` if not in model frame. * `MPinv` now checks that the diagonal elements of an `eliminate`d submatrix are all non-zero and reports an error otherwise. Changes in gnm 0.7-1 ======================= New Features ------------ * `Topo` introduced for creating topological interaction factors. * `anova` implemented for objects of class `c("gnm", "glm")`. Improvements ------------ * Diagnostic messages given by `gnm` have been improved. * Step-halving introduced in main iterations of `gnm` to ensure deviance is reduced at every iteration. * `getContrasts` now (additionally) reports quasi standard errors, when available. * Calls to `gnm` plug-in functions are now evaluated in the environment of the model frame and the enclosing environment of the parent frame of the call to `gnm`. This means that variables can be found in a more standard fashion. Changes in Behaviour -------------------- * The `data` argument of `Nonlin` is defunct: `Nonlin` now identifies variables to be added to the model frame as those passed to unspecified arguments of the plug-in function or those identified by a companion function to the plug-in, which is of a specified format. * The (optional) `start` object returned by a plug-in function can no longer be a function, only a vector. However it may now include `NA` values, to indicate parameters which may be treated as linear for the purpose of finding starting values, given the non-`NA` values. Bug Fixes --------- * The `eliminate` argument of `gnm` now handles functions of variables in the given formula e.g. `~ strata(A, B), ~ as.factor(A):as.factor(B)`, etc. * `gnm` was giving an error for models with either no linear parameters, or none specified by the `start` argument, this is now fixed. * Long calls to plug-in functions caused problems in parsing the model formula: now fixed. * `gnm` now only restarts after failing if there are unspecified nonlinear parameters. * `gnm` now returns `NULL` if model fails. * Bug fixed in calculation of starting values for `gnm` that occurred when some parameters were constrained. gnm/MD50000644000176200001440000002415113616026022011344 0ustar liggesusers651affac53d5074bc971d8b51d572764 *DESCRIPTION 83a86c20a913e193eec23fbdf022f4c6 *NAMESPACE 8e07ef5094b82f4de84ad3a67633da8e *NEWS.md 854496a25c0c74492a5047b936d55ab5 *R/Const.R bc8a3dff0415b0253454aa34ffe16b38 *R/Diag.R 5fee39db2b681eff9a6b1b0cd336eb94 *R/Dref.R e20fafcb9c40fa3fb4ad864ce638fd28 *R/DrefWeights.R 7a7e2f355094ea09b3727919a2a810f7 *R/Exp.R 1163bbf6c25fb51810d0219643d31fb4 *R/Inv.R 1be94a5f1cbc953c9547efcd219250f9 *R/Log.R 948e44dbfd7e9b44638fa6e804f5623f *R/Logistic.R 32ce6aac8288253199fd161a3750edc6 *R/Logit.R 3820f8ae17dd6e16bd3f7b3ff78c0c8a *R/MPinv.R ce0a897eb161f67a8b3e1a9758dd6e7b *R/Mult.R 56b99626a0fabc857f5b5740a7b16719 *R/MultHomog.R cd7fd3c31dd817fcdd8fd533926279a7 *R/Raise.R bd4e1bd5fe574399b147788ec559afc8 *R/Symm.R 914ffbf061e95a91e31ba55578eb6460 *R/Topo.R 108a36fca967d40cf512c7a0648bac63 *R/add1.gnm.R 3fa8820d54cbd3ccc84bf37f583d1104 *R/addterm.gnm.R c11c021ce659dcaa94158059983e0498 *R/alias.gnm.R b596dd030bb03fddc54f47c216584a78 *R/anova.gnm.R ce592c42122cc711bda928ee403e4105 *R/asGnm.R 3133d8a14d3f6df07bdc093409b8d664 *R/asGnm.default.R 3f343550a46023f76d92fb43dfe18e81 *R/asGnm.glm.R fbe0395a6fe899b3412606d88153ad12 *R/asGnm.lm.R 954badc596f77b0aac6615e41c214717 *R/boxcox.gnm.R 75b9c6027d9e86f0a44bb0c16458e873 *R/checkCall.R c6fbfbd53511fea8b3706e37c1db6ac6 *R/checkEstimable.R e63ec69e101db9fc21f212575b2e125d *R/cholInv.R f8239fe470d0d8e3a74c1c5e32c2b070 *R/coef.gnm.R 055e4800edc247e51a3754ed97a7bd80 *R/confint.gnm.R 58aae1a1d29f4b4d8b4c057238476cf9 *R/confint.profile.gnm.R c41c1536e1866d8037032da16de62f47 *R/cooks.distance.gnm.R aae1beb67cc6062c2f0d1fb4f28c2238 *R/dfbeta.gnm.R 31254d1c7c6eed6abe766b71208b8722 *R/dfbetas.gnm.R 493cf97f1edd024f8b6c9473a50823cf *R/drop1.gnm.R 597fb498683d628c7d52f2e288289ab1 *R/dropterm.gnm.R 7b226f6597ab38664e89de3b319c11ca *R/dummy.coef.gnm.R 35aa210357604f393bc2994a25821b94 *R/effects.gnm.R 654710a33bb547685fdea664e3c03e9e *R/exitInfo.R 64bc4cfd43ac4b8089f877316a8f2382 *R/expandCategorical.R 5e4aaa614ef38eafe07f57eba879d957 *R/fitted.gnm.R 28011986544115860b64ffdf9a8526ed *R/getContrasts.R 699387219fa5bf06442abb43618dfb9b *R/getData.R 812e73053b531c9a15f44072f3a76832 *R/glm.fit.e.R 512c1d6b73395b508ad1095c9783453d *R/gnm-defunct.R bf663ae5c2dd88a4f327d94f87f9061e *R/gnm.R 5b64d576541a0b4f9685e05d6bfe86dc *R/gnmFit.R 4d9338e33215facd25e8b7cf4ea90987 *R/gnmStart.R 6a282326dd437d1ba4fc69b33618e0d5 *R/gnmTerms.R 0a5a6b6bf70bcbe65617be17de77c952 *R/gnmTools.R b6be5ae7a90f3cdc0e9d054505d1dfdb *R/grp.sum.R 68992380696b028e9c7a6cd24b52b2bc *R/hashSplit.R 0211542e7701cda87f26f69d4ed516c1 *R/hatvalues.gnm.R 6a8b167dd634bd1533f51ff2cf781e84 *R/influence.gnm.R c77000f134b8096b3f55c9efb977e73b *R/instances.R fd6cbaee5c3d909a31889dba229741e4 *R/kappa.gnm.R 0120485b96379a3d741ef386f1dedebb *R/labels.gnm.R 876d01bb73a00985db1c3bb8ab8a3206 *R/logtrans.gnm.R 406094dcdc99491118ace40866547310 *R/meanResiduals.R af43d37bfd33c2c1325eaa7fef761c78 *R/model.frame.gnm.R 838e4f634c956834ff3209838b95f074 *R/model.matrix.gnm.R a0f246dfc591ea337f018f72100c9ded *R/naToZero.R e966c500a3d16dfb144d25079340f631 *R/nonlinTerms.R 7f89fd4a6221fa64df48b8f86ca80ec3 *R/ofInterest.R fff5e4bc8436a682778488b6396c9084 *R/ofInterestReplacement.R 2b3a80421fb27a5f9f1a1536f6d0bcdb *R/parameters.R b1efbfb8af7d24545d30984bcd60cba1 *R/pickCoef.R 6906b976d65ef298d87a08dab3780343 *R/plot.gnm.R ecf041f5e07f0eee6eabb4292aa9a900 *R/plot.profile.gnm.R 0fa72da0fdaa6b5ff02be15e14593ccf *R/pprod.R 50c8ed0dc792d486adf8defb3311e48f *R/prattle.R 06da18aad2eb637edd3a66dca30bfe81 *R/predict.gnm.R 3b21b08dbeb848c8c5fc202f68d32818 *R/print.coef.gnm.R 385e40991edec5085c915233e68e21bd *R/print.gnm.R 684777a967c1e1b7f164434d2eb2c028 *R/print.meanResiduals.R 2d6c45e2770708678c7d97bc9c3bb4cc *R/print.profile.gnm.R 9689be0a5036c00d99b0287a5a2ff422 *R/print.summary.gnm.R 0db04b53db8222364c02cfada6a4ee98 *R/print.vcov.gnm.R 2e07923ea518e4d62738e7c88fb49dac *R/profile.gnm.R 07123ec72cd3e255f1556af97c10f8cc *R/proj.gnm.R 6397c01c19d1dc9e2e53ba447c3afa8f *R/psum.R 0c101c57f953af46125d1dd658294483 *R/quick.glm.fit.R c7ef02916b6b62a2e5b5a8a5a9b55fce *R/quickRank.R 43ec16af9dd0892c16d0af99f3b16b69 *R/residSVD.R 87a178b9b723b19f6d6ce19d0e2a1b8c *R/residuals.gnm.R 279be6c011ff254bcd7bd7428d3c90b9 *R/rstandard.gnm.R 99830d4e74dfa4f0a1c539135e2e7370 *R/rstudent.gnm.R c7d7198d9d3cb9e9731d6894b9440357 *R/se.R 150226136bf1ca5996f68cd68866fc05 *R/sumExpression.R 2fab87fb5a52585e7a57b2fbf45c2484 *R/summary.gnm.R 49ac30c6ea6e498b38d0b7af19b16516 *R/summary.meanResiduals.R 6b5ac9ba80f30a49a5b7901b3f4dce0e *R/termPredictors.R 2bdbd1e59eaf31da95f953b9f6bd44d1 *R/termPredictors.default.R 0fcea4dfca5685734a3c594d853b905d *R/termPredictors.gnm.R 67d461ed7923cb56f17ce1f692ea96da *R/unlistOneLevel.R fa215eb5f9dcb9bfd840cf12e3bd3706 *R/update.gnm.R 939d8938906a946a477745a3adc6c5c3 *R/updateLinear.R 192d90bae21e8ed3bd4c37997ee522fc *R/variable.names.gnm.R 28d29a7f7929e686240f649c43d70686 *R/vcov.gnm.R 0ba281b4a6492dc7e28cafb62b442056 *R/wedderburn.R af58d5d6c6349e1353f1c8811f5abaec *R/weighted.MM.R 051baec2bdd0bce8410af20d4448deac *R/weights.gnm.R 89f80acb87709420ed295ea1b85af636 *R/zzz.R 94e272985639ca9590a398fdf69f4de7 *README.md 22ea155f9959cd2f00b0181c1ea8b759 *TODO 4e1916103613598bd9c2834079a10139 *build/vignette.rds 5997a09c57ad12a1afcefbc9b7df55d0 *data/House2001.rda 251362065802d1cf6156d4a38c0bb9d0 *data/backPain.rda 97515be36a9357f9f9e0a83e5a84e0ca *data/barley.rda 44f544e054b8a5c4109c04f22abaaa1f *data/barleyHeights.rda c1dc8a79d9817f075013eb7a8b4e63ac *data/cautres.rda 48065dd251430e6736481f94bde73a63 *data/erikson.rda f2dac42aba1457a2f7a14ec44fb0cee0 *data/friend.rda cd1bc2845ab2779f40dc2aa5b91649d5 *data/mentalHealth.rda 15df182e94b640e9600e251916e6bbae *data/voting.rda 41ae94100dd0a463b390445c0658044a *data/wheat.rda 99079b4698da131f08824b393b9da9f5 *data/yaish.rda c8c477e8cc92a00190fc07f155cc1df8 *demo/00Index c9d7e30a137b9f9fb6311ecf82d81842 *demo/gnm.R a2ac7a7f42b645a338e527f37879b7e9 *inst/CITATION 9b7107fa0c02a0902365be914e986039 *inst/WORDLIST 7ca3b3eb71c300a9339a3535f3524bb9 *inst/doc/gnmOverview.R adaeaa3c6e1dbdff60b065ea5cb6f479 *inst/doc/gnmOverview.Rnw 1b189144d0b0fe902234445c91fd6881 *inst/doc/gnmOverview.pdf 85e992e91d7cba65da2a6d599bd31413 *man/Const.Rd 67f8c5a6c456a0822ff537db42a6b0c2 *man/Diag.Rd 0358eb8f515685aa7cc613e41ed1b887 *man/Dref.Rd d474d3d982cec7798cee2d76e547bfb6 *man/Exp.Rd f01b62d1ceb9a304e5874125cba7cac4 *man/House2001.Rd 264892ca68e2b7c62ed161035af01d9e *man/Inv.Rd bfb3220d153ffb0a9ca78878149ff28a *man/MPinv.Rd b56090e88095215fdbe1c862b98117f5 *man/Mult.Rd 858863f066143f20bc98e248e4e06823 *man/MultHomog.Rd e1bf703ece928af9d70bcc15ca5f2e61 *man/Symm.Rd f017554959aab092565af8492f60da73 *man/Topo.Rd 5ca24d22d50cb807d73839ffef9fa2c0 *man/anova.gnm.Rd 3709acc93ded6573df4aff6e7ac299b1 *man/asGnm.Rd 8006f41596e0d8de7b3dc6f6edee539b *man/backPain.Rd 854f6de396cf1435127151a005fd4d7b *man/barley.Rd 1847ccfd274aefeb23138f23da285af0 *man/barleyHeights.Rd f1a7a3da20cfc54cba892c3efc96f530 *man/cautres.Rd 10886ac6db3bf0db24893af1259fa44e *man/checkEstimable.Rd 8afc75479d7d6110071e64ea54ced037 *man/confint.gnm.Rd a33abb43f7ca09dd3f79d6f95dcc08e7 *man/erikson.Rd 5efe06dbc64e8e8eeab5ae5260a6c7fa *man/exitInfo.Rd 3bcdfd9f64e952fadebb773dc7799113 *man/expandCategorical.Rd 761ca574a0deec5c8d07683806029efa *man/friend.Rd aa00cc98395cf8917a0059f541ab1f84 *man/getContrasts.Rd 5db92406797fbf7005362f638dd72983 *man/gnm-defunct.Rd 208e6ad06c53ef31dc053af2dcb55031 *man/gnm-package.Rd 26488938eae8248198e9b56fad2e02b1 *man/gnm.Rd ed561d469b59eb78fee8cfc94423c5b4 *man/instances.Rd 5875a3c18e4d92e9499a72c4b7443c18 *man/meanResiduals.Rd 7f020321e45f8862fbff8f8db391d263 *man/mentalHealth.Rd fae4fd1c5b87ac311be846bd0818c1e1 *man/model.matrix.gnm.Rd ad5b6dd7b9d4dd661661923a2f417f11 *man/nonlin.function.Rd 07ee19b158b956dd857140fcca5faa6d *man/ofInterest.Rd 16e981f6532b4ef22679cd20b6c83b58 *man/parameters.Rd 23319a78ceaf845c4eb50d02192d08d4 *man/pickCoef.Rd dfcffdf6846ac9ca365a9e35dd676cb2 *man/plot.gnm.Rd 9e07000e50faedda6d0828cb889a35f2 *man/predict.gnm.Rd 846ef920aee4a61c0024b9405c239462 *man/profile.gnm.Rd 90144720cb986b40e1e35096ef02c176 *man/residSVD.Rd fae67a2d246f4f95e24aa96ca00ef115 *man/se.Rd 2d0e3ecdb6d44468695138e619447e15 *man/se.gnm.Rd fd356b9fd0ad27345b9fa452a035ce5b *man/summary.gnm.Rd badbc1338de4cc070474541ba8db74cb *man/termPredictors.Rd fa22e4de02c3e5d638e6d5cf3aa4cf83 *man/vcov.gnm.Rd e2b7330e553d7fa198f4ee866547e047 *man/voting.Rd 86e2c54eede728c71f53fffe588b4747 *man/wedderburn.Rd 45f6173b89f29140a32b451db068a05f *man/wheat.Rd 382958f7c88a849929c32db5d54cfc92 *man/yaish.Rd 2fa4c7011c2bc0f7449ae151d5cc44ae *src/Makevars d21a171eeb76f8215a4d222ec172b432 *src/gnm.c 584b4f0b9a696c0d772e103692c4ca54 *tests/testthat/outputs/RChomog2.rds 4dc90c79e7fdafa3938246495dd12329 *tests/testthat/outputs/biplotModel.rds b674ed3781e3b020b88f6b3980dde069 *tests/testthat/outputs/doubleUnidiff-contrasts.rds 40ae3e473c2b0ce55686d1ea916230ba *tests/testthat/outputs/doubleUnidiff.rds cf89365fd532d144509b0b84040e62b4 *tests/testthat/outputs/yaish-mult.rds f3558c731d924e7e16167672937b080c *tests/testthat/test-RC.R 3ff7d79c6ab8ede9ab8718308ed208ea *tests/testthat/test-RChomog.R 3c287dc584b5980086376f5632ad268d *tests/testthat/test-biplot.R 659095e7b964a22ed72612c3998bc135 *tests/testthat/test-bwt.R 612fbb9a03d8b8f07bdbe63dc1f06ee1 *tests/testthat/test-diagonalRef.R a0d6af7c6f9cb9b0765eef7581f24392 *tests/testthat/test-doubleUnidiff.R be0a66db6808ee46ba79b508e8e23db8 *tests/testthat/test-gammi.R 9f7085533299ff0f9ff3bd2b934bbe31 *tests/testthat/test-logistic.R b3f15597decce1ad96f594136ecb938a *tests/testthat/test-stereotype.R 8501b0386c1efafa0a4f934f6388da37 *vignettes/fig-Effect_plots.pdf fd726d14883e8a94f45664a8ce062803 *vignettes/fig-LCall.pdf 596d106d3518e1cb77dbe23745d2f32a *vignettes/fig-LCover45.pdf e77867e5284795f1ed6d089899067d9c *vignettes/fig-LCqvplot.pdf ed765957742f3d6e102227a3ae699b04 *vignettes/fig-deaths1921-1940.pdf 39c2eaa3b5904faca6c419c0cab7b70e *vignettes/fig-profilePlot.pdf d39bcd84e80e26b411e58a29a7ebf113 *vignettes/gnm.bib adaeaa3c6e1dbdff60b065ea5cb6f479 *vignettes/gnmOverview.Rnw f7bb932423c663aba2113c8ebb840cdc *vignettes/screenshot1.png 49e2d977c91fc67eceac382b56480625 *vignettes/screenshot2.png 91bb1eb0a9bef5dae03f658159ad9ac1 *vignettes/screenshot3.png gnm/inst/0000755000176200001440000000000013615621570012016 5ustar liggesusersgnm/inst/doc/0000755000176200001440000000000013615621570012563 5ustar liggesusersgnm/inst/doc/gnmOverview.Rnw0000744000176200001440000037613313544666014015604 0ustar liggesusers%\VignetteIndexEntry{Generalized nonlinear models in R: An overview of the gnm package} %\VignetteKeywords{Generalized Nonlinear Models} %\VignettePackage{gnm} \documentclass[a4paper]{article} \usepackage[english]{babel} % to avoid et~al with texi2pdf \usepackage{Sweave} %\usepackage{alltt} % now replaced by environments Sinput, Soutput, Scode \usepackage{amsmath} %\usepackage{times} %\usepackage[scaled]{couriers} \usepackage{txfonts} % Times, with Belleek math font and txtt for monospaced \usepackage[scaled=0.92]{helvet} %\usepackage[T1]{fontenc} %\usepackage[expert,altbullet,lucidasmallerscale]{lucidabr} \usepackage{booktabs} \usepackage[round,authoryear]{natbib} \usepackage[left=2cm,top=2.5cm,nohead]{geometry} \usepackage{hyperref} \usepackage{array} % for paragraph columns in tables %\usepackage{moreverb} \setkeys{Gin}{width=0.6\textwidth} %% The next few definitions from "Writing Vignettes for Bioconductor Packages" %% by R Gentleman \newcommand{\Robject}[1]{{\emph{\texttt{#1}}}} \newcommand{\Rfunction}[1]{{\emph{\texttt{#1}}}} \newcommand{\Rcode}[1]{{\emph{\texttt{#1}}}} \newcommand{\Rpackage}[1]{{\textsf{#1}}} \newcommand{\Rclass}[1]{{\emph{#1}}} \newcommand{\Rmethod}[1]{{\emph{\texttt{#1}}}} \newcommand{\Rfunarg}[1]{{\emph{\texttt{#1}}}} \newcommand{\R}{\textsf{R}} \newcommand\twiddle{{\char'176}} %\setlength{\oddsidemargin}{0.5in} %\setlength{\evensidemargin}{0.5in} %\setlength{\textwidth}{5.5in} \setlength{\itemindent}{1cm} \title{Generalized nonlinear models in \R: An overview of the \Rpackage{gnm} package} \author{Heather Turner and David Firth\footnote{ This work was supported by the Economic and Social Research Council (UK) through Professorial Fellowship RES-051-27-0055.}\\ \emph{University of Warwick, UK} } \date{For \Rpackage{gnm} version \Sexpr{packageDescription("gnm")[["Version"]]} , \Sexpr{Sys.Date()}} \begin{document} \maketitle {\small \tableofcontents } <>= options(SweaveHooks = list(eval = function() options(show.signif.stars = FALSE))) @ \section{Introduction} The \Rpackage{gnm} package provides facilities for fitting \emph{generalized nonlinear models}, i.e., regression models in which the link-transformed mean is described as a sum of predictor terms, some of which may be non-linear in the unknown parameters. Linear and generalized linear models, as handled by the \Rfunction{lm} and \Rfunction{glm} functions in \R, are included in the class of generalized nonlinear models, as the special case in which there is no nonlinear term. This document gives an extended overview of the \Rpackage{gnm} package, with some examples of applications. The primary package documentation in the form of standard help pages, as viewed in \R\ by, for example, \Rcode{?gnm} or \Rcode{help(gnm)}, is supplemented rather than replaced by the present document. We begin below with a preliminary note (Section \ref{sec:glms}) on some ways in which the \Rpackage{gnm} package extends \R's facilities for specifying, fitting and working with generalized \emph{linear} models. Then (Section \ref{sec:nonlinear} onwards) the facilities for nonlinear terms are introduced, explained and exemplified. The \Rpackage{gnm} package is installed in the standard way for CRAN packages, for example by using \Rfunction{install.packages}. Once installed, the package is loaded into an \R\ session by <>= library(gnm) @ \section{Generalized linear models} \label{sec:glms} \subsection{Preamble} Central to the facilities provided by the \Rpackage{gnm} package is the model-fitting function \Rfunction{gnm}, which interprets a model formula and returns a model object. The user interface of \Rfunction{gnm} is patterned after \Rfunction{glm} (which is included in \R's standard \Rpackage{stats} package), and indeed \Rfunction{gnm} can be viewed as a replacement for \Rfunction{glm} for specifying and fitting generalized linear models. In general there is no reason to prefer \Rfunction{gnm} to \Rfunction{glm} for fitting generalized linear models, except perhaps when the model involves a large number of incidental parameters which are treatable by \Rfunction{gnm}'s \emph{eliminate} mechanism (see Section \ref{sec:eliminate}). While the main purpose of the \Rpackage{gnm} package is to extend the class of models to include nonlinear terms, some of the new functions and methods can be used also with the familiar \Rfunction{lm} and \Rfunction{glm} model-fitting functions. These are: three new data-manipulation functions \Rfunction{Diag}, \Rfunction{Symm} and \Rfunction{Topo}, for setting up structured interactions between factors; a new \Rclass{family} function, \Rfunction{wedderburn}, for modelling a continuous response variable in $[0,1]$ with the variance function $V(\mu) = \mu^2(1-\mu)^2$ as in \citet{Wedd74}; and a new generic function \Rfunction{termPredictors} which extracts the contribution of each term to the predictor from a fitted model object. These functions are briefly introduced here, before we move on to the main purpose of the package, nonlinear models, in Section \ref{sec:nonlinear}. \subsection{\Rfunction{Diag} and \Rfunction{Symm}} When dealing with \emph{homologous} factors, that is, categorical variables whose levels are the same, statistical models often involve structured interaction terms which exploit the inherent symmetry. The functions \Rfunction{Diag} and \Rfunction{Symm} facilitate the specification of such structured interactions. As a simple example of their use, consider the log-linear models of \emph{quasi-independence}, \emph{quasi-symmetry} and \emph{symmetry} for a square contingency table. \citet{Agre02}, Section 10.4, gives data on migration between regions of the USA between 1980 and 1985: <>= count <- c(11607, 100, 366, 124, 87, 13677, 515, 302, 172, 225, 17819, 270, 63, 176, 286, 10192 ) region <- c("NE", "MW", "S", "W") row <- gl(4, 4, labels = region) col <- gl(4, 1, length = 16, labels = region) @ The comparison of models reported by Agresti can be achieved as follows: <>= independence <- glm(count ~ row + col, family = poisson) quasi.indep <- glm(count ~ row + col + Diag(row, col), family = poisson) symmetry <- glm(count ~ Symm(row, col), family = poisson) quasi.symm <- glm(count ~ row + col + Symm(row, col), family = poisson) comparison1 <- anova(independence, quasi.indep, quasi.symm) print(comparison1, digits = 7) comparison2 <- anova(symmetry, quasi.symm) print(comparison2) @ The \Rfunction{Diag} and \Rfunction{Symm} functions also generalize the notions of diagonal and symmetric interaction to cover situations involving more than two homologous factors. \subsection{\Rfunction{Topo}} More general structured interactions than those provided by \Rfunction{Diag} and \Rfunction{Symm} can be specified using the function \Rfunction{Topo}. (The name of this function is short for `topological interaction', which is the nomenclature often used in sociology for factor interactions with structure derived from subject-matter theory.) The \Rfunction{Topo} function operates on any number ($k$, say) of input factors, and requires an argument named \Rfunarg{spec} which must be an array of dimension $L_1 \times \ldots \times L_k$, where $L_i$ is the number of levels for the $i$th factor. The \Rfunarg{spec} argument specifies the interaction level corresponding to every possible combination of the input factors, and the result is a new factor representing the specified interaction. As an example, consider fitting the `log-multiplicative layer effects' models described in \citet{Xie92}. The data are 7 by 7 versions of social mobility tables from \citet{Erik82}: <>= ### Collapse to 7 by 7 table as in Erikson et al. (1982) erikson <- as.data.frame(erikson) lvl <- levels(erikson$origin) levels(erikson$origin) <- levels(erikson$destination) <- c(rep(paste(lvl[1:2], collapse = " + "), 2), lvl[3], rep(paste(lvl[4:5], collapse = " + "), 2), lvl[6:9]) erikson <- xtabs(Freq ~ origin + destination + country, data = erikson) @ From sociological theory --- for which see \citet{Erik82} or \citet{Xie92} --- the log-linear interaction between origin and destination is assumed to have a particular structure: \begin{Sinput} > levelMatrix <- matrix(c(2, 3, 4, 6, 5, 6, 6, + 3, 3, 4, 6, 4, 5, 6, + 4, 4, 2, 5, 5, 5, 5, + 6, 6, 5, 1, 6, 5, 2, + 4, 4, 5, 6, 3, 4, 5, + 5, 4, 5, 5, 3, 3, 5, + 6, 6, 5, 3, 5, 4, 1), 7, 7, byrow = TRUE) \end{Sinput} The models of table 3 of \citet{Xie92} can now be fitted as follows: \begin{Sinput} > ## Null association between origin and destination > nullModel <- gnm(Freq ~ country:origin + country:destination, + family = poisson, data = erikson, verbose = FALSE) > > ## Interaction specified by levelMatrix, common to all countries > commonTopo <- update(nullModel, ~ . + + Topo(origin, destination, spec = levelMatrix), + verbose = FALSE) > > ## Interaction specified by levelMatrix, different multiplier for each country > multTopo <- update(nullModel, ~ . + + Mult(Exp(country), Topo(origin, destination, spec = levelMatrix)), + verbose = FALSE) > > ## Interaction specified by levelMatrix, different effects for each country > separateTopo <- update(nullModel, ~ . + + country:Topo(origin, destination, spec = levelMatrix), + verbose = FALSE) > > anova(nullModel, commonTopo, multTopo, separateTopo) \end{Sinput} \begin{Soutput} Analysis of Deviance Table Model 1: Freq ~ country:origin + country:destination Model 2: Freq ~ Topo(origin, destination, spec = levelMatrix) + country:origin + country:destination Model 3: Freq ~ Mult(country, Topo(origin, destination, spec = levelMatrix)) + country:origin + country:destination Model 4: Freq ~ country:origin + country:destination + country:Topo(origin, destination, spec = levelMatrix) Resid. Df Resid. Dev Df Deviance 1 108 4860.0 2 103 244.3 5 4615.7 3 101 216.4 2 28.0 4 93 208.5 8 7.9 \end{Soutput} Here we have used \Rfunction{gnm} to fit all of these log-link models; the first, second and fourth are log-linear and could equally well have been fitted using \Rfunction{glm}. \subsection{The \Rfunction{wedderburn} family} In \citet{Wedd74} it was suggested to represent the mean of a continuous response variable in $[0,1]$ using a quasi-likelihood model with logit link and the variance function $\mu^2(1-\mu)^2$. This is not one of the variance functions made available as standard in \R's \Rfunction{quasi} family. The \Rfunction{wedderburn} family provides it. As an example, Wedderburn's analysis of data on leaf blotch on barley can be reproduced as follows: <>= ## data from Wedderburn (1974), see ?barley logitModel <- glm(y ~ site + variety, family = wedderburn, data = barley) fit <- fitted(logitModel) print(sum((barley$y - fit)^2 / (fit * (1-fit))^2)) @ This agrees with the chi-squared value reported on page 331 of \citet{McCu89}, which differs slightly from Wedderburn's own reported value. \subsection{\Rfunction{termPredictors}} \label{sec:termPredictors} The generic function \Rfunction{termPredictors} extracts a term-by-term decomposition of the predictor function in a linear, generalized linear or generalized nonlinear model. As an illustrative example, we can decompose the linear predictor in the above quasi-symmetry model as follows: <>= print(temp <- termPredictors(quasi.symm)) rowSums(temp) - quasi.symm$linear.predictors @ Such a decomposition might be useful, for example, in assessing the relative contributions of different terms or groups of terms. \section{Nonlinear terms} \label{sec:nonlinear} The main purpose of the \Rpackage{gnm} package is to provide a flexible framework for the specification and estimation of generalized models with nonlinear terms. The facility provided with \Rfunction{gnm} for the specification of nonlinear terms is designed to be compatible with the symbolic language used in \Rclass{formula} objects. Primarily, nonlinear terms are specified in the model formula as calls to functions of the class \Rclass{nonlin}. There are a number of \Rclass{nonlin} functions included in the \Rpackage{gnm} package. Some of these specify simple mathematical functions of predictors: \Rfunction{Exp}, \Rfunction{Mult}, and \Rfunction{Inv}. %\Rfunction{Log}, \Rfunction{Raise} (to raise to a constant power), and \Rfunction{Logit}. Others specify more specialized nonlinear terms, in particular \Rfunction{MultHomog} specifies homogeneous multiplicative interactions and \Rfunction{Dref} specifies diagonal reference terms. Users may also define their own \Rclass{nonlin} functions. \subsection{Basic mathematical functions of predictors} \label{sec:Basic} Most of the \Rclass{nonlin} functions included in \Rpackage{gnm} are basic mathematical functions of predictors: \begin{description} \setlength{\itemindent}{-0.5cm} \item[\Rfunction{Exp}:] the exponential of a predictor \item[\Rfunction{Inv}:] the reciprocal of a predictor %\item[\Rfunction{Log}:] the natural logarithm of a predictor %\item[\Rfunction{Logit}:] the logit of a predictor \item[\Rfunction{Mult}:] the product of predictors %\item[\Rfunction{Raise}:] a predictor raised to a constant power \end{description} Predictors are specified by symbolic expressions that are interpreted as the right-hand side of a \Rclass{formula} object, except that an intercept is \textbf{not} added by default. The predictors may contain nonlinear terms, allowing more complex functions to be built up. For example, suppose we wanted to specify a logistic predictor with the same form as that used by \Rfunction{SSlogis} (a selfStart model for use with \Rfunction{nls} --- see section~\ref{sec:gnmVnls} for more on \Rfunction{gnm} vs.\ \Rfunction{nls}): \[\frac{\text{Asym}}{1 + \exp((\text{xmid} - x)/\text{scal})}.\] This expression could be simplified by re-parameterizing in terms of xmid/scal and 1/scal, however we shall continue with this form for illustration. We could express this predictor symbolically as follows \begin{Scode} ~ -1 + Mult(1, Inv(Const(1) + Exp(Mult(1 + offset(-x), Inv(1))))) \end{Scode} where \Rfunction{Const} is a convenience function to specify a constant in a \Rclass{nonlin} term, equivalent to \Rcode{offset(rep(1, nObs))} where \Robject{nObs} is the number of observations. However, this is rather convoluted and it may be preferable to define a specialized \Rclass{nonlin} function in such a case. Section \ref{sec:nonlin.functions} explains how users can define custom \Rclass{nonlin} functions, with a function to specify logistic terms as an example. One family of models usefully specified with the basic functions is the family of models with multiplicative interactions. For example, the row-column association model \[ \log \mu_{rc} = \alpha_r + \beta_c + \gamma_r\delta_c, \] also known as the Goodman RC model \citep{Good79}, would be specified as a log-link model (for response variable \Robject{resp}, say), with formula \begin{Scode} resp ~ R + C + Mult(R, C) \end{Scode} where \Robject{R} and \Robject{C} are row and column factors respectively. In some contexts, it may be desirable to constrain one or more of the constituent multipliers\footnote{ A note on terminology: the rather cumbersome phrase `constituent multiplier', or sometimes the abbreviation `multiplier', will be used throughout this document in preference to the more elegant and standard mathematical term `factor'. This will avoid possible confusion with the completely different meaning of the word `factor' --- that is, a categorical variable --- in \R. } in a multiplicative interaction to be nonnegative . This may be achieved by specifying the multiplier as an exponential, as in the following `uniform difference' model \citep{Xie92, Erik92} \[ \log \mu_{rct} = \alpha_{rt} + \beta_{ct} + e^{\gamma_t}\delta_{rc}, \] which would be represented by a formula of the form \begin{Scode} resp ~ R:T + C:T + Mult(Exp(T), R:C) \end{Scode} \subsection{\Rfunction{MultHomog}} \Rfunction{MultHomog} is a \Rclass{nonlin} function to specify multiplicative interaction terms in which the constituent multipliers are the effects of two or more factors and the effects of these factors are constrained to be equal when the factor levels are equal. The arguments of \Rfunction{MultHomog} are the factors in the interaction, which are assumed to be objects of class \Rclass{factor}. As an example, consider the following association model with homogeneous row-column effects: \[\log \mu_{rc} = \alpha_r + \beta_c + \theta_{r}I(r=c) + \gamma_r\gamma_c.\] To fit this model, with response variable named \Robject{resp}, say, the formula argument to \Rfunction{gnm} would be \begin{Scode} resp ~ R + C + Diag(R, C) + MultHomog(R, C) \end{Scode} If the factors passed to \Rfunction{MultHomog} do not have exactly the same levels, a common set of levels is obtained by taking the union of the levels of each factor, sorted into increasing order. \subsection{\Rfunction{Dref}} \label{sec:Dref function} \Rfunction{Dref} is a \Rclass{nonlin} function to fit diagonal reference terms \citep{Sobe81, Sobe85} involving two or more factors with a common set of levels. A diagonal reference term comprises an additive component for each factor. The component for factor $f$ is given by \[ w_f\gamma_l \] for an observation with level $l$ of factor $f$, where $w_f$ is the weight for factor $f$ and $\gamma_l$ is the ``diagonal effect'' for level $l$. The weights are constrained to be nonnegative and to sum to one so that a ``diagonal effect'', say $\gamma_l$, is the value of the diagonal reference term for data points with level $l$ across the factors. \Rfunction{Dref} specifies the constraints on the weights by defining them as \[ w_f = \frac{e^{\delta_f}}{\sum_i e^{\delta_i}} \] where the $\delta_f$ are the parameters to be estimated. Factors defining the diagonal reference term are passed as unspecified arguments to \Rfunction{Dref}. For example, the following diagonal reference model for a contingency table classified by the row factor \Robject{R} and the column factor \Robject{C}, \[ \mu_{rc} =\frac{e^{\delta_1}}{e^{\delta_1} + e^{\delta_2}}\gamma_r + \frac{e^{\delta_2}}{e^{\delta_1} + e^{\delta_2}}\gamma_c, \] would be specified by a formula of the form \begin{Scode} resp ~ -1 + Dref(R, C) \end{Scode} The \Rfunction{Dref} function has one specified argument, \Rfunarg{delta}, which is a formula with no left-hand side, specifying the dependence (if any) of $\delta_f$ on covariates. For example, the formula \begin{Scode} resp ~ -1 + x + Dref(R, C, delta = ~ 1 + x) \end{Scode} specifies the generalized diagonal reference model \[ \mu_{rci} = \beta x_i + \frac{e^{\xi_{01} + \xi_{11}x_i}}{e^{\xi_{01} + \xi_{11}x_i} + e^{\xi_{02} + \xi_{12}x_i}}\gamma_r + \frac{e^{\xi_{02} + \xi_{12}x_i}}{e^{\xi_{01} + \xi_{11}x_i} + e^{\xi_{02} + \xi_{12}x_i}}\gamma_c. \] The default value of \Rfunarg{delta} is \Robject{\twiddle 1}, so that constant weights are estimated. The coefficients returned by \Rfunction{gnm} are those that are directly estimated, i.e. the $\delta_f$ or the $\xi_{.f}$, rather than the implied weights $w_f$. However, these weights may be obtained from a fitted model using the \Rfunction{DrefWeights} function, which computes the corresponding standard errors using the delta method. \subsection{\Rfunction{instances}} \label{sec:instances} Multiple instances of a linear term will be aliased with each other, but this is not necessarily the case for nonlinear terms. Indeed, there are certain types of model where adding further instances of a nonlinear term is a natural way to extend the model. For example, Goodman's RC model, introduced in section \ref{sec:Basic} \[ \log \mu_{rc} = \alpha_r + \beta_c + \gamma_r\delta_c, \] is naturally extended to the RC(2) model, with a two-component interaction \[ \log \mu_{rc} = \alpha_r + \beta_c + \gamma_r\delta_c + \theta_r\phi_c. \] Currently all of the \Rclass{nonlin} functions in \Rpackage{gnm} except \Rpackage{Dref} have an \Rfunarg{inst} argument to allow the specification of multiple instances. So the RC(2) model could be specified as follows \begin{Scode} resp ~ R + C + Mult(R, C, inst = 1) + Mult(R, C, inst = 2) \end{Scode} The convenience function \Rfunction{instances} allows multiple instances of a term to be specified at once \begin{Scode} resp ~ R + C + instances(Mult(R, C), 2) \end{Scode} The formula is expanded by \Rfunction{gnm}, so that the instances are treated as separate terms. The \Rfunction{instances} function may be used with any function with an \Rfunarg{inst} argument. \subsection{Custom \Rclass{nonlin} functions} \label{sec:nonlin.functions} \subsubsection{General description} Users may write their own \Rclass{nonlin} functions to specify nonlinear terms which can not (easily) be specified using the \Rclass{nonlin} functions in the \Rpackage{gnm} package. A function of class \Rclass{nonlin} should return a list of arguments for the internal function \Rfunction{nonlinTerms}. The following arguments must be specified in all cases: \begin{description} \setlength{\itemindent}{-0.5cm} \item[\Robject{predictors}:] a list of symbolic expressions or formulae with no left hand side which represent (possibly nonlinear) predictors that form part of the term. \item[\Robject{term}:] a function that takes the arguments \Rfunarg{predLabels} and \Rfunarg{varLabels}, which are labels generated by \Rfunction{gnm} for the specified predictors and variables (see below), and returns a deparsed mathematical expression of the nonlinear term. Only functions recognised by \Rfunction{deriv} should be used in the expression, e.g. \Rfunction{+} rather than \Rfunction{sum}. \end{description} If predictors are named, these names are used as a prefix for parameter labels or as the parameter label itself in the single-parameter case. The following arguments of \Rfunction{nonlinTerms} must be specified whenever applicable to the nonlinear term: \begin{description} \setlength{\itemindent}{-0.5cm} \item[\Robject{variables}:] a list of expressions representing variables in the term (variables with a coefficient of 1). \item[\Robject{common}:] a numeric index of \Rfunarg{predictors} with duplicated indices identifying single factor predictors for which homologous effects are to be estimated. \end{description} The arguments below are optional: \begin{description} \setlength{\itemindent}{-0.5cm} \item[\Robject{call}:] a call to be used as a prefix for parameter labels. \item[\Robject{match}:] (if \Robject{call} is non-\Rcode{NULL}) a numeric index of \Robject{predictors} specifying which arguments of \Robject{call} the predictors match to --- zero indicating no match. If \Rcode{NULL}, predictors will not be matched to the arguments of \Robject{call}. \item[\Robject{start}:] a function which takes a named vector of parameters corresponding to the predictors and returns a vector of starting values for those parameters. This function is ignored if the term is nested within another nonlinear term. \end{description} Predictors which are matched to a specified argument of \Robject{call} should be given the same name as the argument. Matched predictors are labelled using ``dot-style'' labelling, e.g. the label for the intercept in the first constituent multiplier of the term \Rcode{Mult(A, B)} would be \Rcode{"Mult(.\ + A, 1 + B).(Intercept)"}. It is recommended that matches are specified wherever possible, to ensure parameter labels are well-defined. The arguments of \Rclass{nonlin} functions are as suited to the particular term, but will usually include symbolic representations of predictors in the term and/or the names of variables in the term. The function may also have an \Rfunarg{inst} argument to allow specification of multiple instances (see \ref{sec:instances}). \subsubsection{Example: a logistic function} As an example, consider writing a \Rclass{nonlin} function for the logistic term discussed in \ref{sec:Basic}: \[\frac{\text{Asym}}{1 + \exp((\text{xmid} - x)/\text{scal})}.\] We can consider \emph{Asym}, \emph{xmid} and \emph{scal} as the parameters of three separate predictors, each with a single intercept term. Thus we specify the \Rfunarg{predictors} argument to \Rfunction{nonlinTerms} as \begin{Scode} predictors = list(Asym = 1, xmid = 1, scal = 1) \end{Scode} The term also depends on the variable $x$, which would need to be specified by the user. Suppose this is specified to our \Rclass{nonlin} function through an argument named \Rfunarg{x}. Then our \Rclass{nonlin} function would specify the following \Rfunarg{variables} argument \begin{Scode} variables = list(substitute(x)) \end{Scode} We need to use \Rfunction{substitute} here to list the variable specified by the user rather than the variable named \Rcode{``x''} (if it exists). Our \Rclass{nonlin} function must also specify the \Rfunarg{term} argument to \Rfunction{nonlinTerms}. This is a function that will paste together an expression for the term, given labels for the predictors and the variables: \begin{Scode} term = function(predLabels, varLabels) { paste(predLabels[1], "/(1 + exp((", predLabels[2], "-", varLabels[1], ")/", predLabels[3], "))") } \end{Scode} We now have all the necessary ingredients of a \Rclass{nonlin} function to specify the logistic term. Since the parameterization does not depend on user-specified values, it does not make sense to use call-matched labelling in this case. The labels for our parameters will be taken from the labels of the \Rfunarg{predictors} argument. Since we do not anticipate fitting models with multiple logistic terms, our \Rclass{nonlin} function will not specify a \Rfunarg{call} argument with which to prefix the parameter labels. We do however, have some idea of useful starting values, so we will specify the \Rfunarg{start} argument as \begin{Scode} start = function(theta){ theta[3] <- 1 theta } \end{Scode} which sets the initial scale parameter to one. Putting all these ingredients together we have \begin{Scode} Logistic <- function(x){ list(predictors = list(Asym = 1, xmid = 1, scal = 1), variables = list(substitute(x)), term = function(predLabels, varLabels) { paste(predLabels[1], "/(1 + exp((", predLabels[2], "-", varLabels[1], ")/", predLabels[3], "))") }, start = function(theta){ theta[3] <- 1 theta }) } class(Logistic) <- "nonlin" \end{Scode} \subsubsection{Example: \Rfunction{MultHomog}} The \Rfunction{MultHomog} function included in the \Rpackage{gnm} package provides a further example of a \Rclass{nonlin} function, showing how to specify a term with quite different features from the preceding example. The definition is \begin{Scode} MultHomog <- function(..., inst = NULL){ dots <- match.call(expand.dots = FALSE)[["..."]] list(predictors = dots, common = rep(1, length(dots)), term = function(predLabels, ...) { paste("(", paste(predLabels, collapse = ")*("), ")", sep = "")}, call = as.expression(match.call())) } class(MultHomog) <- "nonlin" \end{Scode} Firstly, the interaction may be based on any number of factors, hence the use of the special ``\Rfunarg{...}'' argument. The use of \Rfunction{match.call} is analogous to the use of \Rfunction{substitute} in the \Rfunction{Logistic} function: to obtain expressions for the factors as specified by the user. The returned \Rfunarg{common} argument specifies that homogeneous effects are to be estimated across all the specified factors. The term only depends on these factors, but the \Rfunarg{term} function allows for the empty \Robject{varLabels} vector that will be passed to it, by having a ``\Rfunarg{...}'' argument. Since the user may wish to specify multiple instances, the \Rfunarg{call} argument to \Rfunction{nonlinTerms} is specified, so that parameters in different instances of the term will have unique labels (due to the \Rfunarg{inst} argument in the call). However as the expressions passed to ``\Rfunarg{...}'' may only represent single factors, rather than general predictors, it is not necessary to use call-matched labelling, so the \Rfunarg{match} argument is not specified here. % Dref starting values as example of ensuring the arbitrariness of the final % parameterization is emphasised (see old plug-in section)? \section{Controlling the fitting procedure} The \Rfunction{gnm} function has a number of arguments which affect the way a model will be fitted. Basic control parameters can be set using the arguments %\Rfunarg{checkLinear}, \Rfunarg{lsMethod}, \Rfunarg{ridge}, \Rfunarg{tolerance}, \Rfunarg{iterStart} and \Rfunarg{iterMax}. Starting values for the parameter estimates can be set by \Rfunarg{start} or they can be generated from starting values for the predictors on the link or response scale via \Rfunarg{etastart} or \Rfunarg{mustart} respectively. Parameters can be constrained via \Rfunarg{constrain} and \Rfunarg{constrainTo} arguments, while parameters of a stratification factor can be handled more efficiently by specifying the factor in an \Rfunarg{eliminate} argument. These options are described in more detail below. \subsection{Basic control parameters} %By default, \Rfunction{gnm} will use \Rfunction{glm.fit} to fit models where the %predictor is linear and \Rfunarg{eliminate} is \Rcode{NULL}. This behaviour can %be overridden by setting \Rfunarg{checkLinear} to \Rcode{FALSE}. %%% At present there is no advantage to doing this! Parameterization would be %%% the same. The arguments \Rfunarg{iterStart} and \Rfunarg{iterMax} control respectively the number of starting iterations (where applicable) and the number of main iterations used by the fitting algorithm. The progress of these iterations can be followed by setting either \Rfunarg{verbose} or \Rfunarg{trace} to \Robject{TRUE}. If \Rfunarg{verbose} is \Robject{TRUE} and \Rfunarg{trace} is \Robject{FALSE}, which is the default setting, progress is indicated by printing the character ``.'' at the beginning of each iteration. If \Rfunarg{trace} is \Robject{TRUE}, the deviance is printed at the beginning of each iteration (over-riding the printing of ``.'' if necessary). Whenever \Rfunarg{verbose} is \Robject{TRUE}, additional messages indicate each stage of the fitting process and diagnose any errors that cause that cause the algorithm to restart. Prior to solving the (typically rank-deficient) least squares problem at the heart of the \Rfunction{gnm} fitting algorithm, the design matrix is standardized and regularized (in the Levenberg-Marquardt sense); the \Rfunarg{ridge} argument provides a degree of control over the regularization performed (smaller values may sometimes give faster convergence but can lead to numerical instability). The fitting algorithm will terminate before the number of main iterations has reached \Rfunarg{iterMax} if the convergence criteria have been met, with tolerance specified by \Rfunarg{tolerance}. Convergence is judged by comparing the squared components of the score vector with corresponding elements of the diagonal of the Fisher information matrix. If, for all components of the score vector, the ratio is less than \Robject{tolerance\^{}2}, or the corresponding diagonal element of the Fisher information matrix is less than 1e-20, the algorithm is deemed to have converged. \subsection{Specifying starting values} \label{sec:start} \subsubsection{Using \Rfunarg{start}} In some contexts, the default starting values may not be appropriate and the fitting algorithm will fail to converge, or perhaps only converge after a large number of iterations. Alternative starting values may be passed on to \Rfunction{gnm} by specifying a \Rfunarg{start} argument. This should be a numeric vector of length equal to the number of parameters (or possibly the non-eliminated parameters, see Section \ref{sec:eliminate}), however missing starting values (\Robject{NA}s) are allowed. If there is no user-specified starting value for a parameter, the default value is used. This feature is particularly useful when adding terms to a model, since the estimates from the original model can be used as starting values, as in this example: \begin{Scode} model1 <- gnm(mu ~ R + C + Mult(R, C)) model2 <- gnm(mu ~ R + C + instances(Mult(R, C), 2), start = c(coef(model1), rep(NA, 10))) \end{Scode} The \Rfunction{gnm} call can be made with \Rcode{method = "coefNames"} to identify the parameters of a model prior to estimation, to assist with the specification of arguments such as \Rfunarg{start}. For example, to get the number \Rcode{10} for the value of \Rfunarg{start} above, we could have done \begin{Scode} gnm(mu ~ R + C + instances(Mult(R, C), 2), method = "coefNames") \end{Scode} from whose output it would be seen that there are 10 new coefficients in \Robject{model2}. When called with \Rcode{method = "coefNames"}, \Rfunction{gnm} makes no attempt to fit the specified model; instead it returns just the names that the coefficients in the fitted model object would have. The starting procedure used by \Rfunction{gnm} is as follows: \begin{enumerate} \item Begin with all parameters set to \Rcode{NA}. \item \label{i:nonlin} Replace \Rcode{NA} values with any starting values set by \Rclass{nonlin} functions. \item \label{i:start} Replace current values with any (non-\Rcode{NA}) starting values specified by the \Rfunarg{start} argument of \Rfunction{gnm}. \item \label{i:constrain} Set any values specified by the \Rfunarg{constrain} argument to the values specified by the \Rfunarg{constrainTo} argument (see Section \ref{sec:constrain}). \item \label{i:gnmStart} Categorise remaining \Rcode{NA} parameters as linear or nonlinear, treating non-\Rcode{NA} parameters as fixed. Initialise the nonlinear parameters by generating values $\theta_i$ from the Uniform($-0.1$, $0.1$) distribution and shifting these values away from zero as follows \begin{equation*} \theta_i = \begin{cases} \theta_i - 0.1 & \text{if } \theta_i < 1 \\ \theta_i + 0.1 & \text{otherwise} \end{cases} \end{equation*} \item Compute the \Rfunction{glm} estimate of the linear parameters, offsetting the contribution to the predictor of any terms fully determined by steps \ref{i:nonlin} to \ref{i:gnmStart}. \item \label{i:iter} Run starting iterations: update nonlinear parameters one at a time, jointly re-estimating linear parameters after each round of updates. \end{enumerate} Note that no starting iterations (step \ref{i:iter}) will be run if all parameters are linear, or if all nonlinear parameters are specified by \Rfunarg{start}, \Rfunarg{constrain} or a \Rclass{nonlin} function. \subsubsection{Using \Rfunarg{etastart} or \Rfunarg{mustart}} An alternative way to set starting values for the parameters is to specify starting values for the predictors. If there are linear parameters in the model, the predictor starting values are first used to fit a model with only the linear terms (offsetting any terms fully specified by starting values given by \Rfunarg{start}, \Rfunarg{constrain} or a \Rclass{nonlin} function). In this case the parameters corresponding to the predictor starting values can be computed analytically. If the fitted model reproduces the predictor starting values, then these values contain no further information and they are replaced using the \Rfunction{initialize} function of the specified \Rfunarg{family}. The predictor starting values or their replacement are then used as the response variable in a nonlinear least squares model with only the unspecified nonlinear terms, offsetting the contribution of any other terms. Since the model is over-parameterized, the model is approximated using \Rfunarg{iterStart} iterations of the ``L-BFGS-B'' algorithm of \Rfunction{optim}, assuming parameters lie in the range (-10, 10). Starting values for the predictors can be specified explicitly via \Rfunarg{etastart} or implicitly by passing starting values for the fitted means to \Rfunarg{mustart}. For example, when extending a model, the fitted predictors from the first model can be used to find starting values for the parameters of the second model: \begin{Scode} model1 <- gnm(mu ~ R + C + Mult(R, C)) model2 <- gnm(mu ~ R + C + instances(Mult(R, C), 2), etastart = model1$predictors) \end{Scode} %$ Using \Rfunction{etastart} avoids the one-parameter-at-a-time starting iterations, so is quicker than using \Rfunction{start} to pass on information from a nested model. However \Rfunction{start} will generally produce better starting values so should be used when feasible. For multiplicative terms, the \Rfunction{residSVD} functions provides a better way to avoid starting iterations. \subsection{Using \Rfunarg{constrain}} \label{sec:constrain} By default, \Rfunction{gnm} only imposes identifiability constraints according to the general conventions used by \Robject{R} to handle linear aliasing. Therefore models that have any nonlinear terms will be typically be over-parameterized, and \Rfunction{gnm} will return a random parameterization for unidentified coefficients (determined by the randomly chosen starting values for the iterative algorithm, step 5 above). To illustrate this point, consider the following application of \Rfunction{gnm}, discussed later in Section \ref{sec:RCmodels}: <>= set.seed(1) RChomog1 <- gnm(Freq ~ origin + destination + Diag(origin, destination) + MultHomog(origin, destination), family = poisson, data = occupationalStatus, verbose = FALSE) @ Running the analysis again from a different seed <>= set.seed(2) RChomog2 <- update(RChomog1) @ gives a different representation of the same model: <>= compareCoef <- cbind(coef(RChomog1), coef(RChomog2)) colnames(compareCoef) <- c("RChomog1", "RChomog2") round(compareCoef, 4) @ Even though the linear terms are constrained, the parameter estimates for the main effects of \Robject{origin} and \Robject{destination} still change, because these terms are aliased with the higher order multiplicative interaction, which is unconstrained. Standard errors are only meaningful for identified parameters and hence the output of \Rmethod{summary.gnm} will show clearly which coefficients are estimable: <>= summary(RChomog2) @ Additional constraints may be specified through the \Rfunarg{constrain} and \Rfunarg{constrainTo} arguments of \Rfunction{gnm}. These arguments specify respectively parameters that are to be constrained in the fitting process and the values to which they should be constrained. Parameters may be specified by a regular expression to match against the parameter names, a numeric vector of indices, a character vector of names, or, if \Rcode{constrain = "[?]"} they can be selected through a \emph{Tk} dialog. The values to constrain to should be specified by a numeric vector; if \Rfunarg{constrainTo} is missing, constrained parameters will be set to zero. In the case above, constraining one level of the homogeneous multiplicative factor is sufficient to make the parameters of the nonlinear term identifiable, and hence all parameters in the model identifiable. Figure~\ref{fig:Tk} illustrates how the coefficient to be constrained may be specified via a \emph{Tk} dialog, an approach which can be helpful in interactive R sessions. % here illustrate TclTk dialog, but explain other methods better for reproducibility \begin{figure}[tp] \centering \begin{tabular}[!h]{m{0.6\linewidth}m{0.4\linewidth}} \scalebox{0.9}{\includegraphics{screenshot1.png}} & When \Rfunction{gnm} is called with \Rcode{constrain = "[?]"}, a \emph{Tk} dialog is shown listing the coefficients in the model.\\ \scalebox{0.9}{\includegraphics{screenshot2.png}} & Scroll through the coefficients and click to select a single coefficient to constrain. To select multiple coefficients, hold down the \texttt{Ctrl} key whilst clicking. The \texttt{Add} button will become active when coefficient(s) have been selected.\\ \scalebox{0.9}{\includegraphics{screenshot3.png}} & Click the \texttt{Add} button to add the selected coefficients to the list of coefficients to be constrained. To remove coefficients from the list, select the coefficients in the right pane and click \texttt{Remove}. Click \texttt{OK} when you have finalised the list.\\ \end{tabular} \caption{Selecting coefficients to constrain with the \emph{Tk} dialog.} \label{fig:Tk} \end{figure} However for reproducible code, it is best to specify the constrained coefficients directly. For example, the following code specifies that the last level of the homogeneous multiplicative factor should be constrained to zero, <>= set.seed(1) RChomogConstrained1 <- update(RChomog1, constrain = length(coef(RChomog1))) @ Since all the parameters are now constrained, re-fitting the model will give the same results, regardless of the random seed set beforehand: <>= set.seed(2) RChomogConstrained2 <- update(RChomogConstrained1) identical(coef(RChomogConstrained1), coef(RChomogConstrained2)) @ It is not usually so straightforward to constrain all the parameters in a generalized nonlinear model. However use of \Rfunarg{constrain} in conjunction with \Rfunarg{constrainTo} is usually sufficient to make coefficients of interest identifiable . The functions \Rfunction{checkEstimable} or \Rfunction{getContrasts}, described in Section \ref{sec:Methods}, may be used to check whether particular combinations of parameters are estimable. \subsection{Using \Rfunarg{eliminate}} \label{sec:eliminate} When a model contains the additive effect of a factor which has a large number of levels, the iterative algorithm by which maximum likelihood estimates are computed can usually be accelerated by use of the \Rfunarg{eliminate} argument to \Rfunction{gnm}. A factor passed to \Rfunarg{eliminate} specifies the first term in the model, replacing any intercept term. So, for example \begin{Scode} gnm(mu ~ A + B + Mult(A, B), eliminate = strata1:strata2) \end{Scode} is equivalent, in terms of the structure of the model, to \begin{Scode} gnm(mu ~ -1 + strata1:strata2 + A + B + Mult(A, B)) \end{Scode} However, specifying a factor through \Rfunarg{eliminate} has two advantages over the standard specification. First, the structure of the eliminated factor is exploited so that computational speed is improved --- substantially so if the number of eliminated parameters is large. Second, eliminated parameters are returned separately from non-eliminated parameters (as an attribute of the \Robject{coefficients} component of the returned object). Thus eliminated parameters are excluded from printed model summaries by default and disregarded by \Rclass{gnm} methods that would not be relevant to such parameters (see Section \ref{sec:Methods}). The \Rfunarg{eliminate} feature is useful, for example, when multinomial-response models are fitted by using the well known equivalence between multinomial and (conditional) Poisson likelihoods. In such situations the sufficient statistic involves a potentially large number of fixed multinomial row totals, and the corresponding parameters are of no substantive interest. For an application see Section \ref{sec:Stereotype} below. Here we give an artificial illustration: 1000 randomly-generated trinomial responses, and a single predictor variable (whose effect on the data generation is null): <>= set.seed(1) n <- 1000 x <- rep(rnorm(n), rep(3, n)) counts <- as.vector(rmultinom(n, 10, c(0.7, 0.1, 0.2))) rowID <- gl(n, 3, 3 * n) resp <- gl(3, 1, 3 * n) @ The logistic model for dependence on \Robject{x} can be fitted as a Poisson log-linear model\footnote{For this particular example, of course, it would be more economical to fit the model directly using \Rfunction{multinom} (from the recommended package \Rpackage{nnet}). But fitting as here via the `Poisson trick' allows the model to be elaborated within the \Rpackage{gnm} framework using \Rfunction{Mult} or other \Rclass{nonlin} terms.}, using either \Rfunction{glm} or \Rfunction{gnm}: \begin{Sinput} > ## Timings on a Xeon 2.33GHz, under Linux > system.time(temp.glm <- glm(counts ~ rowID + resp + resp:x, family = poisson))[1] \end{Sinput} \begin{Soutput} user.self 37.126 \end{Soutput} \begin{Sinput} > system.time(temp.gnm <- gnm(counts ~ resp + resp:x, eliminate = rowID, family = poisson, verbose = FALSE))[1] \end{Sinput} \begin{Soutput} user.self 0.04 \end{Soutput} \begin{Sinput} > c(deviance(temp.glm), deviance(temp.gnm)) \end{Sinput} \begin{Soutput} [1] 2462.556 2462.556 \end{Soutput} Here the use of \Rfunarg{eliminate} causes the \Rfunction{gnm} calculations to run much more quickly than \Rfunction{glm}. The speed advantage increases with the number of eliminated parameters (here 1000). By default,the eliminated parameters do not appear in printed model summaries as here: \begin{Sinput} > summary(temp.gnm) \end{Sinput} \begin{Soutput} Call: gnm(formula = counts ~ resp + resp:x, eliminate = rowID, family = poisson, verbose = FALSE) Deviance Residuals: Min 1Q Median 3Q Max -2.852038 -0.786172 -0.004534 0.645278 2.755013 Coefficients of interest: Estimate Std. Error z value Pr(>|z|) resp2 -1.961448 0.034007 -57.678 <2e-16 resp3 -1.255846 0.025359 -49.523 <2e-16 resp1:x -0.007726 0.024517 -0.315 0.753 resp2:x -0.023340 0.037611 -0.621 0.535 resp3:x 0.000000 NA NA NA (Dispersion parameter for poisson family taken to be 1) Std. Error is NA where coefficient has been constrained or is unidentified Residual deviance: 2462.6 on 1996 degrees of freedom AIC: 12028 Number of iterations: 4 \end{Soutput} although the \Rmethod{summary} method has a logical \Rfunarg{with.eliminate} that can toggled so that the eliminated parameters are included if desired. The \Rfunarg{eliminate} feature as implemented in \Rpackage{gnm} extends the earlier work of \cite{Hatz04} to a broader class of models and to over-parameterized model representations. \section{Methods and accessor functions} \label{sec:Methods} \subsection{Methods} \label{sec:specificMethods} The \Rfunction{gnm} function returns an object of class \Robject{c("gnm", "glm", "lm")}. There are several methods that have been written for objects of class \Rclass{glm} or \Rclass{lm} to facilitate inspection of fitted models. Out of the generic functions in the \Rpackage{base}, \Rpackage{stats} and \Rpackage{graphics} packages for which methods have been written for \Rclass{glm} or \Rclass{lm} objects, Figure \ref{fig:glm.lm} shows those that can be used to analyse \Rclass{gnm} objects, whilst Figure \ref{fig:!glm.lm} shows those that are not implemented for \Rclass{gnm} objects. \begin{figure}[!tbph] \centering \begin{fbox} { \begin{tabular*}{7.5cm}{@{\extracolsep{\fill}}lll@{\extracolsep{\fill}}} add1$^*$ & family & print \\ anova & formula & profile \\ case.names & hatvalues & residuals \\ coef & labels & rstandard \\ cooks.distance & logLik & summary \\ confint & model.frame & variable.names \\ deviance & model.matrix & vcov \\ drop1$^*$ & plot & weights \\ extractAIC & predict & \\ \end{tabular*} } \end{fbox} \caption{Generic functions in the \Rpackage{base}, \Rpackage{stats} and \Rpackage{graphics} packages that can be used to analyse \Rclass{gnm} objects. Starred functions are implemented for models with linear terms only.} \label{fig:glm.lm} \end{figure} \begin{figure}[!tbph] \centering \begin{fbox} { \begin{tabular*}{4.5cm}{@{\extracolsep{\fill}}ll@{\extracolsep{\fill}}} alias & effects \\ dfbeta & influence \\ dfbetas & kappa \\ dummy.coef & proj \\ \end{tabular*} } \end{fbox} \caption{Generic functions in the \Rpackage{base}, \Rpackage{stats} and \Rpackage{graphics} packages for which methods have been written for \Rclass{glm} or \Rclass{lm} objects, but which are \emph{not} implemented for \Rclass{gnm} objects.} \label{fig:!glm.lm} \end{figure} In addition to the accessor functions shown in Figure \ref{fig:glm.lm}, the \Rpackage{gnm} package provides a new generic function called \Rfunction{termPredictors} that has methods for objects of class \Rclass{gnm}, \Rclass{glm} and \Rclass{lm}. This function returns the additive contribution of each term to the predictor. See Section \ref{sec:termPredictors} for an example of its use. Most of the functions listed in Figure \ref{fig:glm.lm} can be used as they would be for \Rclass{glm} or \Rclass{lm} objects, however care must be taken with \Rmethod{vcov.gnm}, as the variance-covariance matrix will depend on the parameterization of the model. In particular, standard errors calculated using the variance-covariance matrix will only be valid for parameters or contrasts that are estimable! Similarly, \Rmethod{profile.gnm} and \Rmethod{confint.gnm} are only applicable to estimable parameters. The deviance function of a generalized nonlinear model can sometimes be far from quadratic and \Rmethod{profile.gnm} attempts to detect asymmetry or asymptotic behaviour in order to return a sufficient profile for a given parameter. As an example, consider the following model, described later in Section \ref{sec:Unidiff}: \begin{Scode} unidiff <- gnm(Freq ~ educ*orig + educ*dest + Mult(Exp(educ), orig:dest), constrain = "[.]educ1", family = poisson, data = yaish, subset = (dest != 7)) prof <- profile(unidiff, which = 61:65, trace = TRUE) \end{Scode} If the deviance is quadratic in a given parameter, the profile trace will be linear. We can plot the profile traces as follows: \begin{figure}[!tbph] \begin{center} \scalebox{1.1}{\includegraphics{fig-profilePlot.pdf}} \end{center} \caption{Profile traces for the multipliers of the orig:dest association} \label{fig:profilePlot} \end{figure} From these plots we can see that the deviance is approximately quadratic in \Robject{Mult(Exp(.), orig:dest).educ2}, asymmetric in \Robject{Mult(Exp(.), orig:dest).educ3} and \Robject{Mult(Exp(.), orig:dest).educ4} and asymptotic in \Robject{Mult(Exp(.), orig:dest).educ5}. When the deviance is approximately quadratic in a given parameter, \Rmethod{profile.gnm} uses the same stepsize for profiling above and below the original estimate: \begin{Sinput} > diff(prof[[2]]$par.vals[, "Mult(Exp(.), orig:dest).educ2"]) \end{Sinput} \begin{Soutput} [1] 0.1053072 0.1053072 0.1053072 0.1053072 0.1053072 0.1053072 0.1053072 [8] 0.1053072 0.1053072 0.1053072 \end{Soutput} When the deviance is asymmetric, \Rmethod{profile.gnm} uses different step sizes to accommodate the skew: \begin{Sinput} > diff(prof[[4]]$par.vals[, "Mult(Exp(.), orig:dest).educ4"]) \end{Sinput} \begin{Soutput} [1] 0.2018393 0.2018393 0.2018393 0.2018393 0.2018393 0.2018393 0.2018393 [8] 0.2018393 0.2018393 0.2243673 0.2243673 0.2243673 0.2243673 0.2243673 \end{Soutput} Finally, the presence of an asymptote is recorded in the \Robject{"asymptote"} attribute of the returned profile: \begin{Sinput} > attr(prof[[5]], "asymptote") \end{Sinput} \begin{Soutput} [1] TRUE FALSE \end{Soutput} This information is used by \Rmethod{confint.gnm} to return infinite limits for confidence intervals, as appropriate: \begin{Sinput} > confint(prof, level = 0.95) \end{Sinput} \begin{Soutput} 2.5 % 97.5 % Mult(Exp(.), orig:dest).educ1 NA NA Mult(Exp(.), orig:dest).educ2 -0.5978901 0.1022447 Mult(Exp(.), orig:dest).educ3 -1.4836854 -0.2362378 Mult(Exp(.), orig:dest).educ4 -2.5792398 -0.2953420 Mult(Exp(.), orig:dest).educ5 -Inf -0.7006889 \end{Soutput} \subsection{\Rfunction{ofInterest} and \Rfunction{pickCoef}} \label{sec:ofInterest} It is quite common for a statistical model to have a large number of parameters, but for only a subset of these parameters be of interest when it comes to interpreting the model. The \Rfunarg{ofInterest} argument to \Rfunction{gnm} allows the user to specify a subset of the parameters which are of interest, so that \Rclass{gnm} methods will focus on these parameters. In particular, printed model summaries will only show the parameters of interest, whilst methods for which a subset of parameters may be selected will by default select the parameters of interest, or where this may not be appropriate, provide a \emph{Tk} dialog for selection from the parameters of interest. Parameters may be specified to the \Rfunarg{ofInterest} argument by a regular expression to match against parameter names, by a numeric vector of indices, by a character vector of names, or, if \Rcode{ofInterest = "[?]"} they can be selected through a \emph{Tk} dialog. The information regarding the parameters of interest is held in the \Robject{ofInterest} component of \Rclass{gnm} objects, which is a named vector of numeric indices, or \Robject{NULL} if all parameters are of interest. This component may be accessed or replaced using \Rfunction{ofInterest} or \Rfunction{ofInterest<-} respectively. The \Rfunction{pickCoef} function provides a simple way to obtain the indices of coefficients from any model object. It takes the model object as its first argument and has an optional \Rfunarg{regexp} argument. If a regular expression is passed to \Rfunarg{regexp}, the coefficients are selected by matching this regular expression against the coefficient names. Otherwise, coefficients may be selected via a \emph{Tk} dialog. So, returning to the example from the last section, if we had set \Robject{ofInterest} to index the education multipliers as follows \begin{Scode} ofInterest(unidiff) <- pickCoef(unidiff, "[.]educ") \end{Scode} then it would not have been necessary to specify the \Rfunarg{which} argument of \Rfunction{profile} as these parameters would have been selected by default. \subsection{\Rfunction{checkEstimable}} \label{sec:checkEstimable} The \Rfunction{checkEstimable} function can be used to check the estimability of a linear combination of parameters. For non-linear combinations the same function can be used to check estimability based on the (local) vector of partial derivatives. The \Rfunction{checkEstimable} function provides a numerical version of the sort of algebraic test described in \citet{CatcMorg97}. Consider the following model, which is described later in Section \ref{sec:Unidiff}: <>= doubleUnidiff <- gnm(Freq ~ election:vote + election:class:religion + Mult(Exp(election), religion:vote) + Mult(Exp(election), class:vote), family = poisson, data = cautres) @ The effects of the first constituent multiplier in the first multiplicative interaction are identified when the parameter for one of the levels --- say for the first level --- is constrained to zero. The parameters to be estimated are then the differences between each other level and the first. These differences can be represented by a contrast matrix as follows: <>= coefs <- names(coef(doubleUnidiff)) contrCoefs <- coefs[grep(", religion:vote", coefs)] nContr <- length(contrCoefs) contrMatrix <- matrix(0, length(coefs), nContr, dimnames = list(coefs, contrCoefs)) contr <- contr.sum(contrCoefs) # switch round to contrast with first level contr <- rbind(contr[nContr, ], contr[-nContr, ]) contrMatrix[contrCoefs, 2:nContr] <- contr contrMatrix[contrCoefs, 2:nContr] @ Then their estimability can be checked using \Rfunction{checkEstimable} <>= checkEstimable(doubleUnidiff, contrMatrix) @ which confirms that the effects for the other three levels are estimable when the parameter for the first level is set to zero. However, applying the equivalent constraint to the second constituent multiplier in the interaction is not sufficient to make the parameters in that multiplier estimable: <>= coefs <- names(coef(doubleUnidiff)) contrCoefs <- coefs[grep("[.]religion", coefs)] nContr <- length(contrCoefs) contrMatrix <- matrix(0, length(coefs), length(contrCoefs), dimnames = list(coefs, contrCoefs)) contr <- contr.sum(contrCoefs) contrMatrix[contrCoefs, 2:nContr] <- rbind(contr[nContr, ], contr[-nContr, ]) checkEstimable(doubleUnidiff, contrMatrix) @ \subsection{\Rfunction{getContrasts}, \Rfunction{se}} \label{sec:getContrasts} To investigate simple ``sum to zero'' contrasts such as those above, it is easiest to use the \Rfunction{getContrasts} function, which checks the estimability of possibly scaled contrasts and returns the parameter estimates with their standard errors. Returning to the example of the first constituent multiplier in the first multiplicative interaction term, the differences between each election and the first can be obtained as follows: <>= myContrasts <- getContrasts(doubleUnidiff, pickCoef(doubleUnidiff, ", religion:vote")) myContrasts @ %def Visualization of estimated contrasts using `quasi standard errors' \citep{Firt03,FirtMene04} is achieved by plotting the resulting object: <>= plot(myContrasts, main = "Relative strength of religion-vote association, log scale", xlab = "Election", levelNames = 1:4) @ \begin{figure}[!tbph] \begin{center} \includegraphics{gnmOverview-qvplot.pdf} \end{center} \caption{Relative strength of religion-vote association, log scale} \label{fig:qvplot} \end{figure} %Attempting to obtain the equivalent contrasts for the second %(religion-vote association) multiplier produces the %following result: %<>= %coefs.of.interest <- grep("[.]religion", names(coef(doubleUnidiff))) %getContrasts(doubleUnidiff, coefs.of.interest) %@ %def By default, \Rfunction{getContrasts} uses the first parameter of the specified set as the reference level; alternatives may be set via the \Rfunarg{ref} argument. In the above example, the simple contrasts are estimable without scaling. In certain other applications, for example row-column association models (see Section~\ref{sec:RCmodels}), the contrasts are identified only after fixing their scale. A more general family of \emph{scaled} contrasts for a set of parameters $\gamma_r, r = 1, \ldots, R$ is given by \begin{equation*} \gamma^*_r = \frac{\gamma_r - \overline{\gamma}_w}{ \sqrt{\sum_r v_r (\gamma_r - \overline{\gamma}_u)^2}} \end{equation*} where $\overline{\gamma}_w = \sum w_r \gamma_r$ is the reference level against which the contrasts are taken, $\overline{\gamma}_u = \sum u_r \gamma_r$ is a possibly different weighted mean of the parameters to be used as reference level for a set of ``scaling contrasts'', and $v_r$ is a further set of weights. Thus, for example, the choice \[ w_r= \begin{cases} 1&(r=1)\\ 0&\hbox{(otherwise)} \end{cases}, \qquad u_r=v_r=1/R \] specifies contrasts with the first level, with the coefficients scaled to have variance 1\null. This general type of scaling can be obtained by specifying the form of $\overline{\gamma}_u$ and $v_r$ via the \Rfunarg{scaleRef} and \Rfunarg{scaleWeights} arguments of \Rfunction{getContrasts}. As an example, consider the following model, described in Section~\ref{sec:RCmodels}: @ <>= mentalHealth$MHS <- C(mentalHealth$MHS, treatment) mentalHealth$SES <- C(mentalHealth$SES, treatment) RC1model <- gnm(count ~ SES + MHS + Mult(SES, MHS), family = poisson, data = mentalHealth) @ %def The effects of the constituent multipliers of the multiplicative interaction are identified when both their scale and location are constrained. A simple way to achieve this is to set the first parameter to zero and the last parameter to one: @ <>= RC1model2 <- gnm(count ~ SES + MHS + Mult(1, SES, MHS), constrain = "[.]SES[AF]", constrainTo = c(0, 1), ofInterest = "[.]SES", family = poisson, data = mentalHealth) summary(RC1model2) @ %def Note that a constant multiplier must be incorporated into the interaction term, i.e., the multiplicative term \Rcode{Mult(SES, MHS)} becomes \Rcode{Mult(1, SES, MHS)}, in order to maintain equivalence with the original model specification. The constraints specified for \Robject{RC1model2} result in the estimation of scaled contrasts with level \Rcode{A} of \Rcode{SES}, in which the scaling fixes the magnitude of the contrast between level \Rcode{F} and level \Rcode{A} to be equal to 1\null. The equivalent use of \Rfunction{getContrasts}, together with the \emph{unconstrained} fit (\Robject{RC1model}), in this case is as follows: @ <>= getContrasts(RC1model, pickCoef(RC1model, "[.]SES"), ref = "first", scaleRef = "first", scaleWeights = c(rep(0, 5), 1)) @ %def Quasi-variances and standard errors are not returned here as they can not (currently) be computed for scaled contrasts. When the scaling uses the same reference level as the contrasts, equal scale weights produce ``spherical'' contrasts, whilst unequal weights produce ``elliptical'' contrasts. Further examples are given in Sections~\ref{sec:RCmodels} and \ref{sec:GAMMI}. For more general linear combinations of parameters than contrasts, the lower-level \Rfunction{se} function (which is called internally by \Rfunction{getContrasts} and by the \Rmethod{summary} method) can be used directly. See \Rcode{help(se)} for details. \subsection{\Rfunction{residSVD}} \label{sec:residSVD} Sometimes it is useful to operate on the residuals of a model in order to create informative summaries of residual variation, or to obtain good starting values for additional parameters in a more elaborate model. The relevant arithmetical operations are weighted means of the so-called \emph{working residuals}. The \Rfunction{residSVD} function facilitates one particular residual analysis that is often useful when considering multiplicative interaction between factors as a model elaboration: in effect, \Rfunction{residSVD} provides a direct estimate of the parameters of such an interaction, by performing an appropriately weighted singular value decomposition on the working residuals. As an illustration, consider the barley data from \citet{Wedd74}. These data have the following two-way structure: <>= xtabs(y ~ site + variety, barley) @ In Section~\ref{sec:biplot} a biplot model is proposed for these data, which comprises a two-component interaction between the cross-classifying factors. In order to fit this model, we can proceed by fitting a smaller model, then use \Rfunction{residSVD} to obtain starting values for the parameters in the bilinear term: @ <>= emptyModel <- gnm(y ~ -1, family = wedderburn, data = barley) biplotStart <- residSVD(emptyModel, barley$site, barley$variety, d = 2) biplotModel <- gnm(y ~ -1 + instances(Mult(site, variety), 2), family = wedderburn, data = barley, start = biplotStart) @ %def In this instance, the use of purposive (as opposed to the default, random) starting values had little effect: the fairly large number of iterations needed in this example is caused by a rather flat (quasi-)likelihood surface near the maximum, not by poor starting values. In other situations, the use of \Rfunction{residSVD} may speed the calculations dramatically (see for example Section \ref{sec:GAMMI}), or it may be crucial to success in locating the MLE (for example see \Rcode{help(House2001)}, where the number of multiplicative parameters is in the hundreds). The \Rfunction{residSVD} result in this instance provides a crude approximation to the MLE of the enlarged model, as can be seen in Figure \ref{fig:residSVDplot}: @ <>= plot(coef(biplotModel), biplotStart, main = "Comparison of residSVD and MLE for a 2-dimensional biplot model", ylim = c(-2, 2), xlim = c(-4, 4)) abline(a = 0, b = 1, lty = 2) @ %def \begin{figure}[!tbph] \begin{center} \includegraphics{gnmOverview-residSVDplot} \end{center} \caption{Comparison of residSVD and the MLE for a 2-dimensional biplot model} \label{fig:residSVDplot} \end{figure} \section{\Rfunction{gnm} or \Rfunction{(g)nls}?} \label{sec:gnmVnls} The \Rfunction{nls} function in the \Rpackage{stats} package may be used to fit a nonlinear model via least-squares estimation. Statistically speaking, \Rfunction{gnm} is to \Rfunction{nls} as \Rfunction{glm} is to \Rfunction{lm}, in that a nonlinear least-squares model is equivalent to a generalized nonlinear model with \Rcode{family = gaussian}. A \Rfunction{nls} model assumes that the responses are distributed either with constant variance or with fixed relative variances (specified via the \Rfunarg{weights} argument). The \Rfunction{gnls} function in the \Rpackage{nlme} package extends \Rfunction{nls} to allow correlated responses. On the other hand, \Rfunction{gnm} allows for responses distributed with variances that are a specified (via the \Rfunarg{family} argument) function of the mean; as with \Rfunction{nls}, no correlation is allowed. The \Rfunction{gnm} function also differs from \Rfunction{nls}/\Rfunction{gnls} in terms of the interface. Models are specified to \Rfunction{nls} and \Rfunction{gnls} in terms of a mathematical formula or a \Rclass{selfStart} function based on such a formula, which is convenient for models that have a small number of parameters. For models that have a large number of parameters, or can not easily be represented by a mathematical formula, the symbolic model specification used by \Rfunction{gnm} may be more convenient. This would usually be the case for models involving factors, which would need to be represented by dummy variables in a \Rfunction{nls} formula. When working with artificial data, \Rfunction{gnm} has the minor advantage that it does not fail when a model is an exact fit to the data (see \Rcode{help(nls)})\null. Therefore it is not necessary with \Rfunction{gnm} to add noise to artificial data, which can be useful when testing methods. \section{Examples} \label{sec:Examples} \subsection{Row-column association models} \label{sec:RCmodels} There are several models that have been proposed for modelling the relationship between the cell means of a contingency table and the cross-classifying factors. The following examples consider the row-column association models proposed by \citet{Good79}. The examples shown use data from two-way contingency tables, but the \Rpackage{gnm} package can also be used to fit the equivalent models for higher order tables. \subsubsection{RC(1) model} The RC(1) model is a row and column association model with the interaction between row and column factors represented by one component of the multiplicative interaction. If the rows are indexed by $r$ and the columns by $c$, then the log-multiplicative form of the RC(1) model for the cell means $\mu_{rc}$ is given by \[\log \mu_{rc} = \alpha_r + \beta_c + \gamma_r\delta_c. \] We shall fit this model to the \Robject{mentalHealth} data set from \citet[][page 381]{Agre02}, which is a two-way contingency table classified by the child's mental impairment (MHS) and the parents' socioeconomic status (SES). Although both of these factors are ordered, we do not wish to use polynomial contrasts in the model, so we begin by setting the contrasts attribute of these factors to \Rcode{treatment}: <>= set.seed(1) mentalHealth$MHS <- C(mentalHealth$MHS, treatment) mentalHealth$SES <- C(mentalHealth$SES, treatment) @ The \Rclass{gnm} model is then specified as follows, using the poisson family with a log link function: <>= RC1model <- gnm(count ~ SES + MHS + Mult(SES, MHS), family = poisson, data = mentalHealth) RC1model @ %def The row scores (parameters 10 to 15) and the column scores (parameters 16 to 19) of the multiplicative interaction can be normalized as in Agresti's eqn (9.15): <>= rowProbs <- with(mentalHealth, tapply(count, SES, sum) / sum(count)) colProbs <- with(mentalHealth, tapply(count, MHS, sum) / sum(count)) rowScores <- coef(RC1model)[10:15] colScores <- coef(RC1model)[16:19] rowScores <- rowScores - sum(rowScores * rowProbs) colScores <- colScores - sum(colScores * colProbs) beta1 <- sqrt(sum(rowScores^2 * rowProbs)) beta2 <- sqrt(sum(colScores^2 * colProbs)) assoc <- list(beta = beta1 * beta2, mu = rowScores / beta1, nu = colScores / beta2) assoc @ %def Alternatively, the elliptical contrasts \Robject{mu} and \Robject{nu} can be obtained using \Rfunction{getContrasts}, with the advantage that the standard errors for the contrasts will also be computed: @ <>= mu <- getContrasts(RC1model, pickCoef(RC1model, "[.]SES"), ref = rowProbs, scaleWeights = rowProbs) nu <- getContrasts(RC1model, pickCoef(RC1model, "[.]MHS"), ref = colProbs, scaleWeights = colProbs) mu nu @ %def Since the value of \Robject{beta} is dependent upon the particular scaling used for the contrasts, it is typically not of interest to conduct inference on this parameter directly. The standard error for \Robject{beta} could be obtained, if desired, via the delta method. \subsubsection{RC(2) model} The RC(1) model can be extended to an RC($m$) model with $m$ components of the multiplicative interaction. For example, the RC(2) model is given by \[ \log \mu_{rc} = \alpha_r + \beta_c + \gamma_r\delta_c + \theta_r\phi_c. \] Extra instances of the multiplicative interaction can be specified by the \Rfunarg{multiplicity} argument of \Rfunction{Mult}, so the RC(2) model can be fitted to the \Robject{mentalHealth} data as follows <>= RC2model <- gnm(count ~ SES + MHS + instances(Mult(SES, MHS), 2), family = poisson, data = mentalHealth) RC2model @ \subsubsection{Homogeneous effects} If the row and column factors have the same levels, or perhaps some levels in common, then the row-column interaction could be modelled by a multiplicative interaction with homogeneous effects, that is \[\log \mu_{rc} = \alpha_r + \beta_c + \gamma_r\gamma_c.\] For example, the \Robject{occupationalStatus} data set from \citet{Good79} is a contingency table classified by the occupational status of fathers (origin) and their sons (destination). \citet{Good79} fits a row-column association model with homogeneous effects to these data after deleting the cells on the main diagonal. Equivalently we can account for the diagonal effects by a separate \Rfunction{Diag} term: @ <>= RChomog <- gnm(Freq ~ origin + destination + Diag(origin, destination) + MultHomog(origin, destination), family = poisson, data = occupationalStatus) RChomog @ %def To determine whether it would be better to allow for heterogeneous effects on the association of the fathers' occupational status and the sons' occupational status, we can compare this model to the RC(1) model for these data: <>= RCheterog <- gnm(Freq ~ origin + destination + Diag(origin, destination) + Mult(origin, destination), family = poisson, data = occupationalStatus) anova(RChomog, RCheterog) @ In this case there is little gain in allowing heterogeneous effects. \subsection{Diagonal reference models} \label{sec:Dref} Diagonal reference models, proposed by \citet{Sobe81, Sobe85}, are designed for contingency tables classified by factors with the same levels. The cell means are modelled as a function of the diagonal effects, i.e., the mean responses of the `diagonal' cells in which the levels of the row and column factors are the same. \subsubsection*{\Rfunction{Dref} example 1: Political consequences of social mobility} To illustrate the use of diagonal reference models we shall use the \Robject{voting} data from \citet{Clif93}. The data come from the 1987 British general election and are the percentage voting Labour in groups cross-classified by the class of the head of household (\Robject{destination}) and the class of their father (\Robject{origin}). In order to weight these percentages by the group size, we first back-transform them to the counts of those voting Labour and those not voting Labour: @ <>= set.seed(1) count <- with(voting, percentage/100 * total) yvar <- cbind(count, voting$total - count) @ %def The grouped percentages may be modelled by a basic diagonal reference model, that is, a weighted sum of the diagonal effects for the corresponding origin and destination classes. This model may be expressed as \[ \mu_{od} = \frac{e^{\delta_1}}{e^{\delta_1} + e^{\delta_2}}\gamma_o + \frac{e^{\delta_2}}{e^{\delta_1} + e^{\delta_2}}\gamma_d . \] See Section \ref{sec:Dref function} for more detail on the parameterization. The basic diagonal reference model may be fitted using \Rfunction{gnm} as follows @ <>= classMobility <- gnm(yvar ~ Dref(origin, destination), family = binomial, data = voting) classMobility @ %def and the origin and destination weights can be evaluated as below @ <>= DrefWeights(classMobility) @ %def These results are slightly different from those reported by \citet{Clif93}. The reason for this is unclear: we are confident that the above results are correct for the data as given in \citet{Clif93}, but have not been able to confirm that the data as printed in the journal were exactly as used in Clifford and Heath's analysis. \citet{Clif93} suggest that movements in and out of the salariat (class 1) should be treated differently from movements between the lower classes (classes 2 - 5), since the former has a greater effect on social status. Thus they propose the following model \begin{equation*} \mu_{od} = \begin{cases} \dfrac{e^{\delta_1}}{e^{\delta_1} + e^{\delta_2}}\gamma_o + \dfrac{e^{\delta_2}}{e^{\delta_1} + e^{\delta_2}}\gamma_d & \text{if } o = 1\\ \\ \dfrac{e^{\delta_3}}{e^{\delta_3} + e^{\delta_4}}\gamma_o + \dfrac{e^{\delta_4}}{e^{\delta_3} + e^{\delta_4}}\gamma_d & \text{if } d = 1\\ \\ \dfrac{e^{\delta_5}}{e^{\delta_5} + e^{\delta_6}}\gamma_o + \dfrac{e^{\delta_6}}{e^{\delta_5} + e^{\delta_6}}\gamma_d & \text{if } o \ne 1 \text{ and } d \ne 1 \end{cases} \end{equation*} To fit this model we define factors indicating movement in (upward) and out (downward) of the salariat @ <>= upward <- with(voting, origin != 1 & destination == 1) downward <- with(voting, origin == 1 & destination != 1) @ %def Then the diagonal reference model with separate weights for socially mobile groups can be estimated as follows @ <>= socialMobility <- gnm(yvar ~ Dref(origin, destination, delta = ~ 1 + downward + upward), family = binomial, data = voting) socialMobility @ %def The weights for those moving into the salariat, those moving out of the salariat and those in any other group, can be evaluated as below @ <>= DrefWeights(socialMobility) @ %def Again, the results differ slightly from those reported by \citet{Clif93}, but the essence of the results is the same: the origin weight is much larger for the downwardly mobile group than for the other groups. The weights for the upwardly mobile group are very similar to the base level weights, so the model may be simplified by only fitting separate weights for the downwardly mobile group: @ <>= downwardMobility <- gnm(yvar ~ Dref(origin, destination, delta = ~ 1 + downward), family = binomial, data = voting) downwardMobility DrefWeights(downwardMobility) @ %def \subsubsection*{\Rfunction{Dref} example 2: conformity to parental rules} %\SweaveInput{vanDerSlikEg.Rnw} Another application of diagonal reference models is given by \citet{Vand02}. The data from this paper are not publicly available\footnote{ We thank Frans van der Slik for his kindness in sending us the data.}, but we shall show how the models presented in the paper may be estimated using \Rfunction{gnm}. The data relate to the value parents place on their children conforming to their rules. There are two response variables: the mother's conformity score (MCFM) and the father's conformity score (FCFF). The data are cross-classified by two factors describing the education level of the mother (MOPLM) and the father (FOPLF), and there are six further covariates (AGEM, MRMM, FRMF, MWORK, MFCM and FFCF). In their baseline model for the mother's conformity score, \citet{Vand02} include five of the six covariates (leaving out the father's family conflict score, FCFF) and a diagonal reference term with constant weights based on the two education factors. This model may be expressed as \[ \mu_{rci} = \beta_1x_{1i} + \beta_2x_{2i} + \beta_3x_{3i} +\beta_4x_{4i} +\beta_5x_{5i} + \frac{e^{\delta_1}}{e^{\delta_1} + e^{\delta_2}}\gamma_r + \frac{e^{\delta_2}}{e^{\delta_1} + e^{\delta_2}}\gamma_c . \] The baseline model can be fitted as follows: \begin{Sinput} > set.seed(1) > A <- gnm(MCFM ~ -1 + AGEM + MRMM + FRMF + MWORK + MFCM + + Dref(MOPLM, FOPLF), family = gaussian, data = conformity, + verbose = FALSE) > A \end{Sinput} \begin{Soutput} Call: gnm(formula = MCFM ~ -1 + AGEM + MRMM + FRMF + MWORK + MFCM + Dref(MOPLM, FOPLF), family = gaussian, data = conformity, verbose = FALSE) Coefficients: AGEM MRMM FRMF 0.06363 -0.32425 -0.25324 MWORK MFCM Dref(MOPLM, FOPLF)delta1 -0.06430 -0.06043 -0.33731 Dref(MOPLM, FOPLF)delta2 Dref(., .).MOPLM|FOPLF1 Dref(., .).MOPLM|FOPLF2 -0.02505 4.95121 4.86329 Dref(., .).MOPLM|FOPLF3 Dref(., .).MOPLM|FOPLF4 Dref(., .).MOPLM|FOPLF5 4.86458 4.72343 4.43516 Dref(., .).MOPLM|FOPLF6 Dref(., .).MOPLM|FOPLF7 4.18873 4.43378 Deviance: 425.3389 Pearson chi-squared: 425.3389 Residual df: 576 \end{Soutput} The coefficients of the covariates are not aliased with the parameters of the diagonal reference term and thus the basic identifiability constraints that have been imposed are sufficient for these parameters to be identified. The diagonal effects do not need to be constrained as they represent contrasts with the off-diagonal cells. Therefore the only unidentified parameters in this model are the weight parameters. This is confirmed in the summary of the model: \begin{Sinput} > summary(A) \end{Sinput} \begin{Soutput} Call: gnm(formula = MCFM ~ -1 + AGEM + MRMM + FRMF + MWORK + MFCM + Dref(MOPLM, FOPLF), family = gaussian, data = conformity, verbose = FALSE) Deviance Residuals: Min 1Q Median 3Q Max -3.63688 -0.50383 0.01714 0.56753 2.25139 Coefficients: Estimate Std. Error t value Pr(>|t|) AGEM 0.06363 0.07375 0.863 0.38859 MRMM -0.32425 0.07766 -4.175 3.44e-05 FRMF -0.25324 0.07681 -3.297 0.00104 MWORK -0.06430 0.07431 -0.865 0.38727 MFCM -0.06043 0.07123 -0.848 0.39663 Dref(MOPLM, FOPLF)delta1 -0.33731 NA NA NA Dref(MOPLM, FOPLF)delta2 -0.02505 NA NA NA Dref(., .).MOPLM|FOPLF1 4.95121 0.16639 29.757 < 2e-16 Dref(., .).MOPLM|FOPLF2 4.86329 0.10436 46.602 < 2e-16 Dref(., .).MOPLM|FOPLF3 4.86458 0.12855 37.842 < 2e-16 Dref(., .).MOPLM|FOPLF4 4.72343 0.13523 34.929 < 2e-16 Dref(., .).MOPLM|FOPLF5 4.43516 0.19314 22.963 < 2e-16 Dref(., .).MOPLM|FOPLF6 4.18873 0.17142 24.435 < 2e-16 Dref(., .).MOPLM|FOPLF7 4.43378 0.16903 26.231 < 2e-16 --- (Dispersion parameter for gaussian family taken to be 0.7384355) Std. Error is NA where coefficient has been constrained or is unidentified Residual deviance: 425.34 on 576 degrees of freedom AIC: 1507.8 Number of iterations: 15 \end{Soutput} The weights have been constrained to sum to one as described in Section \ref{sec:Dref function}, so the weights themselves may be estimated as follows: \begin{Sinput} > prop.table(exp(coef(A)[6:7])) \end{Sinput} \begin{Soutput} Dref(MOPLM, FOPLF)delta1 Dref(MOPLM, FOPLF)delta2 0.4225638 0.5774362 \end{Soutput} However, in order to estimate corresponding standard errors, the parameters of one of the weights must be constrained. If no such constraints were applied when the model was fitted, \Rfunction{DrefWeights} will refit the model constraining the parameters of the first weight to zero: \begin{Sinput} > DrefWeights(A) \end{Sinput} \begin{Soutput} Refitting with parameters of first Dref weight constrained to zero $MOPLM weight se 0.4225636 0.1439829 $FOPLF weight se 0.5774364 0.1439829 \end{Soutput} giving the values reported by \citet{Vand02}. All the other coefficients of model A are the same as those reported by \citet{Vand02} except the coefficients of the mother's gender role (MRMM) and the father's gender role (FRMF). \citet{Vand02} reversed the signs of the coefficients of these factors since they were coded in the direction of liberal values, unlike the other covariates. However, simply reversing the signs of these coefficients does not give the same model, since the estimates of the diagonal effects depend on the estimates of these coefficients. For consistent interpretation of the covariate coefficients, it is better to recode the gender role factors as follows: \begin{Sinput} > MRMM2 <- as.numeric(!conformity$MRMM) > FRMF2 <- as.numeric(!conformity$FRMF) > A <- gnm(MCFM ~ -1 + AGEM + MRMM2 + FRMF2 + MWORK + MFCM + + Dref(MOPLM, FOPLF), family = gaussian, data = conformity, + verbose = FALSE) > A \end{Sinput} \begin{Soutput} Call: gnm(formula = MCFM ~ -1 + AGEM + MRMM2 + FRMF2 + MWORK + MFCM + Dref(MOPLM, FOPLF), family = gaussian, data = conformity, verbose = FALSE) Coefficients: AGEM MRMM2 FRMF2 0.06363 0.32425 0.25324 MWORK MFCM Dref(MOPLM, FOPLF)delta1 -0.06430 -0.06043 0.08440 Dref(MOPLM, FOPLF)delta2 Dref(., .).MOPLM|FOPLF1 Dref(., .).MOPLM|FOPLF2 0.39666 4.37371 4.28579 Dref(., .).MOPLM|FOPLF3 Dref(., .).MOPLM|FOPLF4 Dref(., .).MOPLM|FOPLF5 4.28708 4.14593 3.85767 Dref(., .).MOPLM|FOPLF6 Dref(., .).MOPLM|FOPLF7 3.61123 3.85629 Deviance: 425.3389 Pearson chi-squared: 425.3389 Residual df: 576 \end{Soutput} The coefficients of the covariates are now as reported by \citet{Vand02}, but the diagonal effects have been adjusted appropriately. \citet{Vand02} compare the baseline model for the mother's conformity score to several other models in which the weights in the diagonal reference term are dependent on one of the covariates. One particular model they consider incorporates an interaction of the weights with the mother's conflict score as follows: \[ \mu_{rci} = \beta_1x_{1i} + \beta_2x_{2i} + \beta_3x_{3i} +\beta_4x_{4i} +\beta_5x_{5i} + \frac{e^{\xi_{01} + \xi_{11}x_{5i}}}{e^{\xi_{01} + \xi_{11}x_{5i}} + e^{\xi_{02} + \xi_{12}x_{5i}}}\gamma_r + \frac{e^{\xi_{02} + \xi_{12}x_{5i}}}{e^{\xi_{01} + \xi_{11}x_{5i}} + e^{\xi_{02} + \xi_{12}x_{5i}}}\gamma_c. \] This model can be fitted as below, using the original coding for the gender role factors for ease of comparison to the results reported by \citet{Vand02}, \begin{Sinput} > F <- gnm(MCFM ~ -1 + AGEM + MRMM + FRMF + MWORK + MFCM + + Dref(MOPLM, FOPLF, delta = ~ 1 + MFCM), family = gaussian, + data = conformity, verbose = FALSE) > F \end{Sinput} \begin{Soutput} Call: gnm(formula = MCFM ~ -1 + AGEM + MRMM + FRMF + MWORK + MFCM + Dref(MOPLM, FOPLF, delta = ~1 + MFCM), family = gaussian, data = conformity, verbose = FALSE) Coefficients: AGEM 0.05818 MRMM -0.32701 FRMF -0.25772 MWORK -0.07847 MFCM -0.01694 Dref(MOPLM, FOPLF, delta = ~ . + MFCM).delta1(Intercept) 1.03515 Dref(MOPLM, FOPLF, delta = ~ 1 + .).delta1MFCM -1.77756 Dref(MOPLM, FOPLF, delta = ~ . + MFCM).delta2(Intercept) -0.03515 Dref(MOPLM, FOPLF, delta = ~ 1 + .).delta2MFCM 2.77756 Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF1 4.82476 Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF2 4.88066 Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF3 4.83969 Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF4 4.74850 Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF5 4.42020 Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF6 4.17957 Dref(., ., delta = ~ 1 + MFCM).MOPLM|FOPLF7 4.40819 Deviance: 420.9022 Pearson chi-squared: 420.9022 Residual df: 575 \end{Soutput} In this case there are two sets of weights, one for when the mother's conflict score is less than average (coded as zero) and one for when the score is greater than average (coded as one). These can be evaluated as follows: \begin{Sinput} > DrefWeights(F) \end{Sinput} \begin{Soutput} Refitting with parameters of first Dref weight constrained to zero $MOPLM MFCM weight se 1 1 0.02974675 0.2277711 2 0 0.74465224 0.2006916 $FOPLF MFCM weight se 1 1 0.9702532 0.2277711 2 0 0.2553478 0.2006916 \end{Soutput} giving the same weights as in Table 4 of \citet{Vand02}, though we obtain a lower standard error in the case where MFCM is equal to one. \subsection{Uniform difference (UNIDIFF) models} \label{sec:Unidiff} Uniform difference models \citep{Xie92, Erik92} use a simplified three-way interaction to provide an interpretable model of contingency tables classified by three or more variables. For example, the uniform difference model for a three-way contingency table, also known as the UNIDIFF model, is given by \[ \mu_{ijk} = \alpha_{ik} + \beta_{jk} + \exp(\delta_k)\gamma_{ij}. \] The $\gamma_{ij}$ represent a pattern of association that varies in strength over the dimension indexed by $k$, and $\exp(\delta_k)$ represents the relative strength of that association at level $k$. This model can be applied to the \Robject{yaish} data set \citep{Yais98,Yais04}, which is a contingency table cross-classified by father's social class (\Robject{orig}), son's social class (\Robject{dest}) and son's education level (\Robject{educ}). In this case, we can consider the importance of the association between the social class of father and son across the education levels. We omit the sub-table which corresponds to level 7 of \Robject{dest}, because its information content is negligible: @ <>= set.seed(1) unidiff <- gnm(Freq ~ educ*orig + educ*dest + Mult(Exp(educ), orig:dest), ofInterest = "[.]educ", family = poisson, data = yaish, subset = (dest != 7)) coef(unidiff) @ %def The \Robject{ofInterest} component has been set to index the multipliers of the association between the social class of father and son. We can contrast each multiplier to that of the lowest education level and obtain the standard errors for these parameters as follows: @ <>= getContrasts(unidiff, ofInterest(unidiff)) @ %def Four-way contingency tables may sometimes be described by a ``double UNIDIFF'' model \[ \mu_{ijkl} = \alpha_{il} + \beta_{jkl} + \exp(\delta_l)\gamma_{ij} + \exp(\phi_l)\theta_{ik}, \] where the strengths of two, two-way associations with a common variable are estimated across the levels of the fourth variable. The \Robject{cautres} data set, from \citet{Caut98}, can be used to illustrate the application of the double UNIDIFF model. This data set is classified by the variables vote, class, religion and election. Using a double UNIDIFF model, we can see how the association between class and vote, and the association between religion and vote, differ between the most recent election and the other elections: @ <>= set.seed(1) doubleUnidiff <- gnm(Freq ~ election*vote + election*class*religion + Mult(Exp(election), religion:vote) + Mult(Exp(election), class:vote), family = poisson, data = cautres) getContrasts(doubleUnidiff, rev(pickCoef(doubleUnidiff, ", class:vote"))) getContrasts(doubleUnidiff, rev(pickCoef(doubleUnidiff, ", religion:vote"))) @ %def \subsection{Generalized additive main effects and multiplicative interaction (GAMMI) models} \label{sec:GAMMI} Generalized additive main effects and multiplicative interaction models, or GAMMI models, were motivated by two-way contingency tables and comprise the row and column main effects plus one or more components of the multiplicative interaction. The singular value corresponding to each multiplicative component is often factored out, as a measure of the strength of association between the row and column scores, indicating the importance of the component, or axis. For cell means $\mu_{rc}$ a GAMMI-K model has the form \begin{equation} \label{eq:GAMMI} g(\mu_{rc}) = \alpha_r + \beta_c + \sum_{k=1}^K \sigma_k\gamma_{kr}\delta_{kc}, \end{equation} in which $g$ is a link function, $\alpha_r$ and $\beta_c$ are the row and column main effects, $\gamma_{kr}$ and $\delta_{kc}$ are the row and column scores for multiplicative component $k$ and $\sigma_k$ is the singular value for component $k$. The number of multiplicative components, $K$, is less than or equal to the rank of the matrix of residuals from the main effects. The row-column association models discussed in Section \ref{sec:RCmodels} are examples of GAMMI models, with a log link and poisson variance. Here we illustrate the use of an AMMI model, which is a GAMMI model with an identity link and a constant variance. We shall use the \Robject{wheat} data set taken from \citet{Varg01}, which gives wheat yields measured over ten years. First we scale these yields and create a new treatment factor, so that we can reproduce the analysis of \citet{Varg01}: @ <>= set.seed(1) yield.scaled <- wheat$yield * sqrt(3/1000) treatment <- interaction(wheat$tillage, wheat$summerCrop, wheat$manure, wheat$N, sep = "") @ %def Now we can fit the AMMI-1 model, to the scaled yields using the combined treatment factor and the year factor from the \Robject{wheat} dataset. We will proceed by first fitting the main effects model, then using \Rfunction{residSVD} (see Section \ref{sec:residSVD}) for the parameters of the multiplicative term: @ <>= mainEffects <- gnm(yield.scaled ~ year + treatment, family = gaussian, data = wheat) svdStart <- residSVD(mainEffects, year, treatment, 3) bilinear1 <- update(mainEffects, . ~ . + Mult(year, treatment), start = c(coef(mainEffects), svdStart[,1])) @ %def We can compare the AMMI-1 model to the main effects model, @ <>= anova(mainEffects, bilinear1, test = "F") @ %def giving the same results as in Table 1 of \citet{Varg01} (up to error caused by rounding). Thus the significance of the multiplicative interaction can be tested without applying constraints to this term. If the multiplicative interaction is significant, we may wish to apply constraints to obtain estimates of the row and column scores. We illustrate this using the \Robject{barleyHeights} data, which records the average height for 15 genotypes of barley over 9 years. For this small dataset the AMMI-1 model is easily estimated with the default settings: @ <>= set.seed(1) barleyModel <- gnm(height ~ year + genotype + Mult(year, genotype), data = barleyHeights) @ %def To obtain the parameterization of Equation \ref{eq:GAMMI} in which $\sigma_k$ is the singular value for component $k$, the row and column scores must be constrained so that the scores sum to zero and the squared scores sum to one. These contrasts can be obtained using \Robject{getContrasts}: @ <>= gamma <- getContrasts(barleyModel, pickCoef(barleyModel, "[.]y"), ref = "mean", scaleWeights = "unit") delta <- getContrasts(barleyModel, pickCoef(barleyModel, "[.]g"), ref = "mean", scaleWeights = "unit") gamma delta @ %def Confidence intervals based on the assumption of asymptotic normality can be computed as follows: @ <>= gamma[[2]][,1] + (gamma[[2]][,2]) %o% c(-1.96, 1.96) delta[[2]][,1] + (delta[[2]][,2]) %o% c(-1.96, 1.96) @ %def which broadly agree with Table 8 of Chadoeuf and Denis (1991), allowing for the change in sign. On the basis of such confidence intervals we can investigate simplifications of the model such as combining levels of the factors or fitting an additive model to a subset of the data. The singular value $\sigma_k$ may be obtained as follows @ <>= svd(termPredictors(barleyModel)[, "Mult(year, genotype)"])$d @ %def This parameter is of little interest in itself, given that the significance of the term as a whole can be tested using ANOVA. The SVD representation can also be obtained quite easily for AMMI and GAMMI models with interaction rank greater than 1\null. See \Rcode{example(wheat)} for an example of this in an AMMI model with rank 2\null. (The calculation of \emph{standard errors} and \emph{confidence regions} for the SVD representation with rank greater than 1 is not yet implemented, though.) \subsection{Biplot models} \label{sec:biplot} Biplots are graphical displays of two-dimensional arrays, which represent the objects that index both dimensions of the array on the same plot. Here we consider the case of a two-way table, where a biplot may be used to represent both the row and column categories simultaneously. A two-dimensional biplot is constructed from a rank-2 representation of the data. For two-way tables, the generalized bilinear model defines one such representation: \begin{equation*} g(\mu_{ij}) = \eta_{ij} = \alpha_{1i}\beta_{1j} + \alpha_{2i}\beta_{2j} \end{equation*} since we can alternatively write \begin{align*} \boldsymbol{\eta} &= \begin{pmatrix} \alpha_{11} & \alpha_{21} \\ \vdots & \vdots \\ \alpha_{1n} & \alpha_{2n} \\ \end{pmatrix} \begin{pmatrix} \beta_{11} & \dots & \beta_{1p} \\ \beta_{21} & \dots & \beta_{2p} \\ \end{pmatrix} \\ &= \boldsymbol{AB}^T \end{align*} where the columns of $A$ and $B$ are linearly independent by definition. To demonstrate how the biplot is obtained from this model, we shall use the \Robject{barley} data set which gives the percentage of leaf area affected by leaf blotch for ten varieties of barley grown at nine sites \citep{Wedd74,Gabr98}. As suggested by \citet{Wedd74} we model these data using a logit link and a variance proportional to the square of that of the binomial, implemented as the \Rfunction{wedderburn} family in \Rpackage{gnm} (see also Section \ref{sec:glms}): @ <>= set.seed(83) biplotModel <- gnm(y ~ -1 + instances(Mult(site, variety), 2), family = wedderburn, data = barley) @ %def The effect of site $i$ can be represented by the point \[ (\alpha_{1i}, \alpha_{2i}) \] in the space spanned by the linearly independent basis vectors \begin{align*} a_1 = (\alpha_{11}, \alpha_{12}, \ldots \alpha_{19})^T\\ a_2 = (\alpha_{21}, \alpha_{22}, \ldots \alpha_{29})^T\\ \end{align*} and the variety effects can be similarly represented. Thus we can represent the sites and varieties separately as follows \begin{Sinput} sites <- pickCoef(biplotModel, "[.]site") coefs <- coef(biplotModel) A <- matrix(coefs[sites], nc = 2) B <- matrix(coefs[-sites], nc = 2) par(mfrow = c(1, 2)) plot(A, pch = levels(barley$site), xlim = c(-5, 5), ylim = c(-5, 5), main = "Site Effects", xlab = "Component 1", ylab = "Component 2") plot(B, pch = levels(barley$variety), xlim = c(-5, 5), ylim = c(-5, 5), main = "Variety Effects", xlab = "Component 1", ylab = "Component 2") \end{Sinput} \begin{figure}[!tbph] \begin{center} \includegraphics[width = 6in]{fig-Effect_plots.pdf} \end{center} \caption{Plots of site and variety effects from the generalized bilinear model of the barley data.} \label{fig:Effect_plots} \end{figure} Of course the parameterization of the bilinear model is not unique and therefore the scale and rotation of the points in these plots will depend on the random seed. By rotation and reciprocal scaling of the matrices $A$ and $B$, we can obtain basis vectors with desirable properties without changing the fitted model. In particular, if we rotate the matrices $A$ and $B$ so that their columns are orthogonal, then the corresponding plots will display the euclidean distances between sites and varieties respectively. If we also scale the matrices $A$ and $B$ so that the corresponding plots have the same units, then we can combine the two plots to give a conventional biplot display. The required rotation and scaling can be performed via singular value decomposition of the fitted predictors: @ <>= barleyMatrix <- xtabs(biplotModel$predictors ~ site + variety, data = barley) barleySVD <- svd(barleyMatrix) A <- sweep(barleySVD$u, 2, sqrt(barleySVD$d), "*")[, 1:2] B <- sweep(barleySVD$v, 2, sqrt(barleySVD$d), "*")[, 1:2] rownames(A) <- levels(barley$site) rownames(B) <- levels(barley$variety) colnames(A) <- colnames(B) <- paste("Component", 1:2) A B @ %def These matrices are essentially the same as in \citet{Gabr98}. From these the biplot can be produced, for sites $A \ldots I$ and varieties $1 \dots 9, X$: @ <>= barleyCol <- c("red", "blue") plot(rbind(A, B), pch = c(levels(barley$site), levels(barley$variety)), col = rep(barleyCol, c(nlevels(barley$site), nlevels(barley$variety))), xlim = c(-4, 4), ylim = c(-4, 4), main = "Biplot for barley data", xlab = "Component 1", ylab = "Component 2") text(c(-3.5, -3.5), c(3.9, 3.6), c("sites: A-I","varieties: 1-9, X"), col = barleyCol, adj = 0) @ %def \begin{figure}[!tbph] \begin{center} \includegraphics{gnmOverview-Biplot1.pdf} \end{center} \caption{Biplot for barley data} \label{fig:Biplot1} \end{figure} The biplot gives an idea of how the sites and varieties are related to one another. It also allows us to consider whether the data can be represented by a simpler model than the generalized bilinear model. We see that the points in the biplot approximately align with the rotated axes shown in Figure \ref{fig:Biplot2}, such that the sites fall about a line parallel to the ``h-axis'' and the varieties group about two lines roughly parallel to the ``v-axis''. @ <>= plot(rbind(A, B), pch = c(levels(barley$site), levels(barley$variety)), col = rep(barleyCol, c(nlevels(barley$site), nlevels(barley$variety))), xlim = c(-4, 4), ylim = c(-4, 4), main = "Biplot for barley data", xlab = "Component 1", ylab = "Component 2") text(c(-3.5, -3.5), c(3.9, 3.6), c("sites: A-I","varieties: 1-9, X"), col = barleyCol, adj = 0) abline(a = 0, b = tan(pi/3)) abline(a = 0, b = -tan(pi/6)) abline(a = 2.6, b = tan(pi/3), lty = 2) abline(a = 4.5, b = tan(pi/3), lty = 2) abline(a = 1.3, b = -tan(pi/6), lty = 2) text(2.8, 3.9, "v-axis", font = 3) text(3.8, -2.7, "h-axis", font = 3) @ %def %abline(a = 0, b = tan(3*pi/10), lty = 4) %abline(a = 0, b = -tan(pi/5), lty = 4) \begin{figure}[!tbph] \begin{center} \includegraphics{gnmOverview-Biplot2.pdf} \end{center} \caption{Biplot for barley data, showing approximate alignment with rotated axes.} \label{fig:Biplot2} \end{figure} This suggests that the sites could be represented by points along a line, with co-ordinates \begin{equation*} (\gamma_i, \delta_0). \end{equation*} and the varieties by points on two lines perpendicular to the site line: \begin{equation*} (\nu_0 + \nu_1I(i \in \{2, 3, 6\}), \omega_j) \end{equation*} This corresponds to the following simplification of the bilinear model: \begin{align*} &\alpha_{1i}\beta_{1j} + \alpha_{2i}\beta_{2j} \\ \approx &\gamma_i(\nu_0 + \nu_1I(i \in \{2, 3, 6\})) + \delta_0\omega_j \end{align*} or equivalently \begin{equation*} \gamma_i(\nu_0 + \nu_1I(i \in \{2, 3, 6\})) + \omega_j, \end{equation*} the double additive model proposed by \citet{Gabr98}. We can fit this model as follows: @ <>= variety.binary <- factor(match(barley$variety, c(2,3,6), nomatch = 0) > 0, labels = c("rest", "2,3,6")) doubleAdditive <- gnm(y ~ variety + Mult(site, variety.binary), family = wedderburn, data = barley) @ %def Comparing the chi-squared statistics, we see that the double additive model is an adequate model for the leaf blotch incidence: @ <>= biplotModChiSq <- sum(residuals(biplotModel, type = "pearson")^2) doubleAddChiSq <- sum(residuals(doubleAdditive, type = "pearson")^2) c(doubleAddChiSq - biplotModChiSq, doubleAdditive$df.residual - biplotModel$df.residual) @ %def \subsection{Stereotype model for multinomial response} \label{sec:Stereotype} The stereotype model was proposed by \citet{Ande84} for ordered categorical data. It is a special case of the multinomial logistic model, in which the covariate coefficients are common to all categories but the scale of association is allowed to vary between categories such that \[ p_{ic} = \frac{\exp(\beta_{0c} + \gamma_c \boldsymbol{\beta}^T\boldsymbol{x}_{i})}{\sum_{k = 1}^K \exp(\beta_{0k} + \gamma_k \boldsymbol{\beta}^T\boldsymbol{x}_{i})} \] where $p_{ic}$ is the probability that the response for individual $i$ is category $c$ and $K$ is the number of categories. Like the multinomial logistic model, the stereotype model specifies a simple form for the log odds of one category against another, e.g. \begin{equation*} \log\left(\frac{p_{ic}}{p_{ik}}\right) = (\beta_{0c} - \beta_{0k}) + (\gamma_c - \gamma_k)\boldsymbol{\beta}^T\boldsymbol{x}_{i} \end{equation*} In order to model a multinomial response in the generalized nonlinear model framework, we must re-express the data as category counts $Y_i = (Y_{i1}, \ldots, Y_{iK})$ for each individual (or group). Then assuming a Poisson distribution for the counts $Y_{ic}$, the joint distribution of $Y_i$ is Multinomial$(N_i, p_{i1}, \ldots, p_{iK})$ conditional on the total count for each individual $N_i$. The expected counts are then $\mu_{ic} = N_ip_{ic}$ and the parameters of the stereotype model can be estimated through fitting the following model \begin{align*} \log \mu_{ic} &= \log(N_i) + \log(p_{ic}) \\ &= \alpha_i + \beta_{0c} + \gamma_c\sum_r \boldsymbol{\beta}_{r}\boldsymbol{x}_{ir} \\ \end{align*} where the ``nuisance'' parameters $\alpha_i$ ensure that the multinomial denominators are reproduced exactly, as required. The \Rpackage{gnm} package includes the utility function \Rfunction{expandCategorical} to re-express the categorical response as category counts. By default, individuals with common values across all covariates are grouped together, to avoid redundancy. For example, the \Robject{backPain} data set from \citet{Ande84} describes the progress of patients with back pain. The data set consists of an ordered factor quantifying the progress of each patient, and three prognostic variables. We re-express the data as follows: @ <>= set.seed(1) subset(backPain, x1 == 1 & x2 == 1 & x3 == 1) backPainLong <- expandCategorical(backPain, "pain") head(backPainLong) @ %def We can now fit the stereotype model to these data: @ <>= oneDimensional <- gnm(count ~ pain + Mult(pain, x1 + x2 + x3), eliminate = id, family = "poisson", data = backPainLong) oneDimensional @ %def specifying the \Robject{id} factor through \Rfunarg{eliminate} so that the 12 \Robject{id} effects are estimated more efficiently and are excluded from printed model summaries by default. This model is one dimensional since it involves only one function of $\mathbf{x} = (x1, x2, x3)$. We can compare this model to one with category-specific coefficients of the $x$ variables, as may be used for a qualitative categorical response: @ <>= threeDimensional <- gnm(count ~ pain + pain:(x1 + x2 + x3), eliminate = id, family = "poisson", data = backPainLong) threeDimensional @ %def This model has the maximum dimensionality of three (as determined by the number of covariates). The ungrouped multinomial log-likelihoods reported in \citet{Ande84} are given by \begin{equation*} \sum_{i,c} y_{ic}\log(p_{ic}) = \sum_{i,c} y_{ic}\log(\mu_{ic}/n_{ic}) \end{equation*} We write a simple function to compute this and the corresponding degrees of freedom, then compare the log-likelihoods of the one dimensional model and the three dimensional model: @ <>= logLikMultinom <- function(model, size){ object <- get(model) l <- sum(object$y * log(object$fitted/size)) c(nParameters = object$rank - nlevels(object$eliminate), logLikelihood = l) } size <- tapply(backPainLong$count, backPainLong$id, sum)[backPainLong$id] t(sapply(c("oneDimensional", "threeDimensional"), logLikMultinom, size)) @ %def showing that the \Robject{oneDimensional} model is adequate. To obtain estimates of the category-specific multipliers in the stereotype model, we need to constrain both the location and the scale of these parameters. The latter constraint can be imposed by fixing the slope of one of the covariates in the second multiplier to \Robject{1}, which may be achieved by specifying the covariate as an offset: @ <>= ## before constraint summary(oneDimensional) oneDimensional <- gnm(count ~ pain + Mult(pain, offset(x1) + x2 + x3), eliminate = id, family = "poisson", data = backPainLong) ## after constraint summary(oneDimensional) @ %def The location of the category-specific multipliers can constrained by setting one of the parameters to zero, either through the \Rfunarg{constrain} argument of \Rfunction{gnm} or with \Rfunction{getContrasts}: @ <>= getContrasts(oneDimensional, pickCoef(oneDimensional, "[.]pain")) @ %def giving the required estimates. \subsection{Lee-Carter model for trends in age-specific mortality} In the study and projection of population mortality rates, the model proposed by \cite{LeeCart92} forms the basis of many if not most current analyses. Here we consider the quasi-Poisson version of the model \citep{Wilm93, Alho00, BrouDenuVerm02, RensHabe03}, in which the death count $D_{ay}$ for individuals of age $a$ in year $y$ has mean $\mu_{ay}$ and variance $\phi\mu_{ay}$ (where $\phi$ is 1 for Poisson-distributed counts, and is respectively greater than or less than 1 in cases of over-dispersion or under-dispersion). In the Lee-Carter model, the expected counts follow the log-bilinear form \[ \log(\mu_{ay}/e_{ay}) = \alpha_a + \beta_a \gamma_y, \] where $e_{ay}$ is the `exposure' (number of lives at risk). This is a generalized nonlinear model with a single multiplicative term. The use of \Rpackage{gnm} to fit this model is straightforward. We will illustrate by using data downloaded on 2006-11-14 from the Human Mortality Database\footnote{Thanks to Iain Currie for helpful advice relating to this section} (HMD, made available by the University of California, Berkeley, and Max Planck Institute for Demographic Research, at \texttt{http://www.mortality.org}) on male deaths in Canada between 1921 and 2003. The data are not made available as part of \Rpackage{gnm} because of license restrictions; but they are readily available via the web simply by registering with the HMD. We assume that the data for Canadian males (both deaths and exposure-to-risk) have been downloaded from the HMD and organised into a data frame named \Robject{Canada} in \R, with columns \Robject{Year} (a factor, with levels \Rcode{1921} to \Rcode{2003}), \Robject{Age} (a factor, with levels \Rcode{20} to \Rcode{99}), \Robject{mDeaths} and \Robject{mExposure} (both quantitative). The Lee-Carter model may then be specified as \begin{Sinput} LCmodel.male <- gnm(mDeaths ~ Age + Mult(Exp(Age), Year), offset = log(mExposure), family = "quasipoisson", data = Canada) \end{Sinput} Here we have acknowledged the fact that the model only really makes sense if all of the $\beta_a$ parameters, which represent the `sensitivity' of age group $a$ to a change in the level of general mortality \citep[e.g.,][]{BrouDenuVerm02}, have the same sign. Without loss of generality we assume $\beta_a>0$ for all $a$, and we impose this constraint by using \Rcode{Exp(Age)} instead of just \Rcode{Age} in the multiplicative term. Convergence is to a fitted model with residual deviance 32419.83 on 6399 degrees of freedom --- representing clear evidence of substantial overdispersion relative to the Poisson distribution. In order to explore the lack of fit a little further, we plot the distribution of Pearson residuals in Figure \ref{fig:LCresplot}: \begin{Sinput} par(mfrow = c(2,2)) age <- as.numeric(as.character(Canada$Age)) with(Canada,{ res <- residuals(LCmodel.male, type = "pearson") plot(Age, res, xlab="Age", ylab="Pearson residual", main = "(a) Residuals by age") plot(Year, res, xlab="Year", ylab="Pearson residual", main = "(b) Residuals by year") plot(Year[(age>24) & (age<36)], res[(age>24) & (age<36)], xlab = "Year", ylab = "Pearson residual", main = "(c) Age group 25-35") plot(Year[(age>49) & (age<66)], res[(age>49) & (age<66)], xlab = "Year", ylab = "Pearson residual", main = "(d) Age group 50-65") }) \end{Sinput} %$ \begin{figure}[!tbph] \begin{center} \includegraphics[width=6in]{fig-LCall.pdf} \end{center} \caption{Canada, males: plots of residuals from the Lee-Carter model of mortality} \label{fig:LCresplot} \end{figure} Panel (a) of Figure \ref{fig:LCresplot} indicates that the overdispersion is not evenly spread through the data, but is largely concentrated in two age groups, roughly ages 25--35 and 50--65\null. Panels (c) and (d) focus on the residuals in each of these two age groups: there is a clear (and roughly cancelling) dependence on \Robject{Year}, indicating that the assumed bilinear interaction between \Robject{Age} and \Robject{Year} does not hold for the full range of ages and years considered here. A somewhat more satisfactory Lee-Carter model fit is obtained if only a subset of the data is used, namely only those males aged 45 or over: \begin{Sinput} LCmodel.maleOver45 <- gnm(mDeaths ~ Age + Mult(Exp(Age), Year), offset = log(mExposure), family = "quasipoisson", data = Canada[age>44,]) \end{Sinput} The residual deviance now is 12595.44 on 4375 degrees of freedom: still substantially overdispersed, but less severely so than before. Again we plot the distributions of Pearson residuals (Figure \ref{fig:LCresplot2}). \begin{figure}[!tbph] \begin{center} \includegraphics[width=6in]{fig-LCover45.pdf} \end{center} \caption{Canada, males over 45: plots of residuals from the Lee-Carter model of mortality} \label{fig:LCresplot2} \end{figure} Still clear departures from the assumed bilinear structure are evident, especially for age group 81--89; but they are less pronounced than in the previous model fit. The main purpose here is only to illustrate how straightforward it is to work with the Lee-Carter model using \Rfunction{gnm}, but we will take this example a little further by examining the estimated $\beta_a$ parameters from the last fitted model. We can use \Rfunction{getContrasts} to compute quasi standard errors for the logarithms of $\hat\beta_a$ --- the logarithms being the result of having used \Rcode{Exp(Age)} in the model specification --- and use these in a plot of the coefficients: \begin{Sinput} AgeContrasts <- getContrasts(LCmodel.maleOver45, 56:100) ## ages 45 to 89 only \end{Sinput} \begin{figure}[!tbph] \begin{center} \includegraphics{fig-LCqvplot.pdf} \end{center} \caption{Canada, males over 45, Lee-Carter model: relative sensitivity of different ages to change in total mortality.} \label{fig:LCqvplot} \end{figure} The plot shows that sensitivity to the general level of mortality is highest at younger ages, as expected. An \emph{unexpected} feature is the clear outlying positions occupied by the estimates for ages 51, 61, 71 and 81: for each of those ages, the estimated $\beta_a$ coefficient is substantially less than it is for the neighbouring age groups (and the error bars indicate clearly that the deviations are larger than could plausibly be due to chance variation). This is a curious finding. An explanation comes from a look back at the raw death-count data. In the years between 1921 and 1940, the death counts for ages 31, 41, 51, 61, 71 and 81 all stand out as being very substantially lower than those of neighbouring ages (Figure \ref{fig:deaths2140}: the ages concerned are highlighted in solid red). The same does \emph{not} hold for later years: after about 1940, the `1' ages fall in with the general pattern. This apparent `age heaping\footnote{Age heaping is common in mortality data: see \url{http://www.mortality.org/Public/Overview.php}}' explains our finding above regarding the $\beta_a$ coefficients: whilst all age groups have benefited from the general trend of reduced mortality, the `1' age groups appear to have benefited least because their starting point (in the 1920s and 1930s) was lower than would have been indicated by the general pattern --- hence $\hat\beta_a$ is smaller for ages $a=31$, $a=41$,\ldots, $a=81$. \begin{figure}[!tbph] \begin{center} \includegraphics{fig-deaths1921-1940.pdf} \end{center} \caption{Canada, males: Deaths 1921 to 1940 by age} \label{fig:deaths2140} \end{figure} \subsection{Exponential and sum-of-exponentials models for decay curves} A class of nonlinear functions which arise in various application contexts --- a notable one being pharmacokinetic studies -- involves one or more \emph{exponential decay} terms. For example, a simple decay model with additive error is \begin{equation} \label{eq:singleExp} y = \alpha + \exp(\beta + \gamma x) + e \end{equation} (with $\gamma<0$), while a more complex (`sum of exponentials') model might involve two decay terms: \begin{equation} \label{eq:twoExp} y = \alpha + \exp(\beta_1 + \gamma_1 x) + \exp(\beta_2+ \gamma_2 x) + e. \end{equation} Estimation and inference with such models are typically not straightforward, partly on account of multiple local maxima in the likelihood \citep[e.g.,][Ch.3]{Sebe89}. We illustrate the difficulties here, with a couple of artificial examples. These examples will make clear the value of making repeated calls to \Rfunction{gnm}, in order to use different, randomly-generated parameterizations and starting values and thus improve the chances of locating both the global maximum and all local maxima of the likelihood. \subsubsection{Example: single exponential decay term} Let us first construct some data from model (\ref{eq:singleExp}). For our illustrative purposes here, we will use \emph{noise-free} data, i.e., we fix the variance of $e$ to be zero; for the other parameters we will use $\alpha=0$, $\beta = 0$, $\gamma = -0.1$. @ <>= x <- 1:100 y <- exp(- x / 10) set.seed(1) saved.fits <- list() for (i in 1:100) saved.fits[[i]] <- gnm(y ~ Exp(1 + x), verbose = FALSE) table(zapsmall(sapply(saved.fits, deviance))) @ %def The \Robject{saved.fits} object thus contains the results of 100 calls to \Rfunction{gnm}, each using a different, randomly-generated starting value for the vector of parameters $(\alpha, \beta, \gamma)$. Out of 100 fits, 52 reproduce the data exactly, to machine accuracy. The remaining 48 fits are all identical to one another, but they are far from globally optimal, with residual sum of squares 3.61: they result from divergence of $\hat\gamma$ to $+\infty$, and correspondingly of $\hat\beta$ to $-\infty$, such that the fitted `curve' is in fact just a constant, with level equal to $\bar{y}=0.09508$. For example, the second of the 100 fits is of this kind: @ <>= saved.fits[[2]] @ %def The use of repeated calls to \Rfunction{gnm}, as here, allows the local and global maxima to be easily distinguished. \subsubsection{Example: sum of two exponentials} We can conduct a similar exercise based on the more complex model (\ref{eq:twoExp}): @ <>= x <- 1:100 y <- exp(- x / 10) + 2 * exp(- x / 50) set.seed(1) saved.fits <- list() for (i in 1:100) { saved.fits[[i]] <- suppressWarnings(gnm(y ~ Exp(1 + x, inst = 1) + Exp(1 + x, inst = 2), verbose = FALSE)) } table(round(unlist(sapply(saved.fits, deviance)), 4)) @ %def In this instance, only 27 of the 100 calls to \Rfunction{gnm} have successfully located a local maximum of the likelihood: in the remaining 73 cases the starting values generated were such that numerical problems resulted, and the fitting algorithm was abandoned (giving a \Robject{NULL} result). Among the 27 `successful' fits, it is evident that there are three distinct solutions (with respective residual sums of squares equal to 0.1589, 41.64, and essentially zero --- the last of these, the exact fit to the data, having been found 20 times out of the above 27). The two non-optimal local maxima here correspond to the best fit with a single exponential (which has residual sum of squares 0.1589) and to the fit with no dependence at all on $x$ (residual sum of squares 41.64), as we can see by comparing with: @ <>= singleExp <- gnm(y ~ Exp(1 + x), start = c(NA, NA, -0.1), verbose = FALSE) singleExp meanOnly <- gnm(y ~ 1, verbose = FALSE) meanOnly plot(x, y, main = "Two sub-optimal fits to a sum-of-exponentials curve") lines(x, fitted(singleExp)) lines(x, fitted(meanOnly), lty = "dashed") @ %def \begin{figure}[!tbph] \centering \includegraphics{gnmOverview-doubleExp2.pdf} \caption{Two sub-optimal fits to a sum-of-exponentials curve} \label{fig:doubleExp} \end{figure} In this example, it is clear that even a small amount of noise in the data would make it practically impossible to distinguish between competing models containing one and two exponential-decay terms. In summary: the default \Rfunction{gnm} setting of randomly-chosen starting values is useful for identifying multiple local maxima in the likelihood; and reasonably good starting values are needed if the global maximum is to be found. In the present example, knowing that $\gamma_1$ and $\gamma_2$ should both be small and negative, we might perhaps have tried @ <>= gnm(y ~ instances(Exp(1 + x), 2), start = c(NA, NA, -0.1, NA, -0.1), verbose = FALSE) @ %def which reliably yields the (globally optimal) perfect fit to the data. \newpage \appendix \section{User-level functions} We list here, for easy reference, all of the user-level functions in the \Rpackage{gnm} package. For full documentation see the package help pages. \begin{table}[!h] \begin{tabular*}{\textwidth}{@{}p{0.2in}p{1.3in}p{4.5in}@{}} \toprule \multicolumn{3}{l}{\textbf{Model Fitting}} \\ \midrule & \Rfunction{gnm} & fit generalized nonlinear models \\ \midrule \multicolumn{3}{l}{\textbf{Model Specification}} \\ \midrule & \Rfunction{Diag} & create factor differentiating diagonal elements \\ & \Rfunction{Symm} & create symmetric interaction of factors \\ & \Rfunction{Topo} & create `topological' interaction factors \\ & \Rfunction{Const} & specify a constant in a \Rclass{nonlin} function predictor \\ & \Rfunction{Dref} & specify a diagonal reference term in a \Rfunction{gnm} model formula \\ & \Rfunction{Mult} & specify a product of predictors in a \Rfunction{gnm} formula \\ & \Rfunction{MultHomog} & specify a multiplicative interaction with homogeneous effects in a \Rfunction{gnm} formula \\ & \Rfunction{Exp} & specify the exponential of a predictor in a \Rfunction{gnm} formula \\ % & \Rfunction{Log} & specify the natural logarithm of a predictor in a % \Rfunction{gnm} formula \\ % & \Rfunction{Logit} & specify the logit of a predictor in a % \Rfunction{gnm} formula \\ & \Rfunction{Inv} & specify the reciprocal of a predictor in a \Rfunction{gnm} formula \\ % & \Rfunction{Raise} & specify a predictor raised to a constant % power in a \Rfunction{gnm} formula \\ & \Rfunction{wedderburn} & specify the Wedderburn quasi-likelihood family \\ \midrule \multicolumn{3}{l}{\textbf{Methods and Accessor Functions}} \\ \midrule & \Rmethod{confint.gnm} & compute confidence intervals of \Rclass{gnm} parameters based on the profiled deviance \\ & \Rmethod{confint.profile.gnm} & compute confidence intervals of parameters from a \Rclass{profile.gnm} object \\ & \Rmethod{predict.gnm} & predict from a \Rclass{gnm} model \\ & \Rmethod{profile.gnm} & profile deviance for parameters in a \Rclass{gnm} model \\ & \Rmethod{plot.profile.gnm} & plot profile traces from a \Rclass{profile.gnm} object \\ & \Rmethod{summary.gnm} & summarize \Rclass{gnm} fits \\ & \Rfunction{residSVD} & multiplicative approximation of model residuals \\ & \Rfunction{exitInfo} & print numerical details of last iteration when \Rfunction{gnm} has not converged \\ & \Rfunction{ofInterest} & extract the \Robject{ofInterest} component of a \Rclass{gnm} object \\ & \Rfunction{ofInterest<-} & replace the \Robject{ofInterest} component of a \Rclass{gnm} object \\ & \Rfunction{parameters} & get model parameters from a \Rclass{gnm} object, including parameters that were constrained \\ & \Rfunction{pickCoef} & get indices of model parameters \\ & \Rfunction{getContrasts} & estimate contrasts and their standard errors for parameters in a \Rclass{gnm} model \\ & \Rfunction{checkEstimable} & check whether one or more parameter combinations in a \Rclass{gnm} model is identified \\ & \Rfunction{se} & get standard errors of linear parameter combinations in \Rclass{gnm} models \\ & \Rfunction{Dref} & estimate weights and corresponding standard errors for a diagonal reference term in a \Rclass{gnm} model \\ & \Rfunction{termPredictors} & (\emph{generic}) extract term contributions to predictor \\ \midrule \multicolumn{3}{l}{\textbf{Auxiliary Functions}} \\ \midrule & \Rfunction{asGnm} & coerce an object of class \Rclass{lm} or \Rclass{glm} to class \Rclass{gnm} \\ & \Rfunction{expandCategorical} & expand a data frame by re-expressing categorical data as counts \\ & \Rfunction{getModelFrame} & get the model frame in use by \Rfunction{gnm} \\ & \Rfunction{MPinv} & Moore-Penrose pseudoinverse of a real-valued matrix \\ & \Rfunction{qrSolve} & Minimum-length solution of a linear system\\ \end{tabular*} \end{table} \newpage \bibliography{gnm} \bibliographystyle{jss} \end{document} gnm/inst/doc/gnmOverview.pdf0000644000176200001440000201110213615621570015563 0ustar liggesusers%PDF-1.5 % 222 0 obj << /Length 1662 /Filter /FlateDecode >> stream x[Ys6~У QG^:&ͤr䁡 c*Iu}$HYIg]|_~pd,?q8VG7j AmoR:Gs5A$ ͩŸ\z hU@Hd0*UegF;q-/1*ИMT9X|}s_MtHbu:~Cio ; eS4 ?́hA>@-`svf߈fm#4Ax#s4$m4" 8d lf |ۂz;9"aHl##7agfĿ->I73otSy OxgH1't)̻8@Nn(`˘ef-A"&n'bz\XG^%$~(L;MVrFi)xGufT/4"S3FO|ߔ"VEƴedYPEnDS 9"LJ >pˌrfLoykm`K&cjT#ixN1TPDk\39Gϭ2~١GJIVޛ R]3|FbT:%i$!TKmHr[wzyp0xd8?{hi8#O&҂dEF-˼ qWuo*:SU9-`IC0,Cj,l1a}^Έmtq\VqZ84M{WlUW-8-YJφfzķ{!C MGX@=61mp􏣡 3Sˆxu2CۤǏ<8߹#(^^#2^>>K[ɒ}n9wSmL仓@tp{ۊ-ʷ|[˚}wNlK?> c!P$MPHcdXw=.Z3 endstream endobj 2 0 obj << /Type /ObjStm /N 100 /First 806 /Length 1635 /Filter /FlateDecode >> stream xڭXoH~_1E&_ qJ! 8ba{#z}lB 4I67JɐJ)#mQnH($4>DNbhI)IARDJ!$3`‘R<$e,Ms*'s%@0Ҳy)<%R|`@2MYn1O91r4$Y!2G.<"'G)ˈ@2P'!RX | * ,X܁ $aOʥ BL+ՊH0ms~3o22c)<V @d9} D&D r!,QH^8YIL"fƹr)#;2e-Gn"CRrȑH5(a7Q所R)u:*"@U1 c(h9zEdf b€FɜiA*!`TT\(P6j- +&aaPinOi~AC)z,9:k.,wO\,7_wE]TW/:jo4ןv[[:_4j?:;*]6̈́ڨ|0RǕ=}>ESշf:A$B?Ymh#U)eEW%5OU5->w"z;4fbyˉǪ퇢-u?ڑ!^X}UETPn8Fר: j}C*-a _B/rF+'c+_V[u_z'3N-yWŨHcc#~芪PlUSQs?|~l:EDnDőD*+/D 7TO5[Fn0"AVVN&0mÙ:z_+6~-÷2릥)APv8'WGF=COCouO~ĂEC?FrMV5[oN^چ1=Ţ;qX aq^w1"gha8L%o0ܮ"W{ kCS\+lg?+'hS7L D_~|^nG?N1{9c>F>]r}fX{!P"÷p7Ϟok{% 毪>M8w=s'W&3~uEN)_zo3 !# @_:}odemKQ(UE<\sm"JRGị̢QF<DOl{ <$q'Td"txcgKKrKcf"2F),G@&C5syT'|mq33H:no{Ef|=m-P+^3{/~4=+ -j7ܺqK1jڕgE;;j-ҙŖ2)Ӯw(RZ\яJ$v~m6Sy6yͣ \៑2Ϳme3#ͳMA endstream endobj 252 0 obj << /Length 3521 /Filter /FlateDecode >> stream x[ݓطVò R@c s{ܱ-P/;,Oo?e^knRt.2YUvI>*]t+&J/XZ L^,Os8 LZmSZXuͶ,}UwYb4yY25d+0-֝L >:K7Frj1x9;H×;m`7B3Y#I\Imd f֜ x6YY7uQyζyϪ-F$jLо$_wMޕK kfd@Dy٫/g1&֚EžkʾD 9EY?\H_ nVzGDYnTK !(Nkpjrr&>CB,CmzAfGZdn.(¯fҌLAMĠ*nBq0k܄~=% Q`Eg/ W= &WjVK7jl{H@~T[ z|ꁔ3HC wuNLWo"IY oSRe8l޶M*0 "gIg1זXy$(޵PIΘx[U,=I\IH1ֺA5g {ppjɻ9&Hz"4RGQ'j mvݨHB%tt~<`@|{PJ k!`ycUJ&7m1h!B)f咁b@|\zl\s-Ye4 ;n.M bR=;/)=ɶAwGᤒ%>fіq$зE*NI#KsM=<uDբzVDLLa ˨h,N1]z&9BI^zˀМL -fkNVaL獑vMi5n. &PsZԿ .Ƴf2T T:*GJ ؗ*" +A7UB'P(pIFR~2 m;bUr_:7)\Ͽ7y0ABk`AЈo? Os׻JKdKU0ef}+N6(nʞR`44܁MmߺbBPq $Ԑ8d^f`;c ')<5 E6p`!NcxE4a"Ò@٘1f<> I7] endstream endobj 264 0 obj << /Length 2087 /Filter /FlateDecode >> stream xYݏbq/5#"%WP$}mM2f#(}D[޽@^,~ Ù g?>ۊը=<ޕqZޕ㻇?z& g䙖c'ܐXaԣ#BnŽkr+H;[w_pP[iGoLHkT]hVpk҃ՈW8,_Z>b 8C M].(̋5ƨfѾȁ LQGYXGLpmP(f ZӊfwУt?,'yN%<(Q~|'WeOnvی^@o,l6'%C%:5kL*w-0yu3Vkhթ]wk?d1K81f 1ФQRXX3ѿ^ +0Ĕ,MԜ$p(Q2M*x&i ɫi;k+=ˇ͏+֩<2us9ol˛R"z_qSpӀ5/CqfZ1t< ⨆Qx4o;ya<۽[NgcjKbeb]w0y/,uԼcs9QI_5 B$?fgV}aW8FO#!9TfBI:yNEmzԘ- B_8~t:{[c_0ǕO};k0O` ح5.p/x}w,#oh1U@^ɘx&mưO`Q’گ`'R/ixbbH5A\$bz20d~9&8G,9pːߊ_X%U&yiF _*@U#lor IQ655(!{E,JLY`G U92P^D%F 2E[_ʚN+ׂG M'#\ѫH-,VXF <}YdZe.| t@_ZMf&U:`ZHʟ+ TW%: ́`jȗmLkV ^ŜpTM:=ū\Vު Z784|&gӎƽ M 78ܿ ;T^F] z t4 Ro(Z#AvƬel˗ TGN/t/R0G! 0/g.qv9ʮ96'D?tS24ͫ 7V 0%.$!mgI9E.wLӕBͥo3od'Gy/Y/FlB!NQӡ%g&|ҩ9xeΝPv@j yz;k endstream endobj 280 0 obj << /Length 1368 /Filter /FlateDecode >> stream xɎ6>_atz]AdzH]@2ZDdb/Mʒg&qǷ/$]pAr(A`x0[ > M|˘lG$&p/:`DBZi'O)δx%>.BI3FiU/ YcLJ?!Gv65^"3B ,?/5FYk&\qh lhQNAr)s1:; ߁\УY'/m+t9">\nkްFa [p/UZfy^]tph'j/u* Cޑ ;a%:|$D٩jrjKQvy.֝B?4mz7G7r˚Ю=",@v>d W4[߾@= ]to9wsgD[[VV}9i,Yaܰ/9[8zj.q gO(|ۮ7q jГ@C9n|"㣺E EUc./_.Y2}^i7)gk+ # >'ᝠ 4nQ c 9#$oG21KE^E*]ʓF'_S uIfu-RXv&OMzlV뺊댦kGBm9L6j-/qQ_FS5.\H S<[r8(&v]2.dC%Oϼ Vj=w(o[O/ vؑ|k9۪b~=ՑdKc_ > λ9sD'Q7w0>0w"0ZWQ~}Ewz1ԥhQwAD_M p/򩠸+"AjJW|R3QLP(:*JbQO.^,9'1.TBǷ->BzH0ӇQ]ÚsPx4CinAREQćع]\_ endstream endobj 286 0 obj << /Length 2210 /Filter /FlateDecode >> stream xڽXY ~_Q.W2薝I6.af]jg\vtCv hHrosqg,9+bwsؽO$TpΓ;o#LGp5HZ|=窾'fJR!@a1!w>U'?3.{nȝVȓj{A?NCt }2Yc a6CՌH|K٧4IUmIbぅk!r;! P4FLg6Us ĻTf"H"eH* _Wwm{s{us5dݞ"~0YWG,N!>03)=.Ǧ:t93.|RrhL&b9U?m 0\Ie=r&JIؐ]1lz[4mCF; R\  Ma 06O^62lU^t$HY@XX[θGy$=Qɕm_m9f1^H 8*kj8_jfRgҪr;5(nh b(hPޭWo,ma,o҆Ƕ`n(x?)_1]{OWxT=va"n@{tbaS}q_[ 7|{ږbRDDN ).Ń CA^qf_c_NyW=8.j@UZ A^(%h_Ǻ.N4kP2Q朗>9Oh[i@ z14i"B_WW'xM>8a4Ƕ2ilzҲ욿 ;کʡLV48?>`y:<0K缳`{R`QU:+Ó?_~ymb& ǂpϹFHl.1|]Ke%3ʖ;da , /O.BpCL !3\7"|g 3eZ%3"Oyp]p *,ܱ+>&vis٩0 3ŗpeAOy:Ӌ/!pPP:W* ԸITU] 88> stream xڵZߏܶ~bߢCnR(AIHk_qk[Zi/;!%JNjyDQp7otcۥ*VZ2c)rv'REu[6ӱ:'@\J8xyc$=N ,s}.E`:z՝+kjhqTe}@}|ils=_] lAUtc]]?<%rD,R܋Y: HK|<Ԍ!kp"k$*c@(dla]0je#XG+0ُ%ѹ+h:ëCMVEOMc՟qR`>%Phv>7Lr=6K* ?ڪxi+/ xX_'i5O#`AaPZF扌EWw5Ka%dX[|5nO ꫶+ksus`jΊPh;U5.DGN]K3+800LD=Om6~lE;2o߰>n:0Ƣo.Am7!&륿y6b@CʴnfZ@L?Ɍװǀ=3O6/ywvav;!km!Kɳ$Ns7И t->sDb5p+tmՎ֩Wl *UNta[%* /}WA2nkkv%X,NY^ȿ/} DIxΑx͢|2lKW@7 BBщ+Ӹ?!p~1ȳ83&u=trvIX| 4 {Wn”r72pXܧ8&gbR4N\|K\-#c%xEme75G5W-<е.^ֿ|2(J&l[BH 8!goH!n#HHЗ%Ap΄AZc!qy0䣎 0#yuL":gbct[>#(YZ 6p9)ts~Ndn =8 ڑ󇫗P{r-=xU(gf0*ܺ^fHd_pp%֔z{GFal(m% Αav @P`ƕnove:+ =Nb.8/L_]삓8τ& .\EW'ɥ,pNn\7^CՓ l\D lxXZ,.]{( uD+O G#]7Ŕ,CS9s"+kT~tUM -V31#Y|ǩu YPCY XJ୯*BT{WTa# M,Ρ<%+󑵗tSbs. X`,<2|luy)[ Q[ٜky:nwa9<2Sos׏Q>U|2e+6͉X7KJ:׹u:pelg*N"ծָzKz5u~PXL, ,2D: r*4R{y͸M60 <4ύa<&x9?u48ߌ?y@\hd6TťZ sgb$_-:zۺ0ԗJ>?9#&s|@BtD,yP|]͖! =0)Ch$v.IyfuF{ $P@xtPNMuDSjb.*MlOu5xZW).(g`iF4xWFpcd*21s*,cA'Va 0^/9 | yQ̒Î^l#![Țy'(OD Dr3Z2 o0WHRBS^hJ7S[S2u81q[Bδ>#p8! u%ݾvx3c滮98b4{'`cTS??c?D<1^+. 1H>\М 5`b,2C``*D&+ #aX Q]0< TٚwPR#ݥvt7.jϭWyl늲 װo B/e8QE##g1scm f0UNjk. σFkS7-m04dD2[iJ6fΟ!er!EAyJ/cCOa|ǂMC/Ss4C<yU~NOn?u9s=1̉4v(zl;m=KX ILXDX:}ڞ cvo>3 &w!]U*G CML:"MM| >H7t7Vz7ϑ 4 o\-.(n ԲD-Dzov5'+#@6 17TafcagC endstream endobj 312 0 obj << /Length 3290 /Filter /FlateDecode >> stream xKs_< 0h&Lf/!Ɂh$:$_@'HbB-#R|q{PB,fj]/~X ¯X.آXP6a)_\ʛYm~J+J$Fp," qm]F U_7;o)S?-W?mU\-fjYzWm!%|na?cXefuvIvHD \r<Ė-K7(Mv($T;2c+)Te[|m3p +wKHcot#۲Uaa3w}?ˍ}~v3G8X!jzj   .u`5ˇ>vu$LP~LRf( 1e̠\NV$BO: {~ٻ0۝-3uXmPFy'Zڨs필#!>pxJӦz( UF~5M\kVuͺzvU[flHFNab ɂ l 09?" >":zD@R8;dج1< ,gfX jgh3QvBKJ,>i)U^ >༳< %#6Epڔe$xa% <41,X,<9UŎ`âKJeϊΪAMrbp<8Ug&BdP^[=AĂ*K ˻Mٕh3`xX&g;aȻVWb[I^+krTiD<"Xpe7N2P"* rF~|5.PQ޿ NZ.AB@Ϡ߄ ߅'p#+g|Q׍kzX^sT oo>@M΢q_j[U@ӄ-A0Vgs1|} diЗ7~AĹɢ$4J}:?jT4-J8cQPy]ʃ9}VD҉kBG!%χ Xctt4a_@bVUևD;g~Mҙ:`zj?|Rre$ar&Pޮ *PQqI1T p.k]tԧ| ?uWu~]Pu=Kf@X|6 ^r-\'"L%ptZ0(!֐Q4s¦a*5l%q ,ezθcCt1uyw,zwd`aXA<ߌiѻ;dp0=`m 땈<)9}lԹI MU>T3&KȩAh}zZʞD"D.1`؋Ca1ИSs1 ʦ|.M2>-GB_Kd؊q*N %'#dCWi}Y&l?\_&%5sõӯiuRn 3n 8e~| Pg+.- dϋ?@= O 6 8ĖR4fv YyEL̵SN:muSƮH@`-:0ze3~tMxZm~a]m+Vϡag*/Ԏq.\T9J|AE׭EfW.l6kiBR8[/Lμz](:[yl:aPR4M*oLbA$,;Ƿ9*,x@ *; ~D ;$/@45:qI[f[rz3ܣ~m1p8ysnʕ\>`C)ȌQrs 5=Sp}-5vCGr2qG6}0]2\#0pڭC@:`/9a M7c'r?iim}1\8eR\t9YpZ {|m"k m;hwui މ%t̔9蕐 e"q̄TD2ķlMJX"׊sтBk^@YWBx`2.V-8L]*˞6E! ³)g9蔄͞0tD1deBv={oE[ۇG,4?,Gc ,d/; @,|a]dxąZş򼒧)co3=B^WfaT*'G*- ]4i 糷-V nwŐɶ`إ5>RLKO]:pt:`|p3$Eq7)"a.4+-UKو}[ƛF̽)?C4{-XV뺭3\L5pz {A2h&h1aYx1CPr T?yfᒴxAm ԵbRo#k??\'1]xCpz@&6B v^ ܖEJm~Z?Lm>qOJ98-$aQH2־{Y5(;uنjfhR 08HQ(-g+ endstream endobj 233 0 obj << /Type /ObjStm /N 100 /First 899 /Length 2574 /Filter /FlateDecode >> stream x[n7} *V $lk6h I8edL[Q !٧u;EZ)P@\qMq-AડՂzVCeõV)䄱7([1'W3`š}TCÍ?Ŝ9/l)d_J]dV13aҖ7\q#057|mweGW-قꟍSatf R /e0YS3CJֶȒB+AL(9¡T!JS|FdY v5Z~)A4_))9ER%`&!0Q)aZUd8FkRv-IfQ}mrWkK6 fP :Jčծ1ZҊI͡OX94J抟q5a:o%r}B'?;1}M|A`P%UL]1#`Dx-4D8 nT*>e|[_0.CV'O7 ˧ggӳ?'?bj2]EJ,5DE(-IX˟oa< =]E  Kl.\!Npd!zQ40R'@DQBaX6`Er%A kHGRRn)[ VGN([hT+-a1?|4/otV첣} zTtp 5ޭ]usN70/7/|j| ؚW"^/֟?.:~Yq%)N`[Mfӽ/^!9\u\m\n>~cq<cqBǕu'c>fw!Έ+|0wdynj*nj;‘Q9hv\ĐFl0-4 $Cm<f;1רD<=ܺeEڇ! +M8"W= e~h%$%F7; e8_@0G--aOA\C+ܫ·{؆tiP } k/!Kc(|iċ Qb'ϞGR  o)OVg'_`d$j9wQ%9̐biĦm/=-yVɽ幋xMMLq{{aK'w1@8;Uuurbsv -$x;PjPp.r%[ӕrOlS 2}[I}7xNNMnW bx$>z wEc*_?d2X VF֦0v^2NN0LҰl5n{y* %LAVRRE0dvPUT\[ G.e, 内Q"H?O3a | Kttz9kƝmRjE/uׁqn}YM_3g6****yB+-&'dȗOYL|v*pRU 01aFNJ_(qУ,"i 5~<h4Wv=mUwޮEr-UZFAF2fr%jFiBFhO( m )@QA}OUF{>6g齀2=g[} /LK`buc-lӧ}L6ړlS[.NF{hQOj#h#h9ww6_$7YwԻPeC +M߁}Wj c>釆M|n~`,~ "a{Lf!^Eqj{<e<0niE(+W~z}׭VsUk[7OQU<"я_0!%iC0<C~4;6?]iHrQw]J޾A[w' {ΖlQX7tWO?|G[&ڸY)yX?> ;ّGq^?굃?d켸 endstream endobj 323 0 obj << /Length 3386 /Filter /FlateDecode >> stream xڵZKsW|ɨɇS>؛8);ImS6CI,sHYY9䷧ +1F_7_P+!Xi2JugL\SL__PxXQW&4W}Ln*Y gԽ(XVN>v^Jz7pEj܌GvݺU@v~MU?0?47/wגN[737Tm:50CIx$36?f?4XQ#DQfŃM?CS4-鑐U 2]&rVjj>Uӵ Edn\Vƭag(?#h0Ukcv ⦵<S|SS: ˻3&M;șn'G+4S`N?pѬR^eUa-)1]jq xIf6Ed녪PI%7d 3E*E`p =n!Wx-='6J\`!imNN/g}4IsfXiPYI5<9.GksfЪ߬ z8>}"mJIXZn>Z^l^Ag|-KZޙ˘'\2IO7*24(*ʕ=#XLjaQ<$=[R9(.((Z&(ʂ2N5ƉVQ3CA1*gMqN, e?]b=M&=T>⪍g4)8U`O4t$ԇki3CcS8ub6 z, &t i8Xenp{u;oW ~SBT2`0/=+z]#߸in[C&~_i秷K^E ;18O@pda^ 4d'L]kQ\ O7s^;d$x&ggGǡ\RQv^"s:?oQaMQ@PtH` R 3:6Lhk:ja7gD\ s,`9@jo/9mEi6ç+^MN׏s(ƟOJKy wg2V9: (N ^!so>64J>[@n Rv[g886HW>@{vA%cE.ך<2#98T4saLںMγĘ8HȰ^s Tq+g[/X(Ph//cutIxP-Exq5^+! U[:ZmF#Oý`FSȵ)hLb>+4>Wc[v{95n%3˟%q@X6".?m. ߯-\b-r,S5e[~8$E.f ЌT,B[OB'۵06g`^r}4Uy \0aVi8YLNuN)Nz+Tf̮t=38<ь0աfQݑ[L܌4r$Cv(Hj })fI jϯ]2LEx 2F UÅs a]I‹k|y_kīB>ҧ !&CظѬB(K&qVb&U6!U(nޟ P;dHWb٣^'$$FF}Ia$g&շPS½uSLRu'6:-)R^+"=˾+9t!0nNWV(/$֛,ckoŧf#ct%Wm `sK٭64jIp_ju](^Z ߀}cL irxApĉ]^y1IMߊp 6 *f[+)b1C<dDVňq,2b|6bC2{<=諂"f$͗ }!)PEԟatȷ/lɴS)sjs@/D#6% (DF)̉[N݇+m".Dpw#<sMROk=YǭB+m4c0UnE,. A+4vzN0FP-nÈw_ڃ{ZQP/@ޯ!Ef.*UP?"ɢEaF=X ͅ{Xj%=wK:w+- _PE{O~:CSǦ@qdzMآi>e:.7kE~I)ZK:xKmZ킭{zEDhhw-&>^Ls-J$՟rv'Q@iT#Mw0i~h0 Q^PWKvjҿTTٴvjK\p'uxUY>q:M' ;m_w[+ CȲEdj+V+W~F*Q euV#r)HX4e1͡v|5_oXq7{x|.|yla^yźx(QB-9!߿%@6La> stream xYKo6W>u#n_z c :-ibYDlX!FS|T_nPIIʌg}f$+EgЌ%U~#HJv(۝`t;M=P~lCݵ?d H=.P--K7H{]ו>-B%3Q3`c]11xN4&yQq:Aت~?vao Dv\ZL[t4W^ye$ KD4a*e?^@ J(I"ySIY!2h6ɻ_3ܛEK3l*N0VNJ&J³9NSj~OǺr4Y,~D ! ?)XHŗ6QG('*^5(qJ(Mm܎ g- pw<+6{ d} K8ϐ4x!I͇‰YLNh*C%E|Rqh8:j ;o{?ݔ^I_pUso<zRn%|p> ּv,D45g+1O0:,?}}ioB!4#\,jD/)I]19VwlԸ%>]ʎ|Ű,;;h!|^-8 ⁓*pZΠgɈ+%di>^цs4,z5=ǯVR[:ArsS]i}Vv?6nޠadi@wYy c* -snR,͖19\ LH:61 suةF(}r%cnBЯZ5nӓExaV_h=MmLY-06 EdY* 33KW ZmI.盘}4nkgeN`Mrߨ%1C䵋+؄`:=S )~`cwb };V\<f%H\ 7PY)?" I||%k dzWXx! B7 |{/H2?LNj7h9փod'NWa9<{}=ރ'2ųy |w>脛Ynw,Kp_ endstream endobj 333 0 obj << /Length 3621 /Filter /FlateDecode >> stream xڝZKܶWtM"geRh]9X>`f39HޤӍnJ9x|sߔU%\^e+ȥHr~ͻK3~ߝ]_piwcݵ,BRo#["{_DTJRTYF8,I̸;i$n;v/iLo5l?%%Frލ]$ToiksxםN]g$'m{nc;mZslm30a8RƌyjIl"zuMc΃]lTܻ87;.33eoϼ;")13 Nn=(}6Sz-BS<r3--8Q<˖gl`Ff^N[z>dcnGj`lwiA)g pTwDPdƯ ژFdQ@v2ҥXէ[C+u旙 ,Z@TMk]9vx~y@4Dv2Ru mX0~Eȋp(e8L_ϢS?t=K8h"KENi>$r GzOMȭ#SQr{7UWKlɴHŸSYs1 mkI#dۙ 1yFbw#S4=I[n[1(c!GG;3kXm&.TjqqP%u<ޞmh7SρYyJo7 $;1EVl(U 8Qk-&p|'jXy|ُU:#ڈœre^sVO=k;3᭮.9z"FN /;Dx8-~˸S KNAlF %$s`sNCJq%!2ᕶ KPrjwv yP0gw n HbӬ6"\Tڦ>խVq@E^x?U7l;U%.eO9/0im,=P=:\JQYŜB4 2KX0pf>%u(D$%/ WV%tܚJlڥ-W9Uil톨%N|쐢4 <['4bt\oq-V{jV~GT/,R/Xg 2-agXřJK v-K3zgMVebç v;݄s_.@Gw2TR.7E{ N،4?q?mȡQkqަQ.AOT2n<+_|VD)EZ#Č=smW)=z赲#gd&ύe1`=" zJ,|kmKcc~QTspVT ʫ/"xU X ]w3$RB^RntՌ_v-W+bTj6{G3̝]ߺ!-,Tb -8gbx[ob`nѾ]Z. QR(.:V\X$O,7蛚5R"=XjXEyY vd?ט1 KK*+$ܒ3k*!ME|vG;C{kOR剉d]Q\y?vk*HdrVjOS+R7tJH:lVVu |wǧqAUjZkm1||dJx"O1I9;nWEЈy 4f1! /f$pz b.a̜qZ =7n?\K5hm$ hQAlTF\ԯ I endstream endobj 341 0 obj << /Length 3443 /Filter /FlateDecode >> stream xڽ˒IS^1$NJW(ёH"=F7@쮝\$~??|[7&1Z蛻MmM$柫Z|u9fشV })y~]-$JnWf~<ܮRCsK.n<M.-7[6WvzZ4@sOcu顣gazg/ڨ$:4Oy:wK9>k95m5;jǣ_ĥkA% .xϡ_™/>5pe O?8zFx#EܳRY {u<2H& jA"C 7ahYmGpjm} K9X zAE̷*]!E|]80e:ějПxz }8o?,jz8-ݎ1|eS.Wmͻt2[TF,xz̒\@QrW8 pͮ$®Yt/}%q}ϓ̟7"MׂSod'064E>:GkPKq,tK?b/,/4j_CL^DU$^uQfN+ƒF/ˎ4KG4 {ۻ GـL4,^,՝b՟n[Fwsc 4 ^$D n߹E`^bn(2XWq>2e&HT%">"=af/ ʢ5P~_6fT篛2 0ny8. 4)2Upa9ϱ " K "!G7=|+Ct7B-A=? %/m"~Ly1GAŪ :E=3<\QHTBahM1WYȲق 8BTȲTPI=; !C_EJLB̙,[dl;M,~biMwo:Vɤ+ϛ.)xnh,٧P` pg[^ Brv]ͫ)Ͷ!@ΊD4w?]iE0 ϟ w a(O`1Dh!c<ztCiޫyORT~v|_]@|46=ц-=MTn<3܄",9H4OtHs$nE3!9NJV3\ wlKH' 8@x ,G 0[.SV-b 5BAJTvO{ ^1C R&g-cW.s,O`r?>7ÝAe`Zua^ ke015d4t=C@/^ԩ޶/iNuJ8Uw"c`3BwfCWLs&s,hB`L͜|zjKSQ$Hu B}EҲY$s"Z-Z ,:'D ̲!ưA-RHՋTsіgrZA}<{f{+c7n)rVǡvιF'R{9i@v\2}`3Yp]>У5:oRbʧC ;WJ,cj4\xI%XS.<4ɧթ9>efQ%*oA )Uee!S+F2]iSK#FR8! ҂K73"=8vO#@M,Q:`ր9{{i܊;IňYbO2%X$} |K(zg[2⢤ TЖüa!P/6axlEzRpŻ+.nZp -{C^onƊnlaګ#鹖$‡}[3S.i).bcS_iwU{_O q@҈u\d~5Yfs6Q83Erl= \a>Q9mcF{OZUMmy=/92xjs߲y$t1S0ҧ2*z`][_$O}`?WkCk_BZ}qwB )8\GzܪXD7O.\[nvG.2hmT8U|4 endstream endobj 353 0 obj << /Length 1796 /Filter /FlateDecode >> stream xڥXIo6W 4rTHb4=h$ΌP--C{Q!>{ܽ:%~#$ D ,.TMJ =G,p5X?sc?oCk+w 13IdQw}Zgrݚ֪OA-)ԪF!}b>PԅGW62(a >.ldLȻm 4 OiVW >Lþ46?*+틦 nH5)4?[f ǴGÙΤ=MSu !QA"ek6 tߴnۦԪUnצnhr̂*Ye $r|Y>eiT Y-K&2euaz*Gi9Ν6 e>JPH2t:^it8 *] xGi-WP"4Nٰgce ! x@4['> !H6{_䪳.`LG0})hj$" ]&i<&bcϩ\#Abۆca> "ħ!}JBIgA&F(JDB^&iҩ.SPq#4e;vٍ4˚6R\17ĽcW[Djڠ`1 2|dJG(/]#pBbY㲨U{LHh"ե`4 U0:=5kl]l;-&tĵit#V;'?(Ђn!Gv/ ҌI4‘kbBc3ff-0g(gczx㡞d {Yt|R08Fo?b"W+M(+"hշu uc`,&p=y48DeNWAª)дE, 7ɮc* flG ˛n$srثя¹vjG5ݴPǾwm_ɍySFhk;3̔IsE mv ˴*[M#D_҈!}zuGRFy{lVnէ*xn^pd\fuX/_N`=sK.OBC{t]S_=e&Ot!dp2OsUY0_ [ݛ=<SЍM[&1Z~Vpy@t{׌5WF_D}} 'H2_F8̆K԰EqԴ >a`Bˑ_VnenՎ ER.ғ5\!m/E]QuQxqDH!OR8,Ylp1ɔ^&kQ* *`(>90`Q1Y2S噌.Q!Lx&DO2Da͠*!ص ?R:qMPbo:q!ǁ!^ubȷ zRd B«X,JC@ҫ$G^!^e4+oGPe<,pC|;&K>(|b:)\2R9LYJ‡  1bpݫ  endstream endobj 357 0 obj << /Length 1361 /Filter /FlateDecode >> stream xڵXM6Wh#~h4٠-MAkӶYnԇ7bOQ{3oCI?_>{f6 r3*Qϴ)]g?r_ndemb)QPgEZgeAπ/@SK(asA\6c%@b<XL 쀙(`98X :(Y(ul 3=e? D`HE'8 e=F hnt]b]yZ# VqUC0Ӫy竲8UJ|&/J[>]Dٔ==!ũ}`l?dCq4_1#Qn[ՑĹ8DĄNR@rvZZGDPFi* U,V43";_bHN_Uz!dZ~/ި-_5nMqӨЄ!XOPbBӯ} ;ԡ$FIN26H~Cmw&$CA H-AjZ8GfjA0QJ[phI aڙt g`- g3@-=c`:hпL#dl:}^+{$F S !D{H#E(7L6vSbLt@*߳#d׏9z*B9ڋ[ТUr*€dDc:in$vt9ڎ15:ZttL[.)ۋɌX@㽘 ŜNg3 W2th_R6sO`Gȵ9'F SȞJ? Wا1ğDGg߽OIO@ -}@~<|?^n9 endstream endobj 369 0 obj << /Length 2843 /Filter /FlateDecode >> stream xڝrܸ_ڧQ%۹XTl?pH <&<>OQ)@{ܾF)u8IëU:a]E~(V򫏻OnŶӴvIKә?L.m蘖y~1< Ϸrsmmy5wg6ǣͬ:^8@j U5L k}es@` ;7`|iWi'?cH}R^$w? V_Nq0`@hA$ibjp. \[pC`v<=9y+/q\T[^(f[Z i{rݹ< q'&rU!8נr R5ӽY"ߊu Y!tz{%H9Q~ ')/W×ᯃl@>;[Hډ' ^#r(A}R1iC|t).ǾEN m_$jcxFMѮ}܎b Z'=N̂R sNv >v D6av D+cl*!MЉY3:m!CaGo -/tU܊:E c?z VIH[YZ=$7A{+=^pJ = h#kCr#v!X$k 9*Ut)B쒃AT^JERԝ1PS>X򝞗xPdD 1 Q >WgE] X~b/P)b=-e {#| ` H`A ڑ6yA;& a43rpC0fo껔@'`/O (ņRѼ:PzAˮ?ό?}fXXղз=(=xӹܑ7$:)d`f$iL8d:&-oz'-i*ڌ9LɡvCG1Qk*u髬j;۝7@69$4l'~*\FKA |߷CL.F6NI^ dԪAȡ`(w9۶%a{xsHxR7[ ׉t` Ҷk$9eR9{DPf&^.H=rsP͏ـىMhO92#x*iQPVlō<^!moH\@z*ȟG禰%^hK:{` 36\beT\S}`ԁ\ʏrNM:B|Ҕ?.8lQxZHN.VIutQGFЛ]]nK ux㥵 s}P_m!RHN0aEq(*/}gK؟+2SzX2N'h9mTt+4my֏w)Y)[1K~ܩ*|q2EtIbCWp@VzbRp*9:H2sa78WyxK>Ϫ@8PeIyk~Û? #% {3K&vγ} ]^񨟗[?X!AŤY9KY]ɛ\g]?HګV]}3cǬ;mz_N # VxCO24gYB`9?FfF'mU I0bFA[^o,!xЮv8YL+8+8ƢDo(MЄR~E=Op ?fTΖ7~ȃβۧZ5xq@H3yJm!(J,0+*!w\"  `' x] `A"K_U*i U2/T q:H!Pl#OE̋͜4p@ Dp $8hT?~R^s|O>5YD wi0> stream xڵVێ6}Wy@h1ЇlVR["Y* v€IFs3 MJ'R2̴H ][u0_?H4|?N~m^32*C…D) 8*˦K{}{>x|6UZ> stream x\[ﶿ7iڦI&M4 I 1Ξ;q@a `l a6!tսbƘ$]Z^-@6~}_]H\~9ο;|m C tx˟o#1;;;_n[-<}n1qc=cx9ψ#͌xM<13zxc<ǓxڛxQK^'pOm/y/xē+$^rW-xzvfWg%^&}oZ7__x̻{SV1\ge0_u"sGT1vy*?{;?,ngZg],/'7+͛ˠez!pq5yvϾԻ7Y%2qj(.{|fUAn֝=)"[tm#;?3YxU@ GXu۟Oo#]@ b9E;nG bY[@^;˸իCWEFFDDp`aaAaagxxPDxлVY}@xz'AjUHdxpH00O(5YDV͈ DAߝ'yM;@ -yG>oOo$#aA mi'yMd-"ȈUhU@;#δK+V?ߕw#ȉ$- sJ8E=F w'ADL-=8*{_L'9WO,!Za$BARɆ-RS6%'&Ē5YBXJzF  }W|'W deuaFi^7L}ŒE"Qċ!-Y26Pɚ6e ^N`Xn ?gHq8`}d䯞}QgYN>` oMJ+$qq(Kd YNֆ-|obUx0w6t'wǿr80"2˃SNUQq 0,da ɺu{#۪Ub;B1fӛQJ^ڨQ1C?;將y],\,O`Xw~^ |>/==䗏= އ >_m$^!mIJDI^%1/ _~D${U@a˻{t˩#$ EšR_QP:In(|m-wD_ˊ>~qx ҏ_' [F"?Aa!"_8?`hPȓ_$lC‰9gPy^ڕ> ?7弗hڕ+K 540h߻:G7+v j:Xol_O ֐F]f_ X?E u^jEeV!(=(r9p:C"p%D .Ȼ~Ud o0<'l{Dgd؇Â<|I᣾4O_||'yMd- Q [f7|ՏΧ/WE Ÿj"۰|-G[/hnAP76u '\92o[AAghs:]ݙT( Qux,=xDx Yw ~@SgnB5~ .~"u zYԯc:Jb x]a|K]Ԣ&xsx{)t e<|b}iW-=qD!O0O`aS]ſXA,ב;Gwzo~u~ko呿_eنlI  ~ _~LNOw?Kdeنl)] >DU6]-_'CAbqd8DܶVō^7>$[/7@-zr cWo^bhf; մ{JY-8©-^ٝ#Tn{ Q}<MlkgVyqp0Ͱr_n8|p-;:fab,/J U/oLNZPgei~M/ y% |bSuKܓ'DbOyr=jwp'YnVEnK8Ź9gBS?$-_-|d9a/XU_l@VbU\*x#I;jZ/z4ip}q߰/ 95eQC|AV[cÃ}||Uk\zd*Z*/_иI|g>_ޔmG׷Mr0;r^sT >!A3ǧrωCE~o7xL( MkQr@Ķ@KAΗJRKD7\4wkDmgYy_rYn腁'C|pr ׷+ss{~B[5^ &6^?<ϫ:ϙl_H3^UG@P&{=a8?Aή]zx]xY T @,鰻><,S Oqdmh{C|M['c >*}Mo K=Yywyl?G5"V˻I"/f;8_.8C,=kSsCʣ"߰/'0+._3͘ڬ>,33O~S"{imP@Nޔ:៚3 Njx`_glxdz"g{^.>|} Р9>1 g!ᡁ' rq\z/sO`rpwP4X OaoXw?-kn_軫z`MW7;* 2 ^$}oo[/k$\(,'k6dKќհ9ݒ&Ke} [؋u_H`kUgiw-/t!BqhHdʕwo~ >=C|*QhJDJ7fWܹRT\/ TOvsn7?dqɛrCE޹oxS0@pot9-yH.pww| =Q桕T'(T$=Bn\]z\vzWܬa TC K5 ȷ %io"M=y=7yv˪#o,Whpp7^W{ bw~($%/+B$ |(դ9`?nd]ս@aέ.9ANǪwwwV}GkFiզɏ\LA|as)mU{]P[ .A9ݶA;<@ \?9\/Z3Y{ʾh8M* .8<:nt[a~ޑH3t7"9>0^s}N߫fO` ԋ=DX>^ ?=IC}z#?3%/,q^gţ6ri%* |y扗_zz饧-O,!u 9ሐ@њ;K-tzK|D(ܿ#^V䴛Wj%O bU~'5]L:H0H,VsWpCғAݣ.(H(^cRI{.Ow-ZւϠH(\rΦ>T>+ GOͫĢ@I*>"aeP6XoK!A~~>Ǒ b.!b!w <'iʝ>~~3\ׁ|3>׊̏a87 >=b!"0gDFV,;~vl/O,!ZrY:l5?#^( H=z'yM AXX88`j ."?ksRz`D|˰^,7VE](}7OnЭ5=I^%dy-H^$g?uzGO, V? 7@\2!|Hcyz@v3a!X@8^M?4$00_$!'?kta}dDhD<@'0_/̌Cļ^q)@cJ_a>XX]Orj/x9Zeڬyr`5~x9D!Acy]:@ A@ /\@ b|Y@ ]]@ bF,Gz\C%SZO\{*-UW˾nAc^s85.vW+V^u?%<[/ŵ 5k+OEi*~j!Xv5wo鵗Vvzh,/W|kϿj[ e+VMyt)9o~@7k6=5똆԰o?zOeߩ&YU׮}}7+z^}%je_~5A6jʫT:Dn_9NgQrz \DO-~߬+2jUO_w[-<~ec0ˮz,Oͨae~﮸zm+7/hQC)M[poXa]UmݖLoʝ?Mίe=}z<7ƶQz5|(:P.b0w͏]ͯw~ \L8ٟ`^g#G참~tneSM?}y^˘$[\?TUWܕm"rі>w*zʟpzs>׻=cz{, s`YG/FfxwqyH[}ޣW]v;E[<5{_{mx[q~~|닙C(_MOg4 ѴwS^:czzpp8`Sen ߴgWޟ?y,;awT|u~+?ܳ\m_aW.|+-]X_ysЋi6&?{WX~r= 8|we;漮w{|F}|?Ί?Sڢ.}]x7WwRzz\p=z\-ZEƕKV9\(ELKKlדq`yB`y `Y_c2 n51Z ;bA Y:p=pԚHK$ eMON;ȑW-;㼽P) 59uq cRX\SRRv}̎)Syb|v{oB tK9:/=8߮;p=pWݩhYBtVh&N*4E j2mU 0SӧdĦ Yk)L9۲ :_Wð$BE:ء-L6gP,U%:lT wzK˶L}ݺU qܩoz "XgfW9$Twp@"t` >5fLQMYybBgXu$Y#QdNLudȼ9rjC:GI {FDmG<}P,=%Opۂ?TkV{zٶѾ].r՜X;7ѱS1F,:6%35֫#ǫF\nHb KOs؃ {]C?\h%Ez|y&#7>i,**E?]F|p\\륩&&;/zvll[;o\z9[ҽe_O6a(>8mszЮoI;wkFgX}-TV^UV QMã݅d#oQuMb#ǫL'F:mޱG\u^}Lt׃Q9\\4:!6Q=&M)WO֤=(I,7i[qb{uocg(n:+jUiZᜆ-ZMs< ͻ#o );a9Rmvi"du#-zE{AB\4Ld-hzmޙ?f{!2A pQX>:::4$KyEwöS_}VU2\X\O,+VDvFZ=}P}x-K_mpת0WHSRR  t=eT[c_ijfXYKSͰ.3jOp=\|9\ 9_ [XUJvdTnsi<1aFvv{IJ˵X&(L'Nmanߨ7RmAf}3,JK7C zRt=ݷ^a"ɹ\VoƹةxArkYF ܰ.Ko]TkVOV1]y1,zD]O,#k?xM7S-cP#㕔.ٝyZ-fJ" <_Gt,B(NB=zt]O,̕M.y}jq05?3;b&{tƎ\dzv=|K>}'hl[}bnGզ?GIC\Gn=~W33y|q; TsW!&r+bz/A?Gs78e9.w/MV3#,[lu$=?lcV2&PNUfew\FG9.ҔrIme\!c]p#Sg1:p=\o4Қ把%zb_7|6"u_Ý%%}\˿VYe):}M gRU7SRR䲨 zIBA1?5'p٩~R{BGo=C vT(Uu-{mN_V''(^m?r^(kؼR7j;)1 4W*K-N_^''Oq\ՍeD+:tyayYjqÁ=*=-뗙Sx+zz\!멁}JWj#տGUٮclM{Z/3oNIq\J* Jb'MũzG^v9\\O,O\9r[Uz꒲f Mtuqw_^''ߞ ] w*y;-֩(t,k__~9\\O,O\r/yCCX ڶv>Erg&q##s1z$]O,O\k^ZU 9*WPXa{p=\ X(on×$b!p=\鹞X^Y3%^h4?U4]4j:A+jZ˹ z\zzq?z{$&ۉޗ~_Sqz,륩U}] oT.,9p" ¢چ_ߺ=vƌxp=\_jsYKGʜ湋U 0S'|E|^ rJ$6tlu&gK%O8@siCoeVISmn}cf-MQ4òʶw(f~ \p%ucY!6}I1=;e2j*sK 13:_r9%&ӉSce_ϝ}IBf3өTIr`p=\}gs>zrHr.5q.&:v*=^Z´owҳ,mrtS ǯzp+%-zp=\麞,f%C}ut9.H|-dm2S;\wpe,pGNTb=p=\i'S\:`k^g:vĞM^sm \p%?r<MӘmOmڴg(IrMjf&p=\έoog8eY˝KӪ 7:5}C&۽lIϏ?9} v%ح1~SY4D]?׾9mt{N<4\=qzzR[ MgFȖGІz~ j(kfzp\Ph9+ [^\e):}M oz~[~*hӚ3{FRWnH+;Z+KJJk{j_j[ՔAj4/TV7tFFVUZ׫'G)kRnz$tͣ卬5?q=Cm҆~`kfh]ocEi=KKT{:4Cwו*˫ٸZUeGVa Uy uT9`q9n(+o뗘o2z~]td|;Q<3ޢ+>vthVl zRuuzijU_WA<+Pe pzχ/p=zwDYi(iZ3:uWg0,7>y$ɚ[g3>68{^(yzc4Mz+ ǧLjdus+MLU6kie]]3qidx4-Zp=\p{Ǥ7tCm-,U:czvdTn-OLaV׫\{F~"tXs-\/g ΟEr7^?O^*7u<׼ \/Kt=kw`b\n381_Qi3QDב`qL97y}|~lFBqwIJ@ ݹ78e9.w/MV3#,[lu$=?lcV2&PNUfew\FG9.ҔrImM!&Yk5L#f[~zK7\|^Qdc|/gR*ut% z#덬5?,ۼz\XWp=p=z\H\ X\D}|%MܵWiec;/ X\/M*H}c3+x>ze؆6+MvwDYKGʜ湋U 0S'|E|^ rJlVg:|lqQ4i6VfO4WZ89Vl7k2]cw>&l'na׳S&Өr ?cD3#v?J˵lX'L'Ny?=wB% ELGZ}Wv2 wa¥)\VoƹةlSwe0۝n dm p*V8~-;χ+Hu5xIVݺ^LdfjG+)]\Z58ڢot!/rpu%IUGuk!{z=U%O3gzY~cG]O4ܸ~K\׻hl[}bnGզ?GIC\Gn=~W33y|䀛jdiU4)z85 DZ,qTw8|iZFOaydS#'d; 18u2(7:>>:=}nω'u'NOOjkҜ{ m8C{aLzB^Qd]rs\XFT5)H=c~HkhO˸ z\zzzz\p=`ٻ>&ۉy7xbc&O0s>?U}] lkeuFmmL댉yzeӆ/t툁\{.6͏5t9s%M`FN'$Yplu&gK%O8@siCoeVISmn}cf-MQ4òLOmҴLXhp=pY!6}I1=;e2j*Ff$WiDvĩ2N}[hy$H3֙6u$9p=\\TE%O7jr\\MtTD{ ,igYz\_ Õ$U zz7S-3fjG+)ݜZ5+f)]7| a]F8p=p^OUnrS댃yy^{6yWjepzzMӘmOmڴg(IrMjf&>.OMUm@ 8e9.w/MV3#,[lu$=?lcV2&PNUfew\FG9.ҔrImMkol[Se2Tz~~|,R*u).ezIBAz#khO˸ z\zzzz\p=`ٻ>&ۉWkbǃr\/륩U}] 4Wo1"l4ʒ`{˧ _QD1*%){ݱzzOeVFQ2yH]5N{5 ˍO+%LM4Ξ6J^qX#Mӆʬb):YJS+4'jZhe5uΓJDҤxLbz,ݐe>aw KդΘ2F5[Y"OL~zk(Od7N+~z7'K4c.z>u4p=pTK_4ިɍsq=7ѱS9qvkYF ӾIϲ^O+%w+Gp=pқ %6U<2>^Is\Z58ڢot!/rpuҩ:A(ԗ&@zrK^ZgsLǎس=^h3 U0p=p&i̶'qTmڌ3p}$Q9u&Xzw53GM^%M {wq;rp=pqk4,QNij>}t{K^sHz~,c-CneL&C̢!iNOsҔrImMQvNgb5Yxz zEy|,+R*u|9\/I(3Dp=zz륛=ĉُ_,b2{O9]re0ӷ&*.Ƽ^TBM|MU}] ֹ\IBmmy4,LödV,k;A"qaʕm.-KwL+@wn\\Za`Y#mi>6]o4?Zf4LKZCGr,g 2mTVV58M7c(Lw&gi+MLU6kie]J:u6FyΪ\jEfu/m4k*s7of4.䫙T< zIBSbp)Q7}o&%IcRKF ssu=l\2Yoks-''w>TKTm\g@q\X y4гӳ4cb7 wl-[NM糔{yק⢼s}l#=S"ȁb;iRA8_/B;Ƨʪrl_UWrGڳl+csc[֌ψ$gm>:TOפH#v7'5ןy1MӘmOm47 q; Ts"~ʭ=Qqı MwQ'LMI۫{ |=Cu]YAA}[ 7:BFFmE.Cޣ$ܑ#&#MQt :rA9ܒmht|N}tz(ݞÏ'NOOjkd#_it.ߩbHi+~k_qT>gZr<6α63zEz\p=z\zzp=D\/ݤ'N8d|;Qr'Yr%Y}qD́zŘܸ^QϙԪs+ T,b嘱CU2lzv7s.\$? ]p]sg`Y#mi>6]ocM0eVIb^+uȡQ区A-24j>}t:[2 u9c3斕Vh&N*4E j2.} %aEM#`N{gUy"61[+GCW\`KԦMbC3\/I*PXZ:0,0yngmBظ]\N}[(H3֙AS]uIϼܘFn+MR5Rke%:!p=»^tfź Z뜲͓m"͸\5׸EjZa&/ssR=^O+ieCq[-$6vIʍި*إiFMnWriVgW& zyPpl^g8>ib1r=N7ѱIuҜ&?w/s "Qv63΢hkcωɝՒI}ןVYi?8|eKS =;=K3:61!Ʃ1}cx6"^Y=^OUnrS댃yqQgzIr 3φ D"g}tןEwҤp|^/wO%fUؾ䎴gVnƚ:\/߭ݟc1H۾Qr֮N,5)RHg^nLF4fs86MMkC|UzehyzͰu;TWXrʏ>h?)c(N/NL45e֞սú,wEm!{s##"!QNȑq(J^>hx~ =qW_/'xF.vכLBO>Y6qozpi(+zzo\?%$'_駟.޸ ׃K$'oo~UV-޸>zp)%'tttݯYfp=\_?}ݷu{d)\.;v9'֒\q}JJ \.'OtN JGϗzzo\Ԟxݺu_|Œ=\\oZ\.>|o}뭷^f;~~Æ p=\sognR'_tb2{O9S.f#8h<~llS4__\s]w<_~ǎ;qɯ$z.aKԦMbC3\/I*PXZ:0_moM)-ng׹=faSZf%Ԍuf8osrwWlԹ(7&lJvTMZI+pywOG~M7MR{;-\\\/Kof:b]uNɶurf\k"5Iq3kKz=UpZmU HA&U9(7zrHrė5q*:o"Yb?O],oذH?app0IW^ \Үi % Wy&#7>ޓts-|_ ͙msz'Wuݪ(-6szrCd\߳Ps**vg19qGNTJaŇȝ/֭[GN7xc /zvzftlbBScƢmEvtK#ӵéUgM.y}jq0/΋;9l8/!~̗_~yp=x"ȁb;iRA8_/B;Ƨʪrl_UWrGڳl+csc[֌ψ$gm(9kG'uf]3/7&cmmU&\XçL&ehz8:1el8[^k[J?βzW 772o+r%I,7i[mMxrlsG~4\=qzzR[f%IV"M#twNCjN][p 9Pό- V ]R\\]s,g,c'ozXή' XƮz`>gzoz,zށt8xD}|_C\y#FTwazEܸ^Qϙ{9ijU_WA¹u*Wa(.{3bpʅ\8]sg`Y#mi>6]7KYk)Lvi$RXΨd2-SJӪѩGGX to$xLM4Θ[VZ89VlE3,˔5t m4 ;SUՊ^hn7[+zݷML##i1"huXnL6KJu)VǤ3WyngmBظ]\N}[(H3֙bNG,I:Ƥ7tm^iIzY+I]kp]/Kof:b]uNɶurf\k"5Iq3kKz=UpZmU HA&U9(7zrHrė5q^j搀tOdzu@UlTQ<9|z><zvzUtlbBScƢmEvtK#ӵ)_ܳT&>8u:6mW\P~V(&t-Tc|,1*Ux%w=+ζ2vk=7ּznۍArvv}tbIZGnfOk%?rc281_QiRoZec=M:Up=>228"ĔIc{D3~X7Ue(Է r#dondDV2=JX92n2EiKښ'-fFG98@iJz&zK1EFG*X]&;rm﷦Gu;sI6kMc&iUl\(\p=p!\,gKzІp=\_z\륛= ̞o'Sc\i⮽jH3,;ܴp<-:7Wjs斝4 :BKݶ8HQ\ fnB6+Mv\\36[ ]\VҮ7ܱ&VR,sIZCGr,g 2mdiU#e{~~Pi9={%L/YFz}a%y].[8:dzzKeGj)]0 9r~R7_ [Tj/_u Ddm]ʤemL>zAz+quG"=ӒJL UVJ\zH2R^]ѷFy"vid g P49 EzEPw;|>zl/r-[jX:3<ܣ 82UtFaL¹^-'[I RhVVxɈ Z׻|Hmw^ɲ(kgY4RנJIsKzY&[j4~K4Z+vPv8V.@8Is&HQTPc7H*byB8׋Uf{9IR;uXe8ҁ8eO>3R K7fj?BNZUD:BNFTԂuCjӉ'F_~^^3WX-q0KN{\O$䅖&O$LǩMÝEv=zy66'qUY^ZjUx0Kz\~}Z?x̛qG$/~^%iYnU]QX 3ڑ+PĜjM^\`:{ 'JRv=OVi7ӮyaN\?vE_/+jgF3+KTz.Q$w=,8ivK㬡!l4IbϝLzmFfhе538hkWsRcR3:::($i)o6; ZGyԹ+WQ<@B^ʘA$I8MCTwu^걾^!_m_ث;kzX#`u<bK\\9|\p=z\zz@$jzKaVχ#M%_Qvq%d'{]i<r\XqXe&+RCazsDr]_WIJq%M>SsGT%jGR[v1Xvj" Ev^ΝtPvy8zp׹sN4Sԍ/SgF 1Na3YBo[7@_ܠ[)8Ǟ02,\c|QjHNÑ,1^CybtjwҬ^caWMSHP[U(bzb' _>^g{ԉb.uSg>b}'TZNh^ +KYFz}a%y].[8:dzzKeGj)]0 ~lhW⤚}U{lH&"k^==e, 8Ikq_n s/#MIiI%&C`_*+%ABm.=mdmE/IhAmf<;G8c'MC$^Gv&Pvú^2˥\˖i*1 (.xLU1bX1SpWKIrҪ&թ"w2+RI#R$}z×7'FZbUC,exq=|ޓZ<,^06 wf Dj ݕ0uUzYȉ듏8*IW 1DJ3/qUD|߯SOy3O׋sd??M ˭+=aF;r%ҚSi~׋ C'2 $*;?od6ANx Z?soWq[vlT6P"]Vp=`]/'FO,)Y&/^{&mV>w2=Knd][3v5'=/+1ì"IQ&= ·|i_V9Q^la;uʕsTG;WG>2fnPx/I4=w ]WAzW׮oir8N!93j k0Дt\XǰF.p=\*v=p=z\p=zzRFf|8$_0㘩-[9>/HP#U EiWfo!_Zat0ҚJp=k8vseea%JnYS|bXKK j]pPSr_'qFe}yNblv;^ZFJ|_Ҝfq4U]N8[-Cq}$~j7&_ɜSBC YO E.{HʳDbybt5')([[f8y?z4r8hw={WUZt/QXQdN'#s^ٖH1\>ըi5S$INHւ]mհ[ũ׋6p8YE[9|<3zfq2Knə"y~# )_A]O% &CTwP l+_Vaf: =Rqҧ440I5Z'8YvPn/ #s zKeGWj)]B$>J%{]|\Oʁ#/.PS"线!G^0zn|/\N{% x4芿\ltg+b}g -AzP׋ pfyq+Y8G@(" G%Hg7+DګeR6J; 8Ikq_n s/#MIHn5R$紿aF>8B\e[ RhVVxp&bpB |g8vHm7()O3$X#UK\l!^K-}X:3<x?'JTU)3 Pv(Ol·zHׇ9'-tWN@UA 3ɧPq=|lîL7.èjIs:;Z+Io ׻vޓzOy"Y0`2=Nm 8?ϸ>GzAFf yAɲJ 'w Z?Gv|t{c=2.$NV08C(}wleE ٨ bH{5WǪ˽g;tIS,]M!E;v콫V>w2]ZbAP ՜wMfI4BL?vÏ~$O:<< Ǐ/h=񕋧Yl< \Xq!UCd5\rLCjO>rTqċaM_ _Uk-6ߜLᒟJj۲D"H?VJzz~|I͓9V xe pz\p=p=\\p=p=\\+rXŮw= zaVχ#M[LqԖķϋa!5=ȥ /_]vm%+z^$}u鋹u}]%(!od|bXKK j7Hi>54~|Q% W,!\Xu9ʹh;œqZƋHj.ծB%sO$TV_'R)])L_Hƞ02)XiX$`XN&N9I1NEQ2qP?(OPp|iV}/pL,ek sC(KT4Vy@;} HWa%k #O5jZIRi8`.s׹s5@kqj)"Ey1/hL=e6!8,}FzT@%CNIyoџWG?Q`/gL -'zv} ?(r QC7Lϯ|Y(,KK Ҵۦ 8f_V"@$ԯw쐡6$_,F{;j)݂L>Jb]|\Oʁ#/.PpbHoџW3~@oK ;?%PԙqL \]OA^ $M5/W8j3 _yXAT }l(Egj838I# MCf3OʛG"UH2Rۂ:NI_anܗ'(IRg Dr}A !6> 3iwяd*/ CDRŭ·p=p}D%-4ѬNhIM*=9EAREqN. nP&R$3gTI>Gګ0SB.ݽ*r[*%V/t fx'~4O>3R K7f7ϧG?QWj_18O%\z_L]912W''BD2F&r"#J3OGګ'ilhP&1|\u{O^=d€8i3x.Ï<ǚd.J?lqt,qm^j߾rrvw]~,f %ዟhj~@[UW{T-VÌvJ|?51ZnU C'2 $*{f3ڝagv=?YrZdrΏ06MV; _)M͖vK_r4Uoz8XɰCTwu^}iEi5424i3*&204虩|ivC?͸d;t1^O3iޜ$WS\9Guy~+c /.~Tytᓮ^9ivIױ44|Gwj1vN&KKv#34A[)1ì"IQ&ZinяdbIGA.)ea./R=D&/^c-4tfH#GW}Ռ0[wƦ篆}* owM{yMws/jW/?<8ܖ%mAᶊUrׯ|K:mqX2N+W~z\ozV뿹Xͮ[zzUzp=IOzzU$b\/pIx+ 3ڲt-y7,D4tA9˴Ү0ޖjE#~lncŲ ZOp=w\.x=|M{2s'JmQB/ЇΣϋ VɊq_(^]vcSCS+x(jNH=-2$>\]/s'iGS0gbb>ڲr뮯PɜSμX1?w>μ{+g/LyJ$w-V;I9A9/#kNRAQ6~q5O-.4T54_UK9KڻzhU,U5Nfxt_y?>UmSV3Etd-u\ ;(Գ>?^m8Z$GuXKԙX wUP90(qe'7.FI|= 9jwя`sm!+ɵO\ᕊzY#w냼^D:B$5yMI->>[9Gj3AHyl ؞Q%i¸O?Xb w\mXe8ҁ8*'}ؕ)Fv66%qUy>^g']re,KWcihHF}={bϝLzmFfh=v5'u}ScFGYE2M;ϱ(ãڠyc>TNij.11p=`KTmƋGzr% ݫ#R?QǪG;cWþWZ7;9ssj۲D"H?VJzz~|I͓9ҕ+zU?p=p=p=\\p=p= \/pIx+ 3ڲt-y7,D4tA9˴Ү0ޖ3ÊF2G-zze/N$u,ڪc_Gy#@2 ziP\)ͧW")-Ё7ֹ4ӎ%= szj/,#-,W >e^u֖-R/L_Hƞ02)XiX$`XN&N9I1NEQ2qP?(OPp|iV}/pL,ek sC(KT4Vy@;} HWa%k #O5jZIRi8`.s׹s5@kqj)"Ey1/hK8ǐ/SgF 1Na3YPɐSpznяl* 6Y j~B-9P04;oTg_ 3Q)YΗ*>=U5=TiϷM)@*LoqR;D|I6$O_g!CmIX/*d=wzK=+ՆSH2p}Q'zźMPi9= |WC%G^\d$>D_uCڝa#"x[cm`>+!]iFW Gmf<[++ qzL g5 sa(pTŒtIyH >Y&[j[zVZ)+ҍrC}iJ?Hn5R$紿aF>8B\e[h쾺Xğq}xRhVVxp&bpBZ |g8vHm7()O3$X#UA\l!^K-}X:3<x?'JTU)3 Pv(Ol>/;}=gj ׇ9'-tWN@UA 3ɧPq=|lîL7.èjIs:;Z+Io ׻vޓzOy"Y0`2=Nm 8?ϸ>GzAFfEx#X1ce6ANx8:/>2,Uo.{d\I>aqnQʊQAjU;{sY?x̛qG$/~^%iYnU]QX 3ڑ+PĜj U-.0 . 8wџW3̮'֟;k-`m|liw+N3ZJH8XɰCTwu^}iEi5424i3*&204虩C 4naz=ysgs^ۖ[NrQ΋#Ϯ1S~НOz)Y&]А"^{kU;.-1ۍР{(mjNʻTnj$IsGeh!wџcG?Q'զQ=\O>gX>`KTmƋGzrEq2 ݫ#R?-50[wƦYΕzu@^k|YLᒟJj۲D"H?VJzz~|I͓9V xe pz\p=p=\\p=p=\\p= z>i/JdŒc]Kg>}^ F. ]Pxq2+lZH\hpn-uG}Uzze/N$u,ڪc_Gy#@2 ziP\)ͧBȪ9+Ws\ϭs'iGS6ղ{>ڲr뮯PɜSz>ފd #-kFNRvil΋htPe-_g SK M;Ycba sC(KT4Vy@;} HWa%k #O5jZIRi8`.s׹s5@kqj)"Ey1/hK8ǐ/SgF 1Na3YPɐSpznяl* |QP[><2,ð !\X{'ԒSN!꛻c(Iu^/03|8{SUCUAv|۔'JhdCq2ԦeaBsg>Գ>?^m8ZW>Jb]|\Oʁ#/.PS"线!G^0zn-XU[~lf~FX00L!\XsJH$iQ8V 2tGrcCA\/*^>SÙidMBhr$0#yRެ<iBFIߖ qJ tG"=o }  19oџO3~$W9|V8cABq\ HiYZ!y <ۋUf{ sM]#ܠL9qY% \90d" *H?Aw>*'}ؕ)Fv66%qUy>^2,Uo.{d\I>aqnQʊQAjU;{ ]~,f %ዟhj~@[UW{T-VÌvJ|?51ZnU C'2 $*;?a ??Κ~[J~;XKsu>>_t2t}75[ڝ/}ʅӌVw%4=q2 ]WA_gD{QZM/Ͳ ML, < M;zf|ivC?͸d;t1^O3iޜ$WS\9Guy~+c /.~Trᓮ^9ivIױ4Vzq^{kU;.-1ۍР{(mjNʻTnj$IsGeh!wџcG?Q'զ V3{jeA!*_*WR=D&/^c-4tfH#GD XFٺ36M<5Ouo owM{yMw2<W/?<8ܖ%mAᶊUr5=?hP]/',%6OV,['+"q}xz֚z;uX5 z5z\\"\tXMw1%XlBkO< \9q.n׏V6p=`>hz\p=ä={~VaƑp= dw;=m]TTԺvOoH[>RIcH\AP݊' DU:_XI;Įp=`Ż^_+ K/lx wOhc_q}Tmȫ5.5`מGݹomQ.6GGGoi?`kYi7UirfզȾͮM6ǷIY'*7?эz{طcDc(zJpO<ׯ4辬E$9'~eJ~{{}mK7Dm~z#&*w[e.TTv7r9m"?wۓ: A m.V߽{vzLۛrӵ{}?MhZÛn|ѿlM7Pd=~蝜#'m?ٵퟕzoد~, ӷ ;z~Kwp=`y]F~EKҡz-oy~d;JwOˌwP}}ۢ>9@#룮ݶs7naq Ӷ ]ߨt;p=`9]/{p g 7n^׿P8=K3秚pu??rTvzij&2p=rr~ak[~mx;nxڠѮ%޲wyK6}[$ӴD3w|d[jAQCr?!Vp=\\/'+ +u5|7xm{P/}u7_<;lݶŵo wS[^->fC6'nۺ.*M;ȇOSׯPG.o|߿l|\lЊ\):M$o<}֧ROҞO['IO½mcxm.\?uiC V66;w|u={ͷ=j7?H\7TgC29>cޥmuG_œ;&|8\p=z\p= U+ KۆS;H<_hl}`T39>' p6l-\p=Xp2z_Z=Ә/ub!hnyCou \9Zoz{طc+zkoBtxW U6p=`nwv\wm.G!tlewz}jyBɲV3Wvb;Mo>1Q^z0ޢ2Ƣn S]]f!oKw SƏ6>ҁÔ :r W6*ߋ0<m ܧn8^{']uݟttrsr=ݛ樨7ٸ[~QmY6z!A ͂7G2mQ_'I{6+G;S]oo?t# Y99lܷa+jcrC Y qP]9|\zp=z,i|c7p=`}07az c|cz/z|cz\z\ _4g*PD;`*'~#z/0Qwm/$pɉѤ.6/Ѧ7鮛u=˻ʎ:k+uI@sXw}p=_ܼL6Y[}rwQ\ooSڷCv;%-&S_k7ϼ [z_Xao~py7/x7y _޺KZ'MVmzqӾ|;pD؛~{cN?nt+w\GN?yW};_McVĵ_ɮ 5yߵW/STuHR(xƭOh|}l(sW]I{2\[z=BZn{2QޭC7^`B7Zɡ7~[kqɇvlߔ=+Of->LWm[M\$D~J\|/\"]u͆M6\u݇Z/>͕e&7<ɔd׶V'ZRpx\pq9xo}K_њ&E;FzE`C3 ߩ;<|wO|3Sp}S~Eگ;\3 IWo߾[Em^q M^q>m;wyy#p/xLoQqѴtvzL71Zj'~ k1I\"]?y~ i߯wKRo{ot».bwW\Ī_ڵ%/p}towܯ׫~گw$y2_'GWLJڹ_h\<:/gqJ\q\..כ~r~Hveu/|7ZqEYKk{9'U}7ZM4u5(3{gv4cۿJ]cY[p_ؼW~Dyo}A\8% ? )\ua&|pwz=ݿܖڳ)**K7xAI:i3|ⶭ뢢ٴod!7>(}ugS=zٙzhv>'ӮGd7w͍=U:{S_(G~J\wzZtUynk c|cz/z"%jr!SLMj9g!p=_ "%2>\zcK5_p=1vp*}H݇8 #)/[q]aQUW1}?2\?D?~c񡝻^*^*|ySԺ{t׃V ff]OA4+h>wnF9 [tpW#yӳyz\O$=ӞiBWs} :kt׃ fpZv}* 2fWl?_=zSQ}o򵤃[}JeTnw mh:z5UըmwWߖxOx?S]Gq[;~8umr?4yjR{τC _ U֨%n<^m } ѽiOm<M\TnvJ'ׇx=XC\EPjԺqunyեtS룶|'1_ݱcD6ʥv|>ʱ>xmԮ Mz=xC\}4Qk*ᶨp?nzè:tc5y2T._ǧn۵ﮃ>/1= fp=XXm;p=XUlVcp=XmP] lvv sd! ֬RIcHw ݋oٺ~iz_>\_ȷK(o~B^'HX;{/ڨڜʽGEm7G?{5Q׬ߴ㛿4w}вS +p=c=%Z1mQ=nY,||w=/hГwn;Glͷ]h첇rAE\p=Xׇi[򃛶d,}R{Y]lwm}}M Z6ȶSzsvv\m[-BKMo=?z}TT->f.~+p=z}v*vp=] z`~p=]ƛ] _u=z$;'qm_)?Q2I"y_ODyR_^9eoIhp+~7_6u/oصnWDM{?[A endstream endobj 362 0 obj << /Type /XObject /Subtype /Image /Width 674 /Height 561 /BitsPerComponent 8 /ColorSpace /DeviceRGB /Length 50600 /Filter /FlateDecode >> stream xtו$ݵ]'ulǛ]' X%r{ŎKb콉`N) , !D`%e[ϖgߠ&J{x g7s!{|ڃav=Zb>^j>R{le٣,{ܯc{"{==Ყx0({=P {g|>iƞ]3<=ܳ>9dc/"{`/9r{i/'=ꢽ沧_{ez0-z cATQYX9KWlGy5zpØ+Sy~c~JΟ_'8 'jg 6]nvIof˻zDpb9Da؄ϲ~@铪 m}Q@Oߠس l{ /a```````ɜʃmK? [wݕ_EEQ ݻbogo+"]11Ȉ0.'hIb\Z⢐#FDEr"a3Z000000UY0gㄤ>~WO޸>>%\NZ_DyE񣸜?wHbE/h-Ą]]Ȱ[n CGα+vBX[Љ s/IeN.?M=sm##0`Dm~4iK_gy! i|>%h9Z@6;?>Yt\lTd$'66 ~&Ag-ul}{?&2<hK}P'Dr^Қwsy P^TD(*Is9;C8N=N2YK@[&ŝpcby~بV}E/58-fΐG(ڵvΰ(96ڵsc3w!\nf:lgX(r=:mt-ń/s#8>>̜һ8xwV&y,&:I%GŰΟqؕ^v$@)+1Ɵ%&ybνY<lPg>f({Ba{>H__>|EE{Wt$'no(dv<;ߕɉF\71V~P 7"!sP621UˏJLGErJ[۸7İpW'鶾o DEy7v,YED=6atl66ڙ޽QQȧ Danxٵ[Q[e+ɉs}=:*auf|1l2i:\)l8ےTy8A)>>9$0ˢyG`qjGDi}-=;qCCUh%>.6 {㍗>=ud~{o: }FK6hK748=-Ëc#x~ /~WfwoEqynun͹J[t$/nzȈ]Wtd"Aؠ$t_:bs.ϱ\Ξ8Url-ҏ, aNȿp\=<얿w*wy h~<~"c|V΄oyaѱW2= 80x!:Ë|3:}o'ʻD9T(N@%bbMCGF>WK9TDXK[3(?g"CcfQYWw|x4:c)8w-,nqu8գ#W݁]ֆ(v%* ~:_=?|~շ| ox;ih z}7\ ~G/ѭa(ꉊ"##ckc{f. od⢹>̫׺{ƽ~Iލ8@qQ6U&x3+Q~IŭՍy9Y.='*"v;Gb%- hzC9*̵)^X?0Ȼa3 b1_#Kΐ壘DE(8v,dqY~:չz```9(7{{'2?{_[^gϯ;WmЖk/so[obvg\rmtmh߷ ;oDvqQQq{|ϯ6Go;GY[-&4o$FyKoo )wSVbcx>< xwwܲxyU-V-8{6QѽQ!;cvzw*:౼(p9)vDMǍbxa=GĽ#i1yR휝 wby\5 3]&)ɢ<'Wٛ8,?|\^D?=00b#Y"3-?Pޟ#/{6 }}zgwisܣ0(_}幗^|嗞A|Ew}FK_x }~/y_Rl\|4)tOdrɼ?y&+=cLvݑAGdx3.:;ʼng"PVsnx@yN*f o+Ɩ64Skr#5Ãr#sߨ;=mzqa~j=摬T6|dP\ߥG{"<▞O`ߧ:'""6ej !ڽ=y/ӓDv?|7̇~qoQ,.<#/O8qϠ3Z? ᱘pJ+T#kCGy蚅zб>0Ņ0#a vLBt"n}qKtܓX6hd$0:af3[Q]4'ƻjkpq^H8Ϳ+󡣥NO/?Swn.Hݽ]rc9z][]__EɆ 6}ϕ(sk﫟t4>wؔ7*7Kp^.#a hi5@Ï#?u.O_}]yyo|uQwn"A"wv~tS?}PmyMwgY@y^c{6X땟]{{amXoWKpr7 h{iUCcZQ4nrF^w^W4KbhG,,}/߿Z~ 7>X:2 pkH,(ږ(o#';&߽0㣍o|?ړqy_~ӯ+$lpgyQ}DI0 wԷ2}EgP֧߳~(oz9o:U{xJ#ڻk'a(.{i6R;~ꎏ[t9׿}:9uыQ?o񭫮9?.{;v|9WY"}k/?Pf9,֎߽STpo;}f߁ ҥ<ʃ@ <ʃ@ <ʃ@ <ʃ@ <ʃ@)]&Z티 Pu{@ %/';Z$0ā ЕI$t KV/EjkܪrM@;ʃ@@y?4 Yva5'jY6 ZAhYAha?1wbS6Ә(;c rzWN,iuT,}lo$nϞ?֥38Nv@ugi`2[qFO =)|]:VJ:F cfn. QI)US;P0AGk2n 3Tl9hUZcV&K4īCi\G}h}:sLO,jVJ6\qa)s]4`iUj;ޙ0(s](8 y<AyQa)iܳDCc,\&|l1NuK2oy jmb4Nʔ (W07n&9(=Hh |A KFkz+颼Tn=;O޲Q33r$XrHc (*n=c&|n4J%Nl5.bϋŻsy\J(@6. P~ձ#}l)8A SA J(.PCmKDA < ж|B<(o%o7@ے{nKʃ@@yAmI (o%<ږ`@y(}#-)A < жc<,L=yK\t;}+HA '(6O>jby܈+7zxu`a9cuiKۭ*IR|6k-+A@o@?Agzl(LV$.62 ()alṧRIgmdͯgQ^4h19ݤywBty?~b4el19PLO :5ewUֹ'.gR gJ; MCي6znXLre%1i7{Ub|J](6@yPQOyaZ6dR"h'>ݔfL'.psTu)Ӭҝ5b._t 1M{ψ02Z)IڈrŅvǝ[KR,8]ʃztADZmE0nA@Mk>RS&a :kܳDCc,\&|l1NuK2oy jmb4Nʔ (W0㭬w,ۦI+0M”~;ރ@yP~)/Tn6|.Kֳ4-53-,H2-4bQ!3Yք/TMҚ\5ĉ Ilw,m7s1 (7'Orαiaj,l-<'}Vf-falqB`0PSԔe5=I^fhqPU6ptg溟p8|4T.\8E V33W捝,IOO#-Jy\w};IYAQ gE\/ޯcSu>/&oB1@˞)ˇdGݱ"# # >(oh߹k1B6HPC߸-(o(XyMW ]'&ߋ{_}虷SwrT7n[UO}ΖWnz7w WMV͡'~4((*ŀ Pm@yRH],?d&] UN[fHA <=k^aݙ*n_m¿ݸ{C7:ho9P~Q>;C7^'' b_ޱKW]U<}\MΘ6^$ Xr6|^vPCxSn i#Cq;ε |[?5vяC^q椟@mF¼,<yfwIX,U?{XH8A%R֝!~솞4y*ױZV1Jؘ6p'^{@@y<(WW0AGk2])]n 3Tl9b_cVӶ&W S}~S_~2Z9ܠ?)a-(W\k'zܹu*S'1Q 7A@y<(ٔonKyQa)iܳDCc,V%|l1NuK2oy jZiZ Rf5CȊɻm䠼|FuN VR^*7Z4J.Kֳ4-53-,H2-4bQ!3Yք/TMҚ\5ĉ sALS"OaVeR {D;.V9X^/=(巀>RS&aMK,g߉*YLQbxi딗e$ck9Ky ([o!)'(qh=#(W0㭬{XnM_Wcq n2A@y<(eʍ&VEyzv&eff^IF@P49U,87${& ԚEIZӐ+ 8!G♁&J/knv?˒+%ԱU#Eb%AV|_pݔ,Dg6%곟z˯\qa-wߗO\,fta_(qS(Z z@)(@@yL(?إlgj|3TsRĂz[`:4f7;F13V\nPuXͭ.A P()MCI&mi썉) cy]n*1 (HAИ$ 6U9 qJG`?ܢdq=38Ыs Óme,(@@yP nUt xm*3[=zt\s [A"}ʃ@ ۛXnaW׹ۙiERẴ͢Enp7AH*7ʍ^?^-ݪrǦs|N"UGSifʾ(寀X^ֈ[Zv0_tq#Rݒ7 mUII4uz\ Q1P_w՝IF+}lXfӐdℍz*YؤG n#:Vh=@R9%}6ݜBYI(l':\5ĀO ZYJA=if描5e9WgR 'H]d(dD8W_Ϣ$i Yc(L'NLSvf3%b8Zc*V믫\+*3XJyhO cyTuM4yj̐nu[?ʋOb@y<cZO-c7NWYlug~O4'LWLRC5iλ)})_?9?5oO\t"{wfk(+KZ/jOi7ߜ-_ݬ♁&J/knv?˒+%Ա>[*" \/U*w_̎㟌`P)~^ndҙ\fuŲZM)zziPhgui-eI$E/܉7 e:I)/%a:͚ ]AJq…S`53 n~uaۥ5毿hJ[S{ye' iɢHʃ@_<~ Ymd+Q^^r3{024',4v P]&e,7[Gz *%?5_"nDYJ (.e ,Yvkm^^@@yt؃@ <ʃ@ <ʃ@@y<ʃ@@y@@y@@y@$K@ %Ayq{d }+z|}xswS[KQj̫(2P%) 5??ʳco# h{tKرM{g(Elt BRWn ejůV^)aZ>X n%b<ڮOZNVC_G\][I͠|0`7C[U.AE+΋TͅX~'ʃ@+I˻'.Le6 Lf+N)"I [Fuzvw,M.}6ݼ4PV1JlZr%a9VR~POکcM`|Ub9Ǻ}F n(019P6j2N׳(/m&fa?1wbS6Әpuo*7p Jdd:w@۔IŒ6|jI'87yntv<ּ<<N/I*.=XZڎw,/o_i}[>SP& ozi c EچLWJWmg "[PMLץ,yiiV[naS~[]Awj (HJ  %~) H.P (B!h$"59 QKO 3ޚ=.v5,PC2W~ge-VTGjXw%;QX% F5:3NuK2Z=Bj漥0e)ay꥞(.u!W"pJXrի+vvΤiO:uD=\]$G.+Bėzz %5Ayƫ&z-zv&effby!hrXqW߀rWl ZArs!{Qn~12HF{_>@oå^q1G!XΡOEh΂e6<9i֫R^ +SfcXUݪ_S$=M5t093u<7[|=0.)o \Q{t\w翞Dst$5T{RGΟxX0E̦ PxW.^Z)`o9?Z̺9uXFf奥j|3M^^~-EA %WJ c}^U#Eb%AV|2ĭ+]W0'#%wJ{x_}qQG[()9Q,X: }™Ѭ.OhNSHK<@<%$MS$n(K&q/zN,,')HGvHk 7k >*w)ĩ N7,E7Յyc'n֘k)mO2sq䕝$Pca3O>Vfym6;' 5=4Ԕe5]kF8nTH6+ B0k̜wfEM-|NJ hOj4uV[&يnԿW\̽ ngiNXiP<L(/n3Y#og_דjf/gTʬmr2iuCp6z/M@ <GA PA PA K*'??jpu;Żgc_>U5xքodnryzwH2-4bQ_}z]hAZύ+qgJ@ytޗcpWɆ@ry&r씯GEß~I\t"{wfk(+KZ/jOi7ߜ-_ݬ♁&J/knv?˒+%Ա>[*" \/U*w_̎㟌,Ғߣ,LvX -4`=ڮg?/oSxGq`Lhf. gSGbY ==ET(s 3^R:J4EIaQz盅}$IQ㒰IyMfM^^ z8u)bef0o|M4~63G^I056X;D1jefalqB`0PSLSLMYXѕMmAUd#R믱L+}̜;QVqfOTcII@y}c'Y\5A:-ےʿW\̽%ާ9aQ C] P2(dq.9:S|gAjf/gTʬmr2iuCp4 2@@y@@y@y(@y( ( ( 蒥DlwML\th߆g=>oz} Ths>_9)劋+Hhҍ@y})~$E/ardž6흡Xv=ɗA;]ϛ\ $qP^V^nUIX^ϱyJ*kzg)Lo+夓ړK tK &fhe"c~yIK>ɒv<q<_!+{}l̤XfӐdℍz*RXa(AmAXGgh} gKӸ e%xu+']>AN/#je)?>֔! ^.Ӫ=Kg$p v l#&D_m~=ܦAN^nRg0]ޏ;1M)i@WAVu믫\+*31/6T˖eʃ@+IŒ6|jI'87yntv<ּ<<N/I*.=XZڎw,/o_i}[>SP& ozi cLv ĉh7* E}=KY<Ӭ݆Ô{C01ZU D+`y}}f7 @yJ%~) H.P (B!h$"59 QKO 3ޚ=.v5,PC2W~ge-VTGjXw%;QX% 5:3NuK2Z=Bj漥Z|,aК%\P(A,n4JTTnzuN1m\R9vV؁(={E9XPϋ ZgjKݒʭgi[6jfF}Y (&ǻGy )wi-?7.T?fwEjfm9P]X~/9\!Px~_,tXĎ,x[&+9`3ȓI`Z+Ү>ej&0Qխ 5H^C 3C^ss(n (/*<=ߓA+Ԫ~~h{qBtfc;U}_x9abIs=M#Nz\T=IS4ESS\1P]IOfUK:H?ǙŬv˨g+`3PV~>ᩨ@pIPqaqgWҪv3gI~yMO"4q>|ԗ;|/LkӔl%Юt!ӕA80Ce:>Tu)G^ZcV0bxOq&^k}]h,Bܳ”ʢTuSb1P]A/ \( ӴҝUT&a#*AyIVx Ua[3n&jvB&XA/,xoeC֊ H +D}'*d2FGy1`9֩NyI^F257@믧[?VHU͜T=Hh@yr IZӐ+BP%N,R;;gǴqI'Y:.bbxl!` @֚@oå^qG!XΡOEh΂e6<9i֫R^ +SfcXUݪ_S$=M5t093u<7[|=+>!g<ќ0]1I դ9Tg|=.*,ּ=qwid^gEyy:R4ᜓ/QF$)9RhF:Q"EIUcb``s4+ Ʒ0M)c2ve=lfWjyתZ4sofc[B[ZkyAæCSŘ:mŸ\/ta{s4~hvqۀӧ!5Gq>t^I,>lhEnoo_HoZ=28ۭ>^&#-`y~L SM-eX뛋#:ceFX t ߙvWLD4 ,qwlXŃ^FqfD3G"i9Z 4/[]΢Vg77gw4Bٯ7riޮ cV>ckE8M0Y3[اLZcvD$Dt*Tcl&i!q âu+RzX͜ye ä2?[JLgOfCF(͡Ͽd_w-3':Gh X {a~g4 TmRgy|X%[Mp*׿e W,X`y˃,<`yZ^a |Ȯ41E{4RGo(h=g~L}r{Pl"T?:D8AQIjy9$'}'{vf(jXa2|Miu~J@ebX^3U=}{{0]̄{U/{<I ='sfN+s1xryfwfeO:6+9,`/_Ɯ\d7g&Eۧ}X<$"Zx204To~~9u [%<;wW=V掑a,u{<m dja\4U"|{=t+-yzhS $Bg}ك "VU4_'MZ+u~A]E}.c!ǀv.'SVSwo弮~#}):Nޟ̣M, FZzO8Sb+hTgT1jZ#,i2UKeM^Ig2{g:4CgjFʭzA;d-fζTu܁}//2= o^,@Tm.v>l˅.u"#VuKZz-/ }^!o~lӓ-):ovX^ˋr]hg,-+GW`y0,Z4~?ƾhIf⤮eJ9Do?}cS툓]*mo?YΧ}[4i<4҅4jyZ߯EfNcж sijЅ͕"QnNz5{%oWui5zrk~m#KGwLi!zɻjpq®C~,+ܰKp+_w6O> TmRgy|X%[Mp*׿e W,X`y˃,<`yZ^a |Ȯ41E{4RGo(h=g~L}r{D *G1+b\{>CG;350R&ݴ:?r{%F1Gs, Un ڽq.ϋP@n\X+}{w,; n랧sfN/kR2>Un>/ n\aqK=,m{Ø̤h/{1)*1LToq"qOLxњ_ v)uȵh|8{}bwFq 25btl$E=+ L^&;[qh2!<&A 5P/ZH ͣ]N;|-߂-`Jtab"XY#J{G )yr8ZaB:.Kݤ .*(l,To~~9u [%<;wEפe|TMU F+ι)h"!1.Exzr WZzY=ͷ!yS $Bg}ك "VU4_'MZ+u~A]E}c!ǀv.'SVSwo弮~#}):NӑbaW{`.8u`8FS2eƕ#N:k=U4V5%RRk%b=[acX3,մ7$W-5yc>$eʶ~ܺ? үj嫵W)fKnSTl^scӭ-`yEhl c}C܇~p6WdĪniRkUett=$Q|.6=RRS[my>{xK.х&f_~'XMoij~}X? hͲI]˔fs~@t'LU.~!SmĦ{3JҨ֪^km5s(vSM3KU.lo&.rдv;4чN+i%~m);ցVʭ-/1|R[Cb;ly~y~<: }}sqDv$CS4N;s 04%xЋ:=.ߌh:_$Mc;<ǵ]K!p kYVbʴ #P\(&].Uco߿Ӻ1[+o׆2-R0_gkE5ө|WR M~ӧ1 zgfVYxKc5so-t|Ƀ,9VcKVUl`Y4UQCɾB[gD1?Nuȏ<%b nyFӟO"^VSI }V佫nGM ,`lyD7K©{\2ޗY++^,X<`y˃,0ޛ(I5F>To~~9u [%<;wW=1˝/<XͶ|S2s.v FwjExzr WZzY= ޗ]kdxL- kd2ZU^Ҕ~L4%kIw&9}'wGTRڹL.[Mmj+[BL:1}jZo! |{Tsy`._5ۺԁwMLTW|:Y 0Wp"4V5%RRk%b=[acX3,մFXdʚ1d2e[uni[W5+[%L7w)z1`oKZ3Id`yPˋh&=ț %3Uˣrl.- fsȈUҠ֪^4+nzH\mz20\2^-2>|ˋ~syޗ`yy]n ~k<GZ-nZc_q4$eZ\ 8o^~@t'LU.~!j}[4i<4҅4jyZ߯EfNcж sijЅ͕"QnNz5{%oWui5zrk~m#KGwLi]jaIa'?)&ղH|,12s#,a ML: ;s&T W8;LA/r|3X#P4ǎK!p kYVbʴ #P\(&].Uco߿uc1VqT cex[=`2V:l/ W=N"Jxlpvͤ>=0$aX;cT6zr{_J/ SW;ѭhTkCp*c-Y%VM'gٷ\VGi}%m( rB,_H5l+|A ۤ>+UK<% QT=Cˬ,X<X,`y@ 2E#c8AP?޶sE{g(L56n٫tC?S{\E;rb_Fȓ,?t^.#=Z\'-hż-2w_D[΅}ˑϢ}9Y@Q isqw{W9QWlUn>[ n,r,@-m YߒОMrw|h|>}( avO]v`ykq्+KWƴI l1+L;K]|$x:}x_rlŘapJԸSU[HǓ9^*O}Lϖ'sWFk~&(:;ڝn+V9vCV"ע1 '(*43x2wL ,&ۓ*@ZV=(-$:G4-:.K^*zg9ä =Qu JbfNGtԌ`V!&`k/&ed8#m3}A}OM޸bmq2[%<;w`yr/ Ki,O}"Vjcm`m` c;Q(MnJ8{o!_' uqme#,įwk2 kd2ZU^Ҕ~L4%I&9}~J:W=KB;eMַr^W{ejag$LD#;ơmB5{_J/dJ<OlyjC;n'|չ<'(o۸gqˋ_FP Bظrɢ`PTTzVRk%b=ޓGuONk%M&jC!L&,S[f~U,_5ۺÛb/dO<OoD7b]2g<;oJ` yS+2b6 g6G;s1wnRkUettɛ6g WoL)xK筶<g䭊{ {_}w.,[7x-0.jJi;]ZUpM;ցVD{-4s@c[ˋY^Do?}cS툓]*mo?YlsZz-Q:h~XTkPT1mg.?˫]\)M]6iwHQi\Og3 |ـ ,N[F0_Hx*ˏRW7t9*8}tys`*bT_\>˅9a1"9|}sqDj&i!q âcaj(ZJ~w=X=]#@ d,@3,߳_/OKUeղh&{3ȴײs,ZًqUn>/ n\a:/-{go<-y+ $wLJgYODaPD x:%),ڵOhmyDcZ $y{kr{#Óc+ƤOSzƵz4E8 . M%/ϙRyupcz<؝M5Z0AљtMn31'nJZs>>\;8E_f|N:`OƢI]y{&/C\7F;>=NMv#gӾH,pIQ4y +z\(ܤ,`&WuAZ oF^~2VȚ(syE&opyLQEa˝\~y_.̏уk@ϻs5U#J{G )yr8{z*7߹҄ޙk2u0BO~0GTzB³X/-|75#U ڋ)]YiHLhnsf{7.X60uzxC̩moұ Z5z_B/γsQtL޵ŹD`y7r/ Ki,O}"Vjcm`m` w' ɍ[ g"DD5s^l佞\啖`^wMaAZK`Sүd: ?ZABt)\Nv65Zy]합vWqx2 }):NṾ]bڊ@=Mչʵw™ CX0o~\Y  p|V"V}ga.zsG8iwc1VqT :gri,zXd{i.]3Ix<:bS&ghh=@d)|gnA5PWxKc5s{w):u,`y8SRl*j2= )_VKu ( CX,Ha!Vxￜ7l+^XΰʸMJ~zWݎw)X`{O7K©{\B X`y˃,d S_8h=g~L}r{DvhegS1= Y/r'\e ]%Gzjj4ъRdZk9_|850R&ݴsqw{BgӸݹ+|\5NUxƜ\T|!Z+kpp~ej9؂I<;{&WvM{홼 sMv!4Mdl7Bpk6i/>I 'KP/ZH ͣmjo|˫׉E-SI7#/||+d~w7<⢰N./qPE5]]˪Ƽ\}9?=]eiBE5:gtx'?#*N!YIU|>L*lŔ gym&vo7ȹ3;9?*cl``68HS^oZ Z5z_B/γsQ^M_~:WBM\G s=;Sr4䮸-V{oCkkdxL];Q(MnJ8{o!_' uqme#,įwk2 kd2ZU^Ҕ~L4%kIw&9}~J:W=Kq hr2l5uVjLm"쌛ēh|8M(fK֙ubTt2hv={yg6sv~2W˳~\})[{*k4 *+G>, u;KHg%V"=}TKFXdʚ1d2e[uni[W5+^#K)+.@80)zA;QJ~+,,˷ ھ=OH0 M`d;*qf;w$4/[]YJZvIƣP]߾çuZQ}S6 /w˹LZcvD$DtN g/Ia8BQ_/jU1N13GEƨ;14dX5Ξ/VGi}% ~Ng,o$ܰKp+_w6/VgXMe&%xy?inGǃ,`y% QT=GV ,`y<X,`y,X<`y˃,XGZJ~w=Xl"D791Sj<Ͱ|~O{<*K/W=UV V̐"Z|G_αrhe/aɔ7馝:䩯m*ks4?*8LEl'և7`y70!8(mvٗ1 3szY 1xryfwyM=|go\Yh&;>T<ϲF" "jSg)IgѮ},E[m#R'#_۳t0Nd[1&uxr#5T;)dpah*yy΄S+Cӳi\l>њ_ vn56srQhDE;3cNPTic &d,X^5Mg2T5!xƎO4Ee0hh/'1dRTdc.M^C^hu0#5/YjX UDТF$_Lf?\^ѻI\STgqQr'_ޗ8cz"P\ ĮeBJqDcbޟʍw4wL3L:Г^$֪jud{Dg M&`obbJWVG<6;ڷD鍋j, pަ)sz[t,&_nޗ h]),1ٛ}I閗th|a`._g'OcyS&8V{oCkkdxL];Q(MnJ8{o!_' uqme#,įwk2 kd2ZU^Ҕ~L4%kIw&9}~J:W=Kq hr2l5uVjLm"쌛ēh|8M(fK֙ubTy-߶@*|Xg6sv~2W˳~\})[{*k4 *+G>, u;KHg%V"=}TKFXdʚ1d2e[uni[W5+^#K)+.@80)zA;d=:O>5^(.,˷ ھ=Ot>i+$eZ+8o\rk~m#KGwL5ihG}c:TGng>JF Tht0I1L*EM.PrœI8?]f5^~4Ð8aQ05i-lpAoJ?:@լ7O>չʵw™ CX0o~\Y  p|V"V}ga.zsG8iwc1VqT :gri,zXd{i.]3Ix<:bS&ghh=@d)|gnA5PWxKc5s26)>.X;pۄSRl*j2= )_VKu ( CX,Ha!Vxϭ ;V32n=NMv#gӾH,pIQ4y +z\(+Z>ᄡ~|;ӥ4UDТF$_Lf?\^ѻI\STgqQr'_ޗ8cz"P\ ĮeBJqDcbޟʍw4wL3L:Г^$֪jud{Dg M&`obbJWVG<6;ڷD鍋j, pަ)sz[t,&_nޗ h]),kE_SaUL|,/\Fɥ+X^i_ |d:dj6):hJZy *Ls.tz,DdjwjnS^hwE7'qhPnޗ 3hhk<0,˳V9pv;l?Y`>Gi~=[^Z5 Ņjƕ#NJҳZ+d>%|rZ#,i2UKeM^Ig2{g:4Cgjw֥ } }NVXYnY~-ΛB`XŮ}C܇mA Zkyfp:]٦'[*Su y =DZ<%y"Fsyޗ`yy]n [jˈhy sᢦƹߥ[^e )alhEۢM3T?桱.ůmA7+=Վ8epyv*;7`yZ߯EfNcж sijЅ͕"QnNz5~6nL? h1⤮es˭-/1#SxK |#n.sPUq*-RT&c&OraNXH$_\.oI?}zaHðwXdZ?)/5{,+mD3G43ǏzAak,7N?a5k͓wurp8;LA/os~GAB5HĮiGomJ~w=(~6y"Ha?t.#=Yl5h )2w/G>VbVL)_znڹ=C栲F1Gs,_}r[ty^u2\XtxЇg)l OCr6;˘Ι9x K}( avO]$eE ^m-hLKA$o|Mns]|$x:}x_rlŘapJԸSU[HǓ9^*O}LϖqsWFk~&(:;ڝFb3 Z\v·ׇ+vgǰboic &d,X^5Mg2T5!xƎO4Ee0hh/'1dRTdc.M^C^hu0#4Kz^ǰQսN-jj$Hy[!k1Eu-wr}3?G. Lyj v-GR#spTnts 3daᅞ`:g%VU_' '#:[ojF0{SƏ?2呶Ѿ &Jo\Tcl``68HS7/c1xrk^@g gJb1:~]">XM\G s=;Sr4ؼ`Z#c݉BirVy;B_' uqme#,įwk2 kd2ZU^Ҕ~L4%kIw&9}~J:W=Kq hr2l5uVjLm"쌛ēh|8M(fK֙ubd5n";qS=XͰ?*kIl^~&/b\I][k[i_:zcM iK޵W wXˏRW7t9*8}tys`*bT_\>˅9a1"9|}sqDj&i!q âcaj(Z<>/i~6N!9JyeL̜^T\=NMv#gӾH,Ƥ]}i`.FjhzM^Yި^'L5$ߌe5QM :–;\ƙCգY׀*wmj v-GR#sp„u]&T\sIz4ZUͷNy,|lCBL^LJ?pGfbGv>0ޛ(qQŲ۴ eN]o{K߼DP˭zvdH2_z|,/\˅9a1"9|}sqDj&i!q âcaj(ZW7?{msU_??'Oֻ>/?9h|.w4o|<+ou5chߪ~]U/Z_ l<Ung?魴4JF=Wuh\~ӿ~c;&0(DqT@ Ea%rv[v~ʌpW#}:cK|N”g%Wv/ ZqVȧD3\n*#e%MwD`(8( `[etS*ԦApnˆ32:T@ A?`V8uh洙>|KoVxl)-!Lt˿c,_ug 8^mk\&%iPqW ]oAW 7׍_}ZgWw9xyϊݷf~'K}w>gJreT L*\vo[uF#3KgGi}p3JӶ gN,_[t4l'ViE,O}R6}e2Q7SI{v\m+c_W')5 7$*ҳ5ގ?_BQ`y`yXDo$Wݺ' 8SA:dW|ѡ"8&o`YZ[i.9/VhJ}=OJnoOW}g+.wy~%rƌR bVZo^φ(1Agխ }j,_gE]=j]?fnsIݐJ˲Ol_,B.L;`^'qc8JMz9^J^ZL᩵XX.Wݬ7eEzoKcE۲ {T^Y-Vٸ南-K]8Գ>t+//x~otK6U"Tԭ!,2K&|d5,I}nJ,o${pub}/],oV [7F_=X> ԋkfwVV>~R)yɋ6OƐ$'N'RBZ>eH~WTTǁ3))z,/=iKr bDҾ=~oʫ~[nWx$jKK}vܮ5Wn(5]HG<5nye륏7=Q%cS|}uz7Ͻ/M];XԭJc !J"|3ᾫOhv(%ʋk|]!zIGŴhqogiF!_?xɥX~,կgO?M`JKKgсݪznohomzkaj 'oSX$EO~9E7]@| `𔖖gyI޽kkk\^^.Hq]t-x~Ԅf̘1N5õ"p ,?XLkk+)ߟ< ŭ[_xqGIIIIKKKOO/..noo  e~iĉ,Ow;;斖6|puvv7oѣGpرc~~~GMF6<9… ^jkk/&zXLF"<_|Evvׯ[ZZARR466*JXAw.(( mP(r;wLfhh}bb7o`y,u2~'#׮]ۼyɓ'KKK;::Frtq:wh4;ړQ<Lj ay`y=n*hÞMm&w,5#̚3m^|S߼弛vyCs r,)(^kv5J]M:o]ly`y0ڋs^jIҊvan;}ot.ݵ?ŕhg[59b9r-qc1ٱ2rZGM+,bņK*wIcތl[ނħ2%\_2sY;zezW]]}=.EIՆ`F"q'H.͕ ]mqVSwܬm*/F؊ο.mVع2$aay,{^Vg dTm1RDvo;oʿ vw[{]Nch.fNnK2[~M'+(<y_8,r=Utu7%:KLb3T?)n݊7wc!X_ݬ7愅;#/f3:J'\yXjc.nc^js7>4we!xۈyW iS<*);OgH::1,f1ۜY{=^ ՚(ʍ)<пO~{ U]Je"{\Q$gj[.k1Sp `yX˃"o39F#Kq6mшi6af3-HQ;Ye木ѿ.+U˴wq\ӌ X=BbS BU <X~6`X0Q,>#Qo/wcx6L ]9~׿b}Ư#Ɵ|\w)le#EUeCqB8;17k}@*8q\ky8 1VK9qrkR\ESP7GשWo{S,X<,XP `^cҔ/|=wxyaO`(hy%ojβn‹/<`iĜXiF3Q=z`1Mrv04V5<>*h+ۖ7_@xS]<:x7tbi˃Z^Te'oW'NO ;WA:$a紴oxycAzzQS4+zndNe%q3JԅM\2X͒40w#&IÎ}i/q"d5wq~^(T>8Pe$Q,t< KK?1MKYcՒWg*0(z:XPr+@E,Y7is7cI;$+20gb6D4򀚮NJHwT2L2\x?~C!5`J_h-Hf^J(6,Xض)oOז63xSe>ӒړcZAheŝD d` :X`yX,X<@ݡ`y_:_,#R;aVwJ1NP EBfݯayX~wjCB:Lfe~ /=})hJ[(,Uj912]څX՝j,<֝W(Oݵ("NPs7Ϛt<E8oJ8ъj?Sn:j2v\DKncX^,63S{ eݵlY$r XWd9)Jb75U#8+5JO4ݕm[TT˃y[X _z-^& cf3 w,'m\!S(+Vzl+sfm\Vy1Vt<`yGYTOi7. <͜D|6cW#,OU5j{+mVع% Ә>՗73m,3(D6DUS߱픔M$"#N+o7E k^ǘY\%S(ܨU(v3zL-5)~ <5Yޖ>:nzY=y]}b ouQ7-*9I&k*{u.l3u`yˣ`=1 :Sqrհͽ UCXKM6}s5Z)$zf=ܴ)3ʥ'g1?9@Egͅ.;qENx%osXP_CJS"k'm,O3j fˏ[.,9s4)sE9 sj>V6e.`fRh['UB[eKjCxFj-G,GSo!`QzcR$+ʖ`,լI1;^ݭ9voM_>P'U4ust9+p6=t-,̀T u`y0JP6lr_|`y0zP4  ץg7,XpyrΞmp~}g<L6d.f$ rV5 E^W:.lXs Q gWr-qc1ٱ2jS&[b`u2+iy[/!┐935- Vvo'H.͕ ]t|,byp[&콕$vU8gKfl\y2כɫh.fNK>KQX 3϶zO2~a.6ӚZx7z9ꨒRby'ƇX2|YpH06B]eY[C|GWnLy]vʼ&Xܪ.Cr~={Ejug)*<;Y!9'jy]M0>2'jbP܍4w쩒RU`y<`y0~?g$ endstream endobj 363 0 obj << /Type /XObject /Subtype /Image /Width 675 /Height 562 /BitsPerComponent 8 /ColorSpace /DeviceRGB /Length 53139 /Filter /FlateDecode >> stream xXW}{o&fl6n%m" q-v;vNs@nM0`$:;@efۀq)N\3*HIBu_\ôssF73sf }yO1\^ϿFdG|3_xo]rU[mݖ^eزz[jnkؚ%;v3r+H[?VX: {٦l^q^^WW ٫m4{׬Z+McK&{͎ںֽ͛l3؛^7[z{c2ۛvaۢ [m|g ;ܑBem ]V|˺Y3JwRuu9~)떺z/B͟f8!c7 &dqni͛MCCjl-[Mu"`1"v2KBfٚC PZ*E[kl=П?}߈_|?,\63gE $ӳЃH@qaiȼX^^Lۛ?9nc;B9\_zЦBbt9._xy2m6.s}<==4ЗW'_iNh{|Q b49k׬܄-5h=ڊvCY?cLٳ\P)e2Spq3 ]؞,q9slzLYGclwJf7+ۆ" r9--5h=ڪ6B< 'ɤyzwEDG hA=uxX=s m3r c'F{,X|{gugz}Lr\&-c1;,sZ\z`lNDkglq>g|&zI]```3Gcl:_y[?6}nhjo77y//www"~h "B  mD{O1?o7:k)e-]$;yB\fz:x1@绥˃Ә^;ܛN_k n~~S؝m^nW^tc<]vWidZEo6wI^```3=B0o\uㅶl'NN{/&!>o%'_y_sw| >Ld5%t7z'M`It7l=ٙg1ai s\hlo7{ev҅ZA{ Wм|=<Φ4uBO/B]vGQ[8V2e~.i9s\\,M1ve&x~|fLٙn8qaKF\ qaSU6e1k貑rvTPhp1M$zwO=G~rq=|YÖxx/9L^I%Wie`9;E[b1 ,_/?򋏾#-5h=ڊYb;f tDm:~R?6mf4IhMKx||?K9mJRl&ׇrvHA]+uZu|_WC;iXJhlVbUXwwvvkm)tɤ17hMtW7[I[n"ΣYLfaJ:Jݜ2w&ѓGgI2r_Iͫokut+Rvw4SUlb {~YL6)0[ƒƴY ;la K_>ܨ#knn6v{S]6ݗ7ߔ~㾥Zn\FwcYMi~ [UlLr<=遁ݭ=j`혛k[νyMck]UtW3;H<9v^ҭ*$[Q;g4KZ1/lE.u~#>szRQ_ގ黻flצC}LӍ2Þj !i YLw#m̙Իdui+ Z5 zE=Z#LLu\գ/`:ڥ1O 5#ٶǃNs:3lrFvvo͇<>.zm+Ͼ߄9|:A\O?yo>];|هh;nF]ʩ"l)bt]w"uTelp1#/m˼R͝r:7WWƪv]<?ӕ0tEi ouz{XNNt_R/wqQIө 'ރ5b+sS:)72\=.[P;ů91C$ڪEo̗PsUe,˼D r3kW(Agnٕ'0P|szˤ&鼳3sS5b=%7Wq\)3̲׺͵\]F7tG5!ݝsnpsa16@?6rؼQtvՋm'G ӋfzWwtŲA<:uo/y.Lnd9X\L~w```wAn|Pdt {VoՋG\# 9^gQ7-deѼm߶o y]~Vk*b'˃`2- 3݂4sj045l20Eb8{{TN.A-6ˋz[Ђztww/+t5ڍ(I #j4c~DƬyMy'gUwFG,O2eQ#@.fP4w{;;3Űbtl&[yg6ɲSb43#oO ,Q, ;N2w09rpɭ]t6k]kFгl9kZϞZ/dUɇ^x}w.߄A{"3^];ou{Q䮏Q<;Z}О n {BP4uXLׂ՛?ywflnͣZH<ggM":gl'ƊZ!QؖG=ՕlpB\ fR\?Jc?s/g*zp<qŅZCۢP&z=ᓣLY'1л4G|bhtgt7S)fpT(!€:XʜF<t9r+)YŴ=Zn9KnT9YV/u:kjz{y2m/5ԍE\d-+x{A&ܻqNM+o[>==Q,[l~͍oZ@Xޛ/ZFk7؀av6OwW2|TOb(s-8ɰqJ&^NNh&ZF5cuIVC`XDaSJg1oCBHi>v׽E95;}λh[S Pg憘5Yaiqߍn>ZGV4XGtuaG,{l>л^.6rĠ,sEqQ`0At>ln=uw\: ulRy:KMzfۆzO7WϞZԉ=ӧ^}-+/Z ꩢϢv'Nsz՗x͛^~Wk/ZFkzutߞm y0]7 Sre:ݟpGw.t7Sku8h46ۢIt@ %aq;r(x/bsߊ-=PEgY>e2-^X+cޛj I<̳>ilFPJED_zq9S2?(=u~}FPp8#sWfwquaAgV#գ> WmTfwayz1AOcXM}<%7`[ݭ]R3͎xc' b=jYL /q#5: ӾNg:>'N}BɅmb3ϥ82CtݗOt;݉5n,o8l!l8#O;,vrqqGk5* :m'uV[+ -7=>{3| / >,AwYb񫯬}5/_7֠(uw˝6`?'c0\|?/Q 7t\,=۝1zhNs~|'CG2Z{cyQXuoҥ׮]K+_isP*;`??_!"tU/000qtGۛB{O&͕AwBF2ZӳNjPFw棧Qѻ觼A7l4}949Nt7(000(v'7{{ҟp```````2=YL3#]fAO͂6Lz000000lj@3Qz   f;>s:mnŝS{-kcϗE(yIhYw}k0&9_Ӂ·?,%-@ t5ڃN+?nw=kTwB~vLU3a=;ۯڴZuG-;1X; 3jeDK}VXGEiY=V~f,C*.ѣzt߀sЂ,mbP͗A c@\3Z^`ch^=;2]i~tn+=;yaUcn?jzα@oX3; X%;/?z󶽇\ZH\44Nз#GF?>@z)o{Uah?_?!=uHyO;jZΉz7j園=@(ăd@[wt}uߓ[a@ hfiWcuNK]<_:2_#k-GY+zh!&PLm%Vs:я>V~#clA  ]z(hF<`n ^3Uܶ k9{"]KW<Gw8YwĽOoNXGCqr|vg7eP譤EX=CGߴժ6@({v6Gˏڜhc0"fy+Ώj֬Yo\uo--kVo՚6@VV׿5׳U-%5fx =A @ @ @ @ h3Yz@tKbK^czg tj4@ zh|2 =Ѓ@3?v=;EMx[ՐFqnu:- SNw pI. 417yPGNL<5Δ .lmZޮtR,7,>ЏA }v M#GA==?:NѨqL bkToZȫ2#-z9ɾݤT[eDM"_1COwi[r"懆eԣd.󥽃KD8F#=(xĐ]'+Tvide)!|R6'j]ZՐ+ t+zSZRKڮ.usN HJA ms²$ڦz|sFs"r'EQsڻ2BcVai_ῠ~|5Ovt4p2ζdslΒO)nD*[ "]~\/K27pWih^qBŇr "b)YM mA=[=/OXR0%u fP,rU]鉻"B z%v0o(+[28d )ܘR4-!F97%ASz߿Ѓ@zw-" .k sɞd;@ADBzzNjԁ>+)~@ #g b У*r +1ηht! 4e@'sRl*P7CKM3蹻ˉf(N"Wb;-"jYzP@/׬@zt;чfIq#2{.~gz^ k3 H'J }IAƍRxe c|]AdrPΤAċu+5Wz,"ˏ d3+:rMݒK`_9*NGcZ-!p\Qw0. 4? SԢ: LgȔ552 Mvu)k,p3ɾ06'y`N~pU:েN㵩?nTPgq~$RԤvwy)by,)M.]c~@X&gL̬j]IqBiЃ@;n @V#{z0 GhFQǛ <@3s GhFQ~<_=G_hCH#/[@yf$WX<@3kW/Ѓ@zhA zD/Ѓ@zhA zDW_^(;EMx%ӷ]ĦsQӘ.7| FQfA tQ~ӆ靘xj@)mKO:ntakCFv$H8 3 M$tQn.v:t 'ts"`:~F axB#ʿ&fSi4j\%l<;ZNȫ2#y'<;wԐjyIˍ)l'.腷XLmgGN{Bob%Nè>pD#:\pK#+KPoR6'j*DŽZՐkwL)m]Uq<@oms²$ڦ_Fs"r'EQvsڻ2Biަ}9^R=E6'8ےճ9Kz>okYl'tq8/7l+:'Dِʦx 4Qw߶ z^\%Q$}0%u fP,rU]鉻"B z%v0o(+[28d )|wnLZWr\AH(sBUkЃ zD&靪`Kf骋Z\j) Pw^Z$A8u 2 8 džUJhbn1O mVo.HnJyEnH;dH =@~m=7)61a|>Ь4hk֏?XN>ZQiV(c/FЃz~A(<͒t54 Fd\po֖g O-L5""jJƻ=I>0 {L%5+ea]z`sN{S*䲆!2eMBG]]ʚ,zG1 ͉5vƾS. EEU!5顡xm*5'TЃ@zhgqYeExA[I*r%u2 T<=m,#G z\R8""NNVI W5nk=~Q>*"@yA8֓Pcmr,"Ot[3 ǻXq6X/Z?ցSa~^Ԁp[]aG <'wqisRBVW[)1]}+Cf譮'q(zD=q1z@ zBX"nJrX[֎HA^~aqcQ֣{7xC*"gc ǻԨ]Wk֬innO'%8 zNQ{i?\oi-e P_'Mi/cM\2 ]W׭[rX&#ʧ;^މҶTF6dM-oO؂xӤzzĜ @^>6mjkk5OSn.v:tҵ~d @'ƍ=[nmooOEvAO^hԸJ^y`w1ٵJjZȫ2#-bTNxz5vd7!VQg7|Kޒc1a9 #FK{*;q Fz8Qh!N&WPi4 &nspbQ~X*V5䚦+,!ZR@*@~By?CD2ݬOs3l%6e4<5#?.2ݖ8{x Ji YۜlKf8W,D8ЄBe>ATˏ+eƉxa4Xq4aL>߱BA=NKK}#O;wi==*$(`<^B]w> \I XZ+";.tWbMf*qQA*#J)SъC PˏXDjiZC^q>"_Ց w,{}PTWWX(Jzaz*HA*zab0iJ63D$ᤖh+IN賂LȱavABSztۃU?'HnJye~&VȳCS =7|sʕF{AAAh4@'Fê C:zx zranx;^초eA}pf27<0Lsr}W躺pyPTRRfŊh3Is@OY|0ĎQs;{½UX[i@/<)0VZM 2nĖ+cMv3q(LNʙ4sxq0nfJED?t$Ql|FVCb%1܀q>(]@zџ9sfpp>>PJzՠ_hQjjjssD"hL&s---0@T(`wb~2z zzzw/[[[zݥBdGQ<뇟򄄄W^y>|XP@)A t E1;ZFpG>z@w%;EMx%ӷ]ĦsQӓ.71I}?WM 3N7A\?wFD/LSLi[Yх aSK۔.7PO#L,Ws# =„0@tӡ۔npFfD" U =͠fSi4j\%l<;Z%5RCjUSqӫ}'I ʈD!-l'.腷XLmgGN{Bob%NpBNZoBe>ATˏ+eƉxa4Xq4a~;1Z@ ==UIQjx} J廹An8=qWDwb]6ATbEU2P\씩hM]H70T-scJҴ Boju&!5"z@N ;UT UdOOSٝA "!=h 'D[Ip@d8p@ #g b У*D +1ηU'kN1MpL sRl3P7CKM3蹻ˉf=於\D vZDчղ n?psxNvA>4K|0ĎQs;{½UX[i@/<)0VZM 2nĖ+cMv "r& %^5t ^鱈'.?$ʓjH$H?W.T =ЏǴZRCย`\vi@+-ޥ6'xOQ'0B.k(JNuN.t4եɲ Ϭ'zjjڄڜXlwjЅ$JA40$?=4tMq$;c #&5 oKcIQ or[FP߼ѐ$h+S+:Z4 >Qm8pUЃ @@/*iVQAH$.mQAz@Y+ί􄲵pXW[5.)/:')lU(Z*sJ%+h(׭5vj0pҸ%B[M@@z"QNYFXV] .jS.o))EQ?BtNP#pEQ^aYc'v+opIeZ"XWu9 %eyRzz=}Fh,9C.o,9܊!IɫZJU(fvҎ2(Pced$zOGDO%ܲ6*S]yzs5*1Iy^XᜢzCCbc翚/ЯW44*#YOA @?]uE*.+;c"u{ ZJsP>~I@D@zt^MZmU Xζ6XGlRO0)EP.ʦqޡBq1޷@i=5d*_TT@UU䈨1yUmxCYQa}ZYX+$zЃzT ЃzQĦsQ2vTO)'׮;EMx%ӌӮەiIP+@qL}Bon.xsc eCOwQ|P0Z ㅣgVF6dMQ%ڞ)nw'4 ;1Ԁ>8Sږ*]R.z9 s SAz#>)3sp#y64 ۧL;]gZ%AzŒ5=u|dܝu2BjmFVb9_0.'5jU-IURIHw熍<'8z瓚8OՐk)l'.CH 5;s,7:_;xDTىcNh4ÉS2jAW;+δ &VIZȫ2#-ʐ^;MjHUF$ jF[r,&L~mҵ_BX{c@A(h#mOEO# -ƕ.$kSs+~8;:HV ??\y`Ŗ!"̀V--M%Al7(lKf8WϪ,ĩXN%6e4‹<5#?.o rڻ2BK^&mgà|#Dk'@-pwUyQygA`PH E*;e3Zq)"jyËz~|Pˏ0ƔiA!{RG >%v0oL5UIQjx} J&NqU]鉻"BP~dМAe@yJ m}V 1|wZc}LXH.ͩBv X19bgG,Sa ȱ=UveJ*[t~-a.5d :Pw^Z$A8u_?tǬ}j!0,7=4Qs'> sw {͢cK#_rskHYtJ`EL}X-K $j [R]W[)xF=ʺ)vNa|>Ь:ۯIFkkpz@?b}jRst{ rx/2 ^1tpQYep^BS"-+H<67D& L:c=ggщ<~|^!cуCNԢ*r#EMj-!]xc^4 b[$0eG81 ^lUɑ=s$$Ibf IlPŐ1|땽cCRkCCTj 7*O{y Wn^ 5C^iWPYJwQԢ: (ix{pLYS##RdY pG77d__VcY+UL~;R C=}Uֆq֞f -ZRVA ЌoT6TMIђj$K{$.g{O*Ea={@ϋ*+]G7%oy;j߫qu:QGΐ-=A ˨SljkT Ѓ@A A A =A =Ѓ@ =Ѓ@ =K@x"FM߷G;Ls&׮;EMxn Mt ժ꽶'7O(&3MtֽU-jF6dLGEQ%ڞcd2>Os~0O 3m[ەnwWs' ;(ʕjz4A0re[6 h@zGݮtr3Vzޮ8z2~@~>5a1 壧1̮* Wk4Lߌ5㪖Ziȩ)ݹ#'|'jK\1D%@pH)!{OfGpپWvFK{*;q Fz8q@F^V*yg{ݙd*պj5=ΜjdnRC2 l~B&_۵?t׾c*^7$@f.8Xmʩt`dԸrŝdm~ rNprsGت3#Ǖk2TܰU8z|[ZJ# ;ೃ^ٜlK,)EhvEOAωȑhE9m!%/L63aPJi:YO46kRQwWX=SNr0 @?];{ՋΣ?L\q厰w0lOn׏'_goS~%˒0gܹs_ 9wmZAoeMŊd(BS>g|Ww[`bdE}`HGpcJҴ u)よ^;l7S9%S*zYzx}< J1 bUWkqz⮈ ĺ'_;?tǬ}Gj!4gPj;FZ;}.[zU'~Yp3xl+7bۗ[ŢoU|kmw{H&޼Jw^yb}YA޿\%|\}gWD+AhÃ6xK^Yм9ߴ7AzvKܞ}/]t\޽cݲgvdraYtlɁcDKN"zns <˘N초eA^M{Kj+1h?GYW5i ^[~XCS|߻.Xd)˟xDk7=~z& epnk 1_t{;ֵ%,;sαW_s;V_dٲ% >8E7.97ok׿;*4/VGE1ܗz,ү< l1xBنW,[<{ޫ!59|Mگ#;P-8W]?f>u\-rG]&sBWG[msxqyfJ)ㄋ:Ⱥ0Ԑ}D.kΞ:i+H<6hbǍȨ=z*-4 [j|+-DD&7 bKfƻ=(7QJwE'6&F?j[* byeBŷxآ\:_Vl8k$#˝6*-') I{795}8 :7e⌎. | Q` x K=1sx-7.+Q[tȺ6PR'9c`'pȎ|TZ7DC7 {YrnۣkU75}ry|{pt|w9QUgG^TƳ˃\l~7A{uYGѐD[QBPȱ 'HjQQdz٤֒R݅7楈KZiX 6jISvԋ:0߀V9 $Ik4\7HBf-t]Z:צRQyCŦ]* 6WQJCย`\RZg,iVe EIC܃3dʚEUEW&b;ɬ'zjðڜXTwڟ`kߑZD髲L =(k@Lrhꔖ5]U"ˋ~ }EƄ^C5_;_CB/uE+>?JG͇ u~WO}lrڋG K.-ZDt~"-xa7e4MXv‘6ԥ7&ԅ>^F! ܰdKZ}MHwwn`iU-K(CIyG0u R&R6% nGKj۫K,ZLOI(3r A=v #+r([ m,]"7f/uo5 ;VVze|%i&@ys2 =o/.4&k3ߟ}aϢ7ޘ*3kc ZqYࡵKGЄ"1j_C4_C{mKvwQԏרtAo옃w|jӵA7S߇<o+7zr:.Z^s}Q~tx+3z{kٯm?zZtſy[oI>/S=$@W~5k֟ީv\q3S%{7m\f8 ƕIs\ߜ1n^7^K(ic@?tǨAd"?Y{.f]r[/5M=u<Зo~'kMwxkOgW<)~Ǜyq}~0ejc-[XwԺW9,K-[ !W~xw/,kZZH}AdG??qqE8~;j/ݸJ<5쳍c N> zӬeZMHee; u/1=VYޱW|I(]J_0֑9eub_Fo_?oђ%k>˓,볾.&n]hZՏrxê/zʯ z,iژd~~Jkɇi=&*&wnt|7svx覤B`܍Q 9 gу.X":g-ҽ> Z~wWN;5?BeN)}eq~@YޕJcWծJ/a^S?uf}=jH]z@.پj… -b+*=Ѓ@z=Ѓ@z@?SFM߷G;Ls&׮;EMxn Mt ժ꽶>[ I*iŵZ$9z4Ao{5Z ㅣ?΍.lmȘrJ=է褓y뀄靘xj@)mKޮtʎw; ^LG Ua$@ftDo9{]2B}dϋi@;2]tvK͝CiM[Ĝb}@~>5a1 壧1̮* Wk4Hߌ5㪖Ziȩ)ݹ#'|'jK\1D%@pH)!{OfGpپWvFK{*;q Fz8q@F^V*yg{ݙd*պj5H2䄧Wc'NvR-o5|2bIvO*]X-:"87@-#$@~VD`G6+'Pbj\9N6U?9'8B{㹣T^ls5xq*Vn* V=b>z̀V--M%AlNp%Su|NXx}T ,@hvEOAωȑhE9|{0(7Hd=ڬI;F;P ]m4ύ.Փ wDz@? &bEU2y@T)Sъ3⫈Zsj^_1x2ߢ>0T#{1jiZG޺qAQlO 6)nyqD,`<^B]w> bIHӘnt8=qWDwb]ʯڟLc־#3LKqNpBAMA D6@UJhb@TM0Seg@roNZ|XUe8&HnJgk>;e Kx@M)-ST.k sɞ&gЁ2m% ©ڭɤ;f;P ay';uUЃ@3z; 2ww9Ѱ׬@1%'[=7heL vZtчղIQ& %ugѣRl4P7C3+ڟdDo=/LY̘qp"Qwz4A _MjuoAQQ\S+=. ORCUKh8{KN (O6> O!ndAW}H槛7[7HY|0ĎQs;{½UX[i@/<)0VZM 2nĖ+O Kw{B9?tǨAYtlc-Ce q muf0-ߣhH(!(phjtЅ$J66HQZKjHmwޘ"&. h%aB% LQ/N~[wr{Ϝ=mI%IX1E4m1{ zei6Ǎʓ^,6E4ŕWFc+ ㊺qY*Ki.4ZTT=Z!5% qΐ)kjddwU]]ʚ,&Ѫq :ksbS߱jگ}GjzE8چkҐpn@)8KecZ`H۔t["+^_dwz?qfB^ =/@4v~PXpEjDNjoxqő3f @ps2qU; Ѓ@A A A =A =Ѓ@ =Ѓ@ =Ѓ@ ĦsQ1~ю=S<ޙ O]PEEEQTܗZ JQYDEZs[{νO D<ߟӛL;yNWd<,|oαEa:vi-?Z)KKv(jZe-iu~@ֈ^7=Ӽ|{_6g8S;A־q޶  z^$TCKvިhCr>Un!w,iVsR~HY޼8@muїgWiLΙ@,pbtlsD/i> MK6\]=LaOvP!!&tz(I3L"ҵ^nW]8Iw֖+"D3;%n>㫲KQ3UD'oOD vW_u*:yFt'IDnj/OJ$ŭCEYzU%dGEԎGrLڽW֞-zCfʭrz}6{S?^wA3z ({I64'z# FJV $W};[pox:}Wu=Rrk%!>4 /jF'.i 㫥q`yB1lH ZpocÒ։V{%{r^POݫGOSdEQ=o2ڻE fb} MNfhFRxu_u@6ΦZlз?9bt1qCK~Cն+v?uT ew|Ռ5+zjTz'_nöqr?NBЎ`>z͐?/)sKc49kT[֙c|Wo]6`;t{~SG:O>YlA/x=M3VQ]:a LzmvB I{#n撍Ֆ0ɲ nz=?WHP${͵E!u,Y+kP|$._)5ɟ~3o,D\h >'=Jah:.?&cI"N8ET9?ϲx?kQzr{_N/!]ksEhs[2=9k ˅կ1֮Q"/M_j0xrqG zW)~ ˴9zqTVO1>T(|?e D 7.z0Hi7a|۬D@ zуD= z@[7=Yc#`Ki^INWd<,|oֱEE*%#"! zLыϺH /kԎv/N>ۡi͖M+#[#zT`L}rОz쳚(>@.=^N7IR{_v ]fD/']sZr'2mj=@muїgWiLΙ@,pbtlsD/i> MK6\]=y4":rX)lwN 5/bB4͟t r,]+khx8N4}gm 븂)K=S"ѫ3uh/K'S]g>4 ؏;VA 5ڽTҽ/Ѩ_Xe6>ΚU zeoC:C{Y#_yaTk).gcζ|?{Ԏ2AauM[e㹸UKTFқ;xT z]_j@1nMDSu_^/o'"z=y{ ZWBpu5Sq#L.0Sgai&x+D_ՌN\WK,)bِB1%V4}J~3}0̟| 7z"w!>&Z3z{#ew@)ӥNќshۚZ5*znh{3J蹦c-U` y ^K +84m _#zcQUdlX1v}3[!F7G=d:]mkr`Z(Oտ͐[6+q|Wh[[FEw6l{$s$qbvLk|9 Mi[w]̹Xڲ{5hC+9ۑ[*N=ҹ|yeK?q@z&F D+z>zfȃ26}{wuAr(6&G%)ի- aeOV^ {~Z LHkCuBYVR*c;+¡H]>RkƓ?$fؾUǹZ$A$}N{Q8i,¢=Wd"<⮛vvbL&]t:s/7SA'Z=ĴjP[-=߸d U1߄moV^D= zуD=@DK*kKn|g7|-=0:?{{%A;]!"wz^PoZP8*]'YU }U}k>w=b q40m @KD z=A= z@{^e }ɭ1UƑo4Sgo$h+Dn2U ~J}rU>7T"$ugi 9^|=EXx_v{iwEMl_E7m^hq릢cokۆlg*s'QZʁׯGtC$e>P蒝7*ڀtk[ȝ0|ڷ=XiNjQ>R1*8)9%L`lmE3MG) 4v}F+SG"_3s u9LPI {]j^:$37ĄNo{%i&?ٟ@YVע 'p i:2qSz&zDWg)^NxD1:|i*#w*'%k{r{_^/٫:GNM}E߆t,F|aR*\\;NJ)m~<^eZ)ۢM>+j{i|"=}ɲboHDc4dYfjggOOG qڊ !wrvr&N葎ɡˤ_ f3'OB|jGv0A̺ʭ2z\\,+SH q8io}RS q3/n"ǨO~o};Lѫ½ݕ:kkEarI[KӺ_R-IqAQ^5x)QӀv`C6P{%zr^hަƤfHv4{HfEY'٠ӬV&nx586Y%\=zlI4sý1RjG|U]#,Vsf"BZ͈jiu%PL6~V;ꀦu^oܺ/oq{L̴a 7z2= 79՚ѣ/J./vt礼C֤֪Q+tC6?%QzF5 nBm4kΣl@xu_u@6ΦZlз?9bt1qCK~Cն+v?uT ew|Ռ5+zjTz'_nö}I.ء_}!/~0_HS]izs3i=)SlvʭEt.|޳Jli|iуx=M3VQ]:a Lzm vB I{#n撍Ֆ0ɲ nz=?WHP${͵E!u,Y+kP|$._)5ɟ~3 Q8W+$d`ωs2ңr+,sN&b!Xjg'd҅HS;NQ;r3dϳ,E8Zԭhoo\ޗ mHZ+>Xz:Wj) .,~NktԶ_˽7m+ \Oh @蕦D_}޴9GH tgUj_eߚlDE&b8&oc}== z@D z=AD= z@^WYC_r;kLտql9+ V{>Kyljd tlcDE/>" ,ԯy|P;ڽ;lU6[ίޢ6Qgn 48nuSу1˷mC{633+ƺE%:=^N7IR{/:BO^N-Ne>۪MuNdX4v5/cϮr[Ә3X"ŦfBo#AXxqxd˕#ʄoκ&(ZlwN-bB4͟S3:KJZ{!=^uy$MGY[&B:`CDHj?E T"F?=?04C%cU%|PDMv7Utv7{u4ZH Ỳv8v{DJP?W^=/ZJ˃+btX19m7ߏOR'_ENQUMlXQK+KD{ E"A%2kU3?;sxx:>bpFVp!gg)+m+ˋMLJ`0s0Yf< }ep93F[*Nsq髞˿îtD z?"Ph-.oyqTVg4 /jF'.i 㫥q`yB1lH ZpocÒ։V{%{r^PO#UH?&cYDĀnCٱ}ȀpS=ڽ;RbhN9mM^nB7 =nSg\ӱH*FJ<yD/M{_OM3Z% Z3vH,u" z5G>xu_u@6ΦZZ{۟YADu /QNW|%mU ew|Ռ5+zjTz'_nöqr?NBЎ`>z͐?/)sKc49kT[֙c|Wo]6`;t{~SG:O>Ylw֧.~zPN^,z>zfȃ26}{wuAr(6&G%)ի- aeOV^ {~Z sMhE!u,Y+kP|$._)5ɟ~3 ,qV4ItetG?0VXjLvB ;;1&.tE:qܹ s~e)֢nE{~J^hCֲx\c9 KGׇHѿ:'V#tMapag]E_Gr)#zi1z6T/>J tgUj_eߚlDE&b8&oc}== z@D z=AD= zC$z}|'IVϟ]տql1>*kKn݄̓vBD&Syg)W5|C5SB+uv zZ(u5\z_M7=EN~]2hڽx\}? o'e(jZe[}Aw';k[ݭ}-$;TftkP~prGDrX\ ɝY%zs9t3xrBvP .yU[^N-dte>$NHVxÎ}/wڟE_\~#"j')`5/s)YEݟTΕ)W2Jd2gevMHky[-|$" /Ocחlt2z$53WNΥ&:}ldTR6gZI\v/Dsǫ.Oq;kDVȩLX"~^mY:=Cf~ܱd6i/9%NPlmc3:qIS_-γfCo uǀc~##.;$Xy0K +fD^0~ EY>Jm?OF5hClvD7mܲC; jK^6:bT_m W~>[s[FEw6l{Z'Ht) f* yr@8<4JӻsGe9~i۫0ΦZ1{۟Yьr~}#'JE?H]2Iϐ4x{M:0VB;gleip}jgB Sck 6dϳ,E8ZD޾C\U'vmD7r@22 7/qEjxϿ0-'uqs$2$: #0V{saE!uDUowדD z}#3LR8qMQFD z=A= z@D@ zѿ$Iҧ_s[=oUƑo樬/u6 LR{\Հ N\a#&3ե"}} +Gx+?Y6XD* =p'^f4VlEoڽ;i@^֠qqwkD_}rОLea:J<J\HDߊuD8@$a 1%`xJBV}%;oT!z9b*;ao2W;ڻIK I zѷ$M#uU ݢ'Kij ؘodq\DMsD6-+M-j^:$*=. ?۝fJFL,{Ns-oCSA`i.WjWDf*IݹbB4͟t >7{vU3d$EU'N8Ate"+d ,?LND6S, V/~z~ahJH>qF3E;gD Mӱ͑zM+z^:D laV S,|eYf-䓞W||SFcGW9mk u-gwS#:6{x$Ui^~U3de3xhg%V53?#g8hmE`wrvr&N葎ɡˤ_ f3O/D.4wvd ̬mo ZJEjm:/ť"X4/ >k4@Rapœ>7 oHhw%DBNEǵERҔ픧~)}X:{I7ʾ|h^MfrI[KӺ_R-IqAQ^5xq[QQj#L9^+kOml *7ͻ)Kc'֭oAu{_N/foSchku#u@Eωmxb9{#z --zk58& G-u;Hg%V<}ylF'.i 㫥q`yB1lH ZpocÒ։V{=$tՊ2'Z"/oZkJB8!*D ZD?ҢfO)|S4{~GfR} MNfhFˮ($Q͈^nB7 =ne3zXhvKjA%XCowe<~`mhbF/2DoޫT`2D ։^0~ EY>Jm?OF5hClH&!lPoR 1%U?!j[ÕֺD䝛Z5*z_aӂ89GK!vhd0{Wyfȋ̗Ҕṥ1~WŜ?-̱GKm4^q6ERC̊f[\>g}maGտXzT z7)@I?!O9IƊqUhL8Ml:MO-̰\R:a LzmZyYKqw}?Ďn0޼0=Fξ>ԹƵY,ːx(:gn~ZY΅= $#t}VVi>qGŰ_?ӷ qV4Itd+=Ji,¢=Wd"<⮛vvbL&]ͤө(o]U(ͤ78"TXҽ/ڐ칷J(vUyV=Pqb5B Vf:5Q OS=rb"/>PoZPZ=ui-Yՠ]OR=A0Hi7aDVD z=AD z@D= zуDҢGw$I~myUGMK_7T"D?O,0tø}} +Gx+?Y6XD* =p'^f4Vl9znڽ;i@^֠qqwkD_}rОLeJ‡!]Du-)D߂uD8@$JS8$arg) M[mLBQ<夋}^BYӾYH qXZ}K;>R[Y-jbyHmZVZԼtH RU$s/zDg]u&,;'^wYpٽ`gZ[H04E^Ʈ/revHkf2ԝKM!&tz(I3LGZhU^nW]8Iw֖+"D3;%'ţh +\OiˈgH6nSB"Z!Xڢ}biJvw>Usk_eN>SEj{tAp/}&3N$ȭUMi]SUyȠ(K׭sӀv`C6P{Z1ַܺ/g1)=Xܧ\D_sF)'>jG|>ZZjqL0AV $W};[wjJn$'x،N\WK,)bِB1%V4}*{I64e7NDu{_F/( 'j9Xr@-}ޯ?K=NsțK] 79՚ѣ/D;7#zjT Ъ/ʖ蹦c-U` y 풻CGt)iZ!j=`^e |2p|k̇~?w툼o e㿇w|mu /QNW|%c%y&D/V^m =NΑR1^UG4qxniߕw1a-j:s$ WaM+&c`з?}G:O>Yli6}${Z"@Iz4ۓdNnҁb\9Ng,NSS||83,(oN^V( s~e)RzqqWGرn0޼0=Fξ>ԹƵY,ːx(:gn~ZY΅= $#t}VVi>qGŰ_?ӷ qV4Itd+=Ji,¢=Wd"<⮛vvbL&]ͤө(o]U(ͤ78"TXҽ/yZ[5O5q@GE3`<Z4tNFra۪Q"/ތBg&icx@7YnZLM {7Vn3>T5] =&b8&( xD=@ zуD= z@D z=_ZHN$ӯ?o㷪7sTЗܺ yktMy_Rj[c_ւh{׉>#sM땟VRT`j"8Qq]x3GMl_E7^ߝ4 /}mk8⸻5xVmhq2w}71< D߂uD8@$a 1%`xJBV}%;oT!z9b*;ao9W[?|j/@oIaGj>ڻEO 1⸈mZVZԼtH RU$s/zDg]u&,;'^wYpٽ`gi#RZV}  ‹%]Lծ|U&|s7ĄNo{%i&?ٟ@ehU^nW]8Iw֖+"D3;%} QU;)dh#H]gcζ|?{YX/#z[!y o$ЁV֩踶(z_XҲ/EO\~/FٷTڞ=]-KL.0SYlh電S&ҔoO9IƊqUhL8Ml:MO-̰\R:a LzmZyYKqw}?ĎWHpSQ7?\7Du5}pBdYSGAyW=p}w.Q AP(Ե GM܏>*%IUusIH%]QOc9Z'wd,c2ij&N8E5MrBl&M͏Iʕ}9ІteϽ27T"X"Ma=}:q{w3JjUM'?*κ~oFi͖K䥯m GwF* UE} 358$arg) M[mLBQ<夋}^BYӾM Eo;>R[Y-jbFE4O/nӲԢCRʭ"[}#:rW3)lwN+%2{;ώFεڷ`h ,8<]_ṬWΥ&:}ldTRn4gZI\v/Dsǫ.Oq;kDV^LX"~^mC{Y:=Cf~m4^s&K$14yHTҽ/Ѩ_XeBȏfVޢ vB3Y+[%U}[4'=E v/t0jǎrAM!C@Z>8+ GtmI)*yg%f *JfjggOOG qڊV6,M~ey#CIɿf&˟^4\h`.;șY7ҵ xuz_F/=K_D~`-K D ֈ^0da ֿoya7$UB"Z!Xڢ}biJvw>Usk_eN>SEj{tAp/}&3N$ȭUMi]SUyȠ(K׭sӀv`C6P{Z1ַܺ/gQ{"4Bsb;rq?rk9~GmGBK^Z# Fb5*ѣogKq]r=RYɭOz5AщKjiu%PL6~V;ꀦu^e:f Ɖna[|~v7wh@TmzvH/-zn;EwT!oF/um2 TkFvoB܌֪Q+tC6+[6皎FjT6T5vQ6 x#zK F=&fҽ/C~>GzۂhP*[僨Ԗd^cf>lG}f-=8f襯mC#&0n(~IՏzup糵.+;7!zjTz'_nöqr?NBЎ`>z͐?/)sKc49kT[֙c&h lX1/N=ҹ|yeK?q@zԥn w)D &E?H]2Iϐ4x{M:0VB;gl-DO-̰\R:a LzmZyYKq0S;]>ybFt+$S){¨WJ r:P>8g!L,C⩣<«Sig;( []YIJZ~I^ƣHC?$f O*XǹZ$A$}N撍ǹpOc9Z'wd,c2ij&N8E5MrBl&M͏Iʕ}9ІteϽe<剳YxxAm0\hXjtԶ_˽7ٯj0xr==AMF)~z꩛LkϪվ/ozrDoD}@'Nc # ( zуD=@ zD= z@D =>$Ikn8 5%nB^A;]!"wz^Q^=[\)YbK03𔄦NS6CKvިhCr>Un!w,iߦIv t3v|j[p)Mm!s,inH_ܦeEK [E2Gt0AQgbsuW_(e 6}|v6"umշ`h ,8<]_T\e7;|CLQf~.FcϮ~搬ĵhB4w{ /FY[&B:`CDHj?E T"F?=?04C%c$o3X"ŦCBʕ}yfF^=r)=$zg ۵ hf䣯o,2Wm&5ؽ4䳞0;y 3ն=Ե}q?VLAlǓT{WST|KD{ 91T2Z|*㠵ܭ"lYy8G:f'.%=L?h(ڑ]&( w3n/k)r^@{<*jjj5>ʽ1b? }kDT\|M_FM=ң-"qDF G>_E6w~~1לs≏_GjUգGΖDzڳ[+ d>j<648W;uvqDU_~Xb'l/LQ95vTF%q9`ĕg5Q+ VR*Ue=${{~dY 7[UA{BԪ6Z|)凎;{#'i/jukKSeծ!M\6at{g'4ΧT ūxɯJMZܠR֫3^>zRAyS!, )pf$5ϳ)W}WoLÿqn "R-7@@ Gfpz{?ͨʿ3ZߗBv>*j_vni~w)DDD}g˹qm҄`Z)==DDC@==@ zD==DDEt*}る/ߋ>y+C:aOT?ze\J5/I ~6m3YR^i4E_26+l)S+wtF&fc]i"cS~=sh;Uz!2.;47C#zcnZ̝ ;"3;z2[P*ˈ A:~M9v|UPQ#`_OBӡNS;<:҃=πg!zu> ^zŹ^\ݩv!z !IS{5P ^ M*KS+ï۵T+M-+,^ʭG2E] %s*o+fGA#ï{TZw_${QVnKmB>ϫɼ잩}c~|xg7U56~B@`LnojoȚ%ˍO9TJEYօǿ}R'^ԐLNb!\_~SIaʸBɤm-%7+CR'>lok6 >6sʛZZy::ۚc j{_^Jsӳr5xFJG]\V#/B!}d~&ϥ6~<)6y>򧏊ħQ8OK3U-PUVd8i rŽ_ 䇿)f&13\| >ƾRU&5~]5 DU5tT'yr{|S-$HXFklPNd=:ŭQRG EPf;g =ЈlJskV=|QX|D$Hg Wo\:Sm0_OmT?$ϳڬ޽֖[ xF^;%-zQ%2)EO ՋUT,(W|ɉ*g]{J!km@ESZ^V=dhyձ[|GzPQ|6Hw "zս#4?ꝀfmH=Љ^(z *߈Xސ+A^=,lȟ`9agDN{'׊O${5r?{^+5BjLj?&Drn|,b Ixߣ.!һy_'+-0IU}#]p<6i\PlH)zEu.TEo .& z A>?~(Ov.jm?~,bUSXffۯOH#Ce(v?[KbvɓGB>Aei3:=ޣ)}]x+ʝ:Av*]q/V,jwDɓD_ݏ]m(圌AGGr*R80ʿ޳(u+ s_hq==LǿGaq?[gx=!jUo-ODCG㝋]ߴ2j&.STNRNyl r{YSUv]vb4-Y&g=0f7swT>վ+8ŖnkgG[Ax=`"IZ.uqr/9q$A}q^DV#Bȹmθ-8wl?gۅ30kz3C C{R,.;4,cz詏g/jʼn?N*!͏ {,aSlD!bw36nsr9!=3N0sc)OB.l.40w%(wQOf3c+ne {~9Z Cf qs8tCCFbJD_|5ƎR4\SַEQZGit-m0Τ/zotwptd8:,z*.-pndj'kyVs3SUt0D|ў>wƜ>|;ΎcխRQ8ճ :̉tr[!^V}c벵E_Vp{hW HUjZifn왳mKׯd.Tyo_겘ɰد|6֫ꅲlυ+{t<..  YD<x!]}ue #<"e蒬 {Gk(6cyeWsEtB͏eWUvGhľ컗.4?Tv/13m8mRY|֫L(YUXRU97>bc@FU˔: }t!'/M?:VJQZuAݏ^B\gm(]Yn;Ja"nokǕ~v1|(G ,{TY7|st cdY*UD7Ye._^9"_Doo<(n) eeg\_+F%Iٯɕ~ԋ.9 9o'~Dfeuܡ8.Kk_p1ҍ{57ً>k[=v$n(ŷd8;rr~"«M>-}QvaJsϭP|lc! t }@΍c]dot^~*Sz}5z鹆Ρ$T~(g ckUD[޴xc}X0*(L2ZU ^nf8-ˍP:Y]+u[E->=IGx ߫U"{-v aZv_q;w3hvAzl NuGcʆJ[#=|Iϕdx2C">{_^`gc[17w-.riS#ňO z z^;;ʢ_48 @l/E_Vد NDlq>ƶ(5"$[$y0WU=^vYψ])/PK>an .*`+ 8#Y]0f̕ cy4ƀyzӱ[Rf]8`o8vbD?}}S޽ZDz'NO$oٳ_>zv3z7UɸIm]\ΕuILlJGva3t08;+P"JĽwd=N|-}^ȯuj4]KˉH{ (=C#)kURF3hj@PR4FgU\4_;6VUCU_ُ[_hSRM=D a׵r c,5ϳXI7o1Қs$ j2$}F(֜0Uߒw|Ba=O h->\`}sTQETމUM(@R =De5֓uFGkLt~?Tz^Иqz43מJoW[zV}vNNɎT-!(v9 r]'8?Hke j>2ە*Ֆ,.7m7oM^u6o6Ԟ,U:f,=y\ LDd6-{̍$`ɓR59m٤wEզ?%N>fδfұ]3t蚠NWd*)=E\T a)znݫ~F=Ill*=y ʩx@j SLK!ziYZ2Zڞ̨#$wvM^_Q'GrJ:s=3.:8*TcHXiDO9w)=ϙj*1iY녭&F .DG=Cqۺ#LwHѓ-'ؾcMm,Hk4o26\^)*ؚwj(=i=@5ݫrY dIfleh`1ynWDod6Z#iZSHo'Ɂ+_H-uN_|y 90 FݓTDD2PA:p%c7޿Sl`sA$DI+M5V0@S /ZܣcV!zRQg"$4MƓ%K朙b՛S'Y0+Kq4s=m}k׵lX1-ldSPeXD zqV(.[7:ì4-k`QH9GgX{'jRZرQyvhsr<,>],)DUj9i zZW^eiv 1n0--T$)a1 +)-^⪫"D/p֢hc4Ō)=͔Ye)%o..5ߛE%z=kOx@57=fi0;+h/>{BJiљ[(Rfj%q432i!¨{av'J6tOjRTyw7Pe6 i@=C z@@(  c' CA@ߡ zdY z, DD z, zDD_98)nOEj8C軿ީJf6љ #h `1N=c2wݗp$DEIks;KfL%-){V/LW]FuD?_ {!ZW{?jyan暓>qNO5Y,=uJ=14a՜n'.DCp9i,4n+3 3MӞ/1U@ۄQ C& i}G0Z3vT̫ z@~K0X*R{љ:־+O=xaF=F;-9m٤w9W+_魌i}IJtk{D/6D9z/:S‘|G4:$VU=YB~&Gg0D0яS^YYDN4]G#.:ttuGtV5GkY|EWwM5i4k-HrK"-3Fi`h^!ocj2|{Uߣnf./ҿ: ޷rk&Lo9_#=Q^S"D/`f<D! @@AY@Ҏ9r(rnHkVwy*=w_^*t@As?ɀD zDZԉ{X]T o2i8$odv\?ԵLLSѦoIejrGS-'MKaʊ }ѿ$'MHc'o/_Zoryc؆(7s룗\mj^ĥ 5o~oqU"o7ߒ.9DS,'k!Շ@/ EOvV)#GN!9MJ腂UhSnZ'Y[AC&c5Z8f$q4rR}D^/$nԣi-Z/OhD/6ŻM/cSgXqشi5b9i )? C/]-;=xyo7_U+T+CiW7DD3V!** qng D=Լ1+ h"tuuMg!I+]lvƣh4mEkhzևk%]6cFFhh;!=iڞeIZ {ΤI`Eף]x4לm\`}lujIh LBn)#h44 y8Xjh4 ɎTPܺ'TKVg@ zs=~?yY'; endstream endobj 379 0 obj << /Length 2180 /Filter /FlateDecode >> stream xڭn]_1B%6\8nkY=X/1桑FU]$gĕl 0}:&ji,nyK1Y7Cp}k.?^ 0|Te]6!84; cg.ˠi{+XwE`. P{ăilں̪mgCgrx3O0>ydfOAMUmT͖㨈*8" ̯c{*np4A-xAFR,oʶ*Xr-uW%g۶-r4ޝc~f0f<0L[F &K H*ʜLV6CѢC;BMHU]$Z6c}c:;r4Ua#;bhi|ܽu#*j3Y1jI^%߀ 92HeL?$-Y7dCUրCM>½S9!c8ߙQ )|@TWf7oҬ9dZ-Z8 SL+!jp(tRRЌʯV&1 ubW[bfJmXQmhrK'Н9 i' :9ni^%ofOId}xoЌؕgMrevKi&<8ߞ2ļ8.{-V?ݼŜPBj>R&.R Ia)\^5J*V29nEvUֻ9۪lL-ybV2,IxP$h*Vؒa  SS}VV v&&540@*8Tr kRrhvX#ui=h"}r6;P63>?á *!j̍k*:'7o`X NvY]bGp W6|P߄$ X0NJrC/=\Qg9\ /`%9o޿sk1Dq YVV s_f1O8OgPH$Q,Bj]"pTӮ iw+C#6G9~&s=_; c U>VS[!ajj8Ff/)(-9j "L3$ Wh̀L0_A(xklo\-3Փ&Xb"#W/q6NF(hY}>BvUƒ׏TT'W˘vXPOt a_a?+5b sPþ7^ 8MqM^_|6Ph!kH^8ji;eMPC ]8T@B͏i ݾkd @G X .!ŗbʕ0f33}EEAj%d7C|<^H !&|H;m]cWX94bC߹| 44АR(!0#^ӘaR,fj@r)@ $z>tId> stream xڭYIϯP|R7NIJ"ק pQS`P¯|NXf<72MbVlvz6;#w6 έi\C CKO ` ~zۆovR,}?v|uXuNV+\ p).ڦ5UI t/+;1?S8ԿޕeMQR[l 8,q󡫪Rٞ"+!Xf ?Brh)^A$R./k|w]3N"%:y=XW2` tʻO+Uƌ>0c[YRmN=U*xvÑU;&aMĠț P{8UI6J$x4~'AȖI÷)KٞKCF BL)&3lܹ$[ows]p  $!ܲHМVIL:A/CՔiU-'}v͇_]s&]AɹA,pĻ.HO]0L:{NNmYaQoB>P|/aW1RZfA6Nivs;9B'v"]N@+ʫeWm/avj@$S™E *lP.m>\{5(A@+[B/4agK(e(w< m_=i9Zg>Q£;7 d"(PD}J>! $R⯉ צGi |u*')yj7 y \)A?!` W2,CՀh~3ť9n@p@_CK(r%r ==HER2G2+xٍ:k4Ud0YP3v\qbF^EPCoiTiA£K&Шq%oS4*c$V=@lFIp N8hڰe&%~ﴒ pv boy|7aHFY)No~oJxI)SYy[O Sy_ ")le`)&сX\bI7f,'eB$˲<xn riZ˦ {k7IGo{02lB 1K 3--bd]%k @PV}k!RүR2agEn':ɶ4kʼ+/Rg=b27fwĨycK]zg{LRiF:JB0Ze!b|/T5 ]{^(` 6kt@Z}8/?d]^ Pf*]1t*I!x`P/*pl@PdN .ԔZ ;׸5~F6wo y%%NGPBWc'U*s!T.Mw],`vQ*y\LXӨv zS,@Kk+6 q;k P[84,А`0޴x),pQP&V~9Q)goeMG.Vgs\+?UkUt0YT|Kz~^!pwc{Eu,؛0$! K qUBrB|B0(o`砐~o!= PT.ر\3 \X.Y͍ eU)ūUgIݫJQ/smAY|aDGP{,͠+̭WwOe*&$ *] Jt odJg>HmzR<ԿɞhøAa,hrMLktԬo>]n<~ `Z(5NYʣ?M.[ xrc &Y]%6yxB{ξ<BV96wm ' Ki Er8G_/`)Yf9?*/u|F CڒtO&{ %cJn0͛QӥAȫOį([uV BC"/Ľ=c9ִY߅O+W|5չ~?tv!/Uӑ=U1ĮǐoaX+.5o}д۱T}1*nNٹ@㦱h1|iמjsWzPnG~k Ɂ~hyb9. !]]0 LRv^ApG >K˨H X{>׮@ 鉇Gm>='߸^] r=ޗ-[8\fTALEb6}9oXwpJv[xoߵ'璗|WR+?²io> stream xڵWKo6WFr3|zm.[@.@tLTIΣ5#)ʶ"HG37E,$!Γ! E!#4dr|U=.fsG~Q1nǺMޫ)NN'[].pt Ei^|`v"BAG1BT.V'5:,n(F칼53.vU>+wdp ƛ@poItqye^dWdYa>Eb oufTZh :MW.! 1A(,PNٚn69J( AoO7EinqmG =/FvJ0 ܵF7(b@^$.={+Y۩ɞz:TU;UoIj~ieuT)F6t ?D[AfdZtw>My U(. ս^gI]s8x;QyqT8ޝԶTX` aao$~ufAdl$3Vmy f1f\ Ǭ;$uRᵴ^V52^NzcBy"H#/=L&]76BYwl9CTL~k͹4z~ ;]S#1Ʉ̄;oP]:֞ƹLqRA3G&!ˎQeqYҘ4NU8}pBҺWKaj%ƙQGGsoE6DB"y" XFQ +6؋l9BNx†'h<_H7'FÓOU 2x%E%7MD?P]<a[>B">!|vg>+ꀯtڴ|y9%r'zh8bNU[炮XZ*=w jSب1t'] ю?Gh*Gnd"$?G^G{ȫ_{U+wO+du[1P¨/iCVm S!{w5h$2,}Wcd"!,93p5=ϖc6xq%6nn_#iq8,fͣ@e-ˏ 5loD*,ˏ#?lo0Brr(5KhIHo?#>QB(ujn?͑sxMNˢjmc)jJCP}kC5#'hmk/ endstream endobj 397 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp5TQ4ft/Rbuild67ba7a7f86f6/gnm/vignettes/fig-profilePlot.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 403 0 R /BBox [0 0 395 394] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 404 0 R/F2 405 0 R/F3 406 0 R>> /ExtGState << /GS1 407 0 R /GS257 408 0 R >>>> /Length 8744 >> stream q Q q 49.00 258.21 123.52 87.29 re W n Q q 0.00 0.00 395.25 394.50 re W n /GS1 gs 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 70.08 258.21 m 156.96 258.21 l S 70.08 258.21 m 70.08 252.23 l S 91.80 258.21 m 91.80 252.23 l S 113.52 258.21 m 113.52 252.23 l S 135.24 258.21 m 135.24 252.23 l S 156.96 258.21 m 156.96 252.23 l S BT /GS257 gs 0.000 0.000 0.000 rg /F2 1 Tf 10.00 0.00 0.00 10.00 60.21 236.69 Tm (-0.6) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 103.65 236.69 Tm (-0.2) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 150.01 236.69 Tm (0.2) Tj ET 49.00 270.41 m 49.00 339.93 l S 49.00 270.41 m 43.03 270.41 l S 49.00 284.31 m 43.03 284.31 l S 49.00 298.22 m 43.03 298.22 l S 49.00 312.12 m 43.03 312.12 l S 49.00 326.03 m 43.03 326.03 l S 49.00 339.93 m 43.03 339.93 l S BT /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 264.71 Tm (-2) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 295.44 Tm (0) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 309.34 Tm (1) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 323.25 Tm (2) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 337.15 Tm (3) Tj ET 49.00 258.21 m 172.53 258.21 l 172.53 345.50 l 49.00 345.50 l 49.00 258.21 l S Q q 0.00 197.25 197.62 197.25 re W n BT /GS257 gs 0.000 0.000 0.000 rg /F2 1 Tf 10.00 0.00 0.00 10.00 47.61 212.79 Tm (Mult\(Exp\(.\), orig:dest\).educ2) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 10.76 299.35 Tm (z) Tj ET Q q 49.00 258.21 123.52 87.29 re W n /GS1 gs 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 107.60 298.22 m 113.93 298.22 l S 110.76 295.05 m 110.76 301.39 l S 53.58 261.44 m 57.15 263.38 l 60.73 265.37 l 64.30 267.41 l 67.87 269.51 l 71.45 271.65 l 75.02 273.84 l 78.60 276.08 l 82.17 278.37 l 85.75 280.70 l 89.32 283.08 l 92.89 285.51 l 96.47 287.97 l 100.04 290.48 l 103.62 293.02 l 107.19 295.60 l 110.76 298.22 l 114.34 300.86 l 117.91 303.54 l 121.49 306.23 l 125.06 308.96 l 128.64 311.70 l 132.21 314.46 l 135.78 317.23 l 139.36 320.01 l 142.93 322.80 l 146.51 325.60 l 150.08 328.39 l 153.65 331.18 l 157.23 333.97 l 160.80 336.75 l 164.38 339.51 l 167.95 342.26 l S Q q 246.63 258.21 123.52 87.29 re W n Q q 0.00 0.00 395.25 394.50 re W n /GS1 gs 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 260.61 258.21 m 364.24 258.21 l S 260.61 258.21 m 260.61 252.23 l S 295.15 258.21 m 295.15 252.23 l S 329.69 258.21 m 329.69 252.23 l S 364.24 258.21 m 364.24 252.23 l S BT /GS257 gs 0.000 0.000 0.000 rg /F2 1 Tf 10.00 0.00 0.00 10.00 250.74 236.69 Tm (-1.5) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 285.28 236.69 Tm (-1.0) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 319.82 236.69 Tm (-0.5) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 357.29 236.69 Tm (0.0) Tj ET 246.63 265.03 m 246.63 341.28 l S 246.63 265.03 m 240.65 265.03 l S 246.63 280.28 m 240.65 280.28 l S 246.63 295.53 m 240.65 295.53 l S 246.63 310.78 m 240.65 310.78 l S 246.63 326.03 m 240.65 326.03 l S 246.63 341.28 m 240.65 341.28 l S BT /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 259.33 Tm (-2) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 292.75 Tm (0) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 308.00 Tm (1) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 323.25 Tm (2) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 338.50 Tm (3) Tj ET 246.63 258.21 m 370.15 258.21 l 370.15 345.50 l 246.63 345.50 l 246.63 258.21 l S Q q 197.62 197.25 197.62 197.25 re W n BT /GS257 gs 0.000 0.000 0.000 rg /F2 1 Tf 10.00 0.00 0.00 10.00 245.24 212.79 Tm (Mult\(Exp\(.\), orig:dest\).educ3) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 208.38 299.35 Tm (z) Tj ET Q q 246.63 258.21 123.52 87.29 re W n /GS1 gs 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 309.71 295.53 m 316.05 295.53 l S 312.88 292.36 m 312.88 298.70 l S 251.20 261.44 m 254.21 262.58 l 257.22 263.77 l 260.23 265.00 l 263.24 266.29 l 266.25 267.62 l 269.26 269.01 l 272.27 270.45 l 275.28 271.94 l 278.29 273.49 l 281.30 275.10 l 284.31 276.76 l 287.32 278.48 l 290.33 280.26 l 293.34 282.10 l 296.35 284.00 l 299.36 285.97 l 302.37 287.99 l 305.38 290.08 l 308.39 292.22 l 311.40 294.43 l 314.41 296.69 l 317.42 299.01 l 320.43 301.40 l 323.44 303.83 l 326.45 306.32 l 329.46 308.86 l 332.47 311.45 l 335.48 314.09 l 338.49 316.77 l 341.50 319.49 l 344.51 322.25 l 347.52 325.04 l 350.53 327.86 l 353.54 330.71 l 356.55 333.58 l 359.56 336.46 l 362.57 339.36 l 365.58 342.26 l S Q q 49.00 60.96 123.52 87.29 re W n Q q 0.00 0.00 395.25 394.50 re W n /GS1 gs 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 67.42 60.96 m 164.72 60.96 l S 67.42 60.96 m 67.42 54.98 l S 86.88 60.96 m 86.88 54.98 l S 106.34 60.96 m 106.34 54.98 l S 125.80 60.96 m 125.80 54.98 l S 145.26 60.96 m 145.26 54.98 l S 164.72 60.96 m 164.72 54.98 l S BT /GS257 gs 0.000 0.000 0.000 rg /F2 1 Tf 10.00 0.00 0.00 10.00 57.55 39.44 Tm (-2.5) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 96.47 39.44 Tm (-1.5) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 135.39 39.44 Tm (-0.5) Tj ET 49.00 65.60 m 49.00 144.92 l S 49.00 65.60 m 43.03 65.60 l S 49.00 81.47 m 43.03 81.47 l S 49.00 97.33 m 43.03 97.33 l S 49.00 113.19 m 43.03 113.19 l S 49.00 129.06 m 43.03 129.06 l S 49.00 144.92 m 43.03 144.92 l S BT /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 59.90 Tm (-2) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 94.55 Tm (0) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 110.41 Tm (1) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 126.28 Tm (2) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 34.66 142.14 Tm (3) Tj ET 49.00 60.96 m 172.53 60.96 l 172.53 148.25 l 49.00 148.25 l 49.00 60.96 l S Q q 0.00 0.00 197.62 197.25 re W n BT /GS257 gs 0.000 0.000 0.000 rg /F2 1 Tf 10.00 0.00 0.00 10.00 47.61 15.54 Tm (Mult\(Exp\(.\), orig:dest\).educ4) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 10.76 102.10 Tm (z) Tj ET Q q 49.00 60.96 123.52 87.29 re W n /GS1 gs 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 121.12 97.33 m 127.45 97.33 l S 124.28 94.16 m 124.28 100.50 l S 53.58 64.19 m 56.18 64.63 l 58.78 65.10 l 61.38 65.61 l 63.98 66.16 l 66.58 66.75 l 69.17 67.38 l 71.77 68.05 l 74.37 68.78 l 76.97 69.56 l 79.57 70.39 l 82.17 71.29 l 84.77 72.25 l 87.37 73.28 l 89.97 74.38 l 92.57 75.56 l 95.17 76.82 l 97.77 78.17 l 100.37 79.60 l 102.97 81.12 l 105.57 82.74 l 108.17 84.46 l 110.76 86.27 l 113.36 88.19 l 115.96 90.21 l 118.56 92.32 l 121.16 94.54 l 123.76 96.85 l 126.36 99.26 l 128.96 101.76 l 131.56 104.35 l 134.16 107.02 l 136.76 109.76 l 139.36 112.57 l 141.96 115.44 l 144.56 118.37 l 147.16 121.34 l 149.76 124.35 l 152.35 127.39 l 154.95 130.45 l 157.55 133.49 l 160.15 136.50 l 162.75 139.43 l 165.35 142.28 l 167.95 145.01 l S Q q 246.63 60.96 123.52 87.29 re W n Q q 0.00 0.00 395.25 394.50 re W n /GS1 gs 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 256.84 60.96 m 362.65 60.96 l S 256.84 60.96 m 256.84 54.98 l S 283.29 60.96 m 283.29 54.98 l S 309.74 60.96 m 309.74 54.98 l S 336.20 60.96 m 336.20 54.98 l S 362.65 60.96 m 362.65 54.98 l S BT /GS257 gs 0.000 0.000 0.000 rg /F2 1 Tf 10.00 0.00 0.00 10.00 251.14 39.44 Tm (-8) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 277.59 39.44 Tm (-6) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 304.04 39.44 Tm (-4) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 330.50 39.44 Tm (-2) Tj /F2 1 Tf 10.00 0.00 0.00 10.00 359.87 39.44 Tm (0) Tj ET 246.63 62.64 m 246.63 128.34 l S 246.63 62.64 m 240.65 62.64 l S 246.63 84.54 m 240.65 84.54 l S 246.63 106.44 m 240.65 106.44 l S 246.63 128.34 m 240.65 128.34 l S BT /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 56.94 Tm (-1) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 81.76 Tm (0) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 103.66 Tm (1) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 232.29 125.56 Tm (2) Tj ET 246.63 60.96 m 370.15 60.96 l 370.15 148.25 l 246.63 148.25 l 246.63 60.96 l S Q q 197.62 0.00 197.62 197.25 re W n BT /GS257 gs 0.000 0.000 0.000 rg /F2 1 Tf 10.00 0.00 0.00 10.00 245.24 15.54 Tm (Mult\(Exp\(.\), orig:dest\).educ5) Tj /F2 1 Tf 0.00 10.00 -10.00 0.00 208.38 102.10 Tm (z) Tj ET Q q 246.63 60.96 123.52 87.29 re W n /GS1 gs 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 329.73 84.54 m 336.07 84.54 l S 332.90 81.37 m 332.90 87.71 l S 251.20 64.19 m 253.80 64.20 l 256.40 64.21 l 259.00 64.22 l 261.60 64.24 l 264.20 64.26 l 266.80 64.29 l 269.40 64.32 l 272.00 64.36 l 274.60 64.41 l 277.20 64.46 l 279.80 64.53 l 282.40 64.62 l 285.00 64.72 l 287.59 64.84 l 290.19 64.99 l 292.79 65.18 l 295.39 65.40 l 297.99 65.68 l 300.59 66.01 l 303.19 66.41 l 305.79 66.90 l 308.39 67.50 l 310.99 68.22 l 313.59 69.10 l 316.19 70.16 l 318.79 71.45 l 321.39 73.00 l 323.99 74.88 l 326.59 77.13 l 329.18 79.82 l 331.78 83.00 l 334.38 86.76 l 336.98 91.11 l 339.58 96.06 l 342.18 101.63 l 344.78 107.67 l 347.38 113.90 l 349.98 120.03 l 352.58 125.82 l 355.18 131.14 l 357.78 135.86 l 360.38 139.85 l 362.98 142.95 l 365.58 145.01 l S Q q 0.00 0.00 395.25 394.50 re W n BT /GS257 gs 0.000 0.000 0.000 rg /F3 1 Tf 11.00 0.00 0.00 11.00 56.26 361.03 Tm (Profile traces for the multipliers of the orig:dest association) Tj ET Q endstream endobj 415 0 obj << /Length 2672 /Filter /FlateDecode >> stream xڥ]o8}EPsEQ_,{衻wئOihIy%$' InQp=? -t&ۋ8Vi"Eȋfu+ m|"+=}ӗ೼rϟI)'Tu(_.HǷ7'[e$t_lwaM7mjcW<0թR"Ȁ/G/o꭭{q[8H mCAֶ/齲{3#-*:/l.j`\󡵦/_/Y*2aTϩMF%f_`e6H؟pÌtwt%cyZ%sa75wn`  옪!!|\ Lq,x㾬H" c_`-:½#}d|!H0p{v2z1 w# 9W lm9sqtvz2%p5>"‡xAs꽭*Zm@vݑht'R ࠕQ|E `ewMkp# DZO~Nɝk_9QrAA!WM2YH{@6l:]Y9 DI4tz+ I( xO7G/S TF , =S"FaQ7x1&Ո#m0£,Y\ 4X%o /["TO۶{B-!\nD֩տQi1u6VoNi}^K0!qfq,3q Yx  ր[E޿A :"Aa^&D(1"ܣW5$6UXڜ^(KS'ۺB !;8,ΚwmC+M aOW7jbg*8 z='_ow\/%Ϲs!>+(eOXPmA)ZOyuܕU?eaE؅M=~]8*U簱2h6t7!qM8@JR2RIWrnl=`"B~Ò  f ݱnݼU ߈/d,?伞&>2<]jWn ӓQB6[X+ֵ "#2=W80l4Bs og?e۪\ ЯCsZ#v;sf?pIz>N񢹫z~ۮ{Y|a'HNq7SIyĪ[KOLv/ 7]9#=NާvC]^>͂ePbFf[<6 4NqEB•^?h endstream endobj 317 0 obj << /Type /ObjStm /N 100 /First 872 /Length 2369 /Filter /FlateDecode >> stream xڽZ[o8~a)޹(hK)J;墻~#+K,B #HFEA&CF`IFa0^U^sI"y3A|HI% 95("t 1N7¡])<:ɍтo JAhzڤDHB(UB :OƀEY=6 fBZ1ax+[֛?҈ؑe G+qq&A0!aRǢ`*|l5`ɑ4mgŰ=X   %}<(T؜v4s\-dnγ:6QAU"J4x#$01ab| :4Sujc##3u >"!z'` "Dt!\0ڎNsGb B-`cl%Iw4$^ ^eP|^VjuS?ObR,>+#]gHQW3&u6ʚ!dK0+ȮDTR0V*oH/ď?7#J ec$xUɈk3r <%>)gZ1_f{i}CKi]ԒҾ)UJCWomAA=>0k0֡y`Pit=cX9(W)oDZ뮆>w(żZ,Wq]kb2__E9԰hI|ٚ/gؗs{}*FFlN֑DEn4h؉f\y^7x!%$਎LQsb7(AԏV֞6}p~}HCzF?Z p%$$t!SԱuU8W۴҂{a# 8`t*V̶W4'yŖ6nv"z"?NILz: xDju8UY4fܯ[ߴi㐆 iOoNB]@`|n@92$X[A3Tg= KrwTWhd}UK= d+!˰C,!Y0FEH>W*!B،V@JĽh5HhCkh\|/Z.8/ tIM}.%OevbFЉ`xOâ;XpP؊ Ό:ҰA#kw|ܟ[oH$?/qa[(<"ܞdɳCKhاpʎ[@MmӺA 僅,Qs&Gh8C@ jQ ZX#(XN$Uc^m R v/wq8}whX4NtnA?3=Bl/G91GgkǮc0zxܚ$zqPN&d:$A#r茯*"$/}DvHvccxU'Hv,+,WtmGw>PDN/^L6@S-:-%u&e6A-6plpz8Yo\pVx+o:yuKX@ s߁ ?__Ɂ19sb vbKBaZs< x&~RU19ZW}'IZn ul1Jc!xR!M(l72B;DoV[ gi2+BfzѢJ|,-2w^iJ=ȺNusn'zsԶ7z󍋸E3/?\S+UҚڼJdاi5Gv?9/oaU;Y>YW/g/izeQ-#njy=ǻb|4LWѷ2SSu9۫ BH^ ;8ηyk[%tj> _Noo `AYXO童H>{hVV&%4\NE*t1^ΊY5M>/yv(@O&S,.3 tMl19^,_UYyW΋3oVO)*=7ݸT;tl*?A0=8TcJ1ܓdq2†៮0KpeCs*m.I3CE^)w) {b&:}'f6r2LDaqdTN#?q6Q endstream endobj 422 0 obj << /Length 1267 /Filter /FlateDecode >> stream xXKs6Wh 5_3iƞN!UNYRKRV_HqlY4bcub<M#? A€t59Ӎ G?\3J[38#Fuo(P Kё˪D|ߪpC)/ ;<++Udf]ZT*{lzL*5s?f#뙕,er  ) $W(od׎%E:ryHbX\d;y&mc_D"'Zi7*l4HvbZ&t:(|QָHTfr+]f5+ ;.!*ۤu/3]WX޾R IJBfKY"BV{i",789X-Px!I6n֧ izd5}[Ȼlf֭0` yĠPm³>X'Ms}yi A)q_Ǯϵ-. 2>cwT~J鿡715k&(-dnas^畬FU?b'{ um26Ⱦf,Ƣct }G#~ʽ2wz>lVuZ{|b\,Tjjoy+3;%brL8qUSdҸ)YI@yڣK5~Ls6SlͻA &`z P4VvƚDI]Y!Pa`P6lZmU#VAPOpZqem)Az)aD&ZĢwHH1ԁs9]w/j\Ζ/Iemz  ?'`P0?'v%0 %%mʉ` '"½FE 3ץB`.&x5%6:;Us&NJRȼ> ۚKv'C^%S%RQZum^j\dPf{5/58w ċryq5p ( endstream endobj 433 0 obj << /Length 2885 /Filter /FlateDecode >> stream xڭk۸ P6nK$HwESr@6V#[>IC{/rp8o!傊fFihͤ  2;[~{oK"U`")g~O8oCWzՕbl;jtU^4uņ$7c]2:#Lq B`Ǣ*s2lx1`k7[Sv}s(lͼ+n{Ơ{m^Wer٦C.=Uu.ѡѭ|a>/6j@ Vȑx\-L6+.D #32GҜ*ڶ^KLU_x&66 ė8sS$!iGp%cQ0|mS/Y ӄP@O 9lCn:>[ˢH'Oż=UiVĦb*R꥙JQk\rPsA/bЄ(RS TpD/;H O%lRb˨h0S$HYDEՋy=AԄ.]`&{_: FfVA 3Uy='59TѸnd$-굮Zx} _$"SL uAr 0|NoƩC(/5nWNovu]xЦ|FkpWV^sXfH njX̝KݣWmkYTT52T@m ġhtBƠ>%ebaMnHI ~J$G @RV8 "yb(z|H0P64'J70HՀO!'DdOsbFY $l/;+Ԍ".F3:s#Hj1! ;k A}2=;(*Č`0 5[N~e0ueAwV&R>5N6Qa gk u`-)bLɄ5Ǭe -Rxy 34E&we#! H)n)<2P `2 JS1a[< QpRϦ *jɍ84eQ)"2Ra8%=QRHI(A,8+TTpR& `@M n{FBD.fV.#[HmHx%CB /q&ɳR˽$}c,qCNIl#O,Fb89G$8ÞiX=ILnIGQFq!LU6|ӕ./A%d6PeQ>yC"VwN]XXX=u{!7+1l&0O wcx[9c8e6^~mr rԥYmrS !5,Jqqb0FI %BAp(>6g<Go_"i MPrd Q&3 ts^ikr{cKC0vF!du!}_QA?q^o0tbO+l&-]AfkLtk0W963-5lXuJ68"\Hּ0\g5jXP> stream xڵVMo0﯈zʊƵI*@JEz$]K$B9Ϊi*y$$'8b,b,MY|_ N3`"-(N./MI<~89/XTSaQFNU]j2 tWR wK`m'nԮI65ݒR5^MS -'焐%%(I)]eЪWf !d~7ƙVt6Ｄ z&|ƵG ZIf endstream endobj 428 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp5TQ4ft/Rbuild67ba7a7f86f6/gnm/vignettes/gnmOverview-qvplot.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 442 0 R /BBox [0 0 432 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 443 0 R/F2 444 0 R/F3 445 0 R>> /ExtGState << >>/ColorSpace << /sRGB 446 0 R >>>> /Length 584 /Filter /FlateDecode >> stream xUMo@ Wz>2VݕvH{z@lד I@z ώ-`6<;IU5(-Jc*ao؅M] !xū6+IID?!j.f S<ƠՀwKˎlGs>3ի]r]b-!6ma"mǬ=6W^ϕ+1p\Pa:SiB![Nq7\@z<#i;s>?mlh .>euE4SyfR"k V䷶NC+ϥ/\6Guw/Tob]TjrXu*xoefw2B6hɇ.tcq7į%TguSlM>VK=k6#eLek=6u/ݶLD!'N^Bb84 پW[ E/nKcQp,oFŗFc㸐PʅGhA"GD(~HhhFCDAם endstream endobj 448 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 455 0 obj << /Length 2529 /Filter /FlateDecode >> stream xڝYKo8W91iEvccw0Zb^=x0߾_HIݭ8N|0"YUw{FqyY,㋻E{q\$a U[]hU:Ѫ^\q !"ϏӋ^E|>Kgm۴1/$#D.J3)LԠniF0qh?%fZ"@@:'ςp~n,=|㐁e Nwv!o_Y]6my矔 b4G.I- Xz cnϱ7 IP猭eh^W͝H鑶!vlw*}&P:PK8۝2/b G(h-m?s%_tNވn;y욅v6UՐ7b bPڴ3׹2W~D߽?/-jM[.IMylv[Al@o7G3~L4f d8)-oTBو[ O[X̄~'6ypHB,sO`'/IDjR8 LLtBtTUC?2 eZpȨK?T4AK5tL?`O$GE&^c ^xR~6u-]G`V-/|6(-yZ5P2kr-QL ؖJS!EL2e 1nع%j$tgKA'W\CO9}oKPM5ɷ ȓSeElƱd9\maQHPȮ)9 j. -d䭖z[.G+%FD"ITeoҥAm"kVq =V<[E,i*ڋ\Ȣ%f٬-0;]yx_4|r}og;T<7]$֚=(Mjk<,OayuDl:RHVE,pRCbf6huDhZEN񊞱cMS 9 BfLԄD|ńKZxMRO#&Rv!%F!:X;ha68kF&\"H=.(w=2.߬m<8o$$-GgxhO q hxQєbouDeY AQF(.њ兮tw ljœiܴUr2.CϏ9fl{eɌ~@G][ zZ)GbX|8{##uӇboj.'H}g@F6b?W~{QM:Gslb_-O2x܈B sH{";1X9.} )%+Hɞj84F8TKD~B[gHDp\< 6Y{(ΠT_YB8]l7_.FU٘q|cU5лxɀy]=%Fl=>\"7Tgy͒t( %&v9`N~z G,c͐?z 4 j>ߘlˮ]1٪M^A&Zg CNzq}WJl endstream endobj 465 0 obj << /Length 2993 /Filter /FlateDecode >> stream xڭYK W!,%9coT\T9[icg'$Q=q_HQG!R߽=eYEriZܽ-{oʎ~绽BQaF{W"wGɣ11QXOM.}qOe8So›4mʛ9J07y,<:/.d5uwR.WB8{\yI |&!.=< usXB=hOERҠ0o?.zgiX3 oM:q_]Xa6}SN}Fǘޚ4E}g|#q; os7y~B l2wXu!eQJեFZjִ\ tK7ؒVO]OJ3\ϴzK_ vgO"u{|۵Y;,B滃mCZ2;0쏵\|B@~ܩt}i{{xd9-8= }-q04g>Q8S@dLĽ0{DER \hFS4Fӓdԓ3 <=aⴊMccl8TuZ3g,^6[r5|͞Ƕ3=x4U~KÓ-oyf}"J,݀PQ[fţT>_af]dhi#|!uC4T-=w~;#|,Rͧ^yТYIfMm|4η݁54Bg~_G0%L %4+UU H؁6t'ZL=y(^Uetô cB]̬7m5ΐn 88lJzQWX3Q>3q@1:3}w@5)L>09xȜIĻتPmj@3-=SsPq8{ PP "]LE~0ͥf󋣙&42.66?Lfzۺ:w|[SBDl̇lw?gbw\X/zjLP/:ƉԙiAvr(?Hټ12rZy4qnTekK !6n:sJ ڬfM4&V C䎾fc?+SӢ0{Op Ao*iw%#~,s|ӁD+0otQZc?PƷWYr09hWxiǭX( *#+!rC$zAΈqq\gЩRCe)/}c/';%H 2ql-]`w N m׮{T|0}_"S[3NOuDad_WR {+Xܓ HEOFp6ZSEW W |1Bd|OE Ss["@.xi3”Dabuoy ņm!۩;y3Dlc/AKDs@9b+JGȎʴE "4wVGs1 qK'q7qR {^/*^ƻitwڊ"DJH "Nfl+.˜ȸ\,iuX"5 \BteA&9i9דARb9DFۑ5XMZ*JVxVr9{U({[7z "(RNFۖ!EA~i(uzwuQ9<6-C8+ @gKD^ eÿS ʒdq`_Zno"DR.~xRJpZ!4|6lo9-q\ }ZIcMk1tD;YW\ZH [b>K!]Wf\j.Zo-J\qЁN-znsmiwGr7H 5U/*"/R(۴E|uIo[%cؒ =\2`G kzEf8^k24DQ=C,>|}vRp5!8'1ն¤"KWH)hθA\"44]J炑Ƶ< do巻^jlau4?e4eu8?0:FQ FCO.6AHevssȠyoql_.<։z=zkZNw=U_L<wຌ\6( 47w&GZh=b5v ~ #! 75ښuV!F kG(ykU7DŽȋ֤v&%.˯J?\ٿ#9g#u` DDW]X65mv\tԎ_msQXvsA,XڧǹSQ\\uCAdKC5zp6wH_j)/!t,Ao,3 g7ݙ0353yWM8f LY鶫m6-/}inu>wNSU'_p]9K s(YL'_{} endstream endobj 472 0 obj << /Length 1657 /Filter /FlateDecode >> stream xڥM6b( JiiR5fW`<~6̲Ij"GW4QRB$WUw*,!%k]WկB2ٛ<]Q_mWsJx^ !KIØ G#^m9QַƷЍjp4`a-;яReܷJ#ܩZ?~~H=Qpf4S>Wa"q)!$OiTHV!K"JDݥj JΙWdy<9rk\ҠDX4kM@ VsYݔMfđ"f#DTA(j[wNZ_iOAcXY0/+1y$6.[նʸ 8#[Pb6SLA;WUˣYwt@or' aVE#wpjT'CzȠtSQ3!{e\&5-(G|p p "-Q!e^CNKAܬЖ z{hF"*bCf[DclZ \Vm3|f4 mıފlś5Vv3sBˣ,إF/FFy?\D h.e4QcgSӄk?ϣ$/ J#X'B* <. tU<1AAҒf1(/t"bq:WŒXh$9IԂdbQKsʝ%gey9ɿU^(^8\[ R(U"{uN";O9k+`v剧9e] ߋcgxGPƢ8:llߊ|2Y3Oߪ#4 -^C7/yVA;A7d q.w [h:fGov 8tbxƓ4SX{ 9ࡄ9tvwc 63~|3SS PSur(]xw{sk { Q%,(m+`@]5 'viI}1kw{ 娝$ٻ{ 䍎q'Z;WָG̈́Xi=HHCg/= Fd"QjId3#&Y (a3Ei.D;:~NKk< _$IXIgvt,*i./'uZl>-)^TSw.x?f^qKHqg?;.)gg ?‡W5>R| |Lqz)3;g\O3/L^JC]]g#YLx vǐ|usw/+ endstream endobj 460 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp5TQ4ft/Rbuild67ba7a7f86f6/gnm/vignettes/gnmOverview-residSVDplot.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 475 0 R /BBox [0 0 432 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 476 0 R/F2 477 0 R/F3 478 0 R>> /ExtGState << >>/ColorSpace << /sRGB 479 0 R >>>> /Length 918 /Filter /FlateDecode >> stream xWKoH Wh<6m6 tmtmnh%5dhC$3'>C׀ߚ |6Ad# (g wWǿx Wk- gjA}n׋;s{ I[~p.I -L6SXHA3<;jP*hIbrѤإ%ȄPc=jj r i`YbN[x cjA{5JCqƺv/pJ ֙L\3Aoф}IA 6ΘMp^ ԔLSVKװmձNI>8t`FeOUo /U .ʭy'6U#RڌXO uHe)ؚ%Kۨp~m5mXe'c'n`L]$0[^Olu`r,"i#rj{|(XR]$.VSLډkѳ>~Rwb'ٕȞ8^0x}'Ν~0AAӺ}3&<2XOeo}D>o8[S$r$]mzI)rL p۶qr~]z\r?T& LXVgX\tѨDeRTf|Ya_mF40闳vwiR^v4qnfehd_Q4\0<@> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 484 0 obj << /Length 1142 /Filter /FlateDecode >> stream xڭWYo6~ϯw#HQFn`d:!ѱC%U~$g|:%b *f͌ $b6AXj=MmTj*?-V, ŜoMۣS>jUAuujSB2?ܯ',ukq+iE"A~"Y֩;NJrڧ<s)ʬI-I-w7w[~>zi_k 2FsY3\OJؼ, *) 3RWڪRe2G[®p=>)&'F\lZjMM z}A\;Ac^8DYL[sTиkGʭ}zkӂCv[şYGb䂰o({m,^c娟n;Y6azoj2,K\t=wA<>zs7$qU5*.lavӊE'xIi&$>vIJvzp_ >=pp Vz)WsGoPBO*0PbI_ 7 v~1|̇~ɚ 0y3#0t" ]=ypH0i (q]K#1?=ɉO dS׭U w B(cXrh0 0o CEDp$0LL@NI"4fOQeRc19Y D;9kDZBofSBJqT\v>Y (ض endstream endobj 488 0 obj << /Length 1749 /Filter /FlateDecode >> stream xڽXIoFW9Q5}1c- @M"qǗYHXh|y B #]fJ!ILI$b9,|!l }YպQ[ܖ̄Bقdj$Bs3h3_(DLCgGWM^mV Qڟ `H^h1ۢ?AQږ&}\ d3*3{W‚`x\W[-:mcyg($nf8_P=I) q5id#{en$kol^5-tUmB!H`3-فac!+{d ʋoΟycۨmt bXNog"vaja1o+ tٲ8M*)supsEqP T˿rx3 څ1mU8.m?Mu}_eu{LN9 bbRSML$~`ҲeROH LOSU/(]΍o/H( vW>X u30P)Տ0gH1Z!#BJP6fh2@%Ta,ۛUBydH\ic66ICM# 56t >aR 4WbJ3>B Tcy{3c-7e; 4ZQPlN_%v|-Qh=&fZT="4z*MnJ'dQy:ê rS6Eذm@M(K_]{ٰorpxUQF/>lDMk&ǐ4Ӏ@eAsm?H*vK H#;gsr % niD`gwrNU?jwuӫЉZÊsav <`Aw-Dl\w -E=-pq5DC(#PȀDgy7tuYj  ]|NvDe>-8Tcq5~kȩ.hWі'k(&զcGxU۸h4:poLh@nכ<9'/EoGJ4>xqDRĥVᳱ{=);T'c3W" t>edħو]JAP'R KJ5XMH7)PkHOsX2-ZK剤<"M1:RwđdўҤ<'SY:,R0>MTv.d';5[N![]X.8 CLd8CXDnS./S_ ݋=j؃(X9n푀a!R "rwl)Fi!;VwFcsem|/ #_:̼O]#(t_׭Сp/hi26kg8`~ϯ0:LC1j4Ua2nڪ&{g{S 0dp(5~?M4eKkQM)&w?{Ѯ3)SB_pHTլ49t,"@ g $^_ݫ| endstream endobj 496 0 obj << /Length 1590 /Filter /FlateDecode >> stream xڭXKs6W(M"i:vtPTH*/]p!%C--z{5clbU\MnMb*6]L~~:~63e(\ݼsDŽQ1bD)ABHBI:SBT^+$ˀw=|ĩF6{ƴ&ԜR~5P~#pOl;ˤ`$uQ.Z/|:R9D3ʵ(\r}P\7h &'0[j(CLz./dG LӘ7sx ,jh$@ͿĤ jPJf"S|yuKjT@5cFqY.U͕Zs֪ B ˻+#_ցH B]bu%r. VDdj|mgsE( ڀ_Wx|޵c<`CkJ8 ~X2:VM=H/lRܮ+/6e;wGʿ OAD@uTPW[.:FH't#] m+ hVߛk!Ԓi .d&e)YV-f!V_ ^G)O30;iO&{MJ BVIp]0uhcnB'×zSЈFxDUÙyWuo7.@ŕ7붩earjYΡևFvl5~UHh!C^W]Q =us}ڶD)ǀcnbl^b<^Q?Lc3K0MMMqWTc`pj -[_Tt6H1uQCīםNv3NW[agfm5v5I+0~#ї>8J> stream xڽWK661h{nMַ&ŦmXRw(RȎE9o<{Kbj2_M"V@|9kow&t+e[ND0^H(+JQIm(JQ*21uou g] p(=Kbg-@n@=!m ȗQBA7@qc]s#2u=2u2}pZYIopqFO1"49Ǜ݊2f`3gD)brOIUϢn)n)/ĚԘ~Ha T HCJous^i1fqb!MVϋeS:`DZw.?Tݤpa}v_66BO[M R3,c8|–O_6޸C[q?O>yQ~̃17B}u)Gg av)-%9r_= endstream endobj 511 0 obj << /Length 2107 /Filter /FlateDecode >> stream xYߏ۸~߿Bj71"%Mpڋ.Ti[$n$ys{( %GM}M3o/7^ !eFh{a&SQbFD}M^wehW@W̛үm6R,}"񜾯[Z X6~B_לGFv)3)iRwzH&8^ݶuvOC{lY*450L۠`ZңWRp ]^ݓl Uu;Ć6]'& [)Bpw&v+lUQyєIB9rbh~tRK!㝬Jfoa;AI#5 8GC"Q㟃 wp*մy? i :Al_TkආJ㫢ajyw 3c(ۡXi`%e,+0bϘ4Wu(Jv4+`VeU{K[h t)2 ?WՕ2TOFil TDs Ψt>szh]MUvg`=d\'h|kstlR-  o8YHn`2 6}d4(`ZB]/Z@Awx>>AVv|FkڶMGCsdˠغmGu]YZ)kzE3;|?JW'8Uûi8ݟL↤Un>niR!<-X2Yp&,!&{X#* <=fN!ǶHI::[L}]}x攱0[vA./tp$z\swI5 `}(зa4]ޕL9pU<OSonN rݹ!&w("њٗH~U@R9ckG`W]D,>!Qӥ7{jP_naAOxb1.R` zT@Ndd? + KA˙L7i.+8betőbF$.q`{S|dҗA{m{FHED*ɘiT7?̣= B^b Tܼۛw*΄yI&x$/KUO3#&_b8Ӌ,B|4 xS4ZrQ,q @-@~YH)/^zR"9T6Tз^귷}^:욫p!m[+:]fK8Q#9Z]nJ3 J{cS/|<ކgnA1$P"ٛ2:4`2 Ox[~{z+؛eV>\ A}MƉK]8:<lxX^C 4Gu>Ӗ AWujbx%ܿV5#0<4_AÛsy4'ॳCY@X;rPp(3Psg-1dz ,yꔊԠQ )(),j?wU^ ,2_L V. fq 7uϸVW/%1# -T ʿ#35K4 2`N endstream endobj 523 0 obj << /Length 1964 /Filter /FlateDecode >> stream xZo6_ŝY~KZ4mp>m K>6 pC%GNMC$So~38!QRIet$A)eQ W,ItEξ=]٘SƔ/b4MQ,ƠuFKX; /PRl*V|!3J8e+xG,qYԿ[7BeLM֪IfkxJ.,]0#%{W|AfݍO[m6ۦv?Vʏ.=??*oUUo}tl_/甍ܔ6\䦹tƬ9sR2Fy䡫 FŔ˔;0,M%<gȁχ=BX0,~8[ ,NgFMgunpf<tQ ("$ndž_9ųq2.rVYΊz3(#0vcMF<;C7I&6%Lc>vSXjb&$ܣ92PS@,} [S0o0JKTg PP@M~$NRgqԱG!{R$@axL3TqR':"Ks(D'R'خR:NוM6*'h@T@@a^<+á:};3+߳ <+Ys9OVMY7Lj^ ?oon;%U?{Y+⾼;ǵ e w5opϮ|]{v b`Ȇη4+>;~oVfFmJ׺͹O:5QjD׷?ɽ*ۛ]bpow;?xO to=eS7IXls47RcfoLu\sP swI(wj0W(XK/]>amQtejީVCFTߔ+=mvhnۜh18A?r/GXN7?xlJ^!cd|᳞W@0W9RR,J1 OQ endstream endobj 531 0 obj << /Length 1224 /Filter /FlateDecode >> stream xWMo6W]s)A[`$-P.zhzm& K$;0PwȡQ 6CDR3Oo3wӳW!&hIʲN)M? #B1sh"RJ2FƈQ -.|yCjrDq,um]uR|||ͪ֋_M 0lz߶~=iJ|=JXU/$RFu#iMDG|/8jNz3>Ǚ3-< Q(-'apC;|BL.,DLSMF`ÜI$G^dO`pb({f-7b#@Z~QҊ'MRCҾ[ZS>$[z,lZ1_;gy~>҄ehIuXn nu8_ 2^$y[[/\[T|F:O]Vɲ%j3\¹+ GmζGYRm[|Q-@;[.`󪮶H`4,@$L;[ \ >gyQwQG~#;*铴?W3Wv5 a aw;Na] 01W! >LaAJiT=&PrJ*6NQ -;XRmUƄtPųwVJTאRe L1fCR>R1bz~\ḄK&\-:oE( 0Y2J4n()Yg45Fٲ68ʂmUh}1ȄIC4^B#4$vCؙ1(li;7M'8۟$e84v~-0XPsplkA,Yy<~ozZ`,0c0|Q6v~C͂GsihA|ߑIvJNk@ɿ(v_g8Zl+@-bޣAs껩f v- 2u3TeG޶mcx緶V^צ]צ]3_?(bΟẒ55\zUGa.a}4p;cFn@ri!#ę+ 4뎛=qW<*] Xa r-Q.^r4$ 9_Te>P8+My7]NEK endstream endobj 419 0 obj << /Type /ObjStm /N 100 /First 893 /Length 2414 /Filter /FlateDecode >> stream xZn}W!=]]} l)^` ~ȑYTxY8SÑD2 h3=էNU d M&0JGo8x<7#Cq-Q1,z=K'p1D31$ zRTh6$Ƭ o8*@va•'ΰȰN)x).B“PW$tBRm~)&)t =|A͞!dhd_l b>tL#DN^)'Tz:~<: 0g6|서LdU9=֟%zX"18܂Qw:E1)&Xd Jѕјq`D|E`dr ᚸDUE'ׯ;չ P˙bl͇ϝom^G3.^隧.4~5e\(AX;^lŲ@&zf.M>_fƧոѽ; գxPOI6\o_̥^"93fN AE ôdi [{n2̲j`}5~Mywոz3!aXZaZE ltYxү' \}WH?+-f%[ cU &yӘލ? `Vۋd+5q@YE+yFJ6<jQ|_j o{(#i#?B)E`b2ábίxv0dxPmLwIH{^%dlc(xގe.Kb FZë́\\BcĭU<%>a:ťHlRwuλ|sWvT<|{!|0&ݻq>^5zw$_sҫU%umO/R{p;~]F7Wt,zG=o޸qMd-DgEx^eLj֫b!h:x}>HORF)_3TYꏱ6頺tno>`қ^/l0m7I1xISLʂu5U6v.6t'aw>7Q{몼]Wi!R!+Zg]ޮX 5/?^SIL4 E䯄+V#G>XeqDBފ~744D`,"~3>G2<"2~Prᷠ +esxB#8,NQi(BʯJܜ XXB#E *3f,"1 G,5]Et,%2k6PzʟXYBsJf>m|q AJh'Zu$7 @mo ۼ=KEiݟSr>].93/%[BGJ4>Hfk~tnT8RhqllrӍ皒5|NТj(,GfM_^6d-'ݛsR}ҒѲuI^K[Ǽc> stream xXݏF"d{E*\IE z\$ec۹pRޙ]@3;y&'-j=I4FMR-brOgLU}yB;̤`Fdy# IBOn2M3}~k5׍h;[坭NςㇷJrf8Fη=zgazk2Ou³R% bK[T]KF2OϫhŮ_ 8r&$R%F|5so#9eܘL5ˢ}^z}ȓQ?N>כESb7Od>kXNJGxv \`Fx`Δ1+f@vIDeQ)&<kJhYW)HGw'# QnS4(|+<2tu]"5#m +LElqKW7xW ui?x IӤ7N灖lD?\ZL4+0z:_b$XTy$tun<1wW+Z[sgxt Ayxv6Vke޶,Rƕ  \vuec#XC1-a_J:vIJZ/_#g;u49TF|h@âh7.cG}tEK(P]\^b>xn ԗKwAGrX-юEP\Q 'øBvWl}@B(F!z(Fkee_ywC \ 5CQP0Q'j*`) jpXcYWiOHJޝ?.STe=2" IŸ]wGAwKQv^TU*=:x&|"`BՓ{>Y?̔(B _gOi$:/%8Ry$S f`G'Tɫ>3AxA|hQ<`UU~g=+u 7~\1C,,Sk5?6 endstream endobj 548 0 obj << /Length 1745 /Filter /FlateDecode >> stream xX[oH~c"0W R)J@J<ɄXrbJhرS4ڮd.>s2//MH*E$$ $K]̣Ok}]8.X^0 3:kS:BbU17y7O4c"F?jgqGrW$BV^ϘJOHD1DE1A<ឮ`6ewq ADC|}fn]֦]Ƥnzhc (bH.'EBuF7PȽ;X7p~cVQ6sx[O"pl-J I"[3VvY0/ʎ줊GZD bI&utHWc[-чo "_*n+k[Vs֐7,S61i`M";Z+)xt't:>D5P(gg6ƐHzsJ%WVL9M ]4mmlmn5oto>cLӷVbLjw E2A^c'*Sʘg,0GF ]Z"DKKğ#N~o?ďOpٴ1=7&Iwo;̀J)1zUӧZX/UI,]yZb(UV<)/NN~W~퍸2dpZ"ef] ksvl~, d(&8N81$vIl˝wrI"V&V,1 56-cNALѹ(P!Kܹ/KQO25iH]ihuQqG}%%U XiЭ2LxWP! j)DpdWb2WpgxKbK'CWI>tk&-uT|!g,W0J~Y,faiQ#ʒƧY,Xoؗ+[2KkAQ?YuɳH^ }KtejSc5үŮ4@eʕQ77¹m }K6oO|A̶'eCJېL3gQ/h)4fV ]8{Ir b TOלVҺh.r|E BڷS 'pTG 6TEaBڸ`Y>֭?<-%\w*}tFDp U ᔣ(=yRqT3uĚ(3Bw0,FڶvYwzufNhGLZpz eT<:0,rհ:fJ 0݁־;Ɇ|<{hOwȍNANNNj'm45pa]LB-?J9Z:&n:蟈"]7 43T[/El謨D*?Pz H9)$)9ĊMM:qlN endstream endobj 559 0 obj << /Length 1896 /Filter /FlateDecode >> stream xXݏ_q T7i%<$y+ER}w7;߫ݽzȓ\s}qP:ѹ0%fw/o;5UOrZ`"+m,i"?^_.Sih)"X2J=?\ ģLq ggiH]<1%DDD> fZJ D)R)ħQʎ  q}WT-J`Pm*X[PasiUXJ!/*mg-v7g_[Hp3xGSD`n8'^ej?xoC⡸%S 􈳉vSB֭ؖ>[B$ gzM?+"PwAFQ9vE!8T0nںn/ѡ@qAa|0c LJе/kbn5/ 'O-!lj'ۧMT ~5CHΕ@22jqe'˜ ]tvU0k!JtQz1Z mYoj)7ꐉlhl08:,vׇ G3C*2,"Sd=l -}fO~_c> XMECҮcѡK鿦)UfsnǬtl[rMr$uL8Nf-e{ѕ@ w^pI!>d"0# ӥXT$\#~@gЩqo^H{@ȅo"7Ca[h6# 5̵>j!q䜆Akc 3zSp8d{btDdsT}Z5|Ԃlm3ܿkkҚ/77QpHMy5%3I' RA @E͊IGHEv=_gI*v]D*Fb$"cϮ6tsa!Y"ͳL7EqtE'0cJ"XaHÔ#o_" &e>8a9cnE Hg'̐<<(vElS YjSJhs M4#e294xѠo-͚*q!c7 I>a'u NeUlw],aD"f.dC> stream xY[o6~ϯlfy'ڴhCŦmJr~/%GJ6`D\sH>>9x0%D1%2R I#% ’D'Iao/'IB{?dSiJ:|̋UZ]=-ф ^4/MgWOT7aB1)/C1 fLYW###U_Ѓx6uczr#5 C+ RqY6,G:}Y|uIitW9X?{ v~Bʚeezro/T`$t9;:Qjt<.(lIΫ0JK!3@<,0׾;_i. U:dII.e_?'-Ҏ:hk@4D]mzHUb`~FZw]dʷK@̧̳@䝼#rDz9R٬o 1ȴFa::k3<ţ>1L;&Vr; mYO:>"XmljRRP{}i$GFlcolcc`}-IMݒwj[G#8Q΀ak2[vu'XYp;4a^+̵A*Zd{J$7 k?e-DI'lH:C".lY4_~  KIG*R1f,zuc[ $ٍ~ء61% "5&~dOnvq'C&,:]ݐjZR{e}3= 50|q ^[*G2]aHR_xECj*-Z=:%YYnϫ(=Y3$e-eYe8}Qd1{aMVZ%@h"Ķ1P"N * ns1aW` 2??O z3L.ҥO%^;z ǖJ*3W(yS :k}4:n1N=(ɲ>oVMU~ajؑw .\%U 7=C M/z;tTy3dTH/·קf:M;d4WI{LddB'gԻ\T鮎~˵F5ݗPK6kĎ@$!zqv 71:Ι: endstream endobj 582 0 obj << /Length 2170 /Filter /FlateDecode >> stream xڽXKsﯘ\XɇxT6q9r9)jѢH-IT*=S,yw 0`я//RT6ǍHxGJHm.͏ۯI:n^/_? _ XϗhiD^):GE`D)z >N Go8 "fEm}ܠO"VKD/OLǏvI@"|[0HsտY)r.9<;}VY0sqp`%nNEl,m~"uu쐵_ O~=o4>tݵg/: @v[c ')MqX̡Jm{>Ym;嶾NP>skojt<8ͪ&>LH}0#a+ӠgozŒ<!M;0osWǟ FǺ,kОs4E4$W1CG?'Q`y^w?]WT'Pt4˚փIZтhnۂ`Nj&+*<.t55O~RrV s(1YDϨB cR PZSG^FNk;2JU y_; rO9v8Y9s*B(p"x,0^i- `DOr&(,VZH@sI%bZ '=-Ycf Ytݟպ겂hlUk;oCXa̢d&hqCcH]aKҀ WU[ q 1$h(eġov*z(#(~7_aPlW\I)qB:2mZ_A7&kX;Š"Z}(@Z0t:aܥхOyq뫖9B&Dg1l 0V!tHȴJX}xdL7Zm~_F`W׃{a?~dU[k@5mL:TVw:\;.dwP)m;NhzXcVk™ˈyM/rGk>r8И$g]ͮ4tᚈe|'; mq,#EK;kz^ `5xyK1jgMqZk64wU.;C h{T2G !"5(=3DxHșW3IHu<C}$ݭ.-d5D݃Ղl}3i) nJ9>FŠ!"\2{W>tȤﮮH'NW< f p`Cn#Ⱥ 96׽9CԌXr*Sg[{z7;!5?@%(%zc쪡L,ʹőT݆ƿ=~~VafeL^SuD"FLql+1j`OП(~F1cv[3XNX>x~27)Nq" ÂƎ2aW8 endstream endobj 591 0 obj << /Length 1814 /Filter /FlateDecode >> stream xXKs6Whr6=ԉgܙ:(D:$e'.Ij83.c]p!dfT.3!4l$AXjGv^]o˶^8ó!WZ*˛n++EGwyY?߄Ua_i:(A2urUS?| ,|uС%;I~Yao?^My}v GNp5 l0F B5јhN-R%}b~1Z0zF0Jq{Qİ02bI!J&vD#j(D!@\@\DeHm{]e*Dd2rؤٖExhPm[/Kwz)]֎i¡C18r='8ˁC $U+;B<}qVe^e]uMv~ȗ?ts;w<:Xz޿+<3Uۅݾ+ Υ ?Hv*oVZ`u_؊ÛwE=<|6lOɋ$; fjGIk X#R!4OrwS_^-n[8eޟB^PaL ̤n&I*"Qhj-4WsYqD/2&fq p(4\KMٓme0UfqJ%6L9!SnQe#)'2,pOS-\MAPҒ.zʶ;]pAeS^s=w?9?;e+HHrm:U^`4huS阋K3 B1JϷ(lP* @?,+ժoIVNC~r0oPДstPB,Z R [I0srg$; {y1A`cELXgM-C`B Lm::l*{wτPA3VP{ػ@[]X zRfۘqoc6&>SgPmdW˰Bvi Mňn Wѷ}AZ 5w0}t0C6"M( ʘЩIM+w}?w_K-BS,׋4&/8He՞ӨfXNA<_E(f{|Wn?y^.!d 'vH;l']|knWa==;ݶHf0;ix>a}&qe?$Gv|GptrΥfl6 G6GpЈ!E |33BXpị;#8H#If1Lsh.,LBLRdNL+.x9W3=6-峷7HS endstream endobj 602 0 obj << /Length 2595 /Filter /FlateDecode >> stream xڵK۶_[K0$Ӧ3iHqۙ8r,kz{o r!:  볋׊85#T/`z{9Wٛk(>MWۯ?9- gl)'_;O7 VkPZc['vo7=H~'s ^RGY`U,. ƹ(gW`d.y^L2/wS^ȂBb 2A$aL)vִ R[ ATj jv'Ђ+f&ХON O_̓ї/bǔ#lK[-xn:g4LU3]2"#'& 8n'{'PF/x(p}1*ekbٚD'`{!AX9xwJ#Ќqy1:I7;64xɲ(뷶i1 ]\yCto^?cX4mk; f T5k?⑕@Gͮv7=pMأ5) ˹̌NdDOffSevi[kaBN6$c@XAQD3"*`MLpIX+,cԧ#$R(a!YSpdlXRQ6/!\3 F+ oB"ˀlH)ϢUڄ;kH8gD5`%DÂ} dRD(Zo4.b]"HD _ xOQVFE"{)+]IK SŘ')UO&aۤL3gݮW+4) ӈ4'Pα#ZT~l' h P =l`I?zJ z )hk9@dJ!%Ĩ )˖ .Iw%aP-uulpPȡp.< sww8#)Gr\L%.}Uc*[aə-B&L ?ž(t0.K]0;. ̦kJX&)l;.> b_*!+sbw>!$Ps/#0˸,'q bR:å 0)i(Uy*.Bg! z`>->g<׌瘖DMSAå h\xZ^<'9s5N*Acd\cB}X.z^G*g5Uk\J"W%A~!U#&ZQ-+yo7Vudg8n@xgfb?Í%YhߎhPI5?͕?ґom]O>\8 4Sg?vZCٷCٱ 3h_Л#Z,}&<XV[0K4!+fq:޿Y>pW1B謻6q,D>`kښ>a$S}5 hly.j;.=g笀bueHIȻB U *CWQ\g *v%oJ'zT1HK s95mXEvvncnP]t`٦falZmǛ3EM璺Xkk3#DenMl6Y:/(؋c:N+tJ%u(9 +X#a>qYȟܺsuw)^>>S ;`BPU\U;G̦+]?Lhjɍ|O-L 44y`?4L~.D51q5~.0>vj( %eU8Y?,FރE1T7q9'P$/A zj0JEo1gL}l;;?1$ x`>ԕwE{w eW}ٔ]T 㱣KSFX\*ˮӚNUsdC*,\"6Jn;U}@GBqƈ' |ugnW 4']ҐcBQ޴598]M,ċ{j9 oL|d&K\"_ xm[}ˊ]/0Ês zc|3k`;R xWiNI3uѤMdl7PO?gcL~A߅> stream xڽXKoFW>Ih#HI"5C-$"T v@y|3 _=d-qn4N,fj.>.VkՒg[Rmo'eXuz{uOTQLo F֌T彯- 7s翎a#M_StyZsFͿ쌭1 M q:(ˌ[aEpC*X1&&`m `i4ҪAfМ%Dst_| âJqU `$></[_{v)pHU(Q}E+mƪD9&YsնGD?_][>P*͢kmUv9S@iG!ՋmbW<*,#[ֱYEِ{}~mmrOpvXmHl|:M kOy޴IY H !O^=6~o?=م"mO.ۤ)oI:݅ۿN]-[iL; S8#,Jib@f͈t2~ 54rʰW$$;@ [@ ^&SnH\G\HZFL@mHn񎐕k .E|v3[E"ԇnW>u@O7_A,"C~Zh;T5pվF1O㘧Z:t>R!v#eםE 49J(O䌰x6|y]GQnwdsn7O򋨤\Hlt3~"*Er5 cc{dG~m^bwo`7dbB˒`:iu4|3q7hVfńiVi=h֝f)όKc\M8ZзZ*3@CY\ͶӬk4R=gס$x>[ .}2R:(%0g ڰLAmCz1&e ?I{p ^ IP]/&"&ỉ!9&a*!QSgWSL Gkbaż'+ :q3cףiP;Ձ͐_\SܳT\9̫ W@) ^ar7D)nfD !RȞ"p>a;lÒ)1Kh6Z`(=K32{8`{ZN^M{3zt?#ZW>wZɆP~\R endstream endobj 615 0 obj << /Length 2057 /Filter /FlateDecode >> stream xXY~_!1@#@8q2;-GM IdS} )zaW|K-?m()pWۮl{ᨨio[e׆xfX)_܍!]6M=׃xΡ;_cRc槮i:gop#mvXp?nwx|6?WqoGeeX@pK-g&Yj7;Jv T8Nl1#F Tb,SBLJ!/^ILaEdx"&ZJLRh"px]Eo@c*4b)KkE$8N!D`Ts-5Y)2k\ Vr"ZJL'J"D D\T$A=$|ZIbM(\惷%Ft%w$tD1+یI|" wbln/79 ~P r*IIRQĄPRB~NdxՂr7(rANRY7rg҃$s2+e&!|*d4ln's] az 61}^(W,(< n\簈$B8H59." D En * O4К##c *rXgu94t"deTNhͱ>c*7qC-['Suy{wc[vG"[ju{L5+N=NcFx-g0+5cKG(Foм@@9,{=s O[ ;q cdݡfWY8wa!afukeqX- 1ؐ}O[ ~>]8Dqr|LUc=Twrc(7Wf4tژhXfPRRcG莁K(wgJY`eDIdLg/h3ZSƈ!sT*:U({7+vpmFbMiGv:/|]֖S16:ܟBՠbzs`{E"FL裇$"g`'WJ,x2cZ j<QY<H&d5'l |Pa:{S^#)fŏ?}`фmp @.ܜdk= ٭=,>5F?4_CXv >$Κ`қp&`  d\@ڕ0 `Q|qpPx*)hĀ=`|8(l{|j+ pX@- % M)v#Wj3;c$>!P-5H39EU` XkNGzV: ;1$2IWLY/mJp8!j b`ZzصN{KͤOA$H,8F4tc־u*0 co.0'&Vpi̋bb]=0iޢs)j?C!"wF!0bR83\N9C "FbH|lsC]xfȐ\II 20ᱏs$o[XdX)8}f*9@~orXN@}tMyWwV endstream endobj 627 0 obj << /Length 2492 /Filter /FlateDecode >> stream xڽ]۸==D\i637Ih[^sN|C{)[:4 _w/)SH'wJY'yYj~ښjY"{.uE ]vES̄~q5-Gۘ}?|i̲LN$ey,ɇXprƸObBz0x`r"8ъ D@?0DG`J/xũ@JJXV „yY³I!r>FϙxW#.Ix+< H$x&~HdlATrrgE0Yj}e8 t$c1? oG\툫=%{ S,DxdDA搣g!%jཚE<#8ϱe<1kzF b&=FGWmġ!'.fa,GVL$!0WhgfA <@:]Ɛk.HY$)$ϖuV-c(8Łcq˘gAW"`3!ǹ%""^Tn|6ժpVŇ8L]1< )gTfr%I {uvJ65 bٕuԴVn1(_Ze0AXeI}[ؐ.Bm%<#2۩;W`QP:bXf1tT/Ad?Wӿn xg@3Ǜhqyt6=eJQ dޜ\@`A)ZRΧs}Vv.@3 CUHN/˪:k @WRi-@,K#*X3t5'~]׻Ů:@C7Yf?l>^~xN#^"3ů2b3f8:Q@|3lvuW@k#bؘ:ap94 2XX6ɂ  }i 8$!׷*<w}{f89?Qdъˣ|]%uIH2 ,Aǰܙobw 6]%w}M7%l=%@7yr@,>-թZ# 濗f{:R PBSq{C]vŝ]^Źeҋ!z}M/&OBw{N9 Go`K;'?tO3Ǝ"&bh4_- a+>U8ž2.vD)u=vK'ͦMݝ=>܅>́ʕ0w֥SKմipkqN$}>o.KKkv,tnΣ\<IkYs0=?=DyA)ˆ$bOt?nMzW4ԇFWNoAũr7)My;.ޝY!dTοOzz4j"A䑎dh_W6{/|l[bvń ^&bɠt,i?޽? endstream endobj 635 0 obj << /Length 865 /Filter /FlateDecode >> stream xڵVM6W=Mĝ!_A[`7MS @E$Z-GVDZ7D u EΛ惴0~03Z(2n=y?Ab4.^mv]M簕G|rqt7d̃^eZ*"{=YP\j'\!LXU.,Ua-hTlaI=-e| q"O{ّ2-u~_W0kMYeq\-7eQu(W{mQiԻ(BD1r$&Gr%~|~Y4SX9㧦ݽ -'e|[]Sջ`% !Q![9Qx%X 濌0'pG_u},w_tbG|9|cYnLpqؒqܽcOgOoqu}?M.^vy:R*j7>Q˫p[׻j-uiVrӜ :A}? d{t=~Ǎ PaT_E֐$JyTlO# Az$I{#X~N[.ew>z֣z/[KP7= ȡOr=QW(+Φr[D0) "Vъd!H؃kN5&A4LXyoY2QS8`S05ynP8N`tq36V;I6=qiu4#6/? hRMcZC㦡ƑgC2`Sd 0ivd 3u)&[$z m,(]&*O endstream endobj 624 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp5TQ4ft/Rbuild67ba7a7f86f6/gnm/vignettes/fig-Effect_plots.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 639 0 R /BBox [0 0 432 216] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 640 0 R/F3 641 0 R>> /ExtGState << >>>> /Length 4095 >> stream q Q q 28.34 31.10 180.06 156.56 re W n BT 0.000 0.000 0.000 rg /F2 1 Tf 7.00 0.00 -0.00 7.00 44.97 51.31 Tm (A) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 67.68 72.28 Tm (B) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 93.33 85.85 Tm (C) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 94.07 69.87 Tm (D) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 99.71 83.19 Tm (E) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 106.20 78.95 Tm (F) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 113.86 73.01 Tm (G) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 133.51 60.60 Tm (H) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 159.70 56.30 Tm (I) Tj ET Q q 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 51.68 31.10 m 185.06 31.10 l S 51.68 31.10 m 51.68 27.65 l S 85.02 31.10 m 85.02 27.65 l S 118.37 31.10 m 118.37 27.65 l S 151.71 31.10 m 151.71 27.65 l S 185.06 31.10 m 185.06 27.65 l S BT 0.000 0.000 0.000 rg /F2 1 Tf 7.00 0.00 -0.00 7.00 47.69 18.66 Tm (-4) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 81.03 18.66 Tm (-2) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 116.42 18.66 Tm (0) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 149.77 18.66 Tm (2) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 183.11 18.66 Tm (4) Tj ET 28.34 51.40 m 28.34 167.37 l S 28.34 51.40 m 24.88 51.40 l S 28.34 80.39 m 24.88 80.39 l S 28.34 109.38 m 24.88 109.38 l S 28.34 138.37 m 24.88 138.37 l S 28.34 167.37 m 24.88 167.37 l S BT /F2 1 Tf 0.00 7.00 -7.00 0.00 20.04 47.41 Tm (-4) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 20.04 76.40 Tm (-2) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 20.04 107.44 Tm (0) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 20.04 136.43 Tm (2) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 20.04 165.42 Tm (4) Tj ET 28.34 31.10 m 208.40 31.10 l 208.40 187.66 l 28.34 187.66 l 28.34 31.10 l S Q q 0.00 0.00 216.00 216.00 re W n BT 0.000 0.000 0.000 rg /F3 1 Tf 9.00 0.00 -0.00 9.00 93.91 198.60 Tm [(Site Eff) 10 (ects)] TJ ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 97.36 4.84 Tm (Component 1) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 6.22 88.37 Tm (Component 2) Tj ET Q q 244.34 31.10 180.06 156.56 re W n Q q 244.34 31.10 180.06 156.56 re W n BT 0.000 0.000 0.000 rg /F2 1 Tf 7.00 0.00 -0.00 7.00 347.42 123.78 Tm (1) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 360.67 127.41 Tm (2) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 360.77 126.05 Tm (3) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 347.84 119.97 Tm (4) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 347.93 116.64 Tm (5) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 358.95 113.00 Tm (6) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 347.20 111.99 Tm (7) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 348.58 106.53 Tm (8) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 350.60 106.68 Tm (9) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 347.28 103.77 Tm (X) Tj ET Q q 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 267.68 31.10 m 401.06 31.10 l S 267.68 31.10 m 267.68 27.65 l S 301.02 31.10 m 301.02 27.65 l S 334.37 31.10 m 334.37 27.65 l S 367.71 31.10 m 367.71 27.65 l S 401.06 31.10 m 401.06 27.65 l S BT 0.000 0.000 0.000 rg /F2 1 Tf 7.00 0.00 -0.00 7.00 263.69 18.66 Tm (-4) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 297.03 18.66 Tm (-2) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 332.42 18.66 Tm (0) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 365.77 18.66 Tm (2) Tj ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 399.11 18.66 Tm (4) Tj ET 244.34 51.40 m 244.34 167.37 l S 244.34 51.40 m 240.88 51.40 l S 244.34 80.39 m 240.88 80.39 l S 244.34 109.38 m 240.88 109.38 l S 244.34 138.37 m 240.88 138.37 l S 244.34 167.37 m 240.88 167.37 l S BT /F2 1 Tf 0.00 7.00 -7.00 0.00 236.04 47.41 Tm (-4) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 236.04 76.40 Tm (-2) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 236.04 107.44 Tm (0) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 236.04 136.43 Tm (2) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 236.04 165.42 Tm (4) Tj ET 244.34 31.10 m 424.40 31.10 l 424.40 187.66 l 244.34 187.66 l 244.34 31.10 l S Q q 216.00 0.00 216.00 216.00 re W n BT 0.000 0.000 0.000 rg /F3 1 Tf 9.00 0.00 -0.00 9.00 303.42 198.60 Tm [(V) 60 (ariety Eff) 10 (ects)] TJ ET BT /F2 1 Tf 7.00 0.00 -0.00 7.00 313.36 4.84 Tm (Component 1) Tj ET BT /F2 1 Tf 0.00 7.00 -7.00 0.00 222.22 88.37 Tm (Component 2) Tj ET Q endstream endobj 648 0 obj << /Length 1155 /Filter /FlateDecode >> stream xWKo6WB21C>dm@b,JחÇ, 3|C9|r}ArNx0 RxN(8oѼƔh-V-e#֩eɺWv/L'NIvXJVV)I>'DXG'QgE|XJ}~<3914x6#k0׋Pjk%qrBܿk*;>%TH"pQmet8u ۅ n8:y,(T%w@9fĚY%N.}v.b+7$ՈH5*ytbQk'}d޹ smB"|Xkַ֛p`%9-J)"ECq(wC97Vs?Wmű|Qq4D'?'pssgr=s8aIjG^Nq΂{SCw' 2!۴j rL"_*3s1Y'} /Mж'>Au(wUHa5ͣ ?Alq}q]ٷ,JBC4iM̢GUT]2qn FuAԝfߞ+R|}ԂY:#ƩҗQ+0_@uMMaZHCe+**UK1vs}fI:)y&Mc>3 $φm Oʹ<|64cF+8PZL> /ExtGState << >>/ColorSpace << /sRGB 654 0 R >>>> /Length 758 /Filter /FlateDecode >> stream xVMo1ﯘ#Heb{ i6R+ 5RMD Ԫ.ЄbUꁅa7ϖp๺g0PkPPhVSj8_χp$ !@d::#p|IGUQ090~Nq쿀EaPR'4O ̂/%PPv64>-zf-}VLh-He,ay#ϟ2p.yt6(,HoҐz$ 2BN`*TUذ)T:EJ=0%3K Kݷ`/ʤ;W +x&} ٲ\ Ba]/W- 1  o@]%?\`r9(fF;}}M壵m b 泧0lshW5Cؚ[0bqyck4NT6Ҩ6݄]H!m <k6|v6U/<[ #Av-86i^dڄh},}ow{/XeZUiI r2l_E:d+FzG: ⻔k gO \qgaAM6 /ox6oJr1]l# Fe@zמ 0uY(趒l3]?JK=`'>?fͬL;ڶ bS endstream endobj 656 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 544 0 obj << /Type /ObjStm /N 100 /First 903 /Length 2587 /Filter /FlateDecode >> stream xZKs7WƣlReKj7Iٮ*H">R__)r29Ap>4\VF+ eP&QETsV$Vʜ{GE&CQx`EV I cYy E%XEɠ}`&J%:6z"Dep@Tu?l1 ` 3CWΒg\*VΧ (V"f梈!!G7Z0Dt &W%!`1+AGcv9)L  ]XAPz VUKM枢MP >Ak?tbbGQqENRΊ)Ψ'"/y<Lxҽax$XSyq5(V ay`D UUQ%YJf*E,#:%$ :{1施v Kި2%f,}`h%+;Q['!,>ɻ`\EOt&DS!/yE1 cxc!T#䀝=ڑ6S {WJ?wUx>J^M~5~j0,_Lki zozi.]l|j#pOHے; k;᧏N܋ў^b]bZZ\;ufkk#C۶Uw!IydM|2zInO^x W^$o$1YqHRw@n`6Y\G}(tnwivq6>W.}xl?R$ endstream endobj 663 0 obj << /Length 1321 /Filter /FlateDecode >> stream xXKo6WA6b1|KJHZۃ,Hf}oPla-q? H@`8cA9{8Cr,:`M̽$[} Sd;EDRܭBJ820 ٍZbRgIb<$22BŃ;Bc|$P%<E;oz[Tver՞9.6!0qzch3G"f>?<%.| cG)ue|#A#y o; (;g+6B1C6qD"ϠoT8=0_yOdOL(J(u)LP ʛgxeyRٖ=4K[ՓQNV.aVO΋ "9;aac 4(x$/⠏{aI^4f8GR M D+O?M()b9'NeD xcbȱN◊T+bJ1_ńbf1'.惂!trKo%'I2JƢ>xeq 4#N]__2^J0wz HM%m&7 i?e/~.etHu\<\r[}Ku4]Zous.rO o²q8P6Ħoy,xCaߵz{w߄wf67iݛAb[[Hc{Yn}. Sk\2]e3);s{4wχiv(G~c16v]md?Gޱ]^>'Z'aouUxxbz H,WaKk33iUրLE|Iym^>yf}i3Fz"]|,uGaUe*/} X)yr xޝg endstream endobj 645 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp5TQ4ft/Rbuild67ba7a7f86f6/gnm/vignettes/gnmOverview-Biplot2.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 665 0 R /BBox [0 0 432 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F2 666 0 R/F3 667 0 R/F4 668 0 R>> /ExtGState << >>/ColorSpace << /sRGB 669 0 R >>>> /Length 866 /Filter /FlateDecode >> stream xV[oS1 ~?DMbI *4@ ֊˿IV!Ӻ>_>G1h8o626bDKpwpκӨU=/H>&Ql5),fY0;TV5e` VV)dQX ' ` 0K+KJN A2yjtNbJ/DSC \FKm,*:XR9h Z1WBx' J`n[:=gi;٬:۲hB}0Qpdda lZٳ SF$A_`^Nn0"Q䞙3M ]'\O_/6y" Wa~}|o3+rS "oJWW 9r難5d C([gi5C&f~|+CY_Z]z U_Oc,bzmi]6ڒh  * (זr}e сPre:(bː G`NS*]O+K=W+5}7;Xn~.7;tj4Dˍoʫ endstream endobj 671 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 678 0 obj << /Length 2898 /Filter /FlateDecode >> stream xڽkoD{xzwEh$(qeH츿3HjewΛ⛷M2I&'DfDIJI'/`b(.~.vsv1mYu{x~堺qM[W/٧˿MɜR 1`w8=|ٕyxXDŽjI:L/gs*To;?+c4>L󛷔1FJ#~r4#J+$G&&n,Єkϰ"q$}gSS;12Ap5uw뮬MUf8Z Hh^^Ti $9|px74oöuk |J{7}U<\gG3ͭ A{NygfTL\Zw9ͥb;7Uzڹguke_^ 2t]_mW.A]kG[<)q~ί'lr"|L&eiuHf}=S]kؓo.f,:F!֜qFO2۶ w *@Ɲ e~LOs9}ˋLqI8C&çdR"Y$c$zo0RS Lz.0c9m,!T@[9q_ 2qػ 4"4(/WQa~ U8coE uXѴOwa6tH00(HQuw2#N)f4iq"PS#G0/E.wnird#>UQbtu)Wg|nFUyŕV.O>u<=@^0D="82sZ,L&!نpN X@ yLa<.<& @~ I06Dv,7Qu7bvv0h j;fT5ofgHˑIrFy&n"2:ĠQrEia p*E4Ṃ%$9{|y_! zWσv H}Vjm b‡3Nm[Q;dk{c_S+f%DbG/a]Ŷy{Wfe!*=m{ 0îwC˦8ؒ}ViVoWfЍ|0bas겈]UU c?p[Hc8>xn*./q@״@B`7:e]t EMv]y ng.|"QV{ʲcd5 \c\PcslN1~UW]CF e-كI}ioLCUck5~|Lwel A)|6"H(#J/YIkLaHnW0 7''\MG.QR@8@dJ+K^kP#J_v]ˆ&on f8[Ո!IO#ak i̺4;wgtǺWpk5vQd( ԡĵɋH'K:.S`1v " hN=N ;ȉLOP&?J@ `A endstream endobj 683 0 obj << /Length 1112 /Filter /FlateDecode >> stream xڵWM60rјH6 Т@H+ɛK~{"l:N/șy3ͫ7BJPX .Pl ux`r>JEy~Z Xl Tf둩׵n8f5lNm j›WyQ_JcdeՕԙ|FHwKuOOci ][m}vNd[}~9"T?F6&ڏ+?n>4~:Tu/I<'q2Z C ǵi 9O~0E(T{k6/sLC8i#4c'!1+әf˙M]T{c_k_rh> 0tL O tţH$87mG=lwqө#]'Ύ0!4]=B:Q G")J;I'R7;p ~ህPqDp*J@J (3$P ~HT9'E@/ :-%ekk7ɾu MXAܴ;P G/^h|n$YLMPs0)8a7aal)N'wd 3^Ph) BRtx#o~[J1 endstream endobj 689 0 obj << /Length 1609 /Filter /FlateDecode >> stream xXKo6W,v[/ÇDIS }PEPh$Y׬JZnΈV\$hCOyg>}s4^($E,TbHFdbfy4j-Rl.V~xRM"Eh-U҉Eҋ<"oH߿1u~DD7D@BK<c>ƽc܇4YJ ڦ"\Nf[/MwZVMKظN/^X4ܼ޲K&O gəMquߍ5B31謣("HkVze֚jc:{[{su]4wYi7hq*Lvݶ;ԅ9^c0_Zg*]wQžjm_o ?ovuoWmfj{~)ް`C]Ը񹽘F@  0!2mrmL53\d}gkUSo0Dl1bAV۬,ΙtAR]F@) c\{\4F_\*~mCHu\{RD$Ip~UxDĢѕfsSmZCA;O;ܔ)X %# (64d(jwW{Κ$JSBwI",5xo!@J+M _yN=$Jػcp\39mB9>%a1}2DpȨ00|BC5ʉ%1cʥXʣ q!tEzp;'v&?݋ G BL!K1?1b1I `#!w!1OXXOdVG}bӏLDF4L"vMHj!9tϹq|054u'=g9P#ͮ?C-@vxQ^ [6`'#4Plby-GQ.e7vNL50etKEStDwf2is9.:h )$u`Ѷ# \]~Ň( !\jt0SgИ?6KB nt?ںz2TvٴV;FŸɻ C+y<'Gu´} 3f]pԥe7:R ]غ>{|7bgmyLい崏0O@eo޾C nt8we<φ;;(} +ED)J>?lS5 endstream endobj 693 0 obj << /Length 1404 /Filter /FlateDecode >> stream xڽXKs6Wh 5<><̴Mrĝխ! cPIʶ2.DTcvNXBoc&ՄD4#4by6+(?JU=I.ܮ?KYEc$R5.kcKOg4`|:̘dDJZ:Tm6*]pzPS"i9ً8#"=TSи6٨4~F%q\f:?;h3xJxkͧ ,,Q`2uݘTVXoS&z|,vyci&:TTJm"\J3TC6Bᰢg!Q Ql8=t ΄Ly|o[[k4ѥwno9pñ]ZW+v2X?ZrcpͶC~D[p汮7fA3jWi,pUT}oڝkz `\"!<;'?Q&FIÚZ7#4%ǐHXo.  @7cεan1' ~8S7l?s]l 3kQNIە*L,mA3 XG-] 9XʨrkT^t¥CD S8=@ЙQݬY.le Bd2 !S"d*1մkmjeF Ԗ^#5i;wg/*[yTCv" z]{ و F0NBug!@ГLD7$!8<"Rq *;~Wv`o}4y˛`X2|X rEi#=}Qc3OfVhGc cr|wT-; [SpeJ0gk¥EH2ZF[5J, 3[[#@]=0-Q|2Y$poz 7sQ)lf xUu`|Uw= 880? ң_jGn[pUw:ۇ{ض[d`VFg#>u|Jxq`tKוַ+l1pql$Io> stream xڽW[o6~ϯ0Y)[.IKK޶=%Mb}"eK9@%;ύ_zK(TήV3!LI$dͻㅠbN A9-(CqXɾ/*V~)um ҄;Wo#Sp\y#763y:s.xgcE~_?/~l-uN:rʴ{:|enI]{, +JMj3x֓n3~|{.lU$ѵ,E~Rl6tSg5mmuj+_W.EB+m, sOa^-j}kt][D(dSzw[eo۹Ǎ_oZ&OM,6_HEFHe3OT> stream xZ~/!֚$4sqIPJbN|ޙ%Ev.1;;; Փo9狌eFBf2H gכŏ+c^^/yӫ,Sj75=U:Lݵv~pK-tm[ċ%,Ӛ6ō*;!Y=3?V+Imh/ >6Փ!!D7{Kʨln1!M|4"\G_v.~cYձCYضu鬁͋ncuO}Qnb[6l?zf143f!A90Mǎ$ICLRU ݂ۀt̼̄i;V><,JfWWk!6ljRDGx9ΝKP@d] z~_nAp[>ŐSv_d| GڼE{/%K,ށZSn^}ϊ6wıdJDOJlЏ93d)"Srb>./y{k7!(f8gSǺ%xBZp'%?L&/>|82/L枚yv푥"ñRm0gO3xDto@ۏҁ672`6m՝Ы8H=<v@D{M[c>0}?|+yˎb:qt,,̝_GaAõf˪C#iuw:M"Z{hfS9 Miڞ% f>{qNHh:c 3ze|z 8@ Gw| TJq^Y,%=(ճP &DRc8cR KqN75sāhWi!ߘQFZcK+j,g%U ="ݍۃQH_#m]!lZ* | ZxQ8{#/QۼrAh2trƣ`NNq9ٜFg>QX*MUWYEy׷5nvnO7ArOxKj'<(HlϻDpB?^a9˗?(꧄ B5ţ`Gc;oh^nue7DKueGs'68h' wFu7~=>4R%>NPK^d.Nnf D~T.SE& ϭn`SNXh(O^"^9maǺ15> stream xZm~Bph_ܤ$@M6JZI)R!)_E;oKQ:iRl<3/n^|ENK0,Uqz&2ڪ"v&j(5EV.v²a 힉oΘC{ UUˎZC3;K3Q\C Ze?[WU:u9T$:,vwZ$9V۶{`]It@n|}cQn;nTEduyy{a$J0¿9v0I( }`p< ѷ`Q'0}>u?}EK4J^"+\=(8z{dڻ6?+$> ͭZn=3v߲w͆jWvj)o^mSBaw~O lY3vxm߼޷k_y|?3  -?א֏u<=3XH4VNrj7EQoSwy/mߜI?`G7d'ѿ }fRzwRgMzLA4ԹF;}ʀnu]{J0x]b{ h 7{ci f.VyYPI9XًG_=T¦Ѳ=~Ы۷rIl {p*MZnFP 7)Meg#ƮEM+0CʱՕVtIכZHG4\xM/NLƅ磯z){ b o{~34e]pC=JY sdH=~N$QSӓBP;^-"`5/~'#5Pbn=/}9"?> D?ܥ5.. 72$me"oS<$p,i|3a"}`x3wo頍*֒䨌0* [=rjMF1TX6TͲZdtM|!dNx/jn:n-sAc Uv1?.<\Ncg w:Ȃ. l)=nZÎT"%redX|v(8ӉUp.cO@6l2ELMeB/Ҹ@3,QFŶ hD|1aQ.ɓn.Ita"'>~#C83'MF}?sJ808tk]גy.*P {G%,_8љljĔpM:/RgU 8`n3dTѮAIsV[㱝cU5|t'[AuC ( 6!zD;Y0+#wQ%gΦ&-%)Ϫ!;x&Y~SD ~&WPPK_®OO>+r"2F| #,ԋK+UCHe l"hȼj#$a(QN% ^V +CpRQň$W0{/l/vl<>8w8գKgܑ9}[\C==*ADbjueʺPg3pw;nN`S=IxT!@}b 䖿Nr:ź4U5(Tj2$@  ےd.eTF|i0 E s"kc+T%A PA8Ӗx8Hq/.Ԁs5b%V%HU+_"pVL@ą? ߞMTa^~J0vr4pl k@º.yɧ_vP!X)M p p>,T0UbmdIr[8߈̹g&o[gv|GlU2洆kH/3WA=-ůxxW W,V71ĦwĹ_3] +2t|pNSuA{2KgxrXyH7ԩV :I6 ]è *5YT"֣-vpx]> stream xUN0w?ō]i*X!q qޞ;}ӏ AFh݃[!; >א!'p2'#;89vbg7VFUxnN륄+#kѿ߬4f >biHx,9W}#cK y$R}W`)'RQSBv7M endstream endobj 724 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp5TQ4ft/Rbuild67ba7a7f86f6/gnm/vignettes/fig-LCall.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 745 0 R /BBox [0 0 720 720] /Resources << /ExtGState << >>/Font << /F1 746 0 R/F2 747 0 R/F3 748 0 R>> /ProcSet [ /PDF /Text ] >> /Length 43210 /Filter /FlateDecode >> stream xM$ɕ}~ _1  @*@"":G׎3w $q$y<EtuUS^=b3[k2>Yc럎r[=?=;C_ޜ~ǷLGtٛTe>S: K5Ⱥ1&[Muz!dR^/NJlך[_:Yzֳg=Yzֳg=Yϸ~Zrk v+)TcGLk/&#|Ȳn;S[\k6-8xzֳg=Yzֳg=YzֳR-l8+TpfbAnj_|LoiG- 6zv&ԼݴjRX6^:Yzֳg=Yzֳg=YO^[Hf 95po {g˯G2..Gvv|?~o~#뼕/W}5=v.o#6ne=7ɮQ>Wulqƕ# _cr=u^!ԟ;5k{j\_:Yzֳg=Yzֳg=Yϸ~Zrk o*zDZ:G/ hb=bz5[rRl~ti.%6^Yzֳg=Yzֳg=YzBj}Vm+|W&#"uh8F/ bJ;dr< %F˃{j.lZjwS_x}g=Yzֳg=Yzֳg=?zm!>|-l8+Tp6Sesuֳg=Yzֳg=Yzֳql!>|-l8+|/8k0VFL k/=ƘlxKBNIT|Qs}u6^Yzֳg=Yzֳg=YzBj}Vmgy·q ,g A޿t5ʗ~YpSe1&m 9a{j6oZ5qjKzg=Yzֳg=Yzֳg\-ևom+|Wlcӣ7!Q9cx˺1&N/QފөYʃ6^ߵYzֳg=Yzֳg=YzmM\,W6lAn[6uֳg=Yzֳg=YzֳtZ5m!gYm\ᧂsWLYvv{še/boMuGysQP{+ضD_2<ؗ.:˚8s_˘]6o˝9ƙUwLkq~4a:'#nq%;g|%ʗ%R׬H<=1- rXȞ_}^8gdz8Wo,;xcIƍuNmWr[5Q}]ƶ588s_ΐ.WX銵˝9H1},;xJ?'84gB9׬H<=1- rZȞ_}^t=UG=L[M#v3/N4f^ɚ$'d9ZV9xzWM3?<聾]t9?đrtIBȞ_}^դ`VR-ߧd_Us0#1'ϳ>6NɁ&}Ү_bӵDwq$%00000000000000000000]6R5k;s뙿+t.t__bY%Wi,;x>srUǕ}%rw{YZ58bOyK````````````````````|1C\m`+.w6<3W+nƵqs~dgj\eWz,&,t'lqK7Yk/53Y?đrtIBȞ_}^alٛUsg erz%%J?<-.F9cKM9o /fh TFgz?ݖW}^ے8$ϲrW,;xgS4fkj+,_)qEN_g!؏g!_XLk^bOlHyK````````````````````|1C\m`+.w6<3WSW\Mg}ƺfˮYK6IW9`JAn5#֬H<=1- r}[]ldyg>{Wq,;7+vєf8ؿWl_D Rojw1׬HlHyK````````````````````|9C\m`+.w6<3WSWLLG WmkܺSYM1pc^,kػ}b11y=#1- rXȞ_}^oO]qV'v Lk슽5wLc嘓k3(JvIJ%77X'%00000000000000000000] rugzw ) Mqkؗ]q0wMЖyIot{+ٷq~ƙ}+{)ai*&ĜƗ3Vbrg#{γ=y=uɄrhMvcXf8bX rIJ뉺%j`_ XLk^bOlHyK````````````````````|1C\m`+.w6<3W￿p?_~=6aGǭߏ_>|G%mIG=gy/`:r!|0g3mi}fB|sY~# - r}[]ldyg>m}}kGawqͲ]q<67o9yoܬJԶ%`/ћV׬H<=1- rXȞ_}^oO]q2j7<\Ŵf8XrGf=4Y%\~E\##1- rXȞ_}^aIη#,>0~EruJVx%O{)9{*&ĜƗ3Vbrg#{γ=y=uդ8N=&'GGYv+n&+cNbR+}nb&5/'.Qs_.WFgzw}}ծ؏3S4Yv+NrvHѕc]z%["u+N$(ְfGA9o /fh tFgzdf)|24h(5x]5g倎q߳s ΄y(Ҽ){ 9wUM9o /gH TFeV˚+*ޓAvre&e^oJM&-V˃}ob&5/MĜ3mu=뙿+EfdA4ѯYv+8y_9`}^|Wﭵ{(fGA,y[j+]v=ٿ??¢/}%GX|ha oYO_Ќ6嗋܃=g^YX 壉+˱ Wo0?KLM,Ɩ588s_ΐ.WX)˝9@dXܴ󪹚 K^⌍k7jnu1'J+-jUs36mb&5/'.Qs_.WFgz;0MHkKGq :'_vyeӯDRhw158bk_.WX銵˝9mJ;|m%FxfylHҿ\+,Iy܈^6G!DҧA fGA9o /gXX˝9t[r5A׿芫;,;x7ic[[<:Ǖnʖɸ1H}}/YőDMyK````````````````````|9C\m`$Ȟ_}^o:IzŴqct,;xW/wu>PgJd%r3} }őbvJW]ldyg>8fRq$s-&5^wYK6َcN~wO;j)K>Q>P5G9$EB ,ou՜sðꇣ^WZYΩ\%&)R֬&vQ: eh TFgzVAawF;g뮸Vnxޟ]*HIn^>ž[׬&Nq&t_͐.W7IH;s뙿+ے RWW1~fLt gy/;jM St|?Ysrb)=8ۗh.ښ(KԄ{kj+v=ٿ?精5Y獷)8$+=gy,G'[dRѶf"F)sUs.f5yO````````````````````|-C\m`j.w6<3W WծWفrƜe& L6u8Wj49mMx졯䶉}/֭YEML'00000000000000000000!]6o.w6<3W%d U ޖ Hiu^VޛqeԹo4֕L["SO׸D3%qyO````````````````````|-C\m`j.w6<3W>j/orn=[vR3GoMXYvz Ex=u^7k_x^Ƨv>hb^q{ȣ u^N>_zDu^/r總M:nuםl5h|:"?L[xǼ=倗-:oR>5=(&=yOD9teK'j%tnĜDwx')-H֤SyO9"}K%tĜD0u'q D+1='-(D&D0y'U%t>=SgJWX&=[B-]wۧ=L{B=噵[B-!ݺ}kA~#sK':o0~SJyO=-&D?_%tS&D{s[=~\hyK_B׼'o Do\[nO}{"<[B=L?9o~5]yO_M׼%t{"?j=a[B+lWO}{"cA{b|zqbcu%kI~u%z_X?0$q[(0}qm۾c懯?C/؇wvWma؇þ~鿮 ? B{cX~5p1[rːA9^Opm0~LNVvwm_,?cw}Vg$o/ǿ;? !yti:??_˿ؿG;]oП+_{y<`ʯ?~/>o揧[_֜/xGqD_5_c?~~o{z?IsGBg;gꞻ?|4VܿzGݼ7m]s'oMC׬H<=1-Y g6{.yug}X9$/mβ׽wSc7ʨFi}wJN^n!5Uaܿuiӡ##1- 饵M[{.}^;}H?%,;x{R?<)+ǜl2~q%bl;?UxU988sؐ^Zd齵9. ||Z ~ǧxEZ|1'мw8JT✓ynő쥵M~[lyvg>Sr0+&;H9^A8Q]V9"oAݸQaK#҃}$K&5/'6q$%000000000000000000000>{k/=s]+{'yDk#/;&5޻ ~srM"%J2=Kr̃(ώYőxKY&Kﭽlyvg>s݌MS7.㹖1,;x{swsN6 0WrȳW<~]YőđĆ&Kﭽlyvg>sL GJNZmA1Yv<1'׿r{W-Qzw;w׼Ğđ&Kﭽlyvg>s]偗)yOzrƕ5^vȣ9vcī{Wrv-Q݋sN}oIaKKĜƧ56mҳ]>%Ow__<4Q;&5^ީ_t,w{yJg[\MbkVq$Ğ&Kﭽlyvg>s)ceŤf;_XTre9[>-Q^b29<ͭYőx{b[Kk,ҳ]>%~wt;Y1iG%/=[g#y-VT׵y31e}8cN>lӺ]^}^b5obߋkVq$.Qsؐ^Z7IH/=s%͋rz316NOюV`_y&/W㙡:'Wo aK/X׭q8s^Zd͵9.ymܨͽ@mMG2@1έY<XI9('[Ww&-qDow1X׼Ğđ&Kml9k|6rym͋T)zŚ`,oumތ |qso=gz3WJ~Մ(fGA9o Okh/mg|Y3W陞}}6w/Ķf޻x=lu>'%?]cS; ?Px7+gŤ＿,eޜ z[>Tgiױz%*7_r>ַ>lvqu*&Ĝ'66Yzog|γK>y{lb,;/{bE0sMn7׽Wsrn_mXM(k^$.Q: jh/mKvg||Lң??&Yjs9;5xU'kMcA c}]1qD_wyDM'000000000000000000000>zimdҳ]>%e}oV?vLhkq/7Ys똔uDJrJn/1XU.JB=Y M[{.}^.. lLyZG &m ܛ;c~*'Y> 1{S8zfٮWZXw뜣?z쥿58bkذ~k/=s]+|g{3^>#9gJYe՚0~BgyԨl6ƕɴ=TR.:m918sؐ^Z7IH/=s]+{]4-Yv&#X9lh]侅DβݾDw1׼Ğđ&Kﭽlyvg>Otq%_Iry37З5x]gS䘺~S`U+%7VKaInKM9o Okh/mKvg|?.^M}s;iK1vsYB{+&9J̇Ͻw3?ŮY?x{b[Kkz.}^.^kgM*8i}}M!v(Eۗ}{,]tw]+)z%R}q&G58bmkp6Yvg|γK>y޷k=kv](|4Sܚ坿۳o̓u/_c@J=|^b2b1YőđĆ&K߮lyvg>(uͫ r3uf,oumwb*&[ü}^ɗQim^|^#qFHM~Dg|γK>y城C$}Gׄ(gYv^Xݬua%Ͻw1͏c&5^8=:T9"ս}\[">XMʏb kVq$ּ%000000000000000000000>mug|x-$ONi-`r^y&#f?9+69BJ~Vq&yUM9o OlH/mKvg|?. qz̦5^$R1'zwJUv%r-w1֬HlHyK`````````````````````|bCzim^z<3W.ri4,;x{VƜ\>d[-[(?<.6횗.ĜƧ56mҳ]>]+cRb6o)ϏI_>S4좿̇5xY'gZ:bIy:'V)>dֶD[/1]&5/'6q$%000000000000000000000>Rk/=s]+ڼRv?0X}{0'wMkwo_.1K@s+[-xebkVq$Ğ&K߮lyvg>,9ŏS3٭Yv&#o6cNǕ|+I^r{[Y# - 饵M[{.}^g}K1 qy(6MKvvg>9ǐq,y_ښe{qpz,8m,_ΣeJIJ%/і]L&5/і]9o Okh/mKvg|?Y qqeͲ׽wc1's"-/[/]&5/]9o Okh/mKvg|?T9ś,;x{glmܫsr^ɶC`f"GyDkbzKX# Ĝg5f/mg|γK>y~s&Ǘ~xxKbkVq$ĞĆ&Kmlyvg>}3InP޻,;x{9E~`1'LXn\!g"'S~X̾v֬HlHyK`````````````````````|bCzim^z<3Wn<3޻ͅ5^՚K&wW-ۗh.:ۚh.Ĝg5f/m$9.꽫7)d_u䕘qsr^f}wJļ%r5=ؗ.F8s^Zd齵9.) 9^X9ť+ǜuJل%r2ǽw\֬H<=1-i M[{.}^޻fR̦3ɮYvnxTLw\_tJ~9`4ڣX'%000000000000000000000>o9.꽛7.ɚ-,;x{ry%h|ʡ}]Ʀ588sؐ^Zd齵9.Z.ϱ;[,;x{ge嘥awWrx˕qrｓieq*&Ĝ'66Yzog|γK>y忽w|#{X?R|Pdߏ_u*?u<9x]7S!pƜl'{[W Lqmތ˗51y=q31-i M~[lyvg>vqY_ܑB4ɍDezliP1'[MIuK.豘z䴘9/'6q$%000000000000000000000>{k/=s]+{G|ߓ;(&5^8>+ǜ]Ǥ+eʖx`/1֬H<=1-i M[{.}^޻q~s҃9Yvn&UNv9hJ{W–H͸`_{%XfG51- 饵M~ҳ]>%Osy^)ye/{oM|c^ݖ}~4AĜUM9o OlH/maҳ]>%Ͻw41X拱~Ͳ׽Ĝ1uN}Cqvz%&ĕ+⏞k);ل%&ĜƧ56Yzog|Y3W.&#*owkܔ.LNNqWZTM%M{{bGb[Kkz.}^oo?,HƥVTS/=[gX qK&5xY{o<ə߲r̲8ouWZ6o1)ޙX)Yőx{b[Kk,ҳ]>%Ohluf;hsS[+_D*/n{QԜU'%000000000000000000000>óM[{i9%Ͻw1^L)kIrL[w9Iޝ^i^V^7{lzqq*&Ĝ'66Yzog|γK>yz`FiYvvfוcN>y{=R&=d9$|β׽w4UNqI1'o5ו+ýSDw1ּĞđ&Kﭽlyvg>sMi<09 MϜe{*GMucD29T/_"7?ŮYőx{b[Kk,ҳ]>%Ͻw3McY,ћ,;x{GϹ:&+--^5?MYőxk[쥵M~[lyvg>SqHo֏$Se{(˩-MW9jlJvUnI9;olbju*&Ĝ'66Yzog|γK>y{lB>u젚,;x{C7^)+ǜ|ZtJx%5j|Y{bGb[Kk,ҳ]>%~wt;Y둤c#EzjGvIN`~_Z9o[}cK 5z7ήY>E}qLɠsrٸC=l\Lq%NG:%&Ĝg5f/mg|γK>ynPsL N&TMkU[1'$2NY/[C>8XU'%000000000000000000000>{k/=s]+{7U}IA>g;[Z7ms9pWDn`{dD'7Y?đĆ&IBz.}^;{ܑ䀕qwpβ׽w0룳Y1JYNYŚqxfGbGb[Kk,ҳ]>%Ͻw'vԿ8;W,;x{gS3M1'Ms{k/=s]+{WR3>Yvn#2vv9&GǕYW-7]{51-i M~[lyvg>S]Q)yOz&5^eK|~]dM [D/ԃXښU5o Okh/mKvvg>sr9;Zb[uMtFƽ:˝qMWcg4S}G58bOyK`````````````````````|bCzim^z<3W2qq^vͲ׽wr>x|^DRv6ŕ589o OlH/m$9.꽫31)yI 5^՛"49EV9Z9M[y9|/] s^bOlHyK`````````````````````|ZC{im^z<3W>kVB?Mi:jZ:o IWb{"{d["8r'g:=Q垁-3?ӭyOּ%}n{">L=Q?9oܿ3?9yOOl{B~%tE7s&'`+?x%t^_w׿w|P^r/qk/?|n.-gcKM.mil ǥKBo.)Z]ol*${@sO:):o$RĜTUlM lzMmK0*5k<.7~_t_gn,o?`+o??~~_N&I#~Z#(VKS??CMU?t͟r̯~Yc?n54DM]{l6w L%Y~}Н0y,ؿW^YSϮ_vR7M^q{g=Yzֳg=Yzֳg=_?[T?f:5so ?1`eI3|Q}'O(7eBs&0A~Ғ:Yzֳg=Yzֳg=YzX/-֟oY[نq+|Wף:yQ?^u Vز^hYh>jw]iU:Yzֳg=Yzֳg=YzX/-֟rhhQgY~m\ᧂMǖ}ZJH  f3\]XPw8QY!eΪ+H6rGrnje,x/}F9z9 eXl;1Uwb.+o/k^zo^ʫK^|?}#rsĶ\y] N|'k='|ΙTŚVVqL܉5M`````````````````````1z&K=z.5c ~{gr{dw;5ݍW+}^K)+8&6qL̼M`````````````````````jjW^]c.rkI +h d{s_r;5vWo㉜kdҗ[.6fVqLl☘yxaCzim^z+.y_1{{k޵F\rO{oLi7SsQ:sVӾxw_wi~%cbme Mx[lwĭ>cbme M[{.5cMm}'kfb\Yy]sbVs=g×X"jWVQ'vQ&4jh/mKvȳK>yz_>ߒrnoV"y7?//o.Ro.5FmW>yp&ȗrSslrxTog%VVqL܉}bm 饵Mx[lIQ/YwjXN_u̩ʓyvMdaҷk/#.5xy39\*ƍk}ݮ,W4?M'̜ƍ+D.rRnL+/Q&NQ'4/j^zoG/g|_̫Z6n_*<јLh+x^G9\OvYv(0_)}mU^,ieubeB>&KmloEZ( W5f/=dg/Vyv5޻"w;'yleL+m̓`ɺlѹfV 9M~;w^m+oߩRGk;{#ϖ5pvN EN)+( xs68A9Ҩ+oD &QN],ƖUԉS Kk,ҳ]>쒏k^w5!hދ;g+x{7͙ǥl]/]_o&m";N_37OOf&[A _i?dB y5B8bwr\A4,WP.T'DQ:xci~K] y2q:yxUC{im^zG]1k|0Eb|]YyLy7^wjvޔy'|%v2n!=$ʽ*.ʄ}U M޻^zG]1k.ɓ jM,+<｛qZ}N 9]_֤M`\X6;Uԉ] ƫe&^zG]1ko?nK7{qoϗ՝qrw֯rO[/J6e[=H\WٰO<3o߭ܬiulmW\횾5p vrI/V/LN&[kk =y|e M#RZlQyc`mF;zZg᫽gK{_, :W+x^(W9TG.R9 jBNs T}ִom}^erߞ먯/߂aeOLKUq<χj|&|l=}= & TW{ZgK{_,r4 ~er2.Jdh۠,+\ hKQ~畺6 ZjO+=lik^r1Vr\A3٭,WP&[ی}{ . 8oƖ;VfToy}`ml5ɣ튫]׼Ưex9-zS埕:Z)eظ^mS&˥Ժ^iTooy@@@@@@@@@@@@@@@@@@@@n)|x )|go{׼?=0hZ( w476l56KWB Lr?dBqy}}w*h=Zȳ=yz(rcq6+hƕ 4{T5 {8WƓo}r1>o^CA4.3oߩ0^iNulmW\횾5Lnq7r}&?-3Zevw1_ s[yN/КfToy}`mf=*|go{׼?ӯo[2.OdM~Ǐobۢ/K_ezڹlBo06 RjO+==lik^_ﱝ:'C7 TSr+|?\Rt'/o|Ws377o ̼M |k6zԽ]quk!Po9G]<;pfOxwEklA}(u1 7gIdN捁 SоWkڏ7ha+h/yˁ=q"ORs,_yLM֌/cru.+ D %'Fnw*h=Zȳ=y ҷ!_&˭MomrδFet16J֘׾|!5)wyyY{jToyM |*Z^mmW\횾5jV/L&;nQk4J=D'K)uiF捁 ViNG-1kC.h缩zԺ\B9lo52NYk켫z"CmU}^J_8"gSkTooy@@@@@@@@@@@@@@@@@@@@n)|BY y5n䝏l5aI=_IV8';w_餫ۄ\Χ.KS ƫKk,ҳ]>쒏k^zh1"WPLL+<ｳq;SةVﭯTo>ߴ wI^neubeB>&Kﭽl&Ʉҳ]>쒏k^_?w;;ë3}䌗SV㜖L +?m͓7)?3g||_D˗.99|fuuB>G,쥵]>쒏k^w())W+x{'S9D6( JRI'f4.oy@@@@@@@@@@@@@@@@@@@@N-|BY y5Or1Y/IT~V+x^(WM6IY3,Y]_ɣ5?'=6ͤeuB>&^zG]1kǏljҌ_?GM"gy&̾۬+qHw^,yeubeB>&Kml';*,wCgVQ'NQ'4k^zR^Z#.5z6yr +n}~śW+x{,'TSG?sǃ:oDs)ڴ& 56M&g|_{l;I)YnYyMם.;5(뵏W r9QLr+/Ol☘yxYC{im^zG]1kCM{Ww&?Yy]-C4[X>^JK,&{ؕUwbyxYC{imnʫK^|zAޮ5T/3<3^h^k3q^C3ٟ޵'ŬVVVqL܉}bmUKkz.5k]qrvIYyMD;G=γ+Z kwy-bjue& 6\Ym޳vȳK>yz_U>ߒboV"Ez7{_~|y|6AnΦi_Ms+x^Vw?9k&͛+əw)ZUvy2q:yxUC{im6^zG]1k}!|vew8\<"'m"uf^b116쥵Mx[l/{䲲\;XknnJlr9ѯwذ~cb ί6M&g|_t齃&$ք4 W+x{ͥ1\IyLxMR-.F*M3o/ldG/W콓[*3<ｳ< GΑurt^a.焫&ݟr.b~%cbme M[{.yv5Oo?ko[2.OH/3?n?ҙ>|[7t3x^7ӤϦGͣo]_ 4Mx/nbv%:16&^zG]1kvMu ,WvAjvW>PsL׮Xc Mn/ћVVqL܉M`````````````````````1z&K=z.5c/Fv`new6!vPΑ}sy~N$;vbVWVqL܉}bm 饵M[{.yv5޻J qPڕ $9O</vNxKy-mbWVVqLN̼M`````````````````````j?dڣ]^yuk;'rO{o9JwM'kR?48G֝7fד<\q_r~>n-7ZyGփ3a|4Ѹyf>kףcx2dc]4s}}=˩Gz_q_fz_mfi֋?n;5Ӹ_fKьz5e|4n͙}>dh׫ \q_rչ>^Lۺsƞߌz4n#E|{+{k׃i[q_/m}m=ק4㾞_fӌzc]㾞ϵ&#n˷Ǻ}=}>jZGֳ7n4ɄӸWO^|[rkףq_򟡝#n}~4^_f֛}q_O3xۿ پҸoC>⾞.x>Xu8\q_E߹>ⶾx|yoM?_|nt$w׼uc_ɾ1|F/M;coawo`sۙmGwF'woٿP;۷ R_/}D~aV}\ߨ.a|;;ҹ*cUӹׇ-zE͟PtϸeOmDσs}ٵOn_C+od7f'w}wb<ʪS;3>m͍"G)27Ⱥb~?>O(e+𗐾WMs]ҿ_7ݲU)'SQ7+ʹVn05;zV=Ff&Oa~wG-1k~iU-؛՟ȆWCQϗrZ측j<-$5}eC-rg3J)}Dra; 75`??ӨX߼106 RjO+}=lik^VƷL1qf[]6qz%GϽ mav^J X?ҨX߼106 RjO+=lik^rCm6.1qA7)^ SogK{_(\nN2`T 1T[dyvzEnD,rAN8({c`m;՞V e-|go{׼ d3BO,WP.ruOs#:z䤋s" r;Xʌ;̼M |Jm<[cc܌M4ver&[ ƍ&Z8CyiH}ȋ݁-ϨXw+H=*|go{׼ س_ԺMK.y-b4.NNh'000000000000000000000^א^Zd齵g|_콓(xr{l.}DysmHhO6o`1!θ~iIaӁ TW{ڏUQ[cCW;5P& ʩ0Xtg؍Ju&m")wzx?zc3oߩR(k;{#ϖ5~u7w{M~|KrʆYlm5?n?RF>|wQV+bRZY>:_n%S13:z8޺Rq~ɑ)VVQ'vQ&4jh/mKvȳK>yCmlWjj+lM+x^7j8d+J&L%M*! Kk&Kv},q&:ki2_ i~ew&KmcMG+Zc6Q4}b0>cbme M[{.yv5;$Otr\Ag+x{'Sc7d;vj+V__.w%Hۧ.y}bKk,ҳ]>쒏k^w٥$/+(VSYy݌ *WnR뵏Wm| ^eeĝ'f&000000000000000000000^^Z䏷KvȳK>y?}R.{9'%V+x{/GHƵ+͍(qr齋3ދ5NLh'000000000000000000000^^Zd齵g|_콣qrR uew2QOqч~)xL+ۄ~>]ƕU8&f&000000000000000000000^pa{k/=#5޻ϱzw3,Wr\ 4ݩ99y^x`j&J0>絴cb m޳vȳK>y?ʁ&Nn Xyewuqgxw{ҒIDrnKM+/Q&NQ'4jh/mg|%׼?ӯo[K7?"ěsոx{ǏKgEn.&kmedfyimv9켍jfJ-rG9rmM"f^LNh'000000000000000000000^^Zd͵g|_zm^iZ11}CmM{ċI$L+x^Wmb9+6/0;{{ڕUwbyxYC{im6^zG]1kᔕfhFi1,Wn΄4w7K>:__B*:s޻VVQ'vQ&4kH/mg|%׼vfB_v[0^7ord_Yހ}ZGyr9+ZS6ߑKwiv,3cb 6Yjsg|%׼oRRf[Yy]L?WsY>^﷉% ޻v]3/Ol☘yxYC{im^zG]1kn&%9<پnW+x{'kM79%Ss9*^SuQ>& 5V/mg|%׼~LJKcRW916&KmlW^]czxsߙT)g+x{8nd\|}#XVvYO WVqL܉}bm W,W5w3^Y錕+pΔ\Y*N5yʵ+>&9!ӝ}^KM +1&6qL̼M`````````````````````!o2!lW^]cAD1|fw0hq7C3Џ \nM+/Ol☘yxYcҳM{ҫ]^yuk;$d9e\W+x{g!]m&Α儕f+ɽ&;}b[y>☘yxYcңM{.yv5>S/)eٿ|cV xp'3xZ{+x?vjne=Ps3՝>ܝjf]Y?1q' 5F/=䏷Kvy%k>n]>W+O{ kT9Ƶ+d'!g{ݽX*;O̼M`````````````````````1z&K=~W콓<,s_Lq+<ｳqndoϣ+u< M>],ƖU8&f&000000000000000000000^ؐ^Zd齵g|_콫 &t0SYyLC`ܲ.>8eޫ>_Iy<3Tkimcubm 饵Mx g|%׼zLŭDy"rO{M;lg7Stui%M3o/k^z{^zoGO]ccN wb|]Yyu7W޺bkDHrI$܉9☸Kk,ҳ]>r.5{ƣ5,Wnrr'ykN_~;IK&{Uԉ] ƫKkz.yv5Oo?o[2.OdCoN$yǏKg{8ɻy09,oim d̝MiD^KU8&f&000000000000000000000^h6G]1kvM`YljZYyLifxfi䌍ۄo}r&f*M3o/lH/mKvȳK>yv8鋗+.}t<쒏k^޼j+H\;9R7M#{ۿv}Eލy>'_}~slf^b116&KﭽlK>y?r.dr{$G94e2_dMkZK]Y1q' 56Yzog|%׼{blyFsf[Yy]M7WTsdoIWZ4n_Rk^leeĝ'f&000000000000000000000^ؐ^Zd齵g|_轳5^ΦyK,W$9Ś쒏k^w6߼/&56r{b年F6wQzJK'ωhSyܤ>& 56Yzog|%׼{&7v{WP yewq).qfo+!D;{t/cN,amUKkz.yv5Oo?o[ެD6~iqoϗG] $QHw՛1o,pN#;˝ ܉ͯ☸ Kk,ҳ]>쒏k^,~^)qew1t9#^fvބJrB9!}^K Xs+ 5\[mKvȳK>yvy⥘vfB|3yRlYڼZ '&>_ M9'G)Z'm%M3oj^Z7^zG]1kj:#ޤo8e1GOHrT9%NͭG+>zyLxLOѻ]&֕'6qL̼M`````````````````````1z&Km>z.5kiMjd<3I-o{Yڼ=qmf)pJr〙c"۝lsYY1q'6&Kmly?'ᴦ(r{`99EOzo}%69qMt~-b46116†&Kﭽl쒏k^_?Ei}fxVM8(d-+x^7S͵ /o}+o>EO1[kbXy.✘yxYC{im?V/=#.5]\9-Frzlij59#{[ӝr;͡e=] &'6qL̼M`````````````````````{k/=#.5{Gw]E)e\A11,WƕI.Yv;v}%;!Ή;VVqL܉}bme M[{.yv5޻1*nΚW+x{79yUg[+ry焜?Mb*Sԉ 6l[mǛLx+.y_1{;g|yMs aewIicbme M^{.yv5ԋr{new5-\ &jc+>9;.SmIe%M3o/k^zoG/ʫK^|?}˼rO{ocghoGnGﭯ茋EK%:X*;䕷 5F/=dG/W콣Z0M TW+x{'::k kxLm焷A6r/cNlim 饵M[{.5$a`qǃbcQx͔y;]pN٩VWtb o_|gwɟ̬116†&KmlW^]cv`Mt:ni޴\;8ͥj|;5bܼ^_#W;'Si ~%M3o/kh/mǛLH/=W콃N'wdi|fwj09s&^_#7O]L&. 56Yzog5w6Ex0Y>쒏k^w KW:3IWr{hb-3fg?_i}ZӾxv:q:yx]Õ&Kﭽl1ueykb9׌]s(rܹu}%G9?(%fX*.ʄ}U M\{.yv5o_%&^"GTƃC3,oim r+5u|83$o}RxD6o7O̬NNh'000000000000000000000^א^Z7^zG]1kpMy?D9%ʽrش\;Rnz٩;ֵ+ﶉ;vȓAg^LNh'000000000000000000000^^Zd齵g|_콫ukW+x{7r7/r(LrDj빛޻7XKC W56mҳ]>쒏k^w_q\A4ѯ,WR%Nͱhc^iZ6Q);Uԉ] ƫKk,ҳ]>쒏k^w_{ V+x{g$O٩9:ֵW&m6)wbVWVqL܉}bm 饵M[{.yv5޻J;5ծ,WnM쒏k^~~WwsϷ$؛՟H%lb~}ll~82i`Z[YӺzEkl;5dBЏL_>G5BRu[w1W^b116&Kݮl@G׋<1\q[7kzR\q_o':z ౮q_`s}}?zh׫qq[o΄ѸGG^L>z}|fףqn[q_/ s}mg}=/ zuo忓95A,\q_ >Lzn}=QXz}q[~i}=>͸WSG!oq_8G׫qgghף)q_/mi֋3v4wӸss}m]~>?z0u4Eq74_fӌz}\O?5Y\q_o-ɹ>I3㾞Lz5-l#nw~~3IrW~\q[ z4u4ӸGgiӌz}q[Ovi}=>͸?\q[+a|4An9G7$q_9Gxͱq_g#mQ|Nh&n.oD˞ }o^ǿ`s}+[OMbQ:N6?+7~Sdߟz2;9xBF?̅c1^0[?}?m }twP}][So}?/>BKoZX18'Ck^~/| endstream endobj 752 0 obj << /Length 221 /Filter /FlateDecode >> stream xUN0 y [dqҴˎ & 8D4eY-d[obRnAȁN[ _W+:^! ]$K^٭!Vf= ^rŰ`Fxi9 ]K%fo?ho ֻSic$ T]1SSɝl}StX>9G6-&!lW8hƕc\Twɽ!O:R endstream endobj 727 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp5TQ4ft/Rbuild67ba7a7f86f6/gnm/vignettes/fig-LCover45.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 754 0 R /BBox [0 0 720 720] /Resources << /ExtGState << >>/Font << /F1 755 0 R/F2 756 0 R/F3 757 0 R>> /ProcSet [ /PDF /Text ] >> /Length 40898 /Filter /FlateDecode >> stream xA%9vZEHh1hBJBP A94Ǖ{$Z]TE~vkv##s ڿ_9)z#O_o~']̏?~ 㿼]ɏ)[GɊϤ?Rnnӕ6Vڑs"jاULl3OO,☰L````````````````````|1ctX;ٙg:vV9f8ꊟYyWXX9r:ع#ŏs9'eS,ī*',/_.WX銵˵FIc~}d?,$/|sYXBrkA#o^N_yʟvٻimc9Di=IH=_Q71B0&qLX^&00000000000000000000!]6/2!]5G9OU:P::Gy}^yv1,Wd׏T6#K ~fv2v9>EO1'qLX^&00000000000000000000]6Qkk쑭=yοsctUg9e9]bxm9M.A]ՅL(vE*',/_.WX銵˵Fֿ<߿/Zusatݖ>p#ts Fd'4|dO]T;֜~zNe"egdoE Qe8&,/_ΐ.W.#[z@]]Sh]c>-0rϫU}cK9vkHGL4wU.b<>c2Ō8\?Xˑ=yοscgƞe?mYyW^gmGξǑ}N"[NKU~fE /fh tZ#{d_{o&{I`ng3xcOy=S1ݎ]n>'6{Wܤ^ 'mY?1c2 r}} r==Y(H]F%frϫDC0^fլGj>HIbOѷUL.'qLX^&00000000000000000000]6R5kk쑭=yο_5Kw'g7Vt|W^e r;H5٦Yۑes"yyjOH~8c" 3V:jr==t~ ';j]Xx~GݜG%y`\i3˕?Ɇ$ky9?W#w,isQ7i18ͬ? cbDŽej"Z#{d_{訫l(R|v_5趢(k x^53LevmLΉ\a_qS! 3Vfr==7OKѭ2ƶ"mЖ wŵH.YJhrۑіS OqVqw%]&\sMn/H9Y9}y|"<>cwAc```````````````````|MctJW<<9ۮ&kW#rYYWTh'yGx*9 ?'rkY?1qej2\kdl1sGsouAr,g+\{۵G6zc"mkW,RUL.U8&,/_ΐ.WX銵˵Fֿ<}ϩ=JnK>/< /˳ rϫld_ Y9rMK#mrD ؂۶V͛w>YOa-,>0R| YW]wT}fuq9=6ti79 Ƒm bysmw*E /gH tr==oog. q9ȍ̖ wM"YysYvޜߖۮ 8,OQ C 3evc{W]oRYiW;);{쮌;5gqzrX&r[W{c"mfE /fh tZ#{1s/|<-,X$*oZWťHc9H#-ɻi$Wո if" Ɨ3Vfr==oonK.G6ىA . wM"U^RjY둖].DNnnq!.b.噧"ej2\kdl1s۽+wy^Y ,<#KyllnGJY&dnw\KU* /fh tZ#{d_{oax9IRz ErtԖW%XWn9V/U,ufE /fh tZ#{d_{ty}^{e9]qqH%=ٗPqH y:!Ok<_fVqL\>ayrtJW]5G9MW\y+s޵2󮸹";lDZ}K]"pN?﫾wU SU /gH LHk쑭=yw5=r .$-VCy}bDŽej+]vc7]q孺P.י w22,gW<~d/D_gWUlqfE /fhF+]v9r9MW\q_qye9+n.jzG9$i;Қ 2jmf)ej"Z#{d_{^_Ux]|'5wz?~o\ΏE۸䢟Y.iܢ순 '*+G!d[5ۑƥ2V5cX4" 3rY\kdl1sY(aoUJtȱ6 v-˕?廓 a~L϶٫2ݲ*.iSn(*C Ɨ3E&˵Fֿc"3Vbr==]qul(Z3x7U:mz#PF#HIY̩>e/ϥe)ej"Z#{d_{!OVj [,;E.6<9g+Q(6ld¢w+#ȥ)W'qLX^&00000000000000000000]6Qkk쑭=yοQJ?=H~՜j9%ҿ[ x^5#]CueK#%ˮ֜/{y䫸UOX^&000000000000000000001Y\kdl1sUsN8T1R-oc},׉B['4]eT{uqмN.meb/D׉}ܜNh^&_~ D5~׉SLd[^'~׉]Lh^&JWO:_X&4Lh^&v/9=',fLh^'vk˄ezubse-ŵSLuny[>'b׉ζNh^':Q΄eB:>'4/AqLX^'Oә׉vteuu9?9]|zzErŻr+Zײօ+ua-/eaJ[|&/m}6[.X>Ad]'cNNօcNNsm]'/>ٞq+GjOy}h,%Ͻ o3#.?uܿFoxz6:^x^+x^y-xG%h\||֥YC]b]?wA̲S~tlˊ ,^D+ǿ)??=?;6￲:1-?ꃞӿ_˿>?f6Eg-Oӟ_?X>ޗ__\ c_SxL&z4,Bڿ0zFkwD*3/g7J8~S "O4g[P˄Z/~kY1qeKk2{ikl]1sdAAb߃HqבcqI/1˽i[4g_fp|/)kmܳwyS"faeKk,.ٺcy_#0Il-<&+EV,7g/veU^RjOzE?cbDŽeKk,.ٺc[b?,c-).lNYU^#э}l" ^}Y1qeK&ˑK>yοٻfks,gNm;|diޥLvbRUlef4E OlH/m쥭]>u=K_]O>]zXLȕ'ʟ'Wd5g~A\&r=꾊i\f" '66Yv]>u=\꧔k=e٩fܖ>nOkufyB?輮YMzYoW\?N-4?.☰L`````````````````````|ZC{im6^#[|=KG#Y>޻o+5o ڤ?'cVbS Okh/m쥭]>r.9wW涟{b.LQo3]ʘe3$że}{*#0:>3;R79s"y|q38&.bL`````````````````````|ZC{imo^#[|o |zIL߮ s\Q e nml.#{^e-Gs)(ΉCsKsve-̬☸}2i M^{ikK>yο&Wt2Pr{& PGo ]H\,D?%/y.:~.ϬS '6BmLH/mK>yοKp13\3u=.sŶD߽r{w򹋋iq1!O9{m*}fE Okh/m쥭]>u=7w_#67rO{Kqy쐢98w;RlA~N6f{p^ŚgVqL\>ay&KﭽG.9N.lya lpbYy]]\أEsɵyz`ׯ9jXO38&qLX^&000000000000000000000>!{k/mK>yοwc2i M~}G.9/_Gx|G_YN?{z]﯏?z}WnkگEF,<͓7km^i3Y'&jV1fbX1ay&KmG.9v<ȼAs),g.mYi#{v-=*V?c" Ƨ56Yzo]>u=o B|o,dwoPo:/|d-,Ӣ.CvWu)_&O}VsU?oUOX^&000000000000000000000>!ɯ/v%<ܠ6i=Ӳqf9NUlEic><1^v&GțKb*f*E OlH/mK[|d뒏{o{"{ af9vs] HI.e"}bu>" Ƨ56Yzo]>u=ws%?r]'f_3<뽳Ňҷk/mK>yο߷1Ev9'RvjO}\bY1q:ayƖg"K[|d뒏{wٷ]ͷ _]lI6,6ߢ :yXMf%9.)Ky)E Okh/mK[|d뒏{nշ޻uf9wq^ITY9';w=҂ aW{Y[pKY1qeKk,.ٺc{wM]{.3<｛ 3R5琤s#{qaoŞ"mfEƧ56e.ٺcۤAo9/%ׅ%xi~aǓMݘ% ȝ{\)3GOTh{~HS eY1c2 饵M^{ikl]1s )͏]uT\3<ｳ48VC{)y\Llsiiaf" '66Yzo]>u=oPOlek3υw䁟O3˕?P7Y 9 ]+˄|MO1Ul.* Ƨ56e.ٺc(1nK5>vɛrOk\rG7>.ݎmqHAYS*FS8&,/^Zd͵v%Yv?L8zۓ*ufE Okh/mK[|d뒏{}A']t|F.G-<ͫ۶R+G{ۑ}w9,W{|"}fE OlH/mK[|d뒏{͋컞T~6u]XBv)^3cW^~f}{ }* ʑoG&HIjOѻZW1PfVqL,☰L`````````````````````|bCzim__dBzikl]1s}{`r+|`w~-IvO.ZY.ymfTvʑe`;ؑ]DjrjW1-<>c2i M\{ikl]1sۭΥyӇ3h.3u=7N.D?/y.u[*w[VqL,☰L`````````````````````|bCzim^#[|{7Gŵ s7G?]؈Z};Ҽ=Ur}>bpaɯ/2Ѷ]>u=I٫'^jz]9z<~Ӳ\ #IGVjnǑܪ|oJOǰI-OO,☰L`````````````````````|Zc&Km>z.<9y y I6pZXon/(_r4>ay&K߮G.9f{7-BrO{]j 4dqvMs"%Y\*2~c" Ƨ56e.ٺc޻EU*i9$X3x{o.]ל~)-2>e38&qLX^&000000000000000000000>!{k/mK>yοJ n[7gW l[SnaaE>߰ eBI6x:$=@qfwG_zzeb]\ھif" '66Y5G.9o $CⳫ?;n(lct|dYfY>E}s<0MBaHw DŽ`YY]|t!Rs d)_#8&r)ni7WS8&,/{^z3.y1NEs3]3<ｋ #%>Vjm\oGzػ{gX*',/{^z3.y17݀|4f3x{7m=r>l㋝)Mز>eU OlH/mLH/mK>yο![?){,lr{\ ȫ cC򰹺,Ӣ>DCimܲKӡGrڏ՞bp-BY1c2񉍸6YKvy%{>ܠKeܐ qf9wLrk.٦2zD^XN=S^~S8&,/{^z3.y1]ɏmaf9wuM+1[qڹ#r{D}bsyy}bDŽe6z.<9j[6)kvKNurOkqق]Vjn\ݻ oz2c" Ƨ5F/mm棗̳K|̿]R9˖R;'9rN$bR*',/ؐ^Zd齵v%<޻ܙ6ag0Nβ޻J9FmGξ=ԎL {y.bb,8&qLX^&000000000000000000000>!{k/mK>yο7/̱QZYiW#,ʑ/qvVeB)mq)E Okh/mLH/mK>yο7W#h޷"[3x{'W#5]9S)Ds{\L]3O1U Okh/mK[|d뒏{o{4޻)i7\)E6-?'sq38&.g^&000000000000000000000>QF/mK[|c_9nsDZw@KrO{ay&KﭽG.9nddrO{jǝLN;{r]<=bp~Y?1c2g"K[|d뒏{ozy.n ef9r}ʑN⶿iE79'Ru)\\ZZ$[VqL,☰L`````````````````````|bc M[{ikl]1sm]jncR3<ｋG5mGξ{أЭWVö\)E Okh/mK[|d뒏{o{s04޻)o.q#˝[j[&rzw}{y)nqu2i M~}G.9]ƙ {H{sA}d|ގ rOG6c"meKk,.ٺc~}d)?Ȃ 7'l~}?[gΗGm.f x^^+mbGZmb,.Ջ=v[Y1q[yĆ&KmG.9vac JvsY)&;w=Ғ׉M~KY&4EZ&4/%|3|SoмNpмNuB2EW:Qd7eB:.ͼLxnu"_~yn_?1Dk9ay&um,/%~b׉N쮭Z^&Z^'gjy]Z?S˄~׉M2y//ͼNlf^'w׉vnsBCޖOlu{ D_]^>׉,O3_&4յmмL(7M׉,{-׉_'4/[pe*:\]?SDu~L-/)-"u"]~y/ͼLdnu"]~y]\?1D_ue~b׉Y^'aeb мN<'4/zϯωۯ%{/0_$alZ K>l.K.ncKeivIץKO|-?_Ruir;ei^KwSiUyC̲,_Uo&6:{u"gr׉L ˄e"1ayi06G׉U˄euB8?_/_j? ꝅ?-L?%fa?A:O9}ß{3]|?uE}-ߒ_~c+:~=t_w.AW(!w͟_w~췝{jtAWf鳏`e{U&/ TO753w3Ze`/ 5vSth5 ]/zrPqg¢6BM~pǁ5W4/_îZɢ~Y,Z:Yzֳg=Yzֳg=Yz_o-֟/֢Z:sw汉no~o@(Y~Y4(' u;GV|]oZ]6Բ|6^xzֳg=Yzֳg=Yzֳ.EݼջڢjeF+?-7J;Æ_o]/Z~4!di:IW$}-YmѪ#Cx:Yzֳg=Yzֳg=Yzm֟hQ 9|sMAd?P6}e }vF .1xFx]`h!X3dV5^xjVլf5YjVլf5YjV?j'X|}zzV÷8g_\>-[-[?m>֠/):7Q.|nTK&Xef5YjVլf5YjVլf5ízR'gj9|sM]-Ey6o*}(o6/j a3b :6r]YÊ<-uҰƫ_xjVլf5YjVլf5YjV?j'X|}zzV÷84y{%i>kp(oL RFa]Đ\iɦ+{D[V,V:YjVլf5YjVլf5YbIgZq75!UyS6ss9ޯ r.w>nO3?텛l(5nMI1}4j<59g88| VWKJ#[I;oqN>mOB+mZYY|'ٚWVje؎ec"ڏdy݇U\l3OO,☰L`````````````````````|ZC{im^g<{x\}w!,gήJgc9繏#1U}RޜhIvXS~Iԙ'qLX^&000000000000000000000>{k/mK>yοwCW3m~f9wE.ژ[.;w=vW27y՞bu[eYEXEмN`````````````````````|VC{im__f/mK>yοOT=?ᶼ}MVG6rOk)!fGo9pJ;[ĶLȃ%*u=76V.Rg3x{gd? )jsGr<뽓MοȈe9y">}ԜF+#,Kq_S*feuB:Y M\{ikl]1sl{\R\(,+x{gzK.sK>[}=w^ʫ9wcb1sbmUKkfjϼs1绤յ$ٿ%|M-ϚGR,7مT1)r9tp;mGWmbrދ✸Kk,ҫ]>ly|A&/\YV.&0QNs&OO߉=[VqN܉cbm 饵M[{.[.9.6+pjYV>S?ҼRs&0z$._}ZڱdY?9sbm 饵M~ W|%?Gt|R,+x{'E@׻\;/z$$e9}*~/].E&M+o/kh/mKvٲu6!vqh.d˲|sf(EJu]XkG<߾MD_]y]]8,.Ή 56YzoWlٺd\XU8'V&000000000000000000000^ؐ^Zd齵^em1{q }>>K- ݕt}XvkvٞGbk{}'{zıX,8'.Q'V&000000000000000000000^H{H{WWlٺd޻y_fݲi]@.q+=WI6k#1.k".&&M+o/kh/]g,Қl]?sc]g<6.+.6˲wq>BN5-#R1TySnxTŒ-8'16W,쥭]l]?sc]%Iﲂ]e{V^t[Wu瑘\vr/dY9q'dyxY^Z7Wlٺd?|-ܾEp? b >|p!L>[2mey.[H^>+5._w޺p\1ﶉA&/-8'6qNM`````````````````````!Rk/e%c>?<.޲?3tXoŵòy}C.WM}/DcX\ U8'V&000000000000000000000^ؐ^Zd齵^em1?.ޒ;-E~x\̫˲6}>[;޷7@Eg6om"$n_b/&sbmeK6m.[.9Ȧy||n>c}|dYnimރp_/g#W5S}jq>])l96&Kmj-[l=˸׷4W0/\YV>\ȷP@Wjٵ>&ok;ߋYVqN܉cbme M[{.[.9Η1J,+O{RIu/WjnمW9VkC]ewbUw☈WK/&K={ik-[le(`gWd{k޲Y}p\J-בXZΉMlY(96F&Dglٺdwr9bȲp[<ｳ<!yfݏ\>ģCDLKyo9..M8'V&000000000000000000000^֘j˖K|{)ȣ ղy=F^Yjx5!۝%Ʋٲcb^m޳vٲu6ozﱘ07X)yѥbYVy%[rUڹĔe D lj&zy(NɲsN6ꥵM~^z˖K|{i}Ϗq7"do巷x}|ن5eyv#GWՕ˺ Cc-%ߋ=ZVqN܉=Z&000000000000000000000^ؐ^Zd͵^e0u1Eޗ)7ٲy]]ЂzU>͜焬Eͅ`Y9sbmㅍہW?{oWlٺd珋c/^ŻK&/ Un {Kѻ"{D+!Fևn޾Dw1-.Ή W5^mLt˖K>{|6oËs\im;d$ $Zx^'׎[x-5}8HL~mr(tq>]fѕM8'V&000000000000000000000^^Zd͵^em11[}^l~R,76|(ť=nuGbW X\bUwb 5f/dg/mem1_͏)k溼3 ì,76O^Pf^!C&dMZtwb+ÜwXyxYC{imҫ]l]?s;=St!ߢRA +ݲy\p,+xS<jvg_kme&Ή 6B6YzK[lٺdRw׹K5˲wqE+o. VVյe~N?K~].f*ΉM+o/lH/mKvٲu6ϷIIk6)C.d>[ܓ܏<"(OwC]NM+o/k^zovٲu6ol]26)9X, 9n4tWqq=m=rʏ_bʻ•M8'V&000000000000000000000^֘j˖K|{g-ˇeY޻Po!ʕ{qz#e'܃M<ܑ,8'16W,w^e%c>}轛;I]Q J,+x{wyg(0׮eWzDn*oKk1Zjı%WVqN\NM`````````````````````!o2!j-[l{zp|-\KeO{#V(r|]+fO?c-=bWVqNlXyxa#!M{.[.9k1/Oq…1%y_(__y;);1Gu>Zl~?-% _{{kB6}%ťfwqNM`````````````````````1{&KQ?{ikΞZ䷳ǾWYLhu=^`,+x{7ٻ%>\ΝbtMׄtcq~,z;e&Ή 56z.[.9׷<`\eO{e\kCr=Ӹ(_1tKfM .{*Ή;Kk,ҫ]l]?sۇ{,&B ғ ;eYpIS)iɕ>dokW~XKUwb?,o/lH/mKv̫K>{WR%  ղyo!ЛZ\ݝfk-bw![VqNlXyxaCzim^z˖K|{콫7tJ]5;@WdD׾<~Nڽ}b?YDDмO`````````````````````zim߬^W|?foSbL'RW(W~oo6NЙU.G!<;Q+/3Ѷ\-wI~[p'òsN,meK6YjKk|%=>.>ﺹI޻, E?fq^Y zy$(u5Q6܋-[VqN܉-[&000000000000000000000^^Zd齵^W|?f.|w֓T˲gw7oy71|v]`R] BN\Nh'000000000000000000000^א^Z7^zg^]9mC|tIv')YAvX<ｓ<bV]H;\HDw1- 56YzoW|%?އ(.aYV.v0w9ZiŵMToO?En{,beeuB>&Kﭽjϼs1޻\̖e{. !е둞 DMn_b+޲2qkB>&Y/3.67yWN + 61(U\\wGb5Mﶉ^ݲsN+o/kh/mKv̫K>͚^dՕ`YV..y7Esܽ{)_q|lj,8'16†/&K={ik-[l{7ɡ7w[<ｻ;Ҽ>wqY[Vx&b罛<~c-ZVqN\NM`````````````````````!o2!j-[loSy)XR |໴ޗ>\ηЫyy W;ڷjoj Nk_q=KYϰ`/ѷ]L.&M+o/kh/mKvٲu6e#ؓ MihvuvlѕZq?3i;?v>Dl!;]g7]u~^܊u;?~P3nѸ>hg/;kgG~rq;xy^~>_gK>?$wϸ/:?~~|W>?]>?"oϸ-߈VѸѸߢG~}>w\ϊjϸ>Ŷq?_]Ϧ[q?\;3?yv~|i~ߟVӊyMhuu~|3nѸ?M}ϸ/Q~׸?\>?ӸӸϮm|s~4nOIq4i|ݿ?~~>ߟVWyu~|㇐,cHϸ?.g3n|qy^~~nwq??C㏦?:~ލ㟃㯦z CAJ .:_2#~+%]Yve+_?ݕWkWciܯ__Ʒ12"ȿi {4:?~zzu^u>ChWΗcy^u~ݎnw9~d6ٴS>ߕ?l1~^_qYHsk?EzW\ǷCܯjOOo_bmseÏ?_oeis ,?_ov+׾aw6-G_ېϿǸ__O?&7q珥Xe/цͿo}\ z|m꧷r[tYsK< 0ӼRsKoHM#<'9~<`e&Ή 66YK[lٺd r,.1lMe{Gf+5b,}}~]l*%D[ 7b6YzoW|%?<X].բ)M4 <<#ny+( Gb:d sBޕWZ!bV6qLlXyxUz&˖K|x\|\_䊾 aTaeY{EM^.U-[#1W| %+8&6qNM`````````````````````1{&K={ik-x9)|Cq4_cqAoˁWx^W ˁg#e~FD6ȫ`Z-8'16&Kmjϼs1Ż|< ,+x{gR1 WjHKۄtQk-ߋc+1'16†?M~[˖K|Ⱥ[y{ήv˲w2RWjn݅ؒ圐N>tVw1Kysb 1[,쥭]l]?sc},{XAuY<ｋ@v9#R콋eKٲ2q:yxUcҳM{.yucϷY6/#n>3F#P- ywB?yt+m<S5}%cyxxw$&Kԉ 5f/K[v%=}>PW*Mv.rOkcWfپ\ܢk녢z$|&駵-8'16W,쥭]l]?s.+.ieeY޻X7i֮G׎}C.+J{NLh'000000000000000000000^^Zd齵^W|?f{7C*鱂e[e{rޤX,M:|#>7q%x*ΉKԉMx}c^&3+lorT|npIʅe/RZ4rO]9ng6sۄu$xA}$vX1sbme M]{.yuceu^gw65B,76?\˷e]Y#|jD ɵG/1],.7&FsbmeK6YjK[lٺdj$ǣ1U T,76z 8o}zz$.m"^7X꽨( W5^ƛ8l_͋l%]Byi Cϋq]A#nY>E}#qn*(V^ב\f;+C~&w{Uԉ] ƫKk,Eҫ]>lun|PzqjҜ?.>|؋ yVddeyv]/h]>u=Ri(A޼ۗ.&%}U M\{.yucy\6L֥_YVnRZnЬGbkB~mPmbuG✸M`````````````````````1{&K={ik-[l{w/oE_y}|dYV%y}scq#c ξRػeubeB>&Y/3.6N.$^v[E˲/Ki!O{#~s&RGwZK8nYVQ'.Q'4kH/mKv̫K>=xP<=.Gw~x/.[. XYy^]M ;yg"F?3==ȇۗ.6M8'V&000000000000000000000^Xlo_g^]9m }!{R\_ͻ+-懏rj{-[-q^\H<ٚSu!ٗ.w&M+o/j^zovٲugY&, eY;nqr.uwH<dImbrދ*Ή;qLM`````````````````````1{&K={ik-[l{eB7w4˲wuOʙ]R&!ok-܋=[VqN܉=[&000000000000000000000^ؐ^Zd齵^W|?ft)Xt-~MịK>ղ\6gЛm^9s ]QI;&Rvۤu ɲ~sb Kk&Kv̫K>x\\A}W<ｋk w+g>ZmG&r'wc`ĘvqNM`````````````````````{k/3.6nS ;)W'bnZ^ỉ;z^mꥭ]l]?sC=pEV- ;bWj=sz$^l[-8'-o/kh/mKvٲu6BɞUj,+x{y<+=W.]ékGdϕT ;;ZKXU8'V&000000000000000000000^ؐ^Zd齵^em1{y;2]e{Jz'5c}wӮc-XVqN\NM`````````````````````kd]l]?sC;ݛEޖdeY;E-v͵U#xMDQۗ.&&M+o/kh/myҫ]l]?scKEX]le{|\+ɕkrm=ͮGd-NNwfwfxcwbɖUwbɖ 56YzoWlٺd޻.LRdr,+x{w;h.M@׵#1>/+ϟn(⸉UwbK 56z.[.9yeV{ 'WeY;Gٌ%UmW\^P]CZK=v1ɦ+8'6qNM`````````````````````!{k/e%c>翽4ܾEp?"=[8,7o_P://}+oz=sq,wo?!o.觪DSH/\s41w, 56YvW|%?>g^]]Q+]VpxeY޻*O7Y2k#PZeݾw-( W5V/=v̫K>9"ωAO_6ѥYdYnim~&Y\+5vz$";\=vKLa;e&Ή 56YjsW|%PwǒRu>}6OJ|9hYnym~Ct״p#zD 61ߋYVqN܉Y&000000000000000000000^^Zd͵^W|?f6$yî?a/=+ڼ6-zepHmd70wbUԉ] ^eKv̫K>6/.%/'}{.%ʝ(,wo/([ȕ+wz$Ƽ>5/vD/obtXVqNlXyxaCzimdBz.yuc/-4(}9\e{4ѥ+ۮH5QKξD_wplL\Nh'000000000000000000000^^:ǵy^Z/g^]9mKte,'y~]s5T, 58߇e7RsX#YO]>Ś,( 5V/mҫ]>꒯!޻:[6׭Sòy]lcr׻;s#%*ֲׄZJ{NLh'000000000000000000000^טl^g^]9mKjg{t}H-.[H%m͛ٲyk^]QTr 2WDʲnX\K\UԉK Kk,ҫ]>lRp۷z,+z])+rе#)mM%nDDмO`````````````````````zimdBz.yucwirمep!Z<ｓkǼ敚SqysA:kfe/1].7&%}U M[{.yucjў[Wdq+ m}NXKNLh'000000000000000000000^^Zd齵^W|?f{7e\AeO{e#.WjNQ@k_GZ&wGm-^lŲ~:2yxUC{im߬^W|?f{<sٕnYVNuJe<~K뽖T&dss2R.f*%}u 饵M[{.yuc![woZ,+x{RsP]Ck}].f*%}u 饵M[{.yucoo?[}Ϗq7"EQnoo巷gx}|wEvr)>c+~'1MRH?5= Xw ]N+7ΟXy@@@@@@@@@@@@@@@@@@@@;Vt̫=R(G/_^o X, <룋 ;!ϡ˅vlDIvh^ʻ7V&N-|>Z ۞ycOh{ű>z|yetUaYny]\: )([=$5\R=]kaE;o M ՚VY֢u6mqǗޕc]*~{FۺH m⨮͌/p՛/OV&n)|} )|Wo{Ҟ?!X+HKʲr8n=r!dHkvsr5^`rDK\ݻӍAZJaY9q' 6Ɵ6YjsW|%?>]]kZ- M^3᪮]sj'HuMC k-bw![VqNlXyxaCzim^zg^]9mCavR)/,eO{\U܂\9ue]h&J'wQY_DXyxYC{imdBz.yucwrENtE6KYYVή/Avv+5](lDՕNccbKk,ҫ]l]?sc]\7^1]cw)[<｛#JYJ͵f{^\ۄ6-(&Kﭽjϼ8ZqOz_0&piuwyfri;e}{.Φ~8l;Z#зgJ[✸ƫ6z.[.99\gp5Z<ｳ}GJͭ#Q6&oz$'6q|fY9sbm 饵M[{.[.9..[,|n˲wu%7w&Ε{tm퉮GbHs"r/q|MM8'V&000000000000000000000^Xl^˖K|J>!D)?&%wwcsc#- <եYk[Qo}^X&ru%b1sbmU gv.yuck维벂C+_YVEz{Rsy$sWs"hwrދ尬✸^m޳vٲu6leeLV9e{ꢿdgr܂]/qm"v;u;ʽزeĝ8&V&000000000000000000000^^Zd齵^W|?f{wdw\eO{]Ku/W}]LH:\mD n_ky,1'6qNM`````````````````````!o2!jϼs1޻7pX]HsٵbYVNh|Vrwzo=z-f;?c-=bv1ZVQ'.Q'4kH/mKv̫K>ZYPIZ/\kv}>ro1,|iΟEC+5>3=" Jđ$%`DDмO`````````````````````ҷk/3.69>ݻeY޻^tyzF~e~N{_bXǟx&) ƫKkfjϼs1{\M޷\Av9Zt=SG5J <mE;7߭ Rkz[c>?>$Vw[݂ymme>.ݲ?k[t5g Żn\8_*}m`rho7V&N-|:Z Z9n;m_po\( }8r=]ju;?v>58~q?_VyY_g7{^gwu~o|qq|4e;?vDWO~pm4q;_s׸u~|3nu4ǟn|sa|4n{pi|4;G~}> ";~>/3K~;?v~?j>I6ϸ/u~|s5:?~7JϸOQv:kygu~|߿?q~ؿ?on\>{|4 uq;/*>hW׷4nkp~4:?~}~8t׸Om|u~4n߿?Oe~ߟVO~jMu~| 3nCt?\q;cV' uMh&6~B?'V't]ĵ O6) ~?0⯺pf #NvD:N)e<6Z??ay@~Mi|?ooǿֿ[c?ӏ}d#Ǹ__?/7V]?b1 Ccooq[J endstream endobj 761 0 obj << /Length 362 /Filter /FlateDecode >> stream xڝRN0+|L$zmcs Ro4n)=N@,ū; / E$0ZEMP,3ᢜ[E`u'.ykQ3%FbQ\݁"QS)SrL :Qtm[[+6vC t`1}\\4tu]m*\;Ts^v-0v1H~ DB/׻v 1vaߟl{ϩڥ7zR%@j`0=XaJ'br "iQ+[g@PmgY ‡!}g;sqv< m8j* vol0I X\B\柰 endstream endobj 728 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp5TQ4ft/Rbuild67ba7a7f86f6/gnm/vignettes/fig-LCqvplot.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 765 0 R /BBox [0 0 468 468] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 766 0 R/F2 767 0 R/F3 768 0 R>> /ExtGState << >>>> /Length 5932 >> stream q Q q 59.04 73.44 378.72 335.52 re W n 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 70.10 359.09 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 78.07 339.04 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 86.04 340.06 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 94.01 340.98 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 101.98 336.39 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 109.95 346.70 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 117.92 313.89 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 125.89 337.12 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 133.86 326.43 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 141.83 318.49 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 149.80 317.46 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 157.77 310.69 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 165.74 302.80 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 173.71 314.78 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 181.68 303.23 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 189.65 307.08 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 197.62 268.32 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 205.59 294.42 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 213.56 293.54 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 221.53 285.33 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 229.50 292.74 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 237.47 251.85 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 245.44 259.33 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 253.41 271.84 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 261.38 261.43 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 269.35 256.54 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 277.32 221.27 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 285.29 259.30 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 293.26 252.63 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 301.23 242.81 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 309.20 241.76 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 317.17 237.95 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 325.14 223.36 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 333.10 236.22 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 341.07 220.15 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 349.04 200.67 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 357.01 156.14 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 364.98 191.07 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 372.95 188.09 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 380.92 192.73 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 388.89 165.53 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 396.86 171.70 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 404.83 162.30 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 412.80 134.21 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 420.77 131.07 Tm (l) Tj 0 Tr ET Q q 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 112.92 73.44 m 431.70 73.44 l S 112.92 73.44 m 112.92 66.24 l S 192.61 73.44 m 192.61 66.24 l S 272.31 73.44 m 272.31 66.24 l S 352.01 73.44 m 352.01 66.24 l S 431.70 73.44 m 431.70 66.24 l S BT 0.000 0.000 0.000 rg /F2 1 Tf 12.00 0.00 -0.00 12.00 106.24 47.52 Tm (50) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 185.94 47.52 Tm (60) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 265.64 47.52 Tm (70) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 345.33 47.52 Tm (80) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 425.03 47.52 Tm (90) Tj ET 59.04 98.78 m 59.04 361.69 l S 59.04 98.78 m 51.84 98.78 l S 59.04 186.42 m 51.84 186.42 l S 59.04 274.05 m 51.84 274.05 l S 59.04 361.69 m 51.84 361.69 l S BT /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 86.94 Tm (-1.5) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 174.57 Tm (-1.0) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 262.21 Tm (-0.5) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 353.35 Tm (0.0) Tj ET 59.04 73.44 m 437.76 73.44 l 437.76 408.96 l 59.04 408.96 l 59.04 73.44 l S Q q BT 0.000 0.000 0.000 rg /F3 1 Tf 14.00 0.00 -0.00 14.00 44.73 442.09 Tm (Canada, males over 45, Lee-Carter model: relative sensitivity) Tj /F3 1 Tf 14.00 0.00 -0.00 14.00 102.47 424.81 Tm (of different ages to change in total mortality) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 237.73 18.72 Tm (Age) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 12.96 217.52 Tm (log\(beta\)) Tj ET Q q 59.04 73.44 378.72 335.52 re W n 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 73.07 352.73 m 73.07 370.64 l S 81.04 331.98 m 81.04 351.29 l S 89.01 333.36 m 89.01 351.94 l S 96.98 334.69 m 96.98 352.45 l S 104.95 330.15 m 104.95 347.82 l S 112.92 341.22 m 112.92 357.37 l S 120.88 307.06 m 120.88 325.91 l S 128.85 331.73 m 128.85 347.69 l S 136.82 320.80 m 136.82 337.27 l S 144.79 312.80 m 144.79 329.37 l S 152.76 311.90 m 152.76 328.21 l S 160.73 305.08 m 160.73 321.49 l S 168.70 297.04 m 168.70 313.75 l S 176.67 309.76 m 176.67 324.99 l S 184.64 297.95 m 184.64 313.70 l S 192.61 302.22 m 192.61 317.14 l S 200.58 261.85 m 200.58 279.97 l S 208.55 289.47 m 208.55 304.56 l S 216.52 288.73 m 216.52 303.53 l S 224.49 280.41 m 224.49 295.45 l S 232.46 288.37 m 232.46 302.29 l S 240.43 245.83 m 240.43 263.07 l S 248.40 253.92 m 248.40 269.92 l S 256.37 267.16 m 256.37 281.72 l S 264.34 256.50 m 264.34 271.56 l S 272.31 251.58 m 272.31 266.68 l S 280.28 214.69 m 280.28 233.05 l S 288.25 254.70 m 288.25 269.09 l S 296.22 247.83 m 296.22 262.62 l S 304.19 237.67 m 304.19 253.14 l S 312.16 236.61 m 312.16 252.10 l S 320.13 232.67 m 320.13 248.43 l S 328.10 217.35 m 328.10 234.56 l S 336.07 230.82 m 336.07 246.81 l S 344.04 213.92 m 344.04 231.58 l S 352.01 193.33 m 352.01 213.20 l S 359.98 145.60 m 359.98 171.87 l S 367.95 182.70 m 367.95 204.63 l S 375.92 179.22 m 375.92 202.15 l S 383.88 183.77 m 383.88 206.88 l S 391.85 154.03 m 391.85 182.23 l S 399.82 160.09 m 399.82 188.51 l S 407.79 149.06 m 407.79 180.73 l S 415.76 116.95 m 415.76 156.66 l S 423.73 111.76 m 423.73 155.58 l S BT 0.000 0.000 0.000 rg /F2 1 Tf 12.00 0.00 -0.00 12.00 340.96 130.85 Tm (Age 81) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 261.26 200.96 Tm (Age 71) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 181.57 248.28 Tm (Age 61) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 101.87 292.10 Tm (Age 51) Tj ET Q endstream endobj 732 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp5TQ4ft/Rbuild67ba7a7f86f6/gnm/vignettes/fig-deaths1921-1940.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 770 0 R /BBox [0 0 468 468] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 771 0 R/F2 772 0 R/F3 773 0 R>> /ExtGState << >>>> /Length 6282 >> stream q Q q 59.04 73.44 378.72 335.52 re W n 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M BT /F1 1 Tf 1 Tr 7.48 0 0 7.48 70.10 164.14 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 74.54 166.20 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 78.98 164.41 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 83.42 165.75 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 87.86 161.13 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 92.30 160.36 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 96.74 160.11 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 101.18 160.08 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 105.62 163.97 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 110.05 157.73 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 114.49 161.26 Tm (l) Tj 0 Tr 1.000 0.000 0.000 rg 1.000 0.000 0.000 RG /F1 1 Tf 2 Tr 7.48 0 0 7.48 118.93 150.88 Tm (l) Tj 0 Tr 0.000 0.000 0.000 RG /F1 1 Tf 1 Tr 7.48 0 0 7.48 123.37 162.44 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 127.81 159.00 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 132.25 158.34 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 136.69 173.81 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 141.13 168.11 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 145.56 168.35 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 150.00 181.93 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 154.44 175.15 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 158.88 194.09 Tm (l) Tj 0 Tr 1.000 0.000 0.000 RG /F1 1 Tf 2 Tr 7.48 0 0 7.48 163.32 171.99 Tm (l) Tj 0 Tr 0.000 0.000 0.000 RG /F1 1 Tf 1 Tr 7.48 0 0 7.48 167.76 201.84 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 172.20 191.00 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 176.64 190.95 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 181.08 214.42 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 185.51 201.68 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 189.95 209.12 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 194.39 223.31 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 198.83 224.41 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 203.27 248.61 Tm (l) Tj 0 Tr 1.000 0.000 0.000 RG /F1 1 Tf 2 Tr 7.48 0 0 7.48 207.71 221.00 Tm (l) Tj 0 Tr 0.000 0.000 0.000 RG /F1 1 Tf 1 Tr 7.48 0 0 7.48 212.15 255.09 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 216.59 248.91 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 221.02 254.08 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 225.46 265.68 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 229.90 268.95 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 234.34 265.89 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 238.78 287.94 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 243.22 283.84 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 247.66 311.59 Tm (l) Tj 0 Tr 1.000 0.000 0.000 RG /F1 1 Tf 2 Tr 7.48 0 0 7.48 252.10 277.42 Tm (l) Tj 0 Tr 0.000 0.000 0.000 RG /F1 1 Tf 1 Tr 7.48 0 0 7.48 256.54 316.29 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 260.97 326.30 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 265.41 329.90 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 269.85 356.85 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 274.29 326.34 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 278.73 342.85 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 283.17 372.90 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 287.61 363.43 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 292.05 386.06 Tm (l) Tj 0 Tr 1.000 0.000 0.000 RG /F1 1 Tf 2 Tr 7.48 0 0 7.48 296.48 343.44 Tm (l) Tj 0 Tr 0.000 0.000 0.000 RG /F1 1 Tf 1 Tr 7.48 0 0 7.48 300.92 393.94 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 305.36 387.99 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 309.80 386.23 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 314.24 385.71 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 318.68 382.43 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 323.12 355.25 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 327.56 366.53 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 332.00 339.33 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 336.43 335.97 Tm (l) Tj 0 Tr 1.000 0.000 0.000 RG /F1 1 Tf 2 Tr 7.48 0 0 7.48 340.87 288.44 Tm (l) Tj 0 Tr 0.000 0.000 0.000 RG /F1 1 Tf 1 Tr 7.48 0 0 7.48 345.31 299.00 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 349.75 279.67 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 354.19 265.61 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 358.63 240.83 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 363.07 220.97 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 367.51 198.96 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 371.94 175.64 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 376.38 157.71 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 380.82 144.98 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 385.26 123.93 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 389.70 118.38 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 394.14 108.48 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 398.58 101.92 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 403.02 96.13 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 407.46 91.49 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 411.89 89.19 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 416.33 86.12 Tm (l) Tj 0 Tr /F1 1 Tf 1 Tr 7.48 0 0 7.48 420.77 83.27 Tm (l) Tj 0 Tr ET Q q 0.000 0.000 0.000 RG 0.75 w [] 0 d 1 J 1 j 10.00 M 73.07 73.44 m 428.17 73.44 l S 73.07 73.44 m 73.07 66.24 l S 161.84 73.44 m 161.84 66.24 l S 250.62 73.44 m 250.62 66.24 l S 339.40 73.44 m 339.40 66.24 l S 428.17 73.44 m 428.17 66.24 l S BT 0.000 0.000 0.000 rg /F2 1 Tf 12.00 0.00 -0.00 12.00 66.39 47.52 Tm (20) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 155.17 47.52 Tm (40) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 243.95 47.52 Tm (60) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 332.72 47.52 Tm (80) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 418.16 47.52 Tm (100) Tj ET 59.04 82.29 m 59.04 388.86 l S 59.04 82.29 m 51.84 82.29 l S 59.04 158.93 m 51.84 158.93 l S 59.04 235.58 m 51.84 235.58 l S 59.04 312.22 m 51.84 312.22 l S 59.04 388.86 m 51.84 388.86 l S BT /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 78.95 Tm (0) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 145.59 Tm (5000) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 218.90 Tm (10000) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 295.54 Tm (15000) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 41.76 372.18 Tm (20000) Tj ET 59.04 73.44 m 437.76 73.44 l 437.76 408.96 l 59.04 408.96 l 59.04 73.44 l S Q q BT 0.000 0.000 0.000 rg /F3 1 Tf 14.00 0.00 -0.00 14.00 93.98 433.45 Tm (Canada, males: Total deaths 1921-1940 by age) Tj /F2 1 Tf 12.00 0.00 -0.00 12.00 237.73 18.72 Tm (Age) Tj /F2 1 Tf 0.00 12.00 -12.00 0.00 12.96 208.90 Tm (Total deaths) Tj ET Q endstream endobj 781 0 obj << /Length 2705 /Filter /FlateDecode >> stream xZKܸWm5̇DI`r FbOkzbQjQ؛%OH`=Wof0cmbLnCܼ 0rXpxl U^_lÊ)ömiAOqvP"" ΂{7{67Y)P*4T)=%7=w4ԴM]5:q76P]=]k"fQ8oޮ9q˰m}q;"ii;%UsG ;Eu5ڙ a,+$C(3B =aֈ%ƴmib&VBJq+@t*'D!Aw>J&(ę̓2 LKD>TÞ,0gjڭp ޣݖglؒ[W.u y'U+,,Vg\IC.m^{lp0,f>~!^Rd\PE_TSF_mPA/2RRFl|Ddsy,5P&`(RNw)4ےT?Kfo _ ;ØFd`ԵmkRwu{;i&<'27mym)O+s[|Psy4{̱!h&m lFD6_зAF طMT9Q=e1mb!)D`ԩvĜpgcwl{mE2?6jܾMI@mBӺubRG  T'ԫ'@ȧ8D^-<pZ0XX{k7O`!evlLlX(#2UIBƎ0f~ ˽\*ɗsĵֈy3=<)g1?PR9yj:x)$[zLXG3?a.vK] (oح،{z{K܁U^+u #k+"J*S7rzeEwV7\-ln[_\z֟cthODMZ>7 Mɗ P 2BŒPqD. @)J=y8|<^ TvrzSl0M>?PxWM?ptqz yxs+!nsY5bǏT,,@B*tVRDpB b& e[fh͠$q$nH6FY&}M$>$ љV[VݵXXjU`Ȃ7}Y5通^] }=cahw h_s3m6TáC,.cEn>DmmWGlk6ȞDU#KlDPo#pS T '(F88Z._wvv8{k`%p$pvjSō ((Y D4놆 :,΄xN-RcʎF2KSGa*^6t`12K<;NCY/@t7 ) ~oMꇧ_~X| )#ޝ>|F'O9-̚bX7N<Z0:/ ab+/?g{ 6Ӥ͞6)"sXկicՔW"ʼs ,La.ӕ/ YP0ֹ&$dEjnWdirr<lN8ЄM℞Wd̯Ah^yiGHA-L$5Rf bxBd;"++Ww}k5-Uszs91pvD PY濫X̹Su\tf7M=@$_ 5m필 j1<+|otvb:M8%?P<ƪkі2zf/_ ?9˜tLVo}M91Uw}Tj:ۼmV̷ŧ nc(eLRy31k3 endstream endobj 658 0 obj << /Type /ObjStm /N 100 /First 898 /Length 2504 /Filter /FlateDecode >> stream xZmo8_͇>"X M/޵h{{b+n+YvĤ(r43g80 m,J/2 eh:&$b+qO(*WqB>dPh:1qJhБ+^TD#M U*jTG% @"`TR0)a(POHFXc@Z Iyi+ {'Q筯`Wp9.FgyS'g?e`V+}/Vޕoވu~ūIs;iZ~Q[+4Gݷ*n:ZV@/{;lGnԽ 3i>.Y^ÏES^Qۓj8؋aaRO<{yzʣhmgbsSٯd4.^WW&\8ݔ>LW  *Lx\fu)~Y'7Ws֔Aeu>lPrIՠj|;&|~204Yu]?~ƷyX1D4K9V[#ًevaíHvGs0X8iVdϫwē~y~Yx< .Jvs>H|svS?c͗W 2ԉd8W3Z.j鱨-u}ڲS͞49;?~Œ + ) i7J [V``'naEt4dD\1g$`$ެ $ZQVrapd>D#voh""ly l,c9@%>h48ڷwDrtu {;8qgAqKye.)qY Y.1[hui/@ C=rXc.%s=l:paw`TZGQ:%FQZRWbSE!QFaUFx)YiivJߕ++cWN!$Ӳ!= bmf=_4dwd>.DᴑV{ᕓ 3lZo=-J2$=`v`Nki{<61 R_dRp|hsEh=gDGψJ $lBx[%FM]7Ì!sQbh:)1dlЛb4~_k[L̘q=351ؗ BMccIQzmeUU5X!9o[UnK^[#޶9C^ixC:8qtsc$d[–bg|X~/Nz`R<&'Ƈq@u g%eNZ/_MM/&jScɆUo;YZQ IF_o^MsS}ITuOYg>Dz$o-;Cw}gSƙm;Ϲwqcnmιݷ;6r%߶[鸘3`n]]_x Y {|H۪.*]-$[\>W#=I>+2׳EZatYW LP_bU|6[a[a1Ğ +f7Q!bVhTmye.@<%-.KGUɞQdO侍=GG'vݥ\b_J:ΜueߨdV=xˤf/}?b[7DLwG7Pcȷ#eiқEL<N9#ߞcv$ QJB7 Yäu8A endstream endobj 790 0 obj << /Length 1970 /Filter /FlateDecode >> stream xX[o ~ϯ0R*_ "8-Z}HtVHEK9Zɑ8}jDrHI}_PD_fQvq}H3?+< /.wizfGkx?]04]n- UHhh) ?noQC oj4keF樃@^E:-5|Y}L}?Hc!Nu7ϺZ\8=Em7,3[oyg/V7O*^ޣcsebH4uSgE͉(kvJttv0 e~ u a+.Ɋr~/ô(YIgI\Zwk"L3ѕeM։^Cd+U;@gexQG+_R`Hey67V(,%zcZ+a!rfy{ W* Fvr`T&1My![[L2S]M'̆| hlԆhn#*-; @i=(ӝЏ[r Y<HƝG$c"'d|8޵ڝA6a|3 \ĢS#m*vCɵRwdnos!0O 5āgt3Jw1FwNzzY3ϴ^'U!e*49R4sBٕ''G!c]%``_r`/#GF@'H'lNlqB)ѡ{G{̮q-άsqW{);y X&"^%.V>LJл&F0&&Nw;[ܠKKyv 8WuCV nrj aPPI7G 6bM )zg3(]蛍ܘ%Z#̆Ɇ1W-{AMU,RQ՗ސBwp2L`?gWӀ]Eޘ][ %[Y$OFWmZqL> stream xڽT;o0+4Jh( @$@[A)[,98K{"Z {>S*8 1Lx|o"" In?Q]չj8+wPgN2Ƶ_#/I 1˅= jba޴3^H<ty8yUXDѴmOv,2Ψ0w"5ȄcdҘ(ǩs4S__97 MM?$$@jgKRMJmp,c!A\ P8/~i~CF2 ̠aPv];ܷ,!x$e*GܗvqkYH:ORiǞ']S^fYL=¿\lދD~êWn*ynE2*ٲj_nbc6/\Ϩ{18d2l7x endstream endobj 787 0 obj << /Type /XObject /Subtype /Form /FormType 1 /PTEX.FileName (/tmp/Rtmp5TQ4ft/Rbuild67ba7a7f86f6/gnm/vignettes/gnmOverview-doubleExp2.pdf) /PTEX.PageNumber 1 /PTEX.InfoDict 797 0 R /BBox [0 0 432 432] /Resources << /ProcSet [ /PDF /Text ] /Font << /F1 798 0 R/F2 799 0 R/F3 800 0 R>> /ExtGState << >>/ColorSpace << /sRGB 801 0 R >>>> /Length 2488 /Filter /FlateDecode >> stream xZˎ]߯rf!d󹵑 ᅢHdiTu{xFlYho]>ݜ螻޺GW59;ɷ${}ww >?]pD^"?z͟#\Qo ֐nn[-ѱGZ`^ϳ$%4G_qi=EvlRt :>n;kRϳc DzB\t*8{) FP(D w%&D zul٫ tهtIwBem@zep:\׾@zf]Hz X+|$=/ Ƞ@ԕ(+GWoz]gƉڕ. zCt%K=õƔ$D>Ok>w th;ĭ}[Hŕh37ң+n3 nBJH:e!J9,MK #t Ƃۤup :-^/=A(ZIG^pڄ,"H^JR*gUgVHkǴ̯L2޳@2WQV"mu4Z;.z"]<afep%3/mb!ahfR$ )];DMAi)IMb#׼Do>&-iAw)Ңt-Ra&B-}쎡,%fiMe-V-څe_&h4]#}-\ 3 2}"`ws ~hK 5e`mo-߃-(UTDt9({%< d9 {eodl+g@+sNKIFYH' A@RJ >]Y-]BTZe0 >϶25Ybt<\_i=B?W[NW߻EL]fa}1l^lLC}g:9.H ƏW?yz8/r8/v*aaj3f3]VMj`ΐI'ȬLr=A 2.J8Y̕mpLgmeEmxba&^}g{>xLpqs|[u[~v8 ȡ&~`u_vxM,ġ:MOHgzMZ]b=^~[Bij; xZ ?U\"H57w-|p?ه>y~}^=٫[XӇ~ѽ-?W55mk#zD)k+ݴ4l2I243-`>\ ^m_ }o #ljkGC%\$>3 5Q9Z W T5)VmB@RcLMH(Rk͗r}g$ֆdN)kU  'Rfx'$U-P&~p楎Gc0մup\wnU²JyF'oaDpK.ЪvGxn^Xfw Pw.^Q6:0)ӪPL0 !vm<}@EƈA9CwOa1XyIWi;O*uU0/0YPkTg!gn0JWu|BkętDұtФcB{2ai&OU:vItؤnbteM1I*tJtxM:&6&tLlұM:&6ؤcǛtLl1&W|oұM:vlqWؤcbo1I&;ޤcbM:vI&txM:&6&tLlұM:&6ؤcǛtLl1Iǎ7ؤcbM:vI&t\U:&.84cǛtLl1q68l`cM=8?G~Llr ܞģMCXģME&69`ՑV!9`UMJ>GLljr*'<#~i# endstream endobj 803 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~ endstream endobj 806 0 obj << /Length 2121 /Filter /FlateDecode >> stream xYK6mm fDJ$`/tv40MIeK͌$z_EQr[6 'UŪ*t}D#gy:!yN0rv v]wRk/XmRtuݕHBնJ\!u"1!rCZ QЇ|r_px<ľ&I {;Uz16iEN:'PGMRGYg/^hC=#Y'T'+9ߝHZR&?/[ԏx^dƏ oy/oՒvLXK[ii:{э`D%T {^ھH!w[kvs@Bm?j\K L)uT}9ݤ77@}o@:q|~#B Tz9oBRUV  (8J'=N^ma YʍRvM>d8;5y筄$ƴw11u |>f Ԓ&Gc.K<$y)`w*jSj\;qLet)EAEו0{M8!&ECs*Z=qлԻ5zӅkm=˜{sh/'LfeC+Od 4Jq>.KL2g xF]Z̯ {֧AI;?DxZ;2eB|2' dyͦRvm"xm,dkXէNЄcy"zO^ Su+7S i"E7b&I.i?(țO"/P:QrX2Oq!xiUA(b~)Uu-d.:ۤ"RqˏSkZV˜ *h:뾋> stream xڽZ[w۸~_᧖:'$@}=I*{4}%X"U^`dhY{nFb.|3?^)q¸8" _*m!x;Fx*[9mq6ݳH:?ȟͣ8bE+*k齞5c,` >d1=b>$&o ݑMI ЁW|"m]7д~oZ'*>!0+V NMV l+"''歊)(#+@aXtU;0 F1hi{aN*McL8oLm3CtZY&mqOҶ&#/|Mx<:%pCaUe)j{w6ktm ;r y.dd2Kp2Bqz^Y:hg]U hJm6:eQ7Ul=xJǜ1_ {Dl ٓn^U5h:I'wEV)mslAzdqq'JH?TGtmFaJ3\Vl M =\e0z,& y3γ5A#_g!DFSfϪI!ϽD <Dp[4,WuK3ta-x8tu0_O?R VƄqt<,>,{d;deeр N7]VǑq0-́tPb-q)3pAqJuORJ}`E Py:"_į[̺TF8 Q!Q1jEa ej6e`vvY/K% 5blç6%21ߞ@,Uwtr_dTG M;Z3s4ܰ4yٕKxAURǭdE.KD0;gD8sDmB32YAK"i7H1p eZBUtqR9$C |OJS d~23p05:2 H9N _u~`'L5V[i"пsgDh˖ Cg|&%JS`&NjqJa 1(Ÿ;Oj:Si0!} ?I],HLvʑ:]ߴ%tҰq6WW3 @P9lԱ,1(% P:ciƟPMF"qUiR='"s|^#I`( W# }]-H*騝Tmtmwȵq -pA Jg$R=[0O跸!"q$<.Kd{$ЦMtM_@d-X~_,3f41)- f.f."Chgjo7Z ^8γAHWYc Pߌj  Y vfz uaaBOjSX-Xr #e GyĐç5[mlbg*l]'J eUS/7SSEVb^5?y̞'t,!(˄[ҽ9gьvN]z;eZ7Old[Msj@&4Yǐ>'I[:Zm,Ju6 ;ϲODE PґvVQ|Z- p: ҏn7)XK w3kz#]p1bC`\ŦH }uh^ȟb׋dTr Zl(tt Y0J< zz> stream xuSn0+tjÇHMq*РAh-4_ҤOK,;;OFDT$:bI!`AN~F=sL.H3&$ZRmvv0{kV`RsJ8Ὥ^u:]~!O4I"~ JAr Z@n#ɪ4ߵOƚ5\Փ=MHѩtӝk Ͽ+6%m\Ir LIF(glLGTB^C2E$8Sß&%FĮ5 3`҉s`=0LM]^jZnoИޓcn0Xη38s[}$=9/L_+mM39$DoݒsU (LGLs9j7osK)}s;)ILva9-pAykq mL~J Ũ]xmt- >_!x )E %o8J?.eM C>C..ك9B&0u2_h7xtǢCی*\iwőtv]"E8 endstream endobj 834 0 obj << /Length1 739 /Length2 922 /Length3 0 /Length 1452 /Filter /FlateDecode >> stream xuR{8TiUӍZtLƜf4KTj\Rf(c s8sQ%X-K=EV[Ze++J'\ {}z9|߱4xR,vPư'!XZ.a1`r1sIg8Й1A".yxe^*8tb:ӞAaB@H"(><a㥪q-ƕd`M6dK)cTr#>S Dz #,ETOU>!#*4F!JwD K! 2\ P)`Jd$@c@'_"@a>Hk0?LHh <?u++%0JX J? w4j2E+VLb1c)`0BZWXMKC1"UD;Qnғ_ ޾gJ'zVԴx&/LB ^eyϛ,}JSk+BN7P~}\Sb'{Rz׀@]_ᢽ*?FdGs-߰kOc`*1u5>p;+3z.ckѓ#{.n)Dn77ժ`pAxQv00s.eu/GKUP*^ݱ.AlphֈjEssu[.z3sw]mLvM^>zu_;gmB4=ʃ" vU[i- 6aw;5w~{nƪ݌[ˏ q9Pfֻy=)ݷXKmu/ g61uf/&=#{)V^9G9Cóʲ +v/}4xpK ʶN qL a蘽02õg$Y^r]SB7 B #j\6=3LY$nA+#NiIϺ󦢔j/+ovV̵8^=*Pwmk3P]4paƖHǢ"cap\'*~vkY145@S-'Qb {Ndǩ0k1SgZ-'e>+o>\t*^pܴr~IyfRMYS)3v.+SйKݜݢccS}Wޚ&K=ܤ>B8m:{`^YueuKK\v{$r[wU\pTZyi26vzOΫ~ b,)$fF6.FLL9t,| endstream endobj 836 0 obj << /Length1 766 /Length2 1059 /Length3 0 /Length 1602 /Filter /FlateDecode >> stream x}R}TLi8} }CT&I1UMR66s̝ܹ>E%,6*)lI{sy~{~ۉ!D.Q$Ģ3 5 8Y _ ( f2&)ħ"!U&Ut^X\.Ř&!A8*pcpGPBH†SH a8ROIbʝÔԐ hNP{J$b!G> } ¥>|X{ ( 6kE!f2AǕ$uDX$bF8J 6D0ȿF?I(ףABY"Iӄ0L&os JM4fsE* JF5#0j(A%m-J['^yn:vԤqy7 e'꼛6c.gZlׄOh߻[K@^xU+Eg!Jikv_4 2wPV_~xtpFյ sdG~Mvs;K;?%Br> Cc\ X>jMvg7-اetgw8ESzg֔8S6w DۺԜøǕeu!ؖ *dyV e;^d>UE\~QTm\uI8sqnO%sWnjZV$$f3Sk['89"yDAJii >W[a)bcQ]ȭ_[7͈v 'tW9"lSݔҊN!gZXŚk:}䚓EK+<OGWnά+slr;xO𺉻hFwLz՛6yi:4>VeQxqQʌQNQ;{2cv߹<R&4]gPƔ~2eG &O;6 U3>]ᛡ-4ԮY`˻mtoVC[. M}ȝuwiy0u?0`< GBMAqg]'A =7󞫣Z}3M]sW;[-4e59n?|S,cQk xܳr> stream x}Sy̭W||>>lrzBg?+^d?~@~_ 6d뷮7Fl].\ePX`乧`V@ʴ>wgaբ\r絵gDќg]G-N\#5/юכvV' .cutb>O1G#;u;fywimK6\sj/m4~.lsz5FN2f)wuz|h/nUgk^~PvB; 3Ō C [zhpp${Ӑ"Gm/xYQ^}, [K%>bWN4=Lvp``[Ob[fgfçXZ0iؾu' ja D\XFfEhK`4XFO駄KdTi^Gc^@#eBq>-FBzr hM4jMN6VKuKzՁxgXun+u*VGOeˣ32n'`LX t¨I"Ly )}o',[6U'Z&dowR^ s O٢-5Q5]6Cy%H VJuk肬-+76x6lSvdiCY?7sjc hG&rlOn7t9Txûsp~PE{sQisٔ~˒> Ǒ#?>O}sWoh 5SA1j5pٙP-"WXo}hCo998i'9DG}3D߈cFSo{諏I~Byq-7;T?qeQȌu(.fJ9.G\,Ԝ=|{([%[NJR<.?d]Z!grt/L3]`zt%#8!rqsw)wǐBwi;ߓ[6j=\=,|c}aٻA[u:Ub?|fgƩyϞ\|GF13:y (?#mBƬJAH$HVGq}c܍FO>Mr8%ZHYtJqnuZF8mXTS)wK-@4-w>i˦mjT#…ciSo6TRoh`የV,OxjY!5<.AjB{~:;gƇkc~o쮏,kڵCZNr^i4:bo+Ŝ@l{wIxZfUJ{(ֿKBZx!#b؆A}ohë:NXnWڏhMeov qYN&,/xIgd|i4E6HmME߹Q#Ԓ.c6ӏn`EJ8ٍRn9SZJF1L&=$j%fiA.sR)O0::yR iy'Y:TE{y$_nգ"@>.tK1>>V-:~e ONOE endstream endobj 840 0 obj << /Length1 808 /Length2 1347 /Length3 0 /Length 1915 /Filter /FlateDecode >> stream xuR{<ePQr\ 8 ә,f̼3̅w%r)ɥh&Gǒ[2i9n-Ev϶yyy~yuhn[ta BX"LxA!Ȁ!)#pD<0`Q E rHB)M, ~ q;`ʳākZ0(!MCd \)91{e[Q<+qa 1sfp!-* ȢA0`3"p?gB.i!i3D'&D4i;yHtk1DLkOg}J8GW/cVpE3,fC(dHx 3 @u JaqXFb8` 2'80H.+ a? iBc) Ed'2D+̟}v +` XPX'锁 .N9w܆uOMkK\0" \m^LSN4l}G$7n(VL jWy-/iASژ/ͼ}[JXC0ziRTzYK w.G<7?cq Ɗd00ѽ DX{\넍 T0x}HIg< eu޳TE9"~{1F87l-108A^ѷb\-s23ҭ@'W4s jOj-*.7Ǣw4LT\F1F]_`ӲI endstream endobj 842 0 obj << /Length1 1283 /Length2 4498 /Length3 0 /Length 5271 /Filter /FlateDecode >> stream x}gXI׀)RD)#!EBI i47.EtQD"E/+Jssfj`,:"5DTLC|x@\TW X:  P0D `x`bP *-++Ch8pD*1NX"+;y %X@:y݂#_b s$g074\rC"2bh/M/aÝ<+lA qnh @Bhÿs&h+HţEJ5@@u= @b BBPEWKD`=DJWE1(*)p8!$ЄmH_¾,0NXc#LVE2X7`H o&qC2b7*6MR%MDpC? 8<U3H0@A3Hp= 3Hp 4gJj=`8$ y%H A v} >g|73 _?7@b xiFϖ8PĀb?/?﹪*_*@!D?h 8B~povB^;鋄SMca.aMe*lE?|l`%w֥Tu@=2xW1<&~0kӖ2FHs^uS$p ^F I??OhqԚ?|Gt/Od@KWcUhJmy#R=:Dt$LXq%e&BJ6 +0K]7ťmvz &m01pjfRو+ptB`MPS঱|Rz1}D m-[9|80DSz`%$:nv2'`oN€<ܷ?_SJ!X/n$4Hj_5KFn'DbwIV=kwDل,_Ef?Tb߹'}`Z0fz\Eӏ2.2WM' {xW쑄!^t"}+3^R4`bl^+7nn@,W*/x7}_+A/hP)+nr]t`D j#2h@KБTR{"N8{k,u h3V6Y\u(&X?Tt+ P`0Ƴ҂Go3.!)*60fKH&q[=ŻZjHb35_'YtnUo Ug8{ d }]SjS>@rB#ظy_g?$uap,Dϳ$;O%Ƒ+ݬ. ̧T[f.A~8+,(%8;8GtΧ;?_,I^H$/djɳӣ(\!)mVZvD^ewֲ0':cm^ޘe[#V >jon+WX?ђ8{} 0%&G>I+=S`3&YQ^m8~{˒,G}S^M8>9ǭג0ej7T<)D?79{`RCL;ESŽ*Uzގ!τV;E;KB0ˢE}Uo0m'8)!@DlhAŖ$6<|gܢOtc;KS1,疶#Ul`@% ;Ц/A6JbwbP_UV[C%^@ܽFMBn) AvX9b^[tfJ0(qr.Y/nYC @*_eC( ωj]]\ɰm^+zTqLah|功\yV޹m vŌv Y; dˀZ PĊ,ymsmY/Y{=ijZ*}bT:s>xb6~^$3MؘOL 0ݦ/Ah(#N>10ĔGYxOۘ_e[f.y_Iy&=Qi3E9ʭ,=0w1l<8T:[N3;d h$WfJm>$LwHcb\׻v92sgw̺yf50W!w1<}22xy0YyE}l>em'L類3l0A^ kgW)Z Us, XHkcd 9 |n]+S4?aL5W?Ѵf ww 3 CeTu-jFI!YNHn![6h{MĮ{7k#R9$9-dLmHS[J CWA;LyTܱ*r3{\<7x6+`|g?ؔ̊"cύ'K5ZjP={{h \wa}XںWc7Whu>ӣGzJ-*]O XNWpp4\]Zr5/EU<\Xv^U54VzY"*u@4"6a }`ﱬjUE(:R< GTUe~.s&'1_y1%:qՇJ2\TA|daW7?dE #]YE?Nk\uG#2{iR21~#B/II:S]R_d%x.k@>=T7TGe~_Vt}I2~͹`5Hۄvc{=!1N>P dg4$95,3N.Rwe1zQXgxlgԏul]w>_9ۋy٧iekA\a-TMۯ,篛l%c'XWj9Ed7)| 姷E3|Z^7Hdv{wO.Z8 u9*(x gT udz$jܴH|Sk^L뾫>UE9cw^.-|ůǘpqC+dśqu˶qacZeZR~rru·}"sB;õ>Iy",җPÖ1~g~fJJqnwѾ㥜10lTG}Ko•LPGۿ_~q ?>bBS+b f/ϠO뒶5"6nYϪQB}E:ZrN'zw{ Ea`ZϞ*tn ~^}n.~H誏#=e>Z@ />ϣKs%|20բ9#AE;)b(|{"Tcs+;/> stream x}uX[) IinFr!RnFS:Eixssy~^kg2ipJ[A-! Pg'P|\LLn,AD<<ܼ@ !HGK ?0%!Pv+|7wD+(Q X#y8:j ֿt7`X!VvNU6o7J<  nv-8yځ!40;0B 8!zO>; V 1@ n m%}yMO s @nn @/yv7b\Pb ==#Ao$'!= I-/  V'^= Q] Q]5 Q]_FT׺'Dg}O:ֽ'{Bhѿ'{Bh1D>пËX9ZAk,Bݻ-@`b kw@t/ em/!tZAD8Oܐ**rc Kr< ">#on{\l}\l!D lv b v}i9#">"3Gz/_n\݈d. 7?" o_6;-sqc<}D\=0AXh*e~ ";mHv/T'a#DDt+X".w~+@v0]_ߏ_7ܠ;+! 6r?@_r >G'_q`7ļa} /?lmA Ù)(X,ؾ&Jҋsm}q="ި7\jP$]bPL/.9*mnxLm1  ޠ:n JQy,Ԋ.R;ET_HZ+ZL$M!ow)C+r{ (n 6A. 60~Һf]w /oHg)w~gQiwjroG!3dc ]5OYqQQʒsqR0sW˶b"8 L~qS gC1Ȧ?TH> /61.uN>k{ەSs#*+VnfTd$e~\ j 7mY0.N듏ȗIL@ n[VC_g9#yŀ FO0qvcwsRbk-%75U%B0!xLq̧8AJZ3P`a] )c@$[ʛfJkc 'saީq@ Y7`WKf&Sw$Zf3JV7~dPn,*MHQnxkҗ5*E x0PHяzLHAzceHr(nsXl[jSYS][n_I6%axT99K:KDpĴ6J8qף;]3P\|;,7E%>{(wAߩQ±[F+n:cfՎ*es4̦Xi=`Y-=^To19zRǠxsm'?7mHpr/6ttrbuktrJE{0Oǫ~ ;XhT_5 ܊w= 5۬Qb\aյ%=ڠSRpŸDTr _a{~ǡŰ\k8PY`D2WʥwT#:ҍ%̣"`Vw'1uҘ\MW *=jZ&ǿ(\!t9(CqWXYn13ÒJ\粲 -y'->[ѿIM[m|P!N%KhL`ɇ%MpG5ߡ$y/"U5'xƺÃ?u: `9VVAS=X%KQP|Kmk[+6e`F87jgz7EK*"tbwvx?G*?"sFJ EcUW!MB["#މft+Ny_ۡՖu_PhA0LOèq%?ԃ$MeAхW둅ަ!-Pou>Z[sKR;TVZot˫h_.aDd<DI3:jEK3Ϊ=cKlj,ܱ%tAikj{'o h $b^,> ސ&\aIih_yqSK{sMzC>=M/Z4Ɯ`U>qI'>)j8)Fg29#T`7W톣g@i + FB jXi2X$s>T6#u;А/g+Gheqja)utM#*@i9XWCf9r2$X|8wѾ Eon_ [1.>xϥzvf^G{L]Gf=F+b[ U|NWY `F.DE'x@};`dR&nviWZuh[ڍڸh},uC2nag5 J%ժTtS~y'0œ&nY ln"lMq}ygyVT#D,ue_g4D4\bxk6inhBśCz<9L-ASUD̐n{/ D{4 ؚ}ʔw@%'ɪԹE/k6ݓ2}2@}ry` _Fp:$r0Q~plkt پyk1ΏۯԲ( ;wyOQH%E$gVTRXf-aD6c7~8>]ޥZ}#ٙEp\lWA06f8~ `)Aw=N8 6Nu{Tl9Cƨ^q(bୱJlkgM Rs^ 8\m?ާ7!șFb?(xR4 [bڧT􇄨H~$uYn h.+c}c{ϟ/b<=Es" |(b6*RެXIB?Y5D tf%r};d2E~LDnw~D;W(-LL@.j <?/Co9g՜k'a<'5Pg;$831%=HW `9up]_^G_M!rt{L 7%q8M2i+ly/^Ug-K$MȰ01&Cwc2Ur&|ˁ8,=p2vpc4_۹7H"BxF3Dq(xr>ǥ 5[DZWp#8>M;m:tH훹,M'}?Dzs>S :p\qGtG~3$1,E2w^.HB:.y72\{,*"a?I$z8 mӒRhKW:_LƁ#zƏVXkS=)DY\|{;SH'MeU5DYպJb7ٞ;z($f#7s&s5|MUo@m$3A>!LA.R{{bWTy#{`Jmw^jYoU`Mao`F]4zH;Vq_5j X2[qyytU/E o _ ٩9Rγ{_Zø=,hcH؜Oj/tQ_/ߚb|R>/im 0enߒȔm<9|<C/T xssjiO4+-‡/ki+`3oU)%Ҳ(kl k(s׳_sǚIY; R ~]K5;ԑl ^">'ZuC|;K'N3YTD:c/-~TN mN ˄IST ztcͺ(^K]n2t<;`tܺ{]#`,!&,OЭ+gFM$ X$Jtd6y/hO{yܻF_P$ޱA=iJ 42A?w&0܄ JTCx4u]Xm^WE-~]D܊n [zIкg<ܤ_UhףZde榤j(2/7u 9XLN&@Vnuuu˅~h27t\+8KuKlQ)}2V( -bZxKl.f Uҏ C5DRQ.XDKKdOGTu4a\{)?'\H,s>=0bl)%VRNME嗥\VNuc 7N5nCq&{%8=<:BXG//]8k!=yxZY"tJW{\õ'M_( ׳IJ!e̊d4 qNgg0%ToMYYYxA{dZ%"xa)Ѕ}S+]QâXx(5o#(tR@ ឧ{\#ly H`벹Nz11ֲW ߑ¾ƊdT\*8'|.ZC15\Qa9YhbT ~`gśAݦceI7Ð6(5iZ)X1~Ϻir`eOxKδ=; UBzkVo)! #I{E==ț 4=.RzfBP {m#4>i&[d6Zb:qݵwU+6.H75dB@N_f%ߵJ|QN_>YRN tcfSq*A `V0wMХz1Rvbz릤z3*3މ՝\yw g# ]4Ƨ($;k~c+d I@`sUQ1"e!gӟjZ؏MeP;`arn@VJ|XNE/P:1c͠g"z s y./X?}y9:X "oR;Ԛpߏ\nDRaRyh갚r'(äp|ˌ:2oۮ'f؊D˕;Tʐ0 F~4p}pY{PYic1B\aQ~;+')1Yڊsq`CzQ۪MU5?Bo>HGv5/+˿G,,4oڒt U4-ոYL _ I*1cC f㻖u^]g_O?=?ûbi kIL\4 L.(mdQz*."}A*rTܪe2GzQà"cq;fĽrփڎ_XiPZ]qUٮk\P͕!X4V4#0950yˎ?{0KJ 42@Z0wE&o-w= yԇ8[0RUbϋ蘆,N:xG1^>)z-ļ ujŅۏ$tN6UOXF#H|y_EtgUY CS Eͩz|H!Kol8XࢤM̤[XŰ2<#nfL~i`Ka?RnP ɆU6WuX  8q<&늄(Ks&UXU<"OV;o]~I.]P׳@A3P%/aqjϖƗ%t1gr0|ol#I;c迲fź'cY)lLc8yD rNu|#eŪ8UwUr*v6xjBjIWXS V c} Xd+?;.^Etn=uf,Y, 3JFI"/NgAc 2uʏH yEO26o .kL,H-تʋ0iT`{w.7_b}=T(.U h+0zox[V#~gL?ʳdj{}"@"F)f[fCh%۫7YCbt"@_o!ž#S+K{gO7 G%FP Y'S/^wT--rW/%J,=hp>Πo68}Fb7 vh)TwuGG\z-pIj_SziRֹYې"/tZ" t%c"Oe6n#%FlY#qo0'{}Lci"2(s0JK1[!yHAXFYV-$~`&RKՃrǴ(i} Tm>,=6wfT? ÌBT O}Kd7#]ڜM-_0xNS]PI#e$Rr ?H2#&y $u^1!^oĒB$ !;䰧IlIл6)CC}{^2HOB;dFzY8=4dVH<+:;ucu.?gUL<9i<ف&ԲirW Q: endstream endobj 846 0 obj << /Length1 2222 /Length2 9694 /Length3 0 /Length 10907 /Filter /FlateDecode >> stream x}vuX[6-1t3tR-CC ]%-H "x<{]_3^ZkRYUb ~ r nP(V ZB$AP  dgg0$sTpv`pqsrL-Mc*w|Y;3o6Le$M!v6Sl" `+cZڸPP *.鵥Tjb::5L6v`eX9`MMI4eBau7-r2AŦ `;m(-+%WGXl@vPC^L vN^!'V+f–읡3#=~S#^P|D?|8`)?"NPq.``ꊏ⇩+?"#="nP5L]ԵL#k`dk lC?)7 ;Z:Y?6c)2cG lIg1ߴ5/Y+l`_ vI7ckؐ .Xk1TxA6Q`YÆG+a9=FyY,Qf7}?tcX`?<`6@X5h8`R`o%m&_g!&BV5mWb$[c+k1}!WtԳAj2&q -/zʨ$P#ǮR=*wU=H ίkƖW];t_u`Lr4OQmd[ ;?LHFK/Nd x@dY4ְ W kc$LڟlBP.<_ Vq+ddj>o|3#iX]M_c߅^.^@n_b^{_vR kEU0Fo7ٝv Uko ^}}饶vKs;s˜2#냻V UET8q4Sٹ(wzM1qi-'Q;Ge7JS.qFjPp҂*PhtE\AݥDrHfdfβMt-9X!~#YC8N|+:ex%,X%X D(eI _~ّH 3ygzXdDikɷ|\4O.ֆƑ5jun-7H[BFR-p!Ӳɮ朜tݍUڬȉ2\n\"f E"/.Ǵy`qo/ e909A?0fn0ZB %Yz2qyi!x{U Bpn+$iKp-Ռ0kB3S6fؓ6:.To#o^of27(4}j\~ >O]j60DFHo? Ix_z!ٍ9gR,k5bf\7tmbPd':X6:96+l0n x\)9gc2ANQN c ov";#0K&3|S)Zy:N>ڄ[[XT5Ӿ/APKbnQDwe1ÏӡE} >VIL@~w }i⪗K"!pǾȰ0."eM?n)o&t*ƉרBW #S#&·M+_`Fljk9]W k6zYwR[U͟sJZPXY]JRhV\PTWT t XɽRzM!5cU  rٵP6O!2\W-3?vZ]܅%nc&5I %,_`8c1-iγuQ:'zr-qN JDơx6z^#ݯ wqh"~S,||FyNX lUz|A;ȎXOVmW)'of8JgE7֡Cp; A)&fyK}L~w_00Ѹ ݺ]Gr;Nc_XeoHF8Oo8B^ŵ[5\i?9@H@4(pZOio2[' Ix"G[#ƵMK-9+9/Ǿ˧|Ga? zA(2j',| ;CFس`6o'㣔'^r3J|dn2O8q!@@vkd /3W'-/հOb59M =gV~Punl"'9|2o>^@V4Zj,-yv*V;l@߇?37ju`/ŠR:`%ʴ䅌hd[{-z)]%>VZ98`2PBo}W ϒ P#JզW6;q b/F/:$ag%3'zrT14ë1M4etC&Df;?/,BxHdWHJ{K.M8AA̒}f2_|m3FH. jhRMzmI.e]N_3*2yHWfե'. JTxeBb"&hQ6>z|ds}?=X3qMxa`~3AjWtRaGtƀ4h jbo=pE|蒭;'Z={u]@i8뮘/&-bQIvĭo7*2?x@НzVW qk,xd_>k鈏G'ˎuʏt:Xc iTI7[c<~E ~ƴk ٰ殯'HK7GlK;Կg#.t{KѭS[f*/)^)?L%!=J)HcoAfbIZˈB;- C/]q|!ttsEh=_V@.7+o.:x('[4y*=gmGʤc jMcWUB ^)77aX/%KJI*VWO*a=1M joӢdMKUi#{fI໧Gn D%//!g\/[έ~&)szO\0zl݌[Wp}BM))'H9%mZ%6T&(yfP?__SZJv~YSv+iǶ˳Iq8zl2cpL@Yl vǫ ;xqVhayq$A4U4ΐ8(2)/"'qD;-NۄPk5#*=өz^g;m[Yʖ hZ_rswѩIm5vNYk}HPyhbFW+WXla&ivoЅ,,&_) [NS<5 U!ge/U}t&N}+moRD3m(N!LUQ/踟qkG^M{ͽQ\uJsD \o]sФ8?M}56D>I@nlu4k99LϮE*MF|ô+hؤoEy!r"Gt }{/ރl[᜚DI$6e&lXZo~!nt9++}RS6iilG+Ԯԯ]qSQsJ΂)g_#obԟU|7a[~JK>d(kP&9uɁ+E w۟WEV5@{Q# v8}`5t}%Oi`1t ﴈ1i~5 ZS,+'.A]COOC=fԈFxL2@W'5$~+fLgìCaaA2[ e3jH#=W5]-:܃X imST-)#w KU~Y3^п5A>kd߱0W3+C\;G)3 pPGq&{nH '\M zvZ&qu" :"n~%KR1=˱ w07]VHc7SA jdeGSl!e'kISjSPbWYCmEvL=IѲF{n_mԹoYb‹ڑG/ڂB{RAY6fT5$2ueZy @uso˅-b#Fț}=+~{T۔botOYF&]FX"K݊aWacT(b!^2a˾+bHҘ + 7jveߪtvV'3[wn@s~.s~ HMEڑΓ.,fyøIZF?Ș13FE~ZLЗBpf0/d0@܉v7…4YH;8@_C!bq{~k9-ߤ4r%zyHPqF> ,ZN=_:I9vdp֔]Flٷu6n*X1_m旺.nZj0)_8 d\/bcQ)|}^EƿvW8G k`X淟d8,d N,;UcWҫ_9+^b2MW&w5!w݅@[u_񚃴%&_pr7w>Lh@l;m)틑!:*<>EyХ|AnZ SېN9"jfl1x&dhU,~N;sLUD}P*$kE:6@<DesEQܒPU2F:Py,~Br*gJH$:ELJWkCBPS'f2 +A>)Jg|qU;bc)^?Psi oO g99.}o>! ڏe޼-!V;BP- s(t7Ttt5E([s4j"р4q" ߋd>tbluvgZ^{|;F(穈J̛ I! ^ٝC[%*/"v4".Eh,_q5б !~⊿Ea cݑȫkT+:{5ѷl=rho;j,[;֨7.fy,픷aAH^?$p=L^Un]ZCRw\M弗Cj}El1;C2[8*?<.B.~|$g1ԒJr ͦ2 k >FQ+9T=oݑ;ImZ+O^ڏn/J旵; ){n/PX?nv7= )0Oi/bI` |9UNjN"Ca%A]y12 VoS :W{?e"! ާ]v^@ 7TSSBho5=Ǧ/O[ u:A ƜَErB!zW9+Z^l|ry,B7ы&Ugұ$bH;eV'(cE?◢u 8И.\ޟ=,\*T}լ"SEbQ8lE `6 w+ZpދJw+z"~'MWgU"P%)$7N}fq9l҄ū,qPUZav uMaxXc uFc;,׊Vn"2a^;,b0pj(l?s~LΡ[%=Í'JaPx'vlدMj^wPcHVie,2*}Ww PPby_D0ۃ5kNd,x-=-Feыa'(}E.PZH7pSĔ߮dc G p<5Pw+J b1̭Y\V rK⨛TfJ[fN1پc2, .yƓr< VBl9_g0H^{xY姴VP볲%?#9ɾBڳ[-f:bMiJ78_72+^ k ]' } ïcKinb:vཕkVL!J$֙Kuk?X0D+D4OFGgZ=\Jh;--`?\OyцOL|+懦㺂iK(ߙ!ag_W-&"f8IU߰x,GҐ^k(0ag3*~Q*|>g~k&&Ey5f Ph=bNq2#2u04gOWb~=W. ٵD`5>,V:y$r(aϬQnVٿ|9%3VDH:7oSӧP|xUnPoܱVYC!r6Z8 Frmks%-[=&,dNxqDo΋|_M#PsWYU >f{/ZыoD&yە(fi(Yti->W I ,RUZWjA1>Qg(f_-en"\y2? Tn*vw.*OXPrMT*yt<4K}hӋ(l:rCY(S8"#Wݔ;OPkacd-ņu z W՝wMDO(]Q]".*.$zPZS,%ciCN#y{Q.;p98-rDBW3KF=wQOsN%:F* cE?yԵ!VOBU -E3×*mM8]%$n8Shl0`;ְi%P#5&aɀZȜLam_{Aڟi?n%I/65T}77=`ˏ#誜vdS~q: <RRh\vh_5 xyܒd a3 xw8J<2iqWl:9mέy;D;{̲+Jƃ&NΌIs sqGC2F3ka`8 dJঃy>+6*B"<Ӭ̓;e'X-`j_qH3> stream xuSy_o^##*Pjh<{dqjCρW$#zd /T.J:PUS87̻|\)⏮ Urڤ/d6QMkYY( j;ZذܕR]Dݟ._eV^;iO%axIvaJS2C쇧N G2 { rbC4 DelT=yNSS*}F.WWǥֈav+XVB2F}WgBRwVqyd;Sv] 8P洵G?m~ߦkţ΂ղ م)cFE ԖR!z8aUx-nfv15y53m{FY>(=)1\c֘[_ZL]MvV"y3FX}ۤMfBԅ텮WKT^N~nsmH,vڬ| .0a`ӛcیޮЉj l)x,`MDyC'{[q%&#) d>7/j8*1O왝 7K%luQ$͊;{eWpkMۮ4vV<\REZr(p";)gGNsÐj-o"^r]c\dh1c(ֻd>1s U3}Jᦋ'6DذYSy+bT֤\z@ ,JU舵lh8eg&䩅]'I "gKVnv$}ГG;nV2WTەێo 9(ry{bnjXB7y14޾Dw̿^%KB"ϘX;'/fn}`5V<=WҬ$7C$R rNIpMDJPToI/~iBR1dbvݗ+iG_JrW*64wET|4_ڸQi ^XQ33A"q8t^;u _6to2}f  I71 ou!{E'Xoid8lFs /h2ɳȚ7ZE40~C_qsa`(>AĚW÷[ qʡTA4^h-鎆rzN=ܢگ~1@) >|ɛg0(|gR(l]O'xt LJUX[m8l5G]PԔZ 鿬iy"8IJ>9OlL=Պ4?pk>h"ÐgLmڕWq]ȯ{Ρ'eۆ J&0&5( fb)Ui2rl" d1Se> stream xuy( 8iSGLja$ha,Y 2X6VW`2F`ɴ Np QH`!ao&ƩU-dKUR5ʄAFqt<eG%3 z]@ 0~V24:`! d:Ɲa*ȢC0H`eGM,F(0fz%<(hmw6#\ @[=̦0T} LتpE)L*>@fABFz@0mV[ f", mseq렘, #>?8#,2?wZ*G}F32]#@!B~@4^ȏ-߆~u١-vBXL_#Ş@F VW븅30D4tugW"bͭxtn7>9 )BmLɩEJ ei5+;V('‹ s-Tf\S{Ӑ5VSӕ4PFk6rn`dvQ/ZJKi*ႷeCFȚqY6O-Cy.#"]yO\Ihv?ojto5#2YS<ùYDD +cuJVV Jhy`}H_pd:Vl}y&wɹݫY2X)]pKoYUrR9SVw -]eqN'2iIOd]/lNphLTS)w˫I^~lS`Gt+̀He]Ss|ea_ aJO+ƴw"4k1Nq~+0TޗD4rnúG%p$[fVB7$>sӦ G#k\Ԡ$1x9֍6ڽx\ W^z9N u|ђ۞}s\i]=AKS4d6RISlZ1*[gVS.>sx;OӜyEk[ܺX\$ѿ?z2@܉33i N&V5]xpqC.W@`#M0H%$Źf[ʞ{1(X ~4k8u`$?\!]vS\*CD7xs%Eݿ-\x}Kv'xe#'x8zMy:|;oCRk XAvc*r%&"dS;[۹K%*Q œSlQk ޺/%GU]](ֽW.M$|.,B؅FĹ>P3{w{=1jrPp/Sc)V$:,/˿jQ[0AFo׃H*x86+j zGȳ!Z KZW%{MsI ^(oUJnt ao,%1,r)wIn^q(ugdM(bD9S46 7zΧLEI~=mqEQ^ɂr%aStJȯ@PPNw{2gN V ¬_ԚW4xtŷKyhQiW/p庖)\09\.rERܴD#ׄ9U7/*fE78}:tpZyϾʗPb`K,)W E5++Ox!;aBMNJrLq)gj endstream endobj 852 0 obj << /Length1 749 /Length2 780 /Length3 0 /Length 1311 /Filter /FlateDecode >> stream x}RkPWU8ƎⓂ7$ټ@##2@ʣ&,ݘlB2A/RQ+PkGP Q)ņ2,.1fj$!HLN8#5X% M}QKG1#csNu-k@0\ xBOk4.P5-$uuV 4% [tjW c8nTߐaH 2%0 2 A\ӆ% & ,>{O*:hߢ Z-P9Jȗg&YZEaّݰ]H~G)>dUw!'R,m;ܚ!{EKq |_~uI:#eWG3zq'(s&6Jme@"03!˳ :135}𠈦 ^.AO6dynHE Gs_o+ߵ[HBDXN0Bwץti kl}WǩOa<gՅfU߭՘Fhis >zzNB1/'8^@DO ,WQrcQP-\⟺Uᢺו'ӟ35M5#]]c%jpvFp4r.O%v'OIq>prҬk5Oj_ -޸Ot?/5X.'yI_kj#+eWbJȸUӒLO u2nWT\vx2L`^}{=ZW /MI}5wNvJ+ vL/9zc)}ֽ4O]|ɻR;q۪kj^`tIϽJ';hO;]{8n[5̙U}NҷYx.=Ep<;ً)\8ZKgnǴ %-cw46G5ULʔ3 '9-`圄sgO܃s+":,) kv89dv`;<}b|G].%sn endstream endobj 854 0 obj << /Length1 1144 /Length2 4030 /Length3 0 /Length 4781 /Filter /FlateDecode >> stream xuSy<&kdD;K{YJ 30fcɕȖ!k5K4Y\DBi!C {>|yyyi{y}nA 0 ACіvp@U,H< /JbP<6⩼7bJ " *R ?1X0Älx8DS)#'QH8pEY"d.9=wNoDQSSAqH E]Qp4K-# j C ^P8⼀h8^,Pc4CcfFH,ܓQ׹1A^H4gK0E42``*7 %&H =~t ?`(xAQ8x8 N⠁pK_;EE xk[ ýCx,2p_+W0hp+`dp20P%UJTP5UU"[^S'gp,BOÞS Gz2 HD?Z&g24vX~bC?|\CQHO}4ט8d0f{za?h?,@^QU鋆pTh/)ўba?hOK s=Y&1Z7|o zܭvq r E;ءͻBܽ Ï}l)"NEZiMx2 ecx#v_  +'X2~mP㵁pMҳ}i܏Èk@îvWDil#0u0 a:神*>%+Ȉb y"sC+WׯJ1Tm9VXNB7޷Dƽ}b /I%>By V4#뷣Xۗ˥`+/ٕߐd6=jEqdDaqJΏQv'c"> $ұI[єԦ֜PCU9Ib{X~YK}kUnRc5`EwIS턆7>GdL"ޕj(]m~~FCwxR9zB͉ILD'ko 5{RRJ;?G;94Oxb 6@׎qˑyo`cr$Tsy=#4h.]A=z3̻ٔ9wˡ:V"}+3,}KC$]dFO;Sﱱ]rٚ3.K83m:]ɀցeQ7^mpKz;X=a+엾f[q;*qvVAK+ɕQY#d&7D:mPfEny+ۀ/66quy]4IľGLC 4|^dzG$"e(;':ėO^KBs{gCaէmc(GoH?.3 ֽTOa|\äTz/dDsHD ~"TV ;\~ހ櫭7Xf2%3jQ%H(~s)-AhlaLzM|[&_iS 'HN =C6Ij磥kM ls~-$([m7`s r;-\Qt P?ʸ>O+{zS/ᤋ\XFާ&/'.rvA?vZRf8uRŋgRa4\i`,ѽc(yS\UvN*T-۲63庽9)%tSZij4~}UO}? ,ya)w(q=s/& Day4ǣ-x2.%#u_?^ݪ[{q v-'mͲ0 f/jXt49z4L;ry=A6u}wL9==4| \6?;P7Xzy=d k 2g8c&E f\Sb9' Usŭz"+xϊp| 5)$Ed]I:SDIKW9%ٖpgg+Й7E~tkPp~uupLSMNxǑXCM厬JA)dlV# ObVjLH/D(߿$7酸|u7g<;SZqCҊ2OECJ½˳]>ܿڔΠh8$F 9mwl=f{é0v a Ӑwp|7J& K!)d+OظPb5ˆng־x'z/|QyO~{un=-yۺ%S/I &'D\YUʹ]Պ2~[ SZҽO;IS 'Pdzɩ}^&Q55;}Ad,ؔS)&En=VE'NONs[=nJ˨8wX>g)kcj0 \yr:4⑟*/HT3gVMm.3E,*gBGrfzlqH+/OO|݊:&] (,< Gl9q=*>{cq%xgŶpΜ yvy%"$Tr=Wr֙Wѻ2.yiONOZ|A|9[p(ZptF"P4{3VC^J{0ž|2˄jZuRɶ>yu//OCI*CC 9=GPƣ1!0:%-i%Û maݜAF0\})3ݢaf1LJTW?eHj;Nv`DgRIkN<q:-jgg_Qb<>ץ[0qDžҶ簭=_e,+I6Cj]3=Aq;#B@a 4%/[zr.xfnqEAz?ZeC|ߺٴhXܖzl'|Mn<[1VV)Drc)kHFtHQQ ]`=1Gj#P_O@6 -.c 'V\N|--^NT|/qL{tF R2Ѡ҆LމFnyUVIc?? endstream endobj 856 0 obj << /Length1 1626 /Length2 14669 /Length3 0 /Length 15501 /Filter /FlateDecode >> stream xڭctfm.bm۶k8E7qʀ<oa T(;ޤd-|kX/8 4;*O~gPi9s $QO`{Wq~Joʎc4].NPSͽXyVECDŽs  4lV j^Anٝ]ʜf6arl:x~r5UYutD3kMOc& ͨXI'fN}NKyԅ&Z>H1Ԑ64қqROzy Ye*vMu9i7G+)ߞHIyKaƉFix4uΏ+dBETW]E Y@Ta`As*tYu_aw`n%Nk3[L;W@/^yBvG,+7zJNZXbZ6%BB.\wXML?Pl\dUP>9HTiW!Q~ ׁ>ïeƝOTO݄8euunr@qbGa!que6uQfA)D󓌭f mJDba4__}4xsr4i؛yde#*tler q,݄{ޱvJސ k*>ģϷᜠ UJɬk}וգjHp=hNI?S<(|Y< ߁NJ ٽN !A1w;}Z'/+8U&hsN)!!OO]ݗgzy١p$#g~F ^M6զSr Uv2W1o"gⱠjQT˃1F:f6[~DZt%l/Ig@A1E&sLr@S+('WgR,&ǣ"oT akvlZيGu{I[k]嚉?[6m;J(]EIMd׳(q{Ic5ꯥk@`5'6]1C :Y"$'h\8'Ad ^Y4+=4a:FtQL+簂Ԭ}&Ohɫ|tƄrru..+4q3@304bRh O-4@M2,f ? C +&&g9z["M<!bfwO)]ςaz] \La T1G͓Ɓ(#t6˘s,ELɠPj $pcBfc#Ѝ͢\ǿP(em">˹oFU ~3IbnzoP}&-`C!Ewwkr*~뎑IݟtAc ktB/V"^qUjk**§xش=OH,k78A@a mׁoykѠA)K窌,yI=ӥ7jӽDvV:ϳ# ıԎ^JC],Yl csJd+UDK:P' })4=z&MٟyDגWxlѮl(b0^9改kx| &E[E )}\#(_4fQ柧.rX,ln[ڿ8[13yf֧W`@wd0NxjۨQpj{e+!{d_fڠW}o2+6F:TckdtL y`ĵV@#h Cwf4Ah~ cWv@(W .  hXN>M'cfw 7"YL{7[2"v7x3n~/ 7>Zp<& 8\P>RCݼI-얁9Q8Q؊ (oA1p.觑0O$ EOf\8 jzW &,; P*"9f3 e^*DXSODR͆GgYE!rmO܏]qӗdeƜts06G TTm ށo;{ď485{j?a#h4Fmv;\FÔ&$'oRi[GqVwJ Z-xY[^4ϓ jS iTIDhu3ۀkSن:1˴Pñ%RWÂ{)Oۛk"_zI11'<$$>vqʱ_5|CЈI4zGjLX`[ Z@M]1OMd}Q6cۉN[g% *UB f$Y wAJc%Ɩ:-kYA%y0|2 {Yq@!dS 눛@dVI*aFg%>"ېNC}‡RڣXs-lƫ_򬲑@V-PظCTBx?XI(*K'?~\D͏@ ]iId==zIL:|Ȓ/ /a=V傼`.ϬA7AW9^ߣ`y͑':5@pҰ?mn琡r1 9gʛ_`l i!U\Zz)i}US]"AlfYo g㕘0\kˁoe5-.EwďP1#Mxr4[JB6|yn+ߤu8M.Ns!#<|v&ʵR8m~ ӏi%~+7Y}|nQ;Iv^N;yxl׽,e8hK} x۵|01PŇ)t* 63ΨyaCˑLETQf<6/l.y?2 NVHV!+Ϙ; E xh;rsi )?]97(MɈRvе;Z ~`:Sޭ@?tɜjSr_F0Ggj;)GR1JUh܄UCDtoq@RE/zjX,MwV+\TSПyߦP1LV:k5g.B80eFsgP3Ss00?B zBߠZ(h0e%_Y).uVӍX$dp{U76W6ZP (ayȂiy?[fJ 9* 7l5w,ҪDsvKQBGHQb35֌GlU1j|0NtoyK=N;b+(ۨˮ` |(L~E5x-n hA\ڝ1&y%o3^0?ל9~E WC(JgIf4sqpRHmb :`6o}gWϔ[R:l2Qa!Jb ?q0L\E[xcE-5dIZ׊4^o\+P&tnL(߃{ ryėKp?>)K: m oNzw۪`( ?_\kd(p,WL_!j$kށBm,7Caװj׭1n+NΌ7[UA~h-6A6|-e*hKjo@WLI1`Y[t, [6;VCX[r[D.m 5y n6:̓mA瓅ʵZrS{lum >ġ loay.F[zs$ E!MG#:hA0U)B]%ΩSTƝ:=7-g:Wwk8lzUBb5.[Pbg*2biMPFY9|Maw0n% }Յl6z;O]&,A鰯'U'Gy4 SXҕ8@Q?F<7J}NlP[*ade'OvbT7.N@=cF콃؊}42sOs ɇS]1b(3TƤKGD:ݎ-C厴V6:AK6Ş83TUfn663뮜-ԧQ 2M~ª\Lt2Km13:0%/A3Zq[-l!(U~%z ALzd[B ٷ7u۞+舃Ô(MKa3x7&ve+o3-,0Y/c#Y̹A&VϦ7͠SFr '`6M1,8ԓ|b7e3q^n^*jBf~[Jw7 YƦuK6Y,6eg4Tq%p?_[qH1ЫBRT@m N(Ꮴe1X.-=4@$7HH'[RvM~Ʉn,EɞpoA-VT¡z-IzSVSq^^%i ?k'sIJ)RWDѬ6"|T*llPy%< s|yHqn WYfOHlO䛣bK`^dC ." rLW+&, 8*&0v-)` PE5.?(pf~[m.6M4wGX0G |`fCx0&ӞqXqĻw%oaIœ_rz[J!Edpa&#6\r!m[]BG\:{I 瀥v euBYrv8Ju\B!;1l2mS=FzCڐNCP-W$no4Nqqf vP&2*Z>UEh>d\y]Ƒ6 Pt`$yGެop+-hP ?poj'yw{ 6m ƀ~N ֘ϬkQy`Rox}Oa.(&a`PKdry\*;wZ r48Gs-b$i_U&.tfdh2.0僜 Ay@ |^"kaAlS}j^ҞؽCUDi $N0 z#l\h R@<Ya'}i, o'OytՏԉ^ܥ0uAG..o8A܃1*ߤȰ^l>Ci@ v8ͪjnC/7m1A+KlP$PRoT ON6N63ryLH {S[j)ЊK *O09"02=7щbcotQ;. HvtsfM%1F6H>4#5cuKJ>9wlB.OPCU2#MU*>o310 94czלKDY}XXwmj\v|+?7ڻ&Ռ.zL>j[j-xF_"CJ*WLe`6rP4~0Hu+QMtgRDžޒ \_b5rHE]1LS[ޫ:=ZD9 jM󡆚R/u1T& \AfˎvTvOB.B=Xx_~WY?sR9ڴl|{rOA޲)jhcxtt} SCc9{!&i{iQ #ꆁilŷ6u|_&(YI`vC>Ab"oۮڒ˹K>M-|!>{SVE^v\,I\ww>iBGw0.Zn "ȫs=ROqPoxr>p2ZeoZaIߖga4 ܺ>xKFw A?OAk TyYV=NXI7lF/5Hn6KF9O[t"-KurSA&ns$ &o941FI(sוoFNONx#_w:=&8͵H/+Dji-f褟zULađq9o~/ N^f_Bt!J-I6:l9x9ײ XʞLzx¡:h1]2,]6t|StXz fyܼ}̓~ SsHkl0{`#T9]e :mAmPJN uT=BLa:Wub,P q$"tU| y[( FȐ5};&سS W} ﾴwmexG$s."ھ&6gE)- ZƸpkǜ" ыu\,l9 Ju+I>ɮj:[q́ =_D&z7;?ڏ‚/֭]S>OGww%iĎKoa6>7(/$oE|oҗ|\Dxg4'T8>v7V -_ &oi O< `CċƋX9W!)0ʈ{W$c]~@ow䲪fRGKF..lYш>*jg\h+FeÝ:(zJ"gkf$|8 ABN@ %hFϛ×,n(~d=ɓ9? ea'5xѷb@}8׊M)=',t ƴU/&ѹsAlE4jc2ҁ|k=C'fO[Q6Z)X&}o6yohc^*0&' q\V9Oj$(ʦT{t?d aL7hq +}OJWGex,=+iG -!R۸o1vU4zv-[wLsDoaUM6ARJEU+$N~4{ DأY*OEUpiC9<Ƽ !b"/FTƤdvnx5VAW߅kd po&'ҟ \U >fOm(X R30J0-Ȏ&łx0&ؑ'܅JˍvGm~Ϛ󦠡rHST"ٙ ͘0+y.Eqp٩X3/ `\a+Mx֭B/q5 a-Aֱzڈٗ/ @9+$'+{RZQ~諝M%j,&`E|im0s i3%u"᜶㗠$X$j F)<|Vx{RGؠ)Ae6^aUϨ\ӇZ[k4 ս"IXCf4XAg QQ#_ƱȐvհ'mEk@>r_6S.u5m2y ׌"D\[::fG@T'=-ݻ%@?LsT˷]z '=5ZBh4^%fOgcS7^bvbj =x?hPiqjBJ6[VVeюBw܎&QPVM_ВAP g8"v yOߋ㠸+F\~4cw|m$DZ`?R4Ip<$fx4_eR@L8AoFxY+Κ> 'Cm~HP"LKUDgt !IZJ KnSSPFTO( <D`x _GpՂ %YΆp\W4 V~iwMdw.,MD7}40.rycTҊ >"mȭP󆢝uXH?~+kvn)S9 ` X+Ž&0 tm_Pݐ'Yd;0 'hIS=ziBX6AIS̢_k0nsvv U<=Ng endstream endobj 858 0 obj << /Length1 1642 /Length2 5195 /Length3 0 /Length 6023 /Filter /FlateDecode >> stream xڭTgXS PEWE:4Х RI#w)"]~ϳ=9?z7;3;kx )Bv054 /$&,z Gڹ H] ă@& Ux8nMaP xh e!D( ‡+ a(<4xG5uՁ|&@u %4bCp X FAZ q@0A0; 10,p F wG( M@0>Ap HȪGxG0WnO(p岃p &ae(*ba`,4_W <~G{8C  9!xBn8 k^4Qhv O}A|fPF!'T%g*5GUլz!ₙ ù3mCA?('eܺ]:ˌYMJ~,i%*û2j|{rb+N"sG+tZwUS>b.~_[Rt zF5/eVɪ\#gdDz\)2y BZp5d.JU *yCjdu|[/^RN5urV%u+Kz#@;$ '$,K m5ur]w`V]GέH/yGl~끹^ eom=OQ$覹 s~' +lXt)Dtsc%[uÒnȸ=fՊ*"n> tC$raSl3k--mN-鼵BA+*]ⲵƛ%ݗʌ7-'-fun5φ_S.~Y ͨ,jM.%mpsf1oQܒ̢М a؝Vg/ò~@aˎWu ȩ\:zdXS+W}Aw |<,~- eT\+h .`C|hXp RnR ;f\wGc%!OSiUw2lu7?r-YqS"Nךf ah#Q/S<K#ڷToE(!0rJEg Fvٝ30]Ѵ~_ل|jj/UDQ s*bt~EJ%(4>`b3-)Ql-,h&tv(2gv ɑ"JM^LúhIbڥ6%֙P2pk$ReDya-Yiem 3Hcu~ގ76p!8>ul*[1Ǐ8178{%#?{K=V ?]",56H +ٕ5D-XPQ ~\+Vy2tZWS7/hR\B΅~_uE՞kL_blEBr7ހ6Elj܃֥K6DGgog|udܽW"8eDۏ򀙻+^ 19g?-] |ON aS;ԻT`n{7,nL[1 VfGy{lN3|iCQ-(|)T$qi|R $E>ҀlΈP#"aw6K~u`l鑶1$D2r`H=S,.HQ٦A5$GMHwB ˢ<~+zt{JUS=+\tpQpiqh, .ңeǾ|鱃݀~ܗIgu˻{K"$}WtrWϗ22bYf,I+JwW8?YNz4j=5V9 ipDV.>Rlű@FV7h!DgV)n|U{ÞgəwVڂ˶uc3{!﶑T8I|gahͶ=kl}ͪU9 YG2L/`fjd7X@U!W>M{4!Ĵ> Qp_/Փ3 (@RW^y8a" U͏]Nsbё5$@R(]0uv7+d$鎮mnK`;Wo qKW cZQ7NrPelYsvq!\Տ2:qx5}ۗdVXOQ5*9 *=N-)Тw$q ~Bk[~%#o\ fT6@VI ۦb5I Z =,k ^ED~v#;[BL=e^5X gjMU %YX$gjeR ;ASRoe֔-K ͶtNs|^.UAYt#ZIZ}c: M}ۡSMPRkg'MXĽTQs)ݥRijzYU-=]pV 1#:9;xY c96uy!Eȵu: }M=Lq{w"uvB Ǫj0&yrft> #˟h6qiqJ彳p6S{C(oT]o;b<ǙY#{,f5w:{P^l!F'զVzi:U?g4b/S?f1S_ 4KI\*/5Z*odmͱ"oP(@SۈhbAM=--"'{J!$g^kqg<(G[ @|}hQʨ|z|"˞,+ۅ/B'ff^!ՓcڠnpSl1-RPT [n{؝R!=v9p@ M(KMbļt܋\ѵg!d'V9;ne{=)Y}~Ky)?5$FƐ_r.[~ե+=گhR+1-AYEo2=J2 ~I cͲJ3gCbY=ne7~$3 _ϲaM`tC="yFjyo~S[1sׁL$Rurj&g6;ƣYV|!#M{{6J&~2 ǪX^zVjB&Rx+,? J* endstream endobj 860 0 obj << /Length1 1630 /Length2 18833 /Length3 0 /Length 19673 /Filter /FlateDecode >> stream xڬctem&vvTlUlƎUm۶Tl۪~o>=c{⚸cS( x.Nܲ@s_9;#ND&3777@@ACKKLdin w9vT@  %%/WH퀎F6EcK H0w034'XBN#ttr t;9큳=_ ۿ`NN&΀QE?,f-MM\)_0FvNg?SK'#98Z+ 'K;̀47r4:9OwNRǿe?stvژ11i7?"egf`f?t@5h(o7$e>(o!7r+GK>Whqy#ۿd @Ϣ1rZxE/5L LZ:[M-M,fF6{/)@_t&voV('-")DY2T;Ϊsٛ?0/zf.= oB,l>bϳ;@oL_`LMg#;ӿ?M\8k@w oUzVs=vȔ@3HCYjq}_z.w{]C gǡ>,TUM!e''Q ~bƹF6ޔ~;L'#3?k?IZcfJ3Z}9e'ё[C|8X ^#lߔ3dgCLJ&OWWNIjno+.䏱D_BL+q2nWa,ʼnt" ]+RkD0|= 5 9#|1n?3 jY~;~~U`Ռ%\9mU0 -ۍZ&su@*eL-Gq}W']=qQpdYtƣiDK\?V>ߗ-EiɸnN'n~vpjVo$~2/a kU@ u1=i1vMzрќTV۩cR)f g'> -\嶙EIpꚵWIvM5_Д9 +5ޢz̤P#]u[E=]zI6[i(K+M[#aJV9'X"#ZnbZnऎX*h~DE,x!Ed5U1W3͗h|JTϯ#zxfd`nŶ-q˜ߊBko@̎t\^/T6DH8n"o-T{IFi1/]_ZnԔ|Sovqz[j hK^l2d/G]=6'GQ# lH7֛Ԩ鑋A DdL6~Q> MNq=tUR 3'ofLJkܫyV 4( ~+&3FLp+9\(ֹzvZvtu#N,AHqA 9 I~l쟾KKoEj(xwljN\v)%*ƪ'aY[X#~} =YRKH~}#Y(l'%1hlV\|@*tM&1ҭ; e_Ϋ#gj'?S;qDq_sVnt'&[ces|Aq Kk*=ao^Mޚ7}|0N|(mlϳ1@K 3\,+lBdN-Tȫƞ38+5J&PCxij`Pz?+//N'#/p;+AWLP]w4kQbeC-ko hhvf9!T\tј0mI{e3N~^#ި+mEnMF$oXޙۭPg ;@PJfղ :?4gοKYۄ,:윌 #쯪4`JV&'ȻuyIn?呋 knΪK2[p)qUzQK$]\.I8C-VAJza3~I$?0KCw%v ֿ[1}WicO}Y9^S}Po Є ,!{ԅKBFQzr(^->"Gp+Ւof{sjvkBRwR"E>N Rq7vp3=~hk vB4&)!p{`;%XJiќ! 5jhwg#-BԨO# < uu6ԤreHT*L Uy0y,)` KrKLe `L=nDcC~݈c٣6?߁ϰi^0,3LK:.@qK[Qje$%[ZѰ:1@> Lkkz<8c\VD Wą؋5\A hS(e5{ܠ 2OZ}*,7Ϡ :~5/L?=އ 0Q/k.d)5Ar"86C%^Vk-Ӗ8qKaww M4-YlyɈn0љ?nA-7YvT^s_#^D78Q 48t7='qRs\~J!hiH4>fل$:p]ݜXSV4-NTE˖Vۇ 1w>9`>:񰟧fm/2!=w;gY3(<3Y(K"x׻|Ry`[^%qQܣɧwOt[>9Q.}_I1[!-~/$ijآ/*E $̵ +4 SvN좡DA4Zkt'8fxW;n#IɋI\u\Vkʘȧrפ4bg>aVf2!(3G/ZAeq ,{c}sV<{ƵV/iߖOC5y?p\Zf,!̧.ijxT b;Ho( XxMa] R&q+D x' s2ЊZʬxT vPB[/K$F<@(1 q)l0qRg^,MxY{gxOqf3ѐd_k<ذD@H ~!h[r>9Z #΋!ij [{VcxtADL=ʝ  KvaBz,"*1Ni dKTsN5GȼCӴ]`ǿUyCҏ]{fpTc>zH4ح:m*Mt!=bn?z4\Pᡖ..2R T!UyNÎI2xwޢ&LaHYZBFge&tګRg>/6t6E,jd kOQe+#&&B$@d@Q$Xb'Ir#pnΥZ7|MW**Ue-ε= bר< 7]ןW WZb]1o<Wn3s`Y7n:[ݞ⿬/d!0Z8Po*u`(l5HHT} $ $&~\/ $jUn*?`Qކ͐BBNOzToz{ :dXh>OVY!( 8r(!*@J(e@2qN?q&aN2xlU'lewZ nr8Q@N Vwq 6rJ0i`a+Ʈ}qK*? 1N6̡~{AձMO Z%8WnJVs@G:bzgAG+bO5k0 lq]Tmq_m }eT ڲĠ2/}TSXwDXPPܻy:"Mp¥R&|^rNbIgĄ42L|H=@&X감z&kGB{O2N= p#AJ"̷P}Y kfmSz8[&@-Im>Ʋ O/锕b~yF3REϫ+U2'T}gգ 3bTQT?p3ϖx̍ "$_}dΧE323A:([(W]t0& ( *AzқϞuʲ™6o3GRb)j-D4,XC[s0xH` >2n /w+8 ikPȦ}G¼bex #TސܒR_T1]7H'`MbƐKel*S}FX˵Uceu|]'.LCX?c@iyBLy#4WLFHa[g( ʳ?eJ9 zn6Pݶ 4#;o )rֶOsCJ l˒4`L*RS^ \R'N}okxR3 :E.Of kc hE(AxP-R +j \rV.u5OЪi-#O9+Hg:8Nqak9Ck"M9VzLYqV%0TN~_if= zZF;[+Q%kYȽ ΂~X&IuGfaV1vNh3]Y'IcR'H)Sb%??.c[| 2e\h@h2SepW i}<5Er%G!|6B'q9"+Q\x};`2[bejPU sZT8Y@fdeG+$7!g4lZ[G.]hƗ) Qs\7kz'Zb@2,ggMyUZ=!~J,^ךJ|Ee*ڏ`gY(טRBBrG P'`KCrޗK9O8-$9^Ȥϼ@pIdn璴-L|c&~one\t{NGP3#{?*UR8G%K;v/Oead`nXO' 5Z֊Ԝvq@)cd$Y8Ki}rq <%-݁UY&M)jOcX 1 P#+"e|PN_]=\E~E~WbҺֲؗN@}.u y֢Q.]}%g˰[`y?cRL![(.y,]Ҏg"6Ta)4 s6?"TW52kǸ F1AgW.# l[f?VV1'xHW9¿oA.t≎>Of=k.;K˼9E+UlAilPec'2J43!sPLa ah8k6Sa8Kd95d7Ĥ _v\@س:}uDwvOL›a5tNL-y! _\iۨho,,`f{]8)3Cv4G҈V=mèǸd%:>|AĦ"֠o/^;F!5#Dk^gKgcDže~>X$RRw\ $!1Y˓`x[Kg iS=@fT`FJh'tBS`?PVR]7lf t Ĭe,P ^reɡ˚E}`\z{R{3bؾyxYJ~4+]r0>LFFG˅ޒx$IL `q/s|ȶw* ȿ_smDVþ1cP?ڐ8ՖޕH"a`C}ԇX.5|(/ n qV倽Y1fP1%y'}?R0SAq3{Y%{F쳄U\n.:tI1F=#HSÅ^׭aXAMbM$&V?q;B[W jK[Fc}zJ^6JLmj?$=\kDl)~PY7HO[$f8һKDv))ե.\WR:>:Xɝk( 67\q;KnW1~Eecgi [6qs֢oQmq0&4zM;m|D u"e𶕊~I#[Pk ZO#b6/=VT(JJdr0<);O\QWkDAgᠶ9e==s,wi5D){#wO5: _⠾":ABDl6`:pfԺ'ݿ$8X)(z`8TTzY`3jKSiT!Aϛkc>da@g vN5 X _sƅ](8IȦdktt^:;19 wζ⊑U ;q „sf(yH^z^/LO>b~xa *V -`K161" BBQ\o*M7/>#[˗J}SmVq*T:Z(Hʊ,w15?T>Λn^Af)D'h$`ʹL;YJYD pa>sg]Q JlFST!yNT&}DgCuTjRvvYf|-K(lm[طx$=׎ˣW=4<ߞ &RCW,][5[0=ظS m$"/{:q֣e,"E.HߟDGOul> :v@R27$ l},ן=O9Ij) c)8pO5~#9CDI&0^dL(3Z(Koy3o`MPHjJoGwCҘbC|K3CAً㚾j4t2f NC!j-@'|R2: 6SX``ъ޲[bi-^H^&.Oh@D$QfX&VH6U$>tڝls]qAN˜#^Ǝ ^8콈{޼DAߒMBbK nH w{ٖJg]O+U@,?K6]{ŏ %֩$b _ g׏Y| iQ#1GSsҌ9sܧQb+(Sj-yZ2*nFё3f9J-Yv,UC0.r 硆9)$1f`BoM5'Z&?eqhTU挖+kѵ8)1q|FD&r gX:h|zi27<$_)zEqJfOѭ¿_8cFV˰7`];>9rhnmZ]~&NyYqWaAX#̡FAd/iEO!N+|sSiwr@3e,{UnBL 1zG(E핒a48CWBƃs %Djrb &%? MΗVm@?z4 o(*I%D0ZщQb'|Icjm]KOzOD8ԔLf3LAwj }å I)ڣ6e8Jxk+TVƖoȡ UddpƸͷ ]N,NRdeNKW$®2?FyTo4sq#uum~ i, &NSoЌU$@|p]5\\폻CȸSH<>,KMy$M(W(T|?RcYنpł]fM: {nDg<[z1B3Μ2RB!,= ˵f? LΛZWKDr 9u;G`Ik}6 * Sӟ"!TqP ?Ϩ\T%RLX0*_ s 0 1 LR|\ ˛FU}#'3c]KPn:mC3Qm2ezq-7řng/Һ?0O>JEQ "$ >t1y"Z"EoGRW^ BI5idwԅ Hf4[> ;):,vBYf;n ͊NȝSCgǭ|pncfFBR? CnnA.O\-ey:&Nk񒝶(LF?JZOs7t١ z'EO'yo*1zWzuVgs6y7RvgUlU& \޵r Ac6@W3-NFAP-XW;/2N 2 9B c! I, q6i%V%E b/ץY1 I8E$۰֕Y[Ny IׂGնcifԌV50{^tӜhePѠJ7}!?3刭Ȥox2a`饽%~w!)ħ>s=kt-w*5\_jѫSx@Ȁ^ыhU`fⰐMt y\-ۆrł[lQ(륽H"%t K\,bhfCu*ѨfO+*e2'T@*U7 * ^kKE6c5^5Ozд ׿q!"7y{36{ XT-b9ՕKO&,!bjD/Aϖ"ZW/FH%lKHn6ː6p-ocѹؾΕr)GcV5SŸ_N$xĒ ^G] f‡yz=a ,Q@PA6zێkcS-rC ȒH41,D{G";"q*;v-3Kָ`r6Lsذ: &6ƘmLCKu 41 "Ӿ!8O#h%S_C]Ӎhx~Vh ʝq!{'9X,b! {4z[2V`bp5,ˏ3 0 띚Vc%^TT-"?VdȈy_FX{M3ܵ:ѿ i'<Ǽ &5gr5L1qفfuO=)O_1A>JSC@k,w 5Y}O7ӡ+Mh竩BM3CP\(2b?iت* F@@c01APs] *Nr}YsvKF nO\ҦPZAJã]K4"_D"9GN6(Y|S?CꅬR;i%= *oU)c,D|Ds>q՗fvETx]%%K(#qxLRDJ5;.zyBc+zCp_mZteC|ٌFہ, nkgopF8`C21kv#q7 "IYEf! bZ}u=dz5Vt`QSbb]ePwW_u`sh `)')}BMHw&W$@h~%ڑDy|e+,(l"njq~&dTk~RGRbctZJ%Tτ~HOE{cv>~3;T!uunCJN8^NVw(lO\=R)v]~ "&|)MaJsrJi-nq: SXMٗݪ'mъb52KDX wcbec]wOE4uw:_\%%ɠ-&Kj \tT$CP>c&Kl*ʲ7 r C .82L'r,ɋ~:.^ ϕQq;ytBNz7]w/"Bd Pա}'QdT1ejGh۫*L8ZUg鑗ǂ]E""=B#}\.ۯxw\9k ;ܒq+ !UtF3K19ƖysOH48L؍X@,psx|߼-Ӳ?vש,VLŖnm hg T7STŹ`3n3}~{І~1AWĆp8SBr>eN<*9Fcs5o iuIN#T x+%!}"$ɤ8pi VQWdi8Ѥ4B8INV4&[bijm=APw-22oQMȎFPYý%RL)?ixp|A+I AO_i${ԀrX$N&YcPS5F{e2U< sέHzMf *&YTƐ>J7c|PT20\cgP^}:I+6SpCP5V# {>0 E:6,wkrc>Ft V *S:&Tv1d$ޠ}yNW'=GM.>wFpb1^iJ}p36ҵ/H\pSG|FMg 2 -9 _ E2\:q9#Q>t+3[h )yòP )R{DG o"ChE0usE ͔te>>P^Y~5i&dM_Z$Vsɫ:bDJ. N,+ÉKR7ljS.|!I!!Icݖ6;^[wRK42Y}V6sڦFϟʲ= Q paV![Cm hx!FEF~pW k3^(E=Lǂpg'!:gOg$o7Cʈ~TRJ7/|ץ9N%׬F^{)2(DYEѾWZFһU2[2W}\qFq\xDJO}jgdzIwy9ЍlbH*nsm҄E{&2VGn^_ \WdGJN5؃1@8K.Mч |/z5J ^0N%\N)a^$:+30;љ}9 26W*l$׻PaO J>[)Jw/mt?*E4\%D='GZ~ι<@m5 ?{"ɧ˦nH¯ujgF>CӐ y*^]/={ig~i({qRSeL]B8;֑!\L^eZ[Hܗ6lN HWѭTYT5mдh4!rh],՟@GnVU+=ާ/j~ =ӚRuZĶ'ccN좣r=G((; cB:4@.*fԭI#nƘ<]Gs!r&9E/ݩ<F ~6t"H5YΓ+Y Ȋk]P96d7ޥ/~5v3yu5tcZp3Q}W۫ܽZŮ.3#eU k6!i ѿպ|© h.*sPVyrq 5V7RR}Z,5WpXppxL5,Ơflx|Ym6e)qwb4` ×K9.bn'Ξw)%y#/תTawz S1P&Hoܷ~xJAag@Nf5g7\<#i|zyGkӐض(a$&W.wSS^1uIu8-jTM)8PDѴTD3`c:Ә gȼ\wHaGX-=Zo{++S|nhlצ-(BVCg=E$J)& c̄#lo 02 0(ZRHէop  ^T{{m,K--/c=Oie_IFWvi&CedK쇔+D bzSk)N'V-c 5odxa];dly䕘5 5 z@A KF{kZ߱XF`*"D׸γ-r"o&wa;nq!GUl- %wӿ"3}z&f{U8f;ЩKbBq5p{dx;ڸ>,Ɣ dvSg~Am:%x^ :R ԪY ZF7Nu)ڍ G5D4BtcnYV\֝qT+膭 emW O=?moyn+zpV{4g*cSΧ>dF۠M|Zbt}ͬD|A( cNRc7)ӳp\ m'_i^-,eI_lRG Ps Q{M8&7Y 6 ˵5?Q t$Bi8& zp)p@v$O9nS(DE=- B$* ^wf/.n\Bx|Kl죈Ƅ̬t3Q ZltF^Y^J2Nbg^0-# ~Δ!U$G)G=Ľc)Ns=Sđ n˷Qjz|oӸF[ endstream endobj 862 0 obj << /Length1 1647 /Length2 14742 /Length3 0 /Length 15595 /Filter /FlateDecode >> stream xڭce]%vemW6OڶUJ۶Jάmy߾}{?9c+fD+dD tB&vFvtL9 #'%;9;.:%5/GF&4t5trԁ&Q1Gp03wP*S-#@z:Y>m)@9`ja +hJʉ(T@["\-2@[' `Ҝr 9 N@cn@wc?-hc`0s4u{v [ckk7WBvw)99;;Z;FU< dؙibgOIE -l@wb&Nֆc%wW.Nf-hfhb trK:[׮ڔoLc翱,lI[S;&.u@ $ Ml=&@S89;!w* -_5.}?\ m6 15?0XX{nu࿳w![ 1ѳlh`ll05{xښ-lEubd/?jښ 4eԤi_v=?#ڙ?Tv/:&v.3:r1e -ڌLϕ53 mM28:U_o%݁pKv<iε9C}=LC!% *v~\5!SܟmR#=<<| @oigQ^W 2[Zj;JzPS,0WOT$h)1H (g OC741d\HlSD<^);JtSV=EHax!?jI~^#<|gKڤRMrhXI%\0WPռJ5 xGac?e牡hšzކ"[1x- cboaId`2ϸsGajeSӺ| ը[zs )%ߨys>z7 O-LFwG"]XegB.yߒN E_W"-tjge1OEZ*01TBadLeSc*~5ih[#)A,nBg݂Yǭ65B; U^w5B]]N|ŠDw'ILˮ!~=rHt뾗4B$rfXt~q7.r)i&wMx2`E~G}Tgdo5b.Ei!́MUcH;a:,i\w }SNg0w>l ōU0ܡJjJͣ @FOuc{I_ `,Iyܐ2Q; mhrgS#F+.@0Sʼn@xrfo8dQMОT4NEOBTSi‹{i ;`yHKgS(~h$\;t*'ġPMBr*+~GYI| tD2bJ%sߜBN#R˚6KrhN FHBPn*`á "~i&aL:Lw)Uϗ1SeY޼PE1"Ient_,P8.t@mw?d]ν;yζ'N?SjLܕZGsy hԀئGhX_l(lz~!V3쳜E hSU}O!+4M7liǡ\0*7^zBKtfx`^o\z FfS?J7C8 Ka$€HkF" ę"hV^v4UD 3E7yX' f{}Uw+ 4y81țl綣|, uCTT q!ҝ*#j>Uދ4FVUݿQ|-SOj RyV0Eo 6Aud4< ew<(:Z$naȠ!Utt(ʩܦ@V<9ƀK2xFa~ʈS о OPAj 1Z @{ {\T@b7ϫ}eF( K7EerT <#oPжh1S(GM=m㷐5QU<JDrH+mFU  J8TCrϔ[14))|O}>4R1?tյ!(z3ՙ +L=5L-ڴPqlꙖ*zVeߩCAgb [ Oպ/ZSl}h,!+3`+6EDp`S,eb!MzЗeCIޓ"J(RZ9a] ԉy!0$ZZد0jQJ`ا%"uK"mO)tM[8z)֗\sumz{3_ rPzOB'TLM0G ڟj%_#c~4_M_[N٬h! ON]LӘDj 챽)gG)$mJ 2dᰏ՟lӃDL_\XUhBLPj9ٕ)B,[o s4V=I+:=!iHW^ęb~.+ҷLE$Ka[|c5Txˏ&VڹZj{fV=Cr}H' XٖtoǞ5l"8?#D-X]Cђ{fy 0grݕ)1;'kh`!X|=1a#pƼ؝&66&aU)J1)uPϵa8h:"JOtSa)UA5>1Vu ۧ[Bc@:Ldj&)7x$ĄӒ:No .Q|a+fA%-X[%niFl,O՘!-%bkVm%q&Q5C|]@_ qG ԋp_J7cȄ\Ny}TmqGѯkbI~ܙ[ՠU}Si0G8bz#- f,ّ&g AdFtpG\0]7_t N^l<1)g\gTt[Utِ>0gڄ׬$,F:gL].UAŮ.o,K}{㤰S,K*F$KBlsfDݭQ^JO]jQXID@•HkSO2{uXs TaܾcQM0G'XeQ.a)}R9ۤ-V'9ABP,-j^{D_ fm"v V+q#$38}hpViTN@^robOl cOϩ?!"1ȁ"pJ;W 5JCm]D[JAi=U4QF=Y%/×{ZOJZ6Xԃwc3(u{̍: <#ݬB;B+q5tӣa.A̧HnϷB_ů.\b_flaaO`֤"rlDI+W1]`C蔮O#I3ZVa7` :܌ "z)t5$Sa"}rxN 8Ow@H\E8gj(DC}>V #Ne s[=W.#{z`ȁ޺jI$+F&H\uί1֒d^3]O8݉Ibsy|rdPafX7DgAEU߿ζYWّM+K{te7鎞XΫP#+~ǞKF"dm ֵPb٢8(t/( !Lqԙb`k7@Q,+h'Lu4`t!y8#>T3 ~ξ"Cx32&K\WCbQ\dؤpN۶EFp>xF68"i`ĘgFK *bBffu qAt]aN[X8ftSۑ1,]l(Lth!g xيX-QDNMƭ(ʫ%,:UY%4>o)iŒ0#{R1Dgm0G^-?2:@&6q l|7 #Rkl[ IZjj{kMfc]󓧊&GMޢdmZOOQ } +y!v5^\s |CW\ >| RnynYͬ麯8]-4 ୱHdڙ'ꆻ% uo-]<2׼7p3_|!VRݜ,#B ?ƭHcLCa7hbH}+2#>?s`3 5ܳ΄cNuT#!ܙs.ޅxǻIhXxW0%V{P(ùLhbduqSF Cei.iY$9՞|bbRAʃx[ +p[t fw: 1KBM;p>ޮFCX5Hbz"AI9 2<}\^W/m&*ƊRB~ *"i`GY)4AIO @]8!e2 O'qb*@Vq`hU=2^V;k's[*C Ktߑ ђP&]~?{@( -sؠs CkT$א)FVz:Y'!˹{*l{fE3d(12K[ sMRZk:%D 6>'[h BplE撁*S:vUkAbTXtOctșL^f?ȆuڙqrKK5cxiCȕJyNun#H&;Gp: |n^siٲ<9L2HI;<0rŸф(K~mYވdV;L}st`BƤþIpGq~Ew4F~yU1Us+*vm5: rאT$; v:Q دd昊sަ`rru.yO!3KtS$9u|Fo 8>hOUUw@sX13} GBhԕ =+SNYgѪY[ p詑ҧnW{7n535&xT5^9+6  *TP܌_cK?G\ͥU9АPMP 1I~v (ߩ:uXmYH-Q%{Jyl|N{AäwvGg=Wܤ jwQc 5uf M[kť[?ttÝ{ ʼn}-o e-,(RvM`i]}KT% ]o"F/b=PjgBeO!_%y9SȢڹo<օ3z9T?<<"('Ln >vn[RN/*.Z<.u:_qr} SVJn\ Pݜ_-՜3P"S~_PNmCf=Y:j4zմCz#(dSj\Q Q; ܂o)Uu3o?>JG7o.5k;:I͑{ eY])ηK${ZQvzcaXZx(A/!G yZLā4"ԟ\rH{FMc?% HQï8')jrR.=WbnzDNmI[ F!$M@wZ_fbݨYJA9݇A%R@Ԛ0EڮRak(W5T&5`F 1#K*I_x˫!.Ӯ2"9w WίNs򪖳x[g@{޵wȨ}"DVŇ#6D>Rd@WPXt&_q4H;-ɓ'&+vm>#'RbƏ^c7R5n {=gԞDoZGY&f8ZZ'^eA9= })GfH:ъ^!De}SSI:@YTCSu~7ֵ_ɐ\s+W3C˯G!5Qyj4g+X*@ct 2AN4co^w@P H6K[j| l(6_g΅]Dv3֠Ӕ Z$l~>ƴA흋;27U>qSLצ NUÐ.?J1U锡QGp\њ #|q x?W 6v :m;- iPc]v-#_RٯetvqSTaXKul᫇vQ }MaNFqF^r1px26o*ǃH8F&P278>j>WJ:=M~6O#@,=t|8J:M$/ 7[-w=N$\Kq7w|_nɅ>[vBWgᑉ(hJ9 ^!SIFV̞;Crzdqg+ghs5VEHdĝa[i74^&StM3.ؤ4 7g]@2?,9PT3N}73CST:^ o\q*|:ҡҰ ˽эׯa$!K(H]*1^;0#$sk/ @~I] ggF(Q  [M|x $W|X'{ytcQG6)3!]sC뮡B84mqـZ}[Q(?\ol:P;ެ5P45UyezS ֥^0dTNa۴rf)+ƒG }Ss$t4E}̔mp,.KsG"i#w?ICG9f80r`d&)JSQۅ1|]d^^mKc_C*dEXQ|rcC^0$1$|-#h>cRHήݘLbY XO WqUt QG:N(p|iPYءHʶ:ZZ8Kv5.T.hGFW;YiJq!C|8Lx<,Ɯ.ܼj=Oӆգ3"253iA6 *ќa~w׌w\o~I6&;OyVOk3@'Iӑ D>^Cy#%s+Ͱ{Kɞ5Yr^B6d4'g\Lf[lIAz/T-X6qE`iuUi;ϔ՜%sp]٢ ݀[&P5lAv{@*3m_fFkB߯@ E8V:U.+VBz}g 6GሞqZC CI2ǦwrţR.sXf^|C9)iOnMɵpM?44F΃n6?0"81할a!žk#Rڂ&7$Ot<B3BŁ)&f?!LN|&D`q]*ϧt^RÙCh?):(6,-5(1@`0чAI<»} ~Z8k_$`6ޤa*N7vq1U7*v6X JY+Dr_JyLLg>w Gn+,Jxq4:,NNf+kM5B^b(Eb!QsJ Bca#2u5'寴Y 2w.qƛ7q۸lIl#u%(?hHhG[LLM6]6N:-Y9-:#=/Jx=a?6/)P\ڡ$$OiŧNQ֍A^(jP4\k"h <ICbr!X[gX= B5W'|`a~Kai|#,f\^!T~1]`XkD+70N%p-[5~e"4~S:f2_OM[+o>K ݲ"P|&6uY[bNxGӱQ5>l)!<^Ň>*E!CqJ ʖzG-ڔű_~gѡ!F#|Rؾ㟑N1 !Neml:μ"Yj'0,^iu*|3ڝ{'oÂd2djQ5,WިtIp-ry9P01iYԂ\{9v?6as0o4vbNal%SFh/f<(#[U=Ǣ-BcmElY+=/^A? Y ۊFdw[*EK.CzO5bx/ACw@4}D >6M? y9mg g~xeS'37u-@k!TL >ٞ{+ypnDl 3JѬK<Џs"ڕO]vWVTV]?!j z`qb^p0QL'U~mf *9wZџ4CÌ, BW\j wL4NYTsfeXEB7H!J"4u2-57ߒ컳\'T7e n򇖏U֌s6n) ܆oaLbw`y ǹLyΉe5kPs+DZ;?ywn t>Kv¨0y5p:%ouY@8>bB6aF[R8$/'j]]oSL˄~lɚ (z(l|(YU=~P}c,kv:e.+" dFҭ;@V4XLds *W*3^:F3ή̣Du3Bmx758]DJdM~M Vۓu rص?'cGQ@q=GX zWPjb,[;#x&Rpr܅״æ8[LP q0}ktzk>\*\;h.=CY򞑚$y4baHfjۋrb ,)o_2eBudH8#F_/uuL{^U)RB-ߎq"=OMx%qC0uI?%z t( rzȲךrl1y .ȪMek(JXӝW5àÉ؜1 iĪBp I\}(pn-^CBj*#:ʒ|";fo@33@/ɝ g{<]d Rz,G ќk ƕ9NV6,h!l ߇Tj73-.zK7+xV@R,y`?PiHcXu n/} ۅqwfN: 5[tکVWxLB 6U2‘Awlpq`AN1ϊQSio.bW<>){7'WuM׭Qeqޟr#κ$3[|_(4n?+v 0OUXvD!nῄѝmfVTr ۳~L^r_<^938qثyoC&*G5YQc ɥ23P9ߊP>ϲM?g;T޻hdhi'[O4#^¡=8 TwlFT ,h(m!6PD52=D׷9 5iNbޯzT]29,\/Q֑x.WH6T)ƒ&JyvE2 L pD+TZ/ب0G!5 oӇ ?PA^}|vU!o*W[ GSkF7ӟ*wzkOêmޜ$|a&h)hegZX`ToʋOF(,|5*a Sx [2@&DD`&M1MY\ RD@Gp88 |#6dHG9Z3 utm yb $MY*Rst݆,=p 2|w =kݮ O6 -g]yp0(h$ҷ{C)}fNG?gP ݂'qy%ÖTGՄj'•^z*fB?X.Z9qa͹ǫ> %DÖW{wZnP)[Ñ&eA2bHQ6@_ŷxR PBU1`dڼ$êܫ g-O`QO^p9J40m٩G#ᕚJp1ﰃ{} }rk(Qww {vpգ{eGZ«Pw&s_q(sn=6f3K`znZf"̚rgˍL5j&4Ǹ8bɔ^NY:L9gJױVIť96'|o Y#8,"s\dm.oҮVWI7xMV5қfGv<*>4yD1Y\HoI=lЙ $!O$hyL@{6B)|F]Ol"ա8eHݗV.QDy% ÅĚSm^ٝ"{ErĞnčd^_ٯلL !PlvkIbAmlS 8,)vvS-/m{ŬɚA|iSR5v:67Z1MOp#. ?-4̓Ȓ`q E%R.5B?`.&#>G7V/:gdhJ<|`2$4}xNvWGjl0|>x%nCU^hd# ヲ}ܝ9'()` H7C *ND-"_Yyh}Ԏ endstream endobj 786 0 obj << /Type /ObjStm /N 100 /First 905 /Length 4257 /Filter /FlateDecode >> stream x[YsF~ׯc\)s[GdǑ/.DBb^!A__(K랞OxLr(^Y%R\u"OW(&Υ ib H1GĦhOU%OBpV*@Ht7A4Hk\&ˉx)nQDxKDDr/D"I)zJiՑ< 9'7`@PFfFb ) tj,XL #Iu% RHR-=҃q'1E*IMҶ9f1Zafj&yAJ6*Hvdh2x2Lg9ndjhrكC  (Dxp9&U3p(ոTM|C^B}^#XB6 8]@56 |@E*k؀ZҔ#Z-`$PBS hfOH!=`QL`+΢RrJ*di 4W:(IuދFpGB= M0T%~鈽2`:G g{8[ocxy>,Jrp)Cd~J˄=%$!cl:pu/?9I>8OS'{BNZ[ӊJF $4Xf@V3a}0$҇vhؼC{:Am dʶՃ u/1i$ƶO05{ _j^&U~[&-WP^d;\"\ j1Q}U,mdrx-0c CZOBګHO,#>vyp̓N!/E0lUQr0;b?O rCC8=9>.#*FmtYO$HabZb`fe>ίJ l4m˂]/9ˆ2gb1\M-+(glM" d!@FXK6@Wlf58[lv=0lwBQژVKp*tvz&yů2BݞLG8;zn7ݑR(뫪.5O7ڭj(}6WՖt MB!tc"U|eah)߸H>TAO$hØWZPgOT `.*n1O$TXC*t4HNEk_ɇCPuJ8 D(l-SATl-QS"?nT̋t]6T8(NI(it؄]wON](趕P>#[QiP6>WC|1u(!#mB&NDN! 2t{C砖( (1Hh,#ǚJE)^Q6NUgt@m76;!@דW!6W:):Ӂ2B?ؑ  ڑ C?b)Ń V9ڋ'IXTƪP}pbKl8֡b"A4~EO4zC6zU5~bcdyVLo_ Ou!-5eUda]'k)`$!M BqS;Bm٦uꔱIcRbJcq FmuLlt\su5֌U[[4Z^E7R Ք4FS)1ochw$sc_udL\6ρkm7;Z˻v$l͎-uGRUce2j,pk606؄X6[mBC[d!^Ҟ1vSMM#XqRיu 5F(xM 񵭾٢fm$ٝ(B挡F⦦kimPmɅk7Bmhd 7A$*%o[g~q\s`A3|khhWQ3ΑEqPE6/C/b5 q"=> `%'m{-XEѢF@d{3\!yXVh8\6Et&p#SlCŮB|lQWT>n\=ɗE1/gXzz鏋za8ۼo\r_bGJ6 },eq67Ư럔ٸ>^sz|Y7Mսj]oٳONbfOǗ)mHA吱y14i^<{+f0؈ߧd(ce/aadMV4M&Ju]g,nW/dYGO~~|;{;bߑ'2*W0Ȗ0YDx ye}Y_+pM߷f\BzmɗHM<ŷc정O~,o۝ :7ݵjw?`w0dr}?)F2ztY1T{ ^w N٨f-WqT,˺ʮZ_?xaej'ᙴ}WȽi^[Iٵ;_DŽ7]B{1*E8и,gJ/~{~2ܑRC EthcGIi:ut9h~zqe6=_vEczDb9!;֦u~+T4HKvx]2DJcUwjg>}1CnNa9"v1vzsXĪ%lUj*rB+HgqDhm_{-V!? ;4 MFnd´|LCj+Aa'w?XLg3o޴9QGqFI͒h2$#VuT|;!3i?*hRTX~X~t-# MخX%rwH]ts9!5G]y}2:5ҵȖtǏd`p(UC3Q>'[k|:eNx *BCd%AbĪ6'I*bNRq->9~c$Fq~P i#FG'Ru0۵,_L:~d>7=-˒ !:!CoQy ? _H6kκG;ag͍Ͻy93gwم?|ӽBފn|_ʸ;jhAF(= i; T]0/`Ί}ʃGS߃Ôu7b?cwϽ{;Z NC99 endstream endobj 864 0 obj << /Type /ObjStm /N 100 /First 871 /Length 2994 /Filter /FlateDecode >> stream xڥZmܶB} ;@s KQNo3$%Z.N$ əgPSuSZtRNK)';eqOvVꜶ j_veDJH,Ap4uRM4C7ՒՒHn0D+˃Q+I!pzp:%a+Y)bidn0J6Hܰίdo0Yc2 ́s&- $(HiH ;'dcJXSG@&%; it:h3# 8#P,t \]-`^m$k|2&`Y 7g+pǐנ3A)B-Bp 3հN.CΦ-{v%7@)q:@"y/',;f y ߈t罕+ρ=ayS;fJVȹ,RN2<7 tԂfNaHIxGA  A5| )gs…߯NǗ;j:}ynY(W?{Nx/=켿m;n}fw?!VO{xufsx bL`Oxi}98Q0Ξyuka;pP>o7ۇo~?[97.JB>{oϣ틆q=7n`\6Xu^mo` uq7ysySR2]]~!]ɦkϿņIV*_}V݆uIhz9d F=9]3~ c3wt )(*ŝm|Mi'lp J~ؐl8ϙK4;p:ȸK~9)?um{}?w]pM!Rܕl5'u ЗհQ|:I)srD=3gtM.gO)ocXLk!fisbmR댥)JWnzRJ;Ok)iW#ԝZZѳP}2y NE-EkmK?xwrOvvIǟgRi\PH \sWpK-:>|gXA?Gl(`X[ \!,{Ü6 kӋ/냇'I^l^r~OUYzu@!Imo3kJ5Os8lx}Xf呛} D7Oc? % 3i#I, h_fU+U;tIU:d/kСϐ샗g.nJQӇTË]ϴxU׳!O%/Fn.Ԯz}ubhDTh;𦿼U2l>}ѥ2o7}RzsdYr3iL~zD ~@SO?@^rR{7nv4o7p6$B-c+} QL>< 1-~qr7x=nIo_9d,OaDA5C";洵#Ey֗HDnx0$Q>7P>jR>SQ>[NAeНRƚVɄfaX&?︔;$ m/]TuyA?Zs( endstream endobj 906 0 obj << /Author()/Title()/Subject()/Creator(LaTeX with hyperref package)/Producer(pdfTeX-1.40.18)/Keywords() /CreationDate (D:20200202193104Z) /ModDate (D:20200202193104Z) /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.18 (TeX Live 2017/Debian) kpathsea version 6.2.3) >> endobj 905 0 obj << /Type /ObjStm /N 1 /First 6 /Length 100 /Filter /FlateDecode >> stream xڳ40Q0ಱ,HUwN,IOHLO-V03W0P/-X@Ds\Kc7?%U?8 51$3?OΎ l endstream endobj 907 0 obj << /Type /XRef /Index [0 908] /Size 908 /W [1 3 1] /Root 904 0 R /Info 906 0 R /ID [ ] /Length 2176 /Filter /FlateDecode >> stream x%[h^Y'm4Is>MӤ4MI'i4I6I8xx0*P\*s%2TDGAoAq@Q/ E޹yw~o(Y' QO( M A6NXR+h%"DG#]'< C%5hh#(5:]%<apa#hB;vAL  AZvtG <N5]$<њ Of g@/Zy>ppYBݠm M'0j†Ѫkhh݄Ph=hzU}1!280IDExD4S`Z 3 orpFEӧ]h3h-K`l77Z_Ee$` 81`рw=>Q,(!KH쀁%(`@ 3 [-q̚!1k h3^ s`ҢQE %W3Ha`0M44ū ='ঠ 4}j@4M|[rw~;_ԂjZ˪Gq[̯ځ*k'P=Uk3w* u\T:nJZiPJ`̃`e0m ]zYi:+; `u6P9ا ׿[)y%e| u*A I-|%?Paq#ufϳZGR/+oV{=W^%sּ^z5D*Z}sy 9 ~}SJ|,ȳ0%^ Zp/kUGY6u!Kp~@W-Yzn`kU@GC^=;`5P1H@}#"Cf8d~qA GA1PjtYh͠6:A?}IWt$8i΀^΃rڠehfҲ~p\,~kyү]WW50-~}V׹V`%# n).mh4QZ-;`B]9 }h"@%єmMfCr5nIK[2M)ܶaZ-Z%]vҺ?U p'Yr[8Î;:+Z2ިq80sU[2ppk qsa3\%[Oԋ^s}RZSM .K޹pu9&:Yp?w`3)R%_,çZ퀭}vޒO8YťEV:7 [œ:iX Y܁B|Jù`̂ K>ީq3:pi=g`mç:|n*~ NJ9\p[ms8ةfH([PXm%)+EMn&qȴ,rj@-8 ,`,BΜҙmi-pɆ,]СK7UlkmQ+ 4+s`ҵ-yQKwZY֒=K?EZjY.-WZV-};Ygj[֫jmXqjmZvoF:̮n9nN:Zn9σ`,u2 `s(Kj8zr9,\ԁH`pݧ",>-#aD2) endstream endobj startxref 526530 %%EOF gnm/inst/doc/gnmOverview.R0000644000176200001440000006073713615621570015233 0ustar liggesusers### R code from vignette source 'gnmOverview.Rnw' ################################################### ### code chunk number 1: gnmOverview.Rnw:65-66 ################################################### getOption("SweaveHooks")[["eval"]]() options(SweaveHooks = list(eval = function() options(show.signif.stars = FALSE))) ################################################### ### code chunk number 2: Load_gnm ################################################### getOption("SweaveHooks")[["eval"]]() library(gnm) ################################################### ### code chunk number 3: migrationData ################################################### getOption("SweaveHooks")[["eval"]]() count <- c(11607, 100, 366, 124, 87, 13677, 515, 302, 172, 225, 17819, 270, 63, 176, 286, 10192 ) region <- c("NE", "MW", "S", "W") row <- gl(4, 4, labels = region) col <- gl(4, 1, length = 16, labels = region) ################################################### ### code chunk number 4: squareTableModels ################################################### getOption("SweaveHooks")[["eval"]]() independence <- glm(count ~ row + col, family = poisson) quasi.indep <- glm(count ~ row + col + Diag(row, col), family = poisson) symmetry <- glm(count ~ Symm(row, col), family = poisson) quasi.symm <- glm(count ~ row + col + Symm(row, col), family = poisson) comparison1 <- anova(independence, quasi.indep, quasi.symm) print(comparison1, digits = 7) comparison2 <- anova(symmetry, quasi.symm) print(comparison2) ################################################### ### code chunk number 5: EriksonData ################################################### getOption("SweaveHooks")[["eval"]]() ### Collapse to 7 by 7 table as in Erikson et al. (1982) erikson <- as.data.frame(erikson) lvl <- levels(erikson$origin) levels(erikson$origin) <- levels(erikson$destination) <- c(rep(paste(lvl[1:2], collapse = " + "), 2), lvl[3], rep(paste(lvl[4:5], collapse = " + "), 2), lvl[6:9]) erikson <- xtabs(Freq ~ origin + destination + country, data = erikson) ################################################### ### code chunk number 6: wedderburn ################################################### getOption("SweaveHooks")[["eval"]]() ## data from Wedderburn (1974), see ?barley logitModel <- glm(y ~ site + variety, family = wedderburn, data = barley) fit <- fitted(logitModel) print(sum((barley$y - fit)^2 / (fit * (1-fit))^2)) ################################################### ### code chunk number 7: termPredictors ################################################### getOption("SweaveHooks")[["eval"]]() print(temp <- termPredictors(quasi.symm)) rowSums(temp) - quasi.symm$linear.predictors ################################################### ### code chunk number 8: RC_homogeneous_model_1 ################################################### getOption("SweaveHooks")[["eval"]]() set.seed(1) RChomog1 <- gnm(Freq ~ origin + destination + Diag(origin, destination) + MultHomog(origin, destination), family = poisson, data = occupationalStatus, verbose = FALSE) ################################################### ### code chunk number 9: RC_homogeneous_model_2 ################################################### getOption("SweaveHooks")[["eval"]]() set.seed(2) RChomog2 <- update(RChomog1) ################################################### ### code chunk number 10: Compare_coefficients ################################################### getOption("SweaveHooks")[["eval"]]() compareCoef <- cbind(coef(RChomog1), coef(RChomog2)) colnames(compareCoef) <- c("RChomog1", "RChomog2") round(compareCoef, 4) ################################################### ### code chunk number 11: Summarize_model ################################################### getOption("SweaveHooks")[["eval"]]() summary(RChomog2) ################################################### ### code chunk number 12: RC_homogeneous_constrained_model1 ################################################### getOption("SweaveHooks")[["eval"]]() set.seed(1) RChomogConstrained1 <- update(RChomog1, constrain = length(coef(RChomog1))) ################################################### ### code chunk number 13: RC_homogeneous_constrained_model2 ################################################### getOption("SweaveHooks")[["eval"]]() set.seed(2) RChomogConstrained2 <- update(RChomogConstrained1) identical(coef(RChomogConstrained1), coef(RChomogConstrained2)) ################################################### ### code chunk number 14: Eliminate_Eg ################################################### getOption("SweaveHooks")[["eval"]]() set.seed(1) n <- 1000 x <- rep(rnorm(n), rep(3, n)) counts <- as.vector(rmultinom(n, 10, c(0.7, 0.1, 0.2))) rowID <- gl(n, 3, 3 * n) resp <- gl(3, 1, 3 * n) ################################################### ### code chunk number 15: Double_UNIDIFF_model ################################################### getOption("SweaveHooks")[["eval"]]() doubleUnidiff <- gnm(Freq ~ election:vote + election:class:religion + Mult(Exp(election), religion:vote) + Mult(Exp(election), class:vote), family = poisson, data = cautres) ################################################### ### code chunk number 16: Contrast_matrix ################################################### getOption("SweaveHooks")[["eval"]]() coefs <- names(coef(doubleUnidiff)) contrCoefs <- coefs[grep(", religion:vote", coefs)] nContr <- length(contrCoefs) contrMatrix <- matrix(0, length(coefs), nContr, dimnames = list(coefs, contrCoefs)) contr <- contr.sum(contrCoefs) # switch round to contrast with first level contr <- rbind(contr[nContr, ], contr[-nContr, ]) contrMatrix[contrCoefs, 2:nContr] <- contr contrMatrix[contrCoefs, 2:nContr] ################################################### ### code chunk number 17: Check_estimability_1 ################################################### getOption("SweaveHooks")[["eval"]]() checkEstimable(doubleUnidiff, contrMatrix) ################################################### ### code chunk number 18: Check_estimability_2 ################################################### getOption("SweaveHooks")[["eval"]]() coefs <- names(coef(doubleUnidiff)) contrCoefs <- coefs[grep("[.]religion", coefs)] nContr <- length(contrCoefs) contrMatrix <- matrix(0, length(coefs), length(contrCoefs), dimnames = list(coefs, contrCoefs)) contr <- contr.sum(contrCoefs) contrMatrix[contrCoefs, 2:nContr] <- rbind(contr[nContr, ], contr[-nContr, ]) checkEstimable(doubleUnidiff, contrMatrix) ################################################### ### code chunk number 19: Get_contrasts_1 ################################################### getOption("SweaveHooks")[["eval"]]() myContrasts <- getContrasts(doubleUnidiff, pickCoef(doubleUnidiff, ", religion:vote")) myContrasts ################################################### ### code chunk number 20: qvplot ################################################### getOption("SweaveHooks")[["eval"]]() plot(myContrasts, main = "Relative strength of religion-vote association, log scale", xlab = "Election", levelNames = 1:4) ################################################### ### code chunk number 21: RCmodel ################################################### getOption("SweaveHooks")[["eval"]]() mentalHealth$MHS <- C(mentalHealth$MHS, treatment) mentalHealth$SES <- C(mentalHealth$SES, treatment) RC1model <- gnm(count ~ SES + MHS + Mult(SES, MHS), family = poisson, data = mentalHealth) ################################################### ### code chunk number 22: RCmodel_constrained ################################################### getOption("SweaveHooks")[["eval"]]() RC1model2 <- gnm(count ~ SES + MHS + Mult(1, SES, MHS), constrain = "[.]SES[AF]", constrainTo = c(0, 1), ofInterest = "[.]SES", family = poisson, data = mentalHealth) summary(RC1model2) ################################################### ### code chunk number 23: getContrasts_simple ################################################### getOption("SweaveHooks")[["eval"]]() getContrasts(RC1model, pickCoef(RC1model, "[.]SES"), ref = "first", scaleRef = "first", scaleWeights = c(rep(0, 5), 1)) ################################################### ### code chunk number 24: two-way ################################################### getOption("SweaveHooks")[["eval"]]() xtabs(y ~ site + variety, barley) ################################################### ### code chunk number 25: residSVD ################################################### getOption("SweaveHooks")[["eval"]]() emptyModel <- gnm(y ~ -1, family = wedderburn, data = barley) biplotStart <- residSVD(emptyModel, barley$site, barley$variety, d = 2) biplotModel <- gnm(y ~ -1 + instances(Mult(site, variety), 2), family = wedderburn, data = barley, start = biplotStart) ################################################### ### code chunk number 26: residSVDplot ################################################### getOption("SweaveHooks")[["eval"]]() plot(coef(biplotModel), biplotStart, main = "Comparison of residSVD and MLE for a 2-dimensional biplot model", ylim = c(-2, 2), xlim = c(-4, 4)) abline(a = 0, b = 1, lty = 2) ################################################### ### code chunk number 27: Set_contrasts_attribute ################################################### getOption("SweaveHooks")[["eval"]]() set.seed(1) mentalHealth$MHS <- C(mentalHealth$MHS, treatment) mentalHealth$SES <- C(mentalHealth$SES, treatment) ################################################### ### code chunk number 28: RC1_model ################################################### getOption("SweaveHooks")[["eval"]]() RC1model <- gnm(count ~ SES + MHS + Mult(SES, MHS), family = poisson, data = mentalHealth) RC1model ################################################### ### code chunk number 29: Normalize_scores ################################################### getOption("SweaveHooks")[["eval"]]() rowProbs <- with(mentalHealth, tapply(count, SES, sum) / sum(count)) colProbs <- with(mentalHealth, tapply(count, MHS, sum) / sum(count)) rowScores <- coef(RC1model)[10:15] colScores <- coef(RC1model)[16:19] rowScores <- rowScores - sum(rowScores * rowProbs) colScores <- colScores - sum(colScores * colProbs) beta1 <- sqrt(sum(rowScores^2 * rowProbs)) beta2 <- sqrt(sum(colScores^2 * colProbs)) assoc <- list(beta = beta1 * beta2, mu = rowScores / beta1, nu = colScores / beta2) assoc ################################################### ### code chunk number 30: Elliptical_contrasts ################################################### getOption("SweaveHooks")[["eval"]]() mu <- getContrasts(RC1model, pickCoef(RC1model, "[.]SES"), ref = rowProbs, scaleWeights = rowProbs) nu <- getContrasts(RC1model, pickCoef(RC1model, "[.]MHS"), ref = colProbs, scaleWeights = colProbs) mu nu ################################################### ### code chunk number 31: RC2_model ################################################### getOption("SweaveHooks")[["eval"]]() RC2model <- gnm(count ~ SES + MHS + instances(Mult(SES, MHS), 2), family = poisson, data = mentalHealth) RC2model ################################################### ### code chunk number 32: Homogeneous_effects ################################################### getOption("SweaveHooks")[["eval"]]() RChomog <- gnm(Freq ~ origin + destination + Diag(origin, destination) + MultHomog(origin, destination), family = poisson, data = occupationalStatus) RChomog ################################################### ### code chunk number 33: Heterogeneous_effects ################################################### getOption("SweaveHooks")[["eval"]]() RCheterog <- gnm(Freq ~ origin + destination + Diag(origin, destination) + Mult(origin, destination), family = poisson, data = occupationalStatus) anova(RChomog, RCheterog) ################################################### ### code chunk number 34: Transform_to_counts ################################################### getOption("SweaveHooks")[["eval"]]() set.seed(1) count <- with(voting, percentage/100 * total) yvar <- cbind(count, voting$total - count) ################################################### ### code chunk number 35: Class_mobility ################################################### getOption("SweaveHooks")[["eval"]]() classMobility <- gnm(yvar ~ Dref(origin, destination), family = binomial, data = voting) classMobility ################################################### ### code chunk number 36: Class_mobility_weights ################################################### getOption("SweaveHooks")[["eval"]]() DrefWeights(classMobility) ################################################### ### code chunk number 37: Salariat_factors ################################################### getOption("SweaveHooks")[["eval"]]() upward <- with(voting, origin != 1 & destination == 1) downward <- with(voting, origin == 1 & destination != 1) ################################################### ### code chunk number 38: Social_mobility ################################################### getOption("SweaveHooks")[["eval"]]() socialMobility <- gnm(yvar ~ Dref(origin, destination, delta = ~ 1 + downward + upward), family = binomial, data = voting) socialMobility ################################################### ### code chunk number 39: social_mobility_weights ################################################### getOption("SweaveHooks")[["eval"]]() DrefWeights(socialMobility) ################################################### ### code chunk number 40: Downward_mobility ################################################### getOption("SweaveHooks")[["eval"]]() downwardMobility <- gnm(yvar ~ Dref(origin, destination, delta = ~ 1 + downward), family = binomial, data = voting) downwardMobility DrefWeights(downwardMobility) ################################################### ### code chunk number 41: UNIDIFF_model ################################################### getOption("SweaveHooks")[["eval"]]() set.seed(1) unidiff <- gnm(Freq ~ educ*orig + educ*dest + Mult(Exp(educ), orig:dest), ofInterest = "[.]educ", family = poisson, data = yaish, subset = (dest != 7)) coef(unidiff) ################################################### ### code chunk number 42: Unidiff_contrasts ################################################### getOption("SweaveHooks")[["eval"]]() getContrasts(unidiff, ofInterest(unidiff)) ################################################### ### code chunk number 43: double_UNIDIFF_model ################################################### getOption("SweaveHooks")[["eval"]]() set.seed(1) doubleUnidiff <- gnm(Freq ~ election*vote + election*class*religion + Mult(Exp(election), religion:vote) + Mult(Exp(election), class:vote), family = poisson, data = cautres) getContrasts(doubleUnidiff, rev(pickCoef(doubleUnidiff, ", class:vote"))) getContrasts(doubleUnidiff, rev(pickCoef(doubleUnidiff, ", religion:vote"))) ################################################### ### code chunk number 44: Scale_yields ################################################### getOption("SweaveHooks")[["eval"]]() set.seed(1) yield.scaled <- wheat$yield * sqrt(3/1000) treatment <- interaction(wheat$tillage, wheat$summerCrop, wheat$manure, wheat$N, sep = "") ################################################### ### code chunk number 45: AMMI_model ################################################### getOption("SweaveHooks")[["eval"]]() mainEffects <- gnm(yield.scaled ~ year + treatment, family = gaussian, data = wheat) svdStart <- residSVD(mainEffects, year, treatment, 3) bilinear1 <- update(mainEffects, . ~ . + Mult(year, treatment), start = c(coef(mainEffects), svdStart[,1])) ################################################### ### code chunk number 46: AOD ################################################### getOption("SweaveHooks")[["eval"]]() anova(mainEffects, bilinear1, test = "F") ################################################### ### code chunk number 47: AMMI_model2 ################################################### getOption("SweaveHooks")[["eval"]]() set.seed(1) barleyModel <- gnm(height ~ year + genotype + Mult(year, genotype), data = barleyHeights) ################################################### ### code chunk number 48: Spherical_contrasts ################################################### getOption("SweaveHooks")[["eval"]]() gamma <- getContrasts(barleyModel, pickCoef(barleyModel, "[.]y"), ref = "mean", scaleWeights = "unit") delta <- getContrasts(barleyModel, pickCoef(barleyModel, "[.]g"), ref = "mean", scaleWeights = "unit") gamma delta ################################################### ### code chunk number 49: CI ################################################### getOption("SweaveHooks")[["eval"]]() gamma[[2]][,1] + (gamma[[2]][,2]) %o% c(-1.96, 1.96) delta[[2]][,1] + (delta[[2]][,2]) %o% c(-1.96, 1.96) ################################################### ### code chunk number 50: SVD ################################################### getOption("SweaveHooks")[["eval"]]() svd(termPredictors(barleyModel)[, "Mult(year, genotype)"])$d ################################################### ### code chunk number 51: Biplot_model ################################################### getOption("SweaveHooks")[["eval"]]() set.seed(83) biplotModel <- gnm(y ~ -1 + instances(Mult(site, variety), 2), family = wedderburn, data = barley) ################################################### ### code chunk number 52: Row_and_column_scores ################################################### getOption("SweaveHooks")[["eval"]]() barleyMatrix <- xtabs(biplotModel$predictors ~ site + variety, data = barley) barleySVD <- svd(barleyMatrix) A <- sweep(barleySVD$u, 2, sqrt(barleySVD$d), "*")[, 1:2] B <- sweep(barleySVD$v, 2, sqrt(barleySVD$d), "*")[, 1:2] rownames(A) <- levels(barley$site) rownames(B) <- levels(barley$variety) colnames(A) <- colnames(B) <- paste("Component", 1:2) A B ################################################### ### code chunk number 53: Biplot1 ################################################### getOption("SweaveHooks")[["eval"]]() barleyCol <- c("red", "blue") plot(rbind(A, B), pch = c(levels(barley$site), levels(barley$variety)), col = rep(barleyCol, c(nlevels(barley$site), nlevels(barley$variety))), xlim = c(-4, 4), ylim = c(-4, 4), main = "Biplot for barley data", xlab = "Component 1", ylab = "Component 2") text(c(-3.5, -3.5), c(3.9, 3.6), c("sites: A-I","varieties: 1-9, X"), col = barleyCol, adj = 0) ################################################### ### code chunk number 54: Biplot2 ################################################### getOption("SweaveHooks")[["eval"]]() plot(rbind(A, B), pch = c(levels(barley$site), levels(barley$variety)), col = rep(barleyCol, c(nlevels(barley$site), nlevels(barley$variety))), xlim = c(-4, 4), ylim = c(-4, 4), main = "Biplot for barley data", xlab = "Component 1", ylab = "Component 2") text(c(-3.5, -3.5), c(3.9, 3.6), c("sites: A-I","varieties: 1-9, X"), col = barleyCol, adj = 0) abline(a = 0, b = tan(pi/3)) abline(a = 0, b = -tan(pi/6)) abline(a = 2.6, b = tan(pi/3), lty = 2) abline(a = 4.5, b = tan(pi/3), lty = 2) abline(a = 1.3, b = -tan(pi/6), lty = 2) text(2.8, 3.9, "v-axis", font = 3) text(3.8, -2.7, "h-axis", font = 3) ################################################### ### code chunk number 55: Double_additive ################################################### getOption("SweaveHooks")[["eval"]]() variety.binary <- factor(match(barley$variety, c(2,3,6), nomatch = 0) > 0, labels = c("rest", "2,3,6")) doubleAdditive <- gnm(y ~ variety + Mult(site, variety.binary), family = wedderburn, data = barley) ################################################### ### code chunk number 56: Compare_chi-squared ################################################### getOption("SweaveHooks")[["eval"]]() biplotModChiSq <- sum(residuals(biplotModel, type = "pearson")^2) doubleAddChiSq <- sum(residuals(doubleAdditive, type = "pearson")^2) c(doubleAddChiSq - biplotModChiSq, doubleAdditive$df.residual - biplotModel$df.residual) ################################################### ### code chunk number 57: Re-express_data ################################################### getOption("SweaveHooks")[["eval"]]() set.seed(1) subset(backPain, x1 == 1 & x2 == 1 & x3 == 1) backPainLong <- expandCategorical(backPain, "pain") head(backPainLong) ################################################### ### code chunk number 58: Stereotype_model ################################################### getOption("SweaveHooks")[["eval"]]() oneDimensional <- gnm(count ~ pain + Mult(pain, x1 + x2 + x3), eliminate = id, family = "poisson", data = backPainLong) oneDimensional ################################################### ### code chunk number 59: Qualitative_model ################################################### getOption("SweaveHooks")[["eval"]]() threeDimensional <- gnm(count ~ pain + pain:(x1 + x2 + x3), eliminate = id, family = "poisson", data = backPainLong) threeDimensional ################################################### ### code chunk number 60: Calculate_log-likelihood ################################################### getOption("SweaveHooks")[["eval"]]() logLikMultinom <- function(model, size){ object <- get(model) l <- sum(object$y * log(object$fitted/size)) c(nParameters = object$rank - nlevels(object$eliminate), logLikelihood = l) } size <- tapply(backPainLong$count, backPainLong$id, sum)[backPainLong$id] t(sapply(c("oneDimensional", "threeDimensional"), logLikMultinom, size)) ################################################### ### code chunk number 61: Constrain_slopes ################################################### getOption("SweaveHooks")[["eval"]]() ## before constraint summary(oneDimensional) oneDimensional <- gnm(count ~ pain + Mult(pain, offset(x1) + x2 + x3), eliminate = id, family = "poisson", data = backPainLong) ## after constraint summary(oneDimensional) ################################################### ### code chunk number 62: Get_slopes ################################################### getOption("SweaveHooks")[["eval"]]() getContrasts(oneDimensional, pickCoef(oneDimensional, "[.]pain")) ################################################### ### code chunk number 63: singleExp ################################################### getOption("SweaveHooks")[["eval"]]() x <- 1:100 y <- exp(- x / 10) set.seed(1) saved.fits <- list() for (i in 1:100) saved.fits[[i]] <- gnm(y ~ Exp(1 + x), verbose = FALSE) table(zapsmall(sapply(saved.fits, deviance))) ################################################### ### code chunk number 64: singleExp2 ################################################### getOption("SweaveHooks")[["eval"]]() saved.fits[[2]] ################################################### ### code chunk number 65: doubleExp ################################################### getOption("SweaveHooks")[["eval"]]() x <- 1:100 y <- exp(- x / 10) + 2 * exp(- x / 50) set.seed(1) saved.fits <- list() for (i in 1:100) { saved.fits[[i]] <- suppressWarnings(gnm(y ~ Exp(1 + x, inst = 1) + Exp(1 + x, inst = 2), verbose = FALSE)) } table(round(unlist(sapply(saved.fits, deviance)), 4)) ################################################### ### code chunk number 66: doubleExp2 ################################################### getOption("SweaveHooks")[["eval"]]() singleExp <- gnm(y ~ Exp(1 + x), start = c(NA, NA, -0.1), verbose = FALSE) singleExp meanOnly <- gnm(y ~ 1, verbose = FALSE) meanOnly plot(x, y, main = "Two sub-optimal fits to a sum-of-exponentials curve") lines(x, fitted(singleExp)) lines(x, fitted(meanOnly), lty = "dashed") ################################################### ### code chunk number 67: doubleExp3 ################################################### getOption("SweaveHooks")[["eval"]]() gnm(y ~ instances(Exp(1 + x), 2), start = c(NA, NA, -0.1, NA, -0.1), verbose = FALSE) gnm/inst/CITATION0000744000176200001440000000142513311227757013160 0ustar liggesusers## R >= 2.8.0 passes package metadata to citation(). if(!exists("meta") || is.null(meta)) meta <- packageDescription("gnm") year <- sub("-.*", "", meta$Date) note <- sprintf("R package version %s", meta$Version) url <- sprintf("https://cran.r-project.org/package=gnm", meta$Version) citEntry(entry="Manual", title = {"Generalized nonlinear models in R: An overview of the gnm package"}, author = personList(as.person("Heather Turner"), as.person("David Firth")), year = year, note = note, url = url, textVersion = paste( "Heather Turner and David Firth", sprintf("(%s).", year), "Generalized nonlinear models in R: An overview of the gnm package.", sprintf("(%s).", note), sprintf("(%s).", url)) ) gnm/inst/WORDLIST0000744000176200001440000000315613615621546013221 0ustar liggesusersAastveit ac AgeContrasts AGEM Agresti Agresti's AMMI anova AppVeyor asGnm Assoc Asym attr Ax backPain barleyHeights Biometrika biplotModel bst byrow Catchpole cautres Cautres Chadoeuf checkEstimable chicago CIMMYT Ciudad cloglog coef coefNames coefs commonTopo confint Const constrainTo Courrieu Crossa deLeeuw deriv dest df Df dfbeta dfbetas Diag dialog Dref DrefWeights ed edn Eeuwijk eqn erikson Erikson estimability etastart etc exitInfo expandCategorical extractAIC FCFF FFCF FOPLF Francaise Frans FRMF GAMMI Gerris getContrasts getModelFrame glm glms gnls gnms Goldthorpe Graaf Harville Hastie hatvalues heatherturner HMD ht ic ij ik il Inf Inv ir iterMax iterStart jkl jss Langner LCmodel Lettre levelMatrix Levenberg lll lm logLik logmult lsMethod Maison maleOver Marquardt MCFM mDeaths Mellen Menezes mentalHealth mExposure MFCM mfrow MHS Midtown MOPLM MPinv MRMM Mult MultHomog multinom multTopo mustart MWORK nc nd Nelder newdata nlme nls nnet nObs nonlin nonlinear Nonlinear nonlinTerms nonzero nullModel NYU Obregon occupationalStatus ofInterest oneDimensional Opler org parameterizing pch pickCoef poisson Poisson Portocarero predLabels proj pseudoinverse Pseudoinverse qrSolve quasibinomial Quasilikelihood quasipoisson qv qvframe R's r'th Rasch RC regexp Resid residSVD resp rowID rstandard salariat scal scaleRef scaleWeights se secalis selfStart sep separateTopo SES Slik Sobel Soc socioeconomic Socioeconomic Sociol Srole SSlogis Stat Std Symm tbph termPredictors th Topo tp u uk unidiff UNIDIFF vals valuedness varLabels vcov warwick wedderburn Wedderburn Wedderburn's www Xie xlab xlim Xlisp xmid yaish Yaish Yaqui ylab ylim