effects/0000755000176000001440000000000012236725756011740 5ustar ripleyuserseffects/inst/0000755000176000001440000000000012236511700012673 5ustar ripleyuserseffects/inst/CITATION0000644000176000001440000000271411265102577014045 0ustar ripleyuserscitHeader("To cite effects in publications use:") citEntry(entry = "Article", title = "Effect Displays in {R} for Generalised Linear Models", author = as.person("John Fox"), journal = "Journal of Statistical Software", year = "2003", volume = "8", number = "15", pages = "1--27", url = "http://www.jstatsoft.org/v08/i15/", textVersion = paste("John Fox (2003).", "Effect Displays in R for Generalised Linear Models.", "Journal of Statistical Software, 8(15), 1-27.", "URL http://www.jstatsoft.org/v08/i15/.") ) citEntry(entry = "Article", title = "Effect Displays in {R} for Multinomial and Proportional-Odds Logit Models: Extensions to the {effects} Package", author = personList(as.person("John Fox"), as.person("Jangman Hong")), journal = "Journal of Statistical Software", year = "2009", volume = "32", number = "1", pages = "1--24", url = "http://www.jstatsoft.org/v32/i01/", textVersion = paste("John Fox, Jangman Hong (2009).", "Effect Displays in R for Multinomial and Proportional-Odds Logit Models: Extensions to the effects Package.", "Journal of Statistical Software, 32(1), 1-24.", "URL http://www.jstatsoft.org/v32/i01/."), header = "For usage in multinomial and proportional-odds logit models also cite:" ) effects/inst/CHANGES0000644000176000001440000001147011716766566013721 0ustar ripleyusersVersion 0.9-0 initial release to CRAN Version 1.0-0 o Rewrote summary.effect method and added print.summary.effect method. Version 1.0-1 o Blanks can be inserted into or removed from effect names without causing an error; thus, e.g., "poly(education,3)" is equivalent to "poly(education, 3)". o Name spaces of lattice and grid packages are imported, as required in R 1.8.0. Version 1.0-2 o Added ask argument to plot.effect.list, and row, col, nrow, ncol, and more arguments to plot.effect, to support graphing an array of effect plots. o Fixed bug in plot.effect that caused xlab argument to be ignored in certain circumstances. Version 1.0-3 o effect function now works if na.action is na.exclude. Version 1.0-4 o Fixed small bug introduced in version 1.0-3. Version 1.0-5 o x.var and z.var arguments to plot.effect now take names as well as indices. Version 1.0-6 o A variable specified in xlevels can be fixed to a single value. Version 1.0-7 o Made effect() generic, with a method for lm objects that handles glm objects as well. Version 1.0-8 o Small fixes to the help files. Version 1.0-9 o Small change to compile without a warning in R 2.4.0. Version 1.0-10 o Standard errors of effects are computed using t rather than standard-normal distribution for models with estimated dispersion (as suggested by Brian Ripley). o Small fixes. o Objects are now named "eff" and "eff.list" rather than "effect" and "effect.list". o Data sets now provided by lazy data. Version 1.0-11 o Replaced obsolete \non_function{} markup in Rd files (reported by Kurt Hornik). Version 1.0-12 o key.args argument added to plot.eff() (coutesy of Michael Friendly), to allow conrol over, e.g., placement of legend. Version 2.0-0 o Jangman Hong joins project. o support added for multinomial and proportional-odds logit models, as fit by multinom() (in nnet package) and polr() (in MASS) package, following results in Fox and Andersen (2006). o added the argument given.values to effect() methods for finer-grain control of displays. Version 2.0-1 o Fixed bug in effect.polr() that prevented computation for a model with a single term (reported by Paul Prew). Version 2.0-2 o Fixed bug in print(), summary(), and plot() methods for polytomous logit models with a response with numbered levels (reported by Paul Prew). Version 2.0-3 o Fixed bug in all effect() methods that caused error when na.action="na.exclude" (reported by Tracy Lightcap and Rob Goedman). Version 2.0-4 o Palettes from the colorspace package are used by default for stacked plots. o Fixed bug in handling of typical= argument to effect() (argument was effectively ignored). o Added Titanic and Wells data sets. o Small changes. Version 2.0-5 o Added examples for Titanic, BEPS, and WVS data sets. o Arguments ... (e.g., digits) passed through in print() methods. Version 2.0-6 o Fixed small bugs in print.efflist(), summary.efflist(), and plot.effpoly() methods. o Corrected error in missing-data handling that sometimes surfaced in effect.multinom(). o Added .Rd file for package. Version 2.0-7 o Fixed bug in handling of given.values argument to effect(). Version 2.0-8 o The S3 method print.summary.eff is now declared in NAMESPACE (as it should have been all along). o Added CITATION.txt file (courtesy of Achim Zeileis). o Version corresponding to John Fox, Jangman Hong (2009), Effect Displays in R for Multinomial and Proportional-Odds Logit Models: Extensions to the effects Package. Journal of Statistical Software, 32(1), 1-24 . O Fixed [pgk] markup in .Rd file cross-references. Version 2.0-9 o Applied patches contributed by Ian Fellows to allow logical predictors and various coercions in model formulas to work properly. o Fixed name of CITATION file (was CITATION.txt). o Small changes to docs. Version 2.0-10 o Backed out Ian Fellows's patches because of errors. Version 2.0-11 o Small change to eliminate warnings produced in R 2.12.0. o Added nrows and ncols argument to plot.efflist() (following suggstion by Michael Friendly). o Small fix to docs. Version 2.0-12 o plot.eff() and plot.effpoly now return an object, printed by print.plot.eff() (after a question by Michael Friendly). o New effect.gls() method, various changes for compatibility (after a question by Oriol Verdeny Vilalta). o effect.lm() now stores the covariance matrix of the effects (after a question by Bernhard Kaess). Version 2.0-13 o effect.multinom() and effect.polr() now use update() to refit the model rather than calling multinom() or polr() directly; update for effect.multinom() sets trace=FALSE (after suggestions by David Armstrong). o Added [.efflist method (after a question by Andreas Roesch). effects/NAMESPACE0000644000176000001440000000203312236312350013133 0ustar ripleyusers# last modified 2013-10-15 by J. Fox import(grid, lattice, colorspace) export(effect, allEffects, all.effects, Effect) S3method(Effect, default) S3method(Effect, lm) S3method(Effect, mer) S3method(Effect, merMod) S3method(Effect, lme) S3method(Effect, gls) S3method(Effect, multinom) S3method(Effect, polr) S3method(Effect, poLCA) S3method(Effect, mlm) S3method(print, eff) S3method(print, efflist) S3method(print, summary.eff) S3method(summary, eff) S3method(summary, efflist) S3method(as.data.frame, eff) S3method(as.data.frame, effpoly) S3method(as.data.frame, efflatent) S3method(plot, eff) S3method(print, plot.eff) S3method(plot, efflist) S3method(print, effpoly) S3method(summary, effpoly) S3method(plot, effpoly) S3method(print, efflatent) S3method(summary, efflatent) S3method(allEffects, default) S3method(allEffects, gls) S3method(allEffects, mer) S3method(allEffects, merMod) S3method(allEffects, lme) S3method(allEffects, poLCA) S3method(vcov, eff) S3method(vcov, fakeglm) S3method(`[`, efflist) effects/NEWS0000644000176000001440000001060112236312350012413 0ustar ripleyusersVersion 2.3-0 o removed stray character in a the mixed models file o ci.style="bands" is now the default for variates on the horizontal axis and can also be used with multiline=TRUE o Added ci.style='bands', band.transparency, band.colors, and lwd to plot.effpoly() for line plots to give filled confidence bands and control line width o Added Effect.mlm() for multivariate linear models o Interpolating splines are now used by default when drawing lines in effects plots unless the argument use.splines=FALSE o effect() now calls Effect(); all effect() methods are removed, but effect() will continue to work as before. o Various methods for effect objects now handle factors with a "valid" NA level (fixing bug reported by Joseph Larmarange). o Further bug fixes in effects.mer() and effects.lme() (following bug report by Felipe E. Albornoz). Version 2.2-6 o bug fixes in effects.mer and effects.lme. o added terms.gls() to make effect.gls() and Effect.gls() work again. o plot.eff() gains an lwd= option to control the width of fitted lines. o Added ci.style='bands' and alpha= to plot.eff() for non-multiline plots to give filled confidence bands. Version 2.2-5 o Added support for polytomous latent class analysis based on the poLCA package. o Modified mixed-model methods to all use in user-functions. o Changed the default method for determining number of levels for a continuous predictor; see help page for 'effect' and discussion of the 'xlevels' argument for details. Argument 'default.levels', while still included for compatibility, is depricated. o Added .merMod methods for development version of lme4. o Added support for lme4.0. o Fixed bug preventing restoration of warn option (reported by Kenneth Knoblauch). o Fixed handling of ticks.x argument to plot.eff() and plot.effpoly(), now works as advertized. o Adjusted package dependencies, imports for CRAN checks. o Changed name of Titanic dataset to TitanicSurvival to avoid name clash (request of Michael Friendly). o Minor fixes. Version 2.2-4 o Add argument 'ci.style' to plot.eff() and plot.eff() to allow confidence intervals to be displayed as lines or using error bars. Confidence bars are permitted on multiline plots (after suggestion by Steve Taylor). o Allow empty cells with crossed factors for lm, glm and multinom. o Added warning about logical predictors (suggestion of Kazuki Yoshida). Version 2.2-3 o Fixed bugs in axis scaling and xlim specification (reported by Achim Zeileis). o Small changes for compatability with R 2.16.0. Version 2.2-2 o Use asymptotic normal to get confidence limits for mer and lme objects o Correct effects.lme to work with weights o Added Effect.mer(), Effect.lme(), Effect.gls(), Effect.multinom(), and Effect.polr() methods. o Safe predictions simplified in effect.multinom() and effect.polr(). o plot() methods for eff and effpoly objects permit predictor transformations. o Added as.data.frame.eff(), as.data.frame.effpoly(), and as.data.frame.efflatent (suggestion of Steve Taylor). o Small bug fixes. Version 2.2-1 o Some examples wrapped in \donttest{} to decrease package check time. Version 2.2-0 o Introduced more flexible Effect() generic, along with Effect.lm() method for linear and generalized linear models. o Default is now ask=FALSE for plot.efflist(). o globalVariables("wt") declared for R 2.15.1 and above. o Small bug fixes. Version 2.1-2 o Offsets for linear and generalized linear (and mixed) models are now supported. o cbind(successes, failures) now supported for binomial generalized linear (and mixed) models. Version 2.1-1 o plot.effpoly() now honors ylim argument when no confidence intervals are plotted (fixing problem reported by Achim Zeileis). o safe predictions simplified in effect.lm(), producing correct results for mixed models (other methods to follow). o plot.eff() now honors type argument. o nlme and lme4 moved to Suggests. o effect() now works when options(OutDec= ',') (suggestion of Guomundur Arnkelsson). Version 2.1-0 o added support for 'mer' objects from lme4 and 'lme' objects from 'nlme'. Added 'rotx', 'roty' and 'grid' arguments to the plot methods. o See CHANGES file for changes to older versions. effects/data/0000755000176000001440000000000012236511700012627 5ustar ripleyuserseffects/data/Cowles.rda0000644000176000001440000000705412236512575014574 0ustar ripleyusersBZh91AY&SY?L$ @/'_TB% II#>) @^a2i2* zAԪGCOUJ 2h=@E&)OQ0j?J~MR4~44S!@ F OJi*OSJI& oߏ2 +*3 022ʀC2,La$a C(P" 2 B1$(b,L "0a@HSC 0 0B b0)`HF$L Q & $ &,9,d)"X# >>___3ɹ\D,B!2*0H1IS1& `I1$ ƒ(&1"%@"JdF0& F#HI%$0aF("PAa0QF &)aF!$&e@BB]IiFsMys@!y]fч@8߾Bq3JLzu <#gP۪]:,UƏfuD N? XHSeX<ߵL盭;{q {w*T f4ʃNˡM6Ԫ'(g  A v\M|h.j%=ct[mkx(v%| >tOR=gMik> z"gjlgF껮8*w"a ǷN\TҌXz2,9Km /!{i l ; 5iCovk1 ) (RQm#Q\!#5oFGe |S MV)d0|W旯q)O`"mDts.dpLhvg)&?N;NMǝn{y} ) nKabĜ.S5og4Pٜ'@HGV$muB4II4%ZAT6֣Q멽1(/)cmIEW'k{3LD1Qxĩ5]" =715RZ+fULֆB4HF&^qJ߱^j!fcKf~!vxL`8K 7ըAƎ 0bgh%T`!; c,x5Y-̻iYJ*6-ed6aqMmc R͵f XHQ!؋Uq.#`)Vj₝ә7z}9@Dwgl 2QzMsNZ vꓷ6$ݻ]sOCi+j61 7*_jaq皒ф,M"YHؠE9$Iq=RmAP2d=Wx{<(mFuWCSQjp52EK HCba1U*Ӈ#RR)WAek}&2E~qV]'fSk##|jpA:I@^~z`t)]8:WRyPcYl. o !:DWUn}(J=䋗W5qXHY{9c6̵kd]RM9-Χ9NN$:<ҡƏ[ ҚuvKש}mH Z|gҙ7ќh+FZޔ*haP~F8S28FS6"+MРQZD~V-gh6u%,k9_aSIrwQ%bpf7`,d5.~5Δ޳ 2###sd/ŧ2!LII>9T]萹s;[+73L^M\XCst _Ane" ve,훶@ B؄ _< 23əU=yyeU__sUeY̲3?_?G{YI$H;ce'l̳,VV%UfVX33*J̌,̬ϰ̲K,b̬UfWefYʳ3/k3,32kZGǏ_?????={{~k߿{{K߿{$_'i$HO7}{ y@www{^yw<מn{k7www5盻$]UUUUUUUUW$3333WUUUUUUUC^yw<מn{k7www5盻}{ y@www{^ywrI$UUUUUUUUJ$H'^ywylh r-6ȶ'"lh r/9$A5urI$ַrI$kz$9d[@mmNE9d[@mmNN3330urd[@mmNE9d[@mmNE9В sI$m]u]u۴[@mmNE9d[@mmNE9d[@mmַrI9d[@mmNE9d[@mmNEkzIU]u]mNE9d[@mmNE9d[@mmNE9>oOw>~|RlD8 83U?E dTO^m{P srE8P?effects/data/WVS.rda0000644000176000001440000002623412236512576014021 0ustar ripleyusers7zXZi"6!XP,^])TW"nRʟ)'dz$&}Tv>D%)#ʿ ^p!ޜcVAf%WԽG sgS؟yKֳzHD#7?|Kd:(apK>ø;__`Ӕ3rldE?ҚN:-5kcaE?raY|]\t*V|Qc߭)g)L{,ֶk(eM,V5XCsHᴵ\W(,qE=:&-d?hGaR"t >nвW`⦵qQ7)Eb7YGl%"YDREqMEˑ,M߄LjY;$ vߝ.S! ~JB) >H$G<,6MPtU?VYqlB|׶g)>󻚂x| » *40N{h-bz`*=) kz*7uG,o=mb'Fǚw%%[{{k]Z{yCM8/IB#uu| Y;Y@yk!"Cw=XVݗޖtN2٩?6zqSs/S5 m>},VoUw V' 4W_D^r=Dfh}^E,)@A2bW?M VN΃ >۟cd1{kpPgj`)mQ@8=&of;H181l]^stSuljß{duUf~8]EMAa9aPrzP[? 39œ. d0f:%o w`.i-e׳,ݲOAe`-ˈ@Ւiٗ2vT|.+'^u  nZPWfNGOLNbl22~PK OYel;bw=ɩY2h@*|OxlN$X$u PgpEuQ?cp[q#;Xp.W_ e@ױ" W^螈j滏U<$3p%2ira@D aU\F^Q prGB,-$M\]m.H(cTyA.2,|(3{~_܈yW( p^ѣQ_Zsc~eNP(Kv2øԟ=p2XG#/΂Y=/(3MWRܚ \~ iR9?,邍\[J|pcAAHwK^#qFp1p1xf}-u*!e] DНj@S6)L+$wj-֔?%5$H>*`JݵxT^Df޴U9 +W, 2>l)FpOLNGCO=l~KUD2Al zximb/aԍzK9MKǓ,H 6= A ^tT,|ʉt{ н!c[ʼNXE -Gg"ۼs.s /'5?ײ ~X篵Tl#AA쒟Ć7(~i;H}]6c m]/i'f0i SK7飞fG";DkDEs{o̖V`~w+nk9t sah_f2& 5땬^Gd`crIu7+#4/@S#z`CHle}C!~yvY-)y_d )aSXgs R,xJFbT-с)Rܬn>ZXuTr)4ԥԖg0J8*]_EzeOqU4 ʘK!W/*] ئnCIBJXt'H xgO'%.?" Q/ UqqH8 Դe=.@K؞U%<w7"!â4"jh'@gSe&$Nzz&@˽4,љ@Rre+1cl/j[|ȏ2E0M{hJśԐZk^e '%1'w:?T^;ng rv9`J ER+£D)G1xJ [ϺTKġpG"@/b]h5:6!jC.e<;$ Y~JdWyMd`aҔZVCh_B(V?8nOhoHhMRl{%dz/ݠW)@iIhԃ+ q8Α -J{}\Ex5Ve{C3r,Dÿ]@WڒENktDc1?R=LgKO9lg6Na݅uٲИeŵ$'#=Hl~bU7OSdj%vc4!&xйUkS%G3Ιh`,8d3Yϭ,Kh| iP#l-\gh1ysTZX<'KlF-dh7'8NR>Xb(21*{\X.U +B&$C9'o}/RH!C-)Om񭬓‹L|jpڍ8/ukr6vfxfxmz$/;퀮ꙓٱ:}?cǥzh(#F?GBz~0gAzQh*M-ը,KwnUN";I"9h{"0R3JSi\L t=ڑUg@⺴.(eED7N:N НN.Uk䢯Bzh].ǝ I4lI@tqbW>/nˇ!M~j4ߓ栬 xyd10\{RX׃(,̭ "3nٓm9EĤ7m7lŶ_֗P`1ԿXn ~,N;*+?戩AmER/K_%.VT w4=5EOMZRMvj$ )۬ߪ j,pS4͌H'NTnދ`=^teIώtʘEE^T9zꮽҫq-hsdɶ3$*jΞ2hVx^G}{<|XJVqKI  y7kwvJͤ;st~2%Bz&% \2P*6ԻI4 i3`s7.waq0zh0ڙ$*Jea{90vn3qGaL&WC1?L4SS飞@ luK#/ EeDNIs?a+01DJM<ҁSaqy׿kuآ3(' ckY\dy_mM{~å-YXOWy\kVHq|+B2)6е+=6%~'vf bÁ?WF\ U9rAp@b|c=st>7B=SH԰z>Sj'5zGZmlN  HY8w>8VBa-Q솹ųDfjtPP6X"&x˔:v{ kqI |[~+PC&߁j FD!:U'.48!n^%RK35rT٣9*lmsy!A͏pyt6{di5tϫr(O}{ȴ&nmחG}9z_3ޖtVkL V &%038QaVɢ_+_ƌrȽt۴=󯿇VGss:JdZ,*8X9o<8Τx=MRpxr+D1F~z#7v0ڤ?0W-M~.&4)nͦ9x}'1#h@}R!)WQG;(4 jmjoḁ.\7p-1(o0CHNqQZnB6zl:b1^FSa'{\.!oaiʱ|2\ty +/в2ryI~!dRllw燆80Ky֕1R0jX&>+3jVjX3q} zrRAEE&·G$1s\lk@T<>'z QY_7×OY_v%Lf'P[E*![&T4,Iw뒓Tlݥ I7TN\yd4_*Hxe 2|"~Mդ1 nxWd!r,<\)kBr͔p9=̷ S*c`ۇYǥkVdM22qWɼn Ż@,X/(1({[n' DmtQLowzH2k(J;51Y4GӁeeMC1HAމ (b!_CU~\ڎt&aBzyܼߚqZ&\ { dSe.K-yЎq jw`8B"2aXjEXX e C;vo,zF ƮW&41Md!p@;*.B }ay M `8`_ G\O !T)R|k/Nm&%Nٵ "]A,tq@@" 2‚0xvKr; `1 &]\XU12ENb-8=u`$xt|yp_e&B1 vbŧv-*:Mx+$QYޫ`NڵӡDIfKS >?kIc'u{N5)M}j-ǻ[kSp~:XѬr N>[J)4y-E*BNa{S,Sভ-Vkygr1e|]CYB2ٲ S;uEk9=nTE2sԚˊ,R!Y=M`m{S#phG2PJ/(ۍ{Gӄ"Mړ[7{VpYye8ξo+^mMWT#{lTm*KuUb$9>eD(3(w>E]mn4OgpT VTB׻ذ0L4kv]M[IO>]p x*–_a?ꎵ\|tqrUf)W$L6Ir$F LU4b [rKrX ].+k/  gvͶ#FRC!p@XC*[(,Um.~`ѩ={ 7=n?Ep{2?q;{VoZny9y&_?d51UkBWN#R܂$+_&F/mRPH+Y(#+Gӱw,iClp7==k*_ d=)>gN:oMc%AVKzŽ"rX%%J( @ <ϟ!Qԇ#u0=mWfbצ\dT`':E365صֽ.(xJ <d>rre㔰Tʮ:։ 9XfVfO~aUKyŧ&\S5X f&{rhtEݕS PSa҉&A| &ZOOI9M42[ }G1- wPN1+/&r' AqWgoJǴ4yn+v7XYˀaa-og\,)a;.?~b]eb,5o<@Q[y>_;% 1Q7coTUq7p q"amh^s@O =bDx!4+|r%*U<4Qy&'XFuʜ.A Pg"F|Qow @ޓicF*wTfdaXބyEUQRm^4\j/p$;m& Z^in&ݿCAK:d|[7T84|-8IYaW̑uɮtk Gc)$~({$룞Ύqai83$Tg@<ԅ RF?ck,d?^ u5ZnnYR PZ'H@!`:k:->-3e6A!z Sp y5 ۰\&pPAm0F/׿u2DqjۖHRvV.kZ:BHhgDz_/$6~L N;+2xvD]>ʺ-OsEo)n񗞾?9~3k : !>7 [8wTD1Ĕ7 OR=F!z_B"k cb[]X>=)H@u m~÷īJymN7/10ݴ_G'9JذNU!{pK.+Sqvv=+Fi- ׃.#RZփ! f~酆a+Apo6),P&"X>1(Վypk Ɓ/ LQ29} bL&쌐m5q6fUpw.́CbazN=8(=i5XoG09C%:OMpZ1^J7Ib(5BR(AƮQry~ǡ9;kR_,mۜ?AEf'#R 7̘OLԤ43ʏhG.8L:-j],)N׀ olI3c1-z|8Y?•'_1ڳ;bfqxݏon \qe1{p؍]:Ml?Lr_Hh&:G?euq"ޙp L!"\I< Z1L̪ʅ`{$ 񬦃3IG5bO:KJ oHDAB˾լ."Ax2[7j:AxzkJ>$^-7HyVVca[3i{浾S裌DVN/ xԕU- 5΂t}&zl'6!ӲZ4jJid(ʗoa:Y Aj)h%u<+Ҧ@4Qo rN+$FƓv5*Z,SdAl#u U_ĩ9e7cDʺ!FeJiVA }^>Cpّݏ!#XcFg٪^L"P 2o}mj=wF0tn^P&rmG zX;PXeM"J4{"8ܵWH!q|rKxc,Lz$-]N4}y8e(]Pp{ Vu$|&UP7Xo4ĸyBur=?/K@GG}K+Y=nb1VYR@5Kyā㌕X3 T՛8aHV)/T!׉шE L?oV_[K|}X,e 7zQ=4Z٪ֶv)2r;]"`pit1BP@[V3}urcO c·W]sT.\G>U]w 7\\Cu:kLErCPJ78,M,H>Qo=nיv1)Q_,*|Gst1{Jn$L! \kj&Gjk<}KP >0g,SJ珛zHg~>%3Eh'g^gd8e"LedHsY+hSq_1]֡˜nh*=s+~՛%(UR;kyQF!'K&”&N8 F"z'H,7G߸qpދ斆j1UH@JԪ9+ ;>X@EҝG5܉/8)"Jda~<㰂D{/z#,Z*R{q?ll&1ef^ t)Q`=Osȃ܆P#|UBcv\ZES:s-!W^G:, ⚗X F,|9|I ƖaR\ĄQ ͟S7ǚQse k($P7ڃ9G&cǮ(HFԑnj`X >0 YZeffects/data/TitanicSurvival.rda0000644000176000001440000003306012236512575016463 0ustar ripleyusersBZh91AY&SY|Z?P RPAE:7}OA W Q% @ )Dǥvw.6 2"-*\ܶ $"gcέluZt6"*۩s8883bգ-PަH@!2&"F6꞉P j4LTSTDɓ@44 Fz4I!"bjbGFhh4z(5|u~ɋ W&bF,wݖ)Ley17w\3v|ˠ_rڬ6{Sv2-Kc4{tΏW>3ՆwB:)~Yh;r~eB(Aj넳Ç^:vCg-ыgtT*zG3}7_{m~;| 'L}7~^Xoa_Ss=gg=<~ʾQr=iѬ0^Y,w͔ˬ{^df˦nuX߾!_W3[u~>Fq ]ާym-gۖVbߢMԷ/fjG "vnTRx-=N I 2!  FՍ#l!X$j6I"(DE cF"f ɔDZ(a&HLH&#fLL(")$fPFa I2Di hCQ2 (fFbiA6%12!#1IDP̘"(S2M2K1MCL$QFLME3Lb#EH4#\1 b"b,@J̉4&h4F 23 K 0 DA$ JLI%1($LHdX%3F M'F d Rae2L4DQfe$FKIF"1@#2JSBB%$Q"ȳ0JJAH42!!%HK6ZJLɂ%&e"fIIb!Ѐl?FĀH@ &OOJjZ*%նWI$a?Y37*_\T $HN?z(CXc~ü~onQ/WyρWT6ٸmS =f1~?/B=a0Tփ]`Mg:}P (ڌ<,o/frikYk]Yg献.ǧ7챿N:5N-@/8U;һixc8vr 5!5?[g!ֻ2:'~/fZJ麱z0*/{7zI\A g1u`fDD+Ծ Ց RDUqKp"/ZO}]EE2f}\ph7snh Ը~Ş v ;7۬˽^OVrX>aٕe?deWFW'㹸ʾnDEƖag?8{O3/=^ cq*X|[sr['  |#Ãg=^~?:~X|x-bmjJ=s#q^=}\~In͝^ vgIpx{[H7g.\ea\,T||i#K,yãK2hSkXݫ.n[Jǃ~6<6$BF ufliYV2 u wr_lB(6I_[m׊©_7aBWzs[> x9J9BN2ŪoWCsj`#jV.9YSRڥsumhDkκ<Dzs9[Poo:Egh(uuŕ{TDբkM 0݌igh rtZi74Y|2ѐ b).azHCңջJb,n-eUpEMŻZ4.zV-<d*^|Ǖ) :w|*#2s6k+;Pf:]Ky jprK} .t9b6-+3$z09lXtYoJbncU2\HK-%aٳq,1>dڡfg]ǖcchv(rzH)֕(@v榦g$ ($`\AFˇ6o[>ĹάqЭK.4 9+dY5ԛAa6:RHc/!K/I1]ŸegX[^bW툶7 6"VJ8g\p}ă o}4kW)Vx$0cm@ibL z +cWuD52TRٔ-ןL2xZ {DjhXi^"IQe*䪐J0 x$)I9YTGX)R9.9֛8a6g;r]֗qqu6]jWTpMpV_em]~Z…K!MOV]kZ:Y+N릯Ck-9!s]4  9SNxͣSR5 16Z|YWc1sgݕLwXTݤiljOYV/6KBN{xŬ,ߦ_n2FxwRLT#g{S7Czzu:}>wRozoUWSx+wOr7x(;ZG9#67|r9NƞӦؚ3Te|.4̈́NXqN͜pp0x1.;*p^-у͈eS೦[|oXޣo Ὄj|) Kh7kOVioW6ehyP!uM[[1}Xk֦zƼV7pnLH9lLb)ݙ4Ž_h0vO>1U'cY"H]4ZHz8>TS&E]V&یXBf r(m#f b^ȩ&%E (f,њј&uli2iub"P`))! Tjm0Vb(bfc!2+^¼Ih [ƹ\Me$Ic bOo& RJ(-ō15Fb`EB)Q24"fL(,LD5u$h11Ag}|ھm HAmojIjkU[ٽ'77{Kp׍\tk:ě+lrJLEc3I4'.sq݄sێ1$T*!AE3r1˕dt\sލ7]q&]ᮻc ^ǣ\БfQ$$pHwrH,p? L DD,ADC$HI& 1U  W1$겪F$0$WJ.]wW(DnK۔s\J4h4k'w\UeCo\(oBNh*f*J>iq6%Z9=ק{#d&JQJ8<]Ϸzao! EpίV>xdXƵVQϙl(!")Tn$E۬-ֿEy 7^y\>~)` !-DA@Y]}A+#դDW{5YGZ=̼#Őmۭv3+Ԅb^ia׳{}zkM1dh̓}N yK0HuX)%Z_f}oft1=k0zsjSZ;iODxcdt@wY,@6snobPКjeMC& ΒsM%bT+J 8u9¬2@\2H yg^ߦ;Ear2stz, q`kז+ڮ^7xC&k>eZ a U`0MZ[D`f$>[y[/4=܁uE $3cMhDL?EletYB9(c1L.Pj\nT#g 2gQ:SFs&ڣp>Ҁc QZ/MLQ#.1XR Z9sx ĿDlʼn.d`7R[T^[ "0Gno@kx$ j*M6s#FLJs;O+Ć2~YHDɍÇ+D<9 AQھd|Ml##l# 'F0DhR#*w[^xY%Ylk|9^zu*Ga# قbrHkZ ~]:3,j똟u EVJ9Fƴ< S ?[^A(G;A6)`P+ x%7iuu&6yYr^ʮ"k 4z^V ȏa= l4pN0.!w\|ŵCxrg <[^w/qWL6/KK.΁}MBsA$=]XB*F@>w~ihs L=. ]3,/a]M2F=Q_v n3,NW5!l)j5V;R~ ]hߙ}I#ǡ3e %wM% A">ջp]w2vb`PnIj7nczUӲ\VS7-9ӇՄiLy|vG{+MPsN6hO(c@j%FLW:'Dd735Hd6iWZ*,b'`Pcm58-yE˧GHKU;8sX3yJn08Sh,ve# eS ׇ3zNvyȀD/'ibp:њjí71m۵1Yќ&z$襝mn>'=~o6#Z~!bʖ5CBԲ]z-BƚA'XB=6ʄm Qd9Vti_,p Q@$=BIP,PɆ ^ڀN 2Z=h y,\Xm-\ఄ LgOBFNH{}ƂYRB ]qa9#f)_,3Un<{B B `. 2^U2sJl[!UA^))jNa /(6M[N?Vu 9e~0lᄶ$vEM*>KF3LMq?{ݿ㗩ܟK]@Bt |M[PkhE/ŋ ;taPG?n` <$;=<:<YkpM9mɬTj.9l(=IC`-M} /o{F/E̙<9`3. 3 8mv_f-KY fŔ (kuVQFC#Axmb1ܘ*J BQ\<ݾ-+j.z^6 GM7äǷM=q@(ewP7 ^rپ9?ς1'8̗i&QH@JOIw5qI3;ݖ˶w:/FU\yp3NԴD`*  ImH DMSRMy*e,/܃R;73PX˕UE4e@/0zOVC{bOiM{m(cr@ ]R% @Hz_g؈5$+Y=f˕iPйdDJs JMm2S0G56a mKSj,Y4AF.칷Ur"1Ei٬仏,UjK}כs_)s L}/):ڼķΥaH<䳎HR bۊE4GKY6^~[QFtjYaBĩOY *okZ!T`5(md8 ]?'k>{ۤ t"z)Ͱ$*>X2섢¨wzSI+dpLr@>2iM a,]-ZB z@Y+T˸>5aE"'|FC+YؠQRyya@\Y5grc epy4X qcgL{yYi1[39aoH6Sh_'~=gT4urŭӯuIyzꊉ8a|zrլ75j ^@%W2TXfj7lg6Yl1UT~{AURA0z޴,^zQ`iʎ$ I-(|B/Svxm oH;L;T@ Lq-[fΆq Y aVַ%W䀊ׂZ܉oskOѦpl:f/ w=r*VGi ޟM4qcmmWgM7TFMF 1ma5QHk)np#'37yvA>fw:~n.1ZC}$ȍǞ@ ;(n|TA_rmnU "!CpÁΜ|-I]̫0vR}PqRYplH@" S.Ce{+ 3t mқkI\yKn@+.gs4{-J]u&l$1txn c.nmh7e ̰ګ6$;eRY6%USkpX*0'AbYxM3:ܚqbW2شh,%ǫAΙl'[vU9BhDX`V#HY{Hn:8Rl3x4 +*9z1;a=ߤ3Ksqj'Q "шQQӳ:&@bcLfHnM$fֲDm.M1ӫ&MNS{+'Å%׿S=7^2jQR8vMGqr4SDl~wv;BCX2Jg/cԴ3 f{d,:)JP`Cm2I%OY! 3-Y'6[n!ʉ?RT)sH[& 0.68!OT@ˈb3d|;-z !U--Xe(JAmQKt;V4{W|*Gedj,qouח6[Ǔ/80Zg}Gk7EA{q4EIVG6T\3a[b~<!ȣVˠE"Hma!v!ZYjfpr}7T )l䕐T@cu3# ) ()aPry҃8N1sz!7j8b7*1[Z=*]0WzKPF E7ZDqE`QKZso7 NsVܴl <̠y4EރˬLk<W~ R| ׅ])59y(R<֙bŭYR/Ez#"PoKD^.A+ jgŮIm(bB.r !pD&8V:3CФ^芅B*[ 鶞zY]"R;ӫ\^xw|B<rh 90)^EwHjEZ<\xƉdŨ70. tz#D>IxE ƟPӷKdKHET_׼fؿuv;/>~&Fv04Ed@؂7(ʩ-w0Qa#~I9~qەv?: h I $ jQRPzo~qzh"AX$4V(E'љ{'<| LBprhZ(BAa4ܵP.Xah4ƉX;Xu>z)v_8peh?J^@46ukUҽ/Ucӹ6Sθ`}lUFqpA,цR½v 4)hIg`gd# 4C!HD`N2L QD!}g{qdΉmq c8CWh:=nY|gRׄ;pwקtr$uq 5DzЏkARLWoP1d!܇vLOyYRg?Ok=)8huej36u:;YmKb/"xj. _z _H9 H(M4%3fJ&Bj+\U1PYjS ű-"Y&d͐ _w< bdnʗT׹{3׭5A\0g$5hOAm\vZڶ6bI?=gS~>a8#UQj Ij,{jB!\,o—pB2dF3 vfHe@0B+KAG(>"& ]^Y$q v3CP@mț檙z@_Mmv e]n8_L!:_Kz"3qeLE{+-qzm4BJKQ$ w #ZȜ2id~mSr#j:i-fIJ҆F*FA‧¢1Eq/x Y T{0  qGԆ{ǿ lR{"V6#(΁ĢP^;rB:I?Lch* r7+$ѷe $`Ѧ4z/>tnj5ozHJ4GI{]pai8oT2&xK,E6ZlϓM!$7Qܸw8w# BI鰂6]εCxD\&tV H1@*\(EG! f͘.qنn,l>Wގ8 lUsAwUkid17 $2F OAf+%(0KJy5 ¬65 '6[`?#tXpd34DV{f:xjNHs" G Ȕwkϗ?uL+#p2\c8XEH01ԗuv._vx%trHWq+V?ߤrpuϿqOˉS6Ӯ.qJ'Xqqsm^>-Z_anW]b|E*gM7ngy_oO? r MzbOA ])TW"nRʟ)'dz$&}TD y?U-,9w=$bp+~3>?I?t@WK zmÞM`wzO =뿌u{J?VSV[D]FwSKyfJLM_V9*"6 x9_Ǵ)",?XƗӺc7dZuwSi~Yև?di0yhM3) dzTF<zV296,Zx[\cJ/Qw0RLOEq8`檀2?S7=96al$@>x)"&]To*nk؞x6A !I6|\i~~_KilFQѕV䅥%zm8:tp6I&I*BAǙ] ?:{ƌ"ؕyTc&x>SjXsj^ICpWؓo$\Da*s$ZM;HTkOI <ؖ 7SQPoUA˴'g4 ptdEGx^ =OH@udoƖϓ[BG/բoRZ4Ua=6j Wܜdnڏw id*Zg!2UbA, kfT߫$&vwf9e&I?|Et۞m۶4lC?^")~qPΕ6l )7Ny !l5(OKaL1p(ׄ*g>iM*$-DSc:g.(}'-#@c#ZXX@uzfvhs[|kQ@3MKbUST` Q"AqUIߓGu$K F7ҐT EYNwxU&{C]~aw}O;i[9W&IbX.Q,M?A0߭ 2S5ʼ'J/ v"hL!1^y_'k@{;q;xnT QPq&9v>K^ akց/v۱6SsTV:FEcM7oRAu"׹ڂUL!Qb2=^z3x؜;`p^Wñ׽@;}(W2gxٕ$U"{w<{3v޹ @bI@8,l2|bk`Q_I?{Y.z2wvkoӤI'S̝qAKi5Wy&wjte,)ey2gDxB?E\oH'K|,fP=/mО\V F5Fn=ZI8;C3_cVn80-F5~/rA] |uz_]/B'wOw{1YDH5SP(S貿WI M8verT<J~;췾|;#K_+**8E[^yyiapͶUŵȼ>DquN4lP`ٜ="˖8A:8 A;=I2ϰmC;CZ("GvwMp%h*ݤH?([q1nGcE*j jL3I5NM b-Svry;0+;禝I_C9_jVvS~طFZrK`΢'#;ExI7>`'nusԗ1b2qIw2j6z?x33t34'_\dr96Y%cC< I7jjs|43yS[Vc^ۏ{Jfu|.keV iGur̉OwY5g3lU򴰱y:@hCB  2 [Y{uƼx &8mUyb:7>7c ^^s[x{o2g:e X.!# * o30/?HE׍;j Ǹ ̄ !8soabhs^UK5't:޵ol =^ȹcj~Jw0 ;FM d'rTU#Y8k{dj1yx3iֈc5y 'a2l߂A\s>:gϿز!~/h1xH٠k/Nn$m٤Wz#bT4M;Nu$K7b,܄l3ڷ܍]{} CmCFۋ5/%iԍEXW$jۍKzP\5&4vGbD]'eݛg\C:t 1!ه=n! s*S ZJBT6@]gV cJm *J<wCx2!Yk !xh2^5kQwfydBz"i ?PA5hHI!?P=<.ytXUCާBF"U`'Z?+ M=];pm> :`]wSE6QbcxÌ.XoWa,y#\.x'9TV{6Yq({|@5A!x.U ~PĻI?kM7Eȓ/Rۿk/7؊{NC+`]EGu![0jWd%;A9 5D5!27q d}xBp]#R& vlF/1~-DB ʹz{| /cl9y({Bv1_?<) sO#7VH l36ev7S|ԕ] {4nx+w;&:r]zniy@f)ԕqmn+ij4iWgU\!P>AcJK s ύ|xfaMR OXt)^m|F/ӟ* .Kq^ZZ2RLRd^P.<1XAm- M]+tX]/odML!2JO7H&"DY(P\/UJun27Ix%EoG=疫>*.Td\KulEW8eB<*|$cg"SdLKEpFEm)reꕀ($E/i5&mue 7v H ϳC*.'fJA|[`BoK^%hth$WPH ACޜb\SP_Vt;Ic}«8uKUhY]9v3 Sat=Ӥ\&c{ &+yV0聄r?6Y p.+rp5F#֢*ZeW-m~XWlwܺc`-:G pAΕgjMIC(5h.jB m#>\]P\0;o> A`q!],>,:psE4Oic>|i}TtrX< L4 X:4;j.ǽVx=/)Ж]S ufrbH5 ,7^/,K"T@ڇ,Ы~;0so+=|@W-вjkCB4>hF:~ j+=R`ɳ},*m)#rO$?CJB;.#vcJSՔN3 ¸ȫZfs ~h3x(?9p ;ͅ "3 U0TܝalΧ NF%4ݮ4"֚`0Ip̬ZQx|dǦuc95yqoNR}+sWZ%MJ{nXc]@t * 6OulЧwh AY4T^q sM|#@W?t6 %Y)Fsu_2&&9) En' rpvJ(`ĞE6]Fck%0!=W4 Qd曀Ӌu'kY@4;gQ~^b LHe36fM֬|Lk\d@#r95 d6gID{lܵơ`PUIZccqu cd 3/G[AS8 2C3&Ү4Ŧ`WwLFX6; Xr"\䪷^b OIw7}-`h.؋kW"V<YC/'se6&q;gɧf07:XS$HԌV[Fc ,E %)b_ ewdܢht?_;Tp8 rr,Envw*eF$,6ZF1/[PnE=; `~ ]#24(&rM A'nP)N% KO1d?F:FW,.Qn\{?s x?r[D14Η?uuXjŸn_8tצ`L2 x9_㽫TK)18zـ~+{ˌ_84.OZL8+?yy7U9[n{ ) x#q$ :OYsfo(jTOIYh:⟶aǁW0zQMVm|[TBXf a"lD?`"9'-$E7mԦf1[t}{}'|AC VhTA5_~nz겕n'HB@q:ڠPU0Z]:uS*9X?O[,C:V2Y{PvΖ ;@iR/.X9. OQrCd>zn/_(`PϩA^b}H#~yĺSM5+WVDu 8{"6%+=!fl+' y4S6cc/jSU=F}^OwxonͯK<הKPFyd m i&95,*K/_l{k"6`dL`m~1Zmߟ_9@Ds~ʂԹ<(^|NX*U,f?elR5^+mOFlUD,b@Jn 7 1G&>i5qm/{pбK<]]=*\|TxI_| zƔ+luD#Pj nw~ro %;Ol #։9گ36_u l0ʽ3p(Mf~ b`Ty ڝe1Pn yQjލ'ŨOHYWv2kSOUf"kC!5ܾB+*«jG &PW(LknI0? G{^6a#SVn} E'BQ$OyW`F]k>j&8zEA4$VhUI;27' 8z!?kI̔اU S\9WhFҫE#=S,SZb1q{ox*)5ʽuABPbf G- 2sf D|ɿP2.rj ƴ(E^;^?uix[ #^ԾG9Ix4chp 5Ϝ;s\t6YJm1D|Q #K(DD9a֚*ٌڙ%yvI߲JE sGU\&[dŴyeL7?N:s@^#ݣKZp~?U rKUѭH*5dΕ ,n~TBQ.i.adLtt̶LX*BzB1nhL@A5C;@;WeŒFjr ~iPEηw~Zb?4$Y<n:FJ|>JܫkT0:*7} K348XF٧\\=DΖ&WR4|K>Td0&۾,=`ΕfhN%w)WWg SvwCF'G,M6^C#HO;;|A=q9r߬9yeA@H%].h?Ŀe1p`Io'?J_幝q1)Ø?u ˫{X V|K.Ur$j;]e֜)oOsH"{bsikKOKY|V)kuzO֚< 05 %LwRh0:]Z gW 0vpĨU!KlCB бZwYFru6v|fA~6&2lvAͱ0FEuUBkY޺J8W+Hd@E8gLw\9'b0IqnjNI`2c_q8Ğ)3Sc " <]~>l:p6BWA-tn,ddҿhe:Pdx.ved$cz)ص_ik4as%kVR`IJǜ03aMmzl߱ԑL3D)Қ4Cc h.U~]7,|4 ]}.Gʭ=iMd.oB-7c%fOD0C2B>8ZzXC[ҙ_ƒ`S7nEr%% V3_a^Q+gjj rY5^BzfD}9 h h DEc7Iuv @cOu*yyK b2'`T"j~ wT 'G  *9k8aj\zv1I#`َS˻4˴ 6M$q=Iʅ[o\ʏ,ʻ\pYu5wʣ+٘D1tl *%@2ťj¹ZN:f{j^{ k2XgYcX}BNB Ղ:m60|$"®M oVNqJHz 4.KޓqؙgŇ(i4ZÞ W@i2rp&b,拯.lKQElYqI$?}{莔Y^/dYWuVdyS&Es%]_w[D2Z[\I]˜sl襶"uglax?v*S?B8=)I6̫X(v}FSњ%Eu!ϼyQ>= 1+~} Rc֝2E:Rrjtte hO u&>W\(}[Vnw[@ˌW_EP%Kul*:H Z?IƠԞ-H1yu>2_(A]9$1**oPtm`Ξr˗ 5,Yٿ[!Һ9sWZ^hBz)pigs/|gYQZgQf[ ٹE0L=B_I[nzo#܄–ґaS؝R)1W]s8)k򈡢m ڑz6-< u2AdD}m7Bسk#lcfPBB܌˙ǿ9;cO?|+{]Q;?f ˆcI BVѕbB,#dl۽@mT\5zy>= 7ZV]F%6K/|s׎a߾R뮫ׂ!%-_.P(u=eQocy2BKuF[*#=@s"ђdU7'D]1_pI5#aY/;9JjRr&ƒoTRඏgc,Ƀm{֊Sli``$g*ށAy[9c`)' B!wGhiBnPU_ھHWW9Aqr@SChqe%TCɬl {aA}~(sRJhc+;&E8+UP,~fJ|(G:iSu*BA>+a]_lZϙ Mp?!lGgЊ~sEMhF6ys Cϫ~ qg<w5)(s߈ uZHD>FD$i܏HMoih-#*g& BntkF+Y'@L5…paC /T Qa黡M_ w:ɭpp68@DwTTK5u°+N4 h2L+ʰ>= ahgwCw92dT^+A Cgi)=53_66|:\%WzfaXKj^Sn|h2rk/s&@Gr \-4m-vЦkE‹ _4:_X]?s t{"qIKW|^xl顫6a 0ҭKj<,ǸZuIcƮ`) kp]uduw$ N=>m.i)#Jc_RVӌt-_Vj{SIˢ?e2!SϮ] /^=I)ϛ#T'{/  ;1ky`^hqL xzsڬQ zbE ]^U[ߎ :BqVuf<,Ϥ% "+6Ģe "[*+6TB4]'adT?=0ꆯ_ƴ|@=#ӯ=PQvi{$e]" ђs^E¶ 4e%T=gY)¼I1US-P|&#^n,ç^g=5#Mcھ>+AMAlSo ُ/q S-rc 9G -[iYA&Ʒ#f}ؗNҸ;Ms@eIH̺Ya@IʴR>y6 %t6 C$k)/IB-=m%QN_"L5^t1hBb.}D>0 YZeffects/data/Prestige.rda0000644000176000001440000000526312236512575015122 0ustar ripleyusersWklW?k{mo<ݵqgL'MRٻΌgf6UhSB ?T*PT$(/*DxTD- *D B{fgn!u{s=w1ƚX3?[𵎵Axc~v4S>}$}pv>|IefVg,X?2Lve\˒O6wح+Ye¡2~[g{j4Ji%>6uc>M~/H>_Nк-w?oHM])&4g3Sc[>ćpR|m P(~)A]z^ڍP~v熱wM14$c/0c6clel,= m}n۟ti\gl!LA15; c~X=YzWÚaglvϏ%X'#l.1؆q?5? ~v7q6A_ }ELbveyE^' Ch'fl5a܇ c )cM`"t A 9~o k1tOOws|xwKײ{!CnyWz9z]_m!UʾP5}\-H\~ާdސ"祗V?smrK޳~|[7IOOSO|<377Q{d|f'%A:_G3G-XOK=t?t~|lsEqG3LI9 W7\ZqƕR_ǩʢU8O3EuɸLz)OM+I}'ohk#곲^}x_yKoU{NLz}~+뫾^˾V~>Z^f խOicyc4&"&=ҽlQv+ve2;WqiJ0|=.|E;ϕceA8HKABiߜp8_%݄3IH[$ONxG>4 G>[ ?'Z`Ox3I\&\JrgcAq /a S< ?C3G#O>kPG%|_jxhAʍCp q^htBBv@& NFܓqwAV}vqh= s$z!ÐQ0!X MS:$C$$xIn$ F ]f.? ihwlC/ĝ TrzUsi1~ tgڎ"j9sr`~J`\\^X<~n\~jၥ`y+);}pqӧO?\`L𯚖..Zyp%z3KeH]8,RN_PĂe]4( S8PEQwrM*M/PG+qW7U(Z]+2q.ͻt˰Q  n(,>mlw*ýt^)<,̀f'vˡyLhiEYwVjZZthf 4=2a2퐙+^POp>5`;z; n8A.Bn]U׺& |,{%WA^v)V⸢p=_W&j,Ńwn!K)h9E^׸OV+!eHS-F(eDLvUw86oގu,kzZ;RhqzYX===Xg~4Nױ !VЄDqlj8벑h`&e5bLh8G+nD݅_ ] VVપ!ĆHj$KUHus|Xآ {@^Z7q9R(hGaI:NokSx[sYtGtH-nC&h{ ƶ3sqϋ}^m#xzĨɫ9[F: &Xgl%ѐxdek_-w5дs_W#aY'o4y]ڈ0ᐗj^nIO) om Ŏ"!g5,Ip^~@5ϱ8g-6ÌopŬP}k]shWwfɝh:Hjf gL%58RIwVݶdU\XtMmTʹpq<ںa/δng;sׯHa=>7 ,U{DZޫKEaeffects/data/Arrests.rda0000644000176000001440000003130412236512574014755 0ustar ripleyusers7zXZi"6!X〳2])TW"nRʟ)'dz$&}T;~k5 :@aip< S dkzb)ұHPlM01_0}E]k GsWU) Q9,{bu2qdohN LCۀ?foȾf*z @@Rh@a,-YQz-rv iPӇi@0q܌15Ka}5CZf=8 ,'/s?Y5a?hK)+ gzJfL@ۤ @ 惏~nhYSq I SB]:kbB{#"+d]JhI_,A ܔnۓ7XL3Ug#T\*5:O4_* ˚8hcTӣ^`PkzQRέ{] QA-lopz@|s͕Eяi,̩3wYC;~ĹGEضsZ$j0d7Ӕev\lF8@Gp'3[6W ohWt8Apm2Sm?s&* =$%?:߈9_SrjEO>- h3:y )OfhIm\|B=27sȰ\2Iew`b1lWF!61?uOڵδ 6V!k^-c`Օb#nW/ƹ7(9rza#zNӮeWSs/ͻ!D(؅ qC^p4so\z_Kڡg?ۣoQ)G+O6'Zj<cI嗫Pj/9iw71+`k<.M` u塐Дjgпe7ck HR Ry:CiQGl!1IN.zݍ6o)slgXx%[Qo7%3[\U-%,$p >F.[i­wu<`V׷PW{`6? G̎9^V_a+!JpKP {e!JynfbG6vzk-* 4^R KS!qsL2@0n++wYu}ΐS{hɭXμ 7q1%W4\ ;{YZEsXq4AH® ~7f,xDGg'Ϝ:xaaWȥ(߷WӚ1TFbb p&+tҌv܈,\8u>A!xE=QD5lfq}b"Ŏˤu@b j"4xRx@9/󒸱d;B^R wWŦ>^cin(iyqwtΎ?E c9Gɷ7@cI/6`)/mљT$E^M,Ƽ[^] dz]}z×K wJZ hp{y~ǐ<9v4֚>#ɵcgqTr>:XG 1E.q_F1#`WI1MuVF*w6 h;"!PY_[B n$T``gkÆ&jQ9W!.~fLPA)ڂ͛bX#u^e1 %v~dVGrrThӟ5:7udžIw!]r`g2j2 Ԝ{P=R6=gڤaS1 ߣŏV=6dOz~fr*6.&YYk=w(-z¦@ĮC X 0*}:uL}9e7~(9j~ƽ?]Xme̶i yNa_`b3X͸f6曟Ufx^{ь'hbmfwaD]t%B,4< KO.\D&`SD8驐VRCw W$yo8 udL= P)Uս9n5:GXck+j{4Qد%|mwΰN_ ID#3 Yi^!{Lu0_bb|,ajxdK*>ˤ(At qp9rHk7& UfR<35l"'GfDvhs<{ʜlQHvP-[jE1e:X"{b9EM Y#AaLƯi\[;֠tǡ7:yrCXlM#җAIRAc~pk&P"OH v,^,8L$DĤhDU#CK|sgnidFE+o}W` ݮt{HNoZmw^'*$|& חgHj d< vzGg*ʝDs#fvDFr7@ +zef=479HݹL9*A[; unn+w)P.O37OV;sM*6fz" Nhb`;ߜX߻; j96t{O,stQf"P'PDq_an Pd;JR!q0!\Pˑ?fbUu~oSlX2/{| Ec'sL5!TDfxpgn1i$1 Ɣv{Kbje떆< Ti2bQƧtjG}*aP>YV6u7 zujbt^Z}a}kPmh cfAK\W3h(/Xo@_ď32 42jrkC'Gnۍe He'`:m gm:Oz(XBG8n ^{zL9#&~wԜd0r ƶgiRj\]8I?7;!:,,]Ɛhfik>hx61Y}"%%%c8 v@MBH˚f3-)&YޱE)tgj X 2wovLrSn!ԁMH\긘)Ng!v}Ή:Ji'*|' w3 .\;Z<'dbH8{>%)@X\6H6lkt`I.^EoeKoٺ7 Eh,țIJ 06: ]k%Hcz'? t!7˛ s ،Ils@<0|7v: j>4q? B.%bzp&v-$[:κ3ʉ7 Lu7VmUdgkN^nGJ !£?S%ğ*$,lz>;փ5[ɯ[0x1r?wz L oġd-tK`O7%Ln~X1B8:RP8;l6A!A #osExsVoD̴2[ڠQ8h흍Q*13{n3Kv$Kٻ&~LX$<2/Bx,wznyp; ԉfu ^iD4mbиۑ~@>hEo#6RVX@\Fȏn&El\ݤz({H 9ݢJSm]d4|\'o2;Q aQ`(堣4͘>˞w#aZ,җ>ZTcL<V'M(v}J*eLpl֨b1?]GQa% mIFu.L$5m =cQ#f=tƇ  L۸D/Uvl5̑wdѨwNlG cgP|dr8ÄꆶOAUd>}ryL[ե([;Ve[I$3b8jldzL18ITޟB̪t Av\F<}kpt^:0M];S`{YL1J Xco_iڬWtr""b) n{ӝ*ɍ>Tdxu aLwL49 "=fNnΉO)nLS㏏#NμgPL̚dteo`bLb!(ݡ:ł(X1!^ 5s9[#Eub QܗD7B4 -b dX!T*MHR%ۺ9"9{rփz#:N 0~Qޘu񩊼Mc1{D3qɬ!?g&Wv\VZ'3"jH~YW*w ~ Tdȏeis621, U&3k#8%iz r3xYm+so+ SZ(Ja4;QYw>O/  ~Ǹg]uLpvmF@Dx,yր! _5*قͮj{ XH=QW[E.i G_j8Y5=VBT w;;V[˻Nٱ8A'Dz-)Z*?M#Ug2)",*YBR}^!:g -abj{$庶0|ClǀDk>FhC.Y>7SX2O3UzHf2T{ݜ*m+%eWHnCcTj86s>| ==>I9r(8>J ZĮ:V,Di\1N.bNRݢ}"K<ߑ@21YkQXdS$E4:TG ,GO៪.!a EH[^wΰ%-y:H(N1/#a.#H iFP6zZ#M5>[ !TSJlr.՜w)F@;9ճT['ٌRYȈ{#>mOt ,5^/u݉_CoXF*k0B͏Džd6+Im(^KyLdroiqV [}?ʏ~ sݤMaOz﷎k({R''D-z!"IݨX飂'&)=+F\0V0:i)dёEp;hP2L^]5\ _SɆ9b_&ϓ= q_ (?gОf8k6nSs5+#(͇3.g[T%Ҍ% DNtz:Bv"] "*P5G*$0~ ·a]_-##;ʫʵ jfN,GYHŶF!tS ?LoJeo|qr6[ ]i%JW LW]cWtݗJ"c,;!pQ <]:ZHa :s&2V3kZa<}<.dǙy6]Z2"LPl2 [ԃSb/[׳͂m8 8ڒ{:)5{ݶQE0kl:#z݂gy'^xh-xjAۿrFZJtA 4wF\FP&_! N ZڽiY:SbKsKѤc{1*k#S/N[*zHy/ai<yM5t(T"~v4Kpb~trі!ZXrC|2[~24{S*Yrñ\~'/C6i7u}LoO#܃6kOr.i]D]Jъ5f73pyw%8Q-OCΤqGgx0搈g.b+OO^ٶ)ZK:!wv.(}"'4="va͆]Á$U7.4ё_2s~L_C JW/c1hْJ Piz4Zha|u{K,{]M@ $dڜyⅮaseVg7_ʊ,-rYFIre:ӏŬxzή"cx$,jfV*ᓧc47e;{]NGdB!"$'K7A|N),Z[Wt4+o;Rd}Wf"aAj J`LGxf=)%C3O͚mmnKm^.=5sV^u*a hN81{sDDWFa=VTBӅD g.w{پgJ[ҽnri;g{!4 BXb%Y'.<lh^h%"lF0*l޴wo#pKXƦt5~ŗe ՝ÞlB>iu[lgJ<1h(n [<~c}5Fp)6@ jh3`q2v9q}bU@{^w@#yYGU{b?a.LZ b|禓~ )(&zIY6"}ӯi}?۪llȰĔ!{յj.!ߑX;vMPFnqP@LÇyM4X3?SO'6aU USxmKEI6F4hgù4z7sog;XRt 5%Rzvx1^V2LhJ>tɛ6!&tqKZӷƋ;nZܺfnmt$ܽ@fOK+)Ur^w1xD-Uoӷ4=ϝa}}V0E;G[w6Ẽd9HNG5,*.pV_n]ee X Ȥf"YgļVQ?Չ!'&J-D̂_ˍ~w~±ڜځΐZוziu^0D_'V*Kkbw?:`ۻy 8ǜwI-sߨ'M@ZlPqvLA8УM!y^4$tv,$щ EH'W M<-$L&ї`9vTVt+]l4RB@iuto,&ZmY`M/jߨ (7Oc_ٴU˦%*88s ?gع07=u܇ŗZqzHUGXA)t-B\ LQ>D V%T54WZOQRӈ#7dtOC@ Q'd`Hs;&۩$Hژ(d,fr:ad1NJ;`%L?}\N(wpLnF;,dN 0= Pȸ&1]PL6Z9)pFCTk_'Q*Zv#~jnNzBxe5!7DN_l7alf3rEOGEL@} ҅;lN([\g;c7!׮q !s_E#")dG^h_Qzr3cT``|һ*g-gKl J{uBL$Ǯ^/{y015+_J>RHaP>tRY{BfCDo3=ÊK x"l_V˜W择0 v<@J^ciblpm\%sM,%M܎y;q{>sl ۇ&Iκ ~0:H-:{R}PJToM59 F\2̸/puf ;kV? x0e!41=k:݂8Qn3tk3_w~ I,eac2*Y}sN(j.(AxHF*ڴX7x\=oko&2߹ml ҫ!@Z-kr`+/DWhsx8rݓIn2%R< %+>b%IFE%8p,\ |,@|9m[Ia1GEU{Cv ]+#!]:3hR׬fج(x&ᕚ]E  ;zq_Zbފ0v 7ݐh9z=VPxUYFyCObB]e%`ry7sjR'tjuqdDi>R}z'a^qN֜Wsb\ZpLGoxxQ1b':bT51zDuҐH.~3AԦ>'gӜE)ˑMU9b0S9}Vlf:Vn~O@r+'px$8}2c"SU. cmCϹ,n }kgXztRVvlY(Lģ`5 iW٤ΡU]0Ό4w /oQ֝"qroufyep%aBsH%1yU] )Z\ 8 h]# D\~:R$|12IƏx*vy]icSIk7;[+P5yUl/msK1.]d {YQzҬi}@MdV LWTxس_Ü! nl/EU 0EXĒr{hތn;Ū9?9<ٔ<8j ' Ȥ`hܲ$O20V! ~_>WRΠiFºH9WGi? ⾈vA{˦TI˒$]H3$j>9KXџ~rȃA ftī؈ˋeg>0 YZeffects/data/Hartnagel.rda0000644000176000001440000000213212236512575015235 0ustar ripleyusers_lSum&$ i{ۮ p 6:]- Ą%,cn(( "dbB_X !!A`3>x9{4wR^^*/xTZ#U, 2JGԃF`LN6x=}`?|#18#p| 398'F@R-Jgf` {p-` oOց&7`1W]'tn<Χk`n_opቁ3NӺWep]=B=#`  4^gfew.&f7u}{9KHF7s >WbìqmHge> rߢ q~'O)֯~;m#6䭥NsK^h]5_)}'}׳\qY;Ŧn+yNJߤ8W;༝܏y&?*yk٧e|qu=_zn[oՇ:!"\/̸>m|3\p^}"g1nO6o xNz}~G_ϛ~<1ǧf?߄Gs*d[JR_ب茝 H7bw쑹*9bw1~}oJ\WK~!pcaVJ^W>-v CRW~g;Իž8ϣ&y( ŕ^q{k,}^M웻"u:ynyr\sg|0)b?pxaoc> gRp)G^Ϥ}v#?UuoA,k-NΖr^ 9äR0:MRlsQS~-pciNH;aDӪvx- 2mƋxQ hXF2Ѱe4,a hXF6Ѱm4la hFÎ.#݅ effects/data/BEPS.rda0000644000176000001440000001563012236512575014070 0ustar ripleyusers7zXZi"6!X3[])TW"nRʟ)'dz$&}UqYnl{V֔ t t zNcGGMpd6i}ڍMˡHʋ qRäX OO?(Mk=y!BȖxnAN AzGB)`ɖ_g DD8RB9^y\hЂ{~$rg&]FlU[S^B2r _Agc?.w8 ÐK_ y+6N ėzN¿<ԛ1S*ĥ}O8x]Gh,?jAh}m4h7 5Dn,yhAuAkbFX۸VaamrJO تknmQZ~Υpegp_~ޛ1'Jt-d/}șj Z1$^}l=fao2uL߱N0|ߍcy#?fZ'cZ)q\PnL?V+IZhn(-:\U᠊Hē[5M$8@$x}Id֣ODBAc=YI$.eYrL 9 F x3x}G/\o$E|rΝBYmv:/)goM`a}B>;\ġ8Y:p~2D?-XW$t dׅHY4 G?la)tմXyZU iQ.oɬܹ>wD?mѺv|&߅<a%L@QVIv4qh cr6gG7Wk?"tAoևxC]EgDŽh0:jB3.8m?Ʊ㩯7 _Тu`56Sa- VST8Vl# ڔ0gjrGpI!qxFtd ^ IP9(T_@gV 3樓h?Ѱ̆ޮ@e.}_%Fۦ ~GR Jt{:Mt"* -c!N*ke0{wFdBluG?0"=Dt}U] wNj4)Tˆd&"> ?8E OnIiOe׬sXPAUViq+uui2;v‰rglq /0X1:^F b ZsjNnDIQgsThC:?qbhy=4s"}~8 $aV><âg ك2c0 SXרQfkT$kdN0T/*j! }tD˲%{$tԧKbX-Vg2s="v`n6U%<2A$+1Co(Sf8l.$M 4Sg(A|]YqjUS0'=o~Oyf0dm1L9UsB3;~g^uN 1B/TQXuÍTJpQ)x$6>Y-g?ݫa L5V'Ttc!|k}/[EJe<(Ԯ*$BVMy!-?a? ϸrY;/;(NKX,Jk QqŧP \+O9Z(2GLJU78׏T.r 7j!3ZwӾ}!`k0]X~`.B\%atw3> vKx$/r$` u }QKҾFs1˛lv%bl FWnP$ז`_,F8/Hl#4|ѓxqeeA-a;L_*ļ@ۆq7a=$"HFUtA;p7]y{WVû2PVrSo,BOg{͘nESy(j"S-DRB*ϼt܆huOീK@>K/R" J,Eh'E;-TR0rPv~iX4yo\?Pyk<ѕqcR'4]z&?S#Bȝ"r{)D28#4hYl_ZyKzgf_~ݥ6wd%N) @ G9@{:g[ -*)l*S2MW-}I}.RWW`nY\!>O\"`ưit6ROjw{{l8 zE~1?Ju|ː܇zYFp1Vy<2GHd?KI}:o+yA|I^Jg?6w>-k+'q<˥BNIv8ޔ,nMEyiwR>UҖG LXq%6Pb񔈛gw{K7wYq9Trq?cAvQaAɜW,< &Aq VKǔНJ@^{O45w8CU ^F4'DR 1T(iUMIfKCPbऺk&P?*܅i2|a@eTcU7l !{wJ"1~PdE@W&0D"U "{ʓn\a@(P=-kWw\䬐RC(ʷc6!^H;%3vu}Z,/]ۅߟkqkODURe`R%>v7SR?I訋r } ՍC-U!l+_gQ`t2\m(C!MW?l [lo]#3^&yc;;^iR:хA<i{)/m=CG^U!, -9_,!̞efs]UxWꢵ/cQ;É6S^~X[j "Aea}di%;{*=^0Hwiը&sFSI-gBmDzfm Ư,DW|\}nL3j\rI(|Y'['>$~dgg>I`r1P2 Bp 5/Yx=9T{&'C/cjYHa0܊]ġCO In\qB 6U8KN.YBV!{O/x4u}'miAhP3Jc(KGANaIWCQDs6q_֥Xϰc 2{N > U&Wi(ErC`?)I.t7Tci-zȨs GS+VBDb=z{LPǤA__Ȱ[AaSuR{hs@ wdruW*fTZTѝ ^[=}--nۿ 2L`!ΞҮ_^$o҇ UYM& 9U',ZcE+{{RO|=6[ M#Kt)M*?fk^[#7/}(3`E~];`|\{CƯ[(5v?9KӶ/ž>{@*W1AG*Nƥ戸Gfq4y38GMQ/Zq`-秼w VR}B@ߟ-6%N@Ça.݊lW1S/5z|Cbpț0D u 36NbLj!*#*f9D|b^1mr# 8tX4D!=B{6[闢%34yX/r6\6UCO<]]-%(|x\?atc'e=WͲ7_C;@lͥD\+{(^PS9UGѨG> J$ ˼7x"k&tPپJf: MU#~Z6)2ٶr}=s -yLz :cݒfCUYh ЭۓK0CI˥CJh9;n6X>0 YZeffects/R/0000755000176000001440000000000012236511700012117 5ustar ripleyuserseffects/R/effectspoLCA.R0000644000176000001440000000363612236312350014550 0ustar ripleyusers# 2013-07-31: extend effects to poLCA objects. S. Weisberg # 2013-10-15: removed effect.poLCA. J. Fox #The next two functions should be exported to the namespace allEffects.poLCA <- function(mod, ...){ allEffects(poLCA.to.fake(mod), ...) } Effect.poLCA <- function(focal.predictors, mod, ...) { result <- Effect(focal.predictors, poLCA.to.fake(mod), ...) result$formula <- as.formula(formula(mod)) result } # this function makes a 'fake' multinom object or 'glm' object so # effect.mulitnom or effect.glm can be used. # effect.multinom requires at least 3 classes, so if classes=2 use # effect.glm poLCA.to.fake <- function(mod) { dta <- eval(mod$call$data) form <- as.formula(eval(mod$call$formula)) # find the missing data: omit <- attr(model.frame(form, dta), "na.action") if(length(omit) == 0) dta$.class <- factor(mod$predclass) else{ dta$.class <- rep(NA, dim(dta)[1]) dta$.class[-omit] <- mod$predclass dta$.class <- factor(dta$.class) } # end of missing data correction formula1 <- update(form, .class ~ .) if(length(mod$P) == 2L){ mod1 <- glm(formula1, family=binomial, data=dta) mod1$call$data <- dta mod1$call$formula <- formula1 mod1$coef <- mod$coeff[, 1] mod1$vcov <- mod$coeff.V class(mod1) <- c("fakeglm", class(mod1)) } else { require(nnet) mod1 <- multinom(formula1, dta, Hess=TRUE, trace=FALSE, maxit=1) mod1$call$data <- dta mod1$call$formula <- formula1 mod1$coeff <- mod$coeff mod1$coeff.V <- mod$coeff.V class(mod1) <- c("fakemultinom", class(mod1)) } mod1 } coef.fakemultinom <- function(mod){ coef <- t(mod$coeff) dimnames(coef) <- list(mod$lab[-1L], mod$vcoefnames) coef } vcov.fakemultinom <- function(mod){mod$coeff.V} effects/R/effectsmer.R0000644000176000001440000001160112236312350014364 0ustar ripleyusers# effect.mer and effect.lme built from effect.lm by S. Weisberg 29 June 2011 # last modified 2012-03-08 to require() lme4 or nlme. J. Fox # 2012-10-05 effect.lme didn't work with 'weights', now corrected. S. Weisberg # 2013-03-05: introduced merMod methods for development version of lme4. J. Fox # 2013-04-06: added support for lme4.0, J. Fox # 2013-07-30: added 'data' argument to lme.to.glm and mer.to.glm to allow # calling effect from within a subroutine. # 2013-09-25: removed the 'data' argument as it make the functions fail with # logs, splines and polynomials # the function lm.wfit fit gets the hessian wrong for mer's. Get the variance # from the vcov method applied to the mer object. # 'fixmod' is a copy of the 'nobars' function in the lme4 package, # renamed so it doesn't cause any conflicts. This is a utility function # that should not be exported fixmod <- function (term) { if (!("|" %in% all.names(term))) return(term) if (is.call(term) && term[[1]] == as.name("|")) return(NULL) if (length(term) == 2) { nb <- fixmod(term[[2]]) if (is.null(nb)) return(NULL) term[[2]] <- nb return(term) } nb2 <- fixmod(term[[2]]) nb3 <- fixmod(term[[3]]) if (is.null(nb2)) return(nb3) if (is.null(nb3)) return(nb2) term[[2]] <- nb2 term[[3]] <- nb3 term } # lme.to.glm evaluates a 'glm' model that is as similar to a given 'lme' # model, in the same pattern as mer.to.glm. This could be speeded up # slightly by using 'lm' rather than 'glm' but I use 'glm' to parallel # mer.to.glm more closely. The differences are: (1) match fewer args # in the call; (2) different def of mod2$coefficients; no other # changes # The argument 'data' to lme.to.glm and to mer.to.glm copies the data # from the object into the local environment and makes it visible when 'effect' # is called from within another function. lme.to.glm <- function(mod) { cl <- mod$call cl$formula <- cl$fixed m <- match(c("formula", "data", "subset", "na.action", "contrasts"), names(cl), 0L) cl <- cl[c(1L, m)] cl[[1L]] <- as.name("glm") mod2 <- eval(cl) pw <- attr(mod$modelStruct$varStruct, "weights") if(!is.null(pw)) mod2$prior.weights <- pw mod2$coefficients <- mod$coefficients$fixed mod2$vcov <- as.matrix(vcov(mod)) mod2$linear.predictors <- model.matrix(mod2) %*% mod2$coefficients mod2$fitted.values <- mod2$family$linkinv(mod2$linear.predictors) mod2$weights <- as.vector(with(mod2, prior.weights * (family$mu.eta(linear.predictors)^2 / family$variance(fitted.values)))) mod2$residuals <- with(mod2, prior.weights * (y - fitted.values)/weights ) class(mod2) <- c("fakeglm", class(mod2)) mod2 } # mer.to.glm evaluates a 'glm' model that is as similar to a given 'mer' # model as follows. It is of class c("fakeglm", "glm", "lm") # several items are added to the created objects. Do not export mer.to.glm <- function(mod) { cl <- mod@call if(cl[[1]] =="nlmer") stop("effects package does not support 'nlmer' objects") m <- match(c("formula", "family", "data", "weights", "subset", "na.action", "start", "offset", "model", "contrasts"), names(cl), 0L) cl <- cl[c(1L, m)] cl[[1L]] <- as.name("glm") cl$formula <- fixmod(as.formula(cl$formula)) mod2 <- eval(cl) mod2$coefficients <- fixef(mod) #mod@fixef mod2$vcov <- as.matrix(vcov(mod)) mod2$linear.predictors <- model.matrix(mod2) %*% mod2$coefficients mod2$fitted.values <- mod2$family$linkinv(mod2$linear.predictors) mod2$weights <- as.vector(with(mod2, prior.weights * (family$mu.eta(linear.predictors)^2 / family$variance(fitted.values)))) mod2$residuals <- with(mod2, prior.weights * (y - fitted.values)/weights ) class(mod2) <- c("fakeglm", class(mod2)) mod2 } #method for 'fakeglm' objects. Do not export vcov.fakeglm <- function(object, ...) object$vcov #The next four functions should be exported effect.mer <- function(term, mod, ...) { result <- effect(term, mer.to.glm(mod), ...) result$formula <- as.formula(formula(mod)) result } allEffects.mer <- function(mod, ...){ allEffects(mer.to.glm(mod), ...) } effect.merMod <- function(term, mod, ...){ effect.mer(term, mod, ...) } allEffects.merMod <- function(mod, ...){ allEffects.mer(mod, ...) } allEffects.lme <- function(mod, ...){ allEffects(lme.to.glm(mod), ...) } effect.lme <- function(term, mod, ...) { mod1 <- lme.to.glm(mod) result <- effect(term, mod1) result$formula <- as.formula(formula(mod)) result } effects/R/plot.effpoly.R0000644000176000001440000005414012236477134014703 0ustar ripleyusers#' Plot method for effpoly objects # modified by Michael Friendly: added ci.style="bands" & alpha.band= arg # modified by Michael Friendly: added lwd= argument for llines (was lwd=2) # 2013-11-06: fixed drop dimension when only one focal predictor. John plot.effpoly <- function(x, type=c("probability", "logit"), x.var=which.max(levels), rug=TRUE, xlab, ylab=paste(x$response, " (", type, ")", sep=""), main=paste(effect, "effect plot"), colors, symbols, lines, cex=1.5, lwd=2, factor.names=TRUE, ci.style, band.colors, band.transparency=0.3, style=c("lines", "stacked"), confint=(style == "lines" && !is.null(x$confidence.level)), transform.x=NULL, ticks.x=NULL, xlim=NULL, ylim, rotx=0, alternating=TRUE, roty=0, grid=FALSE, layout, key.args=NULL, row=1, col=1, nrow=1, ncol=1, more=FALSE, use.splines=TRUE, ...){ ci.style <- if(missing(ci.style)) NULL else match.arg(ci.style, c("bars", "lines", "bands", "none")) type <- match.arg(type) style <- match.arg(style) effect.llines <- llines has.se <- !is.null(x$confidence.level) if (confint && !has.se) stop("there are no confidence limits to plot") if (style == "stacked"){ if (type != "probability"){ type <- "probability" warning('type set to "probability" for stacked plot') } if (confint){ confint <- FALSE warning('confint set to FALSE for stacked plot') } } if (missing(colors)){ if (style == "stacked"){ colors <- if (x$model == "multinom") rainbow_hcl(length(x$y.levels)) else sequential_hcl(length(x$y.levels)) } else colors <- palette() } if (missing(band.colors)) band.colors <- colors if (missing(symbols)) symbols <- 1:length(colors) if (missing(lines)) lines <- 1:length(colors) .mod <- function(a, b) ifelse( (d <- a %% b) == 0, b, d) .modc <- function(a) .mod(a, length(colors)) .mods <- function(a) .mod(a, length(symbols)) .modl <- function(a) .mod(a, length(lines)) effect <- paste(sapply(x$variables, "[[", "name"), collapse="*") split <- c(col, row, ncol, nrow) n.predictors <- length(names(x$x)) y.lev <- x$y.lev n.y.lev <- length(y.lev) ylevel.names <- make.names(paste("prob",y.lev)) colnames(x$prob) <- colnames(x$logit) <- colnames(x$lower.logit) <- colnames(x$upper.logit) <- colnames(x$lower.prob) <- colnames(x$upper.prob)<- ylevel.names x.frame <-as.data.frame(x) predictors <- names(x.frame)[1:n.predictors] levels <- if (n.predictors==1) length (x.frame[,predictors]) else sapply(apply(x.frame[, predictors, drop=FALSE], 2, unique), length) if (is.character(x.var)) { which.x <- which(x.var == predictors) if (length(which.x) == 0) stop(paste("x.var = '", x.var, "' is not in the effect.", sep="")) x.var <- which.x } x.vals <- x.frame[, names(x.frame)[x.var]] response <-matrix(0, nrow=nrow(x.frame), ncol=n.y.lev) for (i in 1:length(x$y.lev)){ level <- which(colnames(x$prob)[i] == ylevel.names) response[,i] <- rep(x$y.lev[level], length(response[,i])) } prob <- as.vector(x$prob) logit <- as.vector(x$logit) response <- as.vector(response) if (has.se){ lower.prob <- as.vector(x$lower.prob) upper.prob <- as.vector(x$upper.prob) lower.logit <- as.vector(x$lower.logit) upper.logit <- as.vector(x$upper.logit) } response <- factor(response, levels=y.lev) data <- data.frame(prob, logit) if (has.se) data <- cbind(data, data.frame(lower.prob, upper.prob, lower.logit, upper.logit)) data[[x$response]] <- response for (i in 1:length(predictors)){ data <-cbind(data, x.frame[predictors[i]]) } levs <- levels(x$data[[predictors[x.var]]]) n.predictor.cats <- sapply(data[, predictors[-c(x.var)], drop=FALSE], function(x) length(unique(x))) if (length(n.predictor.cats) == 0) n.predictor.cats <- 1 ci.style <- if(is.null(ci.style)) { if(is.factor(x$data[[predictors[x.var]]])) "bars" else "bands"} else ci.style if( ci.style=="none" ) confint <- FALSE ### no confidence intervals if confint == FALSE or ci.style=="none" if (!confint){ # plot without confidence bands layout <- if (missing(layout)){ lay <- c(prod(n.predictor.cats[-(n.predictors - 1)]), prod(n.predictor.cats[(n.predictors - 1)]), 1) if (lay[1] > 1) lay else lay[c(2, 1, 3)] } else layout if (style == "lines"){ # line plot if (n.y.lev > min(c(length(colors), length(lines), length(symbols)))) warning('Colors, lines and symbols may have been recycled') if (is.factor(x$data[[predictors[x.var]]])){ # x-variable a factor key <- list(title=x$response, cex.title=1, border=TRUE, text=list(as.character(unique(response))), lines=list(col=colors[.modc(1:n.y.lev)], lty=lines[.modl(1:n.y.lev)], lwd=lwd), points=list(pch=symbols[.mods(1:n.y.lev)], col=colors[.modc(1:n.y.lev)])) result <- xyplot(eval(if (type=="probability") parse(text=if (n.predictors==1) paste("prob ~ as.numeric(", predictors[x.var], ")") else paste("prob ~ as.numeric(", predictors[x.var],") | ", paste(predictors[-x.var], collapse="*"))) else parse(text=if (n.predictors==1) paste("logit ~ as.numeric(", predictors[x.var], ")") else paste("logit ~ as.numeric(", predictors[x.var],") | ", paste(predictors[-x.var], collapse="*")))), strip=function(...) strip.default(..., strip.names=c(factor.names, TRUE)), panel=function(x, y, subscripts, rug, z, x.vals, ...){ if (grid) panel.grid() for (i in 1:n.y.lev){ sub <- z[subscripts] == y.lev[i] good <- !is.na(y[sub]) effect.llines(x[sub][good], y[sub][good], lwd=lwd, type="b", col=colors[.modc(i)], lty=lines[.modl(i)], pch=symbols[i], cex=cex, ...) } }, ylab=ylab, ylim= if (missing(ylim)) if (type == "probability") range(prob) else range(logit) else ylim, xlab=if (missing(xlab)) predictors[x.var] else xlab, x.vals=x$data[[predictors[x.var]]], rug=rug, z=response, scales=list(x=list(at=1:length(levs), labels=levs, rot=rotx), y=list(rot=roty), alternating=alternating), main=main, key=c(key, key.args), layout=layout, data=data, ...) result$split <- split result$more <- more class(result) <- c("plot.eff", class(result)) } else { # x-variable numeric if(use.splines) effect.llines <- spline.llines # added 10/17/13 nm <- predictors[x.var] x.vals <- x$data[[nm]] if (nm %in% names(ticks.x)){ at <- ticks.x[[nm]]$at n <- ticks.x[[nm]]$n } else{ at <- NULL n <- 5 } xlm <- if (nm %in% names(xlim)){ xlim[[nm]] } else range.adj(data[nm]) # range(x.vals) tickmarks.x <- if ((nm %in% names(transform.x)) && !(is.null(transform.x))){ trans <- transform.x[[nm]]$trans make.ticks(trans(xlm), link=transform.x[[nm]]$trans, inverse=transform.x[[nm]]$inverse, at=at, n=n) } else { trans <- I make.ticks(xlm, link=I, inverse=I, at=at, n=n) } key <- list(title=x$response, cex.title=1, border=TRUE, text=list(as.character(unique(response))), lines=list(col=colors[.modc(1:n.y.lev)], lty=lines[.modl(1:n.y.lev)], lwd=lwd)) result <- xyplot(eval(if (type=="probability") parse(text=if (n.predictors==1) paste("prob ~ trans(", predictors[x.var], ")") else paste("prob ~ trans(", predictors[x.var],") |", paste(predictors[-x.var], collapse="*"))) else parse(text=if (n.predictors==1) paste("logit ~ trans(", predictors[x.var], ")") else paste("logit ~ trans(", predictors[x.var],") | ", paste(predictors[-x.var], collapse="*")))), strip=function(...) strip.default(..., strip.names=c(factor.names, TRUE)), panel=function(x, y, subscripts, rug, z, x.vals, ...){ if (grid) panel.grid() if (rug) lrug(trans(x.vals)) for (i in 1:n.y.lev){ sub <- z[subscripts] == y.lev[i] good <- !is.na(y[sub]) effect.llines(x[sub][good], y[sub][good], lwd=lwd, type="l", col=colors[.modc(i)], lty=lines[.modl(i)], ...) } }, ylab=ylab, xlim=suppressWarnings(trans(xlm)), ylim= if (missing(ylim)) if (type == "probability") range(prob) else range(logit) else ylim, xlab=if (missing(xlab)) predictors[x.var] else xlab, x.vals=x$data[[predictors[x.var]]], rug=rug, z=response, scales=list(x=list(at=tickmarks.x$at, labels=tickmarks.x$labels, rot=rotx), y=list(rot=roty), alternating=alternating), main=main, key=c(key, key.args), layout=layout, data=data, ...) result$split <- split result$more <- more class(result) <- c("plot.eff", class(result)) } } else { # stacked plot if (n.y.lev > length(colors)) stop(paste('Not enough colors to plot', n.y.lev, 'regions')) key <- list(text=list(lab=rev(y.lev)), rectangle=list(col=rev(colors[1:n.y.lev]))) if (is.factor(x$data[[predictors[x.var]]])){ # x-variable a factor result <- barchart(eval(parse(text=if (n.predictors == 1) paste("prob ~ ", predictors[x.var], sep="") else paste("prob ~ ", predictors[x.var]," | ", paste(predictors[-x.var], collapse="*")))), strip=function(...) strip.default(..., strip.names=c(factor.names, TRUE)), groups = response, col=colors, horizontal=FALSE, stack=TRUE, data=data, ylim=if (missing(ylim)) 0:1 else ylim, ylab=ylab, xlab=if (missing(xlab)) predictors[x.var] else xlab, scales=list(x=list(rot=rotx), y=list(rot=roty), alternating=alternating), main=main, key=c(key, key.args), layout=layout) result$split <- split result$more <- more class(result) <- c("plot.eff", class(result)) } else { # x-variable numeric if(use.splines) effect.llines <- spline.llines # added 10/17/13 nm <- predictors[x.var] x.vals <- x$data[[nm]] if (nm %in% names(ticks.x)){ at <- ticks.x[[nm]]$at n <- ticks.x[[nm]]$n } else{ at <- NULL n <- 5 } xlm <- if (nm %in% names(xlim)){ xlim[[nm]] } else range.adj(data[nm]) # range(x.vals) tickmarks.x <- if ((nm %in% names(transform.x)) && !(is.null(transform.x))){ trans <- transform.x[[nm]]$trans make.ticks(trans(xlm), link=transform.x[[nm]]$trans, inverse=transform.x[[nm]]$inverse, at=at, n=n) } else { trans <- I make.ticks(xlm, link=I, inverse=I, at=at, n=n) } result <- densityplot(eval(parse(text=if (n.predictors == 1) paste("~ trans(", predictors[x.var], ")", sep="") else paste("~ trans(", predictors[x.var], ") | ", paste(predictors[-x.var], collapse="*")))), probs=x$prob, strip=function(...) strip.default(..., strip.names=c(factor.names, TRUE)), panel = function(x, subscripts, rug, x.vals, probs=probs, col=colors, ...){ fill <- function(x, y1, y2, col){ if (length(y2) == 1) y2 <- rep(y2, length(y1)) if (length(y1) == 1) y1 <- rep(y1, length(y2)) panel.polygon(c(x, rev(x)), c(y1, rev(y2)), col=col) } n <- ncol(probs) Y <- t(apply(probs[subscripts,], 1, cumsum)) fill(x, 0, Y[,1], col=col[1]) for (i in 2:n){ fill(x, Y[,i-1], Y[,i], col=col[i]) } if (rug) lrug(trans(x.vals)) }, rug=rug, x.vals=x$data[[predictors[x.var]]], data=x$x, xlim=suppressWarnings(trans(xlm)), ylim=if (missing(ylim)) 0:1 else ylim, ylab=ylab, xlab=if (missing(xlab)) predictors[x.var] else xlab, scales=list(x=list(at=tickmarks.x$at, labels=tickmarks.x$labels, rot=rotx), y=list(rot=roty), alternating=alternating), main=main, key=c(key, key.args), layout=layout, ...) result$split <- split result$more <- more class(result) <- c("plot.eff", class(result)) } } } ### with confidence bands else{ # plot with confidence bands layout <- if(missing(layout)) c(prod(n.predictor.cats), length(levels(response)), 1) else layout if (type == "probability"){ lower <- lower.prob upper <- upper.prob } else { lower <- lower.logit upper <- upper.logit } ### factor if (is.factor(x$data[[predictors[x.var]]])){ # x-variable a factor levs <- levels(x$data[[predictors[x.var]]]) result <- xyplot(eval(if (type=="probability") parse(text=if (n.predictors==1) paste("prob ~ as.numeric(", predictors[x.var],") |", x$response) else paste("prob ~ as.numeric(", predictors[x.var],") |", paste(predictors[-x.var], collapse="*"), paste("*", x$response))) else parse(text=if (n.predictors==1) paste("logit ~ as.numeric(", predictors[x.var],") |", x$response) else paste("logit ~ as.numeric(", predictors[x.var],")|", paste(predictors[-x.var], collapse="*"), paste("*", x$response)))), par.strip.text=list(cex=0.8), strip=function(...) strip.default(..., strip.names=c(factor.names, TRUE)), panel=function(x, y, subscripts, x.vals, rug, lower, upper, ... ){ if (grid) panel.grid() good <- !is.na(y) effect.llines(x[good], y[good], lwd=lwd, type="b", pch=19, col=colors[1], cex=cex, ...) subs <- subscripts+as.numeric(rownames(data)[1])-1 if (ci.style == "bars"){ larrows(x0=x[good], y0=lower[subs][good], x1=x[good], y1=upper[subs][good], angle=90, code=3, col=colors[.modc(2)], length=0.125*cex/1.5) } else if(ci.style == "lines"){ effect.llines(x[good], lower[subs][good], lty=2, col=colors[.modc(2)]) effect.llines(x[good], upper[subs][good], lty=2, col=colors[.modc(2)]) } else { if(ci.style == "bands") { panel.bands(x[good], y[good], lower[subs][good], upper[subs][good], fill=band.colors[1], alpha=band.transparency) }} }, ylab=ylab, ylim= if (missing(ylim)) c(min(lower), max(upper)) else ylim, xlab=if (missing(xlab)) predictors[x.var] else xlab, main=main, x.vals=x$data[[predictors[x.var]]], rug=rug, lower=lower, upper=upper, scales=list(x=list(at=1:length(levs), labels=levs, rot=rotx), y=list(rot=roty), alternating=alternating), layout=layout, data=data, ...) result$split <- split result$more <- more class(result) <- c("plot.eff", class(result)) } else { # x-variable numeric if(use.splines) effect.llines <- spline.llines # added 10/17/13 nm <- predictors[x.var] x.vals <- x$data[[nm]] if (nm %in% names(ticks.x)){ at <- ticks.x[[nm]]$at n <- ticks.x[[nm]]$n } else{ at <- NULL n <- 5 } xlm <- if (nm %in% names(xlim)){ xlim[[nm]] } else range.adj(data[nm]) # range(x.vals) tickmarks.x <- if ((nm %in% names(transform.x)) && !(is.null(transform.x))){ trans <- transform.x[[nm]]$trans make.ticks(trans(xlm), link=transform.x[[nm]]$trans, inverse=transform.x[[nm]]$inverse, at=at, n=n) } else { trans <- I make.ticks(xlm, link=I, inverse=I, at=at, n=n) } result <- xyplot(eval(if (type=="probability") parse(text=if (n.predictors==1) paste("prob ~ trans(", predictors[x.var],") |", x$response) else paste("prob ~ trans(", predictors[x.var],") |", paste(predictors[-x.var], collapse="*"), paste("*", x$response))) else parse(text=if (n.predictors==1) paste("logit ~ trans(", predictors[x.var],") |", x$response) else paste("logit ~ trans(", predictors[x.var],") |", paste(predictors[-x.var], collapse="*"), paste("*", x$response))) ), par.strip.text=list(cex=0.8), strip=function(...) strip.default(..., strip.names=c(factor.names, TRUE)), panel=function(x, y, subscripts, x.vals, rug, lower, upper, ... ){ if (grid) panel.grid() if (rug) lrug(trans(x.vals)) good <- !is.na(y) effect.llines(x[good], y[good], lwd=lwd, col=colors[1], ...) subs <- subscripts+as.numeric(rownames(data)[1])-1 if (ci.style == "bars"){ larrows(x0=x[good], y0=lower[subs][good], x1=x[good], y1=upper[subs][good], angle=90, code=3, col=colors[.modc(2)], length=0.125*cex/1.5) } else if(ci.style == "lines"){ effect.llines(x[good], lower[subs][good], lty=2, col=colors[.modc(2)]) effect.llines(x[good], upper[subs][good], lty=2, col=colors[.modc(2)]) } else { if(ci.style == "bands") { panel.bands(x[good], y[good], lower[subs][good], upper[subs][good], fill=band.colors[1], alpha=band.transparency) }} }, ylab=ylab, xlim=suppressWarnings(trans(xlm)), ylim= if (missing(ylim)) c(min(lower), max(upper)) else ylim, xlab=if (missing(xlab)) predictors[x.var] else xlab, main=main, x.vals=x$data[[predictors[x.var]]], rug=rug, lower=lower, upper=upper, scales=list(y=list(rot=roty), x=list(at=tickmarks.x$at, labels=tickmarks.x$labels, rot=rotx), alternating=alternating), layout=layout, data=data, ...) result$split <- split result$more <- more class(result) <- c("plot.eff", class(result)) } } result } effects/R/utilities.R0000644000176000001440000003760512236312350014270 0ustar ripleyusers# utilities and common functions for effects package # John Fox, Jangman Hong, and Sanford Weisberg # last modified 2013-08-14 by J. Fox # 7-25-2013 S. Weisberg modified analyze.model and Analyze.model to ignore # default.levels, and use xlevels to set default. Use grid.pretty by default # 11-09-2013: fixed error message in Analyze.model(), bug reported by Joris Meys. J. Fox # 2013-10-15: eliminated functions not needed after effect() methods removed. J. Fox # 2013-10-29: fixed as.data.frame.*() to handle NA levels. J. Fox has.intercept <- function(model, ...) any(names(coefficients(model))=="(Intercept)") term.names <- function (model, ...) { term.names <- gsub(" ", "", labels(terms(model))) if (has.intercept(model)) c("(Intercept)", term.names) else term.names } response.name <- function (model, ...) deparse(attr(terms(model), "variables")[[2]]) mfrow <- function(n, max.plots=0){ # number of rows and columns for array of n plots if (max.plots != 0 & n > max.plots) stop(paste("number of plots =",n," exceeds maximum =", max.plots)) rows <- round(sqrt(n)) cols <- ceiling(n/rows) c(rows, cols) } expand.model.frame <- function (model, extras, envir = environment(formula(model)), na.expand = FALSE){ # modified version of R base function f <- formula(model) data <- eval(model$call$data, envir) ff <- foo ~ bar + baz if (is.call(extras)) gg <- extras else gg <- parse(text = paste("~", paste(extras, collapse = "+")))[[1]] ff[[2]] <- f[[2]] ff[[3]][[2]] <- f[[3]] ff[[3]][[3]] <- gg[[2]] if (!na.expand) { naa <- model$call$na.action subset <- model$call$subset rval <- if (is.null(data)) eval(call("model.frame", ff, # modified subset = subset, na.action = naa), envir) # lines else eval(call("model.frame", ff, data = data, # subset = subset, na.action = naa), envir) # } else { subset <- model$call$subset rval <- eval(call("model.frame", ff, data = data, subset = subset, na.action = I), envir) oldmf <- model.frame(model) keep <- match(rownames(oldmf), rownames(rval)) rval <- rval[keep, ] class(rval) <- "data.frame" } return(rval) } is.relative <- function(term1, term2, factors) { all(!(factors[,term1]&(!factors[,term2]))) } descendants <- function(term, mod, ...){ names <- term.names(mod) if (has.intercept(mod)) names <- names[-1] if(length(names)==1) return(NULL) which.term <- which(term == names) if (length(which.term) == 0){ factors <- attr(terms(...), "factors") rownames(factors) <- gsub(" ", "", rownames(factors)) colnames(factors) <- gsub(" ", "", colnames(factors)) (1:length(names))[sapply(names, function(term2) is.relative(term, term2, factors))] } else { factors <- attr(terms(mod), "factors") rownames(factors) <- gsub(" ", "", rownames(factors)) colnames(factors) <- gsub(" ", "", colnames(factors)) (1:length(names))[-which.term][sapply(names[-which.term], function(term2) is.relative(term, term2, factors))] } } is.high.order.term <- function(term, mod,...){ 0 == length(descendants(term, mod, ...)) } subscripts <- function(index, dims){ subs <- function(dims, index){ dim <- length(dims) if (dim == 0) return(NULL) cum <- c(1,cumprod(dims))[dim] i <- index %/% cum if (index %% cum != 0) i <- i + 1 c(i, subs(dims[-dim], index - (i - 1)*cum)) } rev(subs(dims, index)) } matrix.to.df <- function(matrix, colclasses){ opt <- options(warn = -1) on.exit(options(opt)) ncol <- ncol(matrix) colnames <- colnames(matrix) colclasses[sapply(colclasses, function(x) "integer" %in% x)] <- "numeric" result <- vector(mode="list", length=ncol) names(result) <- colnames for (j in 1:ncol){ result[[j]] <- matrix[, j] class <- colclasses[[colnames[j]]] result[[colnames[j]]] <- if ("numeric" %in% class) { decChar <- getOption('OutDec') if (decChar == '.') as.numeric(result[[colnames[j]]]) else as.numeric(gsub(decChar, '.', matrix[,j])) } else if ("ordered" %in% class) ordered(result[[colnames[j]]]) else if ("factor" %in% class) factor(result[[colnames[j]]]) else result[[colnames[j]]] } as.data.frame(result) } # Added by S. Weisberg, 7/15/2013 to get reasonable default levels # Uses grid.pretty in base package setXlevels <- function(m, xlevels=list(), default.levels=NULL) { firstorderterms <- all.vars(formula(m)[[3]]) if(class(xlevels) == "numeric"){ newxlevels <- list() for(term in firstorderterms) newxlevels[[term]] <- xlevels xlevels <- newxlevels} for (term in firstorderterms) { if(is.null(xlevels[[term]])){ x <- m$model[[term]] xlevels[[term]] <- if(class(x)[1] == "factor") levels(x) else { if(is.numeric(default.levels)){ xr <- range(m$model[[term]]) seq(xr[1], xr[2], length=default.levels) } else grid.pretty(range(x)) }} else { if(length(xlevels[[term]])==1L){ x <- m$model[[term]] xlevels[[term]] <- if(class(x)[1] == "factor") levels(x) else { xr <- range(m$model[[term]]) seq(xr[1], xr[2], length=xlevels[[term]])}}} } xlevels } # the following function is a modification of code contributed by Steve Taylor as.data.frame.eff <- function(x, row.names=NULL, optional=TRUE, transform=x$transformation$inverse, ...){ xx <- x$x for (var in names(xx)){ if (is.factor(xx[[var]])){ xx[[var]] <- addNA(xx[[var]]) # handle factors with "valid" NA level } } x$x <- xx result <- if (is.null(x$se)) data.frame(x$x, fit=transform(x$fit)) else data.frame(x$x, fit=transform(x$fit), se=x$se, lower=transform(x$lower), upper=transform(x$upper)) attr(result, "transformation") <- transform result } as.data.frame.effpoly <- function(x, row.names=NULL, optional=TRUE, ...){ factors <- sapply(x$variables, function(x) x$is.factor) factor.levels <- lapply(x$variables[factors], function(x) x$levels) if (!length(factor.levels) == 0){ factor.names <- names(factor.levels) for (fac in factor.names){ x$x[[fac]] <- factor(x$x[[fac]], levels=factor.levels[[fac]], exclude=NULL) } } result <- data.frame(x$x, x$prob, x$logit) if (!is.null(x$confidence.level)) result <- cbind(result, x$se.prob, x$se.logit, x$lower.prob, x$upper.prob, x$lower.logit, x$upper.logit) result } as.data.frame.efflatent <- function(x, row.names=NULL, optional=TRUE, ...){ xx <- x$x for (var in names(xx)){ if (is.factor(xx$var)){ xx$var <- addNA(xx$var) # handle factors with "valid" NA level } } x$x <- xx if (is.null(x$se)) data.frame(x$x, fit=x$fit) else data.frame(x$x, fit=x$fit, se=x$se, lower=x$lower, upper=x$upper) } logit2p <- function(logit) 1/(1 + exp(-logit)) p2logit <- function(p) log(p/(1 - p)) lrug <- function(x) { if (length(unique(x)) < 0.8 * length(x)) x <- jitter(x) grid.segments(x, unit(0, "npc"), x, unit(0.5, "lines"), default.units="native") } ## model.response not generic model.response.gls <- function(model){ model.response(model.frame(as.formula(model$call$model), data=eval(model$call$data))) } terms.gls <- function(x, ...) terms(formula(x)) ## vcov method for eff objects vcov.eff <- function(object, ...) object$vcov ## [ method for efflist objects `[.efflist` <- function(x, ...){ y <- NextMethod("[") class(y) <- class(x) y } ### the following functions are for use by Effect() methods Analyze.model <- function(focal.predictors, mod, xlevels, default.levels=NULL, formula.rhs){ if ((!is.null(mod$na.action)) && class(mod$na.action) == "exclude") class(mod$na.action) <- "omit" all.predictors <- all.vars(formula.rhs) check.vars <- !(focal.predictors %in% all.predictors) excluded.predictors <- setdiff(all.predictors, focal.predictors) number.bad <- sum(check.vars) if (any(check.vars)) { message <- if (number.bad == 1) paste("the following predictor is not in the model:", focal.predictors[check.vars]) else paste("the following predictors are not in the model:", paste(focal.predictors[check.vars], collapse=", ")) stop(message) } X.mod <- model.matrix(mod) cnames <- colnames(X.mod) factor.cols <- rep(FALSE, length(cnames)) names(factor.cols) <- cnames X <- model.frame(mod) for (name in all.predictors){ if (is.factor(X[[name]])) factor.cols[grep(paste("^", name, sep=""), cnames)] <- TRUE } factor.cols[grep(":", cnames)] <- FALSE X <- na.omit(expand.model.frame(mod, all.predictors)) x <- list() factor.levels <- list() if(length(xlevels)==0 & length(default.levels) == 1L) xlevels <- default.levels if(is.numeric(xlevels) & length(xlevels) == 1L){ levs <- xlevels for(name in focal.predictors) xlevels[[name]] <- levs} for (name in focal.predictors){ levels <- mod$xlevels[[name]] if(is.null(levels)) levels <- mod$xlevels[[paste("factor(",name,")",sep="")]] fac <- !is.null(levels) if (!fac) { levels <- if (is.null(xlevels[[name]])){ grid.pretty(range(X[, name]))} else { if(length(xlevels[[name]]) == 1L) { seq(min(X[, name]), max(X[,name]), length=xlevels[[name]])} else xlevels[[name]]} } else factor.levels[[name]] <- levels x[[name]] <- list(name=name, is.factor=fac, levels=levels) } x.excluded <- list() for (name in excluded.predictors){ levels <- mod$xlevels[[name]] fac <- !is.null(levels) level <- if (fac) levels[1] else mean(X[, name]) if (fac) factor.levels[[name]] <- levels x.excluded[[name]] <- list(name=name, is.factor=fac, level=level) } dims <- sapply(x, function(x) length(x$levels)) len <- prod(dims) n.focal <- length(focal.predictors) n.excluded <- length(excluded.predictors) n.vars <- n.focal + n.excluded predict.data <-matrix('', len, n.vars) excluded <- sapply(x.excluded, function(x) x$level) for (i in 1:len){ subs <- subscripts(i, dims) for (j in 1:n.focal){ predict.data[i,j] <- x[[j]]$levels[subs[j]] } if (n.excluded > 0) predict.data[i, (n.focal + 1):n.vars] <- excluded } colnames(predict.data) <- c(sapply(x, function(x) x$name), sapply(x.excluded, function(x) x$name)) colclasses <- lapply(X, class) colclasses[colclasses == "matrix"] <- "numeric" predict.data <- matrix.to.df(predict.data, colclasses=colclasses) list(predict.data=predict.data, factor.levels=factor.levels, factor.cols=factor.cols, focal.predictors=focal.predictors, n.focal=n.focal, excluded.predictors=excluded.predictors, n.excluded=n.excluded, x=x, X.mod=X.mod, cnames=cnames, X=X) } Fixup.model.matrix <- function(mod, mod.matrix, mod.matrix.all, X.mod, factor.cols, cnames, focal.predictors, excluded.predictors, typical, given.values){ vars <- as.character(attr(terms(mod), "variables"))[-(1:2)] attr(mod.matrix, "assign") <- attr(mod.matrix.all, "assign") if (length(excluded.predictors) > 0){ sel <- apply(sapply(excluded.predictors, matchVarName, expressions=vars), 1, any) strangers <- Strangers(mod, focal.predictors, excluded.predictors) stranger.cols <- apply(outer(strangers, attr(mod.matrix,'assign'), '=='), 2, any) } else stranger.cols <- rep(FALSE, ncol(mod.matrix)) if (has.intercept(mod)) stranger.cols[1] <- TRUE if (any(stranger.cols)) { facs <- factor.cols & stranger.cols covs <- (!factor.cols) & stranger.cols if (any(facs)) mod.matrix[,facs] <- matrix(apply(as.matrix(X.mod[,facs]), 2, mean), nrow=nrow(mod.matrix), ncol=sum(facs), byrow=TRUE) if (any(covs)) mod.matrix[,covs] <- matrix(apply(as.matrix(X.mod[,covs]), 2, typical), nrow=nrow(mod.matrix), ncol=sum(covs), byrow=TRUE) if (!is.null(given.values)){ stranger.names <- cnames[stranger.cols] given <- stranger.names %in% names(given.values) if (any(given)) mod.matrix[,stranger.names[given]] <- matrix(given.values[stranger.names[given]], nrow=nrow(mod.matrix), ncol=length(stranger.names[given]), byrow=TRUE) } } for (name in cnames){ components <- unlist(strsplit(name, ':')) components <- components[components %in% cnames] if (length(components) > 1) mod.matrix[,name] <- apply(mod.matrix[,components], 1, prod) } mod.matrix } matchVarName <- function(name, expressions){ a <- !grepl(paste("[.]+", name, sep=""), expressions) b <- !grepl(paste(name, "[.]+", sep=""), expressions) c <- grepl(paste("\\b", name, "\\b", sep=""), expressions) a & b & c } Strangers <- function(mod, focal.predictors, excluded.predictors){ names <- term.names(mod) if (has.intercept(mod)) names <- names[-1] sel <- apply(sapply(excluded.predictors, matchVarName, expressions=names), 1, any) (1:length(sel))[sel] } # the following is used by effect.multinom() and Effect.multinom() eff.mul <- function(x0, B, se, m, p, r, V){ mu <- exp(x0 %*% B) mu <- mu/(1 + sum(mu)) mu[m] <- 1 - sum(mu) logits <- log(mu/(1 - mu)) if (!se) return(list(p=mu, logits=logits)) d <- array(0, c(m, m - 1, p)) exp.x0.B <- as.vector(exp(x0 %*% B)) sum.exp.x0.B <- sum(exp.x0.B) for (j in 1:(m-1)){ d[m, j,] <- - exp.x0.B[j]*x0 for (jj in 1:(m-1)){ d[j, jj,] <- if (jj != j) - exp(x0 %*% (B[,jj] + B[,j]))*x0 else exp.x0.B[j]*(1 + sum.exp.x0.B - exp.x0.B[j])*x0 } } d <- d/(1 + sum.exp.x0.B)^2 V.mu <- rep(0, m) for (j in 1:m){ dd <- as.vector(t(d[j,,])) for (s in 1:r){ for (t in 1:r){ V.mu[j] <- V.mu[j] + V[s,t]*dd[s]*dd[t] } } } V.logits <- V.mu/(mu^2 * (1 - mu)^2) list(p=mu, std.err.p=sqrt(V.mu), logits=logits, std.error.logits=sqrt(V.logits)) } # the following are used by effect.polr() and Effect.polr() eff.polr <- function(x0, b, alpha, V, m, r, se){ eta0 <- x0 %*% b mu <- rep(0, m) mu[1] <- 1/(1 + exp(alpha[1] + eta0)) for (j in 2:(m-1)){ mu[j] <- exp(eta0)*(exp(alpha[j - 1]) - exp(alpha[j]))/ ((1 + exp(alpha[j - 1] + eta0))*(1 + exp(alpha[j] + eta0))) } mu[m] <- 1 - sum(mu) logits <- log(mu/(1 - mu)) if (!se) return(list(p=mu, logits=logits)) d <- matrix(0, m, r) d[1, 1] <- - exp(alpha[1] + eta0)/(1 + exp(alpha[1] + eta0))^2 d[1, m:r] <- - exp(alpha[1] + eta0)*x0/(1 + exp(alpha[1] + eta0))^2 for (j in 2:(m-1)){ d[j, j-1] <- exp(alpha[j-1] + eta0)/(1 + exp(alpha[j-1] + eta0))^2 d[j, j] <- - exp(alpha[j] + eta0)/(1 + exp(alpha[j] + eta0))^2 d[j, m:r] <- exp(eta0)*(exp(alpha[j]) - exp(alpha[j-1]))* (exp(alpha[j-1] + alpha[j] + 2*eta0) - 1) * x0 / (((1 + exp(alpha[j-1] + eta0))^2)* ((1 + exp(alpha[j] + eta0))^2)) } d[m, m-1] <- exp(alpha[m-1] + eta0)/(1 + exp(alpha[m-1] + eta0))^2 d[m, m:r] <- exp(alpha[m-1] + eta0)*x0/(1 + exp(alpha[m-1] + eta0))^2 V.mu <- rep(0, m) for (j in 1:m){ dd <- d[j,] for (s in 1:r){ for (t in 1:r){ V.mu[j] <- V.mu[j] + V[s,t]*dd[s]*dd[t] } } } V.logits <- V.mu/(mu^2 * (1 - mu)^2) list(p=mu, std.err.p=sqrt(V.mu), logits=logits, std.error.logits=sqrt(V.logits)) } eff.latent <- function(X0, b, V, se){ eta <- X0 %*% b if (!se) return(list(fit=eta)) var <- diag(X0 %*% V %*% t(X0)) list(fit=eta, se=sqrt(var)) } effects/R/effects.R0000644000176000001440000000466712236312350013676 0ustar ripleyusers# effect generic and methods; allEffects # John Fox, Sanford Weisberg, and Jangman Hong # last modified 2012-12-08 by J. Fox # 10/31/2012 modifed effect.lm to use z distn for ses with mer and nlme objects # 12-21-2012 Allow for empty cells in factor interactions, S. Weisberg # 7-15-2013: S. Weisberg: deleted 'default.levels' argument. Changed and # generalized xlevels argument to include the function of default.levels. # 2013-10-15: eliminated generic effect() and all its methods. J. Fox effect <- function(term, mod, ...){ term <- gsub(" ", "", gsub("\\*", ":", term)) terms <- term.names(mod) if (has.intercept(mod)) terms <- terms[-1] which.term <- which(term == terms) mod.aug<- list() if (length(which.term) == 0){ message("NOTE: ", term, " does not appear in the model") mod.aug <- update(formula(mod), eval(parse(text=paste(". ~ . +", term)))) } if (!is.high.order.term(term, mod, mod.aug)) message("NOTE: ", term, " is not a high-order term in the model") predictors <- all.vars(parse(text=term)) Effect(predictors, mod, ...) } allEffects <- function(mod, ...) UseMethod("allEffects") allEffects.default <- function(mod, ...){ high.order.terms <- function(mod){ names <- term.names(mod) if (has.intercept(mod)) names<-names[-1] rel <- lapply(names, descendants, mod=mod) (1:length(names))[sapply(rel, function(x) length(x)==0)] } names <- term.names(mod) if (has.intercept(mod)) names <- names[-1] if (length(names) == 0) stop("the model contains no terms (beyond a constant)") terms <- names[high.order.terms(mod)] result <- lapply(terms, effect, mod=mod, ...) names(result) <- terms class(result) <- 'efflist' result } allEffects.gls <- function(mod, ...){ high.order.terms <- function(mod){ mod <- lm(as.formula(mod$call$model), data=eval(mod$call$data)) names <- term.names(mod) if (has.intercept(mod)) names<-names[-1] rel <- lapply(names, descendants, mod=mod) (1:length(names))[sapply(rel, function(x) length(x)==0)] } names <- term.names(mod) if (has.intercept(mod)) names <- names[-1] if (length(names) == 0) stop("the model contains no terms (beyond a constant)") terms <- names[high.order.terms(mod)] result <- lapply(terms, effect, mod=mod, ...) names(result) <- terms class(result) <- 'efflist' result } all.effects <- function(...){ .Deprecated("allEffects") allEffects(...) }effects/R/plot-methods.R0000644000176000001440000007156412236312350014676 0ustar ripleyusers# plot.eff method for effects package, moved here from plot-summary-print-methods.R # The plot.effpoly method remains there for now. # 2013-10-17: Added use.splines keyword to plot.eff. Sandy # 2013-10-17: Made ci.style="bands" default for variates; allow "bands" if multiline=TRUE # 2013-10-29: fixed plot.eff() to handle factors with "valid" NA level. J. Fox # the following functions aren't exported make.ticks <- function(range, link, inverse, at, n) { warn <- options(warn=-1) on.exit(options(warn)) link <- if (is.null(link)) function(x) nlm(function(y) (inverse(y) - x)^2, mean(range))$estimate else link if (is.null(n)) n <- 5 labels <- if (is.null(at)){ labels <- pretty(sapply(range, inverse), n=n+1) } else at ticks <- sapply(labels, link) list(at=ticks, labels=format(labels)) } range.adj <- function(x){ range <- range(x, na.rm=TRUE) c(range[1] - .025*(range[2] - range[1]), range[2] + .025*(range[2] - range[1])) } # added, modified from http://www.r-bloggers.com/confidence-bands-with-lattice-and-r/ panel.bands <- function(x, y, upper, lower, fill, col, subscripts, ..., font, fontface, use.splines=FALSE) { if(!missing(subscripts)) { upper <- upper[subscripts] lower <- lower[subscripts] } if (use.splines){ up <- spline(x, upper) down <- spline(x, lower) x <- up$x upper <- up$y lower <- down$y } panel.polygon(c(x, rev(x)), c(upper, rev(lower)), col = fill, fill=fill, border = FALSE, ...) } # modified by Michael Friendly: added key.args: # modified by Michael Friendly: added ci.style="bands" # modified by Michael Friendly: added lwd= argument for llines (not used elsewhere) # modified by Michael Friendly: added alpha.band= argument for ci.style="bands" #### Added 10/15/2013 spline.llines <- function(x, y, ...) llines(spline(x, y), ...) #### End addition plot.eff <- function(x, x.var=which.max(levels), z.var=which.min(levels), multiline=is.null(x$se), rug=TRUE, xlab, ylab, main=paste(effect, "effect plot"), colors=palette(), symbols=1:length(colors), lines=1:length(colors), cex=1.5, lwd=2, ylim, xlim=NULL, factor.names=TRUE, ci.style, band.transparency=0.2, band.colors=colors, type=c("response", "link"), ticks=list(at=NULL, n=5), alternating=TRUE, rotx=0, roty=0, grid=FALSE, layout, rescale.axis=TRUE, transform.x=NULL, ticks.x=NULL, key.args=NULL, row=1, col=1, nrow=1, ncol=1, more=FALSE, use.splines=TRUE, ...) { .mod <- function(a, b) ifelse( (d <- a %% b) == 0, b, d) .modc <- function(a) .mod(a, length(colors)) .mods <- function(a) .mod(a, length(symbols)) .modl <- function(a) .mod(a, length(lines)) .modb <- function(a) .mod(a, length(band.colors)) ci.style <- if(missing(ci.style)) NULL else match.arg(ci.style, c("bars", "lines", "bands", "none")) type <- match.arg(type) thresholds <- x$thresholds has.thresholds <- !is.null(thresholds) effect.llines <- llines if (missing(ylab)){ ylab <- if (has.thresholds) paste(x$response, ": ", paste(x$y.levels, collapse=", "), sep="") else x$response } if (has.thresholds){ threshold.labels <- abbreviate(x$y.levels, minlength=1) threshold.labels <- paste(" ", paste(threshold.labels[-length(threshold.labels)], threshold.labels[-1], sep=" - "), " ", sep="") } trans.link <- x$transformation$link trans.inverse <- x$transformation$inverse if (!rescale.axis){ x$lower[!is.na(x$lower)] <- trans.inverse(x$lower[!is.na(x$lower)]) x$upper[!is.na(x$upper)] <- trans.inverse(x$upper[!is.na(x$upper)]) x$fit[!is.na(x$fit)] <- trans.inverse(x$fit)[!is.na(x$fit)] trans.link <- trans.inverse <- I } # require(lattice) split <- c(col, row, ncol, nrow) ylab # force evaluation x.data <- x$data effect <- paste(sapply(x$variables, "[[", "name"), collapse="*") vars <- x$variables x <- as.data.frame(x, transform=I) for (i in 1:length(vars)){ if (!(vars[[i]]$is.factor)) next x[,i] <- factor(x[,i], levels=vars[[i]]$levels, exclude=NULL) } has.se <- !is.null(x$se) n.predictors <- ncol(x) - 1 - 3*has.se if (n.predictors == 1){ ### factor no other predictors if (is.factor(x[,1])){ ci.style <- if(is.null(ci.style)) "bars" else ci.style range <- if(has.se & ci.style!="none") range(c(x$lower, x$upper), na.rm=TRUE) else range(x$fit, na.rm=TRUE) ylim <- if (!missing(ylim)) ylim else c(range[1] - .025*(range[2] - range[1]), range[2] + .025*(range[2] - range[1])) tickmarks <- if (type == "response") make.ticks(ylim, link=trans.link, inverse=trans.inverse, at=ticks$at, n=ticks$n) else make.ticks(ylim, link=I, inverse=I, at=ticks$at, n=ticks$n) levs <- levels(x[,1]) plot <- xyplot(eval(parse( text=paste("fit ~ as.numeric(", names(x)[1], ")"))), strip=function(...) strip.default(..., strip.names=c(factor.names, TRUE)), panel=function(x, y, lower, upper, has.se, ...){ if (grid) panel.grid() good <- !is.na(y) if (has.se){ if (ci.style == "bars"){ larrows(x0=x[good], y0=lower[good], x1=x[good], y1=upper[good], angle=90, code=3, col=colors[.modc(2)], length=0.125*cex/1.5) } else if(ci.style == "lines") { effect.llines(x[good], lower[good], lty=2, col=colors[.modc(2)]) effect.llines(x[good], upper[good], lty=2, col=colors[.modc(2)]) } else{ if(ci.style == "bands") { panel.bands(x[good], y[good], upper[good], lower[good], fill=band.colors[1], alpha=band.transparency, use.splines=FALSE) }} } effect.llines(x[good], y[good], lwd=lwd, col=colors[1], type='b', pch=19, cex=cex, ...) if (has.thresholds){ panel.abline(h=thresholds, lty=3) panel.text(rep(current.panel.limits()$xlim[1], length(thresholds)), thresholds, threshold.labels, adj=c(0,0), cex=0.75) panel.text(rep(current.panel.limits()$xlim[2], length(thresholds)), thresholds, threshold.labels, adj=c(1,0), cex=0.75) } }, ylim=ylim, ylab=ylab, xlab=if (missing(xlab)) names(x)[1] else xlab, scales=list(x=list(at=1:length(levs), labels=levs, rot=rotx), y=list(at=tickmarks$at, labels=tickmarks$labels, rot=roty), alternating=alternating, y=roty), main=main, lower=x$lower, upper=x$upper, has.se=has.se, data=x, ...) result <- update(plot, layout = if (missing(layout)) c(0, prod(dim(plot))) else layout) result$split <- split result$more <- more class(result) <- c("plot.eff", class(result)) } ### variate, no other predictors else { effect.llines <- if(use.splines) spline.llines else effect.llines ci.style <- if(is.null(ci.style)) "bands" else ci.style range <- if(has.se & ci.style!="none") range(c(x$lower, x$upper), na.rm=TRUE) else range(x$fit, na.rm=TRUE) ylim <- if (!missing(ylim)) ylim else c(range[1] - .025*(range[2] - range[1]), range[2] + .025*(range[2] - range[1])) tickmarks <- if (type == "response") make.ticks(ylim, link=trans.link, inverse=trans.inverse, at=ticks$at, n=ticks$n) else make.ticks(ylim, link=I, inverse=I, at=ticks$at, n=ticks$n) nm <- names(x)[1] x.vals <- x.data[, nm] if (nm %in% names(ticks.x)){ at <- ticks.x[[nm]]$at n <- ticks.x[[nm]]$n } else{ at <- NULL n <- 5 } xlm <- if (nm %in% names(xlim)){ xlim[[nm]] } else range.adj(x[nm]) # range(x.vals) tickmarks.x <- if ((nm %in% names(transform.x)) && !(is.null(transform.x))){ trans <- transform.x[[nm]]$trans make.ticks(trans(xlm), link=transform.x[[nm]]$trans, inverse=transform.x[[nm]]$inverse, at=at, n=n) } else { trans <- I make.ticks(xlm, link=I, inverse=I, at=at, n=n) } plot <- xyplot(eval(parse( text=paste("fit ~ trans(", names(x)[1], ")"))), strip=function(...) strip.default(..., strip.names=c(factor.names, TRUE)), panel=function(x, y, x.vals, rug, lower, upper, has.se, ...){ if (grid) panel.grid() good <- !is.na(y) axis.length <- diff(range(x)) effect.llines(x[good], y[good], lwd=lwd, col=colors[1], ...) if (rug) lrug(trans(x.vals)) if (has.se){ if (ci.style == "bars"){ larrows(x0=x[good], y0=lower[good], x1=x[good], y1=upper[good], angle=90, code=3, col=eval(colors[.modc(2)]), length=.125*cex/1.5) } else if(ci.style == "lines") { effect.llines(x[good], lower[good], lty=2, col=colors[.modc(2)]) effect.llines(x[good], upper[good], lty=2, col=colors[.modc(2)]) } else{ if(ci.style == "bands") { panel.bands(x[good], y[good], upper[good], lower[good], fill=band.colors[1], alpha=band.transparency, use.splines=use.splines) }} } if (has.thresholds){ panel.abline(h=thresholds, lty=3) panel.text(rep(current.panel.limits()$xlim[1], length(thresholds)), thresholds, threshold.labels, adj=c(0,0), cex=0.75) panel.text(rep(current.panel.limits()$xlim[2], length(thresholds)), thresholds, threshold.labels, adj=c(1,0), cex=0.75) } }, ylim=ylim, xlim=suppressWarnings(trans(xlm)), ylab=ylab, xlab=if (missing(xlab)) names(x)[1] else xlab, x.vals=x.vals, rug=rug, main=main, lower=x$lower, upper=x$upper, has.se=has.se, data=x, scales=list(y=list(at=tickmarks$at, labels=tickmarks$labels, rot=roty), x=list(at=tickmarks.x$at, labels=tickmarks.x$labels, rot=rotx), alternating=alternating), ...) result <- update(plot, layout = if (missing(layout)) c(0, prod(dim(plot))) else layout) result$split <- split result$more <- more class(result) <- c("plot.eff", class(result)) } return(result) } ### more than one variate predictors <- names(x)[1:n.predictors] levels <- sapply(apply(x[,predictors], 2, unique), length) if (is.character(x.var)) { which.x <- which(x.var == predictors) if (length(which.x) == 0) stop(paste("x.var = '", x.var, "' is not in the effect.", sep="")) x.var <- which.x } if (is.character(z.var)) { which.z <- which(z.var == predictors) if (length(which.z) == 0) stop(paste("z.var = '", z.var, "' is not in the effect.", sep="")) z.var <- which.z } if (x.var == z.var) z.var <- z.var + 1 ### multiline if (multiline){ ci.style <- if(is.null(ci.style)) "none" else ci.style if(ci.style == "lines") { cat("Confidence interval style 'lines' changed to 'bars'\n") ci.style <- "bars"} range <- if (has.se && ci.style !="none") range(c(x$lower, x$upper), na.rm=TRUE) else range(x$fit, na.rm=TRUE) ylim <- if (!missing(ylim)) ylim else c(range[1] - .025*(range[2] - range[1]), range[2] + .025*(range[2] - range[1])) tickmarks <- if (type == "response") make.ticks(ylim, link=trans.link, inverse=trans.inverse, at=ticks$at, n=ticks$n) else make.ticks(ylim, link=I, inverse=I, at=ticks$at, n=ticks$n) zvals <- unique(x[, z.var]) ### multiline factor if (is.factor(x[,x.var])){ levs <- levels(x[,x.var]) key <- list(title=predictors[z.var], cex.title=1, border=TRUE, text=list(as.character(zvals)), lines=list(col=colors[.modc(1:length(zvals))], lty=lines[.modl(1:length(zvals))], lwd=lwd), points=list(col=colors[.modc(1:length(zvals))], pch=symbols[.mods(1:length(zvals))])) key <- c(key, key.args) plot <- xyplot(eval(parse( text=paste("fit ~ as.numeric(", predictors[x.var], ")", if (n.predictors > 2) paste(" |", paste(predictors[-c(x.var, z.var)])), collapse="*"))), strip=function(...) strip.default(..., strip.names=c(factor.names, TRUE)), panel=function(x, y, subscripts, z, lower, upper, show.se, ...){ if (grid) panel.grid() for (i in 1:length(zvals)){ sub <- z[subscripts] == zvals[i] good <- !is.na(y[sub]) os <- if(show.se) (i - (length(zvals) + 1)/2) * (2/(length(zvals)-1)) * .01 * (length(zvals) - 1) else 0 effect.llines(x[sub][good]+os, y[sub][good], lwd=lwd, type='b', col=colors[.modc(i)], pch=symbols[.mods(i)], lty=lines[.modl(i)], cex=cex, ...) if (show.se){ larrows(x0=x[sub][good]+os, y0=lower[subscripts][sub][good], x1=x[sub][good]+os, y1=upper[subscripts][sub][good], angle=90, code=3, col=eval(colors[.modc(i)]), length=.125*cex/1.5) } } if (has.thresholds){ panel.abline(h=thresholds, lty=3) panel.text(rep(current.panel.limits()$xlim[1], length(thresholds)), thresholds, threshold.labels, adj=c(0,0), cex=0.75) panel.text(rep(current.panel.limits()$xlim[2], length(thresholds)), thresholds, threshold.labels, adj=c(1,0), cex=0.75) } }, ylim=ylim, ylab=ylab, xlab=if (missing(xlab)) predictors[x.var] else xlab, z=x[,z.var], scales=list(x=list(at=1:length(levs), labels=levs, rot=rotx), y=list(at=tickmarks$at, labels=tickmarks$labels, rot=roty), alternating=alternating), zvals=zvals, main=main, key=key, lower=x$lower, upper=x$upper, show.se=has.se && ci.style=="bars", data=x, ...) result <- update(plot, layout = if (missing(layout)) c(0, prod(dim(plot))) else layout) result$split <- split result$more <- more class(result) <- c("plot.eff", class(result)) } ### multiline variate else{ effect.llines <- if(use.splines) spline.llines else effect.llines nm <- names(x)[x.var] x.vals <- x.data[, nm] if (nm %in% names(ticks.x)){ at <- ticks.x[[nm]]$at n <- ticks.x[[nm]]$n } else{ at <- NULL n <- 5 } xlm <- if (nm %in% names(xlim)){ xlim[[nm]] } else range.adj(x[nm]) # range(x.vals) tickmarks.x <- if ((nm %in% names(transform.x)) && !(is.null(transform.x))){ trans <- transform.x[[nm]]$trans # make.ticks(trans(xlm), link=transform.x[[nm]]$trans, inverse=transform.x[[nm]]$inverse, at=ticks.x$at, n=ticks.x$n) make.ticks(trans(xlm), link=transform.x[[nm]]$trans, inverse=transform.x[[nm]]$inverse, at=at, n=n) } else { trans <- I make.ticks(xlm, link=I, inverse=I, at=at, n=n) } key<-list(title=predictors[z.var], cex.title=1, border=TRUE, text=list(as.character(zvals)), lines=list(col=colors[.modc(1:length(zvals))], lty=lines[.modl(1:length(zvals))], lwd=lwd)) key <- c(key, key.args) plot <- xyplot(eval(parse( text=paste("fit ~trans(", predictors[x.var], ")", if (n.predictors > 2) paste(" |", paste(predictors[-c(x.var, z.var)])), collapse="*"))), strip=function(...) strip.default(..., strip.names=c(factor.names, TRUE)), panel=function(x, y, subscripts, x.vals, rug, z, lower, upper, show.se, ...){ if (grid) panel.grid() if (rug) lrug(trans(x.vals)) axis.length <- diff(range(x)) for (i in 1:length(zvals)){ sub <- z[subscripts] == zvals[i] good <- !is.na(y[sub]) effect.llines(x[sub][good], y[sub][good], lwd=lwd, type='l', col=colors[.modc(i)], lty=lines[.modl(i)], cex=cex, ...) if(show.se){ if(ci.style == "bars"){ os <- (i - (length(zvals) + 1)/2) * (2/(length(zvals)-1)) * .01 * axis.length larrows(x0=x[sub][good]+os, y0=lower[subscripts][sub][good], x1=x[sub][good]+os, y1=upper[subscripts][sub][good], angle=90, code=3, col=eval(colors[.modc(i)]), length=.125*cex/1.5) } if(ci.style == "bands"){ panel.bands(x[sub][good], y[sub][good], upper[subscripts][sub][good], lower[subscripts][sub][good], fill=eval(band.colors[.modb(i)]), alpha=band.transparency, use.splines=use.splines) } } } if (has.thresholds){ panel.abline(h=thresholds, lty=3) panel.text(rep(current.panel.limits()$xlim[1], length(thresholds)), thresholds, threshold.labels, adj=c(0,0), cex=0.75) panel.text(rep(current.panel.limits()$xlim[2], length(thresholds)), thresholds, threshold.labels, adj=c(1,0), cex=0.75) } }, ylim=ylim, xlim=suppressWarnings(trans(xlm)), ylab=ylab, xlab=if (missing(xlab)) predictors[x.var] else xlab, x.vals=x.vals, rug=rug, z=x[,z.var], zvals=zvals, main=main, key=key, # lower=x$lower, upper=x$upper, show.se=has.se && ci.style %in% c("bars", "bands"), # data=x, scales=list(y=list(at=tickmarks$at, labels=tickmarks$labels), rot=roty, x=list(at=tickmarks.x$at, labels=tickmarks.x$labels, rot=rotx), alternating=alternating), ...) result <- update(plot, layout = if (missing(layout)) c(0, prod(dim(plot))) else layout) result$split <- split result$more <- more class(result) <- c("plot.eff", class(result)) } return(result) } # multiplot factor ci.style <- if(is.null(ci.style)){ if(is.factor(x[, x.var])) "bars" else "bands"} else ci.style range <- if (has.se && ci.style !="none") range(c(x$lower, x$upper), na.rm=TRUE) else range(x$fit, na.rm=TRUE) ylim <- if (!missing(ylim)) ylim else c(range[1] - .025*(range[2] - range[1]), range[2] + .025*(range[2] - range[1])) tickmarks <- if (type == "response") make.ticks(ylim, link=trans.link, inverse=trans.inverse, at=ticks$at, n=ticks$n) else make.ticks(ylim, link=I, inverse=I, at=ticks$at, n=ticks$n) if (is.factor(x[,x.var])){ levs <- levels(x[,x.var]) plot <- xyplot(eval(parse( text=paste("fit ~ as.numeric(", predictors[x.var], ") |", paste(predictors[-x.var], collapse="*")))), strip=function(...) strip.default(..., strip.names=c(factor.names, TRUE)), panel=function(x, y, subscripts, lower, upper, has.se, ...){ if (grid) panel.grid() good <- !is.na(y) if (has.se){ if (ci.style == "bars"){ larrows(x0=x[good], y0=lower[subscripts][good], x1=x[good], y1=upper[subscripts][good], angle=90, code=3, col=colors[.modc(2)], length=0.125*cex/1.5) } else if(ci.style == "lines") { effect.llines(x[good], lower[subscripts][good], lty=2, col=colors[.modc(2)]) effect.llines(x[good], upper[subscripts][good], lty=2, col=colors[.modc(2)]) } else{ if(ci.style == "bands") { panel.bands(x[good], y[good], upper[subscripts][good], lower[subscripts][good], fill=band.colors[1], alpha=band.transparency, use.splines=FALSE) }} } effect.llines(x[good], y[good], lwd=lwd, type='b', col=colors[1], pch=19, cex=cex, ...) if (has.thresholds){ panel.abline(h=thresholds, lty=3) panel.text(rep(current.panel.limits()$xlim[1], length(thresholds)), thresholds, threshold.labels, adj=c(0,0), cex=0.75) panel.text(rep(current.panel.limits()$xlim[2], length(thresholds)), thresholds, threshold.labels, adj=c(1,0), cex=0.75) } }, ylim=ylim, ylab=ylab, xlab=if (missing(xlab)) predictors[x.var] else xlab, scales=list(x=list(at=1:length(levs), labels=levs, rot=rotx), y=list(at=tickmarks$at, labels=tickmarks$labels, rot=roty), alternating=alternating), main=main, lower=x$lower, upper=x$upper, has.se=has.se, data=x, ...) result <- update(plot, layout = if (missing(layout)) c(0, prod(dim(plot))) else layout) result$split <- split result$more <- more class(result) <- c("plot.eff", class(result)) } ### multiplot variate else{ effect.llines <- if(use.splines) spline.llines else effect.llines nm <- names(x)[x.var] x.vals <- x.data[, nm] if (nm %in% names(ticks.x)){ at <- ticks.x[[nm]]$at n <- ticks.x[[nm]]$n } else{ at <- NULL n <- 5 } xlm <- if (nm %in% names(xlim)){ xlim[[nm]] } else range.adj(x[nm]) tickmarks.x <- if ((nm %in% names(transform.x)) && !(is.null(transform.x))){ trans <- transform.x[[nm]]$trans make.ticks(trans(xlm), link=transform.x[[nm]]$trans, inverse=transform.x[[nm]]$inverse, at=at, n=n) } else { trans <- I make.ticks(xlm, link=I, inverse=I, at=at, n=n) } plot <- xyplot(eval(parse( text=paste("fit ~ trans(", predictors[x.var], ") |", paste(predictors[-x.var], collapse="*")))), strip=function(...) strip.default(..., strip.names=c(factor.names, TRUE)), panel=function(x, y, subscripts, x.vals, rug, lower, upper, has.se, ...){ if (grid) panel.grid() good <- !is.na(y) effect.llines(x[good], y[good], lwd=lwd, col=colors[1], ...) if (rug) lrug(trans(x.vals)) if (has.se){ if (ci.style == "bars"){ larrows(x0=x[good], y0=lower[subscripts][good], x1=x[good], y1=upper[subscripts][good], angle=90, code=3, col=eval(colors[.modc(2)]), length=.125*cex/1.5) } else if(ci.style == "lines") { effect.llines(x[good], lower[subscripts][good], lty=2, col=colors[.modc(2)]) effect.llines(x[good], upper[subscripts][good], lty=2, col=colors[.modc(2)]) } else{ if(ci.style == "bands") { panel.bands(x[good], y[good], upper[subscripts][good], lower[subscripts][good], fill=band.colors[1], alpha=band.transparency, use.splines=use.splines) }} } if (has.thresholds){ panel.abline(h=thresholds, lty=3) panel.text(rep(current.panel.limits()$xlim[1], length(thresholds)), thresholds, threshold.labels, adj=c(0,0), cex=0.75) panel.text(rep(current.panel.limits()$xlim[2], length(thresholds)), thresholds, threshold.labels, adj=c(1,0), cex=0.75) } }, ylim=ylim, xlim=suppressWarnings(trans(xlm)), ylab=ylab, xlab=if (missing(xlab)) predictors[x.var] else xlab, x.vals=x.vals, rug=rug, main=main, lower=x$lower, upper=x$upper, has.se=has.se, data=x, scales=list(y=list(at=tickmarks$at, labels=tickmarks$labels, rot=roty), x=list(at=tickmarks.x$at, labels=tickmarks.x$labels, rot=rotx), alternating=alternating), ...) result <- update(plot, layout = if (missing(layout)) c(0, prod(dim(plot))) else layout) result$split <- split result$more <- more class(result) <- c("plot.eff", class(result)) } return(result) } print.plot.eff <- function(x, ...){ NextMethod(split=x$split, more=x$more, ...) invisible(x) } plot.efflist <- function(x, selection, rows, cols, ask=FALSE, graphics=TRUE, ...){ if (!missing(selection)){ if (is.character(selection)) selection <- gsub(" ", "", selection) return(plot(x[[selection]], ...)) } effects <- gsub(":", "*", names(x)) if (ask){ repeat { selection <- menu(effects, graphics=graphics, title="Select Term to Plot") if (selection == 0) break else print(plot(x[[selection]], ...)) } } else { neffects <- length(x) mfrow <- mfrow(neffects) if (missing(rows) || missing(cols)){ rows <- mfrow[1] cols <- mfrow[2] } for (i in 1:rows) { for (j in 1:cols){ if ((i-1)*cols + j > neffects) break more <- !((i-1)*cols + j == neffects) print(plot(x[[(i-1)*cols + j]], row=i, col=j, nrow=rows, ncol=cols, more=more, ...)) } } } } effects/R/summary-print-methods.R0000644000176000001440000002246612230233005016535 0ustar ripleyusers# plot, summary, and print methods for effects package # John Fox and Jangman Hong # last modified 2012-11-30 by J. Fox # 29 June 2011 added grid, rotx and roty arguments to the two plot methods # by S. Weisberg # 21 Dec 2012 modest modification of empty cells with crossed factors # 2013-01-17: Added factor.ci.style arg to plot.eff() and plot.effpoly(). J. Fox # 2013-01-18: Added CI bars to multiline plots with factor.ci.style="bars" # 2013-01-19: Renamed 'factor.ci.style' to 'ci.style'. Added a 'none' option # extended to variate terms if multiline=TRUE, ci.style="bars" # 2013-01-30: scale arrow "heads" for error bars relative to cex # 2013-05-31: fixed symbol colors in legends in plot.eff(). J. Fox # 2013-08-14: fixed bug in restoring warn option. J. Fox # 2013-08-27: fixed symbols argument for multiline plot in plot.eff(), reported by Ulrike Gromping. J. Fox # 2013-08-31: fixed handling of ticks.x argument. John # 2013-09-25: moved plot.eff methods to plot.methods.R for easier work. Michael # 2013-10-17: added use.splines argument to plot.effpoly. Sandy summary.eff <- function(object, type=c("response", "link"), ...){ result <- list() result$header <- paste("\n", gsub(":", "*", object$term), 'effect\n') result$offset <- object$offset type <- match.arg(type) if (type == "response") { object$fit <- object$transformation$inverse(object$fit) if (!is.null(object$confidence.level)){ object$lower <- object$transformation$inverse(object$lower) object$upper <- object$transformation$inverse(object$upper) } } result$effect <- array(object$fit, dim=sapply(object$variables, function(x) length(x$levels)), dimnames=lapply(object$variables, function(x) x$levels)) if (!is.null(object$se)){ result$lower.header <- paste('\n Lower', round(100*object$confidence.level, 2), 'Percent Confidence Limits\n') result$lower <- array(object$lower, dim=sapply(object$variables, function(x) length(x$levels)), dimnames=lapply(object$variables, function(x) x$levels)) result$upper.header <- paste('\n Upper', round(100*object$confidence.level, 2), 'Percent Confidence Limits\n') result$upper <- array(object$upper, dim=sapply(object$variables, function(x) length(x$levels)), dimnames=lapply(object$variables, function(x) x$levels)) } if (object$discrepancy > 1e-3) result$warning <- paste("\nWarning: There is an average discrepancy of", round(object$discrepancy, 3), "percent \n in the 'safe' predictions for effect", object$term, '\n') class(result) <- "summary.eff" result } print.summary.eff <- function(x, ...){ cat(x$header) if (x$offset != 0) cat("\noffset = ", x$offset, "\n\n") print(x$effect, ...) if (!is.null(x$lower)){ cat(x$lower.header) print(x$lower, ...) cat(x$upper.header) print(x$upper, ...) } if (!is.null(x$thresholds)){ cat("\nThresholds:\n") print(x$thresholds, ...) } if (!is.null(x$warning)) cat(x$warning) invisible(x) } print.eff <- function(x, type=c("response", "link"), ...){ cat(paste("\n", gsub(":", "*", x$term), 'effect\n')) if (x$offset != 0) cat("\noffset = ", x$offset, "\n\n") type <- match.arg(type) if (type == "response") x$fit <- x$transformation$inverse(x$fit) table <- array(x$fit, dim=sapply(x$variables, function(x) length(x$levels)), dimnames=lapply(x$variables, function(x) x$levels)) print(table, ...) if (x$discrepancy > 1e-3) cat(paste("\nWarning: There is an average discrepancy of", round(x$discrepancy, 3), "percent \n in the 'safe' predictions for effect", x$term, '\n')) invisible(x) } print.efflist <- function(x, ...){ cat(" model: ") form <- x[[1]]$formula attributes(form) <- NULL print(form) for (effect in names(x)){ print(x[[effect]], ...) } invisible(x) } summary.efflist <- function(object, ...){ cat(" model: ") form <- object[[1]]$formula attributes(form) <- NULL print(form) for (effect in names(object)){ print(summary(object[[effect]], ...)) } invisible(NULL) } print.effpoly <- function(x, type=c("probability", "logits"), ...){ type <- match.arg(type) x.frame <-as.data.frame(x) n.predictors <- length(names(x$x)) predictors <- names(x.frame)[1:n.predictors] y.lev <- x$y.lev ylevel.names <- make.names(paste("prob",y.lev)) colnames(x$prob) <- colnames(x$logit) <- ylevel.names y.categories <- matrix(0, nrow=length(x.frame[,predictors[1]]), ncol=length(y.lev)) for (i in 1:length(y.lev)){ level <- which(colnames(x$prob)[i] == ylevel.names) y.categories[,i] <- rep(y.lev[level], length(y.categories[,i])) } y.categories <- as.vector(y.categories) y.categories <- factor(y.categories) for (i in 1:length(y.lev)){ cat(paste("\n", gsub(":", "*", x$term), " effect (", type,") for ", y.lev[i], "\n", sep="")) table <- array(if (type == "probability") {x$prob[y.categories==y.lev[i]]} else {x$logit[y.categories==y.lev[i]]}, dim=sapply(x$variables, function(x) length(x$levels)), dimnames=lapply(x$variables, function(x) x$levels)) print(table, ...) } if (x$discrepancy > 0.1) cat(paste("\nWarning: There is an average discrepancy of", round(x$discrepancy, 2), "percent \n in the 'safe' predictions for effect", x$term, '\n')) invisible(x) } summary.effpoly <- function(object, type=c("probability", "logits"), ...){ type <- match.arg(type) x.frame <-as.data.frame(object) n.predictors <- length(names(object$x)) predictors <- names(x.frame)[1:n.predictors] y.lev <- object$y.lev ylevel.names <- make.names(paste("prob",y.lev)) colnames(object$prob) <- colnames(object$logit) <- colnames(object$lower.logit) <- colnames(object$upper.logit) <- colnames(object$lower.prob) <- colnames(object$upper.prob)<- ylevel.names y.categories <-matrix(0, nrow=length(x.frame[,predictors[1]]), ncol=length(y.lev)) for (i in 1:length(y.lev)){ level <- which(colnames(object$prob)[i] == ylevel.names) y.categories[,i] <- rep(y.lev[level], length(y.categories[,i])) } y.categories <- as.vector(y.categories) y.categories <- factor(y.categories) for (i in 1:length(y.lev)){ cat(paste("\n", gsub(":", "*", object$term), " effect (" , type, ") for ", y.lev[i], "\n", sep="")) table <- array(if (type == "probability") {object$prob[y.categories==y.lev[i]]} else {object$logit[y.categories==y.lev[i]]}, dim=sapply(object$variables, function(x) length(x$levels)), dimnames=lapply(object$variables, function(x) x$levels)) print(table, ...) } if (is.null(object$confidence.level)) return(invisible(NULL)) for (i in 1:length(y.lev)){ cat(paste("\n", 'Lower', object$confidence.level*100, 'Percent Confidence Limits for' , y.lev[i],'\n')) table <- if (type == "probability") object$lower.prob else object$lower.logit table <- array(table[y.categories==y.lev[i]], dim=sapply(object$variables, function(x) length(x$levels)), dimnames=lapply(object$variables, function(x) x$levels)) print(table, ...) } for (i in 1:length(y.lev)){ cat(paste("\n", 'Upper', object$confidence.level*100, 'Percent Confidence Limits for' , y.lev[i],'\n')) table <- if (type == "probability") object$upper.prob else object$upper.logit table <- array(table[y.categories==y.lev[i]], dim=sapply(object$variables, function(x) length(x$levels)), dimnames=lapply(object$variables, function(x) x$levels)) print(table, ...) } if (object$discrepancy > 0.1) cat(paste("\nWarning: There is an average discrepancy of", round(object$discrepancy, 2), "percent \n in the 'safe' predictions for effect", object$term, '\n')) invisible(NULL) } print.efflatent <- function(x, ...){ cat(paste("\n", gsub(":", "*", x$term), 'effect\n')) table <- array(x$fit, dim=sapply(x$variables, function(x) length(x$levels)), dimnames=lapply(x$variables, function(x) x$levels)) print(table, ...) cat("\nThresholds:\n") print(x$thresholds, ...) if (x$discrepancy > 0.1) cat(paste("\nWarning: There is an average discrepancy of", round(x$discrepancy, 3), "percent \n in the 'safe' predictions for effect", x$term, '\n')) invisible(x) } summary.efflatent <- function(object, ...){ result <- list() result$header <- paste("\n", gsub(":", "*", object$term), 'effect\n') result$effect <- array(object$fit, dim=sapply(object$variables, function(x) length(x$levels)), dimnames=lapply(object$variables, function(x) x$levels)) if (!is.null(object$se)){ result$lower.header <- paste('\n Lower', round(100*object$confidence.level, 2), 'Percent Confidence Limits\n') result$lower <- array(object$lower, dim=sapply(object$variables, function(x) length(x$levels)), dimnames=lapply(object$variables, function(x) x$levels)) result$upper.header <- paste('\n Upper', round(100*object$confidence.level, 2), 'Percent Confidence Limits\n') result$upper <- array(object$upper, dim=sapply(object$variables, function(x) length(x$levels)), dimnames=lapply(object$variables, function(x) x$levels)) } result$thresholds <- object$thresholds if (object$discrepancy > 0.1) result$warning <- paste("\nWarning: There is an average discrepancy of", round(object$discrepancy, 3), "percent \n in the 'safe' predictions for effect", object$term, '\n') class(result) <- "summary.eff" result } effects/R/Effect.R0000644000176000001440000005336212236477134013463 0ustar ripleyusers# Effect generic and methods # John Fox and Sanford Weisberg # last modified 2012-12-08 by J. Fox # 12-21-2012 Allow for empty cells in factor interactions, S. Weisberg # 2012-03-05: Added .merMod method for development version of lme4, J. Fox # 2012-04-06: Added support for lme4.0, J. Fox # 2013-07-15: Changed default xlevels and default.levels # 2013-10-15: Added Effect.default(). J. Fox # 2013-10-22: fixed bug in Effect.lm() when na.action=na.exclude. J. Fox # 2013-10-29: code to handle "valid" NAs in factors. J. Fox # 2013-11-06: fixed bug in Effect.multinom() in construction of effect object # when there is only one focal predictor; caused as.data.frame.effpoly() to fail Effect <- function(focal.predictors, mod, ...){ UseMethod("Effect", mod) } Effect.lm <- function (focal.predictors, mod, xlevels = list(), default.levels = NULL, given.values, se = TRUE, confidence.level = 0.95, transformation = list(link = family(mod)$linkfun, inverse = family(mod)$linkinv), typical = mean, offset = mean, ...){ if (missing(given.values)) given.values <- NULL else if (!all(which <- names(given.values) %in% names(coef(mod)))) stop("given.values (", names(given.values[!which]), ") not in the model") off <- if (is.numeric(offset) && length(offset) == 1) offset else if (is.function(offset)) { mod.off <- model.offset(model.frame(mod)) if (is.null(mod.off)) 0 else offset(mod.off) } else stop("offset must be a function or a number") formula.rhs <- formula(mod)[[3]] model.components <- Analyze.model(focal.predictors, mod, xlevels, default.levels, formula.rhs) excluded.predictors <- model.components$excluded.predictors predict.data <- model.components$predict.data factor.levels <- model.components$factor.levels factor.cols <- model.components$factor.cols n.focal <- model.components$n.focal x <- model.components$x X.mod <- model.components$X.mod cnames <- model.components$cnames X <- model.components$X formula.rhs <- formula(mod)[c(1, 3)] Terms <- delete.response(terms(mod)) mf <- model.frame(Terms, predict.data, xlev = factor.levels, na.action=NULL) mod.matrix <- model.matrix(formula.rhs, data = mf, contrasts.arg = mod$contrasts) wts <- weights(mod) # mod$weights if (is.null(wts)) wts <- rep(1, length(residuals(mod))) mod.matrix <- Fixup.model.matrix(mod, mod.matrix, model.matrix(mod), X.mod, factor.cols, cnames, focal.predictors, excluded.predictors, typical, given.values) # look for aliased coefficients and remove those columns from mod.matrix mod.matrix <- mod.matrix[, !is.na(mod$coefficients)] effect <- off + mod.matrix %*% mod$coefficients[!is.na(mod$coefficients)] # end result <- list(term = paste(focal.predictors, collapse="*"), formula = formula(mod), response = response.name(mod), variables = x, fit = effect, x = predict.data[, 1:n.focal, drop=FALSE], model.matrix = mod.matrix, data = X, discrepancy = 0, offset=off) # find empty cells, if any, and correct whichFact <- unlist(lapply(result$variables, function(x) x$is.factor)) zeroes <- NULL if(sum(whichFact) > 1){ nameFact <- names(whichFact)[whichFact] counts <- xtabs(as.formula( paste("~", paste(nameFact, collapse="+"))), model.frame(mod)) zeroes <- which(counts == 0) } if(length(zeroes) > 0){ levs <- expand.grid(lapply(result$variables, function(x) x$levels)) good <- rep(TRUE, dim(levs)[1]) for(z in zeroes){ good <- good & apply(levs, 1, function(x) !all(x == levs[z, whichFact])) } result$fit[!good] <- NA } # end of change if (se) { if (any(family(mod)$family == c("binomial", "poisson"))) { dispersion <- 1 z <- qnorm(1 - (1 - confidence.level)/2) } else { dispersion <- sum(wts * (residuals(mod))^2, na.rm=TRUE)/mod$df.residual # sum(wts * mod$residuals^2)/mod$df.residual z <- qt(1 - (1 - confidence.level)/2, df = mod$df.residual) } V2 <- dispersion * summary.lm(mod)$cov V1 <- vcov(mod) V <- if (inherits(mod, "fakeglm")) V1 else V2 vcov <- mod.matrix %*% V %*% t(mod.matrix) rownames(vcov) <- colnames(vcov) <- NULL var <- diag(vcov) result$vcov <- vcov result$se <- sqrt(var) result$lower <- effect - z * result$se result$upper <- effect + z * result$se result$confidence.level <- confidence.level # zero cells if(length(zeroes) > 0){ result$se[!good] <- NA result$lower[!good] <- NA result$upper[!good] <- NA } # end zero cells } if (is.null(transformation$link) && is.null(transformation$inverse)) { transformation$link <- I transformation$inverse <- I } result$transformation <- transformation class(result) <- "eff" result } Effect.mer <- function(focal.predictors, mod, ...) { # if ((!require(lme4, quietly=TRUE)) && (!require(lme4.0, quietly=TRUE))) # stop("the lme4 or lme4.0 package is not installed") result <- Effect(focal.predictors, mer.to.glm(mod), ...) result$formula <- as.formula(formula(mod)) result } Effect.merMod <- function(focal.predictors, mod, ...){ Effect.mer(focal.predictors, mod, ...) } Effect.lme <- function(focal.predictors, mod, ...) { # if (!require(nlme)) stop("the nlme package is not installed") result <- Effect(focal.predictors, lme.to.glm(mod), ...) result$formula <- as.formula(formula(mod)) result } Effect.gls <- function (focal.predictors, mod, xlevels = list(), default.levels = NULL, given.values, se = TRUE, confidence.level = 0.95, transformation = NULL, typical = mean, ...){ if (missing(given.values)) given.values <- NULL else if (!all(which <- names(given.values) %in% names(coef(mod)))) stop("given.values (", names(given.values[!which]), ") not in the model") formula.rhs <- formula(mod)[[3]] mod.lm <- lm(as.formula(mod$call$model), data=eval(mod$call$data)) model.components <- Analyze.model(focal.predictors, mod.lm, xlevels, default.levels, formula.rhs) excluded.predictors <- model.components$excluded.predictors predict.data <- model.components$predict.data factor.levels <- model.components$factor.levels factor.cols <- model.components$factor.cols n.focal <- model.components$n.focal x <- model.components$x X.mod <- model.components$X.mod cnames <- model.components$cnames X <- model.components$X formula.rhs <- formula(mod)[c(1, 3)] nrow.X <- nrow(X) mf <- model.frame(formula.rhs, data=rbind(X[,names(predict.data),drop=FALSE], predict.data), xlev=factor.levels) mod.matrix.all <- model.matrix(formula.rhs, data=mf, contrasts.arg=mod$contrasts) mod.matrix <- mod.matrix.all[-(1:nrow.X),] mod.matrix <- Fixup.model.matrix(mod.lm, mod.matrix, model.matrix(mod.lm), X.mod, factor.cols, cnames, focal.predictors, excluded.predictors, typical, given.values) fit.1 <- na.omit(predict(mod)) mod.2 <- lm.fit(mod.matrix.all[1:nrow.X,], fit.1) class(mod.2) <- "lm" # assign(".y", na.omit(model.response.gls(mod)), envir=.GlobalEnv) # assign(".X", na.omit(mod.matrix.all[1:nrow.X,]), envir=.GlobalEnv) .Data <- list(.y=na.omit(model.response.gls(mod)), .X=na.omit(mod.matrix.all[1:nrow.X,])) mod.3 <- update(mod, .y ~ .X - 1, data=.Data) # remove(".X", ".y", envir=.GlobalEnv) discrepancy <- 100*mean(abs(fitted(mod.2)- fit.1)/(1e-10 + mean(abs(fit.1)))) if (discrepancy > 1e-3) warning(paste("There is a discrepancy of", round(discrepancy, 3), "percent \n in the 'safe' predictions used to generate effect", paste(focal.predictors, collapse="*"))) effect <- mod.matrix %*% mod$coefficients result <- list(term = paste(focal.predictors, collapse="*"), formula = formula(mod), response = response.name(mod), variables = x, fit = effect, x = predict.data[, 1:n.focal, drop=FALSE], model.matrix = mod.matrix, data = X, discrepancy = discrepancy, offset=0) if (se){ df.res <- mod$dims[["N"]] - mod$dims[["p"]] z <- qt(1 - (1 - confidence.level)/2, df=df.res) mod.2$terms <- terms(mod) V <- vcov(mod.3) vcov <- mod.matrix %*% V %*% t(mod.matrix) rownames(vcov) <- colnames(vcov) <- NULL var <- diag(vcov) result$vcov <- vcov result$se <- sqrt(var) result$lower <- effect - z*result$se result$upper <- effect + z*result$se result$confidence.level <- confidence.level } if (is.null(transformation$link) && is.null(transformation$inverse)){ transformation$link <- I transformation$inverse <- I } result$transformation <- transformation class(result) <- "eff" result } Effect.multinom <- function(focal.predictors, mod, confidence.level=.95, xlevels=list(), default.levels=NULL, given.values, se=TRUE, typical=mean, ...){ if (length(mod$lev) < 3) stop("effects for multinomial logit model only available for response levels > 2") if (missing(given.values)) given.values <- NULL else if (!all(which <- colnames(given.values) %in% names(coef(mod)))) stop("given.values (", colnames(given.values[!which]),") not in the model") formula.rhs <- formula(mod)[c(1, 3)] model.components <- Analyze.model(focal.predictors, mod, xlevels, default.levels, formula.rhs) excluded.predictors <- model.components$excluded.predictors predict.data <- model.components$predict.data factor.levels <- model.components$factor.levels factor.cols <- model.components$factor.cols n.focal <- model.components$n.focal x <- model.components$x X.mod <- model.components$X.mod cnames <- model.components$cnames X <- model.components$X formula.rhs <- formula(mod)[c(1, 3)] Terms <- delete.response(terms(mod)) mf <- model.frame(Terms, predict.data, xlev = factor.levels) mod.matrix <- model.matrix(formula.rhs, data = mf, contrasts.arg = mod$contrasts) X0 <- Fixup.model.matrix(mod, mod.matrix, model.matrix(mod), X.mod, factor.cols, cnames, focal.predictors, excluded.predictors, typical, given.values) resp.names <- make.names(mod$lev, unique=TRUE) resp.names <- c(resp.names[-1], resp.names[1]) # make the last level the reference level B <- t(coef(mod)) V <- vcov(mod) m <- ncol(B) + 1 p <- nrow(B) r <- p*(m - 1) n <- nrow(X0) P <- Logit <- matrix(0, n, m) colnames(P) <- paste("prob.", resp.names, sep="") colnames(Logit) <- paste("logit.", resp.names, sep="") if (se){ z <- qnorm(1 - (1 - confidence.level)/2) Lower.P <- Upper.P <- Lower.logit <- Upper.logit <- SE.P <- SE.logit <- matrix(0, n, m) colnames(Lower.logit) <- paste("L.logit.", resp.names, sep="") colnames(Upper.logit) <- paste("U.logit.", resp.names, sep="") colnames(Lower.P) <- paste("L.prob.", resp.names, sep="") colnames(Upper.P) <- paste("U.prob.", resp.names, sep="") colnames(SE.P) <- paste("se.prob.", resp.names, sep="") colnames(SE.logit) <- paste("se.logit.", resp.names, sep="") } for (i in 1:n){ res <- eff.mul(X0[i,], B, se, m, p, r, V) # compute effects P[i,] <- prob <- res$p # fitted probabilities Logit[i,] <- logit <- res$logits # fitted logits if (se){ SE.P[i,] <- se.p <- res$std.err.p # std. errors of fitted probs SE.logit[i,] <- se.logit <- res$std.error.logits # std. errors of logits Lower.P[i,] <- logit2p(logit - z*se.logit) Upper.P[i,] <- logit2p(logit + z*se.logit) Lower.logit[i,] <- logit - z*se.logit Upper.logit[i,] <- logit + z*se.logit } } resp.levs <- c(m, 1:(m-1)) # restore the order of the levels P <- P[, resp.levs] Logit <- Logit[, resp.levs] if (se){ Lower.P <- Lower.P[, resp.levs] Upper.P <- Upper.P[, resp.levs] Lower.logit <- Lower.logit[, resp.levs] Upper.logit <- Upper.logit[, resp.levs] SE.P <- SE.P[, resp.levs] SE.logit <- SE.logit[, resp.levs] } result <- list(term=paste(focal.predictors, collapse="*"), formula=formula(mod), response=response.name(mod), y.levels=mod$lev, variables=x, x=predict.data[, focal.predictors, drop=FALSE], model.matrix=X0, data=X, discrepancy=0, model="multinom", prob=P, logit=Logit) if (se) result <- c(result, list(se.prob=SE.P, se.logit=SE.logit, lower.logit=Lower.logit, upper.logit=Upper.logit, lower.prob=Lower.P, upper.prob=Upper.P, confidence.level=confidence.level)) # find empty cells, if any, and correct whichFact <- unlist(lapply(result$variables, function(x) x$is.factor)) zeroes <- NULL if(sum(whichFact) > 1){ nameFact <- names(whichFact)[whichFact] counts <- xtabs(as.formula( paste("~", paste(nameFact, collapse="+"))), model.frame(mod)) zeroes <- which(counts == 0) } if(length(zeroes) > 0){ levs <- expand.grid(lapply(result$variables, function(x) x$levels)) good <- rep(TRUE, dim(levs)[1]) for(z in zeroes){ good <- good & apply(levs, 1, function(x) !all(x == levs[z, whichFact])) } result$prob[!good, ] <- NA result$logit[!good, ] <- NA if (se){ result$se.prob[!good, ] <- NA result$se.logit[!good, ] <- NA result$lower.prob[!good, ] <- NA result$upper.prob[!good, ] <- NA } } class(result) <-'effpoly' result } Effect.polr <- function(focal.predictors, mod, confidence.level=.95, xlevels=list(), default.levels=NULL, given.values, se=TRUE, typical=mean, latent=FALSE, ...){ if (mod$method != "logistic") stop('method argument to polr must be "logistic"') if (missing(given.values)) given.values <- NULL else if (!all(which <- names(given.values) %in% names(coef(mod)))) stop("given.values (", names(given.values[!which]),") not in the model") formula.rhs <- formula(mod)[c(1, 3)] model.components <- Analyze.model(focal.predictors, mod, xlevels, default.levels, formula.rhs) excluded.predictors <- model.components$excluded.predictors predict.data <- model.components$predict.data factor.levels <- model.components$factor.levels factor.cols <- model.components$factor.cols n.focal <- model.components$n.focal x <- model.components$x X.mod <- model.components$X.mod cnames <- model.components$cnames X <- model.components$X Terms <- delete.response(terms(mod)) mf <- model.frame(Terms, predict.data, xlev = factor.levels, na.action=NULL) mod.matrix <- model.matrix(formula.rhs, data = mf, contrasts.arg = mod$contrasts) X0 <- Fixup.model.matrix(mod, mod.matrix, model.matrix(mod), X.mod, factor.cols, cnames, focal.predictors, excluded.predictors, typical, given.values) resp.names <- make.names(mod$lev, unique=TRUE) X0 <- X0[,-1, drop=FALSE] b <- coef(mod) p <- length(b) # corresponds to p - 1 in the text alpha <- - mod$zeta # intercepts are negatives of thresholds z <- qnorm(1 - (1 - confidence.level)/2) result <- list(term=paste(focal.predictors, collapse="*"), formula=formula(mod), response=response.name(mod), y.levels=mod$lev, variables=x, x=predict.data[, focal.predictors, drop=FALSE], model.matrix=X0, data=X, discrepancy=0, model="polr") if (latent){ res <- eff.latent(X0, b, vcov(mod)[1:p, 1:p], se) result$fit <- res$fit if (se){ result$se <- res$se result$lower <- result$fit - z*result$se result$upper <- result$fit + z*result$se result$confidence.level <- confidence.level } transformation <- list() transformation$link <- I transformation$inverse <- I result$transformation <- transformation result$thresholds <- -alpha class(result) <- c("efflatent", "eff") return(result) } m <- length(alpha) + 1 r <- m + p - 1 indices <- c((p+1):r, 1:p) V <- vcov(mod)[indices, indices] for (j in 1:(m-1)){ # fix up the signs of the covariances V[j,] <- -V[j,] # for the intercepts V[,j] <- -V[,j]} n <- nrow(X0) P <- Logit <- matrix(0, n, m) colnames(P) <- paste("prob.", resp.names, sep="") colnames(Logit) <- paste("logit.", resp.names, sep="") if (se){ Lower.logit <- Upper.logit <- Lower.P <- Upper.P <- SE.P <- SE.Logit <- matrix(0, n, m) colnames(Lower.logit) <- paste("L.logit.", resp.names, sep="") colnames(Upper.logit) <- paste("U.logit.", resp.names, sep="") colnames(Lower.P) <- paste("L.prob.", resp.names, sep="") colnames(Upper.P) <- paste("U.prob.", resp.names, sep="") colnames(SE.P) <- paste("se.prob.", resp.names, sep="") colnames(SE.Logit) <- paste("se.logit.", resp.names, sep="") } for (i in 1:n){ res <- eff.polr(X0[i,], b, alpha, V, m, r, se) # compute effects P[i,] <- prob <- res$p # fitted probabilities Logit[i,] <- logit <- res$logits # fitted logits if (se){ SE.P[i,] <- se.p <- res$std.err.p # std. errors of fitted probs SE.Logit[i,] <- se.logit <- res$std.error.logits # std. errors of logits Lower.P[i,] <- logit2p(logit - z*se.logit) Upper.P[i,] <- logit2p(logit + z*se.logit) Lower.logit[i,] <- logit - z*se.logit Upper.logit[i,] <- logit + z*se.logit } } result$prob <- P result$logit <- Logit if (se) result <- c(result, list(se.prob=SE.P, se.logit=SE.Logit, lower.logit=Lower.logit, upper.logit=Upper.logit, lower.prob=Lower.P, upper.prob=Upper.P, confidence.level=confidence.level)) class(result) <-'effpoly' result } Effect.default <- function(focal.predictors, mod, xlevels = list(), default.levels = NULL, given.values, se = TRUE, confidence.level = 0.95, transformation = list(link = I, inverse = I), typical = mean, offset = mean, ...){ if (missing(given.values)) given.values <- NULL else if (!all(which <- names(given.values) %in% names(coef(mod)))) stop("given.values (", names(given.values[!which]), ") not in the model") off <- if (is.numeric(offset) && length(offset) == 1) offset else if (is.function(offset)) { mod.off <- model.offset(model.frame(mod)) if (is.null(mod.off)) 0 else offset(mod.off) } else stop("offset must be a function or a number") formula.rhs <- formula(mod)[[3]] model.components <- Analyze.model(focal.predictors, mod, xlevels, default.levels, formula.rhs) excluded.predictors <- model.components$excluded.predictors predict.data <- model.components$predict.data factor.levels <- model.components$factor.levels factor.cols <- model.components$factor.cols n.focal <- model.components$n.focal x <- model.components$x X.mod <- model.components$X.mod cnames <- model.components$cnames X <- model.components$X formula.rhs <- formula(mod)[c(1, 3)] Terms <- delete.response(terms(mod)) mf <- model.frame(Terms, predict.data, xlev = factor.levels, na.action=NULL) mod.matrix <- model.matrix(formula.rhs, data = mf, contrasts.arg = mod$contrasts) mod.matrix <- Fixup.model.matrix(mod, mod.matrix, model.matrix(mod), X.mod, factor.cols, cnames, focal.predictors, excluded.predictors, typical, given.values) mod.matrix <- mod.matrix[, !is.na(coef(mod))] effect <- off + mod.matrix %*% mod$coefficients[!is.na(coef(mod))] result <- list(term = paste(focal.predictors, collapse="*"), formula = formula(mod), response = response.name(mod), variables = x, fit = effect, x = predict.data[, 1:n.focal, drop=FALSE], model.matrix = mod.matrix, data = X, discrepancy = 0, offset=off) whichFact <- unlist(lapply(result$variables, function(x) x$is.factor)) zeroes <- NULL if(sum(whichFact) > 1){ nameFact <- names(whichFact)[whichFact] counts <- xtabs(as.formula( paste("~", paste(nameFact, collapse="+"))), model.frame(mod)) zeroes <- which(counts == 0) } if(length(zeroes) > 0){ levs <- expand.grid(lapply(result$variables, function(x) x$levels)) good <- rep(TRUE, dim(levs)[1]) for(z in zeroes){ good <- good & apply(levs, 1, function(x) !all(x == levs[z, whichFact])) } result$fit[!good] <- NA } if (se) { z <- qnorm(1 - (1 - confidence.level)/2) V <- vcov(mod) vcov <- mod.matrix %*% V %*% t(mod.matrix) rownames(vcov) <- colnames(vcov) <- NULL var <- diag(vcov) result$vcov <- vcov result$se <- sqrt(var) result$lower <- effect - z * result$se result$upper <- effect + z * result$se result$confidence.level <- confidence.level if(length(zeroes) > 0){ result$se[!good] <- NA result$lower[!good] <- NA result$upper[!good] <- NA } } result$transformation <- transformation class(result) <- "eff" result }effects/R/Effect.mlm.R0000644000176000001440000000147012236346504014234 0ustar ripleyusers# Calculate Effects for term(s) in a Multivariate Linear Model Effect.mlm <- function(focal.predictors, mod, response, ...) { if (missing(response)) { mod.frame <- model.frame(mod) response <- colnames(model.response(mod.frame)) } else if (is.numeric(response)) { mod.frame <- model.frame(mod) response.names <- colnames(model.response(mod.frame)) response <- response.names[response] } if (length(response)==1) { mod.1 <- update(mod, as.formula(paste(response, " ~ ."))) result <- Effect(focal.predictors, mod.1, ...) } else { result <- as.list(NULL) for (resp in response) { mod.1 <- update(mod, as.formula(paste(resp, " ~ ."))) lab <- resp result[[lab]] <- Effect(focal.predictors, mod.1, ...) } class(result) <- "efflist" } result } effects/MD50000644000176000001440000000323112236725756012247 0ustar ripleyusers932d0fc5d5ed22452775d8350de6e091 *DESCRIPTION 2f97252c2ec52d882310efe916f4334f *NAMESPACE 8940811188602947adafaede2a474b70 *NEWS d8f03492baff8c550f623009967c4d9a *R/Effect.R e217536f8afeb3c99b619c7e65850579 *R/Effect.mlm.R 9b66e02dbf4469470327be7c2a2605f8 *R/effects.R 9534e671584835e2ef452e99dfaeea99 *R/effectsmer.R 2ae3d8ecfb094e5820d872a5240dfd5e *R/effectspoLCA.R 9d503c39201baafb4e14e2d76c48e5ea *R/plot-methods.R 15727e90e6a67a4f1a4383fc5069b449 *R/plot.effpoly.R 0bb21fdd0b65a9093bdc583428a82600 *R/summary-print-methods.R ba1078fc028c90ac321b4f831be66fc7 *R/utilities.R 4d9bf86613bd53ea5c001b3b89c46aad *data/Arrests.rda b422f41e9adca31bb6693439963a2ee1 *data/BEPS.rda 5c1684fbad928c97552754929375f098 *data/Cowles.rda 8cf6d9a640f7af46b835fef8d98ec3ed *data/Hartnagel.rda d46e72193f8a712bf8f60d0fdff6d2c5 *data/Prestige.rda b23a91193485b6e13698eebb69089d8b *data/TitanicSurvival.rda d6d0a5b7289820da0ea9481bd34637ea *data/WVS.rda 0dd50a84dd1e0b7389bc90bc15f92456 *data/Wells.rda 809fa4f25bbbd3e6d146c26d7ae3907e *inst/CHANGES e6b77c2338408b6fdf1a617eaa014a2b *inst/CITATION 2cf51c803a105bfe15c89e1d38075dd4 *man/Arrests.Rd df3b179a879e7905bf9696ee05751707 *man/BEPS.Rd 8751e2c091279ca02cfac5845b196c77 *man/Cowles.Rd 73d76fd4ac46673ccbdbd07b8e199300 *man/Hartnagel.Rd 3f0741a1feb35e53cdc4fc6da672c28e *man/Prestige.Rd a2697326c6634deeba023eb2db80ffea *man/Titanic.Rd 1db6f08e1b42d137e1ca3f76918cc70a *man/WVS.Rd 18f83ed88afe8b1ecae2dbc3dc986b66 *man/Wells.Rd be6d207edcb84d1a19b237da2ab88815 *man/effect.Rd 03336c030e40258fc3316c4cb0c707d1 *man/effects-deprecated.Rd 018d9fd547eae2a299c08a273de704eb *man/effects-package.Rd 3a45d95dc88683908c8cfc344bcef59a *man/summary.effect.Rd effects/DESCRIPTION0000644000176000001440000000261112236725756013446 0ustar ripleyusersPackage: effects Version: 2.3-0 Date: 2013/11/06 Title: Effect Displays for Linear, Generalized Linear, Multinomial-Logit, Proportional-Odds Logit Models and Mixed-Effects Models Authors@R: c(person("John", "Fox", role = c("aut", "cre"), email = "jfox@mcmaster.ca"), person("Sanford", "Weisberg", role = "aut", email = "sandy@umn.edu"), person("Michael", "Friendly", role = "aut", email = "friendly@yorku.ca"), person("Jangman", "Hong", role = "aut"), person("Robert", "Andersen", role = "ctb"), person("David", "Firth", role = "ctb"), person("Steve", "Taylor", role = "ctb")) Depends: R (>= 2.10), lattice, grid, colorspace Suggests: nlme, lme4, MASS, nnet, poLCA, heplots LazyLoad: yes LazyData: yes Description: Graphical and tabular effect displays, e.g., of interactions, for various statistical models with linear predictors. License: GPL (>= 2) URL: http://www.r-project.org, http://socserv.socsci.mcmaster.ca/jfox/ Author: John Fox [aut, cre], Sanford Weisberg [aut], Michael Friendly [aut], Jangman Hong [aut], Robert Andersen [ctb], David Firth [ctb], Steve Taylor [ctb] Maintainer: John Fox Repository: CRAN Repository/R-Forge/Project: effects Repository/R-Forge/Revision: 153 Repository/R-Forge/DateTimeStamp: 2013-11-06 17:37:32 Date/Publication: 2013-11-07 16:04:14 Packaged: 2013-11-06 19:16:11 UTC; rforge NeedsCompilation: no effects/man/0000755000176000001440000000000012236511700012471 5ustar ripleyuserseffects/man/summary.effect.Rd0000644000176000001440000004304712231504226015720 0ustar ripleyusers\name{summary.eff} \alias{print.eff} \alias{print.effpoly} \alias{print.efflatent} \alias{print.efflist} \alias{print.summary.eff} \alias{summary.eff} \alias{summary.effpoly} \alias{summary.efflatent} \alias{summary.efflist} \alias{plot.eff} \alias{plot.effpoly} \alias{plot.efflist} \alias{[.efflist} \title{Summarizing, Printing, and Plotting Effects} \description{ \code{summary}, \code{print}, \code{plot}, and \code{[} methods for \code{eff}, \code{effpoly}, and \code{efflist} objects. } \usage{ \method{print}{eff}(x, type=c("response", "link"), ...) \method{print}{effpoly}(x, type=c("probability", "logits"), ...) \method{print}{efflatent}(x, ...) \method{print}{efflist}(x, ...) \method{print}{summary.eff}(x, ...) \method{summary}{eff}(object, type=c("response", "link"), ...) \method{summary}{effpoly}(object, type=c("probability", "logits"), ...) \method{summary}{efflatent}(object, ...) \method{summary}{efflist}(object, ...) \method{plot}{eff}(x, x.var=which.max(levels), z.var=which.min(levels), multiline=is.null(x$se), rug=TRUE, xlab, ylab, main=paste(effect, "effect plot"), colors=palette(), symbols=1:length(colors), lines=1:length(colors), cex=1.5, lwd=2, ylim, xlim=NULL, factor.names=TRUE, ci.style, band.transparency=0.2, band.colors=colors, type=c("response", "link"), ticks=list(at=NULL, n=5), alternating=TRUE, rotx=0, roty=0, grid=FALSE, layout, rescale.axis=TRUE, transform.x=NULL, ticks.x=NULL, key.args=NULL, row=1, col=1, nrow=1, ncol=1, more=FALSE, use.splines=TRUE, ...) \method{plot}{effpoly}(x, type=c("probability", "logit"), x.var=which.max(levels), rug=TRUE, xlab, ylab=paste(x$response, " (", type, ")", sep=""), main=paste(effect, "effect plot"), colors, symbols, lines, cex=1.5, lwd=2, factor.names=TRUE, ci.style, band.colors, band.transparency=0.3, style=c("lines", "stacked"), confint=(style == "lines" && !is.null(x$confidence.level)), transform.x=NULL, ticks.x=NULL, xlim=NULL, ylim, rotx=0, alternating=TRUE, roty=0, grid=FALSE, layout, key.args=NULL, row=1, col=1, nrow=1, ncol=1, more=FALSE, use.splines=TRUE, ...) \method{plot}{efflist}(x, selection, rows, cols, ask=FALSE, graphics=TRUE, ...) \method{[}{efflist}(x, ...) } \arguments{ \item{x}{an object of class \code{"eff"}, \code{"effpoly"}, \code{"efflist"}, or \code{"summary.eff"}, as appropriate.} \item{object}{an object of class \code{"eff"}, \code{"effpoly"}, or \code{"efflist"}, as appropriate.} \item{type}{for linear and generalized linear models, if \code{"response"} (the default), effects are printed or the vertical axis is labelled on the scale of the response variable; if \code{"link"}, effects are printed or the vertical axis labelled on the scale of the linear predictor. For polytomous logit models, this argument takes either \code{"probability"} or \code{"logit"}, with the former as the default.} \item{x.var}{the index (number) or quoted name of the covariate or factor to place on the horizontal axis of each panel of the effect plot. The default is the predictor with the largest number of levels or values.} \item{z.var}{for linear, generalized linear or mixed models, the index (number) or quoted name of the covariate or factor for which individual lines are to be drawn in each panel of the effect plot. The default is the predictor with the smallest number of levels or values. This argument is only used if \code{multiline = TRUE}.} \item{multiline}{for linear, generalized linear or mixed models, if \code{TRUE}, each panel of the display represents combinations of values of two predictors, with one predictor (corresponding to \code{x.var}) on the horzontal axis, and the other (corresponding to \code{z.var}) used to define lines in the graph; defaults to \code{TRUE} if there are no standard errors in the object being plotted, and \code{FALSE} otherwise.} \item{confint}{plot point-wise confidence bands around fitted effects (for multinomial and proportional-odds logit models); defaults to \code{TRUE}, in which case separate panels are used for different response levels.} \item{rug}{if \code{TRUE}, the default, a rug plot is shown giving the marginal distribution of the predictor on the horizontal axis, if this predictor is a covariate.} \item{xlab}{the label for the horizontal axis of the effect plot; if missing, the function will use the name of the predictor on the horizontal axis.} \item{ylab}{the label for the vertical axis of the effect plot; the default is constructed from the name of the response variable for the model from which the effect was computed.} \item{main}{the title for the plot, printed at the top; the default title is constructed from the name of the effect.} \item{colors}{\code{colors[1]} is used to plot effects, \code{colors[2]} to plot confidence limits when \code{ci.style} is not equal to \code{"bands"}. In a mulitline plot, the successive \code{colors} correspond to the levels of the \code{z.var} covariate or factor. In a stacked plot or a plot without confidence bands for a multinomial or proportional-odds logit model, the successive \code{colors} correspond to the levels of the response factor. In all but stacked plots, \code{colors} defaults to \code{palette()}. If \code{colors} is shorter than the number of levels, then it is recycled, so \code{colors="black"} will use black for all levels. For stacked multinomial-logit plots, \code{colors} defaults to \code{rainbow_hcl(levels)}, where \code{levels} is the number of levels of the response variable; for stacked proportional-odds model plots, \code{colors} defautls to \code{sequential_hcl(levels)}. \code{colors} does not recycle for stacked plots. \bold{Warning:} This argument \emph{cannot} be abbreviated to \code{col}, which is used for a different purpose (see below).} \item{symbols, lines}{corresponding to the levels of the \code{z.var} covariate or factor on a multiline plot, or to the successive levels of the response factor in a line plot for a polytomous logit model. These arguments are used only if \code{multiline = TRUE} or for polytomous logit models where the effects are plotted without confidence bands; in these cases a legend is drawn at the top of the display. If these arguments are too short they are recycled.} \item{cex}{character expansion for plotted symbols; default is \code{1.5}.} \item{lwd}{line width for fitted lines} \item{ylim}{2-element vector containing the lower and upper limits of the vertical axes; if \code{NULL}, the default, then the vertical axes are scaled from the data.} \item{xlim}{a named list of 2-element vectors, with the names corresponding to numeric predictors; if a numeric predictor is in the list, then when it appears on the horizontal axis, the axis limits will be taken from the corresponding vector; if a predictor is not in the list, or if the argument is \code{NULL} (the default), then the horizontal axis limits are computed from the data.} \item{factor.names}{a logical value, default \code{TRUE}, that controls the inclusion of factor names in conditioning-variable labels.} \item{ci.style}{confidence bounds can be indicated using error bars, using lines or confidence bands, depending on the plot type. For single line plots the default is \code{"bars"} for factors and \code{"bands"} for variates. Style \code{"lines"} can also be used for either of these. For multiline plots, the default is \code{"none"} for no confidence bounds, but style \code{"bars"} or \code{"bands"} can also be used. For a variate the option \code{"bars"} displays the error bars at each of the \code{levels} points for which the horizontal variable was evaluated.} \item{band.colors}{A vector of colors for the color of the confidence band with \code{ci.style="bands"}. The default is \code{band.colors=colors}. For plots with one line, the choice, setting \code{band.colors="red"} produces a pleasing result, even if color provides no additional information in this case. If this argument is too short it is recycled.} \item{band.transparency}{For \code{ci.style="bands"}, the alpha transparency of the fill color. Not all graphic devices support transparency.} \item{style}{(for multinomial or proportional-odds logit models) \code{"lines"} (the default for a line plot, or \code{"stacked"} for a stacked-bar or stacked-area plot. In the latter case only fitted probabilities may be plotted and confidence envelopes cannot be shown.} \item{ticks}{a two-item list controlling the placement of tick marks on the vertical axis, with elements \code{at} and \code{n}. If \code{at=NULL} (the default), the program attempts to find `nice' locations for the ticks, and the value of \code{n} (default, \code{5}) gives the approximate number of tick marks desired; if \code{at} is non-\code{NULL}, then the value of \code{n} is ignored.} \item{ticks.x}{a named list of two-item lists controlling the placement of tick marks on the horizontal axis. Each list element is named for a numeric predictor in the model, and each sublist has elements \code{at} or \code{n} are for the \code{ticks} argument. If a predictor doesn't appear in the list, or if \code{ticks.x} is \code{NULL} (the default), then the tick marks are computed by the function.} \item{transform.x}{transformations to be applied to the horizontal axis, in the form of a named list, each of whose elements is itself a list of two functions, with sublist element names \code{trans} and \code{inverse}. The names of the list elements are numeric predictors in the model whose axes are to be transformed; the \code{trans} function is applied to the values of the predictor, and \code{inverse} is used for computing proper axis tick labels. If a numeric predictor is missing from \code{transform.x} then its axis is not transformed; if the argument is \code{NULL} (the default), then no predictor axes are transformed.} \item{alternating}{if \code{TRUE} (the default), the tick labels alternate by panels in multi-panel displays from left to right and top to bottom; if \code{FALSE}, tick labels appear at the bottom and on the left.} \item{rotx, roty}{rotation angles for the horizontal and vertical tick marks, respectively. Default is 0.} \item{grid}{if \code{TRUE}, add grid lines to the plot. Default is FALSE.} \item{layout}{the \code{layout} argument to the \pkg{lattice} function \code{\link{xyplot}} (or, in some cases \code{\link{densityplot}}), which is used to draw the effect display; if not specified, the plot will be formatted so that it appears on a single page.} \item{rescale.axis}{if \code{TRUE} (the default), the tick marks on the vertical axis are labelled on the response scale (e.g., the probability scale for effects computed on the logit scale for a binomial GLM).} \item{key.args}{additional arguments to be passed to the \code{key} trellis argument to \code{\link{xyplot}} or \code{\link{densityplot}}, e.g., to position the key (legend) in the plotting region.} \item{row, col, nrow, ncol, more}{These arguments are used to graph an effect as part of an array of plots; \code{row}, \code{col}, \code{nrow}, and \code{ncol} are used to compose the \code{split} argument and \code{more} the \code{more} argument to \code{\link{print.trellis}}. Normally these arguments are not set by the user, but by \code{plot.efflist}. \bold{Warning:} Note that \code{col} is \emph{not} used to specify colors; use \code{colors} instead (see above).} \item{selection}{the optional index (number) or quoted name of the effect in an effect list to be plotted; if not supplied, a menu of high-order terms is presented or all effects are plotted.} \item{rows, cols}{Number of rows and columns in the ``meta-array'' of plots produced for an \code{efflist} object; if either argument is missing, then the meta-layout will be computed by the \code{plot} method.} \item{ask}{if \code{selection} is not supplied and \code{ask} is \code{TRUE}, a menu of high-order terms is presented; if \code{ask} is \code{FALSE} (the default), effects for all high-order terms are plotted in an array.} \item{graphics}{if \code{TRUE} (the default), then the menu of terms to plot is presented in a dialog box rather than as a text menu.} \item{use.splines}{If \code{TRUE}, the default, then any lines drawn when the horizontal axis is not a factor use interpolating splines computed by the \code{\link{spline}} function. If FALSE, then linear interpoliation is used. This argument is ignored if the horizontal axis is a factor.} \item{...}{arguments to be passed down.} } \details{ In a generalized linear model, by default, the \code{print} and \code{summary} methods for \code{eff} objects print the computed effects on the scale of the response variable using the inverse of the link function. In a logit model, for example, this means that the effects are expressed on the probability scale. By default, effects in a GLM are plotted on the scale of the linear predictor, but the vertical axis is labelled on the response scale. This preserves the linear structure of the model while permitting interpretation on what is usually a more familiar scale. This approach may also be used with linear models, for example to display effects on the scale of the response even if the data are analyzed on a transformed scale, such as log or square-root. In a polytomous (multinomial or proportional-odds) logit model, by default effects are plotted on the probability scale; they may be alternatively plotted on the scale of the individual-level logits. } \value{ The \code{summary} method for \code{"eff"} objects returns a \code{"summary.eff"} object with the following components (those pertaining to confidence limits need not be present): \item{header}{a character string to label the effect.} \item{effect}{an array containing the estimated effect.} \item{lower.header}{a character string to label the lower confidence limits.} \item{lower}{an array containing the lower confidence limits.} \item{upper.header}{a character string to label the upper confidence limits.} \item{upper}{an array containing the upper confidence limits.} The \code{[} method for \code{"efflist"} objects is used to subset an \code{"efflist"} object and returns an object of the same class. } \author{John Fox \email{jfox@mcmaster.ca} and Jangman Hong.} \seealso{\code{\link{effect}}, \code{\link{allEffects}}, \code{\link{xyplot}}, \code{\link{densityplot}}, \code{\link{print.trellis}} \code{\link[colorspace]{rainbow_hcl}}, \code{\link[colorspace:rainbow_hcl]{sequential_hcl}}} \examples{ mod.cowles <- glm(volunteer ~ sex + neuroticism*extraversion, data=Cowles, family=binomial) eff.cowles <- allEffects(mod.cowles, xlevels=list(extraversion=seq(0, 24, 6))) eff.cowles as.data.frame(eff.cowles[[2]]) # neuroticism*extraversion interaction plot(eff.cowles, 'sex', ylab="Prob(Volunteer)", grid=TRUE, rotx=90) plot(eff.cowles, 'neuroticism:extraversion', ylab="Prob(Volunteer)", ticks=list(at=c(.1,.25,.5,.75,.9))) # change color of the confidence bands to 'black' with .15 transparency plot(eff.cowles, 'neuroticism:extraversion', ylab="Prob(Volunteer)", ticks=list(at=c(.1,.25,.5,.75,.9)), band.colors="red", band.transparency=.3) plot(eff.cowles, 'neuroticism:extraversion', multiline=TRUE, ylab="Prob(Volunteer)", key.args = list(x = 0.75, y = 0.75, corner = c(0, 0))) # use probability scale in place of logit scale, all lines are black. plot(eff.cowles, 'neuroticism:extraversion', multiline=TRUE, ylab="Prob(Volunteer)", key.args = list(x = 0.75, y = 0.75, corner = c(0, 0)), colors="black", lines=1:8, ci.style="bands", rescale.axis=FALSE, band.colors=palette()) plot(effect('sex:neuroticism:extraversion', mod.cowles, xlevels=list(extraversion=seq(0, 24, 6))), multiline=TRUE) plot(effect('sex:neuroticism:extraversion', mod.cowles, xlevels=list(extraversion=seq(0, 24, 6))), multiline=TRUE, rescale.axis=FALSE, ci.style="bands") if (require(nnet)){ mod.beps <- multinom(vote ~ age + gender + economic.cond.national + economic.cond.household + Blair + Hague + Kennedy + Europe*political.knowledge, data=BEPS) plot(effect("Europe*political.knowledge", mod.beps, xlevels=list(political.knowledge=0:3))) plot(effect("Europe*political.knowledge", mod.beps, xlevels=list(political.knowledge=0:3), given.values=c(gendermale=0.5)), style="stacked", colors=c("blue", "red", "orange"), rug=FALSE) } if (require(MASS)){ mod.wvs <- polr(poverty ~ gender + religion + degree + country*poly(age,3), data=WVS) plot(effect("country*poly(age, 3)", mod.wvs)) plot(effect("country*poly(age, 3)", mod.wvs), style="stacked", colors=c("gray75", "gray50", "gray25")) plot(effect("country*poly(age, 3)", latent=TRUE, mod.wvs)) } mod.pres <- lm(prestige ~ log(income, 10) + poly(education, 3) + poly(women, 2), data=Prestige) eff.pres <- allEffects(mod.pres, default.levels=50) plot(eff.pres) plot(eff.pres[1:2]) plot(eff.pres[1], transform.x=list(income=list(trans=log10, inverse=function(x) 10^x)), ticks.x=list(income=list(at=c(1000, 2000, 5000, 10000, 20000)))) } \keyword{hplot} \keyword{models} effects/man/BEPS.Rd0000644000176000001440000000361312020162013013502 0ustar ripleyusers\name{BEPS} \alias{BEPS} \docType{data} \title{British Election Panel Study} \description{ These data are drawn from the 1997-2001 British Election Panel Study (BEPS). } \usage{BEPS} \format{ A data frame with 1525 observations on the following 10 variables. \describe{ \item{\code{vote}}{Party choice: \code{Conservative}, \code{Labour}, or \code{Liberal Democrat}} \item{\code{age}}{in years} \item{\code{economic.cond.national}}{Assessment of current national economic conditions, 1 to 5.} \item{\code{economic.cond.household}}{Assessment of current household economic conditions, 1 to 5.} \item{\code{Blair}}{Assessment of the Labour leader, 1 to 5.} \item{\code{Hague}}{Assessment of the Conservative leader, 1 to 5.} \item{\code{Kennedy}}{Assessment of the leader of the Liberal Democrats, 1 to 5.} \item{\code{Europe}}{an 11-point scale that measures respondents' attitudes toward European integration. High scores represent `Eurosceptic' sentiment.} \item{\code{political.knowledge}}{Knowledge of parties' positions on European integration, 0 to 3.} \item{\code{gender}}{\code{female} or \code{male}.} } } \references{ J. Fox and R. Andersen (2006) Effect displays for multinomial and proportional-odds logit models. \emph{Sociological Methodology} \bold{36}, 225--255. } \examples{ summary(BEPS) \donttest{ require(splines) # for bs() beps <- multinom(vote ~ age + gender + economic.cond.national + economic.cond.household + Blair + Hague + Kennedy + bs(Europe, 3)*political.knowledge, data=BEPS) europe.knowledge <- effect("bs(Europe, 3)*political.knowledge", beps, xlevels=list(Europe=seq(1, 11, length=50), political.knowledge=0:3), given.values=c(gendermale=0.5)) plot(europe.knowledge) plot(europe.knowledge, style="stacked", colors=c("blue", "red", "orange"), rug=FALSE) } } \keyword{datasets} effects/man/Wells.Rd0000644000176000001440000000327611163026512014056 0ustar ripleyusers\name{Wells} \alias{Wells} \docType{data} \title{Well Switching in Bangladesh} \description{ Data on whether or not households in Bangladesh changed the wells that they were using. } \usage{Wells} \format{ A data frame with 3020 observations on the following 5 variables. \describe{ \item{\code{switch}}{whether or not the household switched to another well from an unsafe well: \code{no} or \code{yes}.} \item{\code{arsenic}}{the level of arsenic contamination in the household's original well, in hundreds of micrograms per liter; all are above 0.5, which was the level identified as ``safe''.} \item{\code{distance}}{in meters to the closest known safe well.} \item{\code{education}}{in years of the head of the household.} \item{\code{association}}{whether or not any members of the household participated in any community organizations: \code{no} or \code{yes}.} } } \details{ The data are for an area of Arahazar upazila, Bangladesh. The researchers labelled each well with its level of arsenic and an indication of whether the well was ``safe'' or ``unsafe.'' Those using unsafe wells were encouraged to switch. After several years, it was determined whether each household using an unsafe well had changed its well. These data are used by Gelman and Hill (2007) for a logistic-regression example. } \source{ \url{http://www.stat.columbia.edu/~gelman/arm/examples/arsenic/wells.dat}. } \references{ A. Gelman and J. Hill (2007) \emph{Data Analysis Using Regression and Multilevel/Hierarchical Models.} Cambridge: Cambridge University Press. } \examples{ summary(Wells) } \keyword{datasets} effects/man/effects-deprecated.Rd0000644000176000001440000000100111074677173016505 0ustar ripleyusers\name{effects-deprecated} \alias{effects-deprecated} \alias{all.effects} \title{Deprecated Function in effects Package} \description{ The \code{all.effects} function is provided only for compatibility with older versions of the effects package and may be removed; use \code{\link{allEffects}} instead. } \usage{ all.effects(...) } \arguments{ \item{...}{arguments to be passed to \code{allEffects}.} } \author{John Fox \email{jfox@mcmaster.ca}.} \seealso{\code{\link{allEffects}}} effects/man/Prestige.Rd0000644000176000001440000000261011065527636014557 0ustar ripleyusers\name{Prestige} \alias{Prestige} \docType{data} \title{Prestige of Canadian Occupations} \description{ The \code{Prestige} data frame has 102 rows and 6 columns. The observations are occupations. } \format{ This data frame contains the following columns: \describe{ \item{education}{ Average education (years) of occupational incumbents, in 1971. } \item{income}{ Average income (dollars) of incumbents, 1971. } \item{women}{ Percentage of incumbents who are women, 1971. } \item{prestige}{ Pineo-Porter prestige score for occupation, from a social survey conducted in the mid-1960s. } \item{census}{ Canadian Census occupational code. } \item{type}{ Type of occupation. A factor with levels (note: out of order): \code{bc}, Blue Collar; \code{prof}, Professional, Managerial, and Technical; \code{wc}, White Collar. } } } \source{ Canada (1971) \emph{Census of Canada}. Vol. 3, Part 6. Statistics Canada [pp. 19-1--19-21]. Personal communication from B. Blishen, W. Carroll, and C. Moore, Departments of Sociology, York University and University of Victoria. } \references{ Fox, J. (1997) \emph{Applied Regression, Linear Models, and Related Methods.} Sage. } \usage{ Prestige } \keyword{datasets} effects/man/Arrests.Rd0000644000176000001440000000257711162233541014417 0ustar ripleyusers\name{Arrests} \alias{Arrests} \docType{data} \title{Arrests for Marijuana Possession} \description{ Data on police treatment of individuals arrested in Toronto for simple possession of small quantities of marijuana. The data are part of a larger data set featured in a series of articles in the Toronto Star newspaper. } \usage{Arrests} \format{ A data frame with 5226 observations on the following 8 variables. \describe{ \item{released}{Whether or not the arrestee was released with a summons; a factor with levels: \code{No}; \code{Yes}. } \item{colour}{The arrestee's race; a factor with levels: \code{Black}; \code{White}. } \item{year}{1997 through 2002; a numeric vector.} \item{age}{in years; a numeric vector.} \item{sex}{a factor with levels: \code{Female}; \code{Male}. } \item{employed}{a factor with levels: \code{No}; \code{Yes}. } \item{citizen}{a factor with levels: \code{No}; \code{Yes}. } \item{checks}{Number of police data bases (of previous arrests, previous convictions, parole status, etc. -- 6 in all) on which the arrestee's name appeared; a numeric vector} } } \source{ Personal communication from Michael Friendly, York University. } \examples{ summary(Arrests) } \keyword{datasets} effects/man/WVS.Rd0000644000176000001440000000311612020162013013426 0ustar ripleyusers\name{WVS} \alias{WVS} \docType{data} \title{World Values Surveys} \description{ Data from the World Values Surveys 1995-1997 for Australia, Norway, Sweden, and the United States. } \usage{WVS} \format{ A data frame with 5381 observations on the following 6 variables. \describe{ \item{\code{poverty}}{``Do you think that what the government is doing for people in poverty in this country is about the right amount, too much, or too little?'' (ordered): \code{Too Little}, \code{About Right}, \code{Too Much}}. \item{\code{religion}}{Member of a religion: \code{no} or \code{yes}.} \item{\code{degree}}{Held a university degree: \code{no} or \code{yes}.} \item{\code{country}}{\code{Australia}, \code{Norway}, \code{Sweden}, or \code{USA}.} \item{\code{age}}{in years.} \item{\code{gender}}{\code{male} or \code{female}.} } } \references{ J. Fox and R. Andersen (2006) Effect displays for multinomial and proportional-odds logit models. \emph{Sociological Methodology} \bold{36}, 225--255. } \examples{ summary(WVS) \donttest{ require(splines) # for bs() wvs <- polr(poverty ~ gender + country*(religion + degree + bs(age, 4)), data=WVS) plot(effect("country*bs(age,4)", wvs, xlevels=list(age=18:83), given.values=c(gendermale=0.5)), rug=FALSE) plot(effect("country*bs(age,4)", wvs, xlevels=list(age=18:83), given.values=c(gendermale=0.5)), rug=FALSE, style="stacked") plot(effect("country*bs(age,4)", wvs, xlevels=list(age=18:83), given.values=c(gendermale=0.5), latent=TRUE), rug=FALSE) } } \keyword{datasets} effects/man/Hartnagel.Rd0000644000176000001440000000334011507364001014665 0ustar ripleyusers\name{Hartnagel} \alias{Hartnagel} \docType{data} \title{Canadian Crime-Rates Time Series} \description{ The \code{Hartnagel} data frame has 38 rows and 7 columns. The data are an annual time-series from 1931 to 1968. There are some missing data. } \format{ This data frame contains the following columns: \describe{ \item{year}{ 1931--1968. } \item{tfr}{ Total fertility rate per 1000 women. } \item{partic}{ Women's labor-force participation rate per 1000. } \item{degrees}{ Women's post-secondary degree rate per 10,000. } \item{fconvict}{ Female indictable-offense conviction rate per 100,000. } \item{ftheft}{ Female theft conviction rate per 100,000. } \item{mconvict}{ Male indictable-offense conviction rate per 100,000. } \item{mtheft}{ Male theft conviction rate per 100,000. } } } \details{ The post-1948 crime rates have been adjusted to account for a difference in method of recording. Some of your results will differ in the last decimal place from those in Table 14.1 of Fox (1997) due to rounding of the data. Missing values for 1950 were interpolated. } \source{ Personal communication from T. Hartnagel, Department of Sociology, University of Alberta. } \references{ Fox, J., and Hartnagel, T. F (1979) Changing social roles and female crime in Canada: A time series analysis. \emph{Canadian Review of Sociology and Anthroplogy}, \bold{16}, 96--104. Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. } \usage{ Hartnagel } \keyword{datasets} effects/man/Titanic.Rd0000644000176000001440000000324312216200646014357 0ustar ripleyusers\name{TitanicSurvival} \alias{TitanicSurvival} \docType{data} \title{Survival of Passengers on the Titanic} \description{ Information on the survival status, sex, age, and passenger class of 1309 passengers in the Titanic disaster of 1912. } \usage{TitanicSurvival} \format{ A data frame with 1309 observations on the following 4 variables. \describe{ \item{\code{survived}}{\code{no} or \code{yes}.} \item{\code{sex}}{\code{female} or \code{male}} \item{\code{age}}{in years (and for some children, fractions of a year); age is missing for 263 of the passengers.} \item{\code{passengerClass}}{\code{1st}, \code{2nd}, or \code{3rd} class.} } } \details{ This is part of a larger data set compiled by Thomas Cason. Many additional details are given in the sources cited below. } \source{ Data set \code{titanic3} from \url{http://biostat.mc.vanderbilt.edu/twiki/bin/view/Main/DataSets}. } \references{ \url{http://www.encyclopedia-titanica.org/} F. E. Harrell, Jr. (2001) \emph{Regression Modeling Strategies} New York: Springer. } \examples{ summary(TitanicSurvival) titanic <- glm(survived ~ (passengerClass + sex + age)^2, data=TitanicSurvival, family=binomial) titanic.all <- allEffects(titanic, typical=median, given.values=c(passengerClass2nd=1/3, passengerClass3rd=1/3, sexmale=0.5)) plot(titanic.all, ticks=list(at=c(.01, .05, seq(.1, .9, by=.2), .95, .99)), ask=FALSE) plot(effect("passengerClass*sex*age", titanic, xlevels=list(age=0:65)), ticks=list(at=c(.001, .005, .01, .05, seq(.1, .9, by=.2), .95, .99, .995))) } \keyword{datasets} effects/man/effects-package.Rd0000644000176000001440000000514112236477134016005 0ustar ripleyusers\name{effects-package} \Rdversion{1.1} \alias{effects-package} \alias{effects} \docType{package} \title{ Effect Displays for Linear, Generalized Linear, Multinomial-Logit, Proportional-Odds Logit Models and Mixed-Effects Models } \description{ Graphical and tabular effect displays, e.g., of interactions, for linear (including fit via \code{\link[nlme]{gls}}), multivariate-linear, generalized linear, multinomial-logit, proportional-odds logit, mixed-effect, polytomous latent-class, and some other models. } \details{ \tabular{ll}{ Package: \tab effects\cr Version: \tab 2.3-0\cr Date: \tab 2013/11/06\cr Depends: \tab lattice, grid, colorspace\cr Suggests: \tab nlme, lme4, MASS, nnet, poLCA\cr LazyLoad: \tab yes\cr LazyData: \tab yes\cr License: \tab GPL (>= 2)\cr URL: \tab http://www.r-project.org, http://socserv.socsci.mcmaster.ca/jfox/\cr } This package creates effect displays for various kinds of models, as partly explained in the references. Typical usage is \code{plot(allEffects(model))}, where \code{model} is an appropriate fitted-model object. Additional arguments to \code{allEffects} and \code{plot} can be used to customize the resulting displays. The function \code{effect} can be employed to produce an effect display for a particular term in the model, or to which terms in the model are marginal. The function \code{Effect} may similarly be used to produce an effect display for any combination of predictors. See \code{?effect}, \code{?Effect}, and \code{?plot.eff} for details. } \author{ John Fox , Sanford Weisberg, Michael Friendly, and Jangman Hong. We are grateful to Robert Andersen, David Firth, and for various suggestions. Maintainer: John Fox } \references{ Fox, J. (1987) Effect displays for generalized linear models. \emph{Sociological Methodology} \bold{17}, 347--361. Fox, J. (2003) Effect displays in R for generalised linear models. \emph{Journal of Statistical Software} \bold{8:15}, 1--27, <\url{http://www.jstatsoft.org/counter.php?id=75&url=v08/i15/effect-displays-revised.pdf&ct=1}>. Fox, J. and R. Andersen (2006) Effect displays for multinomial and proportional-odds logit models. \emph{Sociological Methodology} \bold{36}, 225--255. Fox, J. and J. Hong (2009). Effect displays in R for multinomial and proportional-odds logit models: Extensions to the effects package. \emph{Journal of Statistical Software} \bold{32:1}, 1--24, <\url{http://www.jstatsoft.org/v32/i01/}>. } \keyword{ package } effects/man/Cowles.Rd0000644000176000001440000000156111162233541014220 0ustar ripleyusers\name{Cowles} \alias{Cowles} \docType{data} \title{Cowles and Davis's Data on Volunteering} \usage{Cowles} \description{ The \code{Cowles} data frame has 1421 rows and 4 columns. These data come from a study of the personality determinants of volunteering for psychological research. } \format{ This data frame contains the following columns: \describe{ \item{neuroticism}{scale from Eysenck personality inventory.} \item{extraversion}{scale from Eysenck personality inventory.} \item{sex}{a factor with levels: \code{female}; \code{male.}} \item{volunteer}{volunteeing, a factor with levels: \code{no}; \code{yes}.} } } \source{ Cowles, M. and C. Davis (1987) The subject matter of psychology: Volunteers. \emph{British Journal of Social Psychology} \bold{26}, 97--102. } \examples{ summary(Cowles) } \keyword{datasets} effects/man/effect.Rd0000644000176000001440000005671112231527660014235 0ustar ripleyusers\name{effect} \alias{effect} \alias{Effect} \alias{Effect.default} \alias{Effect.lm} \alias{Effect.mer} \alias{Effect.merMod} \alias{Effect.lme} \alias{Effect.gls} \alias{Effect.multinom} \alias{Effect.polr} \alias{Effect.poLCA} \alias{Effect.mlm} \alias{allEffects} \alias{allEffects.mer} \alias{allEffects.merMod} \alias{allEffects.lme} \alias{allEffects.poLCA} \alias{as.data.frame.eff} \alias{as.data.frame.effpoly} \alias{as.data.frame.efflatent} \alias{vcov.eff} \title{Functions For Constructing Effect Plots} \description{ \code{effect} constructs an \code{"eff"} object for a term (usually a high-order term) in a linear (fit by \code{lm} or \code{gls}) or generalized linear model (fit by \code{glm}), or an \code{"effpoly"} object for a term in a multinomial or proportional-odds logit model (fit respectively by \code{multinom} or \code{polr}), absorbing the lower-order terms marginal to the term in question, and averaging over other terms in the model. For multivariate linear models (\code{mlm}), the function constructs a list of \code{"eff"} objects separately for the various response variables. The function can also be used with mixed-effects models fit with \code{lmer} from the \pkg{lme4} package, or fit with \code{lme} from the \pkg{nlme} package, and for polytomous latent-class models fit by the \code{poLCA} function in the \pkg{poLCA} package. In mixed effects models the analysis is for the fixed effects only, not for random effects. The \code{effect} function works by constructing a call to \code{Effect}. \code{Effect} also constructs an an \code{"eff"} object, but rather than focusing on a term in the model, it focuses on a subset of the predictors. \code{Effect} is consequently more flexible and robust than \code{effect}, and will work with some models for which \code{effect} fails, such as models with nested terms (see the examples). The \code{effect} function calls \code{Effect}. There is a default method for \code{Effect} that should work with any model object that has a linear predictor and responds to the \code{\link{coef}}, \code{\link{model.frame}}, \code{\link{formula}}, and \code{\link{vcov}} functions. \code{allEffects} identifies all of the high-order terms in a model and returns a list of \code{"eff"} or \code{"effpoly"} objects (i.e., an object of type \code{"efflist"}). } \usage{ effect(term, mod, ...) Effect(focal.predictors, mod, ...) \method{Effect}{lm}(focal.predictors, mod, xlevels=list(), default.levels=NULL, given.values, se=TRUE, confidence.level=0.95, transformation=list(link=family(mod)$linkfun, inverse=family(mod)$linkinv), typical=mean, offset=mean, ...) \method{Effect}{gls}(focal.predictors, mod, xlevels = list(), default.levels=NULL, given.values, se = TRUE, confidence.level = 0.95, transformation = NULL, typical = mean, ...) \method{Effect}{multinom}(focal.predictors, mod, confidence.level=.95, xlevels=list(), default.levels=NULL, given.values, se=TRUE, typical=mean, ...) \method{Effect}{polr}(focal.predictors, mod, confidence.level=.95, xlevels=list(), default.levels=NULL, given.values, se=TRUE, typical=mean, latent=FALSE, ...) \method{Effect}{mer}(focal.predictors, mod, ...) \method{Effect}{merMod}(focal.predictors, mod, ...) \method{Effect}{lme}(focal.predictors, mod, ...) \method{Effect}{poLCA}(focal.predictors, mod, ...) \method{Effect}{mlm}(focal.predictors, mod, response, ...) \method{Effect}{default}(focal.predictors, mod, xlevels = list(), default.levels = NULL, given.values, se = TRUE, confidence.level = 0.95, transformation = list(link = I, inverse = I), typical = mean, offset = mean, ...) allEffects(mod, ...) \method{allEffects}{mer}(mod, ...) \method{allEffects}{merMod}(mod, ...) \method{allEffects}{lme}(mod, ...) \method{allEffects}{poLCA}(mod, ...) \method{as.data.frame}{eff}(x, row.names=NULL, optional=TRUE, transform=x$transformation$inverse, ...) \method{as.data.frame}{effpoly}(x, row.names=NULL, optional=TRUE, ...) \method{as.data.frame}{efflatent}(x, row.names=NULL, optional=TRUE, ...) \method{vcov}{eff}(object, ...) } \arguments{ \item{term}{the quoted name of a term, usually, but not necessarily, a high-order term in the model. The term must be given exactly as it appears in the printed model, although either colons (\code{:}) or asterisks (\code{*}) may be used for interactions.} \item{focal.predictors}{a character vector of one or more predictors in the model.} \item{mod}{an object of class \code{"lm"}, \code{"gls"}, \code{"glm"}, \code{"multinom"}, \code{"polr"}, \code{"mer"} (or \code{"merMod"}), \code{"lme"} or \code{"poLCA"}. } \item{xlevels}{this argument is used to set the number of levels for any focal predictor that is not a factor. If \code{xlevels=NULL}, the default, then the number and values of levels for any numeric predictor is determined by \code{\link{grid.pretty}}. If \code{xlevels=n} is an integer, then each numeric predictor is represented by \code{n} equally spaced levels. More generally, \code{xlevels} can be a named list of values at which to set each numeric predictor. For example, \code{xlevels=list(x1=c(2, 4, 7), x2=5)} would use the values 2, 4 and 7 for the levels of \code{x1}, 5 equally spaced levels for the levels of \code{x2}, and use the default for any other numeric predictors. } \item{default.levels}{ignored, but included for compatibility with pre-July 2013 versions of this package. Use \code{xlevels} instead.} \item{given.values}{a numeric vector of named elements, setting particular columns of the model matrix to specific values for predictors that are \emph{not} focal predictors; if specified, this argument takes precedence over the application of the function given in the \code{typical} argument (below). Care must be taken in specifying these values --- e.g., for a factor, the values of all contrasts should be given and these should be consistent with each other.} \item{se}{if \code{TRUE}, the default, calculate standard errors and confidence limits for the effects. For mer and lme objects, the normal distribution is used to get confidence limits.} \item{confidence.level}{level at which to compute confidence limits based on the standard-normal distribution; the default is \code{0.95}.} \item{transformation}{a two-element list with elements \code{link} and \code{inverse}. For a generalized linear model, these are by default the link function and inverse-link (mean) function. For a linear model, these default to \code{NULL}. If \code{NULL}, the identify function, \code{I}, is used; this effect can also be achieved by setting the argument to \code{NULL}. The inverse-link may be used to transform effects when they are printed or plotted; the link may be used in positioning axis labels (see below). If the link is not given, an attempt will be made to approximate it from the inverse-link.} \item{typical}{a function to be applied to the columns of the model matrix over which the effect is "averaged"; the default is \code{mean}.} \item{offset}{a function to be applied to the offset values (if there is an offset) in a linear or generalized linear model, or a mixed-effects model fit by \code{lmer} or \code{glmer}; or a numeric value, to which the offset will be set. The default is the \code{mean} function, and thus the offset will be set to its mean. \emph{Note:} Only offsets defined by the \code{offset} argument to \code{lm}, \code{glm}, \code{lmer}, or \code{glmer} will be handled correctly; use of the \code{offset} function in the model formula is not supported.} \item{latent}{if \code{TRUE}, effects in a proportional-odds logit model are computed on the scale of the latent response; if \code{FALSE} (the default) effects are computed as individual-level probabilities and logits.} \item{x}{an object of class \code{"eff"}, \code{"effpoly"}, or \code{"efflatent"}.} \item{transform}{a transformation to be applied to the effects and confidence limits, by default taken from the inverse link function saved in the \code{"eff"} object.} \item{row.names, optional}{not used.} \item{response}{for an \code{mlm}, a vector containing the name(s) or indices of one or more response variable(s). The default is to use all responses in the model.} \item{object}{an object of class \code{"eff"} for which the covariance matrix of the effects is desired.} \item{...}{arguments to be passed down.} } \details{ Normally, the functions to be used directly are \code{allEffects}, to return a list of high-order effects, and the generic \code{plot} function to plot the effects. (see \code{\link{plot.efflist}}, \code{\link{plot.eff}}, and \code{\link{plot.effpoly}}). Alternatively, \code{Effect} can be used to vary a subset of predictors over their ranges, while other predictors are held to typical values. Plots are drawn using the \code{\link{xyplot}} (or in some cases, the \code{\link{densityplot}}) function in the \code{lattice} package. Effects may also be printed (implicitly or explicitly via \code{print}) or summarized (using \code{summary}) (see \code{\link{print.efflist}}, \code{\link{summary.efflist}}, \code{\link{print.eff}}, \code{\link{summary.eff}}, \code{\link{print.effpoly}}, and \code{\link{summary.effpoly}}). If asked, the \code{effect} function will compute effects for terms that have higher-order relatives in the model, averaging over those terms (which rarely makes sense), or for terms that do not appear in the model but are higher-order relatives of terms that do. For example, for the model \code{Y ~ A*B + A*C + B*C}, one could compute the effect corresponding to the absent term \code{A:B:C}, which absorbs the constant, the \code{A}, \code{B}, and \code{C} main effects, and the three two-way interactions. In either of these cases, a warning is printed. The \code{as.data.frame} methods convert effect objects to data frames to facilitate the construction of custom displays. In the case of \code{"eff"} objects, the \code{se} element in the data frame is always on the scale of the linear predictor, and the transformation used for the fit and confidence limits is saved in a \code{"transformation"} attribute. } \value{ For \code{lm}, \code{glm}, \code{mer} and \code{lme}, \code{effect} and \code{Effect} return an \code{"eff"} object, and for \code{multinom} and \code{polr}, an \code{"effpoly"} object, with the components listed below. For \code{mlm} with one response specified, an \code{"eff"} object, otherwise a class \code{"efflist"} object, containing one \code{"eff"} object for each \code{response}. \item{term}{the term to which the effect pertains.} \item{formula}{the complete model formula.} \item{response}{a character string giving the name of the response variable.} \item{y.levels}{(for \code{"effpoly"} objects) levels of the polytomous response variable.} \item{variables}{a list with information about each predictor, including its name, whether it is a factor, and its levels or values.} \item{fit}{(for \code{"eff"} objects) a one-column matrix of fitted values, representing the effect on the scale of the linear predictor; this is a ravelled table, representing all combinations of predictor values.} \item{prob}{(for \code{"effpoly"} objects) a matrix giving fitted probabilities for the effect for the various levels of the the response (columns) and combinations of the focal predictors (rows).} \item{logit}{(for \code{"effpoly"} objects) a matrix giving fitted logits for the effect for the various levels of the the response (columns) and combinations of the focal predictors (rows).} \item{x}{a data frame, the columns of which are the predictors in the effect, and the rows of which give all combinations of values of these predictors.} \item{model.matrix}{the model matrix from which the effect was calculated.} \item{data}{a data frame with the data on which the fitted model was based.} \item{discrepancy}{the percentage discrepancy for the `safe' predictions of the original fit; should be very close to 0. Note: except for \code{gls} models, this is now necessarily 0.} \item{offset}{value to which the offset is fixed; \code{0} if there is no offset.} \item{model}{(for \code{"effpoly"} objects) \code{"multinom"} or \code{"polr"}, as appropriate.} \item{vcov}{(for \code{"eff"} objects) a covariance matrix for the effect, on the scale of the linear predictor.} \item{se}{(for \code{"eff"} objects) a vector of standard errors for the effect, on the scale of the linear predictor.} \item{se.prob, se.logit}{(for \code{"effpoly"} objects) matrices of standard errors for the effect, on the probability and logit scales.} \item{lower, upper}{(for \code{"eff"} objects) one-column matrices of confidence limits, on the scale of the linear predictor.} \item{lower.prob, upper.prob, lower.logit, upper.logit}{(for \code{"effpoly"} objects) matrices of confidence limits for the fitted logits and probabilities; the latter are computed by transforming the former.} \item{confidence.level}{for the confidence limits.} \item{transformation}{(for \code{"eff"} objects) a two-element list, with element \code{link} giving the link function, and element \code{inverse} giving the inverse-link (mean) function.} \code{effectList} returns a list of \code{"eff"} or \code{"effpoly"} objects corresponding to the high-order terms of the model. If \code{mod} is of class \code{poLCA} (from the \code{poLCA} package) to fit a polytomous latent class model, effects are computed for the predictors given the estimated latent classes. The result is of class \code{eff} if the latent class model has 2 categories and of class \code{effpoly} with more than 2 categories. } \section{Warnings and Limitations}{ The \code{Effect} function handles factors and covariates differently, and becomes confused if one is changed to the other in a model formula. Consequently, formulas that include calls to \code{as.factor}, \code{factor}, or \code{numeric} (as, e.g., in \code{y ~ as.factor(income)}) will cause errors. Instead, create the modified variables outside of the model formula (e.g., \code{fincome <- as.factor(income)}) and use these in the model formula. Factors cannot have colons in level names (e.g., \code{"level:A"}); the \code{effect} function will confuse the colons with interactions; rename levels to remove or replace the colons (e.g., \code{"level.A"}). In addition, factors cannont be declared on the fly (e.g., using \code{y ~ a + factor(b)}. The functions in the \pkg{effects} package do not handle logical predictors; convert logical predictors to factors. Empty cells in crossed-factors are now permitted for lm, glm and multinom models. With multinom models with two or more crossed factors with an empty cell, the 'plot' command with \code{style="stacked"} apparently does not work because of a bug in the \code{barchart} function in \code{lattice}. However, the default \code{stype="lines"} does work. Offsets in linear and generalized linear models are supported, as are offsets in mixed models fit by \code{lmer} or \code{glmer}, but must be supplied through the \code{offset} argument to \code{lm}, \code{glm}, \code{lmer} or \code{glmer}; offsets supplied via calls to the \code{offset} function on the right-hand side of the model formula are not supported. Calling any of these functions from within a user-written function may result in errors due to R's scoping rules. See the vignette \code{embedding.pdf} for the \pkg{car} package for a solution to this problem. } \references{ Fox, J. (1987). Effect displays for generalized linear models. \emph{Sociological Methodology} \bold{17}, 347--361. Fox, J. (2003) Effect displays in R for generalised linear models. \emph{Journal of Statistical Software} \bold{8:15}, 1--27, <\url{http://www.jstatsoft.org/v08/i15/}>. Fox, J. and R. Andersen (2006). Effect displays for multinomial and proportional-odds logit models. \emph{Sociological Methodology} \bold{36}, 225--255. Fox, J. and J. Hong (2009). Effect displays in R for multinomial and proportional-odds logit models: Extensions to the effects package. \emph{Journal of Statistical Software} \bold{32:1}, 1--24, <\url{http://www.jstatsoft.org/v32/i01/}>. Hastie, T. J. (1992). Generalized additive models. In Chambers, J. M., and Hastie, T. J. (eds.) \emph{Statistical Models in S}, Wadsworth. Weisberg, S. (2014). \emph{Applied Linear Regression}, 4th edition, Wiley, \url{http://z.umn.edu/alr4ed}. } \author{John Fox \email{jfox@mcmaster.ca}, Sanford Weisberg \email{sandy@umn.edu} and Jangman Hong.} \seealso{\code{\link{print.eff}}, \code{\link{summary.eff}}, \code{\link{plot.eff}}, \code{\link{print.summary.eff}}, \code{\link{print.effpoly}}, \code{\link{summary.effpoly}}, \code{\link{plot.effpoly}}, \code{\link{print.efflist}}, \code{\link{summary.efflist}}, \code{\link{plot.efflist}}, \code{\link{xyplot}}, \code{\link{densityplot}}} \examples{ mod.cowles <- glm(volunteer ~ sex + neuroticism*extraversion, data=Cowles, family=binomial) eff.cowles <- allEffects(mod.cowles, xlevels=list(extraversion=seq(0, 24, 6)), given.values=c(sexmale=0.5)) eff.cowles # the following are equivalent: eff.ne <- effect("neuroticism*extraversion", mod.cowles) Eff.ne <- Effect(c("neuroticism", "extraversion"), mod.cowles) all.equal(eff.ne$fit, Eff.ne$fit) plot(eff.cowles, 'sex', ylab="Prob(Volunteer)") plot(eff.cowles, 'neuroticism:extraversion', ylab="Prob(Volunteer)", ticks=list(at=c(.1,.25,.5,.75,.9))) plot(eff.cowles, 'neuroticism:extraversion', multiline=TRUE, ylab="Prob(Volunteer)") plot(effect('sex:neuroticism:extraversion', mod.cowles, xlevels=list(extraversion=seq(0, 24, 6))), multiline=TRUE) as.data.frame(eff.cowles[[2]]) # a nested model: mod <- lm(log(prestige) ~ income:type + education, data=Prestige) # does not work: effect("income:type", mod, transformation=list(link=log, inverse=exp)) plot(Effect(c("income", "type"), mod, transformation=list(link=log, inverse=exp), ylab="prestige")) # works if (require(nnet)){ mod.beps <- multinom(vote ~ age + gender + economic.cond.national + economic.cond.household + Blair + Hague + Kennedy + Europe*political.knowledge, data=BEPS) plot(effect("Europe*political.knowledge", mod.beps, xlevels=list(political.knowledge=0:3))) plot(effect("Europe*political.knowledge", mod.beps, xlevels=list(political.knowledge=0:3), given.values=c(gendermale=0.5)), style="stacked", colors=c("blue", "red", "orange"), rug=FALSE) plot(Effect(c("Europe","political.knowledge"), mod.beps, # equivalent xlevels=list(Europe=1:11, political.knowledge=0:3), given.values=c(gendermale=0.5)), style="stacked", colors=c("blue", "red", "orange"), rug=FALSE) } if (require(MASS)){ mod.wvs <- polr(poverty ~ gender + religion + degree + country*poly(age,3), data=WVS) plot(effect("country*poly(age, 3)", mod.wvs)) plot(effect("country*poly(age, 3)", mod.wvs), style="stacked") plot(Effect(c("country", "age"), mod.wvs), style="stacked") # equivalent plot(effect("country*poly(age, 3)", latent=TRUE, mod.wvs)) } mod.pres <- lm(prestige ~ log(income, 10) + poly(education, 3) + poly(women, 2), data=Prestige) eff.pres <- allEffects(mod.pres, xlevels=50) plot(eff.pres) plot(eff.pres[1], transform.x=list(income=list(trans=log10, inverse=function(x) 10^x)), ticks.x=list(income=list(at=c(1000, 2000, 5000, 10000, 20000)))) # linear model with log-response and log-predictor # to illustrate transforming axes and setting tick labels mod.pres1 <- lm(log(prestige) ~ log(income) + poly(education, 3) + poly(women, 2), data=Prestige) # effect of the log-predictor eff.log <- Effect(c("income"), mod.pres1) # effect of the log-predictor transformed to the arithmetic scale eff.trans <- Effect(c("income"), mod.pres1, transformation=list(link=log, inverse=exp)) #variations: # y-axis: scale is log, tick labels are log # x-axis: scale is arithmetic, tick labels are arithmetic plot(eff.log) # y-axis: scale is log, tick labels are log # x-axis: scale is log, tick labels are arithmetic plot(eff.log, transform.x=list(income=c(trans=log, inverse=exp)), ticks.x=list(income=list(at=c(1000, 2000, 5000, 10000, 20000))), xlab="income, log-scale") # y-axis: scale is log, tick labels are airthmetic # x-axis: scale is arithmetic, tick labels are arithmetic plot(eff.trans, ylab="prestige") # y-axis: scale is arithmetic, tick labels are airthmetic # x-axis: scale is arithmetic, tick labels are arithmetic plot(eff.trans, rescale.axis=FALSE, ylab="prestige") # y-axis: scale is log, tick labels are arithmetic # x-axis: scale is log, tick labels are arithmetic plot(eff.trans, transform.x=list(income=c(trans=log, inverse=exp)), ticks.x=list(income=list(at=c(1000, 2000, 5000, 10000, 20000))), xlab="income, log-scale", ylab="prestige, log-scale", main="Both effect and X in log-scale") # y-axis: scale is arithmetic, tick labels are airthmetic # x-axis: scale is log, tick labels are arithmetic plot(eff.trans, transform.x=list(income=c(trans=log, inverse=exp)), ticks.x=list(income=list(at=c(1000, 2000, 5000, 10000, 20000))), rescale.axis=FALSE, xlab="income, log-scale", ylab="prestige") if (require(nlme)){ # for gls() mod.hart <- gls(fconvict ~ mconvict + tfr + partic + degrees, data=Hartnagel, correlation=corARMA(p=2, q=0), method="ML") plot(allEffects(mod.hart)) detach(package:nlme) } if (require(lme4)){ data(cake, package="lme4") fm1 <- lmer(angle ~ recipe * temperature + (1|recipe:replicate), cake, REML = FALSE) plot(effect("recipe:temperature", fm1), grid=TRUE) plot(Effect(c("recipe", "temperature"), fm1)) # equivalent detach(package:lme4) } if (require(nlme) && length(find.package("lme4", quiet=TRUE)) > 0){ data(cake, package="lme4") cake$rep <- with(cake, paste( as.character(recipe), as.character(replicate), sep="")) fm2 <- lme(angle ~ recipe * temperature, data=cake, random = ~ 1 | rep, method="ML") plot(effect("recipe:temperature", fm2), grid=TRUE) plot(Effect(c("recipe", "temperature"), fm2)) # equivalent detach(package:nlme) } if (require(poLCA)){ data(election) f2a <- cbind(MORALG,CARESG,KNOWG,LEADG,DISHONG,INTELG, MORALB,CARESB,KNOWB,LEADB,DISHONB,INTELB)~PARTY*AGE nes2a <- poLCA(f2a,election,nclass=3,nrep=5) plot(Effect(c("PARTY", "AGE"), nes2a), style="stacked") } # mlm example if (require(heplots)) { data(NLSY, package="heplots") mod <- lm(cbind(read,math) ~ income+educ, data=NLSY) eff.inc <- Effect("income", mod) plot(eff.inc) eff.edu <- Effect("educ", mod) plot(eff.edu, rug=FALSE, grid=TRUE) plot(Effect("educ", mod, response="read")) detach(package:heplots) } } \keyword{hplot} \keyword{models}