car/0000755000175100001440000000000012216355405011040 5ustar hornikuserscar/inst/0000755000175100001440000000000012215160034012004 5ustar hornikuserscar/inst/CITATION0000644000175100001440000000124211621026615013146 0ustar hornikuserscitHeader("To cite the car package in publications use:") citEntry(entry = "Book", title = "An {R} Companion to Applied Regression", edition = "Second", author = personList(as.person("John Fox"), as.person("Sanford Weisberg")), year = "2011", publisher = "Sage", address = "Thousand Oaks {CA}", url = "http://socserv.socsci.mcmaster.ca/jfox/Books/Companion", textVersion = paste("John Fox and Sanford Weisberg (2011).", "An {R} Companion to Applied Regression, Second Edition.", "Thousand Oaks CA: Sage.", "URL: http://socserv.socsci.mcmaster.ca/jfox/Books/Companion") ) car/inst/doc/0000755000175100001440000000000012215160034012551 5ustar hornikuserscar/inst/doc/embedding.R0000644000175100001440000001420612215160034014615 0ustar hornikusers### R code from vignette source 'embedding.Rnw' ################################################### ### code chunk number 1: embedding.Rnw:12-13 ################################################### options(width=80, digits=4, useFancyQuotes=FALSE, prompt=" ", continue=" ") ################################################### ### code chunk number 2: embedding.Rnw:29-32 ################################################### library(car) m1 <- lm(time ~ t1 + t2, Transact) deltaMethod(m1, "t1/(t2 + 2)") ################################################### ### code chunk number 3: embedding.Rnw:35-40 ################################################### ans <- NULL for (z in 1:4) { ans <- rbind(ans, deltaMethod(m1, "t1/(t2 + z)", func = gsub("z", z, "t1/(t1+z)"))) } ans ################################################### ### code chunk number 4: embedding.Rnw:45-52 ################################################### f1 <- function(mod) { ans <- NULL for (x in 1:4) { ans <- rbind(ans, deltaMethod(mod, "t1/(t2 + x)", func = gsub("x", x, "t1/(t1+x)")) )} ans } ################################################### ### code chunk number 5: embedding.Rnw:64-66 ################################################### x <- 10 f1(m1) ################################################### ### code chunk number 6: embedding.Rnw:72-80 ################################################### f2 <- function(mod) { ans <- NULL for (x in 1:4) { ans <- rbind(ans, deltaMethod(mod, "t1/(t2 + x)", func = gsub("x", x, "t1/(t1+x)"), constants=list(x=x)) )} ans } f2(m1) ################################################### ### code chunk number 7: embedding.Rnw:86-88 ################################################### m2 <- lm(prestige ~ education, Prestige) ncvTest(m2, ~ income) ################################################### ### code chunk number 8: embedding.Rnw:91-96 (eval = FALSE) ################################################### ## f3 <- function(meanmod, dta, varmod) { ## m3 <- lm(meanmod, dta) ## ncvTest(m3, varmod) ## } ## f3(prestige ~ education, Prestige, ~ income) ################################################### ### code chunk number 9: embedding.Rnw:104-115 ################################################### f4 <- function(meanmod, dta, varmod) { assign(".dta", dta, envir=.GlobalEnv) assign(".meanmod", meanmod, envir=.GlobalEnv) m1 <- lm(.meanmod, .dta) ans <- ncvTest(m1, varmod) remove(".dta", envir=.GlobalEnv) remove(".meanmod", envir=.GlobalEnv) ans } f4(prestige ~ education, Prestige, ~income) f4(prestige ~ education, Prestige, ~income) ################################################### ### code chunk number 10: embedding.Rnw:120-128 (eval = FALSE) ################################################### ## library(effects) ## fc <- function(dta, formula, terms) { ## print(m1 <- lm(formula, .dta)) ## Effect(terms, m1) ## } ## form <- prestige ~ income*type + education ## terms <- c("income", "type") ## fc(Duncan, form, terms) ################################################### ### code chunk number 11: embedding.Rnw:131-139 (eval = FALSE) ################################################### ## library(effects) ## fc.working <- function(dta, formula, terms) { ## assign(".dta", dta, env=.GlobalEnv) ## print(m1 <- lm(formula, .dta)) ## Effect(terms, m1) ## remove(".dta", envir=.GlobalEnv) ## } ## fc.working(Duncan, form, terms) ################################################### ### code chunk number 12: embedding.Rnw:145-148 ################################################### m1 <- lm(time ~ t1 + t2, Transact) b1 <- Boot(m1, R=999) summary(b1) ################################################### ### code chunk number 13: embedding.Rnw:151-152 ################################################### confint(b1) ################################################### ### code chunk number 14: embedding.Rnw:156-157 (eval = FALSE) ################################################### ## .carEnv <- new.env(parent=emptyenv()) ################################################### ### code chunk number 15: embedding.Rnw:160-161 ################################################### car:::.carEnv ################################################### ### code chunk number 16: embedding.Rnw:164-207 (eval = FALSE) ################################################### ## Boot.default <- function(object, f=coef, labels=names(coef(object)), ## R=999, method=c("case", "residual")) { ## if(!(require(boot))) stop("The 'boot' package is missing") ## f0 <- f(object) ## if(length(labels) != length(f0)) labels <- paste("V", seq(length(f0)), sep="") ## method <- match.arg(method) ## if(method=="case") { ## boot.f <- function(data, indices, .fn) { ## assign(".boot.indices", indices, envir=car:::.carEnv) ## mod <- update(object, subset=get(".boot.indices", envir=car:::.carEnv)) ## if(mod$qr$rank != object$qr$rank){ ## out <- .fn(object) ## out <- rep(NA, length(out)) } else {out <- .fn(mod)} ## out ## } ## } else { ## boot.f <- function(data, indices, .fn) { ## first <- all(indices == seq(length(indices))) ## res <- if(first) object$residuals else ## residuals(object, type="pearson")/sqrt(1 - hatvalues(object)) ## res <- if(!first) (res - mean(res)) else res ## val <- fitted(object) + res[indices] ## if (!is.null(object$na.action)){ ## pad <- object$na.action ## attr(pad, "class") <- "exclude" ## val <- naresid(pad, val) ## } ## assign(".y.boot", val, envir=car:::.carEnv) ## mod <- update(object, get(".y.boot", envir=car:::.carEnv) ~ .) ## if(mod$qr$rank != object$qr$rank){ ## out <- .fn(object) ## out <- rep(NA, length(out)) } else {out <- .fn(mod)} ## out ## } ## } ## b <- boot(data.frame(update(object, model=TRUE)$model), boot.f, R, .fn=f) ## colnames(b$t) <- labels ## if(exists(".y.boot", envir=car:::.carEnv)) ## remove(".y.boot", envir=car:::.carEnv) ## if(exists(".boot.indices", envir=car:::.carEnv)) ## remove(".boot.indices", envir=car:::.carEnv) ## b ## } car/inst/doc/embedding.pdf0000644000175100001440000070037012215160034015171 0ustar hornikusers%PDF-1.5 % 3 0 obj << /Length 2315 /Filter /FlateDecode >> stream xڽKo_!PhF|E7hn^ 5^eG3$oDY(zЈ"?~9/D%D{L^&^V&MK Gp E1^V)כL~O5l6Iÿp|? <=ϝCUioU֔4s {/DLK<"YPI"$e2锵%>9ZHwL U,O$NoyM fk|\(_JWą*ePdG]ۘ2#Kgh2ϒRUޓ-M AM7*c_Ioͣ[*s` |k-Tn·Hukhx/;"uYQ60GW`rşn@a P"r֐2'B$ J'*|[k!6}C6y錪Leb#~ň7 ` K[x-H`PjK")` z&C "⵸HWFv;3~`gĞ|jT@{䘞 2r`5'>螇 "7Dbfc 44J XlN_zґ7yF=9LdLC}ChW"R%4~fw!?0( -ɀyAN8AmfPP2|. <#+7=>c'NGq)3#&r^R[9r\t',ULi&vS̓O=?1j+}3ڦ ʘZk7 |ӑw&P9ϭqe)MxQ["Nm/ 2{k*rYm@ c~)[A;hi} OHPBn;|7#2~3l#C'J+#cinKyǐ`&j2)Wyl Y\`f<Æʫ  $z%Lkz籝_ҏcDJ,* !5A]=[~,;5 POMq.Txv}tO_lՖcpMUsE c^RM?ߐsv #בF,"9COUCh,tюtzAJ ak įÑ{Q 4qəV(!8R64 =OвG`߈8vuE:|>[U|Ag#2ֲ*dn7 ҙ*/&D}h1 Oя-Q|;SD>KM* @sZ/z Բӭ+#* [Trh$$j hN^~fu}.?fM ":25I֠qK>J=RaPKOgds :l.3|RO]pF'UΫ*uw` dgJnY9=R`t64\˟uؚzg`άϳ`s&7K.S~O&d"DٗX_fzN>Sڋ$c eY8>Sf,J{ם0 2 /HDĩWyuZӿ9W:3RZǷo/~@o֪—.!}d]|C"8U<h P)?.^?1[9pq C_q_joY.p]XUiSV2zm)O4}zv f-ckU]ߊؿml'gdD3jvr]Q;4Iw53;mo)Q:8?MgGߎA endstream endobj 25 0 obj << /Length 1693 /Filter /FlateDecode >> stream xrEP¨buYRprpSX ƥc*ۺguphu}Ϟ|Rg ]xUf\gůR'-#k|˕tg.V(JkUzA50~K}*qò^S(`qŖJNv 0yby*+[L3WPy4YBMo73&o|<8/AnK9vsʦc `( $ݞ Z-4R]'Ad1#D5uͣ('RD07Qң|ohg#C 14 t8O1&E0F2 [<tt* ;V;y[P^A^NU+kڀ Oσu>RE X7a{y?o%&׼*7V;7W!D烖6."!ep Fh&--6lab@UCE+75 ZҬ|,r9 d(JilL`ǃ[vZ.pOg2 Hw'5G`3QZUhYv=~ 2H,):M 2HnؤJoUSH p _9.;WP9Rχ8wa}ZYbDf/lS()sw6rk""4W)$I\kZ~`P!W7M|3iy]y5sS(?9<$/;]ڳIPEĻ p(S® בuﱦ|uY u 7.r(p鞩V8= ➍^s.“Ku?(AV,JUcgge endstream endobj 30 0 obj << /Length 1870 /Filter /FlateDecode >> stream xYKo7WTF򱯠9-"@V IHh~{]rwe+i&EgÙgO^.̬RUnrJ, el6;[~'zowdοn-t|Y MHϟ356 ɏ2kc.`H<j ߋ S<')-쇙IUYY2foE ^KSd!m'qq,T={ke았:92Ƞxd*s66FnHƓ.Sf„&>N0,'K'sJk0`'¢Ibr]BTT0ʤ.VY?|%|iR2]gD3-—I[%xvZb*qTt?A%z͈4蕱$ #`D@NdHny5[tfsbJX4n >i];p~x~ѐCv[ʆ 3\SR΢p@)ltt(.֨5;`Mp3zHzwe gz(l0>/]ʕx0`33RLv:h$1PUA3@#R6A&15ݹHd :j&ee'i&X4%(`[v|}R:08=kQ3$Sl?s$psjMݒl9l 9^<}$سw;[[ yvPnݠ{.C'Eyl0P5GK#.Z(V;}M#GV8RB8=mH0).%(>Y*Dān94Vo$%4%^ *e$}+$06 (W|঑RVB=HA}34('Kݮ uY rK"",,`Ij4I2Ձbm? k/_@er$MZeoPrzHT5 ];Σ0+Su(kK %Ū(d$WʬylRɅB 9@Άҋt(R14gFk*2,$ Sitke 71P$s)H}f" _VlJ+Kߕo>ҿ*rWf bs@]υ7eP{ھ,5;]j nZ2Qx{O1$y "Ȳ2t$u"vggH%n#7vq!gOEøs ,k[:V I`?dEр;qR٢b_Lb`oUxc2Xg}+_ vo2SB T]I ];ySTOk`k- 1@$6@A;ў\f?Uh~z@6~S*p-ڦFchL<f7Dחr`gX* 0qGf~j]#ݻǞ.cTd;q-/^'LU'>|'^WL# ˆx%\A-O5HE`\xDN*g(?9={! endstream endobj 33 0 obj << /Length 1745 /Filter /FlateDecode >> stream xIF_ae%jmVꡪsc9V~`(Q`o_'O)գ<&2qQb@Gf4Sc>}\' M@%< Ipo cTuxb+r<,+GRuIVob‹ФL${ng▛*ɜqeyۋYZAՎT-55 F )sCVZ;c gyrځi0+@+R>|X:X_½`D آKs~)?昣x/{v׉LYJX[nPWD|5?V(+iro?Q,N`{WX#ZC(=I1jGn3gv"!R$HPۼCE-FJc|A@Q58j3aOE+sJl!D.dcBM~8N:Eqf3$4 QeM4>,$ G$1Ay+dl)WTw|vJ$o(3yl4LV5T68QXoJf,NE+r X\Ƌ`'yс. [TԦcf#SoEC媰 gHÚY Uin0g2 |{! `2R(Wr[TYc<<ؒOZ+ckk Hxh|(X.JVٌߢu+ nTV{/-#9Z+N4{L^':cQx Unt;|Yl2~!7k9 H3NA˔s1xԆڠ#*;KpA,PDNp +T&m݌]96z(A$.=?2rRyR,[/ B*<{z鮜6ZDܚYa<k4uIPk w 8^28I׆?i K{o-̥˪k PeͺwϖT 8CC11{j_ endstream endobj 37 0 obj << /Length 2175 /Filter /FlateDecode >> stream xڥn}BP@F΍Cn.}CZl%nop(R<8999pOQMefUX^/{_=S(.J޵#=';-̩FyGX][|A ;^_=$uGbvO=O-=_O߷p <QZ(A 8E aQh/]Z耭JU*ؑ&zp8@GakT$aFGMF+k&Yh'*Fg2rP)an!Ѫ.kp}GNE5+c &'QpU\OyIv"F*:> !uǖZ|/!W[Md y.q82A8t*^Ac3yEN((뭰eάcѹ5_ٮP_|lo;&sKV\F$u?Rۿ,?]nIGOOeaDDnDxѰ8.FiwП mva:†c ~zϸ|\xUF9E] hѵn ~\Q4A!_"iD%/2YV"NKHfR<5 vfS6[^J`g]j+UQ_Itf̝Tח/3˯ȇؿZ]7yYy';:dj@hqx"@4^/#]9\˞E)7f03LR1 {">6O|8{{cWHN16^y s-2oDI<y%U[LZk6ZD|(KNzI[Х(I6RO_U6sd_M52Ns#Fյ/o>^?J^ endstream endobj 40 0 obj << /Length 1212 /Filter /FlateDecode >> stream xYKs6WКTFALuh2!2j/I%L$%'L a.(v[g&HX| dx^Ʋ8aʲ4(aAymEcD-m'ڲDAM<E H>S>`52hm^)to}^Ԗvpβ{KgRBʻfH9ЃHORv0e 1j OtapJ CTKnLu'\BeY_Cbn$VhC4Q BZTTF[(ax0 MH}2xt $儨"mS!"Vz[[$P"*!g[O,1m`+H9DӥFJܖc-N:[GEgT6N`DRj 9 L0@>{[AVͺ%jF]zwG`N\0f(tiLdvX˔q(JU`.5<7jX[uDIXbcAXsއ 5X,*M^y[>As8tnBJ^('r[th ugTEd=ecTDŽf092Fk t*QumW4q.YzǹFܨqغS%+a_[:xt+,ECV:݁fF|k_qAHյJui n0@39Ύ{t~GWc^e`n][ }v8vTک| F]PTm__+QFyJ95u&yB,!)aA/gAK*0>ISyE2G@KgIӄKHFKe?( endstream endobj 44 0 obj << /Length 725 /Filter /FlateDecode >> stream xڍU0+8iqDaUUªJf(nC n،2ױDUmR:0 \ȽRScHa#bV BpI*!_)Ɲ+>T`nS2 -\0A+ ip'zHńvY%-9ᬋw%fd!7ƀ@_j$54愮Z k`mf3lB SK#9((.ԕ8`;5q U}~ڏbPrG|zڞ` n 'l5Ӂ=V1R|'NTnJ}Gq+pV1,{''-'; (v"^9Ӂͳ@P4%:5a9 3!8Ԁp 6RߪZ* (H~n,l endstream endobj 68 0 obj << /Length1 1530 /Length2 7644 /Length3 0 /Length 8656 /Filter /FlateDecode >> stream xڍtTl6t4H҂t,- %JK "ݡtw( "O|svwf9XtH2I4M $aG;sPnp$B? (}SoH@ ( B _@$JC5$ϡtF7} %$~a(8h0盎@ *-eFH`g7$N G`n0 EvIM``w#E{Q0 !nRP pv!k9U @.`7a;h/4ܐ7`0 ls}t0@YNa'?7 vp;UfJ@:":"߿,[8jhTܸQ$.&`^{.A_.H ?v(wm p`#~a? 0Oō H?W 46Qzl*'心H//0_HT ((,] W t*"l?HL/"*ϵF0?7 7_%*DNN8'FDl⿡ư?Z*|!r;wS{:p4u 7ŝ  @9ͣvsWCwK% {Bb0 LHT+xPom$&pC`DB/oKBm k)"77E@h{ A C; u5xC/Sy SHȃ0aMg=W9VSy}gQ?qy_|A%v/+q?cݪlHmJ]mğےdop(U#>NGOSkbcO̓ &8m^MҰyLe_3%5*w>@ȭ֔l`W~#EzڷMZD˩ZfHKTqb?ͦUB1hD?1 ,?YՕ5ًL<8(|PLA󢘎;=LT*Zl&]TDz%8]l&O[ qiRt9E/$J([\h2 {j5>CςGlS Fg?52,"!7D9B #"6I-ȜV0u{fvrSσqoH0`qqͭ1h%C_*v_ mNR0DsXk%y+DS= -X8YZ:j{_۾`}nh_^6a;" 2cyleo5)Eo[5?&aʍ=4G$(㥵]UFЬva82h|+]Ɯڃ=5^sg!f5 1GZ)` V-BXY`^W"%P1@o^]GoY$#:bދ`|]mc6[AնuLPq kqƃ1 y~Y}xHu\:*)À&hR["=1#[\ꮾģ=ئW(#KsQdYJU'Xd3íi KEt}yf12H:ط9 d:x?3kx6lVVXb f/>6o2M# c<3B$˂& `̧ͨz%O d=N 1½͝© z"RYSpL:3P1. _{*kuIy6|wGVyX K1I:4`dɚ'Z8 1o.]xLCmmlQi(LȘV مrYV 2`MO׼A$zI4;!wcOU 0i׹ml=2Dz3n-+xjj$+7ThŽslR{$TfDXe,$C>t'viC̵HC9Gˉ'Hu%BC򤅆\j5o!:Ot'0z92 uw}lz*4yk껺mX\J#8׾"Rk"0@mz2 }s8Sؿ'Jٷҝ^k^;fHPEmv=Deǣ6GZ_떤Ek,pI"iVgǧf5onmQmY G++ oDlґqv6,;%if?AYQH'RD0Vc؜TUVF7+M7&5.Y7X߳`4JE'+Lֶ%/Fz f9~C~qEЛOcSLZ9xsj^dnm<~nM;@~ۚ/-ZYSUKYiXȗ9 ڭl:&KD|0l-ol,}Eՠp,Y>vMѿA%  vu6n;/zjȓ% Z]VɜzdWSN71h#M-[R;q;pTٙ~HGw] ҫR\>T 1Q'}WPE-0,-mՋ$Rr)Fi="Lfh܆/5R $^d.؊X:>]0(9VsV;cC ȼ=u% eUK= F>0Y?:YQu,L{iGÙ?G8Sѱ:<^/GoղETM8keLĜ1#s~xLSN'J{ζM$v>sd}\1#Ak>]vX@>fxD';%{U/L,*7YʱD2G"kZ5y-RwĬ}g{w{Q+~nEEDO֬D/N9P)\ u3g牑W`g՘ ] L>X\==55V{Z[`wAdJLPXnxmcgZԅׯI%->ɳwRkQFsM 8Jt]e,s@#M,.gKPP܏f"q2x-]s6,O˒]Ul~gLErnD6/I>k4'-E 1%1?BET6ÈiM)@B~LǾQUl"g"s|Rh_&࠺a K*!xdJ.5DXŠA]Y_:_N\!>j-EMeE#"ZqJRrg t/ '#w!JPG߼׊~Yq8JkqCghi?D,aFe ! 9LbK\+kl۶JuVBN^LegK>jPMqWoQr;<| fLh[D.vG?SLH4yIjAssh NO%s$Q ~sEpG|@Osu`\le#^.~`2QŖ[\ܥijim9R,5<~f(#?}"p vC_4m@G#[Ő3mtJ1T&Hȉm e`nBɌ /TՀ q,UKYDA5+ jM%Oh[ډeʺ 1Ojuq< sᕘKhv,,O|h*M u' '`uWRk+`( ElZ*Ҽfp6tD#w5~+V5Jؾngq)RUà u!~{ʰr#JMI£aiiDY4,x63NG'j^se |T?6}ZAsxlעB+bj&XFUi6[_^;ݤMÃ~[Z!ȱgmO4 Qbk=64VOĶLO,1#~7g-rmD*Upge¦?сo5@iV^͖W ΁oWQn0zXzs8:Qκ٫-K/W-GܹY04ڶ5ӗ6-7cNݭ׫=g-$;S#eYS<z6φFeIS'r9m6V!J|`hEH'#!ArptyRt):"ř]!lkjfT=B?9<8'l78[ZIKn󼭲'E QqLSݿ'5%<"Bz (:G9B;q\O9/ޮ"o (7yxnҌ}wW}3M(~,8ѳG><TbS 340HIJr=}tXlP[0i[[-@se$^IN$?4PMrreT|{Pbӭ@}FO>vEŻ ]wCCfܧXb/f_35uM#/SXL좄M\ Yl*Ş_[a{x=;!#XcK㘌RSG!?{IiGF=-ցmGTKߘ`O`r|+\DoЂ&*O0)b7B@6e|ڷV[ruImȉm j@f<ڹ/eev_R}/dP*}9MVd6& !d3^_b}df>é2x4PuDWm?|[1Nbat ;֊Y%톅b v`VAqaEF4v$<@ @*i,s"R||ϞN%&]a/aĥ+ ,ʹMI:Gr _Uo+} >%jk pzm.kĦ`z!C1~0_c~V 3 Mɻ>e ZL1rp$2r*0F fSU$4d-u(}n&X |CIpZ'h"O*4`x1.MBwX!pVo/EcDx0;3՘"Ś[h{K6Z/Q؀5>L"s!Fm.,h2G~~܆"R:NSDCNU&%1wQ G闉;WX6o6ژ6/H5) X6@%~1Z Ӈwds/hQHa=MrMVѻ sA o1-Rmק6٤CSa&zWOt%J@[$I{ۥ`:; i065&RESc׌w:Ƥڡ Ɖ]x`Jw,2(-:T͝d:VNĒ ^zK{g7E$ kls;u[tV|z_hM-XX҉1{ b=?ǟM1~X4jVq= endstream endobj 70 0 obj << /Length1 1470 /Length2 6897 /Length3 0 /Length 7877 /Filter /FlateDecode >> stream xڍw4\]6тDFeFE] 3 w;E'z zD I>}5g_w^gؘx H+2 (h@ ^M )&`{E0P@Ah"mD>882D`w PC".l H'/_K5'OLL;@YM5CZà^ !i$zxx]x([iNn uܡ/-#fl};r=p5pC@(zs܀?s;ܟ޿HG'0 Pce ^WOWne `w0 B>9, IsruuQ βtt"\]~OZO`C@l~9 0g7&h?2[+@Wx}/'o%/1 `&@/;r߈Y0?b]|` B{en/w}J54`N^  ||bBaN_K?'* :yp-8NwB{ @B ky~W@npo5o;^[=Hp (#֩!D2 цZAC@._W /zܬ׉ RUP4{K%5k` E.< | znltE6Hz rDV 1o'] BnBS 1PO5 Z"M۳j9:/Rl_ S9y|PmnDx/92-N^&YXS8g/%Q /cT jye7|:> rjPcqv%#?U+Q%NxU:kcT<Ŗk9MsוC}OI7Lj/vb }LO{/tҲҚ0` MVSR]d`1(F va,}a=ͷA kaq:lirjE'~='piI]'$]U(Cj^t@"NT_+N/z&"UҽqK03g`ey錙ZWo:-$?aΖg.'e4c#f݀AmC9aV'lՃdK Utuv璱B9>|+E110F2OjH$+ƒqaI=;PB2 !fjS=*NiB8zMĢ_J>fa30'q<>w[ChTRWHv{7U1:/Nxy;waBca"sG("Uj RSE^:R,OHMz$RyE/o ]z"'aeE VRT^I'i`}} -vep>P#ElDX ~I %n"S(]u:FfDr=P"աUm˙#ҍi:wo RR&r4"YgM&DnIf :hYW+9)5>ɪ L )S[qU=E bw"eH( (=/';ɏ2@Y=0\d[P+zN#BvBS#7l?[$]V(8LeT>O%HN j0yAA>Ƙ-j}aK1' KuOB"~eV`Yt㰨q>.II=!K,wbgt4rWX810& E*%,IL>q2%nL|dBhHءzgGB4Ҳ~ȘiVUVfHLSud:}lNM($J5mC8@1]mGĽhШc6@i_SR~̆}8܂caN^_DsAS_8uI| TmR_r$HTj8= Crqd |SFhTh80dyeHħHJ@i\9-.dqizOHFS`Ӗ:'S1'f-7r{gͲ::_vܰBDnE9y` súz~\#]F4=* O)(z{iGal#ܹp 惡إ"(Gl2AoMz8CdWx ҂շ8v&q"7p,G--wF!c6b, Iݺeΐ0(Y702t_E [Q}7NQ?,,'UC W2I9I=/LcOCukTLT{!P>[y-~D9|u"-njb&Ż58!_ں6hjȱӞ*|aAqL<7C9ֿCܢ1JDs.YW2%V;IbuԹvDh6n1W6#۞4Y4|}]USJ{Ev& ݚ(SMn|֡伆8 d?&BHʶaT~Ɠ\)ұpq02])kMۛ, 3 (B+eR3R'~}н~i;g;UՎP>7`ر l5* fR\SGO;{BklFӖ=@h(@qՄؽC_M] ̲Yh Q/]O@~ʙ%So6b LBqⲧግyB2#Wx a@;lȚJR Kϰר 귳$5"H Y)8fGA936 ۫ƃ\E !Tx4Ni(?^yVk2t`#MF;%'շli>oϞW'R+Ut\MjTxy˷6vKסoP%&sA7]}2:ZI$ -es ^Fɼv?WVs2W:HGHfu^d.@f[=*_R.Q#S[`=\B$y|SȕYde4pz}PPaUb !Vw"y+J B*TְXз+ś*;,ᾤvNV q߬oJ\ ק\I2#}zT{QOh{F|նɠ/t5^L z$*{\+1(Lkzڴq\2ə3-k0g|hﱴMG| 8:ޛZv({Y/((ĸaeR5\{|;Lm:>(]ץ֖A?ͷJ&v$,;GzOɄ//B{=&؏ K"_XH>,JrV8_BrixF&%Ȟ_c04D_.!io6eYvRYiN^Z ZA] dĻL.ϒ;q| 7omg0!=$ڂ{΋Z8S{C_ӻM%TieϾϽ,= &Ukir[wfgUR#w,CI@f2VCU,2UppN.$?o8<#8'h{^p"90zISZ :إsja?4rUk4.笺vnmt1W/LSdز֧aã` z[QE~ - oi3}vA&t*7 g-\K7JKxphN^ymZR[wZ(M߇l(w&שLx@̀Iյ\䢄&Saњ۬e]enP`bR= ZݼJoFʆYzW)Z4d(z*ѐ"xb!M̩ 8Z$ՓWܪo\JS"}87˪`vO^ܣ$RAv% !"y}뜖=(zzbReR{V5[xdoV-)X9+. 6Zh AwŜRǒ!=fRb[r /t ǺT`S{ߚjt7c&rR7:Q9ԋ&`|?V'cWy^m`jHާEP_㋴Qֿ/V[x!, &uf ]lTm"=c>edHohT?/r(.{y(?S:lWrOe j>n"ۣt~N:Zf\ΆB3:!nx˘N^瘮FNQv+6伐EӞmjA7e3]9$q{3٢&VB ]&TH!vf.iW$X|Ft eNݬ&֟Tiud%P x~ݸug.y n%^i/YF˾LNĢ+|D; 0|C'jR$VNy .rx.; éQEY%j._(T[* G+^60B&Q uT s0efT:l W1ܾ~U_YK'xdq<h g2[S=)3^Sdc0wn ¹7m#ҁnRQ${)YEYb,`yn76$te *(F"'^ت> stream xڍwT}? "P@Nim mlNDD@IQZPP:<9>qXP8AP@Q! PC֓s0X8 )*שqxG=@Ҡ@ @=!6 Òs^_G+; `$@s+B1 G CK {xx]B(<s0; 2@ M `e0F9<@0$iZ4 _? ODp`0rE^p# up8i`w0~+xa80 J?f5 a s3\$G;a-l=is@ɻ uU mR1Qh`0J  0G8j_2~' ד5a($G,e(O@PD$w~o=0OwQ * F<(k֙|3WE;"LkzsxC4-=<zre_^Ź;ܩJ^Vs)DXI;ȗHZP^sW^{[`M{ڭ2GP;Yd$Qx[h*+nu0I(% `} uRW>[a=A~ w=VQrҠؓMML>9Λ2f#S?[ \gF |t}>m-4Rԋa+ )i?<Lg8Uia9/wyR R!g_7Dv害[ٲ_@.P7+͟\i1p!'xgu_k\ĵm/|TS~_o;駜n˔A+BK mvmNqO!=,CV@5wiӝ h#6-y73Bl}w ijS#MMH1 5J >R7~4}KM,$1@3)b LVdifg?hQsէ} &[H?/ ȑZ/Y89ܪW^3؇2]&`˂5o Ef:t/4?:mQrn.tįfu8*\ѨEMllsMbH WǦ9-a >cqeT\Q+!2'O78ыGD_P-3ܳE[,(+EeXjXal{Wo@Wmi+cmz;pU8uMK™a:. 7/*͐'k1:i1VIbnECfoXC mw^*l^kLU>hA[ϤY(*W.'XfU- pkuz_<3?Y+JtDw\#{[s5-z.{Ӽ \V̺vQ54dj{;5uP,3g\8+e9D>!)"3Tex͔=T Y{(sԩB [V!/v\0!bWvz|Ri^caBpbwշ#ɂu-?|ȵ>tWs Ѝok8zқ`VuЋ@h!Gν`==?aJgQaCJUfY dqSb}L֥ɜ%mun d^5~µ|\' ).I?-P+< k_=ETh5[ n`d;&gcv[{ :WҤM:hZ90ЋrxVA}XFMNrM^A|=Aa DOX~H܅+áG]z񟑷S& Lmu)$WX5;o_ON0rQI9k1;;MLӺI2Z -}<]h &R_H~i :)P|b,@zBJ;4= ^ҽ2h4fY W>x:Oj̈́өc)4ѫ $lHxe Us6#ECLStFĽu|GvҾN79+ۯUxONwLhZմ՟ڝ矣ӫzfϳZ 2׫kDs$DK@YhMaV[ޜc0*ƸkŦPTcQTڕңκKX?tce;x"k'?g➿~9D3GZEĶfL W+1Ĕ #)t H7)&&5sG@%X Ľ̖$jz<ߕk]Z_6/apU-R:qeTF:jET^=b&ILU{jKe6}[ $ÉmփM*%?U=\ْP?뵳[ns IpqŹi ߉󃏻 ʫI +b9D=0~xHXn1+5˖0op*W2UW/|మDeO*6ޟIVE #yOocibtp?T{J;sH 7oBp<]8T2ֿ sV͵ .N7x]*dф#E#O pRM1[ΕKt&3 pC>U` >>p P_mD@cT*v;,h7 z/c^=&S#=qcXEeø g]>|v*)keIjJ2*xqj^r,{6jAޜoshWJ ba"툵%Ĵ6j9q) .T0ۥ,)Jp(&MҬp_)+0>4 TfZ KB4|m_llJ$MWO7ⅷY|'"rj -B"6 b<VM21ÏOB\ͳ-* ycةNl"mU0-wI== Q͋4V̜ ;ȥ0dQf#'N(m[fҮ 1Mq y'3JBX6^fMW5 (9=i AGa&lxJ̙˩}xlj@#b~.=<ԷX٫nu WW:q|y?2TՃL289 1VOK3~aDdS}P3sRyK8]M_Y{kFʳ*+S\x2?r,c-h?Us Hzo 2 ];FE91fNn?lCp+mЇ1%kY*<ARPĥ\Amw]NgBAxU9+7Sj2Vs-FI[q=]>PBhfzKMAn{tfed-/>y8O6FMg"i?+aVl֝.#ʸ{L?K=}1 ; j!GSnm,ܞKT4?զ|pO yTAU7p uۺ(h+IJsz_'4fpi,zdJҋ V5Γ`!&$N]tgBS//1D]˺) [1^岿Nq$=&&i3[Unp50?Fۇ*YAagMqK7q%rITgi#R+J~ OP,zP yƾ~aJq g%I0/+/Xy&O_q5/_zRk-Pw`_pv h"oGIH;RQqL)|w51ܱ!&j?[`OR5Uػ﮸y-zR fG^ίʲy1W^NlbL73u1٥s̐p5e;7HOG\,zM^q*Ed㥦8~2%:䇯, djˬsL,^-IdtJSC/r煰E)}TCL.SmyQSf_00+.1[=ݾ!D=dr@DvDI 5ݯOK^8]@V|qБ$ M7Ѹ]U+kAP I>|X1d'MS1u7JZRW?o:A"go ,d9_iP4-$en;MֹvV.  ~tj]n^D0ݏgi >h0=O$:'hQڗ5'|ڤ%jr#ShT/a@>vGy[HT5gDWTV%T4y k̀4DsV A:hRURj0.^+t`,=Ϥ[i' ,oiN#&"w=y)*I]vg@dZtL7*ÄQG0V0R^N}~hӽZ1>OztfEUY<ίp: : .X&T>8fPf/"St$.]7 {N%?n z{OHo4 <~r&&״UR`:^3JS L-#wkْ=Hb{5!i1VzBS"7)kZ;oJW̺SLky6ηw)Bs"NKޮ;M?5)-lmYkl PϪFyr \/ ѮG4, S!6Nf):jbzLq6'_b|'KXTCdaT|Y*hi׎z %Ie @T7g54 ҭQc89A`=،lm`v(&9'|(D%650gJbP>xk9C>A@4Uy]"2ՎE?r EqkS q>a²nFMc|)YS~}.>s%Z}j#*zd%lζ@vf񪋪XؠWuIA@Q{WEy[9i(8jV:I)b endstream endobj 74 0 obj << /Length1 1407 /Length2 6008 /Length3 0 /Length 6966 /Filter /FlateDecode >> stream xڍtTk.)-C 3t7Hw 03 J7J# !! HHI4{9kfw޻빯2"m`*H(ji@ A>H4a 0w8!aڧA3,HE%@ $w"]H̃tu;c~p@9`qqQy; A ( z" 0@B0ZpH9P|> 'r<`^0[/m 2> oCyCa!<[;=` q!$kIu70?] B./a;:*|(q@!^3<;wW-+#l..0ʃ0(}l Fev@z!n05R.|0@$&*(&`>P_ }]a_n4@W+ = ^0`-0?6zp9=0Ghz"ξ/uU?SP@y^a D/cՅ:蟆j;$ }yIH4aoA~x} Oga# q;' - -$ZN5Q5-y=`!>?CՅ.3.닃+V U@oO⁖ r0}eiK";ėM% ek w?BИvHw_kD| twGMпߒ|`P$T2Ա.FΛwm\ w/TwէfYqIk!qF]}I/CWSu}p ^ReNv2UN)ĵ>mau|'eYCD]F׾=]R?f~z-Jp_C6}so9h^8θ=g$T1;\M60YC"ǶkdܼqL}ǚT׆T \Q NK2O&GayZZsb[uq8> &]q\lGwk5I#c6׹Oʳg[r8=Ɓh[icdf[鹒O?'R؟ ,cL6FWa4=C0/~`L._)իk&_>v$+e*ʨ_ lBj;*I:HKP~`lN9]YlR w-y2φh (Hi\Wj`~ݾCۮ];ﰍ 8Dďxh"O=lX^VX OJwG>6EX'!"Cv;o,8F *H_x.ex@77#s%:?2ͬW聞ۧMILjAoo W:x N.$~!j-@?mdL{Qz(unaq]HzR PWb[s F׷3^,HT噓b\d HJ-k/C"%LFo*9r6.K3r`-Q1xs*"uZxq.ވyaٺ]o* f4yĜg ΂j_F]y_Ƹ!od9y֚e>|Y|`66XH *O;HyE9m+䲇2bx*Ϙ6˒ãijH o;djz+:yO b~/ɥ >S s8Ni輤` T瑽>۝6rCs0ҵ hwYjv o+3oDF(LR5[5\+ޥ`TW›wv"q+ƙ|Y*n#ئQ$5PŊ/~aS i{S}E <VWM9 S]8g)ڋ V4̋M .|z~96+xL^$$)CW25zVqWK!7_^6k烗ura :K򒋓1`26`C= CSg&7 ~"cK5Ia9KIQwn ϞS$qUş~ )2y XYwuj[\2K)Ǭ>y5uRJ z3&=ܵ֝^0v}R) +t!/y'MPWA3*La Gyu0^\WYߏbg1gAPС437=/<|-W˗@$#[fό,dWMvG3nHH~W֊YŨKr5~J&j.HT~uh%қp`*nE% 93#ۘ']|^aeɲmwQ:ו$GoZgi.hRb2Ύ\,YќLk #YuWS=nG?嫘Ve1Of-!86: ' U%/gv;1b1sj೑$03յH~_G[2nkIO1Hgb[ ^tmNsgwoM;{zVAXP5n{D0?!fN"oKYegLU_J_(^JOg'|Ͽ* b9<Qte6AfpriϪ韅~soTW9=rSxVBYuEE {0Q=b_vLj#[\zoq9Yr*;1{V^4˰}fR>Mm͘>?$tE(azS#Կ?ϩ{w& @m6]C/޵rxPytٶuĐbc33jKkLݹWetg<'3s |$RJΏ0u lq5׆g֛8S1כ#L+* &jgz981ә>m&ܸ,uD߭z2~ Օxʥa_iD >8*ZcT9]_W| uZ[q5itXnPn$pHȉê FӠc3[:8HynI߂W0Z?4_Xͽ3*7T\j v N H+$bmYJ8kh,fbh-ْR ZOtz[+Z+Z!8qJC 3_N sɔi _g?_T"wwû gsG%Ս_ݦΥ \?|n>0PɑtjirU X|ʯ4rt3(- 6"PqǼsGy9.,b%dn:.fr[1o-L_ߞWu38<B+S@VTKc]ny㬥Vq}buTP/(uqm[[FBA}J݇ NLFsx5kT6JɯA։N„*5] Ι$JOgϥ<:4hv/1ĸ޴ZΑm IeE\/d-ӊEnl!2%|B,c{٤i]oO\؏.) U̦[q$Xb_wo6|^v ?m=&Mf`#JW] 4(Ny\6'_/`?Lǥ:; Z'$V˛؛dHwr%5BF?Vb\'nMA=ۛ;'_fՎi-q.(̪@`;~"& f̧nޅ97 i;f~dZYVQ?!cXO)a]vyuZp0ϲzaiι~CQ\Sa[!=Q+u-GLc\X9i& aɴ8|P5:&X[f%ڨ ЋLh+Z6y$DȸdΞ,X;!K. s|ҰR%$ޕ>*]1L!tUTPj`j5]^5dw~PԼ24_ ؗըԎ_ͶN9~Jޤ`+ncRg$I sTT#&"{{#_,5[HTuezOYl{^)=y,'9é+l f)a%#xj';S Tu)׶wz6<=ȽL@ 9최qcţ!nmv1OK}A46K#ˁ'dX6SyGAwN( * ƇAjɄ}@ksL)^Qs:sD,Y[yx OM \dl{ag6N FpTkԨ׸iDZp lRm.Uǥ'k?CV}*`PmwP{6i5D,`9d(cV7Y|S ͠{M#S<9uš3՟IU;QNӅOu!L\lF2r噰^0]Rǖ|դ1Es7$JAMH&7R2B6"MlLw@c VSe^rJ:nVmToj6}eݾMy<6dR4t;`ƾ=OD]3* endstream endobj 76 0 obj << /Length1 2342 /Length2 19806 /Length3 0 /Length 21177 /Filter /FlateDecode >> stream xڌP]ww w@ nwwww'9߫Y-kJRe5Fs{S=ȅ `aagbaaTvk:9[ۃsM\AYW[+;@{'>9@ k:S;x:Y[Z3Z+//7; `b{;fof t +>ffwww&;g&{'K!Z@ tr P4 ne] x3ZAo sp<@'X2쿈A'9N_?%zGȨ. ]2ѕY9νGʣtyܮ^ScF~` ei,. #̯iW'޺l1^lxxDG&Eeq潋 V< HRVQҪU#A 5n#m;Ij>L#'2%F.5Dm-76)KS$N:>ۏ)w C۝ZE{ZIXE,@Bthe0QܒxMB.EYYXtyG8}.c|+/6fm __MS..%?It~YV .eبf/$\(ޝc:ӬǙBs8zP8 {c~uSV&juhyQ.:M5 Y鋔H$Dl;SSuQ7RX-uю'wRqJE^C0EnaOؾ*р!P-C6h^{muOnOnSxVq49@~"z.HbѸ.RDX6\?%meg;Pc%dlye?6 V:[%Z&ߡN.>\WR֔T kގu\b&$<N^WQApfhp`Ԙb/U1%rHCjШ6^&DeQ{ɎɺQu{sqjNtOtI$\G2 !K[Ir&ƺ_STګ폥 L} fe)*~!}mb-;d0: kcllhkeYkA;i%$~/MNr_5bIT|%{3#_w<onPp#K3iέ>z3gY'*RWa)uZMӿ@8e9~%cLPґcZ=d6 l'&\Aͦ2R%LAaxPȘׁ{<LJÓbL4 jPփ%;lB.W=yrf㷛Y.TKc{~>`ԏ[Z(ǖnƅ w{SOPTObomؗv*X ڝIճ"-$Õ xru,$CpAjWT%UR^wżG;4#-2OVus;JTVHy7Y;,h2#ُv+,t_a{r-~ugضR*KkЪ3 bqbefWzw А7/hC$a"RBxU:{qhv. LE^|0S_?"y(reޚd +0gI^$~g$&m0?!իiW5%ݶKV)%J軯I6lǐsVt݈]C2U9Uj2HoL[3 Jv/{xC~UCc+e\H17>-Pv.H_z]m Oc˨:kOt?*V!#jȻ vMMid$J%& k9Ydrw94clil-+;3L*WIJgg7M8TXqGe[E#xg1i dϝpy|s^x1hNnm Rܼ2/T "  [.O0wJWrvGbDDp>&MRQ/i-MSu^2[^r}g%%"]0tѴ*ZQ 2ΤǑfHop)?SZ|[E%BJSO%o)Q9rNeҔ,Uyq@C,hۀ1yjtJHp-5X7I oj=r%9mn]Ucl e`b9CWdnJU'R_nzDy?Q`u*Xz\Jͅoy&>(DUgOu$J> ,D)^Golw=W>ӵD$mb`B:w K"IjZmPb$I+lMSƵM*F;SoW#8-i)& 8OOl FL7$Z bpG/Bأa:wkKT14M'n\hYR.|0Q_%@tZ2Ppcn`QRVY; ^܉SAӀί^SGoK!bANO1Ip ܓ뗨iY(oB*c(2.y;zŴ=TmOVc CeݗN3_AF$HYl8dao_+$ח/ ?uO M5rzݶWr9~Rc8ى9'av]_t!,ruai*sTL$ I_9 a!Y9՜qRjl&J^ ѧ/i';Xg[0ɦ7Qʡ?޻ʹ@]7#ͷO^õt_$ޕ|#fw^t<Ir)ACdbYĺ^xŝGth6S&O맽Mi}2=;/fwBlܲ?D띙!"[,Ra@vҫMrm #Q5¤ 󬤵Njp<*Q5$R5m?5ʞƩPTwy&?tw1w8XJ0`tgNEFzheE&,Ӣ) h% MiEDQ h (t3//?ژzXN4l ss#PmeӴg\1GêQ#6q>( akZVq)ONtʟ)HZq tcMp;~q*|9*FAG PcE`/MVX I#n29(rqk=#|hL"+6t8\5|{{`j&IuNIgeftv( $OEGd `XohV#z*JuwԜ^m2['oI$US[(8Oΐhki<>74G"SڌJG*I Ɛ?6vyK-[ 9<"l)2@/!jD?N;/*p3}5) `"o^ N* |x~mlc FTiL-cQC[kZk;1F*\p!pXqFYڶb Uu+c7=gl] CxK65UvRh2MP)HRq[`Q/|+834MZW2VmikwcX4ړ2@Q}; n;L;li["yiᕸ@LiݨЩGն,z>r'`";7^%i${WZ5=u񩆵n(.CgQjkEAP n |po`8$%wYjG\B$h]ڵg7 K>?$@C"ys  BvzU}HPa0 o!a&Q+1E;]lt ,4zN䤹؅aP"DuYo`qi߆3!ɏʠHULa]_)s%=3s:ߩ9ξ+v*K@9 9V&IeZuZC5IFP3BbքϪ[hUh`W{˔>ӗMNXI?4`HLHj)a9T.}/!+7BO|FBt2,d XpK^};#׋h%yP4 i+/,1"g6m V­` [ c*|T& JvW^>Ay=uj|v-E]"sjl=xjdWj+NpQ|`]lX'D^"*;&+_FdݺH|]Յ'iťç>魬 htjB--7ܨywcET]pg-xti&Y\OzaꎡiV/27: @;L-VDTv!"SEW@G*~s1c@_xF8sD>h#VڮrhHupvNԈ9„2w'NΎ 7At _D?meQ\Q 4mAZnoT/{:OY?X:%jx} O?իZTT U"n󟵔J6+ISD +q*W)]VFB0C7ju"5b?INI#Hǔ|RLlcnwo+ . ͮڅ aABz7 :xX,)/SDo5lN.:?s4YÀUb  %L+Y IޠsɂDD|9}GK^x±9@C9NnuSJ vp̚o^L$Rjbi* ASr` w^~^rqH筼s#6dndgUn8$&I}ͷKC+Tυv urD(&kSSM&'q&+9Peo*Ⓨ3qg6с29:I~2(NM̐v᱕- *57ӹS|\#hRG֙L]AYcUv.Tmdj4#7΄Ճ[!g AˋO `>sDj6e,_nÎ*֜2z8ʟ9h'Biytԓ~p(Wmx\¾^S&ǭ&P(m2$ P%kXch6 r.1n^0ԭmzK7=˶eǥ{ B3KDOyhCzy YIJ["gRSr$SIT-H"۽ y*cѻ7Q˺n$hBn6fӺU@~nvVKYd/ρ-H710^23M_WPfĘ$ pi9zV{? !oO̅/>k6JЧ]JmRҊ]%Q@ޙpfE4N5:A1ld=j˗ aՎz8ܷ!2JRyIe.UX)|H,KO[;m%t )ءgYpq*AS)#9HzU@iwh(Xn71}(E>g\ߥk02X!4 S0|hV{d^X䁅9ϧ&otD&ŏYw|+OML<]z ΅yYf57t[|c4A}(":i&s)6\s5n^sH!sWWtg nTrf 4y"/?ׅ|ҐhM4Bmϑ2+Kr$N]12Tw#JG-+x~&BwZ BݧhAM7?,dV??tMhG.DeyLE*!?~nnPdA[gB*R[f6Hr-quǓ{/5tߣ48e{ Ż!6hBzmKW-f8RQ3E<ĞpU*L߾*yME3LuHhnp<4K S02__Hd}1k;}`h^ۆ&5#`~tݡ 'N"NuT'&%9>1mXmoԳnـоD"0VIAې_k^=3%@򞧑:L4Sss{ ˘庇G}'P$=.3h~9t>phJtq˱]źwC'P1CPJc;ZN+|zwO`;GȘy^-eUD&"u$xmÌ P !V8uQ<]۠AKoMIoiL^?};vqߌj'3҄u;^Xc+ޘwӈ~?7H]cA w˝hT2f {?1|!%ovtʾĭpQJy~;x Y+;yjWm@_7hn핆Dp54ܥ eo *L=352Kq#US=P(DatZF)hhb@>Xa [lÎ2#rc.(lq@K+v4ɼr3"c4jr(ST?f8z:fQ]')~ͨT٠kӳwYbMuz\WK)i3$Q{&W24N(xT|apnI]p9y0.}k\gFMOudB̾! 7xЁ+lѷ&?8Of=&Ϋ!BC4^$''Њ%qZ쎐aDZ!w?tםk6d$L%"q/Np+Y/:q7B9p VT?ϧl Ԗ96,{/1\P&m .>7);+xl)ړ1%#TlKpbQw)Gۅdc l^ңl~iS~Z*EB @Gv%)Kڙ:0ꑫݿ4<5BtaB:$N9&+4t;^I8&𬴁ɈOǍVP*M;jt8׵z9uLlkCQ^QjTl$OŽ"m$=BٴS\pvWp%K%Ckdn~>}οDBR>MŜxzwcANT00iȀY+|^oc$EQwAnl"C "}^(RhUS-H +YTxL>`rr&BNK5/~`y8>0x KGD;/,<|-&?z|~ ]/sy}E<`FP~AεXՉ&QeϡFkϛ5_=˴<7CVz%d4~Xۏ>kBЃ"$Ďf9wݟd3(oɈ^nA #̽ ʫ:u%x7WJF5e|9ՠX(~v)ɍ gߟ<-o̐ @x4=*L&,R!V<ĺw8*uFv`6 ){ _ d6W  wZ^†x4 D3{fV392SjYR7!|r VP`ٗRyxÝr=?+ydoEo _=][Q4R2ΪCTIn>U6>cwHdI89G!(hi8.C|.o4 J|9uHEOçe4\wLvG(RBrEB 8KX>{[[IR)%~]<=7 #hm aui]q?ըtLRNZa"У.bʸQ ե1.KsTP)LIGӆɫQc#DLOV+<s<nu/G8.7݂$UgQSM928O#Hi ;JR\>bW>" c+?߆=y;v0v:-Y>܈G'PHS:z XOl];yLm.s |wH[O+l;t`.gʍւlnIRAG&TqyzBίW%ыkkE5^dNaB R cKj5`n~:پƦxI}P~Pxw;Ha1]|`<>[1|܆"Lf`˭&TȒ3~#ck8cm%/Sۺ _F(MM'&RG#TZ~-%$&DfpC`1GѝСUkrV{nsHYUFeS߷j&]$LVXQ]ѫ}*rW{.:?%6䏼rgv-_V,rH:&&_4 P%ˡX%7?ȧMdOkS!i2],]|OwVO6֩%[#t+Zvf(ȼ#z< jJYsex>eU'@4i&6G1ۜs=V b=;AGzc;Г9MD9t׿^6**4->i9237c?ث?mR2MYK7@LZ׀v@:vȼY3P'$ nrL1c]J| N|dI/B<}SCVg?U '@ڀGuq3@+M.;RHa|TH cBxw{ģ|j3w6˖O+(iku[v[7ϧ$94W_ Eg:Ne *_(6o!k8IA9C`0QX:LZjdH%ӶTTPU&UL נu+jownv ?`6X[||.j] Dg\Q9U&5fýy+WTDy$hOebQF_ÄKaD|>&w$-:A"W#JFJ|-8~Ii |QƭY٥*wzѣ X~"=ZQ@}cŲ27ʣu\M(N@>'/liO(k`IMq'q8 i/LїK &;N#~]Hu\aY /nk&Rs}d VC߲wrc#x #xLg3}yC8Ddp7 @_"^!H B{{ٗ'}k>pJnPJS^ovl!zA͈KZ>jͬLp ب4ciK.D<7Fni)FÉצQ \'z|l`4嫥Sz:NqA<)TXrLNRs]k.OL64ȝjnh̗ٟ²Xԩ4mj_ZߪDUGmA๤Mfbq"۽#筻8l24nzwN =[X[zϑ`lx1?%/)fEhȁǡmi"!C'6~[q(v\/K :_JQ4b +d9j?>籡uic_UIw}C:unepĥeW٢t@kypKH5ev7X|K}P}::[\A6JORK~H>z}`ȸt`]j1Θ X=3dm _ 4rL6Y bƕ U|?jl0kX8c'Egc)\;'^O˔5J5O=Py̗ǥ}|ǥ͗I[!w';.0I(?E ~rc)T+v &ֹP.&uhH_ ~ҙ!S!Ȑr5Dt"8h6>Yj\YqdC-657`.~i_8HHoy6ѕrHG׽~CߏԯK~C/`K53gE}c&Z c.ٻ4Zcd&"6Te`*wëlqLʍe*u#} &w0$U(:m}N]zx41F?T>mTcX (i6fye}Lm[WO=(lJw\;/ZSq$2CA-vE5nM,DPTt 9@t{Iy=B4g`;*;lg`ViQ*Y0* l@~){,bVQ=K1INU?f3 Ǭ4 A:Bv|i9 "LpQ]&芹E>UZA0-F\67O@[ҟ~:yUeŶh{X߶R*භI3P#UoVq4~,-w3b8,ae~bз~B"y% J' w~L[N=Ȁ>LZl*e(E%mn]OH3:%7SoAH)hl8fUzʝX1uv~4l9wx(1m¾!(͐Q XJůzMĢ[ !PK[\R? 8Ѥlc@Ie2ݔm eI+\%A]Vt)@V~= &!m  -\$6Q]X)/7#=ӈ^u..%ujn{dlk|}v_YV'B~0aR9)Wi7Io2܃dSs -Iܣ$bD e$ߪ.LO%'[PzILD?>Ç6zoLi[(FΘ6+:}ч7ki}X w%m=wd0nmr,$G˚D1{l8k+v*bv d<,ZW pNY0l]jXE O˂9zHWV3{lI0KiJ w?v_2dU fG_0 FT+]fyO1sҵU2;$@6<;iQ~ө[G_')y9=f{5~y}MՀsI&WR{{,{g"?Y^KPTք*dmܩߨk>vjc>Wz%ٷJ|=r$}xH=gP3>9X ɔea>y ~dv, dE?Ŗ\Pkmo׽{/}':.k7xR|ʃٓ Ƶv`/j" 5'`J^\.j{om;(43op#HCL6EsfLqѾB+<c8C]w*ibab#C*|_*,ɑ]m(@|2+8Hx䶙NuDuUIq}Lºt nkA=!gȼ@;GjS"'Tt4Ml{f (Wt9:K%8G@Jc4M#Z,nodjg q4-7R+I0,kio+(YwNP"bn  0Km {ms+7?@N}9]|84pkUn=n /V蓎Zg2&F˜Py3^ =_65sVy6W.Hq<2IzuwDq_"ϱ$7pi [hc xVU'ĺn-}FYeUbU91t”a pNVsj Ƌa;L' z㏦:IkK=JZˑ|)hX򧖑cc2{4}dbNieD’m|brq,ƜK.=Sxe;C$NrUPN145TPqf!)XmY uJ׿Os. ̼zKV_D xohYJ}:J+7[n ~̊xA^vHE.B L7'Kl׉]I8ꌕ ,M$*+SL%CTq8P^K!;^,@DZCƊ HŖ =x\2crDg;0⍗4_&L<>e#JԗL>Gɠ0ɣϏhU:wZ83 *?eNgWib}8/c +sm8QoA:&_|OLT#30ud~ߦ;%WoSחyX!&TKL\4%:\g QamKAzNLW.)5nTUz4֊4gnȓ_W>ͅw pa;JIv-pN&cL>O~CL$Ə  \p#5wb-# 14Pn("wJ&A*kV~FLFC,0~\?EqaS.I "mS &h) qgoMs;+IM7=;Vʹ pdqeTy6VӻCFL_{9^,,1X Ww6"AK jѦmT9s5k|t3BXzМN b^I#o8˃/T<֢04%IqLSӵަhkپHчde]z6`:>5ūKSe-7#UIce(< `LMݨYDl }d?V|E-Ed iILwyZŷ0F8/rISn+d"8;M[D^ 7e%&uLWj?C,lP. r%_u N`޽.Rݖo٫O;%/װA!an<}\*[dX9DbKvn m(x/0$<3cMtV1¾BΠ^́AvZ57KˬxbJߗ˭ϸE΂*(B$W'=kE(KFNek%>^rzwL|>rVBr_@dP忡%붉>5¯4(u9"ŻU^E!&hm>MӪ%9g.DY Nv!Ҍ2(}+$(++E)4ܙ:TuA9v]I5>dfLA E.. _0 YYU~-PWy^|zv"c\>.3Y aBNMLUӊ 5vh.jz?]+ARh;AT,g-0o*3İNO8 3f(/&`ZCj;0Rx$KԖ#ϑZ,*e!x-lFA{?t/#BNDr5>`nh6~ j-C2Ey Xv$]'$jқ(3e d 6X;/{&yGO ϖ]UF)UnXr)N*:[Kdʓ=0ژVդ\t8sr6m0lL_][IϣW*kh{m!h[A -_M>jtwQj LPf0Eq-"Ѷ;2Xll!t endstream endobj 78 0 obj << /Length1 1788 /Length2 11016 /Length3 0 /Length 12152 /Filter /FlateDecode >> stream xڍ4$z7fnFw,VfuZmuZmYX{s}=sϷ?otTZlf 9 ';P ف@.T::m/1* v@ 2uyɘ<۩8@JvNn''cȘ-*%N vyNFs& ?I{ln X3  (b(njcb] g dMjj;*@\ < +<'h)*A?4`6Nvο;򇳩) X@59evV)ⷡó)Mrgs6]ٝv)rʲ i{{w}2`(=9-C,,pux ;e2y#x@ y[sC[`L =z;.PWP99`s A'd'~n>0>'/pycG9U_ɱo oTWm*B,Rx~pk*&gPuxe7͟p?.c;m 9W;?Ԍ?jS{_ϓ*ϻ_S]ПVy;$!Vv?#YP[9Bsx;0 }kl@8?y;,qLPSOTxq9d8!..gzK(rE"Hp߈[;>}Yj7y|&͗_pX y[,|o/ 8ϙ!ϙK\s&s&A>?e?GvIqr= o5w;Q'%(Pٴ%||tma{\0 n=*Vv5j^W̰ž1 ,+0˙'Frax{5wu=7DȂ{]⭿w;VD wl[j?Uhѻd:6O=inkWUzpnLO7)HBޡd_FēsEiC̙U- fȫ&{赏HРiMH knj(ڵ%j8d6&i"KexM5cXqLk&`-%3l*{C5(ɻ/P ˺N˩ Hhqڠ1Ƞwp&A&QriC.#{_%gNoPǯ@Eo{y.㱼Ի0P+A?`r2A 9&nibPJ8>"NW=td" ΁ƪ2nE-1MZ.I^YsU.)VEFZc~=ZЈp*Ҩu^+iZ׷}LhavTp #^Ƀn;r+=6r,BrҰSeNf L9#tzoAOY?Ĵ'm6_@]CH@Z]'tMI4(.幭(,Jھ؍:s='޼rȷ.MG:FA2ff&aBs,1fS"ll. O[\S*fz0m:D+ ; Hi|Dw$\bb6G_]r6 UJ־Z +yj܋͒yQox!p-6z c{>,>^%6^F#I%*ng!Dd/EcòM1MSg쫷b"fϳ4zR{ nM4wYgH=;{DZ52xK}Ifuw:gCa.<ּį ~jVVd>IFʰ,Ԑ0U+40(jڹ/tv:[[?xꭣtSz-~Xdo xK{ 3,{PdTV,{jV.9Pe'G@hdA5fX BI;u06HqbA BMsI䠝,<k?ՌoYM7ɚ[`'[&91ZGC l168_:IjC.&[ު7 IJhL褵xfEG!ⲎqqN8Q>YMA-KłWhA\ > SPlxC<6 dԟ:AWGm另ho*n mi6j{6Ɠ6]s)V?Rt[@K-ГYg$΍XZWگ 8@ͣ5=bYW( ILr*KUN(46~x;kp$"a&Bpq_+P\Z)rٸ1q0( #6E !c4^n=rl?F4v z)~B(lU{T%#Sy^; [%¾eS󓃠jft)лD$)gpy-Ę 7ҫiC l&C˴*n)4;LQ[@,& qvB!!qis?ކsY@'ł{c}Ym@k!]}Ϧu#(MVL y@ +as!s9x{cu N~Kʉ/I+;l $Uf#T|)*Hd+zk1>ƈ+wEW5rA1Nf4]RzdOef eU`Wj#_9˲x\`OPnSBK˭}(lz]oշOei樁Kyd H:۵ee}A9r4d{qmlH'~}~6ﲓ^ȹ (#_.c#2)ËXGj l 򃴲y#5pw9 ɉ 4]AeDbh%^0w6kYmt#\qor8꼱C ΣrJ"M 9$` P5Ғ6#߾~q6*ZՆsc!5Lbs,Ҫ2"{<Fj :/~0"J|iףM_4]u5UKyeh p@T/ϿXz ԰HFEI~ K]Hp ]$dM[Va.[&XW13 PrmctO+1c}ЊK{ :Uc^IJY ZW -F #/)>zP>\k7/؝#H])lsV'pW2ai}]uA>v﫫*# kC%~2PŒ{)7JrlWx|wxycjYP--.{Ǯ' h>G5mtZt9<2 d,ucc*+N*8t%(FZh(6k880.U{'K{i[GQe֒y(clMq76]ۋT RtpNaeh>I!f)2{G16j UBq|Fߣ,=Bl$m4 ǹG$D"?D\U3{(לsDOAXuc[cDŜJcz+d:3[]I,ZK ᅄa`j;K —[+ZR4+?bZH|c4}_1u9(J";x5g~y*pxG4[AC7u+ov]OHsVvXGɭm !,1+zv2zh/͸T@̠śu檞@~,D 7P)3Mvv+0|Ƨ`2{mAN2hm򥑶O+0kCW%Jh]B2 v4x66?h.u?RhA.gɶj{Mq\+|W܋XloS Z2MBLc߫1Щׄ a6ڥ(Ne4ޖ^#%v~) F;Gw'hnN-H}`9lqc/~ 6W(yL^ uNYJ[pΖBTF Is,JO7X] 3# l}Z1Hҍ NBA s$#Yo/zqO= m{%@ ʠmb-d.=yq>״%NA*ӍZ2GHvL,V_Ub=HM=V'8Q1A_= UM;I.`C-79>٫$vY}U 2O( b|(qO_}㝉fe|yG0+Ƃ9/QN1'nJjʶwW(Ul&81)J|_i@P,hqlbV׀H:cMد1\>& G_7C8wXUfF ~Zr'w5WfաL[󨜌'^*ONu\#œ8gYZH,DXQFst U8.&YwůA:gQeebћBgu8sGE;0[c9d/_/ j耑5%Gek6j)<(O@+4RbmU vQYijŸ\ 3MnlaI( D{OӎYb*gjH^!fUPٻ84{XSoՄ(vW/~ },iVFTf8XlN)|+ɪBD,E Itg ݅mg,5tq= d1j$.Y+N6m"imPh#;]i<Ofjjס9=YiUυ[eJoǢugn.>d)>_ m<|Y2eyqѯ+0RTiȴFЙzo5r2ߍ&Kyk^'truDy!~v57qbL/*w*hԱ S OJXžt34}\|y*q9N̗]%<[t]SU3Ft=7Z2?2P_ 6vKl#\5F:h#\#tgV],Im:G!t3T:Ӥx M!1pc QWuyV/⌫]*mG-Y($0س>FۢoE׽ +^STNڦgw_tPgZ{2Oّ|>ْFA)*e2#}Cy3 sJz7LRX,~$S4]X1ሾeX%m/HOK;zN{@<4c֭XԫZj[t0/q 0!$AmU#@ǚ9TWL/8=1 ?C*JbPIt|mpF@@o^zDlM0cŝu®!r'ӕI0ZtPm=X Yh.A}(X, p'4:f,Ή)n ?@sK\q'LLJH7FJd EEV]RV+RYդ}pd$F an Er_%壀?W˿dʈpZ SM]{+$M5UuLGJ5&TETrWOĶ8] ^X5QSVL;!FD/XDD$8(i⟭uh;-^~R!)Pg}bS{t.!M<=<g}[=R^Ⳛw:4w#a]2G%IfNX+k~@CXbSB3WS!)V[)E"{!ɾ-]Լi\(•^]F7H\f#5NrvJ0d]J*YcѤd66.AnȞeydzN#J[InE2RHo D02>LJ!ճT46TM;O>,v_V{Yx 1쩸6 i 5MfC[lH%7f]loM ]aiÕޘ|xFEN҅GtgW>7rkP;&B6&NpHOqK&e&}_)#ii~}0G 6gaT 8S+yҜWz<`*7/#{#Y&]NvF5?n}檃}4-q3~ME\:A&P&GAMhtM*TQC-~?pl`/*cP߁?znВaVlL߿*TK%K[?rDA&sq%')@Zif tKbg GĬ~hnn=6sjY􁫛f@bk?v߾ORD./Y5)̥rt+ |DG'j +~<ٷ,̦YbАn˹>&O:|nʨW˻h2nb/Vx.*ocWèa¨[=60TnX!dVtQZzϳ% X@r&#^N 5Il8#)fx[[uϣ{3;btK˾[R{{,t4$m=\nO:xEUak= ŌU7}<67#\o_+O AF_(!6g9*/D1}&}C{@캼5&J͓X0<'QFN;b3Iyb`.J@嗜}$徠([$g> exi>OϣgmNv_j/~mjbҼXqwq)+qpK󍥦^ء+O;η'Ց"=>0k>=mv^5%늟pBc[Ч +fev֏R9ZSeǫTK /@,;s/˻o,$V$'؂i]U?ʼn:i(~ɵq7 pWtse˞o"ayeGrK^nKlHtj͑B6!v x9ƾM?iqp)~PIQsx endstream endobj 80 0 obj << /Length1 1576 /Length2 8204 /Length3 0 /Length 9230 /Filter /FlateDecode >> stream xڍTT.L4Hǐ %Cw03PRJK4HJAw+ֺw筽w?^ -k(an>@' x@~}(  #m `}y|ŀ@?(W C @<58 "w:8"fux@m0pޯh vmJI8"nb>>><`WO;pB u9$ uEW.+ᮮq0O`"ak{AT 7cs B@ PXTq@|mysv23wI@'@xxA/AmO{3|P_^{|/{ya.~>_^ e-S?퓓B@@XP*o6ހTP_4T۟ {)Cl((?SnH巛B] W~*@ـoIA^UECwJP_6a:.PD uϛ}yV]q0[ݯz {xp<08>pO/`u@/H7D}#{B^J R\\^Ŀ07O[l<<½_BlqfNmղ>[cS,[F ^٫^}8}piCLfλzg:7V)[8Njvdhiep0 uF}^啻vɥOo]_٧-/UܖMr'$OP0b i8} ΧR8qw^'] F7ЪpJU=40$50*m-rAH@QGB~ ϐ=k"6kU]Q$ Ÿ\4z .B9c$]Cr؃i*d0I|<Ǔ_b=:T_U{vX,cN6~Cxe^f5ƬX3-/iJtڻp8'3.')~~"gFapN iچ+ }O2b*X*N˥gJOT}^ ۇ|Y eHjTnZ=~G}h"~Ӈa/)62^G0L9rbrpM%0v*`yM䘵G"ĥ;tӼءޣ<щknA%x!ϻJO[ݖƩAۡi7]h6wzt鄊Eu/gC!\t %մUJB*hWی=![F/ Q#?,τo:_bLsىA>[`B^QO迲>jX> U9mOڹ?B-HYE2@}.pw/DM;u PK;.fg&tvoqII*?=Y<.dںJ[ë$ROmrw Td/`N_0+tt[F:i{iJc4FekYiݘÃ2[^N& )hZk'/TˢUq G72),,yhFN'84y ݢ+cv>^v-;f~cTir>*td#de2^Ne '_ydӢ;:n*q,Ђ"(5"ηS_k|/l rS7W2vV#?ݳ|4VϬQ=g%liە$y<Mp՚zHq Wkk$hSÃ_LŸ/T.YG>ǟrz)?H҈U=9#х})5p! s=ZDMn<4FWGP;]͒ ޫ3:2 ,t=4w~YTtǾ@Hȁ#mOǀ 8OO4H2nͲQUmEÚ*0Op"֒ffȆ4Tus\u)|WC;E2~ᢩ8Ouh@9Z0"|fcȏEu9ٛg%(D#aȳ :iAc&vK*iM!xRl,Ĝ4i][f}E`|ʍyK~hJo|xd+Mkh6we/>i8LF,#v\iP/cJ6@ M#loIKrkmjrkXȜN[ܑDPXk#>IazdÞ}lkCf\]'zyk,um:Ī|' )J<4Ӭ-Bu0]i] EBous}>Σ_k ~&N+NE{[وq%[/; <+hPi^+h"7tt5t *e-A'ʶ:; 4[kЮrutA| ~JZT-g 3sk(5Xb\Y3"?zmcp6 r= &fv TJ2pOO1s'tfG@! =.Ndƾ8#.]hwRs!6MIQdH |S7&o½AB5n_I~>l?smLQ %*w'oyEWkw!lv>5:Q !G']zx1S͗% V5pCi$$A)k{ n}nIZVKR&2ʼn#'"dkqMϰ̋q2n7+]a +A^BMGa26a"p1i)qJYn8}֓o^^k0 cC?qÕn#ztFIP+v'oip}c ul16OU;^`'E/~<~U8f&̪;NB+y[*aI*_mT`^U)ꩪ/R{^5d TذѬ<ٲ"&SgtX9z`q gE y`-cٙwF݂!O)-G(S Jlف1y} c?Rg=\<~Uw/q{ѮTM-Qjn}9:#P-^ZGS(VSUc~[zLM!z&b AН"q>|hznCgQn洮W&9(r1M֮k%ޒ`buqMUr+9fmt& ^Er+tS69Cܒ$F sbC"z[P!Iٴή X[K'㏐G|L l4ٲZܜɡa7*T\qElyf:F%e]y7 nwiNWحGB"+r'dQ5&|=y3+Wv2+e禀D1KE#Rv37e0\꾤X1P^؊afYt<٫Of"N~-(s>Xʙ\hO9[Π.uLmot*u;S MJLqDtߊiw^0m?pl*|ƴ=7J / tMD[,$3swWH{П+I ^k{lx0QJM<-$ޠST9wLy=V?Ԣ5mmZtQ^Cg,b RҖ=Z!l%W$,'6ĸUOĝ5ͨ: |O'ڤeXhQy[nf'>6>+NfE W9DKјI( ]b{=O;_+JqLun~v!zOQdEP!SħI^-&HwY_J "}|bV>g@& b!(2QyBu[Ia> Mu$w(KQR-ձOW{r3%0!o5hARF:ބmSFLaʰla']׃iG_@JH#uPYvFs>8fS/> OMo>\u U^|J)yyLnGo/~>Âbbو&6909QT'#09u1awr܄sCSt3E)ްs5 V5oL&;Sh`RvIK1.z=6;bT8mqE8;BjFOrwPđ@3ŸʉW)B|ASG"^h&MbkoLp=Ib-׊g_T^yD.;)m T%B*`\BuE-mIZQ(| KzT1>wdeCgϦYoiA\V>oџ8J5 PF$$2 J|Jp/쯣@u!Yl)azV3vmIyQWdMFUU-e?mܦ4t\Θ%IG|e t;+@)^hctJ=PG2g\\rshov޼qH9ScNT6 Gˋ-cZV rz7gF(-Qa1Ms0O>TsU3,TsPlڋZs’T^\,Z!ұC}zy%-_q-y|ۑ~eM-ℋi 'ՑyM{;7RS6$SsjhktG{c'F?l7 PzP7N^ Pn33U#(ªVZCe ~! kU Ar7&?d tĜsa5/T̼`Ut"Yu{`ŵSwXSU2M_9vey0fZ@ $jژIHtDCl<$aU$Q:L<]T~'+eiI21QaҞ@򍰻{c`8}1[ *Xϵ`MXCo6GdSngbln|i|}R)|M69͵0` o5ɹɎv~@?d4m לfOݠlu3DZ*oLҙSin~W9%Ka!dJ1*{ٸ:="ɕQEԳD2hwPNZv10 O.vC5n)ݚxx +f?Ϣac)Mb͠=xx-Z=§ $/&~Q e C~7li] yW/!j 2PFl-$RFr! w ޝDA#@q';*OV>OKr̡|;Dv/ԁ=#J"/޾4/}ϿWkc\"" -LNjeeHϤ YzI)~7'e`C)}+׬ R:Rj:&d-Ƕ&,sKwzD7P%LM=պ>ԄOʸ(^Y~.}6ABe,~Js8FQEX7u*э%1'flϱUBR3=^^"#i@/mtz3OY_e((V8*`cJ?]KUYk{(V`E 4p˛v  ®>3"zQ[:P>MJ/&O<`iw*c2 n;}̘&g]fS<(%7W )BS^h{23| RA.NkRlmgfۭ۾\/> stream xڍVT컧$F42 tl1r4J  Ҋ( RJJ()W{νgl}~{TT D1PDK~~3FQrͮCx:w3@>@"-`_hPpu(7_ AbU:`@p A( G+ @S4 ++)Abhu_\! L 4sEx6E;c8@(o| kMu s^G`,a_<῍_j|8O'p8o/qo 0,@ɎWÝ wxA_Oxn9Q.HJK\7Mh NT\(*.B @!YZ#(dA9@_0|"wC4p?Ka/C7?meV(b,~# @%6;!|iB񛡂rޚ s@( ~`?&8~]RC;9q)i KR@Np߼Ph,> tFc)) _2-/o"Kp?@nu{ua (E(n sLC&";bsAiIC`_y ,1Ÿ$>dd 09vJu7JЙWpwV]|R/(+g"DR+P-W9C+ӧ2j]^ ʮ={sڗ[q[k-jۘZuH3yC(q_ *=&ŨH]xJ"kWQsDdg6®AbF8ݵlZ' "k")+Jaޟ𤠔-bRsRs3rS$wĥ9l&X?K=0eLPJ! }I]vA$o%|؎ >l2EkO>bw8̈r)dR'=m{|C[VMF |[H>IP{tϩ|ԝ&%2T٬M|$rJ;F s!-dXFu9NׂGCg]\h[-j2v}ÿ{CyL6kiW骹rtIh Y&0{6# ҷvifB5^L0wXYu\'cӠzH%%MuRFP'~fz'>t|Dn797]b4I:֙#@_㌠ԛ4B(zYs:I!l~W ]˹iYBuSqEiuԽ~v_S&&}SF$ED #ߌ6+Lb62ի^O*8ɫEJ56|2 $o*3#Ƅ8aC㳚nš yu=:'gj<ޞ<NXAtڭrHr8ž^_x9ӵ-yQ$7IT. >6 dWʞ?O}V mA=xAʧ<E7hWtuƸ5Ӭ4tHex|"\dn:EZ9~NܦΩSX>`">6E9#aIr<ŏ;4Zm {d_= Fx@NCx޵)msFi4ANvbkmۘؗi_*h%ku+alJi :Y?uf cT`39y}YW_?|W: U͸$,T ʮ?,pjUDOXt=0]P"a8":#Ȱ殪MyHF^0\?ד)~Hkr5$U>YH'i:2 ::7J_Q*y 윪G"M 1, $[܊cV5wfeF X#z=Ghls}Ix ĕC3^ԙ?KŽgj6oSچ'8wV9R1&sjk#dY) ? 8[t1s 7dc*DM]%?]rkJ:U+V& =mwЉNwEyZ)&/8m.®d4.q(zn^WY)5Jt'\ZxV{y#[E\MHiM;I }žO$䧗F~?a&}d^2^0'<휘hlN~-Ez xOHb,9}'[/Cvs^\ /jBl0V6c v,mFN:`r9 ^gC-86XNI3=k*bWEa2+=25k{L~\hbQ7zW(6>z~L )@y.qO"? cż[}6hހ`y.&2%ћ7jNJ[iӥ&iNu폥dܪQ֜!Fɯi4-Y KTi>0NcqDUϊۘȃ͸W&J_?k{]Vty2zfv !>mF9z}7w%ikU_DhEHI~a7<ӞJ@] *g$c'Ad籨k|YՔ+L6mî- {&ϗ>3-$j AfQafQ ݋Z xtHpgg~AIRvM;;-Syq߶ G눱SVmw3 uj#}Z5gm>5kWpdյUUj{@ pL׊Oc62hT ۵۷Biwt]iiOF+ uXhl$lai7%1؅Gy) ) WI|\@2EIp>d^j\Ml+8\^, 5_Ϳ5tPO! ιh37<#D}is§@O ϖEBfi FM2qpw'{ep\#pZ`G@T"0+'c3 Mɔ(g藥XvTr9 ا$Y-% f~Ga?@CT a(p).qGq%4#[ 3kE6aWكTӄ|WPr=EJp ~ZV XKAֆM=?ׯQhUJi49~RrH Ƙq٧ d8QR%=3=rU@Yֳy#IT:|Յ]تS0nv3!5nMN:[- eǠ{JsTi+.cRH"۬lFE}gZS}ĻSm)7QzsBL 0Y۬ngwX`mnjӍt`XnYWyRW+nXpIj9K 1fr.sT#ȪSJ$ (ie ǖDG69K*YYm_lF-ENCZPuj&ltW[@&uVXZ/c#"*¸|#8r {ւmߒE7;,oTw;㨊rQW^YPT?@4'AfTW>bΎxcUv\pmehTH<>ْdk#fVC =gqI[?֦ѝvcw%rm.RAF"Y;Yo $:A󰯒Sz/C)$Uٕ j7n{7zg+ؑO1EO2I2s?/Pzʷv-i)0M C)L7nZ]e2e =՗W_}C,n%(& 6Լ7-;LHCTA>gdg&%ed?xnB`w%tZ3u?%0LS=ɷ٘~7FsGQ v{ wmUh:n00& Ln_љyAPuٗBtjp:V$,e3V,mWH]6>{goϹ$5BVFw"-HT]W;-!w?x.}Yl&{}=Z K.9҉\B {>gkrQv6̛wrp鮉d`-}\\d4JJśv3ѱ?&pxK3ܚ$x o>[j^ F)pw ;~Y !;\w_%. HHF3zT)LE&Qvq-.a@Gͭdm$%:2O;__*m'?oCamޢ#gy߄1LŹ e.SP \<\s-34Zu:>cra6S +/l5zX8@ _å|6Y$"AL*yoRZv} n-Q`~mԓҗT*!4_iA.^ʜ ڰ[o j}I\TĮʾ UdBǑv/{"G 'ϧ}ynxFeb| ^k)Whu([/&\ޛ"hvp6&UpEܹ!~|l֔m3BwX0RTѷ'vY1x䷋F@LRb޺P,ұh CDF&||Cg;_ #a endstream endobj 84 0 obj << /Length1 1690 /Length2 9735 /Length3 0 /Length 10812 /Filter /FlateDecode >> stream xڍP.[p=h>0{pw܂kpw !ٽ{WWS5stZj5 V {3=ԅ!R~bD@@JhAN`{RN Sg˳= @^A C?NiS7@ h9J;x:]Ys03|,v ')lb {f474  l fjfd%pXހANn TL@ cChZk[:u~vpZ %ҟ,d/?ML` Te\<\XP? M!n`ٳM Q!a/Yj!eog84 d|j wzyC-,(Ձ] vt)He,BGfrppp  Gܚ}%|4ogS7o#4 `6wP?A;=σpd<[P?濛ˮ.Zw$%=ެ\VN|(KLOD=@?e5  #T`g 8x8̟oGeCњځ!韧y#oA.2jZ͐ZAD,dv1sӃ0f 98GkOs~@ϫߔ2Ps{?v`dg>/\٠..|Nh.7+ H$`7qs?]G|fvп '___/1_Cyyy.ϼn@Ȟ/ @ sE{s`Z 2wI9ݷ錬NX)56.%RF>~aB9-I8n;i 䬚{>>ځ݊yXjr +㡋{5gYc Kir_"R0z`_\ὟzRL`F=*䌽YZt!!#p% bR(]×ʩv- `-d3zu%f5T{giɷ3P2si4K&qC*!F5Z0Ჷi#RЂ;jյv7:ٱ,[BZw׸ p49w߾iVN4jmkfT *gS&4@]j4Ә$اS ஝ocHUR+9✮bƷe/&3~8`i4n*%$+ꖋN,Du]yn#2u\]Ī";c'5x!$u _g2܃C r)7oLI5n ;@C_"W5E3s{}ۇō~^QѼ%vI!D:ڑɗR2h6v%֌$:# aQMACQ_S"aF2 ľn @+}&qŋgXq mKXn |Ҿ7;o@Ӽ[!>hK_8E뱀KfC8֎!ݸ=@Oky|Q4Olw+̔r{.QU'cSVb`en"{+csu #k\26 C@ܗA6g iYxO/mveFݴ22 4N^_؊E9ȶ%d͸"i U nK.XH]5+ZNMIӥQX-F:(-*:s܃&1%|#1$Fd+JvDxL0|L+*Y[֋I8f*]itK/uHt}{{QQf.iY]ՒKXXIt3'G]GWX y ~"*:eu B ؎Ѕݔ?m|?_k]&i q{K]yTjKaͣ.w_θbEOsBUJ0?Ʋ9baHH7 /}D]vYԍ~!m Rǀ'kb/0ocƇ kM!2݈DtsQӣTӻ,BÆޕz뎂ݎF<[\YXc@UmVeL۱BLzc{"qAWh2K,4Goϭ ԗ *HW#;LNkbGT=v¤)B& o!(T:e"+'ۺKzֿb.?R2n6 Hލt;֌֐Q=w7`R!4i}/;^^[&Smtj;@%bz+&Mp|(W40ŒBq~X{')'Obsݕî'и*Oe(uKi/U2znґI`uLŲឹ7\tsˊyyvg{}& )yv6cZ)/8CkF>PhF—~hJRO6D:Kyj dC3YK,ݐײڧ*~vԸ5SNa⺜&xDUBeŧ8b̂=ݍyQ3haVeO\")Jz2ZxDSCI%;A3U_bĴT Y.5!-r;7zS ^fH-I{Nc()ɬ p,&`c!4Mx>?눼3=1z{%W"|u"8n&k}q*'=@GhӖ1h^d}&^" ¬ hT:ΰ#4%s- fu##.9ijg1'aݞMn~I=M~ §7o(0<;_y/NQzX&f3XbǰQZ X#)~4Þe:Gިn|Ƽ<@)m5hg?#E'ZL/ފ;/_q*WkOAu ^ xyb?>"f2#+޿>YNA`*vK/Gl:*qjtcO[KSO^QLNT]9)3t+g q U"nC5@)R?=`{Q%7řȌ]4 "JkJ1_wA1#a`:O^R0]<{00Nݕgd2"ڤJEF26rQ\l:v]+- uO.q2W A;A&%PfVԣYm w2U)@PcZ]zq67LU$, ]Zv{Jle-IPmx_j$5zAthRHA"3J` 29(cX4/FėL(8oV H=WU-n~C=즭$s&WGkČ%_~ڝqđQ7u^u'9j{wFHvҪMVp5|R.M /$^ q{M$\lH `Z}j`*e8}urńj6(Tdi&=#NؠQ ItkQHE/wώi>DTFŶezS qژ}jNp#P}oJ]!ʮu&~"0GUIċ⩢ɂ-Pll k68qux׻Z@%'rՒ]O#rU)3Aks Ŭxe=70yS :8kxNqn?ЉO4E=^O֢}ۭ\zp%+0.Ro%īmK.O]#Q,FA̓]?]KZ~Xs7R yXGH~I2E_28w^|sX/a?Z˽2H}#s_Fq+kvaXqj=:߯0HYCJ)o;]@LoOrګ7_QqP"uְ86i8Tό@w'ȠU&wQSU,Cjvy9_&]4p lT=^Ll}ՑVzҨKI'TkjK\; ¸R9S>1s MasmșLo^!ْW5{0Rxkyۙ&td?rq$fZt065<~ }/gŎEyGxnh>~lj` bV=_t{aDxG`:Rkݷ—52K>"6NP{p;rW1O33W7_\7iBYPlUxs ',u &HQCܬ$}XnN6ђD[ e!a@F?Fj(ZMb~7@`X%E6Mt$c\__ PLsE|]Slq| 'sO5s Id?k{(XdW+Y-g۬; %. ġ(m7 c8Ҧ)bH>isV5FsSQjwTBEG]jeCuƻxUuek:mg,Vut鞂 ^NΫ$q൪%ۙ?jj3xg%\3hI"q? m-LmoKݬo]6rsESր ~tC/os#}pN,k@n? z=&-Ȍ5׃ZaڤT0ur "X ) ,96&vJ_>M,nNL\:nتUCJ[2ܺA \}_B6s^8Xz uE6$٫*e3C#|Tv30t$i6c՞~++|I9\2k=^Bܯg&XI,< ۑhbpi|"pbiBNQ.v>%g<ܰr5a 90NHLu5x l^ G&NZI'0/ m wQnp{t bL!:ŘMfm=N^.s2@lX>$Y{EdFyPqJilng(2[_)wvt|sEuBᣅG^ُH>n5qξb繭(-9G§8F?7bY|`6S >[h޳ԥW WnJw\k9#匍Ǚt~pM9]*ՠ6vW4d:YL#CA:0<:tA'k.7+kf?V%V\oXzO@g fz@ R:\%g1&%fj&XJYh%umؓ2&i@F`_>,aX sjEL:0z3>ʥ'- T>eMohyvJNb95&RF4zT%FqŠ]`Y ir@[͌&U?麼_l1q~Fb/r;DeaR_Uv۱7?#&vCc s_#uc3 S'a3V[դ.QdmdOz%z2~N:sژ[f=B/yNFvKViBXIf;\61,4NvR|_/С9i}.B|[-4^'LO1xI*Z@*Sǜ.D<8w~"e9q!ɇi\)J)GZhܳ?*l7J_a89)D"3eӭQUk }X0&4l7V5] pBXѣ#pCrMv}Q.'lb> 5/D\rz} Zc~2KYBlsAx7\9uPKdrD qڵ0AjESQOMY|0G CO-zB^rOzug,G v|22h7J{bW?1~fč r^=cO+\{#=}cC̨^C4ƛ ''5{^ݓ( 5Bҋ(}oZ{{۪|k[|ʒ56>?i}0NOG)2XX?]ҢLv`jv2{K&bw:/U]l MP%}JHt~ֲmnFX2սg!7§ϤRKQ9?+hM;///},׉cdE< oJz~_j`?>HzU1ҖU>&yAZN }y8J32X)Ƴ_sEWH&=e-r^FJlìNsMe* (ٳ}O""YFzDž,z2m`9Zʪڭ3 l7#BJ_y'cc2<[8mI- GX$'}Ζ.T3;!NQ2먲`[B84o3X.|߫ݞ K-W@_Rx#}pn ][81ubCArC"!pZ1RfW,3*D۞˦ZN9<"2_P4>PLha{:0wQ%5T/mjX34E6Ǔ"=9GC.>G*q#j`Y?AnR;=X |H`Uzd\oܱypfC~mx;| g;r7u⵬$׃9By7oًYHqi\NpWb|ud},Y'n06؋q$II RS"1LK0ٸ h覉R8 oC8vX_?4[P,,үݎ(Ax_3q endstream endobj 86 0 obj << /Length1 1955 /Length2 13973 /Length3 0 /Length 15172 /Filter /FlateDecode >> stream xڍP N Kp!C`sޫ٫}CFB'djo scg)sYT-]l‘-Ћ8\>dF.frviW C{'n)@ mot#wt4p#҄ A;@dibd3r~d41؛X]<'%7;39?- t:M&FGPtX X?\LN)Y_Ʋ2jLL oYldbbo`diig0e]<\hFv8Y]@\H `M,\-mbWK3ڹ8U=nfvfQ0uu`PttJC`cddb@ z:V2%`Akiv6r\\*11L-M\@sK;fw0~ OzejogePUo:.3#q(K,]?\qwP7.#eo=66k)Rhl-m\]>\|fNp o`8Y 2qA\"֏(?f02@f?CiKiGdf@???xX??QG4}~ (Klg4sGoV9|,A0(+~Oi^@4qu 13@E{`!݃] ~9Qp]Jj WUظ[mT]ƽ‹ߺ pr،|a*t&c?x~/sWq^E'4: Ƌ,bᓌK@y{K@L" qd:I8a{z<\ʅ/j˹7 jf8&6dg\a<ߥ/Ϗ?j는Us S@Sve4#"o`Tu- SHC fN|bF1[4Wn{>ƿzL6$]o`HtjƧjr/5JyBN959&6=$^WbF5E40 NYeu52p$ހFu%A##zb>˛K~Tg./(X+ۘ"$bGā0_G#WڭіiH2hܟgnK8:yz.t3>Drwswv$SU[I YVAWGcUިɭrq"w  x7ĨFtLuE|\}d#9]?4: y+5#vd] vJz%>74J \S{sb'>7a[lTT 4<]@Vb5Z&*ϓdն؀txM^Z9%)1y @+UhT7Yʖw9' Req Aذ}vV &*6a=-| mpCb9!Mm1doI0}nd$R$j6Ev龗Y?vO\O` s=%cDq ڔyC0hј_w<[(=LmĚ cٕYNRp2bL;U{䕖uХgoi )Qbe5!"Z1A䆟I-+̙Q\6ecn !C`Ks7DL-b!VA4~~6E(J9cj5EKa/3:E[1E8 vek43Ɵ%^Nr6rSCy ̿GLG)(il>ρz7t 7M k xDr] Z=4թů1 e?B+&*:Ԥ|uU8 W:=+4CoFJ"U`"bEm[sMo}dAZC7|,خP,Z^VMGT?.))ﴻ}""h8f}Yˠ=o"lxvͲh}!uk#C;bB3,RްxW E&,M{<#Y2pŚ{KPW=8X;;ҹG xV^mv"RPp8qf17Y e\e;@b ,I!Ty=Rn#f|T }nEhO49pIpH\RʫTt5Fez8T‘̘TRIzF ]sAy9uѺ0ԯPgoN9qSd<WLnoӁ?@уL{R],`h9"Ue@mh > čK]n%(:S'Ci9RűڛSK>5MnZ;=Rw-j'L"UAy?!Zq)B?;)X%7w!V W% ظ,yJX~8d2$QO mhB)#bi -u.#ICF&t7 *\SMzi͝W k_E,hiI3>&T,i4I$ O`pߋ >HQB@Ky$^+1h2T\̔dm{.vX)ح/tc3)O nuIq1@H'l'<^;3p1$iJ_!E Np{'~Vm%m1Ɵ m-L"`:4}b\lߩR]<1{gm ăJEǑ^u7XT:l=oHF/&?[@M,~Q(IW.r0KDGqFDGDx5Gt: M TZŰqK\dSu[k>alV < օ!WJj}3t hɲL^}>~7VڻV'I,أ 0ILu(y%"{|,Eٜs*N;xx˯m+- p?YvKȘĻKB ܴ۰9\!n`{ı睗< KBP\.֥ NXZ;Dҷdɝj;V0S^N}ȯl/@ g$lVwu۫[~(կe%DF鿨C01hLzhݓr~4uͼS?Hyf7 bž E1Ya5F!!E\͗iR [z>@HZ.8/k@n|!R&vG㙧**0J - 9}@Ol>E,M6[?Kq{$֢H:o4:?)@bv" rx۪G]:e W[0W?L~0BXh(+fH T8/h(þɡrb:=`q"30`-=*e/=cֿ$9nI:usJ^-l@#Ϋdz"qrotA1P`32߇J搟m6Rf7? vMi -; :Ȥĸ8b:;eu9'vXϨVQUOmQd]z qCb-v^3k@/vO{ 5`o+_q\Aq⾮!@ݟ?SB;9шMg+Ӭ򆷛SUj#G \h@S8|m[4?k䍺 D)f/2\h A+BNKQ<[ ħ,4Œ  0Ewea;wݦ.I}F=c2_hS;wtcaE^rҕ(]ul.;/΢mv!Y3!A Ql:q􉜍9N߾MT=^&!%߸C4M>,ډƛDɞ`1DkQ-C-0snKe|:PGmD`t]Ԭo?C ©UCa,\9BR5Fw̹,~0\øu-2my:;7&/**_l[˳zk3z7wB\;?z%IчEN{ޛV7#MvFԁ@m9ul@Z6!D%;5E3W8&.B)lrL`-ǯ(:=]1jo;5ֿlKAJ;&FX-ml"yCj(r.*$D’>vgMw} "$o*8 XRa7&ڊ:[)&p'QyȍH6X7HK#D{[[fx͊5K p!{{vAt˂7](Av ̺-bJ9luJ>S^/jxfGs\~ gЛ :BU$\Ϧhzt}? Ia;)Y\z {^I7""ų .F;q!9N=E%\ "t ok[K^Sa#{q"zsKopߣho"`ܵuԪu2!;HB f7}FMBBr2)m]v; Eze _tNGgvQ0z?| ;yZ'n{6 `U#7COqz`X].@v)I{6ݭDL㒐>uR#w7$J#M ka*`K<+rpQi>T/P4aaFaC^_;ԙfH?DLJcS{I+}*- f^]\.ܔrE~OS[O=z*qE/LM·y<똙25x(TUjz—[u>[b֞*|\r|!zLú+͗sWNxBlbͦ@hKR^q[4v] sOz,A;%o] 6;ۣTekPMh{A#(UL쏤'eX yFQ$f;7eS_8d~oS1׏(ITY"@)Oi*#90-pF5b5k7uxU呑GůPu4Ɠ޾3{5vKTԈv3cjZqK^Ӗi[ݭ @SD+ПEѬ'd질kxвQ?/V.!z :7AQ}KB>{g#^t49C kާaXv_w]^Fd&/A:[s)dh %DZR%4!hP=ʧSZRUx0]?H9ei7ȒH~ޒ }΀ooxupTQ1CP\i/zJhԚL&<6`M5qh5TdvWMa7<̃YGHJ{SPmӄK׺JY[nz >Hţ5B:lVuy2q3hCgqo= C.s1]Qt tR8FwWGo*Q Xv UvenX1be.HXKA@%Tpuȩ˕VH[/) Ұ5>H }A ˆ?'5L/Op[*[Cc>r G@v]4T=nPu@e UB)5,}ui :9IW8Ɓ&Zl֜k1q25=?+ /# Am?u?wJ[-ʘ7jPEy$IIJ Mm[~ ;NS'/> aID%| amZJt[QCV*nV&`."-7Y<o @C'_;Ϧ6!~y 13lՂ!&JPT m%5H_.߬W?Uqh)˼Sp(,ARlaٍ@ t32ZvO=Ӡ/&B!\K[#t{|A B ?EB}[Jĉ(H#jO1ٳ "1iϹ#(¶?RD/!ĵﲗNi*4$@[@uiMGDWS`7BN7;|+tXTlٴCzF |l~UYӷK>F',/-S+W Qqy?ؼ ΑI9G0aS5Q4K0S1wIhL_ ĶYIPԗEH[(,ȯb!ʶ5 ~0v"ߨ bRH[wzI핢Ɂdia]PӡmjឮaQQU}q2.{jk(8g<8sڊz&ޝHT\gtGʥ(T2Kv>8| Mlni}NviY {lsCψy8O 8*YYf %)mK#S[z|k#e3 oK^'F LgdܰLHߴvI lFYc;?vz[8=0Isw.K4TW AEu>?-nKe)K]ѭ7"mqlk#:[EL)lH9 {b$86I1wܑ|H~+3R7K6uM?Kb%m< H d/z !2ariUeYEÆzu0+Lme".1& so]2Q$WI>OҊ:nȵ@ =c" q=u%ڵP?G-f Or:$PoJTO6-Ķdj?`9&bo0=ߟ~+7h K@钂,ۚnnxVL鿡$]|Z4uz"b 5~BNfEyxndaÒƗ35 FYӸ xbyYS3r'B=.ëTb]ic:,<îʈ #!yeBhCK C +¹4@ DO# ;@ɂπ(d 1j6"+PhJ5Ir4+gBGyj}SckAdwU4 .X5Xڳhk~sUBꍃU[)T =Jgiq>ߏ'8榩ҡ$hqĹ9C4>?S&L8OdlwkR}kg!M% oa%shuxBOt{iYEVOE WpF$ 1E UСwa6T?wVιEF6DNLkM6@pԶ3<Fr4 5<i<5]QqDmB+x|N)6S23p2V%UF֦?7&N}1h\z"`,Zt/sIKc/:{)'pDæ;ޕ.mQ,a1}b% !\ elnRU:9-#`h$H]e̷2z7 /{ݦ's?#27.Afp@\z \8>E'NG0~ԧjJFuZm'zSr[|MU\=7z%7虩R,rˊc5f$K }A22&9ޱ t) x5VŊWv |2@An45 Gkit+7K!r3J˗};G\g>$B.[E\m<5YPiisX9uKFBz0=tFeڨX.ڪHFl X9p*Aso;k3_ѿ~roעn/"9Qzj[ұdQrj4w3rGry% S4)MITzY 1ͳmVETSL-|s0kd`^QܖH4A8|ַ*otr~^Ja002V"i0;')Zz^UeM\K,Eony PK4 DmfCyF{N.W8/%SPW$Q_⾏kU$(Ĩ `ٔ.-9tcwx.߬T2ze YDdTĻ 0rْ%"]9ݴrK"=6s)q&yÊQsWwR{nI+ګi_Y!t(]q1J9wDslևtD " R<== ^"BÆd'!+?e?j/oEx2߬ǧ 5jo乁9cc/32R2P\|7k/ ՜{bޟc:'as Ȼf;g&?^iekk/G[F?"Tha$`'7vs**sDX 3|^j!x0qy&b\~6Cs(pɢ) ՄPeK86)˟i7}Ny.pPb');Q=r$/$arPs?} oZf?!6IoY?H DOM"yꌮ<_HG0 6>5%)Ú+*N%%s.whPnkOдIac.1B}յ{KCRM[Y|&gYK:*ڍ5|Y+廥@ YEb\'BC!j\'`A~Hָ**%p73$CL6ydpj7 $2jbHq*(QŬnJͦ15 nD=t /Gq=Ae'NHR}]1bi?ve+=w%4Ve'p@I\UxK dP>]i m|W^ JʬBŶW,Q!y_8 < b7u Si΁"tk~>]PIW<;OƠa &_i(zXzJ6z٬H; \U|J#k|~&+ neR%ڥb?r~KET++AR=>:~TUb>ӯr S47K*YA%"i=An[dӺOBCo2QDQ좆d~ޝv2Ŀgm PŐtˤ 5\:en}V}[[*13N #?Kչ ^.Xѳh귵3P8Hx_5n-ּ Xl.UrˤnAGG=у=?HY"Zj){ڼ^bhyKfZrI]í*cOB9 ~@hGxב2 ܛ̝C]U}\m*QT7j$Sx|C4x{(^թGmUwߞELBNl;i?!ra?oAS-A1>Hc ǭ<1ML_=Qߵ܆>xh}:oq!7&R9Srj8@NM=RiQő!ð5BE6*Cg HjR\%'3`cEM,f<~4=L2Ի 2=;]IaS>O;7:P0 wTCv.Mp]q~^I,L݋:v3m `<*Izg[TtLT:O׈H!hTPsI]ătJ<][۫m 2h+lֈVgF%F(JM{SŘߠA#7I8{/M, W( Hmt Eqܻ.Km0L^ 2$dt%<pnj|;o-n΋KfW1r9v25 V'ܙ1NG)"G) VzpsԴ^ Tcx~amg~PG;@Z(1x;zQ {cqF E2$:|JEnLuxwʰB:jkBZC=3L6Ki{.u*8'92kw$fOﺨaʭ~OXn 'xYJss腿U+j֤+ ,5J2 %3Ts3#IbX+R#XzM3jfuSVOvFilCasD!$KBu^g㠟pيns af̔ͳ@LU)8@Y/[4Av83Uw~l8,){ 8Ir.;l ߌ/#nM9Nq٭`Dw&w}lV\K*jw }ғg(4LeupB =Vќn;XMPG- <'LxpZ1PkW#BؗAw֐]A)[nPv C]OM6r> stream xڍeT\ ww .)pwנ [}3?f>ܺ JRe5FS{c #+ @LAM^]†@InbA99[a#ā.o vYW+;_C{'>89#P;x:Y[eG -ow-hPXl2mj&  A#`ufw2e[XTA '7)/E-_rLu KTjf.@'M`cis~sr39dJ 1`=V&@v;MLmvv3K@IRÅ3hltZ .Q83_, h ;S1{[[3_[:L:c3K;S:0kY:dc&B-38YXXx rv׈3Nsiܾp Dۀ0A)Zp$g+YVA*@HDs[v2b``@HG0 (!L]G~9>#-աP '?pT! .ϯW:XSIOfnK*(,QiZV€(2\Kݹ1N)7_x7/N9.+‘%y?rN*׾"qɅqh%w9| HiVfDž?cKGfiξ`t[|@ Evh EآVtHk M$WQ|WMuY}S"x9^>w~z<@y>7ފ*IiVRmbIv Jv h"SxsyĿ.feiAݤ(hXǧgHྭ`e"h<;MR+fLWL㛮=Gi|d&(]fGN_rw8f"?]/<˝ĮCFid…ݛDk [8U]}:KG^YeY<8\gJmĀ[ӷEAL[ٰ^lG~:?"UPI+bLeXQcu!ETZ E5:+&KrGoe(4<߇6A]&Hɳj]޲ DiֻN.x_6ҔVӋ=3)9hƦuDAB Zt3>}PԈd"vS;+ޔQλؠɏV6'Z~.^8kЄrE:NUARmA%EopG}ZW~Utơ0<S1h%ůzr8˘$ Xj:䓞^~aS +qxJ ga4QR|{T*bһd8ez&`h&QfA1a_ʳde 뺌K\9j:ٜI:_P+x9N+RNQw_5V ܁b1%@4fq2 k|xva׷KW lW6½B ?S>b|iϛrI2{8be;Y K`өXͬm70ϵ,^gӶ)ӽzOLu-|XFB]$ Q-Wٔ gC6{L]PT篝nml=+cOZkfdE_To>i%ZՕ ҧNf:(j &/CnϪ y4К ײ?I ^yN;lzp1,{?+p0X5Y\FRP2ַ@^*kUeΰ\Ř KƑ={g<̳-_[745pUySru|fG-!W٩H JElpMT><%&{+#zenx+"X .T 2spHǻ2bɒ6Wuj0,Jn(è^$`6w_:Il<ѧ0:X:jBEF/ #K4[Ȍ<$_`5,=U1BMD0ઑ$uL 27PC\l o,*8nzɬw=yV{N#ٶALBM+9sqh3P}z6*Kkrډ=j. ]qn;bqdnZ;هDjM4 a?>Ν{}1IiqI,uK݆-,QIDȆ qz3Kz;Yl6o16 }xy':E\1 '= C#}GjVɤ5#q貰RN?ʕӍKUn{[9Hr#YCqʕP,h( @ śqs#hC _Fξ0*OH 09X%/_)L J!7i;g\" jי=`܀bNiFWW:QǼyn@h2b|[B4P [+Ö<:Y%Lk(%3-WFQtRff/Q'{.ZUFe"Et=ІLh7Zys_˥?Ka_yc gưEns)`w|O9$[ď)JOܠ FOۼfF^\W\{=:evxpӡ;\ P>_19G8̂IxtጎqD̅/c-gdq˓Nlt|!GfPla?$DTk}(oq 8R *i |[5>{ݡDW40lݛG;clE?:t_"– { bsb(KH>vVU-NK)!.=,{ǂWk|hHDkj#d{$)IiϺ^6(]fcylÚ?<vMJ7_ޅ1bAǀ?bYtOw s4]%R#LGkn{Cه{:pӰ|I4WkB~-۝.0׮]-'qgltsElM`gBt'nZcq'M/\@4qcy,d__=fo`XVGpe=g6c;Γ@9'/᱂&Ȥ(n3/98s 6/bb!=,t]rʱSL@EXzUvZxˮϨb7`d;$K4e%fH7-6u@1#~1)-*'m:V qh6!Wxi_:^)b;|'\Dz~[ 3=d py(߁599+c`IC{r)sJ8\wx2>Q&FQ!!".j:\iJRާkC-N@b vFl։:ī{Nyhf< f&̄PqO3{ńFڐȼCszυb-ZX ,cro05nRޥE8hCAwo1%%㦮]PZ:&NUZr>z(}dɝ 9++lU5A:1 0g :~Y EkDg}U 0yn|E<2g]qG n<hч Sm5tex E\͙&yVJ9^xgzeVC^ M0vNx[ȼW>e%rnRS($Uk^'T Iy\ț뷤b(y8q ./(haSqW;m.ΦS\YEҖč#|s݅{p:cI*xEKJs*\4RQg-{\ɐ'lZIWG2 rڊ}^bk0G2,;oj<9pxq{((/$idV2e߄{' @G G[w8 9| G+5a22#)O6Uʙw;wyLd!d"°^z\=6tna O6kJD D*q|K?>i,+K̴3vt\*G g|ߞ;9.(!Ywgӽ$H#5簛BZCi?$?廲{ e. цpS+@,BS++V$⏇tG,!eOfH[ 5Mi86-Q[ey,Bs*nL.܍~/R{SmmDࢦQl-{Cg|V} >,X>xc1d7Hq|.Q.$IJ1kBe~;Mm5dIyFS[6ع\kqa2]]#`,-T1t/U_f1ΌQqVL'jBQa%v|9q"'ϛP w Z&DZ]f!dtIô7^@{iW᫈Ha3zzqf2PGAS8}-:pBp=_lqQ=pubh -}K@]/ qLK$xY;:l?K^9d^Ȕ. \ζuha'j? 5쩣&*OK"aóe?x3䊓 !㾧»]PǖC23b1MOPtVo"o%+,`i YgO1`2 @F~]K1|[uM" Ӿ +=7= ? $p& >kWn<'CL҃$bX|ǿ>A vdڅTHزƕ1G} 'OhfQ!ӯTgWl߁W<*nk.T[[$À:P"lؤwqAu>F@"B]ySJ#;S*%3⟮bRazrmb?M8FHY}-ͬuyhCa<#k$)l̚Gwk&g5&]i{w3Mļh@"7xuidLIJLS(uc!y&@i> t.k"E6i:HJ Co@=T+%tPsrJa||.KjQeò9`'aG!,щ%; #H͚oC~Z}gDL'C?U{RC}DDs]wArI1ih΂Bv&f=p(v1._,=#+}<۴ԮKʌ%(U.>1>:bO #0zb)>4,VX`fԉbƳVy/g:C[f{ Ԗ*(r_-ѕz- HΌMi|yS$|q+3";="@m`V<i3ur!Wx7Z@JH\@99Gȁ>/`9 `_ =k#se x -R>7cS.Zv⌐Ѹ#㟋QHot k+59/R_Ϫ5 ]Y!a?'*5F) A=2ު^J&Tj-jBh`]3jK|,25W)XPT=`5SOrم3@68wm 7xjJ^>aN^ r%jnx/hSXh\nM;/1 oM ʚ^<9 ^\B2D_a}E( U9f;v -ta O[A}9NbpԞ1lxjܩAU% hz%`?;HMD0tFxRyI$YA[Mф#@hG{Eן-hl=>rj4V)ZImME X/ ]w\Lpu&le_ɴ["8yHEJxЗV}R.*N ٞjÇw 8YwbNRV)hP 7^k$'yem7B.hi4g.½KU?ŷ)_ۏyRO Y4 ֍Ug6 ǺfKF.vSU0IMȤRG#~5iN)H CpyY)Cjn;r(B$]+; *vgm"lAqU_6;ފ2dU,J4N;)-CdZ DVa=X&I/1T:_m?'vm:|Ç]{I5:!G׺&]Yiv+1wͲYL*#IE㇯×Raj(}~ -Cފ~q ;jA,=SP)+<Ԅsu UKNJKZX'"& =S;:N[l>*Ͻ|!zX}b2iy|w9c\xZܚNffTΚk5@JvRuU&AwjQ'EcHg@/]4Ģ6ax[}6Kށ;6boRІ ~*<k/EC;؁ @'} RHawfoN1o0$)^G-Kwvh`S a 6qdӉ i68kR%h74$I 'yP>1_sq\XH5v1r.2|s6mv;l C {ʦ]})jbq]b &d{[$ޡQӭ\%XcNUOmsWR|;܉mס.X'a8cUJFӦѺoܶ qvZYԮ$UP,+pZ]Q]BU``CJ3慭I8pՠOula-\?輂IfBl&VbCQt„Io+le3NUSD4̻,% l$_Tq{:2#֟(hh2&z=|VP*}{ J8ӹ{ p BG&^paP Q@[z V/~79cNrY5&_Du,K ^ܹBn/bkmuo =&B3 u PDٖ=R2hx콟>멷޶+]y2BN:0CX UdDPOoEc:%nikg&'~, ~ZJίpNT UZ?g EncJ?bw,Cu%9< zv-I@QDR'S8wh ߆w67ᣐ 7`켃?\}lM)< c%򉫼>Uzb}&daS9?y7Nhr o`CDדM!{H_DGNtD 'Ck=(1sNdp8ϙ#Br^̍Ow1~̕5UW]SAVձl˰TNv6S?EJ&jO9>DJ˞5} }j z_*M @/ҺK$G jA 50u]$gF 2}H߄ muP,_oTQJNCͰ'ܚ15C(zoTg(AU@mTz -oZ/e+r5ڼtpӲ7͑1tTݤ٭o]YNJuHhQS\bX&edND`;T0'=92Ғ}́9k7~%UÔ^>Z8rEE}K[婫[993a+ ,B|;FW>tHI:_{n3;_(^TYE)̸R1'=1vD֤ω{ńlEV{&FyzNeG'e N:aFq̅1J?GF_ mӹ^f1exv'_4_z#e IL>'g%r&ݰKt #DT{hsR~F2m[coykZulِP&P- `k\!0}Vb. WSEv\2T.[cYm\V?0vd#̲ؼhW}q RS`{,=*@XseBCdW ,;r[LHmյ5w[t( CYj`|9h/dRy\4\6)"66wBﺞ4w&.8mJ ^P:2>h"RM-&#ɋ.gʯ)i^ۿjpW"ChMgH՚3Trlqτ7E)j큯\%()j*ɛy;*rOǑ%hY8e7Z^lov. ØD"I?B5G}Ȟ363 Ug=](kNUl&qr6pG{iɜC+1Alh>8'[[OwxB;jQūzgY4 ⪍l0vq#]o@90Vv lsYNVbQ gW sL;J-~γ%@3v#.=ҙ JU)HCgVy AK($]c3c,JxV TX#LR|< NڵS Iϡrh @Z+4BͫIzE.*kjR.K(rO un&pC\ҮԻ\` mdeg9 oD3@yI3-R'Mڸ:R30,蟋cWˍSk;|';nx|t˜A0zyPl#kվ@ /={UAL6&nȽ!lFw,U5q1j-C(# fp2=Gɻ&YdC~XʩݪYB4L8QJa2+7eyZ/q؁fA7Fu8=xCԩ$PYd32M=ɧ / ʖixǵWO?F*ÂјdS 0h { )ʖŽ?5wG`:<5 9xE؁†M??=wp 99+|thYDTK.rUrWV N$z IM+j3bd_-7&4IE}GN k`&-,gg(,d${ p-mݘ~d7pg`ê&\VB&DnRŷ@R(3BH"z-|ZudtKƦ8Mo&}I )>f13p ϘaZ7w$K@i:u'-qm>:|d eMv[վV5v#jJ}3_bYۃ,d?(B(kSy) 6R詏aGdXĪ4I'}'ۨlGNOt@C:ūf̖XSvfgH` P!4(Qhܧ,Gg'$Ͱ :8s#ڈbmS}Ͻ]g׳1+J:M;sOcrVskH{4VY %X$D/H6?CZdq<.Q d:aHKkhͱלu4]oVG. ͥ/V j?u@z %njT-0Sާ,U};N7Ŕin@VSPd 21] ~Z7 $qyPz۠|;v}t["F `eUv_z:y˟NHnEjp0DDpfك|zHW59P$^\_3sMQ*9}v`UX2H_5]?F]H1󰝾 )˽tj΀O5(rFn2,&ʸ+'{Qz5[i'4% KfH.hA^b˭ endstream endobj 90 0 obj << /Length1 1392 /Length2 5960 /Length3 0 /Length 6901 /Filter /FlateDecode >> stream xڍwT6R HC7 tK 1%  ݒJI H R"ݝ7sk}ߚf{k}_{YkXxdm%8 5A$  ౰Cΐx,w;DHPT=~A_D_T@ pw @ 4xU8 cC:?6(p@ 0₪hv6P)إHW >>///^ n/ xA.q(`jx,CnCj!P!0[;詨Z_`J'W"(w0 @ah)"f vFQ`O0l:P(!lܡH/#߯46+l..~ Pw >|{>Aavhz=A< * 0(޿m$ @ x8* eFqsv({B$?<P$` euF P~}d0[8#S5R5C_N997#qqq@TXg5o`GByT&o٠[_Y)y8;`j=(ihQ75 P (H(B Ն"mڢJ A7%:'[oTmO@X}@ Q*x^nGBkb/?x4{ MOm$kZϫeixV>b/,E'F #Y9x4&ge[A9=U12Où{>m֙˦~M<,P "Ue|,1K*'|*_$7ލ7{tNNNv'F46F[ ɻM8bp%ּ7Ҿ{CBStlmzOc汔L_#09W+ ȯưSX}DI7|XYáƖ/L񒎹8,$2t=뺸{PyQ`!!-~,:p( ݾwQ,(F[} beAH -<ۮ6 OO,. D[{Wl|h0>|>d| }g\nc{viQZ]rFF i}|`*+ZHdU=.͍8э\]V{GʂN! 'QX,V\I~/B#5-w-6s ;Z486;6W}Z3yZ?{8V?:vnuVJZ-MƤ'p4 !)νNwz 6[w??]j6=QKkk8HJNoD+Gk }ZZ6XBHɹ1$[qK 9BaVu`X1K&(`+hI2|Ò!*#k&z*BZkG5#uZY%c7LG22"mPQeܮޠEiN8M:^M<QGi/̴OAsxG#?^adE#Ь>G xޯ19ݧ~5Ժ0G@ofqID@x_~['z|GYKr p3ruTOzKMX]sEkmh#H¥M|lvHa2C1@vY@LL2_A%B눂4 )덆e_ ឯHRԐejaPH@F9q1)nDzpίjzIEwCNĴ^Hsn="H7h %h5';I%?_sQ,%P"=!{;!{МT6m(F^- &U+lYBIB@þh𲍆 \5TQXE*穑l2'WDĒ\<57cqݟ•82=c)!H 7weaR/qͽxU) ls PwIRs#Yh>=lmZzQlv8eZm{(:AU/? MeIa;'3>Ʒ~mJ1V'؎ޭHSբOjT)#7Cy$2]kIڻ}na9׉f ZjO_E|<p.HQPgx冷=mYz\B%)ܛ+eså/QӘ Da1{8TIu/I(0#1p: l>O|TL*dD#l\!FwbZ(Tj ^txOӧáP&HW$mh3ģ3 >BXK =9z8`g(38mv>X.O0BOV_P zhݭo;]2FqX{kqQ Wwd7{k>NLopv/DH\߿樘nG^lV-)@p[3+tvʣܽ0ûK3Ǣ!>hzJ]hEǧ肫\D{HAx'; ۩Ө"M6B׻$gDhnxà/ت×aLznqr'ȌiIg7AX}N=[m(7a-~ΩʞxMFv+UÊ woZ, `Xo3kkX^OA4DhǒӪ`CI,_ ءUU+ ;9CQtZ)R_w( n}^r (ptnd~R(JL]6"xE.xqX"@ϪWN>ONZu„%[ OI"N7m-ʰSd1~w[ ы:/ Tf( sk}}F'm*_?r ]8e˕JtK@@B_jU]t~kwӾ|2p-.Ȯ J8@d(ui<Ůbe9/^9ǨH8<Թjnyqv~]ꡒ k{?OJ\4eBk>Dfz=> M$?=soPgeICk44P)ew+i) oe}mݘrq{̏ڂ꧿)mfƩr.ιqK_*[װ&GXY011c Va^!H}>O5B6;еتXx<Uf,]ږE8k7?x_te}4YzbGA 䩺F,7}ZRWM?7Hʨt͓UG'kX#44qLuܐ1> Vk ^OW\ 4Z|ƂB> N?p DŽQran cC硧BL@FC%XP< ]8׍͔@﹛=e;dk!w 9{ b`)$Pѽ!s^/W,&<ڡTy}u<< +iNxn+'Kol7"IwޙU,wUɟRt|ʚ?OmIzIE'#"DyɸfG-%v`S7ITSAдںlr^W7y+{QdA*Z9_'0yS/6ux9K$ҏҰ o8tGf龉Jڀ„xf}me<1%1*i8]c@)ĈmM ~ݰzI{ !CK=\_9}`]+Md R r Jv>a4@xk =KNto2{rBӭ7&_oIO9NGiMUbRZMwe"m?BT\y\}R%ILl:UjTtmqxF<.d^|lh/N`/zIG,R*S78)@GS.s'lU6ۻ=[9+|y ҉} Vy{3y=`T9,_li0Y8V! cƜ>C竄90`fJ; Le;>7be*3zJB#"er,zynU|ӈ ȮwD1^4<π69BC6^ٙ9M>bO}mrzީNve^ 3 3-_+DI=_K$] M_ :PvW͎ Y$"!c 4ho̚TQSmAG3å= P`jAA nrY];P*z8M"h"h>^hTo:Fʓf+;wZ8L N,F<^d)-havʣ1q50U.},^ʟJtz~9˳NUw6q'݄21y@6{U`vA?W`Ͱ(7F5-+ީ5n3qbVe7q'@-g#uG0Hd3B6 VšO?~Jy|X^NA9D~Cȣ IHe>kεOς̖X?<9d纎^UѢS|wEt3 4Td>{A1zc3hv?IrogXab#5-Yҿ) @%JA*wL\TM0:.?v=V :yI/d͒ &/ Aw5ghЦF'|*zHmixɂGLI^cʝU-Î)%m/̚vۦRk;@6f.,¬6&ꚩD$UV)J}htʋwLG&D~XXml0: b8 VOK^?YxG]lǕp^v.1y mҴollʹu}٦q04m&>3[[ecM$ۛ}Ev| 2˸}BȻKGD=3,u?MnxԂP9%'g'%(&؞pЍhm6 b}(W$KW9ItSFw֝%a3?+}vp2-Hq:0,7w2`79ޗx,CE\.-r%}s3kwoA-S?Wu.CG U)Ptycد>  {#n/YY^ugUtv _Zoѻ1o9>~i1JhV #ڈrrj:zlD Rq2&\3ABLa؏h'~/Eo{AM-Ķh@:bˆ}Ws8mLXx80Y:tvN/6Ԝt"^pTږ6?v,dg,C_#)"%}*&sė)OQ'.){NLn%$QۺUP[suäOM*~ͻ!R];f CPʕFhL%—I9u[mN0C~GGz۩ircK\}x|7y3& K36H B"6^-Q[>o7V FŹ|dH L鷝NsvvX%+*pM޶Oqr TY [[b endstream endobj 92 0 obj << /Length1 1385 /Length2 5960 /Length3 0 /Length 6895 /Filter /FlateDecode >> stream xڍVTn]RESBuweX:ABTBR@B%Ii)鐺k|w{7=˩o$C߇Q(HP12@ QHAIyMn4J] ֦`q:hp %XFA ٿhW9@⁀:m4 FʫvvEcezXVVFW8wE@!(@;a+B!H E1J! o8ˉyzzBDѮv7O0]=0'a@L0Gm1W85 P8 ᎂ]lqHSs~? BN7e"p@OM[ (O C< $>@M` uE8cDȟ~vYSF;9Q7ҟSA¡ض{# sE`?IܝLPwD@ 58w^P{鍽῜f,_g3`%G±?n8quwǿO`0C@1}EOvn+ aw ~~~® Bz5_153UuS㫿SRB{"ei47/ğˁɨE9`?k!G2+袱 Y ) W?_RsG"~@z`W+BKYC;WCe75@_SG"Pp}@ }ag%UQP4ĥ+ě;zI c {Zm@L`C,=Js1ß&bkؚCI?C^6U(z,5E%wDJaƟk?RrQ1O m{m Nv+m=i}? άwOrlf|HZwͭwX]k*Nw4]6-=ӔA<Iw1SH+Ӝu+;FIEpƺ[xy˸nGWIuL95 , NrfIv5_MYEV v͔a+k,2>f[Ъx BiUwu~sʏ|cl;2ḻ!'G2%#t뗗&vO0k $Kܫǟ|ypw$%HT_fVTnnքd6G*狙<7)Fր w{4  ̈Nk*s[Ui 0 i4PvzjeeZzrn>{ag#{F  Ϋ*gCTq:ZѪ*ۖ4Vu ~#•엸Yto^to^)8l@6(r`pv hm*D?2lcFamNX fsҿ@Bl BO}Ĭc~VgXq*ĬD6Bۀ s#Ũ`K`*}G}wutd)_$S& c()JgٵQ^v v5?Y{8;ɪ49@lzKq*M*8d4Mp=_DMb4rUq—7x݊tfdk׏H 'BJW]MqMX'%ȅNc|WfJhc-rK|/ 9;}$9 7|2mYREnm n1T|'E w}u>$AnQ[yG|\\a<ܒ$JNPW ocn kdd.8f$Gy.Agd bf HNh:f`J}aY/jN֩|Zv79.{Ak;X9"BȑEwڛ>2u͑ʱ8yL`ߎʟ5jsgȶhD8s:O=W!|YeҺICz6¬A9nr|MΣCc Qu-d۞#RWX8n}McHaVO+w5\T{7vimTABҭN+85ΣAt<O1z.\% ΟnnJJJ/o-k4u6L`TZV/~D BÃ2YCZ C˞!^GF^=^ (s)Ʒf$[j '? yq>7b1{^ Of;&Bp Gp St^=`1)Y<^^E>D{2f_ae=DK8GG/x's:YIPUԜjPUwɾN>b8 =;3q?kV͓b,{_w?lݯ~Z!BLCJz@(e`grOG9 ē.un 6o?lʓR¤Z#y_F@uT$7/v)$ю<]m": kF%d!t}w2رR]OJ2zhI&OjDepss'gΉۍ̦D'M{rY:K)aĒsdIx$>] ˣG \1jB+">BuJ&;nLhWR?j".NID5#$Y-))Hf٢_a^68H|>TH,* \ nՁ.) ˢ=\m w-zp,׏2oG1>IE,w }Vg zTiZ1}ZkVejauUףQƗ5'<ß=^'NX=a3•_t}Xc|II~:Swjj  a\THGPRS굱qzRRl>yɂbYR/` 9쇁E8fӔGY6(Q@*A[n,e1>vum:N"*zq)5h*c `cqzp| abYHf/(6JRge\}Gꓓ-_|1曉U0U-ӲJ ,5O 卞fhӪnV}m"f *ԭ\\r@##.w@/G;EK6~4zB-YE熱ޘa/؅dZ L'oMyQt+b^r>E5_(?nbLkլ ~瘩-H_wcO>-o \6iΤioMmiF'i_=5=wt=눨ѽtooK 4s˵-si<0a lǶfoC#)=V@ kػڶ3NzQ"wn.Hp x%865NT0I');Bp_g2Hd7gYuyhhU> IDS}_̈́㳅rof&$v;訝5-S]zq:^%an(]M\ SAVƛ;Ď|-xk*Xj ^Ѐ֦vLvn;=7B7^/l}d6h|,u>OE dM-̠vSY'}*=L<NޝGuO~}y1gajJ= b@_:ǞX~8Y$ayF_ endstream endobj 94 0 obj << /Length1 1419 /Length2 6309 /Length3 0 /Length 7278 /Filter /FlateDecode >> stream xڍvT6)%2Ftw( 6`6`#FJH7*)!JJ4H>?=}پs_XD 0$P5'ā   &1(rPvA08L颐-XKˁ@1HoG@ t-&QFbN\p  hq0 _)0W9QQ/// o ' sA f@27F9` 0pÐh\ s5u0g?€_{{‘ xc$#Cyt{Z&zBv.+"UL -#wo7? 5( _kcIG I= !7R7! /=0Ev߮? =m@pۡt)\,Ih57 j;ߣp#a(4  tθ 7&n]WiZ>1I)%4&&)  -o(B8;ٯD!hg87_8X Bq WQ{wwFϿٓMMV7W(x,-D N>u!NWuk -ޟbUȄu{d j緻"?a7S"xfFmkEhŗ`>q"!\l)@ i8Y01J-Q80}ib[zh~8Ǐmff73ӓՙ"\4G#?YV-8ND(,r >W_wxxsab³},9wi!^mHRGʹv}J\2F:i.i!y0SqH4£~}"v"Re'C}i7"E Ȫ5kuo_Kq=Kn2*~8V_HlcBt)jg IW3NGWT4u/Bƥ3o[J*JMճ*,DK[n~)|PsAF>JU0ֆԖ&A&1 y<~A؛Eil_ #Ʊ1IΝTʧQes瓤4OrEỎhv冾bpǻ!$_o-rjl,شM(\v3m I*N2v8{p K[ڮ;bcmpwwI4~KꜶ &Ώh]##Sto^I 'VSqWo$*}z:^k㧐)=顿i(| ]k 9J$6'.hA A6OJgeDY/6=a~ n'ri]BÛťJ_]Qv n7gڔw6p'YZav{Awj(z@"OH V@~m|[ U 樿 ȈTj.͕ :ԫZ L! ?|P#hs|uuKn3v)C.@jJ)x[^IY(= a< ~ NadoT'x2ŸI(t"Pۗj\q# |{Ʉ%+$ov&ѹ_(RY>s~|<{@<פ`q">XwNǦ)2PT']3/ጚJ']ˣr+,A;;ViI2N*,BwJc=܆QH7R:ǐ>YӍ*9_d$s~}1Baz}YGi+Cfwձf.J,oM8J8ː'}J%BEZkgj|m 7. wyYCgs0찻ujDXJ)0+㛖u>ZiW_5J^ZODEAge[ڸGA]:lzFx$UqRP+f(:G樂EiUֺgOI{6yFݰou+71ļ&O{I 9Ew6A^.ˁ!"41L9C;?6u6QsyQXdweN,j(l}nb+m*2 K\M Vr""S| lpMt#V ģ9[}Tcᵾ!B"fjcLr=6 +yf~.OOnw29*}Ԯ#?0<;dYsg6U 5_ K^`~Z?rrTì>qJw'2$U{1sA9"m_) <syEѧH {W+e3!GS;mU 3 z-{au*ROWxλ7f歺ƔkAv 8iW-( >yqҗ59h>`- z]Sl^P~Sd[6FA u8wSQ$ӊGjBVLNYX5Z#iҡnxbfMA?.VQ=<=YU ,궳"]DjT^%v=c9>H1[Bq8PNGlirYZXZw&Zth3d=)$߸:!t^t 5ݬ?z-@_'tuF9xjkm]516W]3vxSx8¼4Q;gUj"7MaK{I-Ⅲ2{$ce㳘-6˫Oe$F8[[ӍB̐5UrC(u:a!dcthBzxB*{0[] R{v:wQxx :6"mK[[uޗ" \}sz|̥sDP}vNqS^AC8CZ&O*QȉdFfw dɁ[QZjutFIc@iǍ{znl(:z}0;_)dK{*`J+lP59MF,DRa"5g5%CϬ$#8&P4z.n-;z6yqdt7 S#6S" "K42 L/57 z2˜%㪑ꖯˌdmϴ}`nM;O1J'Q ;[\(_f U kE\)x@4GsVC{Ȝu<5dILhw5xJ|u!6篽jDёT3@EazͲIͣʞCowϐYr}<l&@*eކO |>V8h. @멺y;*$'JYBKXۗLLQJ"Tބ*Ee?(n0If]93wM68''U.yES^Ò5wHm;vmΔM|w7V͔^o-><ɲ,[8>Ski+] 7.]B' z*|/byo326 Kk}}&k0ǎ+/L&THRzirN3R;~@ }B1#qإm+n+Ǿk(f=<|ұZWL/晊`KPulKe#8,OV=-Oһ]22`K=g#)6]^v4߽OzϨt /e@5B*{=uܟbj|ZO)9PE kTyCB%g'pli-P\xϰikK=;|9}ѸH?&09x?i/+L6r%myD0e8 |v!OC>g?,lwU f`!6K>%vlq  =o=Ž"h%k;I^R* [X[3Zm@+iN i4:L\JG4xb}s MBHU1.~A` %|x$^nn])KnuIgxC4‹Mr$dZ(A @LBce|QV'Hd(*g4 ۬-b;!OOyDatI0UJkvіm9S !~mMq'ẃVX[9g,Of>D( M`8^ dV:dU2\swO1F ;zN}i_Uo2Wށ[5q42C9ӖVX:B^:_į&(Jd!?ⅧSY q[2d}s_7y. `mף|vqMNr5^^(t9sh)ipr[o<^~($br-amULg}VGƜ!8#f _%fБi4~urU#\ɏ?2~jܶƼzeidh۴rRIݖ cULu~)U}?$ jM5l UYG|{uNG5e#Ѽ]GH&WSۚ> q+dPG9yL1`EW7H{)^+K,9*9vLQAιϰ>qFY1Y#G5][;{n/)r@zs[dk;,_e>I`%KdnW6? +;mUbN>ʯIw|dwB,1f)Bƻ 9ㅨ:Ƈ44etzNVb_AʺJI> stream xڍuT6-NPFHK0@6ƈ (t HI -!(Ht{}y߳su*cAE@`y, 3cP P"xM'`@]PLZ^LF rb@ ' 4u1hqxB0t+A@(JM10xaH%a 4AXO 064sDM1x/($\P0G@X 9TGh@  k6@1 ; a\ݠh t@ Axo0 0|''9xK% Eq D_eSD14u? #Gf/_ Mr@hB0!xXNZZRp"aʛ!~;~ 0n@DA᠞ ߎbb@8 #(43ϙ|,'ɖ@/8OiYܶ?>557OD Jed. r*0@?_K2w!p6`)0%-)7_薇o7oᆺ\| PO Z"HGyW%C$P\DLcGnp#HFap_oB_>`΄ .ATa'.% bP@2q 2#( Bc cZP#`F [pm¡H$alj b >?ፀ100a^"S|h%x!Ck]Z_dQ?့MkVlS3Wӻj>"V,"t"tũ⊏ž5wm mE++naL5Wbuh10@ ed&Y"_PښԵq3N}}Rov~崮M:Oc4\HwߡKawEEaӊTBX}^1D^lS+hWȺ}@a~~x5,W=;VWpi` ycx(IȻ7v>e>XaVzg+D6. O3$hA<6sC$rYTg$nIIZ?\ce!!v7Va51ΐ>~p *\ҾqzUOM `njMld6քi-Z@{s[I ^{ GRѾQF4,_he#@!jM cQSd'_Zib迸 r#+h\ziyR#Bb>5/+Ye[{chޱPi+sVuH#OF73 ~f\ a:0 r^sґǸ=Ma Rpٳa5 _UvhJF%P7-?ӟgzT^=:r]Hnfף;o~zt~^0(2}M,D9d=4 AWh]Qx! _c`:SPY?ok<+}5Z79IJXE`;RN~_Ƣol3U-2d@C\zd!ŧZ>;|#2Sc@ʵGԐn`^r.Tڙewtca."d?|&o˗]/Ж!׺ay ϥxHsx1Q~q09\ekw<{[Qk4;:&7َV#\ᴼa3M\ OupTfo:)FB/Ym{|mopt'w7]h ۿhK4s7, %6@ћ:MU|m2Q }\TO[fFQSI2=idE']\1EVf)%P쪃5uqƭd2Dv3߾15'96/Ogh/#qj)LڹfK~~ZG_ BDWՇfʭˍUerWzAv]4;e97lVE NǻAŦ"/ 0Ye[WqfR]"~NH֓#O7P[d­(^"̝-!Fl88z{fdG"]3#6%mY¾BཟYe4hW3pȲlִ?Dz0zk4V/3J̔c |W[$\&6U*v ќϏA+q. DץM3Ȳf7"}\0ϓ5ML7 D 5~ &"<3'^RV(L<#-Ԏј=yOR5w#HeuHHk1(I먑6S[z(8!ګY”')MFszv ѻ7\`u!i mt;_?.y0O)\=b5bk3 MK9 y28m̐Zu?O$rҙCT;`|̅) S',ъ0 7K2гeByZ]0Sgep|+?cmz>JT"tr5uk$za@ -Ϫ7+ϕ/+uz i~8__o`"RX'\\N7ZU5aS9^2(%ՠle?Ofh Q1|M}JIEKFW4@%MɟV?H)8ƭP8Qr=LnpK)2f儒>At QqE_ĮXo:Xo][' !MǤ]σL@?Tjc޲7k9Os&d%-޴o"qmOÈSjI@NV`Lf̜*b|wP1-wSL9 ]T C9ZA\sh ޙkkgGU~u`*8ATƗf l;HŨh׶dOc]2ϒ=hXh5jE\ {~k[U9e"[EyM~<\.{^_zYxot 3|ꄷN4Zph7YҕQM$ 5Bzj$hEԑ~, ҇3I𭻏?rKx`$g?p;>yA!g]-[+2{="to= /pl>%ֺm)܊>cV߯l~sCL"Ϊ2F5QcfXҔ{_΁g^(۱-ѝ"in 8A>\svPʑ,I2tH,z9.l7f6m hX[P!ׂw ij_. 4H@Y\P#vg|Ȏo@|9h^AKDGAB.Y&= lPJ/ѽf/~hqPU"SurxzN:eo4pqpS0 ;w뷋7l[XS.&8_A/xm\Gì12#Lns,7AϜ {\Hhwx߫_.HmΨpΈF7c1C֏ƨ0Y@Dfmyv?j΋Ȋ6Qۣ> cZ@ &9 }!P蓗-M%g5E`Ҟ5U[kqx%ՁJƞrT?ѴYlOlxA#,LYi W^7bzu-ÆwoV/K_{w ޝnυO!}ṘkJxu?9y$|eܪ,=ַ%!MvZ) ؗSJ1MޅРa0v!oT;ࣰ['6,% 6"(ߑJ2-:o! >Ca|ξJ*w4# 0ogկ.m_޾)m~4@;$;[̩6qKv92N }|%TN4{. OظIVhB憌Mo5Ђ&m 4XqZL>qaG >5k؈ ߋ1 Weu!Q!}|_˶jY 6rO-!Pmmҕ"jMly,8L +dϋJ+M0= ZSE-%r sv=#q?%6ncxow R2d[}sއ E 23b} ^[=J9 }SQfŠL\VoRe W&n\u闛F83֋vM \'㮟2l0xC! rTl&d2 3w3>dc4"K`b꟧4zoSw|CA*GOo{c \վO֛VغT~% 6KۡbO??Gݐzܦ&Dmmg vWT 3*5AJ]Ow 37 endstream endobj 98 0 obj << /Length1 1635 /Length2 10311 /Length3 0 /Length 11366 /Filter /FlateDecode >> stream xڍP- )%8wZ$P\Kŋww(KkqǑ{gޛ${}3ft49B`l\iUE.N'';''7=f^ ;B! žm2@s#bp s sr99, -%GF/ =d `3 r[!U hv`UIspssc:@řYn` @ 9,P@ScG؀9`n@g`A).K3;@[QW+psCLZX8:8!`5 l˩a @=9 ͟: ' >3Cp1B,@ɀAA ^BV`4,]8t!. EcMhY`>NNNAnA=naG'ПN?|V4@>`+ ]@>^t7BX-`s5f_wpYa{yꊒ,SSJ`pqq>]'/Z5w+G_$O_D\Vc jz##N>N/!3OTw$bo鯀;Y.Pu|hU%0HBu ,50 xa4?ޝ,N=}?]ﾲ G?Ftvz=+gGs 폋pHa 8ZFB>{py]@!ೲ9 ϕ7 p|np) -\?|i ;mvB$ȶ:R܍ms4,fONdV >wSɲwr0lm :<} r{ҚQ_ĬO6'vE˯lPc FE ` JKUIhS=۽I[+f&a:)'S6E%Kr)%9tX[V$]qǩFuBʋޤ+iWP%3LD^~Mc,*)CEAT͞R50kMH:_}55n: fj\ b;mo0mV@Ǝ8{OK?v8,/"Lhah˱WuHmy8uף?i*3 B|}VX@m];m^}EʐPtpE@l(8C:PSP(B}oSj}~S0nհULzX( 7 ^a5C]GJ=5t5jh)Tz1p;/NKJy]r F|]|s[^$ ]ovWюX^N׌)F~Y4T9xsbZ붝c/DzyɐqH9 Fw' \^Fk >BQm uE{T?|QT=uV.l${(WSM&UlaD>8qumVIklj!;V84}l"9Be6WXBA0Db8N. 2 TaZVy"hX&㵮fߕP AHӿ|-6]N36GGN~gT+g?-9JZ|5 _3(-3\QD͵үl'#pS] }EBW(*a7{صY1KԬoc$ь6>E f&В'茍Ed0U_YO|zɞQ1:M},_Taa3q6rO襻Ao,j\^_PuXT!3akrMm Lm%Mm45,@:\,tMIs|p&Tҷz~~>h mgZ 8`Th3ヶAWҐ3=zbXĂãQkP$m3&ۙuG&tfXvQ{O&jz'{A LTtob^[:ov!3b[,-(@eH`弯(P)'[e}iYјRd|ԒYE?<0cnxVb9I1 @E.m-2ƻfhc6*ܷ;.pC/IgUCu`4Vn{.uJٗ](&Ml.0Ie'p7WɳQ!KyǏoPw*l3;˷R'4y&m-wju֞ˎc_ބ gfhm˞kמ͌z*d{lzHVHms08j +qk=gHO_N'kX1=PHߒ՝ccDĖC-1]NbA d 1qpY,50T<\ gCt4pgV~YTZ拂E(TGu_jISa@&d>iZSjV ӬFMЛY-(@XqOxr@x.yQoͪTٽK~zi[kW=%ϰg+2ձ.Pٟwy@<82q_$R]pw>6s+PFksadϹA3a][긤WI-zwWcчvL "{[0PV{E+ff-FFRnȌW-+wJ JUt%t#Fŗ *TECswT(LeU0Fxߖ&iA*hG~}hPхmQTQr"˜ĭa, U5qfo#}?"1ћ4#p>$SO½ KϦHKP}+w- T0r4<,$Ҕ2]Ø:#(##6Qj+L徾9=x)02 L)¼^ ^Ma pc2sƥ5"d+G-ѿ{t"X5]iRFzfល(*{6fnXݬVCn ܃y2/~(^pp.nrJB;J3vm9xdbkA6Cs7"Pwހoа]%Mv(o51M\(Գ<ԉг(k]wM;ǙwAbO\Q8 2B>Crf/8,6 Z aN`maOmOspfjn#잏d?P]USXcec-mӊJ›bnA>r "/b#"FU -39)N_)r_* 4CBA`O;rD0Em,5y.K w?XJǶ?&ee_Y?椆?<QW[b3ZuKqkM)gN.2YEi~ar= e+:!?&Depr*\^w#ʄnހ _}2QyMc[KL.\X]S,yGiNX?cjG}[(u}e<gWnMqLR#<}vXUf}gU+^Ѹr''?|Xv^ZnTqw \%mv<%s*giǐtL\nDXoѳٻ/#xW6j5:YX#IBvQת} ֕:aYK]'B~'$f`9`^qĉL75l(n]Pt ?8Una6gxfrCOz xY:w7%!~N:S OyY:ѬotEJ&H3+=*X!M^|hk!|ܸQ04#NF\S7I`u{mD^mmET-D\m hS!bۡ޷uyiCDnI0ꨊ*o"-i(9+ lq+sԭn+a/SF%MDLThauɉ-1QN ƒfF&Mʧ4/ɲ t%ۣ,Eߘ.f.yT}Ja3Un`ΝnU|ՆL;X2(iEc8\czVq~x4S|YdAn%]{.f5O8P7+5*}&/& &Q+<%_.E=-7uB5]kE iIl-#{ 61 4<8ߕGÖ;li.GvLT۵B;?Iߍ_r %xUq;Y+٦F|4X1 "n: -[#V$2%0ZvaډuaAE/[Ho ivvx|͌eбNއǓ{l.&*EVvI$d0k:gk`OxBRE :aODËRçd{ GNo ~]SD#A^wԺt@e 7-.07@@h/~upxs\5JDD CA7chȿz,5oC|C;GI:NCsHz]g\|F6i %P~4g(~R饁-^|zm3=F觬^p[E`&Taռ}_ߝmƢHTӗ;ַ"u;lpTnWY=_oz`8v\e^$?CT3C7A 4JXiTO5Dw!1Gv -WIHa%h6RG5&MsKT+ƪ:b,+_^͒{H3- i3S kٲIgR(v-Puq\o.w>7HRJ8S;~ Ltɋ ,u̶lOaPffKeQRdVi7SL5/x5=Gg ފVA^Y6Ya| ނƯ*3Y[&h^N4$YW,6!.YeRVfk(#L<(EGc}*V"!_a%G\p2R-D^ڪa\9Q>!Fouh#މ?fb[a 1{5X.]~`Gu,(Ex(Q/S4+ޮ3-jryQ(@<(bܘe [2FV)"1ŸDJ$r)˼K6E ~wR:}2fgT[?=BS- &bUlT7Vu.W3=U*1*+! X4B_Lgᘘ\\!z#eDigZGuܟDPq.ֹNLŜ%3 tsVnY>BA\K|ª*PaG,}Fpie &U[(yƐUlrUFf荭<`*23VB/+(J|46ś3Xu?Ex8/*F"|^:vpdz`b #v~lg H}Lfi;iee16i]E<8 RD(ú%gM/  Q>Ǭ@ZcPFf$ch?2fm ~ k~Ѿ.7|56MՆ&B{֨O݃ yHE[Z|AQ~n|CrrYpAc^BUcC&aD%vE6c$R Ӣ?2*E[ukv@i/Y%!<չͷv妛3͑\<߭X1SwH[6_tìtSX&au A)]R;]QJ"SLc]{&H.%Cg tk%@mǸ6G>@Ps8\fT#G+"'ڌT4$V U,-դw2\SzLl[7#fK˖-)J%i;b'X~kYP66Zw@Ě0AkԼOQLOO je /$^GR8[*3s;W 2~c* v7 -깿nAx$XYZLX@k *%HݜCh8a^;mtOĎS;C50c!-Ňu a[BwҜ OAfojG3KQTB#_|xD)nZ{41(d7ä!'H@OP@{9΍+͕nڏxEt֏rcc7\Fš8m۹poR<ܥq&MB^61Ytč Rbf 섦pH}h])(*yyK 3W|< SƋJ7zB'3UFL:0Bo$i*uAG+-,BiU1|gKr=CSvB̸glue23' Vf/O1^[ bpX LmxxqM/췌 #-ul(e]HPb<Ŵ4fFARspFV?c)^tyon!ctk:y6ʺ+ȅG./-0 ,VJF:9o*8k}|-VVLT[FVAԙ]mK~]sףmjFjHE)UUVKKp dkLߕl:n…tay(ip='eçX0yΒ7'pfI9Ȝsc׈Gjn ?*I5u.죿1 **uN&]sXHW[[6;WNFd92!4l=wk䚟 %]|^%akJDž}䩶$݃F7B-ʾeCf* F&{t:BA5X'7u V&KK,EL_^a_|&ROL<i|-xƫi4r眐i'm]qXn#[a%V&,@O@2;1R§N Vb^EU/W=t>>$E{Ô{ yzFzۜ|JqYmŬw;t/Tq\9@O=r<73u~)+?!ʽod|$jV5jKRdR>|)ڴ*R7}2R #_,!GÉ%WPP4,طK$nAPe* LL9TGQm36OA]6SF!O\[qF3ȴ $;WjL/XSfɕMw-!+ƕ!#]91yJ.6Ynf!|]h_A*zvVdD,T67ppw٩si'Tͭ -J~]HGS"T̓>}u`ڝʍQ 5G*RiFyqUYTt |-29@4`' Z/;B g:d/4uI(Db|G )1<U,޹eƈ5d(Akyӿ$C,_-ne{;>Zzx~=wrYtiۼ/4"*ýu|{cm*PR{nNVQ6Cg&akR=kӪO!. _i'] MӺt.~PkC:5\6}ìFƔ^O'-ﱑwJ<.U'Dgh~,7IgQ"ŽU&^(ݘ*EDzo i4JCr[~t>8h,0eIPVKťJ3!tBYږHM^7Vd޴eb,gt/>_}&!ws!9tg)p׏ j#B'E6ĐuE3vZ۳MkSoA9? R`MT#mǁ8`Q@PW_ 6> stream xڌPb;; Ӹ6.=Cpw@p̜9{'kw5Gy%:Ck}==#@HFYB GFljo dgjmg&ֳ3H:XXL\L\fFFZzzLdjlbv( L, S=+ D= )((yLm,AƼT'S{"rJ g '5z82JFNz M`aj{sq2o$r6@KǀOqLLz֖6zV.V#S @NTٞgeߡDzoގy+%MA@0\s+k'+"#S+C0taP2uJc&-3?0 _(V2%~`N9=T/cbƦVp@Lo`oZofhme3H(ʪ)(JAAkg+`dx/˿7z5?)i83, O~f edc4x`X_F$`a??z=KS ,ަm3d2@CS{+c ij'j 4770{bۆ7v S+_ VN{k*F"Vֆ3;@sc|/f66ێm -;5#o qDE,o3Fo~O߈(F-/"ηELoJ=;ӷ:Z[El/b{X[Vֿ$`Vn¿5Ko6Ŀ]4򖠑@8f|4y wo 4q1Za&3Ej|+#fK⯁ov0>mPпwto~]#+?R:cޟ?LZn[m,fMV>[k{bzQc f` (1ۛ۵oYٙA@߮>{޿nd/VVѼAVWogt-[pUU 9!UMs[9< SU~ ulP/=75*ΩW̹xy4p~Wa] x.\%O,Y~bh{:Xj gٛ_3hD4p',ynsv88 oF$懭HE>G>KSZ )6JRփ>mWI׆#''Q^ CHYE MaMp[+ A2{:sRHz&NlfKD`r㓑QsS9ȆoYl{JsgITer4{T#ԣ~ED>ZAf)Rrm,GfPT a9T LmNq!*1MY =ƆDUq6um܃젾Xp,<<͑qp nփ_a; Ll̍e5Ȱ*DjE(6v"G})]Ԫ$L՘XpvQ%֌9K%Gm&o h^һ7yZ'[ >wivlS/O=YAF1 wgsk1TOL( @ UJBZY^!W]]p#lȹx]=/!HM[Kb RXyG X 1 T3SWPBmf9JP53;D Tah.<;zy֓ܪi?9=4=6:9Q?mzΰ?O7 7번*]e꼿8].e0 sijV/33.cSD-AT*eI`\Iêۨ&8{ ~ĩol&բڊ| tWX0i n;Y2Y:KVr.M1R}kH*Nh(4v2&H­(rzɩEiO JIrd oybsσV[pz&9]ʯ+L#?x">, \mJ4[f7jZ M֗îcR >h+#e;‘VVnwFk** AiW=s\ n  PTsPRB#ЁbFMi! QKDS.[7tyQu j)f(-(f)x3QD6eidBXĘٿfn]icSx/xbۚ$U˼z+.t]-W+-+Jᬂ4w0j3<V& ;ĥjQ˴?۩%V  &b[wDAY9RJb>m,*'KmOBBu$P%LM{JetL2=S#%?w E/tb:&ř,G%4FK{Q`eF?jK  [yo󽬬խF;[1†y8.YCHzSO޶v HY5 e¹6.!n* P{zq1S\iA,~lSճOL ~c~HtnBUmI},yq.BO@.MQly+G2=1}((*z{ |/ԌYgU*X#78{95Y/@?l^>ǫ& KFVc:G|uehH;h  3)y伕fISaPHL_I1 ٚ=vT -š{ y+$A=ﳤt8pzÔQ4@`Y5"O&3竮.~YA(Ju|]Bf@ uC~Y_G,A !.sB։s/5xwo ZmtN%njQ 8?Kvo,XkΩ,z$YGi nf$l+k32P\kZt _D,T(wC+٨Z Bva8ἤ"%8&2)Ǵ)u0] gJH2؊ay~hoeb#0b(>mZyb{1V!Q`/;% 'QLA=#_ .QdxB!]ۘII1<}Ty֙vM8IY5"]Zle&իϗu"#J#cLkTX~$?%Ǹ[嵰چ.;^% iRc}~m fN>侲,6zYΪڀ9x™Hm##&jS. = aYmRP5%8^7J|>A4{=gwquȍ{Թ֠UFGD89Fĉ\jEAdR:R2|w aW,@*fw!XgZwhZfⱆ\p][%iad6׼X^ڇδKn1cZ-vR{Xx9I-O. DoFѻ>?{P${CT!pYWG_611 9`ְ gIB嫇X`LO XVnOUt>ȭwO'q95~ (/ocuuX} #+&;lb | : $;z J~-3/yw.g֑؆[GS ĝ+JU|kXRHړNghCIi&,>tA>tTQ.$&#əLPm[#*5*0dl$AIxyrvšKaD \R ΥnHlt]iYsQLT)%$6p0R}3ID0<໱QǺr1)ݨ2*Ï .ff!TcKy=}SB\ZӓAǹ7l/Nw`è8jNcb )4|7x+YVD2;iiꝲ-RV!}ԫ&^]Y (!-ݯlG.GƻO ^+#a݇]sϺ:>{ +$AA/AWy`)g+%gL@ag̾\1e3S #ޝo̊.)tV)JTkHMo!{n6TWqKNegHu/K P9-[|CfŗTp)34hS"vr8!yK;P5O{2+IK=evwomg!,v׆zH,]c)QaRʺjSȎA>SrН3S=fz87zg k)kC`jg7#g^߅ThPs4~z] UtS*̂pfA!+YZf_e7fSzӀHw> ]wor p85!Rva8n TNG0j,ah,ʩl1<̏8>ɸyjr (\Dmх$Ioh_Get]<ĎӰ bVޭLHyؔIp-|~pn!N_oQJF;Zbs<G-P(9M#RXc1#'oA-1!a2xD=ꐠrCܬ".b{ E3z[A!&r?x[80 ,ҿMj+BQ|IM9~ 3TfWH:[y 41(.u\I|s0£6G|&J65TT :830 C44I3dH*Dqzu *8Ma抨aDŽCȤ]`Y]CffS B`Zz 9DFZV009_NJVl^B=D51A!-s[:p/#o-*g5o݈4gLp5nKzQBP0o-1k/̲鼲`hκFΉY ~8܊B ON2d04"\ap!3E^zX5U"b} S[^^\ aT0(e^qc>f+3}kfJûL -I.b|_#f8٘:.!(n9aGb/>Az130dFZB{HY9{}c]9ACTHj$鈾ch~``m'vqku:~ 2ap*(zCq}}pd|j‡Yی7^D1 BC!rGJ>k"};wo<8c-uRc7JG1 6 $k)`qط0Z#s8MQeo)wiѪ͈Tk\dSriaP[4}N{1c;k%>$F~DI:p=CMifKX8_/>hBڣ6N9pOq&T!(}:AsKFKW/d5Ǵk Ѥڧ<qPS[J*"nKsRn 3z,>"L\-3˗ 25 cE>TK3F/&pSu- *jU;ٮy+S;QƭS$c bԪ=ϒ*q{n=O Y)Fqd/ɽwN݋'=#5  a=#J1ˑÑ{ jF#mРyќOT08Ɍ -XġAh"˺q=| % Ydu94APdg)㹠8~hziG^ANzXZSڪ`$ڊ^S,+\WQ`DRպ؂E_8rܲ4 J5}Nhd%Kr9zZO"sLS^)=8 6!>,_jy酻^gKfeSA6wb344۫F=JZf{$ s|?I%QGAF>05]6wI ضhGVcvf:0Y!ht _rk+MכfnS``?^q@Nn^ ؗ<^qRdc,Kp'nHE~3|K@ʫ;l~jNPI5e1$Fp^qy<;˪y7ؽ!Bd|B\t:q,ụ')Xq<9'\: zL٤{lkHydm.!+_ 2d9Jw2L+TcMwFسt3!b~ĴijNЊ#z9lDdӷcIG?;{A~, ՟5YRN"]fNvjSl19vR !^.*nq OuxZс Z'k6{YwԪlX=%).phyfMԤWLV%Y9 VЧ6YnGhBGx/9+VfVI-o'u0qg6Տij5_f[J8A7tMi>f E;eӾ^K ϩ4 "uwk Qj휊2Z_#Tؠ !P~ }H6f6f[9aD?%5 <>B}7M̤-O秜l8Y%$t ZT &&cP8L;mHn7J1؆͔'[x+:)fSBe앛|w!E/ZFI 7!e-^'8[t`3:׌3'\jKZl?2Ⱦf#gCiHMa4η7T$.UR &??J9^S.jSAXJ5@&}A[iZc_sDb:XvBsq naL}o{~~NpO+X0`jm%⢞,i}3/?J|VSm%[4Ҹ+(KδaIgJ#l'Z,ҕnB]A-$޾TFk"p{v!$sb,(3v藂j>V|F-RBUNߨ;&9yzUvW-UQJTi}Naݵi 0{mUmȩUDGpjU}}!E0\˾ gĉ4(m~XAӣ0X}ny}EoIF9ygu͂:|JcCAkr83!oJ0o b;x$F9I#8<NOۀ'I!q#Q8YE>WW߫8{lc/ ._Y'2}.it4&  1UY, bSR6BDʟdl`93w&@˥!rS=VqtY݆ͮ\U*':4TG+('jljIeINꀵS1xJ:w&m="8`,ܿ@ ]%DZ*eʁ? m}cݯT1P;ro'-*n!oF/J^G9JͥϟI$JB|EJ2"6 h2Xܥ?樭(/HTjU]a0zR^ǙRf9Cq!u/$ xP΅3cF/s\(XMҶD3 &}j1Զ] ukf˧w/gsFFDŹdlQG?LN?xDYZX;D_$I͘^\uDw9h@ ^KN(h:/Lc<,6P)=B7-f=t)4km/TѶ7$Kxv9K"¿>U]f1$9|"[j7S蛍ey(^AJ\sNɫ*6]a~Ò9]tB҆/o`T^ DJTޑV|^ tG}@u9eHv3yS^ J͂ѧb9{IU%=ij w)7?2wH"5q ؗ({"k)(ێ Vq1\U 8V[/ oOȴN窽 *uHRCa}ҧh!Dfm!Y v{Л-,0>#&<rsk*&VsX楏;ns90C%{L4i唐^yレ8.V(g$u3G-M6Ed>G)x%w^n LUdMџrԢhP+w yжҬ'@k,g1=t_wӶ YTf`zV!Fj F1/n5`i`m..ʸ!/phÉ0UA.X} =/u vСO8*ZK Djԟ>dm4BQ!p@{<4P$c{)Yŭ7I#7UkJQ+њr;it4a09N -p?C4x[P}Wv=1vQ":_%1p6|?kԽl$=?B7حsRcLeC3b~, ԖA#RIWV,gc> 2" pEH,NyP07 JƵhjb)2,s1.ںsQD/k|7㞺$LS3>)&x}.7NTW0بlQTӔ.RYhhFvr%R+ɫSMLFL!BZ?!Pe( , Y|^θ`{׊/BFǠ(vUa2?*s NI~؇ˤYB{ݵ{ڈ*x (`aA´2$nf®(sɓ"}ѐiËHQ;DrXqӔEׅf3v7J0Z+KRRctrP*6t.bզ^4"άZWWlA7 *֞[W<n5%Ra̗iBPpdjx O[:+)N "CIϝt{>0?з=+0@{ (gV1P Ockor㧢%uFkA?ج5f1cN2%OsО S*C@.w;pȺ?QOi*].'i`37W"˸ws+dXzRW80Im|%L[8đ\q );aB2u!¬KĥT ԳK&[d9Ύi@ov|%e3J56HgOy,{i?KBpB!H(0/_܈4PG(6Tkzƽf@X4DtS.|m{ūUmrpA*(B"z`3F!(!8a0u5?VG4eFs-3 oWK:)[+Z`.2TSk;I 8NǿV` ы] sbqVexFٲ{I3y% sMp ([+nH>h1/xb&h,cuNv'jԮGV@,W41cQd Su[EM` o01 &h[W,aR[-[ K&'<`/2;)~/II? >ݍjJ9 k тQA!MzmpVĹ@+'/ LsW_~jA5ЯF[&XpUV;ٌdkL:ƩpΪn `'|8P޾H77 }l*bՕmOC[*z 6q 8Dti>g@ ؼ90<8ץRI 9VKsnH+iC!;RnVI~i6&>zNC@%p3tip*uu4.!&j "݇EkZ TϏ-{{fvX) Bd dTFٹMq,{EԤrc ֖4ƹr5ˀU8I^h5_e(r '̼N"N?cIb_ޏGE}*HJL&@nTѓZg`yTX㠹2*.F#˵TeI8U@}~;)`tA-iOiv_/}zU_Hq>65zbs^v \Դ[UDŽ ,wt0,Qz)46L*w#=OP2NǾ*<+V Uu<Rho4tF/%%yO2s|ZIZ9naWC %0þp.{O$3216*Oi%LYߋѷb/BxԫAhmr>۝,9"~ߺxM_鑷F@1&0gQc9P9SeȀ t!BER8~4uk .e$A}Y7XYUDIa}%=9zpF!RTM#|J>" $*5~IB#OVxX ^8ӕdUI= ݟwU&X2T v׽y 0dϚ3l$7myuG3+ !nsFऽF%oK܉Ja{r*yHb h7 U-\D=].j.ltk$`D}6<'w!-(J2YI_|&=Yo%{Jz;ZBs6Z&:":ЯO8<γT ?bK C$<>6+JT7f;?tpȌQ Xԓ_nXɵ&Հ=ZUp{zU(6v^&*yjOlHJkarCmcjL+ٜٔ|eÁG:kA}289``ZJ j!1jBy1h_+6%y^wԜh'79膥c ɮXqh9]p} sb1א6YOYk 8A?FgͳhlLWosGT %*'^T]べQM촎RlhpΚE -g%F/1%wrqD;p y ͮ~zW[\({ɢ_3["[Y\aj!&*4ZIrcZ;lZ919u)iݼ Y 1f"AXm4ƭ>{XM,UќAϴ^4c+6k,Eul#>cгIpP nFWk9+o~z/:n^3`Ҳz6_ew-EN,,%iQP`)VH0&L'5Mv Q[>2iox'm_JɢIl\nZ c2GyrťDqc+EZFd [(Qd #!hEee 6lG(BEf:!UBzFl|3^r\s"TɘKg5RFdv˲5t J`tjPoBxJEZ -KmY8+B}UD<9TmIrkdEw@D,-){D`6t!*8ML"BVZ;6pWw;;\>z4Ο.>7:ۿ;DԭvS)qSM7:$eKvtՁ"AOwQdcْ,B^`+jVuKʴ&ɈES|/./0뉕qI3NN֑g%h񓰊 5ۭaw+8\Ux `כحcUZQXvloC匟0Sggy׳ %zdf] rvvWfkl9\JɫP"ٚɣNQB4i'kZ*γ q#5Tߌ/+ԑO9 K ;0P?PHYG?k9 ;=7i)\8N,w+FR%P}(T9=2p \tC騟GY%J!5OgG2uاg׆|=jr-}|wM #GPH Ѽ|9: .;_"#H dO,箳z_~T=A8R #Pڏu.Իjꂒ$}k*F}eT3OFp+sr>1yZi,axZ$~m fmuFg̭0PҘvbfM(NJ.c_G٧i5pQ+Z&C@@8aOoG kL"u|F_~gŮLoX#B%*O޵f3jDvwŠG^nN^d*ޭI̳Ntl\ޣ̏}J~5xGLb2DKE.q:{nUA)jx/D9Z`6(GP%@*kBMuƥP.j.2OX aJ|g/hBMU6ݷ~jAd &Lz$dykQV@&{`'BN%7z lhHfE>b_,bSz ܩ9Z >>YElwY6s` bŴ*CĉEzfNz7"(%/*LqUݚ71!2"\=e59{px$x}Iw𣞛Rzgv? Ktzi U5JwZ~y^`n^0|2=/O͚eQ`M*1# ^sr笣??ugz`Qan a<fÿ@#juv%MU=R2GWւDΙ/@=]h4^CY~i%:ۈ,d𵵨MJQSՉ\8Z 8u>ާ{%b D MC}rLG7Ѵ癜K˺3~^!10[̊/?UL:"psz*(M7 D,iS؜~9g!Gʭ8Zj%RalH#wiձb]efCe'Ez] yXsePPm55jv.ｽߺ|4#}g")]WO7̑5ŏkϋbo!;7Ná,.UTφf{ED{,چ]݅EA$^ ?qI?~߈ G Ԅ%h<24/L?D/e`_%^u`#ˑS&؈B[UrNU@n2TVĘJM]I>P"VyB!逋c4L?.}?3,Up`RQX<%2lJȆ42ϫiH\ϚC ɒT򜚊;Riɝ65n*|DXt*$hvUwt8/Qa9!g>  k㍃ )BdL)_%z2ow}'}fo/(e^"cpHknXj6G>tT,э'0> stream xڍT 4{2""ш13%3$i<0fz(mtE!${eȽ\ȾeZD}Hy3OB&PA*@ˢ]S,-P(LBKbor H,ti p ДJd-j( B~3='T HIR}h$'g_Ъ2H#qpݠxP$Kqg] Źe4'M)p@:H e nQIXgC%2p4d!&(;9i&_ dhYp[HMgOusQ|H'H",Û!( CNq8l -pO#3ty#r# f} ARtF}z$+E$ AtGZSHLޖ $9 @Bz㝑 >!8S"D'AGy~V`h4@ #D~D +O#ygQߠ #P)d#FYKoQѡz~4W%UE()jCwB_)@Fsk/[G# m3,=J l.+2`ɛzWǹ>[63eR4MAoIm{#It7H 1Λm Pt2ZP餍@Q頓ûBo ֦ .׌.br}2@FFtBvW&|EK o kaƟhe3* Y8N>fHQ+TLkGGN-XhsCwC=.tÓ1}ƕ+7-\O}al4IT=? 甼N{zF|`j?N:X_OI!Hv\ {g@pOMSdg`^H# Ŋ] 7A.ָWM ?ψvutt`Rdbf,C!Kig}pπZszոZi8GQ+N;/SM?dٯ1\~+ ꦈ鱱Ѳ6_%l2Yo1!=^}6mMmG&<.>dVo*dhcÁ8&.l/,~Qߟڕ\`.m LYX3iBCnRr?J,.1=T+QV$]7=YغTd|\#Ņ{ثmڄx*wk9WizIʠ*\ Ipmp, <ppnmhgpܗUhϙ E3w1.S9Xszz+oD=sD@G!˙0 D;Ifjy4̗oNCwwOfp9{tk0"u3Z_Iap"V`5JA.{{^T2Y]48uOt`bEYNoIy:Jɡ\?o]]ZweKPm%U&%ii< Niz9#_0uS(|=n.2ZWپ5)Щh]6～y*hS|z>cuU33wFJ[jK/w|MIk6T箙ĴD_Knm] nVJʅU?ݬ_O> .~E!CYv'UA0g% ЀqT068ԛ1t/-:x{0qZOrĭ]]F4R+ ]WXۙw3LN< ].uUڮ]~"fcc\J4LTj`T$P3Tٍ_7]+Qq5>N滋 Ϝ+Y?tB{ Dp)e_F٫ګ/wǨu]+ _a+{+x O Kph%F\6cu!N=l і7 .0G}̻ӬcHD_o&MC/CZ4uU#s?Ȭ I|.Djc)̋Vt:/ OaFU",l#j'*6Ňߝ:nCaC"ej>ц򿊧n5*=6TS7bM6~R̰n2kdHi_ yw .ZRR 5QFJE釆2=E2-iMMiB&1;CV5Uk䆔f͹s2aUٸ80v;dxR휯Wz rtRf IsW$I|ammJHnYN^{mnk v,`-XNw v,<ǐ kdclqldoiE5-.`QݦǶ;/s{R4Lwji$΋,N5YaڼEmlK24x6ro [, gSR͠(R׼V pHuF9}HM0;w2&SRm»- "X?*rl^-NGm4!v[Y kEXG]SQ.5 qօ[cO%W:bQx:Le?qpj{ӑ/a !.-b-ݴ~`1UI0 }VcӃOV2`COᘵьFɆf?|(5߁#:{ۛW{ǯL+KX%OG|VDڎ8Y9]M5d@;~1Nkd2*Gvڣs`ZdL( OS.xIںX ̼]5'rbo4Mz&vl&: S/ɚR-1ke ݉ YEpw J3ܜY^yդN9*|$V1du|oHCp#UYrʩbƒ% 9-i[mxė]l a@Dlā d  endstream endobj 104 0 obj << /Length1 1411 /Length2 6199 /Length3 0 /Length 7160 /Filter /FlateDecode >> stream xڍvTk-U 4 лHޑ! $&ETMJ.EPtADH&RG=|]ޕwf<= #FaE   1a<h``O=Q ""R`0  DcdU Zhģv 6?7|t@A@!(@uwB1aU↼3&+,)qBcO0y0x#0qa&Lh''H8a9`P:_wS_(Ay#Pp :BX/A9B|@BOԕ 9y@172緬rTAPXЯ"00{ pB~pĹ 8_s?>8 H`i1¿ʛx~s0?,߁[ 08Os7}>| kOds./G4  jjaOLYJbb( )# ?kAu4iЀW7 _>W2 [%/oNW@8$w"΅Þ/.|5P Ⱥ0GXr(ᡎ9 Pr{ՑEomq>!2 vux|D[׀ =ONh @ea/Kc˜zBq&= ޿CCBU=Wb\z0Ƴt7O=wLCW<9TJ8v4ǙϗZDSxf0롂/J5lWMn/7ii <4jK> 3nfu󳠹8LkCԠnk.9 5 N^KYN1hYNy? `M&Q+,OK{VrXk LnE wqp1xN5ײ}A G7pǪTͬY=%hU QW\wK!5y+U=I Pr5L:xΜ2{Y0l:qe%9,W9#ЀZ$[پm8!#zt++#2M >;jiQ=o?*es;&z8Nڋ[*ڵg~RhPpISe9&m-l$ozrԓzЇ Ӳ>Ed7+"ԶHW8乚jSgS ҉ZS64I'^>WR%ޔ9]U{*+vn;Twr{wdO(A2@$wm/3_b;[ZRsyO;K/T,fuvf~#2^Y-YR]f=#{5mƈx/pO]eVft *6]'P])rlyۘP͘cq6 3Y ݭu1G ڶ;=X58ӢhlOS_]u>!ڛƼHڪ1D=ե/ FէjW(E:~Fi(s`m]gp5]zH6,dmΓ=N101#BZKl܁yl"RutQ4xog8 dfc=E Բ]r=ׯY|h  <ԩ4:nNX(9NlFBv8N8.4SB]s$2^~iu1"my>KԶaY}ry7aGV/ESrcJaJZarFxYcYEǽ(ח Y3Pcaus'+=6Uo׏X\x@ޚ}!ΡLbvD%/|%&]?79;R 2J:V;ƅVg+_7Qaj?3UQ6hy@P]2Cx[o{ux"-N+`"ώ=ůJF!k| _WX%xwmfRfmK2cr *X#B4w,>c8Jiu$/b~r;gB}`KWRkeO7gW>FcFx楦ķ Y ϩr0=d6IVJltJ]K렢@ Xȟ'`|_P6j}UJJ|"Boϕ g5Tף!1#! > [8aXYlc9؃ [nQhQAFl}z΃D.- zʻ?S-.lO uT|!<-2BuO a4 F5xM 8 ٙ0( !W@EO. K=dŢ_QeDrTj"Ad ,$-$diExHȶʺmbx+с! o01G%M >()fo[p!`(O,PXp]H'wfQ-NCFWkwu97RB _a߆Z> gj-1vbsAJm乓Hw*EqugxI=n֭EHTmYdO% 7TxO}kn+\.uu7UiCD$ljBs1pGs&1ϊ,T<^ H5PwJ||qe"v |G'٬K"[Uߋ$danR]5ba10/lQ#A+#6BW+2 T/?ZP=џS%mxbYѩCʡ@"֓NsСuAws!pC>MˤwR) Vm^׮&lεr;4夽1R".ێI<-k׼ҍ^͎n ! n~x7YWMR\3xa/k'zx#D 6Ȓ׭"Tƹ ?yp{$fūJvb]?wچ=.ë4xO&29{p[}?K\-PhɈVYCeV>ti K $n25/B>|5+AHӢy/$1T9Kz1Ex;o1[NR/#DJq(OYNp;hYiO?-5Ut )~EVq~Nql|ф :xZXHFbXhEwgd;qi͜ogO;Wec-cWKmx I3R|ϭ"Gr_No[=NF*=ۏ҂#sRnadCd`"z*s#HځKE&DT?²IBi|27dY"^ 3(_5<}3meJ!* c~+ͣ&ݡ}7Iw'vn Z}pT[b!Gj?MbyuN9 ~L 워qNIc:{ Ǟ5`WV3KȠ4}%_rR˼?da{˒jCF++.=nu~A)Liu4n<Lu 5`:!-J֓FH>^8zfk`afrv`ç\&*V6V" _)e/V9p9KiBZf>Viޑ00_E93Mba/GU!1nNћ`O8t6p^Tݙ~a,2ЕfEݢc(Β!FRj+K )Z,g] dKF&Y[rqk9>~}RGpC3q}X՜=ֲ& 㪡 o\>$7&B흺9,/玝fi_͛:F7cXI ;t3G -4v|l怓41u2kqH'*O~)?[#-a[(VWY+ {u i>:(jZpj+uO c"5 τG\PGPPxG;^VW] xA8EqEbiq53,2)(ÅOhŞ\CrNwwbSl+tptv%^.~Ut0OC0vl#Wq=3~Ol&/W~K̃Q" j[shMn^؀ke}9a׷l>٬˻awL=g] UM76]zm羝i8}HgV>i`JP@\~UN,t|1:Cp IŊjCy0~Q9~BJa DP`.S`;k~;W$/!w-c9bn3FZbtn5셅B;3_i"JaQGcg[G-+\ULOQƿKCCIl|k&S e.̝mդl rVRd_LZ^Կ~PIid;T$ ~<`>a󊴇d*\R//N:n=UxUB*R}y.Z\#1 I;c ut@}; ȳ"4Ȑ$y~9jU> tdep$ȐPu'Kڦm% M#%mwQ%y4Ybt6V%C"&ZMtwI`IFeˬY +o䈷i4 %]8C4~&g˥ivCk˿UE)#8ymB5_2>y:G90c@\ߩgǴdLBjXGxq3eg%P$xՆl.zPvx@gAO4vOT~^E`>$1r˞'0n endstream endobj 106 0 obj << /Length1 737 /Length2 966 /Length3 0 /Length 1535 /Filter /FlateDecode >> stream xmR PSWHD0´*"IJ(T6! ;T0$&O*". es%JŢl"D@& u!әΛyswz2#Iqb0]Aز0>d&ښK@!☷@k!XdLK"Pvy#  T *T,*KP2U! Ġ2A|y  +E2T Q1p ;@c:I! ARb\|eA|usCr#T6+r̒ ,ј5%Ä*&JPqX7_,l=(FC!Q2YP)IHO a$L&ĨNFKrTE2|I!% P2:00X&B$%)IB T)?)} #8&K+ȟV&lI}W=wW&5^\4Wf-KQmˮΩVe[+3w$J)=d@j)܀7?˦:lǚzIzs%e6%nRuFܻǖWE~Qq}ď9eh8št{$ꎿ}'\i~Vx]p(;Cx148nH -5U4pm1t:i%Ė.+w5nnm>m:]d_&5;R@Wt_lj^il~ >i[|V .Fْ\I0M;үȆns_l`WhA`,mk[ෙ V,<^uZ>8\秪^_r;9J"'|S/v6AJv{A/rlqq2MXFϓK6>CwyMB+597f]fiÆZޫ{V4jA-8w+Ny׃ߍo`z=J)%CF+M|_/+LgOU>&MXD㦯$eE3;qM3ٚQq>\Y?|dd>18_b} endstream endobj 108 0 obj << /Length1 725 /Length2 15948 /Length3 0 /Length 16495 /Filter /FlateDecode >> stream xmctn6vضm۶gNVl۶mZ콿~=zUWWWw9&=#7@E\UHCF&lfj`/jj 039̌L0dG/g+ KW տu[#S+;+g%]ōٍN*ffWK3@DAQKJ^@)!07s6(ZdL]̨4&VBofή3wvȉ +ȫDTEFYۻpmfh#d?X=#01LL\fV0 MMrfxٙ(E\͜rfql濮FvV^C2-?*+q+O3SE+vuv3Z?s#gfjffpϬ:z 1(ȫ+i O,fo`jeoPqO#gQ۬hd /f\<:J=73#' d_pMܜ]M?d2343Y_q0 Nm -+1TYa^A458¹Wß 4ۻܕo&63;& [y-&~W׿SǶ3sMXRb9v*C`6,Gډ_[|ң@3;F )6x_ wCm`YPx_e-8%s-J^;$tŲ!r0Y~ë p )SɫZq77K:C# F .{=jϝ!*)=9B_nu2`A\gvLX9 uTl47/i(i[t"\9;#!E>#}@ٌA4Wg A2ĘKFS젷ПUsU02 _5d xϳ${zf6yi^5U^A S!}w)!h %SF;rB90.3=ltf_<9Ka(:y,op#E}r#丂Y |/xISؙAXgbER^9 s-'p'w٫Y5(ӕ|3uVARb$!.D 1@0]I2 g#^pTNYh߽Y~tl2 W*TXQj*zl}t-f:nVMoPX"*Z_n[7*JSkU{uFs'Ldjig&kh֎ wA3tݽJnKn9筼6[o/[x ]V wAeDH~3 }Mg⺈w;k}b21%:woQPK"F\H1^g pHUcf Uovey1-غ aWڠxCL|JRzV>= ;JHA[;`ك;֣'-A!W^ aehīO1]eV O \ =V' }]^Qc(%OOznu<ĜQ؋TIʪ+eA%8d$ d>#gشgAnK}W;2(G5}3.}ysA4Ξ=pdZaQe͆փ$NLjJ)?ɅLo/IKcR!q1hHSEzsu3Mp[HR9"Wq;ED-ˉA0Qkrl(RDRT2;]b׷}7C輀썩$ s4|ɏE]Txp8TQ*}XWױZs۫ozMZǛst!G{~V7N]j[vjxa{L뽱dKc݉Z]`a2&+Wk Mv^a&nhkS/S#7R-nKv՝fŧϴLBCr=m8p cM7=۩ej H 6y'{H@$_MWӦ{_^gf2  B*|Xv-@!G9L5fI";1uCD(T>'p}ua$cc }bu~땺W"tFB@ ]ӶVc+U?0|7$:NW6U 0Oτ: T|w^)3)2ʿLXUܞ~c]'JP2^Yn9g%:N_1P8-vЍ'~{"瘲dzr~a7kTU(jߎyw\t}ƠD񪉸abR3|g$#A^!M{/pU#_§Em? 0i HGam4pqh@!#Eb. .lXp(#\u8"*57ҕ:S):e%eOÆfpgq| gy%CHNmݺm^˭Ƽ]IߕXx0J*_s~.%#]VBoKd-OSmf=mu\> :b( Xs'Jcr-t#wN%TAx @"t-'3<0zCVm*O_> 3Y%rqC{nf \a /E #!8&ѩE(g{`^ay 0"0ۯE&ymC#@;ܝ`(F[.gEq`Sn\^A=.#x腾*/\{9ؾ %:;vv_=}~ZA\7x- ؈#u))I*hof1ZOe43R"=)g*̱$D'Džs3c11զЂ$`LV@L$ 芋R? 9:X<O@WrqAcZդa,̮17yBt1f gtǵ'&"e mڮ 2y ]E&͊bc:xjt:F!3.\:8nty}\y?Z~*gG:{2 HBHU,-0I6v!rQ\WW0qaXx-ؕF(ngm( 9FbGzG YЬ /uV_l!Iar#?Ol\7"2 xϝdwP"/B`pϷ(-jК)j(rgydLlJ^l% ie9,b EU]#'s @{ܜ辧Mv%Rq A>tZ Zjj7?ݨMy+mI\3z'F`rACDiV-!vy}]!h^ UI!Qʉ`Nf?_ E'B_wZzl-ZB _O#R7|pX5J)(P~$hlOq֗߉UI};uA*8qp)/ sna5;]<7@ "{RL+.HlQn5q-&\<2htԹ2z.Ab·uTA??eSC[@0C6T3n&, bTU_!|Jy(9ExףV6e 4'>qR̭n$𨪼S4?ή0LzLQb]{& }qe&U2 ,N2J!F 7؎zotwq1hu{*nղ|Tk Z {hۜխ#4! 42>9N}p$X-o`kkc@&Ds6j,z}tƟ"*BflUbQktw3|$͹GŪ@U#dƀ6oZ9CPQΏG:j% (0knb>f7`*%FXō("یGJ84P~ e9Ϛf*NMW(s &Q ;H膿 *כ>p*,}KUhHJ{寜BZ=p"꫚(0#%)XI|C%[ݖ@45QJR$AU%>"|{e-A; <]brYZpl0C#bѨ cH-'{ -A e%WN" ih5ј*=(VA8;x_jD]|K~= H"ܞqV_Q6O0!ve~Rmܪ}:;3$qJ;*MR*N±):O'ah9 Zsپ|.nЬ#]Y=J{V_DeQ|x\/sr$7]5NFp(mLB7S.4f`=F|D, *l>ELa rC 1",/hR;Mr B4*Y9r)`ߍ!fD@MvHw>X=:rϿKܻ}&Ր;[&~Fiz)v$5BQac!788\.\kV*tXҷp,qX79bVziO('UU Bڎ ,keX*ck4 3ǫE6-3I"#~ϕ&y"`6(eGP{:kiEc [PP,=cVCM=jph6izoOxSvAb7`KidTi[EԛUSx^~Pk*<g>tT͗*υ "`ew9i-(pL~w5JY)l͟-Pe]R,ŝ%FL&F4=' qD?q )3q뽽ob5y%+ Ҳw_ᶟTl/nH9/@JD|#HCp-b3oDǗN3l$̾.yFH:D£Dv"]O@?OSyqd^D?E$d0P?|||Ղނ@7$" WPHԠ=_>qĦ6! _ˋ&s7'VD9!Kf+>U.Ө I.<ՙ@"g}#HkhmA,r3ϛUUUi>ěGgrz鼥 #,dx{kHn*xȧ1zWI=C0{_wmsHs2ء#Β-cwF5K/eI<*~߁_q*.),+w |(-b{2Q%xLaA,;reJ-JusȫxK8RdWS퍙} ^ `ŰFK$s,%ǔ"C%S;5 `AGE"q\UXx=6~^g9o_sd XW Tߴ:gسFlp9ҕyO}4 s~L;Nn Q-zquk#esmFҊ͔?U7drў"kwc)%;Ñw{=LnjҖIxL {޳lیUv`GH$5wtN$ J8f> Tԉ̿sb~^v7V߱Qb}+H1PǤYb1<:,4^4/#o@ъu524Qx13bˉN&%5%=Q$f5d" {^ lBc8I)ni+Hf= ZLtjl֪ĕ;Q P|LȰP~a90y3M8e U>F@?OYxm$G#̲F;i_3@8@HOeC%Pɕv]Y[}`5(qz;^yWmY1`ڨeO9;za0{VS͞V% WkC aBMݼ-VWҋClUZIY$(M IAbrm휹V1l_aAjKC]P \zb=& <&T WōG*nG]("50]QL%W䲋us 8 X #mdǢxgt%WR +t4 0:JV!sjZ,Tv> "[`X 2.6u0V~)ظdp.nRn"X%\A"8]e|X -~O'78vIQkN\G,^wbnQd" ER>-d 8҅AzyXnkfP3AP('NalҮ%Bj_5 F/"I;!(-'U # 懏rΑ8 ?5X:\tL} "o,CVo=Ymc4-r ƕx\oN;.H R@\/ |sN[fv)GF=9G׏~4KMpv]?m?B <SQonW/ʮy. 'Vv"3R0” g/1| ,MK<.j5_(7;=ANʯ`„q2Tu&"RMX1 >rY[P~rnsF'gB]! $i*21Hy .oJyܕ|}vhvax;yY4Ĥ tx #ݟu3籍Z_FgI}] BTllC1 KK߅@HTY>ٴ̺{n#IKɡ(AMդcqɾ)D]Owfen;E~clp 5 G}V7_%%,x%Op}zP+)5`7·9{5Q H2p!Qh߭1N9>^cDL>ezgIrNpՇ;p،V ̬Y}`C|vuES`qc:~X I7Յ79QH:ס\B/i/V&>DuɬLujŒiMwcEJ7=~A=q'QP*G-_ {5Iz]O+N>ӋKN3 %~0qzPieA G>3/3y]M' ˓pEd8щHT5N~ Av7 Z i '6yTt'T f2=4ynS׶61nwGu%m.\SHP K7Zkږ? EpW @x@W#3? d(bAg^r> (6ohpp.@=Sw>h@-Zw* G-:Ƚf3E^@:=ٹCt %A[vr1b wb /Ζj-p |=,aT\.qXĉ.s>mqN;z)k+㊸aT?/۾3tSl3VES46o<`Z*=Acppw=hWciJc8]֨}EM-ȋD詝%فoW-zm"<$7Ԑ @`"Li -3qVnn_DFc )QƲ3$ji@@IP['RފvtBJ.)U1diGRԛIךl[78uw%ϲjK2 pysv@$G™26dpMH*7Ҿ-de QL2;zxTsMv5tVE# KFmAI+hwN/0@M<'-cXH;@҄7J  9ʗG/{*[ӪR@A j(5,!R0H9]c5٪9"$;}O(:a"N)F;.YږKȟ94}NEb錖1 sOվVsУ=4g܆l"`E$1D1}tĔ*MÐr"&vޛq:v{$ ʓт!]c򙬷᭱ݍCs>嫦ByeDli>-eTa;F;far2лcS(ceX~ubO}tr\JE]Æ\KFiK-?R;Jk\fkyWsHFʧrg,3l0B}$(\ޒؿE4 Mg[7aҵ¹/IɁ1iWK fQ7"oF !B)u4f[nۃYK2@(ÿ!+7gn=VZ :kM9쭿bpbiR5Wܓ5-4gʿ"Y $3l ~Ja`m +^%+"G~G=e}QAR&2$Td+3mB&223 ojvς /});;aŧwKaD\mMU|.hըݾ,ߥ4~[_P)+ӻ ed 6.HY sj^?FuC"i?A/;&ăd&L|Nmm3\! J5{ KK6V3Y?sު{hRkG_A V0iC/mCZDA3CČALx"tj\[eJSX мƇӏ$+WU+=׳됰6%;U'R⍜ 4dmj#$i.}ʦz*6̋cA u=ZuNw9?ȣfWW!&NLOlh5FUn9c I'Q W^o!#n@c?%/4}ӈQ6]ݠm&M)Kokq ~#$DfR;ҩ]_ҪۿV]zv@=ǹ19{9fZ"qxlV% 6& dG3@bLzD vÊBmĚL8qՅzΦggh4O͗ [.*(KϢ̃$l~%n"15ܨBKsb_+g-}m\:$m[f݉'Rz&]hDF5T|s<~™`$(ܔ)3ix4 RBPl^ <D uMKEٌ9* U2Ē5KM`0 HlpR((pujh+v9FwGkz%s%}?}A$w^!:3Zj\@{Ed*UKl`vHf4$ PҚ#>a4+ Bd1rqA9_^qZn,њ~\*1oNHg3u <4_0*gL5NpH86]|Aou}Ai2GE"_a?NW֨ dMLxVO'(G5Skz㽷Y3}l8~x1e.v%z:c^|;PZܧdΜF #۵"~VGحnAŌ&9cm 5P&eHxʨ>-%Ps_ɒ5S)p3%A_zꌰ_ UIl7]@5~D p 9$R`7CVDnSC^=ܧ?bk&uY7 3,.cwHCq<`iq,* ['^P @o fx%r˧gmU8 0((˸R\c$ Gp3_p˧ (B`>ч |Ug{Hv$Y j =&M|ˮ5J8]eh1\}hN Zu_v|wغ)4 |8Z0Rʪ 5\B;U7_fi !R܋~=)[Qde]g v$ߨJ-ݖEjiZq2)0;N0z1R*GI{['gM0皈$ 3 Jb_[@XCw]L'Ӂ['qSpL..IS !U]h9 ^^EE<2XRdljog< VE#SQ x{{w5`(,:x,ْ}^᳢/xk 86y00B6ZVb@p$gƅ\x;~(o[_'a,S-w_$Gi)aԟ ~L(O~Jzc}]~ґ»{cE-Yч8~8hmVЋ>5KNs K讁sRnpR4Ò;zkxРjP *L ڇ4\a].܅TW$/ &1ųf GRil4X$0@kN͇ +{咀1j5~ nTmkr!#<`*O#e]IX^\ch ' 7~x$W7>DpHz0զoc@?1NtJMS_\Fd[Ӛ>,䄤=^,]ƹb"F݁_{3ưJf-ceU܄ϯ냚 d\ "ՏT*$ !JAb+%(Jh1 3}L{4P\/D~+I{ubA-FQ >%)q6 0kp(;@PP_;2sb*ˊ_.|.#]<KIVthK+q)OF |?qIFpܖA0:_PCXX\̹4IrOlefB<2YR,cVp9ώn1^|.o>K&Rf}bF]ЛVΜVbֻD$M&)0)l`("̣c H O{'dA&ΊA?W`d gCm)5NƁ r<@Bl4dW+[gBtiּ;LF(TEpl \,jm$ uM/~[6w],}WiB2[#Ni'ȶ[?%FJ`I"Bl,j۝W(cx;V*TRЏ@9[+M10jJ}'fDPP@Y75B6 rbQ1EOQ0N_9h6k,=ƚY^hlCC  7 ?:7$xa] ֺm|O*&ȪľC}_;ɧJZ0D@)m_3Z9F007YA"dZθi| lN0\lsL8= S]s&"AHT\Eq2D 1!菨 fA6& YrOx;AH/=f_GV_00x_C&uò)GgNjyy-{5 2.SPJqݶR8zwu7r|T+Kz6nAYt*QՊU?:>GsO,\1TeyhRSsQf k? nQm%\5lk~U};lSQ69wםqZd>u-vr+ oP$FM]ySA&Ŝ Y؈ ZʭDcb1;KJ2C!࡟p_Lv^)pIN:|hݝ)1z. endstream endobj 112 0 obj << /Producer (pdfTeX-1.40.13) /Creator (TeX) /CreationDate (D:20130915001555+02'00') /ModDate (D:20130915001555+02'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.1415926-2.4-1.40.13 (TeX Live 2012/Debian) kpathsea version 6.1.0) >> endobj 21 0 obj << /Type /ObjStm /N 82 /First 679 /Length 4055 /Filter /FlateDecode >> stream x[[S;~:ftR pBn@ȥcdؚ1Caw_NnilYT(BUH]( -)FPQ8i % /\,B"?PU4V.,PNB[j&zdaUa>=+4n`1'fFӧR1I(( -xZ `X @b==k" o ᲅ4غiZ sIKv!©^(+j@$QU«"UH4A,$V$ED%,PEy3D,, UTD-Q|p\4|Ld3olEEAcb*KJLUCQ5uVKh(֡TuxS(R7Oj&)mNp^\ Rj|u_O$[EyP7Q $s`9 #m-9`a~ &if.s\bYj%Xȯ)}EE{-g }qRg@]-EӢy}njfw_G#Z4ZSZ@]k=Z#(8VxHuCYO#tkv% gQcɰFJL"%9k*5Bئ.D-*{| Z*(]"tq].O VXRLh4j?'&֍qBVi$gx$6(Uj$JneNnpZ`43ϐ^`TXnΗKJwD0Z@ڱ"MvlJirHC*j%F@%xdZ?Xl$5-S[=ٰv Iee͚k`**VX@p4q9He5~p ^[0:.Ƕ<:B )5BˎFTVty4-Yi[Ӏ{^^.쌃,J /,F)Xz^?-ߒIw&CU{.rtLނbԘPIslͷld3Tʳ=Vlyn|DŽ!\sk=)9NrqE66flP$Mgͣtl[D%mdL{ҩϑTaԑBx7Xmu>AgRԜW1L盼yj4]' YL,: `HYpGC.P47ֽB:J)VYt`,eKlj e+'3`44Vsk@[]7`FpRJ!>vE_\0آYg|ؤDej2Dy=TTwLL^6|byiTƖhO>`b$LvÙFS#ḏ2w=qIٲ]&˓bX7awev"-ge)c$'Qլ'u.|SZ8_YhK l? 6H>lr]i$|囚cp@;@bH,i%6Mt\O-g85&xX׊McbkVD[GI#3HhITb6daeW w|GOλn e$qɦ)~.4cl: Jw%9tgL4y yo]i56D":[ݰ Ȕ)26)p &GX3/Ibx/sK=:bV{U<3]i#y,G{Sb?rЖ=)gM4]LL+S@GJNHGf82-+ *ŷv`onOF+g&9ya9cTG3(ˍy_\.ኄ;J$t_JSFB1܏6ϡ^6uB:¨.]6<[E7A,\-qf]qa4illUlqNs2 .q}otC){Oxmz5C^ /m=y'$uO'O#G_cس0/Yȑʍg`G;x.A?/>tPKDs xMy\򲼺q9)g.]3jkDsYãϟ3Ѓcx(\/rX~&.GePoQ Km s2åDs=J.jk{hr7c?$/z!D/et?ӎT>PfFgC/IQn[r-/W˃LviwR^oh6󃃾X$nf%<<΄'DpXb6E!D(zdJ"|% kעPZOgT8vru~>r?e|xMz2Y)y}5O>ІD3.tvݳP~BmʓB@nq]vs a9nsV5_MսxuG K9W/6hsKJB|WT;Yy2<=-lKރ[_! ^yև^Se7hrzCmAa)Żmq@0`ԽO$;(H' t,7:!}}:`g>yhˍgQ[,{NVsm[2= <($:̿A.76_o?e} Y-YЍXۻ?;Y P4- qyʏh$x2Җ*Vh ] /Length 308 /Filter /FlateDecode >> stream x%.a3χ\\C  kI}+JB A/ !n~s7ȟqA"Aa-Hd]ARdl52G<$+}yXb NNw{dH$t Rt"D\U*HC %5Swdԑ z@IqI3H i%m$LI$EI$QZ/Trq hE!Z1Ok w?Z>P|ՊøOZ#0ɰ(LJ+;J\`^>= options(width=80, digits=4, useFancyQuotes=FALSE, prompt=" ", continue=" ") @ \title{Using \car{} Functions in Other Functions} \author{John Fox\footnote{Department of Sociology, McMaster University} \&{} Sanford Weisberg\footnote{ School of Statistics, University of Minnesota}} \date{\today} \begin{document} \maketitle \begin{abstract} The \car{} package \citep{FoxWeisberg11} provides many functions that are applied to a fitted regression model, perform additional calculations on the model or possibly compute a different model, and then return values and graphs. In some cases, users may wish to write functions that call functions in \car{} for a particular purpose. Because of the scoping rules used in \R{}, several functions in \car{} that work when called from the command prompt may fail when called inside another function. We discuss how users can modify their programs to avoid this problem. \end{abstract} \section{\code{deltaMethod}} The \car{} package includes many functions that require an object created by a modeling function like \code{lm}, \code{glm} or \code{nls} as input. For a simple example, the function \code{deltaMethod} uses the delta method \citep[Sec.~4.4.6]{FoxWeisberg11} to estimate the value and standard error of a nonlinear combination of parameter estimates. For example <<>>= library(car) m1 <- lm(time ~ t1 + t2, Transact) deltaMethod(m1, "t1/(t2 + 2)") @ Here \code{deltaMethod} returns the standard error of the estimate of $\beta_1/(\beta_2+2)$, where $\beta_j$ is the parameter corresponding to the regressor \texttt{t}$_j$. The code <<>>= ans <- NULL for (z in 1:4) { ans <- rbind(ans, deltaMethod(m1, "t1/(t2 + z)", func = gsub("z", z, "t1/(t1+z)"))) } ans @ also works as expected. The \code{func} argument uses \code{gsub} to get the right row labels. Consider the function: <<>>= f1 <- function(mod) { ans <- NULL for (x in 1:4) { ans <- rbind(ans, deltaMethod(mod, "t1/(t2 + x)", func = gsub("x", x, "t1/(t1+x)")) )} ans } @ which simply puts the code used above into a function. Executing this function fails: \begin{Schunk} \begin{Sinput} f1(m1) \end{Sinput} \begin{Soutput} Error in eval(expr, envir, enclos) : object 'x' not found \end{Soutput} \end{Schunk} Worse yet, if \texttt{x} is defined in the same environment as \texttt{m1}, this function gives the wrong answer: <<>>= x <- 10 f1(m1) @ The core of the problem is the way that \R{} does scoping. The regression object \texttt{m1} was created in the global environment, whereas the argument \texttt{z} in the \texttt{f1} function is created in the local environment of the function. The call to \code{deltaMethod} is evaluated in the global environment where \texttt{m1} is defined, leading to the error message if \texttt{z} does not exist in the global environment, and to wrong answers if it does exist. For \code{deltaMethod}, there is an additional argument \texttt{constants} that can be used to fix the problem: <<>>= f2 <- function(mod) { ans <- NULL for (x in 1:4) { ans <- rbind(ans, deltaMethod(mod, "t1/(t2 + x)", func = gsub("x", x, "t1/(t1+x)"), constants=list(x=x)) )} ans } f2(m1) @ The \texttt{constants} argument is a named list of quantities defined in the local function that are needed in the evaluation of \code{deltaMethod}. \section{\code{ncvTest}} The function \code{ncvTest} \citep[Sec.~6.5.2]{FoxWeisberg11} computes tests for non-constant variance in linear models as a function of the mean, the default, or any other linear function of regressors, even for regressors not part of the mean function. For example, <<>>= m2 <- lm(prestige ~ education, Prestige) ncvTest(m2, ~ income) @ fits \texttt{prestige} as a linear function of \texttt{education}, and tests for nonconstant variance as a function of \texttt{income}, another regressor in the data set \texttt{Prestige}. Embedding this in a function fails: <>= f3 <- function(meanmod, dta, varmod) { m3 <- lm(meanmod, dta) ncvTest(m3, varmod) } f3(prestige ~ education, Prestige, ~ income) @ \begin{Schunk} \begin{Soutput} Error in is.data.frame(data) : object 'dta' not found \end{Soutput} \end{Schunk} In this case the model \texttt{m3} is defined in the environment of the function, and the argument \texttt{dta} is defined in the global environment, and is therefore invisible when \code{ncvTest} is called. A solution is to copy \code{dta} to the global environment. <<>>= f4 <- function(meanmod, dta, varmod) { assign(".dta", dta, envir=.GlobalEnv) assign(".meanmod", meanmod, envir=.GlobalEnv) m1 <- lm(.meanmod, .dta) ans <- ncvTest(m1, varmod) remove(".dta", envir=.GlobalEnv) remove(".meanmod", envir=.GlobalEnv) ans } f4(prestige ~ education, Prestige, ~income) f4(prestige ~ education, Prestige, ~income) @ The \code{assign} function copies the \code{dta} and \code{meanmod} arguments to the global environment where \code{ncvTest} will be evaluated, and the \code{remove} function removes them before exiting the function. This is an inherently problematic strategy, because an object assigned in the global environment will replace an existing object of the same name. Consequently we renamed the \code{dta} argument \code{.dta}, with an initial period, but this is not a \emph{guarantee} that there was no preexisting object with this name. This same method can be used with functions in the \code{effects} package. Suppose, for example, you want to write a function that will fit a model, provide printed summaries and also draw a effects plot. The following function will fail: <>= library(effects) fc <- function(dta, formula, terms) { print(m1 <- lm(formula, .dta)) Effect(terms, m1) } form <- prestige ~ income*type + education terms <- c("income", "type") fc(Duncan, form, terms) @ As with \code{ncvTest}, \code{dta} will not be in the correct environment when \code{Effect} is evaluated. The solution is to copy \code{dta} to the global environment: <>= library(effects) fc.working <- function(dta, formula, terms) { assign(".dta", dta, env=.GlobalEnv) print(m1 <- lm(formula, .dta)) Effect(terms, m1) remove(".dta", envir=.GlobalEnv) } fc.working(Duncan, form, terms) @ Assigning \code{formula} to the global environment is not necessary here because it is used by \code{lm} but not by \code{Effect}. \section{\code{Boot}} The \code{Boot} function in \car{} provides a convenience front-end for the function \code{boot} in the \texttt{boot} package \citep{cantyRipley13,FoxWeisberg12}. With no arguments beyond the name of a regression object and the number of replications \texttt{R}, \code{Boot} creates the proper arguments for \code{boot} for case resampling bootstraps, and returns the coefficient vector for each sample: <<>>= m1 <- lm(time ~ t1 + t2, Transact) b1 <- Boot(m1, R=999) summary(b1) @ The returned object \texttt{b1} is of class \texttt{"boot"}, as are objects created directly from the \texttt{boot} function, so helper functions in the \texttt{boot} package and in \car{} can be used on these objects, e.g., <<>>= confint(b1) @ The \code{Boot} function would have scoping problems even without the user embedding it in a function because the \code{boot} function called by \code{Boot} tries to evaluate the model defined in the global environment in a local environment. In \code{car} we define an environment <>= .carEnv <- new.env(parent=emptyenv()) @ and then evaluate the model in the environment \code{.carEnv}. This environment is not exported, so to see that it exists you would need to enter <<>>= car:::.carEnv @ We use this same trick in the \code{Boot.default} function so that \code{.carEnv} is globally visible. Here is a copy of \code{Boot.default} to show how this works. <>= Boot.default <- function(object, f=coef, labels=names(coef(object)), R=999, method=c("case", "residual")) { if(!(require(boot))) stop("The 'boot' package is missing") f0 <- f(object) if(length(labels) != length(f0)) labels <- paste("V", seq(length(f0)), sep="") method <- match.arg(method) if(method=="case") { boot.f <- function(data, indices, .fn) { assign(".boot.indices", indices, envir=car:::.carEnv) mod <- update(object, subset=get(".boot.indices", envir=car:::.carEnv)) if(mod$qr$rank != object$qr$rank){ out <- .fn(object) out <- rep(NA, length(out)) } else {out <- .fn(mod)} out } } else { boot.f <- function(data, indices, .fn) { first <- all(indices == seq(length(indices))) res <- if(first) object$residuals else residuals(object, type="pearson")/sqrt(1 - hatvalues(object)) res <- if(!first) (res - mean(res)) else res val <- fitted(object) + res[indices] if (!is.null(object$na.action)){ pad <- object$na.action attr(pad, "class") <- "exclude" val <- naresid(pad, val) } assign(".y.boot", val, envir=car:::.carEnv) mod <- update(object, get(".y.boot", envir=car:::.carEnv) ~ .) if(mod$qr$rank != object$qr$rank){ out <- .fn(object) out <- rep(NA, length(out)) } else {out <- .fn(mod)} out } } b <- boot(data.frame(update(object, model=TRUE)$model), boot.f, R, .fn=f) colnames(b$t) <- labels if(exists(".y.boot", envir=car:::.carEnv)) remove(".y.boot", envir=car:::.carEnv) if(exists(".boot.indices", envir=car:::.carEnv)) remove(".boot.indices", envir=car:::.carEnv) b } @ The was also fixed in \code{bootCase}. \bibliography{embedding} \end{document} car/NAMESPACE0000644000175100001440000001440412215125215012253 0ustar hornikusers# last modified 2013-09-14 by J. Fox importFrom(MASS, cov.trob, rlm) importFrom(nnet, multinom) export( basicPowerAxis, bcPowerAxis, Boxplot, carWeb, confidenceEllipse, contr.Helmert, contr.Sum, contr.Treatment, dataEllipse, densityPlot, ellipse, logit, panel.car, probabilityAxis, qqPlot, qqp, recode, Recode, regLine, scatter3d, scatterplot, scatterplotMatrix, sigmaHat, slp, some, sp, spm, spreadLevelPlot, symbox, which.names, whichNames, yjPowerAxis, Anova, basicPower, bcPower, yjPower, powerTransform, boxCox, boxCoxVariable, boxTidwell, ceresPlot, ceresPlots, crPlot, crPlots, crp, deltaMethod, dfbetaPlots, dfbetasPlots, dwt, durbinWatsonTest, estimateTransform, testTransform, hccm, identify3d, infIndexPlot, influenceIndexPlot, influencePlot, invResPlot, inverseResponsePlot, invTranPlot, invTranEstimate, leveneTest, leveragePlot, leveragePlots, lht, linearHypothesis, Manova, mmp, mmps, marginalModelPlot, marginalModelPlots, ncvTest, outlierTest, vif, avPlot, avPlots, showLabels, residualPlot, residualPlots, bootCase, nextBoot, subsets, compareCoefs, matchCoefs, Boot, gamLine, loessLine, quantregLine, # method explicitly exported for import in other packages linearHypothesis.default, # deprecated functions av.plot, av.plots, box.cox, bc, box.cox.powers, box.cox.var, box.tidwell, cookd, confidence.ellipse, ceres.plot, ceres.plots, cr.plot, cr.plots, data.ellipse, durbin.watson, levene.test, leverage.plot, leverage.plots, linear.hypothesis, outlier.test, ncv.test, qq.plot, scatterplot.matrix, spread.level.plot, wcrossprod ) # methods S3method(confidenceEllipse, default) S3method(confidenceEllipse, glm) S3method(confidenceEllipse, lm) S3method(print, spreadLevelPlot) S3method(qqPlot, default) S3method(qqPlot, glm) S3method(qqPlot, lm) S3method(scatter3d, default) S3method(scatter3d, formula) S3method(scatterplot, default) S3method(scatterplot, formula) S3method(scatterplotMatrix, default) S3method(scatterplotMatrix, formula) S3method(sigmaHat, default) S3method(sigmaHat, lm) S3method(sigmaHat, glm) S3method(some, data.frame) S3method(some, default) S3method(some, matrix) S3method(spreadLevelPlot, default) S3method(spreadLevelPlot, formula) S3method(spreadLevelPlot, lm) S3method(subsets, regsubsets) S3method(boxCox, default) S3method(boxCox, lm) S3method(boxCox, formula) S3method(Anova, aov) S3method(Anova, coxph) S3method(Anova, default) S3method(Anova, glm) S3method(Anova, lm) S3method(Anova, lme) S3method(Anova, manova) S3method(Anova, mer) S3method(Anova, merMod) S3method(Anova, multinom) S3method(Anova, mlm) S3method(Anova, polr) S3method(Anova, survreg) S3method(Anova, svyglm) S3method(avPlot, lm) S3method(avPlot, glm) S3method(bootCase, lm) S3method(bootCase, glm) S3method(bootCase, nls) S3method(Boxplot, default) S3method(Boxplot, formula) S3method(nextBoot, lm) S3method(nextBoot, nls) S3method(boxTidwell, default) S3method(boxTidwell, formula) S3method(ceresPlot, glm) S3method(ceresPlot, lm) S3method(crPlot, lm) S3method(deltaMethod, default) S3method(deltaMethod, lm) S3method(deltaMethod,multinom) S3method(deltaMethod,polr) S3method(deltaMethod, nls) S3method(deltaMethod, survreg) S3method(deltaMethod, coxph) S3method(deltaMethod, mer) S3method(deltaMethod, merMod) S3method(deltaMethod, lme) S3method(deltaMethod, lmList) S3method(densityPlot, default) S3method(densityPlot, formula) S3method(dfbetaPlots, lm) S3method(dfbetasPlots, lm) S3method(durbinWatsonTest, default) S3method(durbinWatsonTest, lm) S3method(powerTransform, default) S3method(powerTransform, lm) S3method(influencePlot, lm) S3method(inverseResponsePlot, lm) S3method(invTranPlot, formula) S3method(invTranPlot, default) S3method(infIndexPlot, lm) S3method(powerTransform, formula) S3method(hccm, default) S3method(hccm, lm) S3method(leveneTest, formula) S3method(leveneTest, lm) S3method(leveneTest, default) S3method(leveragePlot, glm) S3method(leveragePlot, lm) S3method(linearHypothesis, default) S3method(linearHypothesis, glm) S3method(linearHypothesis, lm) S3method(linearHypothesis, lme) S3method(linearHypothesis, mer) S3method(linearHypothesis, merMod) S3method(linearHypothesis, mlm) S3method(linearHypothesis, polr) S3method(linearHypothesis, svyglm) S3method(linearHypothesis, nlsList) S3method(Manova, mlm) S3method(matchCoefs, default) S3method(matchCoefs, lme) S3method(matchCoefs, mer) S3method(matchCoefs, merMod) S3method(matchCoefs, mlm) S3method(mmp, default) S3method(mmp, lm) S3method(mmp, glm) S3method(ncvTest, glm) S3method(ncvTest, lm) S3method(outlierTest, lm) S3method(print, Anova.mlm) S3method(print, boxTidwell) S3method(print, linearHypothesis.mlm) S3method(print, chisqTest) S3method(print, durbinWatsonTest) S3method(print, outlierTest) S3method(print, powerTransform) S3method(print, summary.powerTransform) S3method(summary, Anova.mlm) S3method(print, summary.Anova.mlm) S3method(print, powerTransform) S3method(print, summary.powerTransform) S3method(summary, powerTransform) S3method(plot, powerTransform) S3method(coef, powerTransform) S3method(vcov, powerTransform) S3method(testTransform, powerTransform) S3method(residualPlots, lm) S3method(residualPlots, glm) S3method(residualPlot, default) S3method(residualPlot, lm) S3method(residualPlot, glm) S3method(summary, powerTransform) S3method(coef, powerTransform) S3method(vcov, powerTransform) S3method(vif, lm) S3method(symbox, formula) S3method(symbox, default) # methods related to Boot S3method(Boot, default) S3method(Boot, lm) S3method(Boot, glm) S3method(Boot, nls) S3method(hist, boot) S3method(confint, boot) S3method(summary, boot) S3method(print, summary.boot) S3method(print, confint.boot) car/NEWS0000644000175100001440000006006112215125215011533 0ustar hornikusersChanges to Version 2.0-19 o fixed scoping problems in Boot, bootCase, and ncvTest o added an argument to deltaMethod for passing arguments to get scoping right when calling linearHypothesis in another function; other deltaMethod bugs fixed o slight modification to documentation of Boot o summary() method for "Anova.mlm" objects now returns an object, printed by a corresponding print() method (adapting code contributed by Gabriel Baud-Bovy). o added .merMod methods to Anova(), deltaMethod(), linearHypothesis(), matchCoefs(), and unexported utilities df.residual() and has.intercept(); insured compatibility with nlme and CRAN and developments versions of lme4. o added use argument to scatterplotMatrix() (suggstion of Antoine Lizee). o export linearHypothesis.default() for use in other packages (suggestion of Achim Zeileis). o small changes and fixes. Changes to Version 2.0-18 o Bug fix to boot with type="residual" o Added densityPlot() function. Changes to Version 2.0-17 o Add a variable to AMSsurvey. o Fix to residualPlots to compute lack of fit tests with missing values and glms. o Fix to residualPlots with a 0/1 variable not declared a factor. o Boxplot() now works properly with at argument passed to boxplot() via ... (contribution of Steve Ellison). o qqPlot.lm() now works with "aov" objects (fixing problem reported by Thomas Burk). o Small fixes to code and docs. Changes to Version 2.0-16 o Fixed bug in printing of hypotheses by linearHypothesis(), where numeric constants of the form 1.* or -1.* were printed incorrectly (reported by Johannes Kutsam). o Fixed a bug in showLabels() with multiple groups in the scatterplot() and scatterplotMatrix() function. o linearHypothesisTest() now tolerates newlines and tabs in hypotheses (suggestion of David Hugh-Jones). o two bugs fixed in Boot() (found by David Pain) changed argument f to f. in bootCase(). o summary.Boot(), confint.Boot() and hist.Boot() handle aliases correctly. o Boxplot.formula() now accepts more than one conditioning variable (suggestion of Christina Yassouridis). O Boxplot() now properly handles at argument passed through via ... to boxplot() (contribution of Steve Ellison). o Small fixes. Changes to Version 2.0-15 o Added an argument coef. to linearHypothesis so tests of the linear hypohtesis form can be computed without reference to a fitted model o Added a linearHypothesis.nlsList method o Added an nls method for Boot o Recode() introduced as alias for recode() to avoid name clash with Hmisc. o residualPlots for glms now ignore starting values for the computing algorithm when computing lack of fit tests; starting values previously caused an error. o Marginal Model Plots now allow conditioning on a categorical variable. Changes to Version 2.0-14 o Smoothers now given as arguments to scatterplot(), scatterplotMatrix(), residualPlots() and other functions; gamLine(), loessLine() (default), and quantregLine() smoothers provided. o linearHypothesis.mer() and Anova.mer() now consistent with pbkrtest version 0.3-2. o Small changes and fixes. Changes to Version 2.0-13 o Added point marking (id.n, etc.) to dataEllipse o Changed the default for id.method with the invTranPlot to "x". o The ncvTest has been rewritten for stability, and unneeded 'data', 'subset' and 'na.action' argument have been removed o Added new function 'Boot' that is a simple front-end to boot::boot that will be useful when bootstrapping regression models. Implemented for lm and glm, but this is likely to work for many other S3 regression models with and 'update' method, 'subset' argument. o Fixed bug in 'compareCoefs' with non-full rank models o Modified 'bootCase' to return a matrix of class c("bootCase", "matrix") so generic functions can be written to summarize these objects. o Minor changes to the returned value of showLabels to give both the label and the corresponding row number. showLabels documentation tweaked. o Improved handling of center.pch argument to ellipse() (suggestion of Rob Kushler). o New test argument for linearHypothesis.mer() and test.statistic argument for Anova.mer() for F-tests with Kenward/Roger df, provided by pbkrtest package. o Anova.mlm() now will do univariate repeated-measures ANOVA even if the error SSP matrix is singular. o hccm() will now accept a weighted linear models (suggestion of Stefan Holst Bache). o deltaMethod.default() now applies coef() and vcov() to a model for which these are supported (generalizing a suggestion by Scott Kostyshak). o Fixed handling of labels argument in scatterplot.formula() and scatterplotMatrix.formula(). o Fixed qqPlot.default() so that it honors line="none" (bug reported by Rob Kushler). o Added new default method for confidenceEllipse(), which now can construct confidence ellipses for linear functions of coefficients. o globalVariables() called for R 2.15.1 or later. o Fixed bug in logit() when percents=TRUE and largest percent is 1 (reported by Eric Goodwin). o Added radius argument to scatter3d() (suggestion of Antonino Messina). o Fixed spurious errors message in scatter3d() when groups present but surface=FALSE (reported by David L. Carlson). Changes to Version 2.0-12 o modified compareCoefs to support any S4 object with that responds to the 'coefs' and 'vcov' methods (suggestion of David Hugh-Jones). o fixed bug in deltaMethod.surveg and deltaMethod.coxph to all use of the 'parameterNames' argument. o compareCoefs: added an argument 'print' to suppress printing output. Added support for 'lme' objects. o fixed xlab, ylab arguments and added dfn argument to confidenceEllipse() (suggestions of Michael Friendly). o moved survival from Depends to Suggests (request of Michael Friendly); added survey to Suggests. o added Anova.svyglm and linearHypothesis.svyglm. o fixed bug in linearHypothesis() that affected printing of some hypotheses (reported by Arne Henningsen). o fixed bug in Anova() for GLMs when F-test used with na.exclude. o package now byte-compiled. Changes to Version 2.0-11 o the arguments to deltaMethod have changed, with parameterPrefix replaced by parameterNames. See documentation for useage. o deltaMethod methods for lmList, nlsList, and mer objects have been added. The syntax for the multinom method has been improved. o the 'layout' argument is used in several graphical functions to determine the layout of multiple graphs within the same graphical window. Setting layout=NA in these functions suppresses this behavior and the user can set the layout outside the function (suggested by Steve Milborrow) o compareCoefs() works with 'mer' objects created by lme4 o avPlot() now will optionally plot concentration ellipses; avPlot() and avPlots() invisibly return coordinates (suggested by Michael Friendly, with contributed code). o dataEllipse() now allows combination of add=FALSE and plot.points=FALSE (suggested by Michael Friendly, with contributed code); the ellipse functions have acquired a "draw" argument, which can be used to suppress graphical output (suggestion of Benoit Bruneau). o ellipse(), confidenceEllipse(), and dataEllipse() return coordinates invisibly (suggested by Michael Friendly, with contributed code). o fixed bug in printed representation of hypotheses with numbers starting with "-1" or "+1" (e.g., "-10") by linearHypothesis() (reported by Vincent Arel-Bundock). o local version of fixef() to avoid lme4/nlme conflicts that surfaced in some situations with Anova(). o changed order of columns in ANOVA tables for mixed models to make them consistent with other models. Changes to Version 2.0-10 o changed tukeyNonaddTest to be sure the test exists. o changed the default in residualPlots for AsIs from FALSE to TRUE. o improved color choice in scatterplot and scatterplotMatrix (at suggestion of Dan Putler). o moved up ... argument in qqPlot.default (suggestion of Peter Ehlers). o changed label on marginal model plot for generalized linear models verses fitted values to 'fitted values' rather than the incorrect 'Linear predictor" o mmp now passes graphical parameters to par o mmps now works correctly with 'gam' models (mgcv package) o modified bootCase to work with multivariate lm objects Changes to Version 2.0-9 o added Anova and linearHypothesis methods for mixed-effects model objects created by lmer in lme4 and lme in nlme. o added matchCoefs, convenience function to use with linearHypothesis. o scatterplot makes parallel boxplots, calling Boxplot, when x is a factor. o mmps (marginal model plots) works better with multidimensional terms like splines and polynomials, and permits plotting against terms in the data frame but not in the model formula. AsIs argument removed. o residualPlots handles matrix-predictors similarly to mmps, above. o recode allows the recode-specification string to be split over more than one line. o small fixes to Anova.multinom, Anova.polr, and leveneTest. Changes to Version 2.0-8 o added optional argument legend.coords to scatterplot to place legend (after question by Blaine Maley). o bug fixes to powerTransform and residualPlots. Changes to Version 2.0-7 o added fill and fill.alpha arguments to ellipse, etc., for translucent filled ellipses (suggested by Michael Friendly). o fixed bug in recode, when a legitimate string includes the characters "else" (reported by Gustaf Rydevik). o carWeb() now works with web site for the R Companion, Second Edition. Changes to Version 2.0-6 o change influenceIndexPlots to used type="h" rather than type="l". o added surface.alpha and ellipsoid.alpha arguments to scatter3d. Changes to Version 2.0-5 o add xlab and ylab arguments to avPlots, crPlots, ceresPlots, etc., to override default labeling if desired. o fix col and col.lines arguments in avPlots, crPlots, ceresPlots, etc., so graphical functions work the same way. o confidenceEllipse.lm and .glm now have add argument, courtesy of Rafael Laboissiere. o small fixes to docs. Changes to Version 2.0-4 o fix col argument to work to set point colors with residualPlots, leveragePlots, invTranPlot, marginalModelPlots Changes to Version 2.0-3 o coefTable() changed to compareCoefs() to avoid name clash with the miscTools package (reported Arne Henningsen). o Small changes. Changes to Version 2.0-2 o leaps package demoted from Depends to Suggests to avoid problem for Debian (reported by Dirk Eddelbuettel). Changes to Version 2.0-1 o No longer export non-standard coef.multinom() (problem reported by Brian Ripley, Achim Zeileis). Changes to Version 2.0-0 o Functions renamed to camel case. o New functions: bootCase(), Boxplot(), deltaMethod(), inverseResponsePlot(), invTranPlot(), various transformation functions o Reworked (or renamed): Anova(), avPlots(), boxCoxVariable(), boxTidwell(), ceresPlots(), crPlots(), durbinWatsonTest(), hccm(), influencePlot(), leveneTest(), leveragePlots(), linearHypothesis(), ncvTest(), outlierTest(), qqPlot(), regLine(), scatterplot(), scatterplotMatrix(), spreadLevelPlot(), transformation-axis functions, vif(). o Removed: Ask(), box.cox.powers(), box.cox(), cookd(), n.bins(). o Added WeightLoss data set (courtesy of Michael Friendly). o Utility functions no longer exported; some removed. o Most moved, renamed, removed functions retained as deprecated functions. o Improvements to linearHypothesis(), thanks to Achim Zeileis. o Small changes. Changes to Version 1.0-0 o Added functions for effects plots [see help(effect)]. o Edited .Rd files to use \method{} for generics. o Changed some F's to f's o Modified durbin.watson to allow directional alternative hypotheses Changes to Version 1.0-1 o Reworked glm methods for Anova for type II LR and F tests to avoid scoping issues produced by use of update. o Added reset.par argument to scatterplot.default to allow addition of graphical elements to the plot. o The generic function Var and its methods are deprecated, in favour of vcov, now in the base package. Changes to Version 1.0-2 o The fitted line can be suppressed in qq.plot. o ceres.plots can now handle models that include transformed predictors -- e.g., log(x), I(x^2). o Fixed bug in Anova which caused it to fail calculating type-II F or LR tests for glms in certain circumstances. (Bug introduced in version 1.0-1.) o Made arguments of method functions consistent with generics (mostly adding ... to methods). o Fixed a bug in plot.effect which caused nonalphabetical orderings of factor levels to be lost; added arguments cex, xlim, and ylim to plot.effect. o Modified effect to permit computing effects for terms not in the model or with higher-order relatives in the model. o Added functions contr.Treatment, contr.Sum, and contr.Helmert; see help(Contrasts). o Added Burt.txt data set (to go with Burt.Rd documentation file already there). o Added Arrests.txt data set. o Fixed an error in hccm.lm which produced incorrect values for the "hc1", "hc2", and "hc3" corrections; added "hc4" correction. o Modified influence.glm to handle 0 prior weights; changes to influence.lm and influence.glm to insure compatibility with R 1.7.0. o removed quietly=TRUE from several calls to require(), to avoid invisibly altering the search path. Changes to Version 1.0-3 o All deletion diagnostics (with the exception of cookd) have been moved to the base package (as of R 1.7.0) and are removed from car; cookd now simply calls cooks.distance in the base package. o plot.effect modified was modified so that it can plot on the scale of the "link" function but label axes on the scale of the response. See ?plot.effect for details. Changes to Version 1.0-4 o Modified box.cox.powers to accept hypotheses to be tested. o Removed effect-display functions (to effects package). o Added warnings to Anova methods for F-tests in binomial and Poisson GLMs that the dispersion is estimated rather than taken as 1. Changes to Version 1.0-5 o Small changes to scatterplot and scatterplot.matrix to avoid "condition has length > 1" warnings. Changes to Version 1.0-6 o Print method for outlier.test no longer prints NA for Bonferroni p-values > 1; prints "> 1". Changes to Version 1.0-7 o More small changes to scatterplot to avoid "condition has length > 1" warnings. Changes to Version 1.0-8 o Small correction to documentation for recode. o Restored missing States data frame. o Small documentation changes to pass new package checks. Changes to Version 1.0-9 o vif now reports an error if the model has fewer than 2 terms (not counting the constant) o Small changes. Changes to Version 1.0-10 o scatterplot.formula made compatible with na.action=na.exclude. o Documentation corrections to satisfy package checks in R 1.9.0 (devel). Changes to Version 1.0-11 o More documentation fixes. o Fix to print method for outlier.test. Changes to Version 1.0-12 o Small fix to box.cox.powers to avoid inconsequential warnings. o Removed dependency on now nonexistent modreg package. o Moved levene.test and influence.plot functions to car from the Rcmdr package. o box.cox now reports an error when it cannot compute an automatic start. o Fixed bug in ceres.plot.lm that caused an error when the subset argument was used to exclude observations in fitting the model. o Changed ncv.test to allow weighted lm object (suggested by Sandy Weisberg). o scatterplot.matrix now passes ... argument to pairs (also suggested by Sandy Weisberg). Changes to Version 1.0-13 o Small changes to levene.test and box.cox.powers to make output compatible with version 0.9-10 of the Rcmdr package. Changes to Version 1.0-14 o cr.plots() ignored its span argument when variable was specified in the call (thanks to Christophe Pallier for pointing this out). o Added some(), which prints a few randomly selected elements (or rows) of an object. o Added Anova() methods for multinomial logistic regression [via multinom() in the nnet package], and for proportional-odds logistic regression [via polr() in the MASS package). o Made influence.plot() generic, with a method for lm objects that handles glm objects as well. Changes to Version 1.0-15 o Changed recode() to accommodate factor levels with spaces (suggested by Dan Putler). o Added cex* arguments to scatterplot() and scatterplot.matrix(), and a jitter argument to scatterplot (suggested by CG Pettersson). o Added symbox() function for selecting a transformation to symmetry (a modified version of a function contributed by Gregor Gorjanc). o ncv.test() modified so that it doesn't fail when the variance formula has a different pattern of NAs than the model formula (adapting a suggestion by Achim Zeileis). o Added argument to spread.level.plot.default() to optionally suppress point labels (suggested by Josyf Mychaleckyj). o vif() modified by Henric Nilsson to be applicable to generalized linear models and other models inheriting from class lm. Weighted linear models are now allowed. Changes to Version 1.0-16 o Modified to linear.hypothesis by Achim Zeleis to support alternative coefficient covariance-matrix estimators for linear models (via new vcov argument); to provide both chisquare and F tests for both linear and generalized-linear models (via new test argument); and to produce neater output (from both .lm and .glm methods). o Anova methods modified to work with new linear.hypothesis functions. Changes to Version 1.0-17 o Fixed a bug in scatterplot() that caused marginal boxplots to be incorrect when xlim or ylim arguments are supplied (pointed out by Erich Neuwirth). Changes to Version 1.0-18 o Restored print.chisq.test(), used by ncv.test() (which had been removed when linear.hypothesis was changed). o Fixed bug in recode() that could cause values with mixed letters and numbers to be treated incorrectly (reported by David Dailey and Tom Mulholland). Changes to Version 1.0-19 o Fix to linear.hypothesis.lm and linear.hypothesis.glm, which were printing long formulas awkwardly (thanks to Henric Nilsson). Changes to Version 1.0-20 o Major reworking of linear.hypothesis (mostly due to Achim Zeleis) (1) to allow symbollic specification of the hypothesis, and (2) to provide a default method that is applicable to any model for which coef and vcov methods exist (or, in the latter case, for which a coefficient-covariance matrix is supplied). o The car package now has a namespace. o Fixes to Anova.multinom and Anova.polr reflecting changes to multinom and polr (thanks Huaibao Feng for a bug report). o Added cex argument to qq.plot methods, suggested by Peter Ehlers. o Modified box.cox so that the power argument can be a vector, returning a matrix of transformed values, adapting code contributed by Spencer Graves (but implementing different behaviour than the one suggested by Spencer). o Added identity.cex and identify.col arguments to influence.plot, as suggested by John Wilkinson. o Data sets are now provided as lazy data; Rd files updated to remove references to data() in examples. o Small modifications to documentation. Changes to Version 1.1-0 o New version of linear.hypothesis (mostly due to Achim Zeleis); some changes to other functions as a consequence. Changes to Version 1.1-1 o Small changes to scatterplot.matrix, adapting contribution of Richard Heiberger. o scatterplot now places the legend in the top margin rather than positioning it interactively. o Cleaned up links to help files in standard packages. Changes to Version 1.1-2 o Fixed small bug in linear.hypothesis() that caused the RHS to printed with NAs in some circumstances. Changes to Version 1.2-0 o vif now reports a more understandable error message when a coefficient in the model is aliased (thanks to a question posed by Ulrike Gr?mping). o recode now takes a levels argument (as suggested by Adrian Dusa). o Corrected diagonal panel functions local to scatterplot.matrix.default, which omitted ... argument (pointed out by Kurt Hornik and Brian Ripley). o New methods for multivariate-linear models (mlm objects) for linear.hypothesis and Anova. Added OBrienKaiser data set for examples. Changes to Version 1.2-1 o The name of the function influence.plot was changed to influencePlot to avoid confusion with the influence generic in the stats package. Changes to Version 1.2-2 o Bug fixed in the bc function (reported by Henric Nilsson). o Error in Bfox data set is now pointed out. o levene.test now checks that second argument is a factor. o Removed extended=FALSE argument to gsub() in some internal functions, since this argument is ignored when fixed=TRUE and generates a warning in R 2.6.0 (reported by Arne Henningsen). Changes to Version 1.2-3 o Replaced obsolete \non_function{} markup in Rd files (reported by Kurt Hornik). Changes to Version 1.2-4 o Avoid warnings in linear.hypothesis() produced by unnecessary use of extended = FALSE argument to strsplit() (problem reported by Alejandro Collantes Ch?vez-Costa). Changes to Version 1.2-5 o Fixed small bug in reg.line() (pointed out by Kurt Hornik). Changes to Version 1.2-5 o Improvements to linear.hypothesis.mlm() and Anova.mlm(), e.g., to detect deficient-rank error SSP matrices (as suggested by Ralf Goertz). o For models with only an intercept, Anova() with type="II" now substitutes equivalent type="III" tests (since the code for type="II" doesn't handle intercepts). This is especially useful for repeated-measures designs with only within-subjects factors (in response to a problem reported by Ralf Goertz). Changes to Version 1.2-7 o Added Mauchly tests for sphericity in repeated-measures designs to summary.Anova.mlm() (suggested by Ralf Goertz). Changes to Version 1.2-8 o HF eps > 1 is now set to 1 in adjusting df in summary.Anova.mlm(), consistent with the behaviour of anova.mlm() (suggested by Ralf Goertz). o Fixed bug in summary.Anova.mlm() that surfaced when all univariate repeated-measures tests have 1 df and hence GG and HF corrections don't apply to any of the tests (reported by Ralf Goertz). o levene.test() is now generic, contributed by Derek Ogle. o Small changes. Changes to Version 1.2-9 o Fixed bug in scatterplot() that left room for a legend even when legend.plot=FALSE (reported by David Carlson). o Allowed colours in col argument to scatterplot() to recycle (suggested by David Carlson). o verbose=TRUE in linear.hypothesis() now prints (in addition to previous output) the estimated value of the hypothesis (Oleksandr Perekhozhuk). Changes to Version 1.2-10 o Reworked Anova(), including adding default method and method for coxph objects. Changes to Version 1.2-11 o Bug fix to Anova(). o Small changes. Changes to Version 1.2-12 o Anova() now works properly with coxph objects with clusters. o Fixed bug in ncv.test.lm() that could cause the function to fail. o Small changes. Changes to Version 1.2-13 o influencePlot() optionally automatically identifies points with large Cook's Ds (suggested by Michael Friendly). o Fixed bug in recode() (reported by Andrew McFadden). o Small changes. Changes to Version 1.2-14 o Small correction to Chile data set. Changes to Version 1.2-15 o Small changes. car/data/0000755000175100001440000000000012215157012011742 5ustar hornikuserscar/data/Cowles.rda0000644000175100001440000000704012215160035013666 0ustar hornikusersBZh91AY&SYLS9L$ @/'_BU$IBRHπCDB""L&@hJU?UJh4 P `0SU?ҥIJiFMd?B"!Ѧ=TST#~ @d $~q%Y K `ZRB,,%%, UI -H`,D)$B$ HX%!QHBa! T E$ A)@  $E$T(H*P!Q($ !"B DQ"D*DT !*AR>9Dk''$  XI * U@HHE*DUXR!T*āUD *)DHHRT( @""$DR(H H*DH" J $$*$EH)b!HDR"Y `d<xPB[}`sϟ\_fژFw}BaMqM>$ÊL:,Jb@2(oTK@Ry.&:GWQjgJ%q5#Sz댚 S<lLߪ6]C. 2χ0\D-ۤiXߛϗĞnu^ݟ;Dc<{(tl'3I!LqU: iٵ5 ei4 ﰖNKC+l2[tH8AJ!|$o|ign"80uO57F;N6؞ f<9/dB¯/xP(ʞohB&gJMmF0>GN4,:LqIޠ\Ey\v+gezV9s3J852|e?|/yEeP+E*J!h7e},x).3C* uYLxgI.LJG@~A*8H$ ;w\ 6m3G4r[TC_7:9B J@M%2RGkڙQtKYf㙓J!(ygmA='zjW"b;b~׋/5hgs]==ғfdY.SŬًCz%iZN+;sz. ;F´cS]JKmmQ œ}XmBpwt1CGD1|, } K^֔ Y;kw}͹+[rKijc{Ub^Ք'pNl۷W Ouf}Y){a() XZpY4qp;Li\eؘFҗ|qS냿].@i6,.,ɒ+T9gK̤y;x뫋+g7lSmj-L%Fhg<٫)~.+W.8b2E_V"c kX[ {[YkXn5Q 7! M+SȗvOAJc$V꘏.Znf&6,sߔ| G٥SɄI"]B"xm9`hexzţ@w)^6fW`wp^d~vj,]6幭uլO_S?+9:8ek.\%{i(Ck b=klU`RbOT76蚴\ӄ(K2k(HtK΁>v魆󿉝H$[jg/a{4b6T(9mÕ>O c$zD,eP ĖP5RzߩIF=EZg6Y;6RlW`.َ>_&p>[aڒCd^7ɖRh|Lr/z2 [PJsǹr.)sՅ.{yJĴ\Cx2R"u [A~cUҮl~= B؄ _i!dO,׺qx ;sw];<ϢNN]:gF &(G S "62\MF fӵt`kLBq+W"t֍ ~;b}t Q'.a1b<&R)zcfbX_R?ü8_!wfma=F",I؏Ey^!֟MkӉf)x د ⽦ciد)N ub:L񳷉ugC/xyqϦϑ1A'1c,h<;puDcD,;ߊq)b1_Rh6dl;lp@647l!bjEEsyWol XM6l㓃n9OQՒ_ϧgnpz.8oMԙ᯷uyHcQ{O&v˲^P7}WԿccp<`p3Byncőaˀ=#$N <2Gms"ϲ>X1fA߬CA¦w<|G{SaOSL>=3Ğ~~d")# w,\1 5f:yKE<7tx7iOT?&醨it5W ԁ#]EmB0:-j Zp7~\KmF)ҨE,jRy+j5 ;5T#ߥrg-1ѷ;mmJ}ռc0 egc`/_{BhՒ%]-ۡ+K{$*T&+]%_ZRTWWOվr_$[\關KMt,Z!kJ~ofY;d-5r=WG 8+Fb car/data/Angell.rda0000644000175100001440000000161012215160034013630 0ustar hornikusersT[n1G( @B(B)0y@I _I8X`|̹N’s}=iOwrs㤜3I)'9] \JI>av-8A {0\䮐}2/#N`}wa %/_u𿆸 _e_*I#y~ps砟,g?|[y̍WMl|A9$4ko>MUGwg r^^u, "ȽFO?\GU]5+1u} @=O1|;au;H"-䣸ʏ_#.]/ṄawD/B߀D_EĽYO꡹=A-I|Hs *o`wvf<̄?\tj5AqHj`"D%YHlkEJӯIz|>0+$zFxþvw?[6Kg~m7czl4;0 q C57iyk?OvǀwO]<3g#X,g1oG8o xs}U2BaE):O ((ѫF>ÊRt *Pt ~I(U4cvBa(3h+~%Eo):H?]4UVRC{.{k|=] 8o;noy?)'h?ĘM z=/'OT7G Nvt^p<{ n?Gq ȫ|?}S>a ӣqos gag4kk1[̏{ncLt6'lkzz}̼Ts <ʯџ>|qoZvھp&o`9ݏYGF)w$I"$<~ $3h>7c4/G<8kcqkcߥ0&O7 }M!^D\ki |#.8<w ,dG@2^0ut^/zC>=+grCs/@z|K7 S=D6w'p9< apH|?'y?x$!ʛHqÏ{G t: @O}o9Xad} qjPӳњ[\@mkikN+x_, nr. `ͳ\(}ت}FO תּ6[O>/+k{PY%޳u soj4kSoW+ݒFOa?zQ.^Z Z2_Oռժӂ,ZUTK{{n?P{F]Ѭ?:ӣU-W!_^xV~| `qTwύfpC|`y+wt*N:2w|=u9[ոN v/[zt8mkaAxүې9_,p e^ ERP@x 12gEŽϸZc3^^0N\6H'8[Εⱓ,șe37yaV,W,< kgEN-4j1 U@9+ Y\5 e_Y酵`:N7i;ŗ)Y)f AQ#q|^29Y/,w)DRՖ& +h;]KZZ#yAzz{^.^+ңcƛr,>{Un8ee[n20XZ f;U~saK˺GqUgGeV{* XLH~tU{K-/0k@gH-G=Wx >v_Pd cǢ+.S7M+&#nmn3_8S bGf7~r7O6Dž&95=c: "Л# :WAPoMbpi7).YÛ7 <_(T#Z >Gϗҗv0jM?,TK9)>xunp !,6,i(,#PeٌJ6xXzny$M04[jvBYXY?7f¹P>UwRPEùϹΨd#J8 M`^SSY;BDt.̞&|)0:j'b1 iSw"iMҝ{HA[7'|gDi|:{RZRW -Iwv,,ÊWZ֜NJf֒>Cڽռ'H^T^֜|!o&fW}6Ee^CJ8pf;U`j=uͬ&}#5>ӌSA"ȉؘG 4՝RW>o& EŚh0vx F' 5XP lWrhsG7N3f~Ņ=h.?w1.w6 Ym -Somw@.(x3;^+9*e F$k mLr {ֹꍋtA=d+> RaTfc9GKX=r~Ę U0RL0""<(ળ=*N!YW+呅90!*>21|)km㔠Lهΰ_JWBbn'\o 5ӷIvO4}+'ey[L ][RlCƈ n)9 ߓПgao܂kz<]$J~ AvZd!lf]2. 6%D[7K( &w͚I( /e*7BP%Rvl4%¸q0v0ǔ.ªOJ:~Tp|{Ys8SE({ G&=myIvD|89tPoR&-"&RlUa$y1A]T0!DGV BsgOI^NqNo)" %F^{ b-?=GUg+8U:Б:2vuz2'*"i sƔƳSG]~4Fu|J*O:}0ibn}n{\+H1Ν6ԉ.ʹD=j`*vB17O3ɴ`إbM8z!OKz/.Azbi˲}}qvHu^C|/*Az0&O;8^ Yh:u$t7l Lgx> NSRmXAѰrrIzoHx5|ș^+^d)gs%puc3,]v|L7F)(00ŋ CXzpZtV\(l@%jpn%FwaZfV2KG1TrQvc=-(=a|,+)Eoy30=x=f>Kb;}C#όB)|GS,ѫHNJ#TД==⽹s#P4t򛴚S™J'܉۱@B2nhS@lY=_К!:6\8B>2hM!4vo@P}]rLP!tL!(f:e 201tJ' KG5b'HÕW,*ʘ%J:%"'HNiiGQ&j7X ?lKj~j+(L/gI[h,SuSPKP|'a~e%X*G&D@/vt*d4畺H$8]8}JyW=9_!cˎ&Fކq4K?ɥYA"]y-TD&quN tEru"m$- ϱT뫆z0 m#UQȂSm y]t*o{7KclIǎ;NbY^~Αt9Ђ@Z9(uHVX]u UF^ בs ᒇ:y =i^}BK!G6MQsB|9쭐NqUOG'\sCir*`C1!ۤ61)> j#_[i>^%g4sUz萭`Js?ƃy: $Qi ]$wjp\[Ers/ϝafZ E_/D1`K qk ԛAa }jWk*d? yl#0ij 7T.o~\!\ sIHJe >8bwV.*I!P"/#}WKo#3 1>S;IoZƁL { 5h/'V` weK \`'ֳ":<%On$IJBWFb98 sҧRBQgC|> dz_CVQ/v=>?~1Dl9ɱW^vXož1.*Wd6!ٓ$ؖpV*Z4\I8+\s#?ov|qvxnrL?OT)ziq~nBBlS4y[ EIAZU- I&o1ȗ|) A~lĐs%ňP mڐЬu|1ZfB.+-MP !k񀔩ǡ31O ~M}9B@&I -q J} 0pU0 $$}(;#26ǣ%i}}g:Zk.JR =}C?u9rPh!&9}EQ'6"(QX_!š˔3y`m+MR˶],+cG&,DUt5F}0y놀~o=1]FW'\z*xJUU'ii/Pl Z7xHhgvT-iEVKPt^'/ɏd 2 Ӧ`0+wtK i*tAx^ O:<{2,LjB^|2DUaQ.ziQ0zƬOY,F\[S)8~ -p\szڭ7!dw㌸S;z;={s1F@:Sv;t/a7QYƲM tqܿw*W,>suZ(\~VJ)DzPq#XaŢFuij/ض-;Lء! *蕞Ck҉g rm sssqJG콳z lCZ q?C㕔4:Ǝ2%nK&.zvWeoX*[5 $:K| T.?=Sp4|#f EK> },}IԂ̃wX3a\PLP&)*[Ÿႎ[G!+s>OU ˗JNFc_b}iH$tFw`ˎV}'-fXt\?dLr(* 8w/ zaӈ-bؒ{ x,)"*ڤ̅_;0ZSRLB~9B/+‰4<_8J^<9oH:hzͿ4 Yι\y%;=} VU&l(&`HN늤RW,sOF?o0 U4n 2" c8w7ٲ &3EJXLhUWT=BEth=9?[@[Ӟ&WIԒi48BW>6*߀qX.taoOT}d;Q鞪Fi(Jتi 擙o`2Mr$uvc$qqɐ q9AmN_dPY]#+2VU%1F·`Cfy}҈9]֡8i렂Z87鶦XJp:Uъ45G67oF&".YQ1ᅺN+(N I\^ ;LϙH" &򪀰E^)cLsZE$nn@1:t8T @#<6Y)PEW@\$6%QP۹tӢ0Uz9c4.%fnj9/$<5u@5C/OưA 4 zoQtн%ɢ O =lߊdG-s^GPkG}]J_:j Ү_h59 neWx lx$[p+yK}́=[I*!mYx*eIֹfn-d{G|D 14c%~4 v31ehi<۰L :d d}vmx9NT3," rn|e~`O`$݋pi{XH/:1j*N0+^GVMen5`=]\#ȳ0j^ o79=|,XƹGt[+QfH_-(F>sy 9#ϯ8]9`i@+?GѹeGf0i?)+I-~M@"h;9+&l^I'Btsb^jgd4u5IGBW(dK1I\Oÿ<$)Q1`=G]O .Hl e Y6a-`D+ˈEzYjm뿙HyD^ۍfn x7h-32Y?eLKI {8"bӢC!;]!64};"dA 9ݹ9A|_[=һJc(Y$dbq"2K 7cyr/ H){vr^II27 9*>3:Bf:pu>;ZshfQbrCPߣF|mszIPQaA+ vw8{[ukPJ`fB7c NϝC{Ba-5ܜPMqge4ƁϢ[9Qr`EDZP"[ Fx5$5Hm9\8=]Ic.~k *N6kS@1([#q8o Gapomp嵟 0~UK)z]H@L ~B75cJڧs2Z8r Gԗ(x!bt!}n&pgyNYVRR ½y6n'F;GǗw:dmdm3lM zhTp 뀔[\p.NoFA\131Ў4wJ:uv ːC:WRUh/U.2ƺZ:&D ld - N_/ g ԉxRTIW0΃: y*./ТU@I\TDgL߱7p4KmrU_!h_eRv^,ds?޺c{ *tT ~pF6K(&40X9J ][xH1v "c^6L'1t୅ȸbY㗓U[d1q[1;FG`1O  w2'H$0 =ZAĠ0ф7XM5) ^'3qvK\7V`xP-">)U)W_-YLWrԃY9%Q;HLz~vE~7&Wq2_GUנD *0Ll9XIJ {uu''f?~&jo>0 $j}LbuR5PFF=顧TDrTF5CSN;D7f#He UlчdJ& DL-H`bau$ T"hUw25v!v |]\DSDs` { kd%Qk*| ~~vҵ pPhեdٳҌ+cbG=ͿhQd{t TȔkcO0|t DՓFGH(HpkĂs(aw2 E(IVTck洰 jC0* TLͷinwD/<׎%vbe{qG;R (T@Glޑ'%3 i~'z]$#=\esĻD[]a yJ&'ۖ> $IgeA>/K щ͛q/[|E\=a/4ZŒxoޯt 7mTOMxUȫ~s/Sx/])TR>R0m.(vy PgȔ8nঌX`DNfϓ 6pip1%!0a,lub% Bn34$I B2n}iU&4OfE vd!E!iq}N ;g5o|rT*?vq7a(A;ܫ*@ ޵d{XϢEPm~*%O_iKo9o:)ײC/w0K!aNRLoj5:*gnfTI1{ϕŜ;8KswQk{" mvZԟ< q3Hu(|*`#>U'8'xG81F4235j+JFSN(FXxP;}̓5\l[0JF$Ik3ՙCWs#fl`+ڍSS=S\LE7T:t1aIџ >:rw蛓>5oMSAV*82^k,cMT/hiX6 :8k>=pHXi|"$Jwe8mmۆ l#]Әc7P,j8$s{HSc٧.>Pi7 'p8.l*nBDhV;]ewA={K-DA&<+BN|`u@ F|zf p\ @q$7Pno:uy-L7ſS!Gۊ D cG-kZ -U|B< wAdbfpb XɅs)]rck Z=*Ns}_/ԖQy͇WП)7rfԚtZ*&YآDJv\6dkB.y`qN<#9_72_-=0A65" ]uvFŕH6#FWӉAgP3@j,0>Aܨ"1SÊVG̷9,ӏ^C#‘3XzmyoK'87W*+:\:sjYMAm]SSoh0byڨN-`%La}C|KqD;LR5;WO5@.;ȚB6*8[Kz/F&nOɖXd-"Gx}[I&E&#WrinЏeEIs@0ջi`Z2KW~w 7hf }gdE zGδ|@6!O4;yAYu Qȶ#w D%,hP; 9BGL]0jꬷL4qv"v4yag ҾT ;ZC/>5cIW|d( UCm= X84]4 p]`#f8 *ȅ#GCO~%!R? (GlK $<P\jlycme*8"#<~ a}=3 ZxS%>hDHx1#PUunW$c#IVn]مbGfzMrz 2d@*{]>esnҤg_W֓73km!^ `\ @ȒgJP1<{GvG3Ĺ؂"VHh^j+x9㌼z'$n+r4FZC֠/%J)c_ޖɰz~?"<[7GR5 Pfs؄B9v(HDpjK^”'>eT "/F+Ebڭ[SK&ѻAtlJ\IZb~/ح5"ֲ>Q=VAϰ \F9[ˢ+jAjP 7}u{݅( yc;n+PJ;G|Y9lS%KM_J6 Y|GL$j 6-`ն귁/HayM}>2qVJ#.i&E0ݠ>޳8z%{z8]ԪH&fFlf+`E؇!9޲iNCUJ~y/lI9o(I?jQ[{Ţ2-u , DMQʬv2;j}XLfngv#h櫨OQ=X- kC~9E'"^4 Sڰ 5I0JQpZ6?P+e%j+DrRω 7}VJ[_L3-C":Gh/&q矠]N3bo+0#J=YgQN^ZRp{ ?劇O9JЌrlc{BE#-րboez@c*.'݊?Si p_ }S R-ijܓ@hd|ʌe NeE|ｃqQ603=Ƞ}~˰EPr%._3)aߎȺ&?"墚Cnʢ PmZ pY̶ ;TM%c6X\xw5d [VYh_# #X!{&&nY0d!MxFTx8H[7 v~A+Tk-5WD0ɕ-' $t2@b! xnm6rfu<|-"'{ר7rr 4l9 /FYQ$KkV/T% "kgM?n6c3 ~O͋ILO@ n* P L #1Fyn\B}e eR }`SΎɫ#,f2]Dq\MVX1 ŸLC-V?x *22nB"ې"jV#ß v~)@ZYml}1竨qR>9 8?&` "kjg,8dnz ,)Fh.pޙ14&$c.@jJ枏Xԓ UWHL~ D2n`A]D@4YUZc֪ROY!24JAH*}KжS´b>nZ$ؑ.f>zv|9F& MLh⨮̹pzk;~`HQ>+1NzH4Q'ؽ){ynPaBQF.\ Q&!MeYa,S>mx P~ of@N b!K#"S%kPeB`P'.=IFPg0n/x#వh( h瘵dꇒ&ߧ>a|WrsR 34+*p0gbO>!gEQ[K&k SbW% )JVDh V]Su"ʅK}n}݋:D^fڵ'=}ZfCJ#F_moQZcj;Ŝ BN&ZJ,v'20ZiV|CMzJ@O#MN,8И>? ՝nq6#P?TWCnp"T]HL:_\z){QxD5djg+ `(S8&3d-.4ovs $ Rc +(wEJ qQ&4C.7QD@{6_=[J!Kk Bst锔y0cRp9zUЂ&㶻_:ӛI |BwFÍDž׆ϻ˿'4A2_5ZjPȚFPT_z]CwȄUO'Cǜ@m\ r)hM«M2c>fA\'R5x蒝viꆠ9sⲐr5fF꧕~Cnd|MЯ\ d?LG8@gc!}89Ҏ+/@nB.WZ@kEP"ڪc?Q7 +#Wz6Vv eOǏV=`tC)l-!L^҉C5) Q_L:YQsͧ,]6B,oq7ËAQ ^8-p!E8, vp9 ` &ȿxuo⃞o3H"}Ouj< ,=oԂ6^C,%D#w4_Q[mwY/Pb0e$@;iR'y8TjVTlTy`BķPjxv[Fn2|>'Fg۴U"ʲe>8'M|vN߸¢НÅhtTi՘JTCy+kbL$%*3PO1,%zˆ:)uiO/RTZ aSb8uwD~V'dCZ ( vBxh?ρ~$Ȇn(Oƻ$|/b(1V8s)ܕCY2<2|a~_{& [N o9VS(hЦGqXG8ViDhv gnQ4EdmgѓU0Z L|NȗĶ'I7/:9|C:ldmQq9'CKc@>%reKZPt(YrvRr˃en^z?ϗԣ_pM?o[vy/0M3ƅ-|kh02ϻ:dm4{ m7tm“2G$ɸ$ν~i?/3b1gMPS?T(ɶ hRƗ$v:C/rU$&cm? ]jR5PŞ3 PPh(FKj|ǻ*7/&wATU_5Fvhч{\ Zׇ.*tisK3ži7 غh(iԝMghܶ;Sb!UڞYJ[&̑%RKx F'@Ό \R7D^YuP}6̍===iq=EuF2cP=1*6p ȑ^DU3 f.ï` 1MВ'%h&T`t1:oxLBsIxh'I:EaYeTi!Ͻ&qŠҜ[nLԓ;x JP\\t]gU_r =<D y|&iաy}]cj6[GvNv)#V]R=<}eQ,[$mne19S5;8mv$bFдx?ҔBB^H sMeڝ$מi*ZW}q`;E =L$Ie P1~GA?|n}Fʊ߽qrWa´rgIF@%5^ @FLo (χ ݿ@7ǣdYgz)U /.Pe^L76V5sdʯG~L;k3gzV4,vu^P 6FPlP5:T>v!2&:5:ЧVJ1|\2s6gtzYȂSkmF@XIכ6Cj~ˁT5}<Du`p9Ewܗ`1݂8[+`Ӣ[<?4=Ѫa|SƘz I@#Y ix1:pQUm^Ec}dr?1 ]§(s wa7>\@5_kY.+yph0ՁtaHrZ!/t',)SA7{aĴ풬 ]<^ێՂ0jG<_Mc$KNw1>\A0;VӉyfEdN%t IYξCK[2д 0lqjDNl(Flz'\%M!ɰ4p>sFE\V5U.T krΨ r%AmF_ِlǨH7!:zC¤L[&E/Fn}VYT#ݷ*YH (+oRSn q4zݒ< dXKſFZgU*Œ$z̳.du[˴_d}q]u[|q`w6h{.œA#rO  %ز] РD X%}=$mСzHrُ>PF:-ʀzyuI #wO3puhMahw04xB{^MWX]f$$zj9~y#_լtDK:IXWl= Z1kNJXOX-`^h5{F qIuphAKq^ `-Up$WVjGI0H袧 {X#}psCc'8'RoZdS<VZϢ2;@Rl1U~P$7Gth9ű7 ЈfuA53VA.b<1(-*.z ĉ6.F(emzL,u+J}VѓD1)x¦0U-pҦ,s@]uoĶTw׾dpE)Rjp}g]ݒ(%TYtPA;{v3֦#HA7StXlLRꪌ^޼Yqw^4"J+ YVp R:W Ȼ}z\  nx zE&kvuiO!ئETV@ +#A.U+i7kk) ED]pl+7>cP94[U88YK.XkǨl2/IJf!se|<60o>(9ėkKY*}y5FhyJs_I{IM8<~$M^l|:QXC̫n/UԞs-'~TzDZM(]7w}gT' ( t@|8aqE-#WڕCuDg;0`ccsy~`lP;AKE,Nb)ln՟~ysywb,~zfVv=LVedK3D׭x.R,Wem2v>v0ɪKᡐ U)UlJ1ESD|]^vzJ y4z~CXHns|^{=$^rNZ@ ,0S1^g;tH$n(尞6gEVi+ɥGR 9 M<1@C:lH8XBR2/,HFjR+C|^G.@m?4u[i{DO<ڦ/Z H>ioV,,QE,%~JSA%^'"o^JIV&;8M]h9*p@#=|O=EF_do'rpR9>)ù|{-R* 獓$nﳌ̩ό>of'J|I<ճŠM&mZJYt(XAY^ݸ8K*~C ]䢰6PPyS@a7==#,EZmqKszkAѨ[/enTM)-#Le?vU~6F9uܛ- PQv˵luꋰ&)=3\3caJ]Ae5&eԗ{MsDOc}W,qaehTT ߸gY~y`H,IaNW`$ y v2l_$5H=sꃬ0i\DTj}[9įޕ_-x[F?0 ΀4] _D9T;Sz(󙃳a./ {ԻӂkY"{+4PyGsq>(NDлvQ&%4ǂSm,_N >pk{PԜ{+J~Nv~-0hL ي} "LA&W}ha!Rol;Z&WnMi_!dkHq ‰pG "$nUnBͻUm(^vUMUcoCiƽQOq+-o;vjB/X/[=i'h}YFw_PĬ p9ZG#a3.WM޻ ݄W (GhszdC-TQG9$37bEu8ӯ_ٸ^br,P](4 g3݀jc処CnHR;ɹR1R," fK<NT.-CR#P>;;cKv;P{G2Yqe{+ tYWe,H`8Rl`zrtQ2&lPQΞ%oq1P^]Z,兆X/=n@:(B=\M!u8'2iP#oRonHJ'EPx3l$26xc11`Ni+usNfX߁%MqtŘ[XFl^rNFX?h"Y"ߺ˩i<=Ԇ_WzZ:Uq@4:w|~ AoO pѤ{@מټ3yzչ#;?QPn{= sbw5ߤ22+y> GcLj􀑻5LÛx^z62K4C4]یF4|E6*(66W Ncl.^R:O6)ڦ֓wcT[My/8SI7E0ib4llq)e 6)gpIG6c9^Y 4BLL2iHs!\_/HSc2㢫KYkPO?BsiA mU2G8,aI[-›8"[k$.6i6xyVnQxy{^2Q&#KKV({<ųI7(́r}b]К(%1,>1_ˡ4#՗+9_]i q.n>BţUe}TٷqIEu’17{f i41=2Ûզt2 ɥ#'Iִ':pek-x~#v5 rH1SPUiIh:*"$w7մ"p#,,[xv[l(2Fg،WTU)!=s!pnfD5,)ab: ŕ˷ji=' U oZ^ĜD)M,ڛ-tiҋs-$ԢV:_ Ԧ]RSMqײ83;ZA&0 EKme+0T-u/rΩ`֫ o ١V%C_؞] ΨyE1 ޮ1Pu,Ԋoz%_|8:ձlIve,I$9@u!Ê>^kmTuJeiZM$%V+:kVT` Җ:)dqZWuDk,yjy91l<~r'IHhee&h!/IݴGukr2] -9s;Xrj 6i`#wRFnK&Ms,.fHGF$*ss9߯BZ.j!*Zu@㹋L2rRw;;E դ;Aً*ceP/pZҏrH,ewɍ#ae/44ًhwoǑҎ&1I%(5YI٪Y{ y68Z>q 9;M{ASG ǛZM>QT'z>00ֹ?|^ X%+Y'YĩBsGᯏ.Ӕ3r$YW Y V+u[}J=:<3&gK(ء{j}/ h Lmۨ)'|l2 լ^*]sd߲OJ_q5F &M錇0 YZcar/data/Wool.rda0000644000175100001440000000041212215160037013350 0ustar hornikusers r0b```b`f`d`b2Y# ', b1/K/˜QG@œH SK N b#:v2-U8Aī Xۀѱ 740n gS~M^ H1cZ\%Ȇ2de%W&X 3 &ȕXVM9gQ~~P@05?R@Qzcar/data/Chile.rda0000644000175100001440000005005012215160035013455 0ustar hornikusers7zXZi"6!XO])TW"nRʟsef,ť:~}2]bTEf(}BZ<`S}v}F%t3 0Fm7uw&$IDZo;4["Iꬲ\VPʙĺ+9U o Bi U,uKY&uZ9 mQkDΜ瀂M-EhCu^%%JkZ wRFWPciQ^g s X{Y.(]zҌ5.m-.dͦ &jL/$˪ dA n[` n7rBsYʌ+(dmu=ޗ+݋U6{Sje$0'/HCz"OIMQ^)7\㊂_ߥ1Sv5-|5h!8sL.X{{a9o͏[Uj8 YjY?71'y685]HQy65Ռ@x[+*|qV$7HO¿x\ ї1D}lCW1CN!xkG jkKYeM;U6PWRBAiZ$ϫcp w.VՀ켚8:L-J(R0C]|m0|@^\bS8SėA;m&;!Y#ↆ@M.[D"%ހ~)n#p:)\n00C4u`wz7Κ ;)g6N] C[M+O?L#As,ݔb.c8-Y!\%Z &eHr@uYg^-@0<uu|EzD]QC`/l4#`@9T>9xgfk|16 !F祬Mv4mbs&7%_}ztFŻ|l8Y$ƢȪ 4Jv- u4ϣvv.:=: Xn CXί|gm3 a09zږ@gS#eVΉe)K"ӠkYsWJjHfjm!Q4Bo/{CEhdm"DEPԓcg~|Z q 15&OdVܭ v, t伧TdMc{TYuT!䚫b"²Wј"BFh,oZlf]SۣN(1^c $‚beTh 9Ag*u &'owywem5ru >VmiJ` ޙ8*r6R[@pY>CKr׀rV~%Y^-%PHIhx2vm={֚w&Ky7mbuP$Dt_4u'eCJ0o5.0(gmYk/}XsaHbnQ#Gs~~.D/! ZmG]o] 8.:d=S3]^,z?yD,}DtLXKx(\-;x:A~=F-uB~G gf&BÄ4<C㫇ggGisQWq ZKQH]j>TJOLN׿*L6eR([&.yIS%7*qNhf)4|ԫ_z6LD<=YMz=X<3;s"fe y&g1vIv 푪BuȣH>E?Պ?}ſ ⟠Hz9BXP,Oz:܃h/Б苿Sa#.ҩ6oBS1[Ɉ͈~cTsӢufl"c9ARanܥZ) D,ɌIZruJTLLuøF"ץF2jW4yg?"5oC;K$h wC ؄O\G I"SPw$Ff]X,e&ӂx)H$]t%J~5Ʉz%  0KXA۾}U0]-+ @+x7Q6'|wm D^@}afakΐVBH*ooc:θᓾgV9pmiH C b EDW)WW:E,_EU{EenCCg{0dSAZMrх3tI&A'>$M#O҄ٙEEYSN]Dn1b@ꙐJAaSi{d iNmqVË)>˖gq͆I/hS}FGqs堨Ԭw_*2*/e6iy&T>;;GK~W{j$+"-kA2~!I$&lnLߞrN/~ߝrḂf+u}%o D\ J޻j.+Y`r"L,kOzOz #K)$N7+(J<a4'a?4k7>^F5xڬrul3CҜ"\Ȁm5h 4QPvwzp}p4VkK7eQRu)ʈ]-1팷0$l"HsI(]soZu.p/ߛt3}Lkt*t,Sh' y \.wCbG߾']j>ZM|2YO9^Ef 3?̌E{ ky„5Sќ}4 UBd/=#󍄃b/4ڈVRG:WlR_ښxb+_^Yzx`{ٓӣ+ɋR\0VҲ1tOeJGOYPKL^rĔ2E0q NFE M@T M>~DTI 21] 3A]+r8#VKLcCzVi$?]y|'Gtht$%>CuN)Ri2$|j0W5w$~9`aL;K 9Y ZtU߂ Bw֚!*YlwG)y\bwX݀3C/=g~Ed^!='xizeF4XRہeR53D̎ z:w{9Ĕ\ņ.>;ZLc46 0ӠDz_i/ů%J&CW9ynC7?m1y9Wo!rUcWTy@3s|o`Jy-})dO?"#,PQ+oc-fYDK: -E?i =lyn4`\|d/Q2f૷d4;&E*cGOb*^ߢ&"%"pꇫfHJ -U'>Pa+>J#6 Lz~Ho\gz,n)!{OJgh/.y?8Y'Ocz͝MӔ-g]QkTS7LрZWΦ~bth9 L1$I/=Grkc3f{os.D"uL 7Fz&xϱKI?E@?a ܐBHSZպ([2~6UGbE˔SM"yoYk|K3]eKP@Բp~D3k'L5FM(y- YAK:Y!vDfP ?+yG&a:gtܠxs/$*UhFS(> c*y4~b7]ih1e݉ 2.R|j KU"Bd"ornd*Zdq e 'X^Kz7}1nkAtI8iϥ@,+M̛ 4X nKf=^iJ_B^]Cj-Iĉo"qJNEoJr27CsztX[`[w'X[߱Wǀl0k>N40* A< : ܂?.(=^)/$Q=Uxڪ|Ɯ CҽJG۽e-px7t$hfMvˌj JLlF2ҜɗޘfKCh.{ëRIRֆp;c(*C n03MdH>\q uO*3Mq$ sE6#6,tNfy49M^)w?ϕ(&|Zv3)uRtk&;+a`~G2Gk`C$ӕlC%љhN /<=!_.ķbxM#H!psօ3hwОF:}& Yl*hk͂~_uDU fH}"SRQ۪ڠl!?}8͖6QMͬ RTZ0pDްlEյ=ña:;䑺4ߕd&7vIHqW醳x9nHq:sg, _t܄["$0ݳJn@Ja}FoⅵQk녪 79UBGlr]?t,MmG5îS[EGYC%j:_uZK+3_cv A T-;lj Bg P_6ei(EӣB/u26_u&Ңo͑iB?hث'+34gH/YP34 ^1s03Y31R_ʥoT`[8VҼ&ptvGTT>EpuWvtNjEujljlj?H㔓Vi"Su aV򹄨i3ruķO=>fDOJ}C'4"넦ok6PN)w Ԕ\^B!E&w'ހ g&!yn聱~ -}ItyL4r h/'#IaᨯikBqCquYP[trv6|u u~Mcmaey|WeP>'C7\fF nelۺF1Fo4~]<%߄F'\# }гz +,iNR2?NY 1@7[4o{z D)NRZ]ZZ9|fl7AI[j5b7afc hEјV-FJW]F͑"(0ӘRgbR}rv)w|>v"Q@S1P(lEo@eTF :=g^K"S+)a48;4~P˗ji㺻K!}OMi^QJm7ITX Ě=-˴ ĝPoމq9\-[{W 1.U?s?gk F1@STQ[lTl ^MM?&vq  cp,RSaƀaL(򌛸BlgygrƖBfT^Nu2Eh-,.R 6 ɌxM$>{F&\=22uy4Eyۣ~nLp;"D|sN`!2:VN?M&fB=Ż9s:iM`IŽh\wN]B:J;Ha:jJC1!7!*}W>EJZ5,z=NSK" ʶECKRRv#J34Mk0:T`TF'mh<ȁg* VT gd|+u[t݌ cXxqvGk*56Am;4pVkޘvlxȒn`ڇ:*+x[š)0d=ɜȫ-PL'U6>fiP!2Gj+" mNۣ?"€%D0l9cay@-(흮p$cj8O$Tr\#{&L#-:&?o$ѥUjϣ*q&)lӌhn+G׬ skWpr..@]LXU^dOO# ŕPyKt-sYP{ZttǔvPkKj!hzg땴דozy|Lx+s0RNO'P\J奚_Lٜd'`vxٶ @7 1:W؈Yl:Pz /t-XT$ŝ\Fۆv\O|= tPO2U =j!uizuBN5ekl\CDRiԲj Rj1nf7~S=DO"֭҅C2^y/id2kJ[~wBvJO'`C0RBž0 wfQkZf[b?^PfU<Ÿr (x)gLmFi4%Cc)g|7lԁxbAT5)ެ=#{M`k3!Jg*q9hFf'y? \f}ZCVU4a@=C&^q m-eYO2F Rk,q{v{8,n ^HuM{YRpei &7Dy mK&34B lVF%l~MAsG~VzK샎+1k.0lgymJ.i A[r89ƒkZx()'଻ݣkM kj$&Of3Mޤ#X/k$QG4O?}UG78T@ Z"|q 04"-/HW)ԣk̑ݎE":Z: _;dҩ- P*_ꞬżzaT*t?$62^zi"{?akx(@G̰ [#l[+`Ljh,iɡ"Wî׋EΣ 2c-)sp^9C}B 2{ʌy#`b%sT,6_tnLGsc+Z†+p'D*̈́Lo#Y%<x,սۥ Ņ3)O '?zjqV3c̯T5m fi2]&KEF5Tiwwz)vzH "j?&1I7XQŚ s鞆[-p(-18 JH[V&ZwKU3.'gу yF9#qjn;Kѽ%EF->NCd=Fj*~F]O9C,ӊJmJxdUؓnnCfzJ|2A{蛦rы $#f~܁ ɿ CoN ¯&wL2[=ڴh'^KFGjr! [&~;IvmI4ZqI[z>\#\H< coYv2ۣY ;@ˎ"Bb_H5%Ggj0t}Pj7_<­D'4"-l~,ryNTX+kJ* juѶ}{GXD4]lgYBh.8fQUՕez)+ϙc ,X++ى'zuvPG*QrIupq6 lgNĽ?Je-Ifb;Ycɤݏl$E?qǩO nrN9c8qK2禈K}uy A;~S8RA 9C(Blw0w2ߪEK}7 uPْlx+>l`Kz,&3""I/bbYlH,|u!$5jMkv3@K9V2㼋X4Ё 'zJ#! PZO8WDq`-@{|c9ă34W6#.҉\ C2}E UTp 庲&QIZ倸Hק{T k}vD媉Ƃ֣#✱6_~]'*J[꞉ʱ<fgme8Lىwێ6ܗNy*K0myHf5h%r{?oo O)FŨ6Diu9jf$&`]Q7!3(<0$XDB" YAe'%䑟uf"Иx0ĞqqjgA^wNtJ̺<?"X3Spq`%wPŏR*%n0q5 <'0JI䵁ɘ*ĥGi8,m4?_ׅlTPa{Z0SFGs]U{ìK9P"T@Ν2:vdfUCWY8tC8އ8cp& rkNQ@5;,"kOZiB=ߜN]h򧲞; e 畁c]b@ JOՂqMMN%=R,|/ҘtƷ$G_!PO`=ʺcIV _M%6q?cSE,5JM{.mq%`5s&0J'x\jO,YZ?^C}*[0aX{ΌU#cwZ?kw13me> HtEzjGBwj^1#*W3F9&WF&l]Tdt *ZDB7RqՃ%{DclMd qr 1VC ZV'*dfaP2`OaXׇH#gR, 5ˍu~no6DBMUf<&'I$R Tp'.E鋭_\)Klܕ]6fnMe;B-@&$ݪUުup~'@|0s?<E}ޚ{x@>v$Of@DB&]5-1$`j>һ 4nV%nި؏t} .T#p~;n *%.F 'sIz}k[\J{/30˙dfRfeϊ.,ZZmZv:(*QcdKsۚ fV5U XvK"%Pe2M+zK61 +l"#:!d@؈񾈔 so;Z9PPD^y(+Z"K6~rzo%6P?qmjghLãe@/61oΙxS/<:l ONdʎ7h# "riWî䔏B} [S7'k-An7 -vd&5_M2Z%b4M]jpՂ-zդ:0D, /'G| _8cNIt Zgeu|HX?"8ƒ_`sOA>*Gg+jCU9Ny(,~Pczc<$u2w{~Xj86~/ɗPT6EJ6M<'?LKᛐ˸J4rbj𽵙wkelC!bo2˓`?x hblUB2d|YP 5C&cF4ν>+'P:5mA8ྭTcR:Bt]s)?1.T=r=7aMJS ;>i8x`Hg!?{Wx_XrI=̕a`GN1U@I/H$5͢"cI Pܔ/='Op՞ZT_J DPWo5CO|-W\,- pX]]T*CTz?ȴiruRSifXC\; .8Pޙ(f>CƇ2 5vNR3ރeaH'e, 5.88XAwx W`P01vk/*षtBpX*h=3^e&E''X|G)0HU4WlC*j"l/єc'9YB=U.;ak(COVӜs%,\^^*R_[hE;\[B`Cq?xSC^]%,c2v).-K%j/Ҽ#SDi ڌNɓA,ۆ/rY3LGzx+B[7x5ڏoo+Q@_pHll_t({X" &[]I-g$88} 3nU>9ay"^vG2)%1!*,8u^r/nfqv;#$^O=$Ym_T'ܱUZ(SiX V{? б?o>dy>:Wz!Q˵'#O9l^~[39k d,^g7Kݮ$’j738][ =KMNH%N aOzSJ()JRhLgt& eƙak/.\1þdGŦ[=Ǚ[+̸kJz\-3٭*t8\Ηy8|m} iq=}5{@1_Š̀དྷ'/@˯Z~*=$Z3sf)PS`w7@fi8] L/t<p]DrY4F+;~41#| '9P͚W]tq!pbڇiȸmrlF|zL jΜ>k:媕uG1B=_Jg7c7׷ lh֝PYf@KA6kfR7Ω Bwr-QkAUv}ABS9!8CG<;XXKc gqAjϩ'iGU ֎aXv|u?촴2SO\a- _+{xeu&Nvg5`2NԺy WIWt/S% BYUmTb}]BޯkF1HH2 RόlB}ySJ[ CCuG}Xޓ}qMuj*ۭī:t)@/[ !c(H546 bZ*tF?]"ؼ쁧l1S+վp3V#N=ˆ! ({_ɮL_ Faܾ'Kp%TlrU3浐|6.RԌ tdBsU@wcL@mjz4 /r*(K׿Լq0snP֠Vmȶ-x+/Vdԃ;<7h&QKˆhe> /tDvbrrV!4B$9ԘӅ?]q F&/2;/!qS)pHk[,PBD\|DQ NewbqZAU$ZK=Ip9 E_-@^$wl! V5s@USpQڼ7 Zgo$ĸdX{O4b-_a%Rl F8zkړ~XUrۡlj#ӹ?պ ia)cQi\ӑp ;.RFɝ:S6#+^"H@fߊ"ajG4?"}4/? AX,3 ΁݇ՉA{m %SiT)%u^E>:4z={$|9.-}HlQ|xW?1πkĈ N^E C6Pd`Ps}ui5mKQ(b2)q"/坭1,imu3H Ot'S>}~8`y<$nl$ "<'n|BA|USg \ꑛzET'AdLzk1Q#pHA ߀t^ zqT׏;7T^ 7, ̈c;|xM &J%ټQF~XeN,C}ͫ DSFBg=AtJP<)Ok$(˜\,AMqxQLA$gCH,^bs0{_% no3wz$U[7ϼ_3?hsb8wLS&o*8 $Z<BRE(T3Rѻ΀6^c z?4BuL-= (ڵx%|7D]f7D嬬 )D1y2R 6wE\̯*5~[x2ewWZ $(Ixc& dI0dD='Oc ܛg w4K(mU}<#P%*rcV(eOV#](tooefw[[ LEܾ7.cĶۙaoc 2 =g$^Egb#!=]J7Dmk߅D[I5=hNT$'KVFqTRVhPP2\*M)\TEFbEBcB=YL}:2n8o^2-0$K '4lD8J#WntE4zsأvPF)BL?V$3gR T-YGvQ g'KN@ P':P.f xE+&~=jmØoH"k09WD#TB@Bo<%~vjr8>cYA觳̲\[Yz(d@LOo25It :wO //5&zŐ0^ܦ<jU,Bp}߹nP"@r̴@JSVa'RO%<+輫(+q QxCּKF~hf=՝{6-Lj׬X޽d '$'%)ptiO%.ۀ` ]N\xե4Q ]'ZtWQ8`ny^{z8kSX^Hb_un>NZ.P x~Ù.}x3-sbbLs,#^+ޤ..]ol)S|CE qbIX4mLO7z;>0 YZcar/data/Robey.rda0000644000175100001440000000142412215160035013512 0ustar hornikusersTmOA>JKyT01Řx/Q P@5ȷunm@'sef4~0M33s=8Z)8YgdϘsJtK;NvN20?%ܟq_ ?k#= )J> ] !Mi_q7!F2/Oչq5Yߪ:eIDc$%y{~X;I2ۓ<}d^<4gg+W ;$O>KMs؉Eh4:MMQ4Mk7w_OM}$~:Z2gL>ܲ#_L κFnLСA 8z 4=Y6A֡ 1Aw2T̙ )+[ngh-Ǘ*wzݘR&DjWW{R۔CR{^{;wAQU 6q._B;Q Yo@v9ƻfO>?>G:8 f}?qzJ8ڎRH61M9[ˆbtћ% y҇͗ˠGI;^J-B.0\ |}f gPQ:/84csj|Ufw0>_o2hbFn~|%2;Q3ړӑyug%B}p_~ᕼ/Ԫʗ5I)]p]h_49k a Uu'~$['-'I?UOơ!yCgԈ7M'-G!v2jг~0X"9DWͯn(׈QU쑧\[ܗ|OoxPZ.: j&kT,uLFrțWGU:DQ'|?GIKQ~i|h6Q吖M$-'T|U2kK!z7HnR?/lߘ8bW$n͒C2hں[wpP[2ؑd\GZ~a\ݩ}JA~~f{3湇!k7o}mE~%=Kw=Cϩf;ځcWOVc@۬a2x'=q%W=%>[7p_6Xuv@m2&,ʐu=tЖ7BNAӈ{PPlMޤ*(jD{K ۲9O1r?BՆ-aT}0McrT d  ԁG6hⰉ]a|z.jNjjL+P `?Գs/5Jկ7*E $$B$DIn~x>zc ,^id h7w<*]-wj$U? A2Ac;:*7X6𶝼!r򹃳e(T+ 3\\hҸ6oL9 gBU:]&7(}%Z1 *Ձ6Mq@+HǞgN]&a")W[Sx}Ѹh~"'Z@oxi?gQ߁᱃SdBǐ?@5vW5y. 7Xmǫł 6囀?`|G'tcpΏ>} W˧w] NAp㘑hs(Va)4Q/=>yhǹX(ϖ) 2W` i )OH`_ ޚz_SzӘ75GjŦ R@PPqQ. Oހ@u'㍇:9&uu]g/\?Aw]v;IP{;6\T?.ޕ |R̯1qVɧ<܅*KgOXB τO<áCE7+(W_sҸ6KσlyۃK 7@Kx䒨}fy\ʝ#C;[+٨ \t&0*IVw bR?2.de }̷IC;VmnczυBsѨKkWթ芖w#EePtҞAޚL5;dB6jC@1VkCު]71b ͡yd,wJFO6+O Bi.}Y~q5:l'&4Y i[w&@!^ '8M=5)Pũcĸib-:|'t{P573Ol2D+kCJ}8*Imj14$y⬛T shj kԊg@:zc ;aD^v/||~~ JIPd~?GTǁ&ƣ^|ݿQ|羋zRoɅtY>(Cƚ K_~"!H[ (\gIW|XꞳg | QS!@w DaĚh)/i 1a) 6.~ H*ɅB=ύH*iqed\raH .Cu]ޱuy,?ܣ:7t:jVMiNe5!z m|3A NriD@4AD gQ8 \ptnq˪$:+_:\E\`KDP2^ b KNhiAH Ob[HY/Z!t:K9#ffjHK[svٗ/Ex"nsbWnݵ3ڥO k39֧-P{\Y;  A=[7 gntr;4/q ܂!vȵg֣n̚['@e+5{ \jSuhٗghwR&UY%i~.kYIs \A\ɘh5X Ybec[)!9 3fy =ox8ҙ>Y&?~kbܰWͰwтD$ He_m aHck`kkIqO`$Zaѷz ,htLcѸԈ@RiQt>g5[|˾>z c%7.*EJݤ;DD6c[|oSJj5V.)FXfDavzjxUKNl[Cѕ2钙w1LˉR3U]KeekTSSk|eNQY M^(cXdӽ2=QnjIeS%7IJo#?|N\MUlؑ؂NA 0֩MZKJVRla*UJ%+P ɂ&—0\KƼķ2T4RGI'lWUf>B*u%Z :Mi 0NC$:^jzƪtJ:'B =PGARL߫Y5@" ZJ7. [Z:ܭj"z{UYaUEUޒǗRBmu( :)瑠ѭ۫ :иCPFHcDღ$eLG5zFdTf+.twEdRp;8 1R8O7ivyR OR7qi=24lM"ĠǓ&#'vA[Y&D<UpH"A5EVݥݪ 4쉨|Æ[y &(RDFEN񘋆0婘'nds9-{K,Rd< Tƾ]DMȈ&FdU8Lk*O" /̤9glȧffD@U;۸wf!u,{hyJ]ޥݧb7MGcl>QEC8zD qwף4'{aUʙlcPn+ -q!pBF-+7Rրl-mjısZXFgz}$oc3[7|hzAO,8uD>܆~v.͌1<߇A_c4(/wfÁ* S$ ː-݉=$J*YP-h) !rh ͩMBGWSAK̗ qIfCĭT!őlVK.bN萈X+&+u 9a9‰@ʈ +wT=GQ,HMQ>^ SMCKR,|(1]2ZYfuNg8ʂ䍣9.bP'(\Fn#_,em|*KLZSNgv\1t)h1(BS 1Kk"Y/ HJ'd;fE"**ҖwߔZaJuPSP;I0VK/-u=r`)lؒȄn!@6ˣI.Zڼ9ig摾XT4n7CUFPܪrܦ7`Apj(/2,W?w$S 6 `car/data/DavisThin.rda0000644000175100001440000000140212215160035014317 0ustar hornikusersBZh91AY&SYx ,Ȉ@/gPx.-xS* T=SP0Sj4cSSLET1 d4TR@ 0IzӑeMVL445.qAe (иHdZXhf*˔Ȣ)P5JRLSVo.B͗%ssK3'Tg@(_b2l>TrdN%ީIw+[PIJϜ+*E叔VyIw-gʟ+ו'\I{_LqxFݑvYɔzG-P|矕r3=y>pxb|3tg`MywsH  kv-)W= HjfcpkƱ7o#߇LYZ\d c7"&>j} $J溜}xYk|ZmV(&Z*V.VaThvmCDžHB5sڌY?IrU)VB/jI of+ ]®ɀ$XAX[Y&a'jL Hlϒ u,405[ 2ف#UiшfW 鳉'D#^VHQ ε5tkdH]*ԭS5Aw{nӡK O-&4 σIZ:$RjOB/&q`݆r-ApkZ&_ Ig=zzr{n?O^OH̑k]OXHb[hZMpص edX Ҝͯ "Xe[4RkNVɄme :oNE@±5.(&\Gϓaz i@|#ˎsYKL_⡗:n]JBbFqG7BSre0_nC k!R؈֟8b eMt:&j%M.z\_`=qs&=~Ca{4>5n *6Q8Hq[]V\95I\JU-`]3=mg08Ac6h rٷg| Fт@E qGZDکŷH%̶lǵ-hR '}VBEsf' wm6,(8ζ1nqttLj&ӈHmR̵I1*5iHG6Ԃ\Qni vf5@:[≶;xx,6b>>Pvqhfr[0A}s2a'(K9O#9YM= uG,LKA[#m\cGXpb[~4Ӄ:0ysq93t L4neӷpTٗ3v;!ww5`^xϫvl-ĪΤKĥKBLdqhnyaaa(9(!WK t*W>%kj@,i9I?@ ̖car/data/WeightLoss.rda0000644000175100001440000000071712215160037014530 0ustar hornikusersTAR@dB?Tbq~H@ľȣgT5":x w5fĺf_!Gb. ŞGb.r`-Vbu==اNk:-IM5SwQ^p8|@;x 'car/data/Depredations.rda0000644000175100001440000000332612215160035015056 0ustar hornikusersBZh91AY&SYj[eET?!4ajB BUos, Q@btΙNyTXW{QIXp{PTTXQN:c806"tcP%4&Zv Cr&hݱH,ukRg'mIQ$\3[ϰjx`i yVZ[Ҫ&:+ @[zI˱UbIRVu UYf&طg*:nnq^l.NW$.9m V{C|3}CtX m1_l(D`uЙqN]M F 8bc ܘvQKsk Zo-@V9RlNΥBHuH0 }I$,y[1CE&-FUEfmZ&eվSl}*1\".s BPHc ҮR((A`1$ĩ TT[fHCvTr%I"@1ƯqHWPR]Q/4$)Ҩ2WB%J7/4QOtWTQJ]-T҉xw$ ʒiГՇnҬhl=lKX]BR̊CV+0qJRB+ jlUU2CPυVMؕNBTLnR2PW).HU`9ӻJ~Ce0iuLԨhvqe5!k;7Qp8ڻn YBGtiisݭHFXj*J. F2$VFK4);Zc_gF*T @|ɼUb10BlɈ%'?' {ĢqQ#Uqs˫jp~Yy]Fݰ{6P2IwzPMem`5`U0TAxI0$I1<(Fx8"y~y<(M(XynP`1+SW\k13_13_ 0_  8=7x?cz޼pBtՒhh+Ks/Yvla-9vrh}TKQi-| }FhL-`<r~CsɏkIЗPƒ١w8?-إ1Z_<$C~% ~Ӯ캗#$_n٠/F<(.Ih1>q0a:6?Ѥ_zvn{7|;D[G="9h񱊳&&kTآMmNY!}loJG-j4@4 Y'JT,Z0舍k{İ7v<&6􉍺uI<v&ݽ k:? Bo 9bR;߃z)X)^Ծv]T):W;վ^`܁| .ޫUt#q۩R\~WnI?%Y*zT^.%9*_y| vu^ e;L':v&YVA%mT͖ܳr$MjIJAKA~2IUHZ"BLRsv pBN#-IއT]}NէQ#PW T}'F}H_/<φ_/NGY2 ̧"*SC&CϠ~E{O@WԭK뭨;;V+Oc-kͰ(pa֏/jwvT_B}$`o?3쥖qn>\B11|_t~31g ?c~0F1`c#Lw؊kdX0ycar/data/Burt.rda0000644000175100001440000000053112215160034013343 0ustar hornikusersKO@F0Bbb@dxW&hD(-K+kwnt]84s{Oi;*BWHWBs.~ !<;%gB7p cp \.;O<ռ`IWpNi&9[ |pA.|P*M 79t60Zy0skE~{zD1lm?y`m0b폣eV [#߭Pq]Xj q*QFFjFFF<#M#{$ne¦تl5:[ckqCqCqCqCqCqCqCqCy_D?5car/data/Bfox.rda0000644000175100001440000000164012215160034013327 0ustar hornikuserseT]HTQ>wR(kMmC]w]={U,D C*C/`A/F/DOBDK O=DaP4wgv=م33f=)1ƒY Kb)Z'YXigKzvB= K}S_S0.=umҾhWӪ9-nSy6ڜ93?~ /zگl3˹ KYXna)C;XQƲ/,2cm ͛'^J?^B]wy=J…iE>]$Zk nry}/owH& pxu+'4dx`}^噉ޔ>&ޘe^Aquۏm*l2:땉,#=6eyཪLj㦹u=eR"{'џ+C5S<4+Ql8(cG̫Ήu| sxym1\+M~źZcϟ OR=݈ 3"/}q.w cRl~uOcEOsV5Vy" 1=tJsa,>\\>Phnm]XO{ \)};G%vz>8p#F$ ~{tљ6fGJ L99LK(%=  qS Q?nw@ŸƆ91AȆH2ibS X2a3! D98I }.HЦц2ɥtΝ5 Tc5^؆R1fxmjnùwOnoC|C~j 1 q'R<$D$M%T#2NtS%uCIt=pd;!.qw?_<EQ|N~Fbh2f DDUFP .iׯ^z$m$I$mm$dXYe숈NȈ"% )NȈӺ".ȚwDDDM""+P"PwYeX"""hXe(D,.DDQ.Xk8w(M &DDdDIdY,r,bթ@mP$#mm$ mnm$LI U4I$$ IUPrIi[mڒImN6ܒUR$I UUUUMܒF$ I&ImI$I I$H`$II U]ͪ5MI$F%UBHmmU8J6ے@Wp s>hBSjX°"U E!U B@TIy萒1R-;'@L0C `@. ov*AE -(TSBjUL)DT)Q!! @$hjШgiE @cBB$"hZ0 1EѠ" @V^ʼn'GSc_/ \x}<ϧWZ3#̈Qd5EIV`@a(մD j o PUőd% 6\x7۟$6?uZBhMt `>KM_;n֯{JH"6K"ы\"EAbBB BA `[/3j+=αQpW:`kƛ8z-`zC MJ@LZB2)rDh}Xōƿ{dɓ90񜁓&yc#ZT{eݮlUUX 66*90g</c{.\ޝ/ADDEDEUUjUUUUUUUUUUUUUV1$w7*"0D *Z,ZֵkYBBB(JP$ -kZֶ 2Ι|eBQDfˢ (FYgϟ>}6qESm6bnBI$H&!$F ]0QEg&Uuzt""""""""("*UUUUJ{WkFԩ#1ŋk[A+BJֵk-qbI.fjָ05ޗ9,Zֵl +Zֵ -qk.lv+ό;lyڝDDDED5ֵr[j$P#6Q_e[eҳjM $3 I$B+R|G#eiw70+vϷ& ɓB/`rI#1 $F&$΀dvn^áZѢDU(*pYDrD9I$܄I#0ywj*rd]q7!$HbnBI$ŗwwm lveUIw:tDQUUUUUUUUUUUUUUUUT׃8H&%^,/r˭k:5;=]U7.I$nBI$I$ 9o:]:kN """.Ȉ=q`I$$!$I1K*9g&JK1I$C$I!]ݴ`Ѭ9\u$zuUUUUUUUUUUUUUUUUU&sbBI$I$ Ehjr$HBI$! $IHIU\9d;+t$(DDEU M4$mnI@m$ٓrޮI $HbBI$Ą$T¦チb˓I$$$I$H]uZu냯^Izt:)EWp'.Z^Y\ϟ:p\]}LI$I I$$$I$^8hURI I$$I$!%U*Dΐ `d ߪnba wn32 D$RԚm Vl`zϣdigp&WBedam[*e.iV3SX&hQHToA**{V6j$+[Fe3UO%tem6br_=4SA6?·P%TK-f]t&ZF{ծln*aHj)}E>a&~7:S;U'SuxIΡ-bfk潮&l+aU{<[D+yڔ%񾴂 x&zg8]4%hnRgxS[ui<ʘVH+Lej:Vϩ!NSgﶛ2mUK sA3V12}S[dJņ} mZK`\`mf93U9&ih5\ͯ=6::1UEbjsDakƶBk2f UBBjYlUVsըjEۖM~,V>R5kuNtf93Òӄ1h7b:T]acV qj8a[V4VXX6lZpi¯{KU^zJ4B33mH*9٘JG5U85ai զQ8v`ػd7n4cmD7y5WSjkeY録-j]afm4ijY4$"MbLuװ$3&IZ<&ZWtM@!7(\G;?qo-}wEnY$.4[U$A!7'Fv[ p=R.FFx%ק*i3y{K˱"8旅f@"8 y;C:^zD%N8j5\򆾼HGILfj!@&Myble0@Ī 61RvβR5&㹝mx*. v6,!m _t ˠ4?:ұ+y\!vNED` ˲eet eKj "8h 5s%PĪms+y_=׮vԘ= u"`i~1kM5ڱon?[|}D!9{e·[NM{; UhBmd 0k`=G*ET+mR%ky]@棰bW ́!Q H`ݹ$ɱ;p0]9xtgs:#ײXyG*R!r^Wafa/R42}>)N@=&L26mkcb/Jffٵc}ky35Nꫡ.E1J$B zT\߷6*݆ݥ7m3n=%/W6 ݲ$/kz&TY aLM]m;ճ{̽m>y˙39l&N<9Hx8$:0˸hPe{$vum /-B~DH}OȎ !_?~"&he D4O`v)'vn{@*!@-#Ⱦl@ y+b @>\n|A/6wC@:qOS~JiL')q]@~5QNUE7~=8SX=_J~b_} 6Ә?Gz׮)uZ#}})z+Dc}8hC$PQv:D_dd G+q#t[!K;l9.vtOұUkXuX˵.=+b}^S5ک JkT%opcim/fW6s6n{'D&f츨& U*<)VR蘒;[GUiSrÊZ1滞LW̩sSSAm`I՚fp픢40s=k&mXdCQGRh31T E2рsRmP [ 5.o0( ma(m=1T̩H&k>X`᳑,(sq}Y^m's[Yu1S,*\uz213.*yoJæRHz/ФctFfJa ֥j[yI]FK03PtQ*i*D[>:Wjlʖ `x&)t;4(Ȋ֘޽-gQulNI~pCm6tq_5*6T*m­yEfz5{65/Ƥ֨{:j nK0annrJ]"uoh/Ixhwc-zBؖh 0vXpf;eٌ<eŭY*LNOBf$dEM/#[-h{L k5Ӛa)e$WĻrcar/data/Prestige.rda0000644000175100001440000000526512215160035014223 0ustar hornikusersWkl\G؎u7q8sM$ױ4~B^zo{ͽwJUQ@RA !T!U@(Aww^_H]윙s75#G#VVZ Vǚ06YXm;U~މ;u^_':ϽӯF>0z-cakK }{DN}?jkw_raOK{s?d&>?յKvVo6¡I}wH^ }}O>|*rSsl%~l!~Q=H;_{|iŸ:/ӧǥ&үē>|Bݗki:g5C= 7߲)O^u}ԓ?Kǘ7No d'I~"q3@6—|p.=qSƷ'g$)z(>i =4n I<"Q!w>ʻYxQ~ua,`lZ3X%[@m|7oӟ[wX"cmBxkcؓa,c{ZmyÞfl ݭ?b,:Xߌ5}!sW@g[JsA At<쐍>y`zx1ƱC!ۏ"Zׁ ZA~ˌm ۳JRα{;[e)߄Nqq9臷ۦq]1 ]?i=C{(d> }%Ykig=@~17?-~VACg2ZOQKhnj>oN{:?~_Q`ᏮSw8I<~ɭ88utsyWo></+?Wou{6EPK뿣|}~+|>u/De_+Q?N).庙>;Ay{9sN>,\^l4'94{t/=]9|JR)?IsUoq'' ߔߒ2FzNQ=w;DaäCg tg((Qqwp"?$#ܻhһ%Voγ檮#?Jzȟ#d_͏>W8?!N$5~9UJz.r÷]WI M˰ B,ZjtԿjj+z iU"3Z*PM).ǑجZ[|V0sWv9֬fgQhD<=s2gm/20ͼ&Y6lV󛼢;/+giqyq6{/N.+ö0[4rU0Wya? ;WnŐqkrKq2 8|iDEA{215E,/u8Y^^y *l-Mk u6sr_[Ee, 7gXɒΝ w <1c<k%2ta!ʖ8U$ ',PR!e۞ % a˙~[9lWO+9NseY3/0$D( np kq i@&me" HŢb*nyi^MbM(4R[<*hjĂC #и $h.Gh5tJ6E P3P)F+&@S8vV+"+ Қf@Qٿ:[Mq®m Råϋl(/r !vAȖŮ!CǴ]j{f\3 \KݯEaTme?HCnP`+"ɝ{p{|gNy F ì?(񳴿B՘2FH#/+H(P^O Ihz`zʆkӁgf;`;mGcͱ:{tX'c$|bd_>yh$Y6>8Zr3fR8]l/0aTr*(oJ*(c,?#o:H恮(Wx5,}C}̅oUe?h@5{۾ǘg{;?-rV|!p$ק ǨS2eᬱ;߁۶ P20r<ޯ]< gଃp\9V?v sbKdrP9ȦrW_Ayj#}l z` *Z`{OhG -ּbdLM, JsK2дr!kJ0F01acf09acXBLp!egY&p)eba\)%ziE@y@ n%kcar/data/Transact.rda0000644000175100001440000000371012215160036014212 0ustar hornikuserse\U;o{S.lCMH6DPDkI<{/Xv8.۱7D$nD9wWwߞsז|WBHB5TBR5%TB-d9X}0u: 7%5+8¥/{cÔN{ 2J-fY;L2s{>_+ʸN&T\r>4^KH!Cex/exhm.g>t3{yk}y<TW[m[Cb>tf\AG~ӻy.cǖ􆲮jiO0KGCy9S=\kTnYַjo]4ΝѠycop!ӳ2Y%{g~느 &u4Vp^dm{V߬ qB*{{pBd޹Qf+݋bz\)]rW"8;ԣعjsL]U πour^]NÄ|5b3έwu:쬫׺p|{.cvCV!w=΋XЯfWq1J|9y<:AL^W`\ W:.s{Pb{rZ֊o>Y펚)5#7h~yc;rvRcs1򗫯skew8 9?.])-8lfXXxqngLbⳎ r=^{}~eهV 6xq:IFw)w}oDZhN?sOޛ~K]sنر=w'o` 9hgܷH?zZa&'.q.Y)&zP'ggk'fqD\])֫{FȐ̂"־#- 4N[gyz FfR`'J뼋ėmo?Goy;W>LٖѬv½{n~xE>0?oo{KK*>|¡lR$ car/data/Chirot.rda0000644000175100001440000000137512215160035013667 0ustar hornikuserseTOHarPv!@oK )UY@]f|+?q?6,|K}ZF10bo~"ڐeӿ?:m y {p_gr~|sk&}}'(}Ο`}s^tέkY]@@ߥs,qc}>ü2y>nwUh]eK>h .Q 68y7/9Nrlq* nўv\G svλq[lJrj.$#Ӷkwn]wFMbdàA~)iP[PB#WP~A)ADC %J4h(PDCFR4T_ [car/data/Salaries.rda0000644000175100001440000000536612215160036014207 0ustar hornikusersZ pU@B$VqкKQ[% A4(*u)EꂈZ-VTE2..Zザ~7{/oHZf43'g9%N>>kz .e!L^3kio yk6_uLdURŤ`Rz$E#I#H*Ri84iKG-i)!"˖Ruht_uS&uў@O2C`ho\!1_0+$˥#ixCts޾$;yl alb/1,ʃ3Z(ul8=K$و)"/~FluZZ,ߢkV\b-ePE%J> (WHP4Ny8\y o_9ЗS9:  %Z{E=S2):}l6ʗ*+/R*^v!خFj_VA {Ѣ|ː$W*c0jd^ $z5#5¤ R}LTgk])JwMFIw|uQ%~p}?I{|:oҾ ϰJ#ʕoDUbǾL յAk_ôFWj]\IώJI㕁pB:aQ%De"?S"J?;{0XqTEx)H|Sg!=p %] 9®LpnyBX&[PW?;DI<<+&?|,9AV窟~n{H3;GiTإE͔~v !m_7}@{K5zgGh|>">Y?3"{F R-&ex17{VB]囯s'^#'k,>n?Mwq=xet{ă7*E$$[/^w8\uQl}-^Oۏ5.ܴ+Gj bYڛq*z؈:uG``LƱz[ k+}0nSv&C*c|.f8[g7w<<_{"u˩D_U{⻰Wka oӱp'<=0Nݗp-[WHlo{>i:HVSN=0 :-8v'hykK7=b~"s up?]I}ݰ Ƽ7= y]nx'. c+>4\W_-]yu -Y_h5\kՏK)􊤞ބ=:5yrᎻnsn!%`0VԳ)ˏ[뎅m|n%kfq+wbsV |v=,~NG'Uwp9G_`>2 |eY9?s\8 B[2vi5bo7Jtlu2O9gVM{(l6lfͭB_6ϋ`2-IJnep[$k'ښCkKⱆ5x+\1kl=AogIґ짿tɻ;2[g-<S9뵨!ߖVʼnk7{-_[Ե98F˷ģ:X&l@n'c"U:ܙG1wq{hhw`υ߰Gp<܅x:B)ϭ?e6e<5wݺny%& ǰ^o(;O[w] 8g:/El8s 1$r] V\~-־jU !zwAs)'_c] qs%wP.q U痲![h\R?O9K9HcxGavaG))'ݟcNm1Xp+rvǘO0W'?> npʸv/  X9裗{D{j#Rϣks)Z]M|eu-*0N51e+<㺘 3^n:X,?4e<]Hy;~qzCU=0_[sucAUV9QPvE;h̷Eĵ0'3~j?'KC/s궬q)Rsj=SJ:z#XL+ہ 'y=^Э_Z/:D[mD,=nYZm;áY%Óի^T=_8uLƮ+É}PDf}{}Ww.3f"߹ |m[mi Do7~mQj0sK1y>M55x 'VVy%:A|d@Y5dxPc t 2xubz?eq^,/k7}P3- A93{FaVgO#6SzwNl󴾨cPu樳nZ)f8t ukڮ:7C_1,ЭYǜkS:^^xgϞ?zNIu뗴>D\E:(?η:csV8*3-e އ5fhÜ/{qb&ߤ8 y,=pY^!1\<1gCͷZgé8)<{0B9ςO ov[Q;({5 b w|gsEsoߓMMC7^/:I]ZomkZH_f/v;ZLfZɑMseёaFWmC{TZtl0K9cƠ޽ozDž7keu-{=gғu#ۚMT~(#Ah0j=.`"ӭK : 6 n;u/YTznUs |ӆ= ot:3N.3NJ#lz#G|5|6A$oxrdA6 ; ڱF!aWxTݪZVt7\xLiF {d3 O);MEcM=;U~'ܚnK6;ldlNwE+ eɎ&^D&a`ԶNPK=Y3 ہI5\YצdT7L\sv֬N'z_g e:AֵkZֵJLI$JR˾6+m̖R $lH6ؐm bAK2YJRdVjnv7],)K$lH6ؐmI$I)n˗.ZֵkZֵrD$I$I$I$kZֵkZֵkZֶI$I$I$'ɕmVjmI$I$ 2KkP/I$I$Jh1333q@$I$I1tR{/ 0 \-I$I$7 0 ZI$I$Ikl4n,-gƏzW0*Udm5DmΔ >y]9_#S7[Iۿ-a5*sq)M!1ΐ>,Oim9%ӗ.D8luIPn4f!#ijZ0andVW%C \S]o5)v:ʻU; pB#Vp{#/y.SԿi ^#r[L([ ǶPA9ܑN$ cf@car/data/Hartnagel.rda0000644000175100001440000000213312215160035014335 0ustar hornikusersmlSeǟ ~؄4mW`m sD֮]{iK11a 혛(( ʛ&~"1C/~a _t|@r7<>wibM+ʧ<[R `tT_f@)}ԀzШT8xLI ]`7x^p|>ap'88NS4W7ꔪmQ?0|Es"@OV m` Tjb4@+|j@suB6xs|*/7>pxC/0sO4[ K}^g x,%6=yA$oL\[?)~6Xo 0/x$}y{Uc~|jMy4筲A1m.iٟ΀M|)vR:Z/I~7u~exy):ιsvQJ7bG/>$u_w#N[{<keR_[ຸZ|r~~9sop>ϫ>X}sW.['<-2O|N<&e] p~/얾m̧^̟`Pj0"(`T<~D3eM6= @/߀@@0:u $iSOI4! d 4$)ѵA&&i|ameBp )܆BCPQ3 K s(KLB M ˭R7kb2 ؀*$U2aJaMVZg2SM!1pL %S⿈ܰbHXN:54dXe˟T56& ǖzwx:"x0鱧mvch}*!B$y`զ"- ! wUTI ["v:CaPj TT*4FD$**T!$ ]vx;ݙuû! U#Ϣ&i-؁u7 Rq530Ԛ4"h2ImF;<R3` sFWXp, g)„(w\0car/data/Sahlins.rda0000644000175100001440000000055112215160036014034 0ustar hornikuserse9OAB-[k lfM1њ55Xx^;/;Ճ `f! qGI" `>0XCf9#.n|3]D!}'7:}@|KU:SA(GS H=?/xvc@oQ#-FP{zs.$Vh8Q{=cFSɹF_{h4cÖxl7z B7C]α'[뺖z\<  Y 9 y  E H:e(m31537T0T4dfx)vl car/data/Pottery.rda0000644000175100001440000000132212215160035014075 0ustar hornikusersT=LSQ~D-hkʏȽOFЁbh8ĸbT4LԁA4b޽97=9}掜5#0F A'`/B0B]ڵ\sC؁{jǾi;EWt8+˙ȎK#}u*_QF͠cr!w"Q05^\: eoȓ޺+;RjC-G1:=ێVv&Ւmׂ~Toӈ#F䣝];P)s%P<ۼ8"cdlf|%z[&Fd,l=ԼV^vOy*Yu s{ǛK2HV ~bK۪]Tl)9m'oܐUqVznFY =<> h~eplnh^o>#֡}AAs%'ꃉZxQY~U%p>Gu{|~}+ȫX]_CsN3Q uutC/[?39ML5+ْ w5BKn{"V,D>BV8$ R d%p%%RҌe0e&sa2&safoRH{Icar/data/Anscombe.rda0000644000175100001440000000151212215160034014156 0ustar hornikusers]YlLQϽSbՒxAA%<S-ZmE냑pvu?D+Z [(l^8-*{kxj{q !(cbKc Tcb/P {˘O|!c ˙cL8>HDzȅp=8h#|r}>ʎOʹH=Y߰AswNSxc X BW·f . 3pgĺrx#y GF;1&hH2lފ{9 Dl޸{wCJijC)ppr1^ݒS|`/20ֆdj`d[5,OVRp{%;Fdh@[TŁV]h%Xڼ@[5_yBJͬT9VZBк:W~%7[YtF7G{jŹ\uUNBc5BO\;%Wi%0/>rմ+>Ocar/data/Davis.rda0000644000175100001440000000250512215160035013501 0ustar hornikusersBZh91AY&SY̗O y2H@@^ [7gSMQH<(FBhhzF0 F=FOSڟmB{LiКe6"MA 4m5jz`L0F#&a0` 0CF&&LbL F&fJ'#R14Pdd4 28j!!6 601 @cv"6P! sR  1 @HJ I!4!4 @*YC{GG'''Mjs3RRܧTLqs!sspRXr'i[ey#A@v`H6 4HFEp&,ҶB%bVc% M=$[3[U;NO$R E-/Cui+$%6jjJ("^3#ghiTTV0cnB&t/,$S 1 wXy+m  -M:E;L䚷ݚ:"6jYLcz9XWA%] 4!`J˜%E9v4an;6 Bm]i"M4i47qv}.\?aܴYxAt%ĈTilhM4 &I4^ڴ@@Iiƚii$I&Fn+VYeYerI$\&5UIMURjUTU&5k=X1c$Mkik<=rI$0]I$bxI$L@Owwww$II cU$I& aWwwwxI$a'WwwwxI$ҡ64ѹ4 1r "Q)s혣6`^!h& >߾SyA#պ_;:N{a'aCS癚du3p#.A|~.car/data/Quartet.rda0000644000175100001440000000063512215160035014062 0ustar hornikusers}R9OAY@aQrrbL!rx$/ (l6FԚƆ`55ZS[caq7ｙ}nk:!D#.BbЭ7urc56!KgX̳m^}X[3ns~0~||@2&U0 %x {Xx%x(sp SX7p5?i]0 b@s/I3QoY؀(#1~t IV}F~!N;q$uVq?,9"ȥ5XA <[,-6DĀ asҫ7\Z" r6ۨPh׊NޓsxUQ?V$}ͫ POݝ}fvQiMyL򪞏7ԂU-s#N*LV&-8NϪ5:/,8O% dz ހ`<~3ϟp\8VY",Xb P/i7^?@h+Tk {`b׹TXZVxzSߛ=UҞuxcp9x r:f|7inr5`YWNPfD_F*6XlO?8$GjW26KSZPwu4-FD EYG2쒕"hINcar/data/Vocab.rda0000644000175100001440000010716012215160037013472 0ustar hornikusers7zXZi"6!XЎ1])TW"nRʟsef,ť:~ԅ}-l- ~ @4jzEǺ}w1dFj!W-$s,o#Ե%J%K:&4eT`j,KG^cIi 5㭾 ֥̿H湊օO$Qvd?&ycvL)xfo_fe4ִ6gGeuB?ȊA* SYlş:BtKQuv{XMSSjh0 P8;+@xv?`Syg0/ d1 ` M-a^pyʅ嵊R' <;F)*y^_NJOr۞d6jQgћ뚪,*DfZW'MGb._j-*C^QNXIU??_ͺ`U\gu8 ? Bեo!"U/dސaw~8\S`o34Efsk[$h fZާ5Q2ՖY{îSw#s =H'br Bole~N,G[`LY{@Qk/>UO\ֆ8S*8,5:Rt0usō_ϴ95R/ba*U+b3TtX #r3÷c!oQokmQd77&5 ߀ F4'VhyU{O70z ok{) G[=.NiJpq,)^V]cF:x#z~iÃUܽ`iW[[9$Z Mxeo4=74?6YƧ_g䮶}%δ$JxrFd5Z*Ic!Ԍ#?uar~FaQ -2Oh TV4q2Fݱx`>TU1QMznlw5I$:&:+17eG1 1!+S7@&  MdrW\i'*:^"Gd&N6]򍑐:*.ϽV4U?$Ef xvCpQdwf+q*JX d4p 8Wvp*+3*&|&黚lw)G־WUT,nj$x } iw=nС @>E9^٬,ÓB% 4 Ε0AYV}ĸa/j%KqPВWʓZ.PRs]  Zi=ŨF0^_aūt*@⨑,K"ag%i4Ę^"Hh2-]}1b5ދ>>LW֡`j?jeh-KtѝQ[*bel^!`X$cڠmEϺ0Oq)nDt3b/ggT5hj=FxmYR\{w+oܜiWb6!~xAjQ}~b&5Ssz߰k^Hɩ\k4k_IMƒ .6-uUTbΒ8A$['8:ZйS2mg Q?AF:ĸuQ!YrNPV^bvn?+, `K 33F K\~uM>%k> ZoW-3Xa8ExٰuljzyCwZg7X,;%`ǪƲSL6N?y<~,(r#:|6h,spУN(w9&@]ހ}KNivI?LJ5=*7E,FR|Fg`c|2k1Grֽ"0n廉Qp7MyGB 7x45`f&!x{Qf$61C?jZρa +[{}DlA;*m"SIآPRN=2B.GU}`^fΊe4_Vi|#L$WYFȴF _kU}/wJ;א3 >\Bq{~$gN[0R-P%(^d#YFMvwЯƛUs{bZV?8@4Ui 0kIJ-"*ndOR$^4TtiSߨuL*6ŋ {4Fqa|%$6 ]͕,lx\v6P]! vuvǀ³Qׂu*-AlJNx{ 7= 30<8e1P ѽ}aC/Ŧ$z6 8UV>_k#Y҃Kp|؉ۍ>@$frJoI/h?+=ᖃZNPACt$/B'Ť}(^h;(kLWg+Qn>5C;YaQ&T4u D&9/fKz%i'I*تG2TpWR+;Ĉ~ <芕tW >eb{(MxR/?w!Iy tK 968 hT#IK+CN1'£e~С9)uťe`nh}OBzؠ(c j1[YW0C;kwoE6a#e/ . *=5!q(i Dnj] ;TC'vw'Fe϶nsHCXƷ\vYNNݼ ͝`52-fL",ПxϤ(ٻTh V uH|B7bq 7㉡n|fhPQDk o:f9]IB\R(>E._ʏo _6- Skd+F̙+"ךW+Z #-i3Ve5﮶:ƈpWU@wCTh:gkwʨ.+;@~nc:ʼnm4stLMChQe7-)M"i};F=I{EW9\dE4Qۜ"H}zPZ`C2[@dʼn՝;uHpi! ) xf&tk0aSlL0vދ;&߯QtW*xfF"gl3BG990wZ,~d_zٻ}qizφTĊcTd3e:  }v+.g,MƠ cH@ưVH< FUݞVV`*X۟<+! F{4eŁ].*^E@&n-_4;'fj0jJg|"km:5YƢGD0aCnY 0oҒ9ٜ?8)#qUe0* 7,]r wcp0{Pu'F &Jmٯb([UPk^l 6J0,4gF7U3 LF(E5RhdXyw&e*#AP9j 3dB@eI_Nw'eQ˟X{ t8+G^Pr Twq>pG:BP#x9~]rTx֥hvVs:;n3W23ʪr | OnZm5s82V[y g'Ozw;h?ro.t`'LunRmC>d}(~JoD2u+53l kM?˼b~/eH`&6 @B'o{,d8*y4P JdJX1'rdˆ])HUm2[88N4cҒ "EJSRn6-W)@yaxRQn6UdrbޖȌ+I| b i:|RX "ꐮKr0 cy벆j ~3܌W8Ė7ZEHxU#8,㶡DG)7c̴% ^ Q֩&zKv1%s"{zrU/(%k~ԸVd z|tNs!EM}Ԩ=?/kDs{ϬNV o 'I<UCqr.<'C\#1=sMp"UP<⎂O #|A_X-j\Y4?7?5GQ> v,s4% zqw,Ese>X?޺d%h"KAɏv|)j3ܞ%u,c0Y ǭň dW,(ogXf)efm(~J-ŕY\5xxO o/LSl%1b.0\)ӌE;(Z2y'Ń2]{o%~2bNX)!ː1 [lZLiQ,\kpݘGѽ8b|@!Y(XN\tX ُ B#sC]!{?;R%jaƊAj_o\K&UeHXD.( 3(vODjQq5cNU})?w˜J}n3⨪J[!F:&'OSJ4ȤLsY1* BC zr5Ϲs}s,@x)b+#E$!$ h"=CR]z"1Rt7iͩN麚'p5bz @@dVK% kц.޼B݅jD`/Wgzz{5X(mbZSeJ dv`5^H5)泿4MUSAyKw6aÞORDPMDv#n;PNZWq G9%RI7Gsm(rgAQrDYCc*P&g X`GI'Zׇǖc ':c3-WXűrh+'ڧdQ *R BGj;J \!:k fq猵?IB9ǹݹU3%g7Ce-k/qml O?VmW= Ta <*iv_2Ձ "H%-#e(;5Qib.V]+xssmU Q _d hs ^ ,@&#Tޮq&V1̝`6)7Ȓ ],lkgKP6ˈkC3vY,)(V1^˳.+)%P 'ˡKmb{(VBeI& kò% aE;пU//~Vhqwxet_ġ9V67P^"+EcE;?}mAl;=maD"y/QW>},X!ΞA>- I$'m[nd}n83Q PgK㉯M*&c@" "e+:&Ғ!\6q΄,sR/ЬClDo j3WW)j[?lg/}`1F^ytyqw*ȹR:d,M9zlYhuʑG4{7˻r G/&kh'"w@#AQg9ߴJP7z&p]z\mrg\NؖL}$谌p`[ʌź:ޔHsL⋭Z/}i} ?.@n^Iriw+۶wZ6pYc/Qh68k?>A!UlS3!ᾸP#(FxYߪ7/?26 !Y'+^)ސ#ԂT*v;4g%!<߼S$" Xǫk3R$W_.Ѽ~ dҚd qHg2%;$r"ln<7?bڨWbG5#!TYJUu} PZfR?ߠC>?op|g6+⫬̋G2c1tLĂ p@θ !&]LA0ErYH? UbPj:FrgTֿ`|S9ֿsa(&tB:jtkbڶVƙqjlEqóۓh/ :qָ$#I^誌R U7Y;Bm*q#tiߩIfQ]}i"Y'\.ĸ^P2WݱZ\f ݔ Wv͕|-tRv̜Κ^bV HkPN5~kηfu[)D} ٵg@W4VR(ˮsj7UImEfX ðZȦQ]72Ud<@E̿>蜛^d [F{>=[M,TF ̌LGf6^aޖd/5aEk`}Z'F}:|(=jEA:^+tA!CX^K~K<8㠩*85䋩&;eIVY8{X;. @[="9o=2REZ uP8E) x:Ά\\wU$*x%*kyF>+l 'Zevy Կe')&;0׵È6ܖ0!R̡u|t"cPz MCY)<|V柼&-l%*Ew0$^14XWs] ;e,;q# 5!zLQ?@TѶAX뛲k-zJk/}V+מU \ r츻"<B 6j k~pla%FR) إە:0Z7>4A ?:Ma9ot°_yr:-FU|ME /_( Z]Z|mp?Fi壜ٴ좷Ĉ7GZ1ْk-.M2+^O Uo+Q“AҔHҙ}d3vS=L_=g_xTf 2%.k<磑NYSC= Ԭn :uG$y% 썶]K{6LX-O,%mPA) Hl}l@)ׯe\UC#YN>i%%j.@9awp_;d>p;dk!6`֝=jG VySEku*Z>^@᳎VPGpDQ= ks >6.=xA3~!ѽ\#^5Ϸ o<*D}ISx:f߄{ ZY& +u1cYj{dV90E 3Ive0:zP8L7}+# Cyh$@#A\Fi&E D AD@l[KQ5ؿn1r/7/-tu*!T]Ti~ RMw'0;_w@J+Fe F?k7Abe>((⎏O=<09-@黉#Th. m%/bLGDAA_nR(Z osQ\}$?mCm58ϻ"4 V G)YN]Oܥ iz4}酈նUGYk-%g#>j+.)J2ՊId?$7)3EpK {]1CdJhi?|HU}!K7q5]% V-yoY с>m \E> G<$+}[h_ru>ZXa<7e5#Vvjr# lac,E`kz񉓤5K$z<5htY #nt%UD oWf[Q!¿z_ b㦃Շ KWTGQL>XTwaJ._+׼LF>z_|{jaU6ġ m酜X::p1Q ~Rnj05q ӄlsơhw4_gҢ")@)OvyS]"H"_E5!'(2TЋk0XQvtg8'e>z/JAi~R#IF8$JQCLc*,Ċ 9rS7&oie?V 2h ұ^TeS\"~&* /Ephr}IK˹JXD.0e` َ/"gou(j/ᄁ9FC[D$-o7\&nr튴uo!"o_-ܚUEaö`W(;o30ssp"+HoԯC Jp"gŰ];'8|Ve1"Q&\7JӉ&6kOmõBX_h+eӑ]@F˰]Q? ᔰ#Vw)m 9!%\Q1ygT>uT({?\.DrX00C$TN7GP#Q44S +V 2Rn1cNemQ+}JSy5Tڭg_kؿR&h(" ک?R?s[3p537/7t~B2W4@ΏS<4޵Bl< = x9xh{>S3˚{zPnɓdou`>L<b$>Ay߈svz3 8' <̏A*Z4I!')kPK]QaHl[YZ(" /eiSl`ު: jI)?sf(N^H 12Sb|aZE 8jWqSI<_EAaoHdr=4oG킓$!v^\&YrȠ{R] n=h}aw9=+C@BO46hDŽ6bDŽhG، xA Ram"+> %#ė"u-#[PIP=KSw<R>{Һ7?<}\ i909g0F0ic!T.lI⸆ՠb?\ͫGQ|&PDX,JQ>oZȏP+U/,|hxC(hq|+ok 2>=QI%k`u/7b{۩gm4Yx}-lb@|cݔqVX80ujr =$X.G Н]Ӟ3-PY 9rIg9VHZD7j>vgG@Q£SbU74:ɊGW}ӣ14Jadfň*0@no=+Wae7q5!=,q GhMs]DtJ8 \O=,$ԗt12>(lGce|}fM;H+bl ߙnAE,d,I'PR,U_Tw%bqi*ZQ׆HvNS  7b.@gRj>[%. ;5#7vo,%.Kapqh՗_UelFaw,zR;k"o+w5B;}'#\@cI52{Y;6i#bh=ERڠX؃(?8Ɓҿ$"#.g6ώ.d5ю2x 5VY>M5qOxi4~028ʹƸ"CI3_U3(&&Bճlo&~JYRx~ϲ |)-'M~F Y2-Fp'û%Jԅ(eyjL0pқ@RݭJ&VRz-,4ݰ *v]AMs*Pxrus jx/ ƖnRhv^oTq/kg=GoUM/Tg0qA g60_}q*mb Hp=DF:!v._˂G|&o<9K/$;sssMNNQNHx4{s7q(]櫶(C(ZN%{ADdzZO54SC~l0&veb|<4~f56b!'2"ncpzi&l: /*ōw64d5ص{w1U >yB}7DC T +8ZA7ywrb%d. EMF!o% Y'fl,qJ;K@l0а<fgn\w{ :2 2M%˪PhCƢce uXeEDVFp; l6cǡƘWxm498t$M r@ҵ)6nG7ar^% GQ&qtNZF֛ɦSh ׁEPP2)tK^VwzoL~ع7*jo` q:f^@W,peX)V(`Ō {%7o_P:d"sɸA35lWk N"_2(S^iV%FFr].aPYOc>8`hمʌ~RM4p7-k쵟N-!xO<ώyH/Tbؐ-gsTh%HuN1hDM8ӯ*Ju{+ɰ|_9%,iSH ̩E3=SPڡ?ȉ$*5DZY /P0Qh~ɵ 2 E"cߌ<6~_ uiT᲎ #$EM_3̊|mx*mM1Z+s(uOJm^KOK6^ 4yMC+H-;US! |He%9N4r;s(`j#O >5TyE@(SK){l{ғz\fƥ.FMη΀?*Rtm?IufyڴtfĊ k0uQ!8gl~x{EAZ~!]^f&t? }vĊzL:Oj|{;h%ZzA?]pCR ԝוW+odeu~Z@`j|uu6_ވi &d6)\6CND'Nnj @h{ CV`3xS jm|$3vv@XrTPJ5ػ xt,&"R]Z>1.Ώ`0f)7KMY^9eWi4tx.1X"R>/5Zﬡ&P{@IF?( djXUJ3׻'t|[8 9=x J:h0E۰PmcTZQdffyH({%2w$}v1_,&F<2S-uugy򋿏T<dGD< mn+/o4a/ldqզ}eۉt3P/H (>2l;y3:϶z\Y,Z3wƔ6Ϩ:ģR-߃:OiPc]׀/p[:^@,'vk+fB?d9K0DDqQsO ;I7@݈{V;:7GɃv&5EQ\Hzբ{vl(+1JӴxN  ҥP ,Rke,Q9Tzۨ*Dwmi%jϟwVs1௾{wȿW_Ӓ05~Jnoz1=;ۡ ;4bGȬÞ}*}?Pqy+5_k1qqz:L* $ZY.)kN7Awy;rqfP1WXZde-lfڽU#!R{~d,~"]Z˖ đ_A,#-L6M)K|ID yV}ƃ QcQVr2zVW=׫f_>2ߥ,kVelƃ]Ư4kՄ.ӉFyuuº`BfWdoE!-IЉOؖOZ~A=9ъm8>y,:2c>GU=A nA zor{dD=xq;t0+` LAoWA( !˷B~ 9;?ag?lPٔOS{:^vP^ ' 5o04|bnj|0gfhF[بF|3'C 32E+@š!\?ڜ(5* sX4,z9JjHgkAR =" `^0Ck3ӎP>Ng-=V\+]z=ٞGYg9(",!?K~%oƑ6pFs$~zV)Z ^?# jQkm}aae<1BJֺvfQy!Xmz(>8q#nKA*su\HL{cz&$aM^j%z-',7.I\98%tj¾[T mFew:otU~~Uun9{p 9''N}x&!GY@͒@oږ\'~|LbY:Hs pYw#ҁ&x Gi zRv#go-04p@:'AwN.##4ɛuJ8+y7e ZL>bav~(Sp'P㡯&ISw@ 3Ri/C@{U{ >kJ#(X8if!֑mBJmN5pF%$u&鹸X^ #!O(eQԮ]%ZjxoܫO5Chg8faSKpjM:4g5l99ZَHS ΠMsa2׋M_T=aHyr=u. aByjrrI@]2:ڬ/>A <N)hcdۺ|#dI^u ~c- ֣~k>d +ZwQq.8HkCp TҨ&ӯ|[DsFs7?6) p~+J^}E`μ-2GgOpZv4ՐK9t$lDS"]wj@(X~P,4ǟmxbB~oQD$ObKvAռM(c`mlV"$uiymD%رN $:\hTHkAxÃ@B=AI&KL AK'~#c,issXÒESųcG,N .z *ဧ"YZW^I3-5Qn╊%0/4,y=<Aw;&RߜFٳub$qI+Gc J ar1kDQdm4Aov 3N]>éH i\Y#V.&,w5I4X%S[fHBN'er ;BaN):<*bvy./1i5Ϧۄ@% c5Z [Re/-"5ɄU$QbЯRSC%6PQܽӰryG_]Bl vO){K@'Au^Jσ3$M uH=y;@PiKu&_~.FV @} Y T6ȟV*"ʑ3 6EV9!HMr5z%}H;gTVD&uhq9H d,;q]r@n uٳ?-"L?:c9q `[L..ޕeUX)H v-p5KW}NI͏w@,l(yd6 !ƛm/x[;fgR 5㜋{k :{yegch*z-ٝB˴&_+ۛٿ<]p8r "L(?^| j)BWJC#l?ʜ~̘)"]~:Eu`Hʊ ԈM.|ZӌMdd.F.0=Ar2񾂺c`bHZaPM:1h[{XʇA5W3iEd,3h WuAIigEsdӖDNE,}Xq4<5.G#0ʡ̹YzRUE-op);]HI!kN65CH3PCF*Ոu98' dA bյ/^D j0KmH,h)Ti?3Zxt+bY^\Gۍמ39UaKJݎ6~˝>I,/ L=5ŀV5LHL`}Z# \`g0J"+ftB:-OqPT@sFTv!cl[Aa[1pܯ<ލ$K|{L(\(-NVkрfz ?%a އtC?&.|z߶Yet|:y~OjZ uݝ{phk~Xs?ö \2 _"4қj]atf6[/QJ|f~g(\p.> 7~b9{wm30nvۂP1٘o h(qgJ,|8.E pf*t@XqSNlAmYCnO!Y~MO@k{^Y!u<GHdj E#>I>eE 6)$_꼝uK*M9e#ZU/|N5wqN埿}{Zg_ YeʌVL֨i_QVmV+2׵a4\P8@}1bcq|~YSE$ǻЩiK@|!.83m> asӨ.S y*RtOQs[Koa$+ʞh9%!*>|LJ:k,sПsV4vf8Smϛ6+[0'iOɢ)_O nHzea~m2#qV ݡLV4 ;Yb=+WjNȣ αzL ȓZgLdmZ 0..oQ"Ϥ-`lRw 3nӑHdhAk jvc]vw{ DWa"d!6)h31'Ĕ8L1EXE^|ړMO*MmrA2aRC^Xlv6,5>mS#O}F39GKX%4cs[F };d_k_źso04eD9S'&T7Oj3Df^ßMYBՁaU/I 5cJm¬6`LM>MT(Ӻ\N5k|BinBKd 5sJD˷O_2̇!M&(_O> 6UU@hi ح)d)ұ}pUb[!O6r$2^}Ѹ_}Ay.PӢ~rcgJYX5ė(ޑCunD*O ߟb cx9]-h BW{_z8S~R'lj#bh:,pgް8N~& .,ьkKpxKV{^Еf5tlO4܀)`i"eƅڭX˒0 * {:~Y||QbZu\v{Khg~`j"HQKifނOdzkp[ iC }G~(*\Fx;K_]O~{T,Sܷ! qc?)xR9k"'WRn3OW_hJdWA.-ՠ8 AZߧI%W=dJ.0 fXm|03&2[mYcybͼ.髟lF3]p8 NA2Pk[s!`((GF#]'nQ.u5Qp` i)wUJaJ zj~[jŊ[()o< e*n)u)*4o4/g؇Ey/N_d<:Œfkw2 t ڻ%Nlw (t[8C2S|{{"/njRK &!h[\>a^?WR|(7rOAz޽x'/ TGj7(@szZ6)\OiU=)tHExeqL) p:6TK+_2rʄt[jg-04:[ĺ>nD4}}(5"^MM:$܏<T9KG49[]B@ntΫDɑE5OQ8xk9dAO= "w=6KWyƫyNT >!W#8yrx1 ֞zZ &3{n@[gmx@cPyƠrj">fTg<l89&šqLtY3_ovg M(L*ͣL 7KZ+1Jf9j:Va$#:F~~IOrP[C : IchYcO8YgwU~Px/==?٤)<<& Ge T阚HZ jhqݳLi,+.\R \r.JCR@Ȩhry]o7e4\߁@Dg*?]ԧ%9d Y%Q"%/|B0#s+E-otYtW[Cz}˚< άI0' eoP WV1{DUvcY94<$rCqfqr2z0dMW,/bse) fOTK]5vNj9lJOVҁ׷R4Kg/&v}Fp|Rޡ J2$]=C*/]ƥr!BN$vQ) 'mSpN5._?c/tmGR3Sk5W!3_ЃD@oa0X?4GR9pf A3>A_f(5Fm1y?0K[v m$VcƜQfC ]J9 =y>aY'/a k`,mljIn*q՞Y]RR4g1+QW>7eWEQU1*`_zi؄H&Ho4e(rqkWvuFrt;O&=tÅb^$A ʐXã5MQU:!s8369,AřL߮s_l1şX&cI6ױS >V.DآxHf_kcWjG~O[zpiq®rRm~Bo 즇WkR2V'F/o}ޝ2}WNo%SLxb׫P?Jb )b N cjbpꚣ?C&7Ý$J=\Jq3Gykr X%V | @\=sB{O9pvX-ZT1ә&8[-_g"ۻ[o`_qtB󃳔yT!%e'_;q/YlCtgcmw"QB"9bƴsu9~Rr)&w''fB{'MU+MjtHP0]/cWM"BMiaj lHn uwcRMN(7|]k?t+ϻm'czl-DG7'6Ϧ@|n4$?ۏ$6Ի R?l@wFӀ/Lj*!BP$3wX /?"*:NWv=wI{j7sp٥誖%a]ٟR]vjn`a]5 r#]+,PW> r5 ZARfU|FsqMrcȱH`BXH: t Glq"W,l.*}m<<3J$qVWJ/g묊௡= |Wq`dSOL%.Z0L^B j86aە%a >Dd)zun[_֔۫= E:ޞ.e; ᴱQ4~;ㆶ'ܕ 41 Ha_֭+fsNUMiccXA~~AX0 YFh8NO7$LXCfE@ e8$,EP7&J9yPwr0ތ#c?9zrGY7r9 YzAt/څdkke]Bgu#ɻo*ٺ \!{KL/,Zsh af`}|p7lC@K˰l$rW@|x/Z1}K,ۄP,=kK0`iuʞf.zV7D ^ҡ~/#; ΝobuNs0o rKczT]P]aeaX_ݟ"vsN4R\0ňj5m.ꝙp qM=Zx}g-sTT#ўxfiJ/s?o!ײJy.swR=p`t:Ȝjq C17Ʉ5Y},Yϯ".KZKz>= .w@ byX{ 4g.{25E`xבw R2a1a`˕AUsjTb@p5\t\?46Ba9$U_"p3M͊ I"pyrCJ S/3z^ב6@UKyvOv-;" fZ kӻ+WggbTjws#в|q㙎Y2H RK1C;c)>,AK<űrh#-9M}؁1|W {Jh8fmߢCA A ʈ\A;{:OˇBj 9&_@^eצt7Ci Ry9IvqnDm'ދ+ ƞݸ[P̛ۨC=g#@F|'N^EOq6|uП$vJPv(AtЗ<6/M[*F4{9e?W෸("d~"i_@-h^h_m4Sy{.,r|Iv+};l_h] ^##PNZKޛq"A)LKÞ$ZӢz^۝Oy)Lg!FI꘶T*PJr-&Hl|-eP :$x]BRթ[Sɍ(iV?3Fӛ1EX"yڴ+ 7^Z+ո/aku51eu2L; Aթ(i$[S80"%M@Xưy4LL^;}z1NΙ`/< 9-.J7ϑ 2bՙ~)tf*^T<";rffQ  iL^ѷIO//k, X V/9͚ :Ek+Ly|eμѿNGAq4` ^m\<5LKMeҔZAJ#6}:Y gI>N4xY 1 +*wy<\Kjn=5+ /LɁNDU&->#u:z̎_Ȇ&0 ǜ)W |MiaΞs^y %(?WK:v_RhOX52L_]4?ƅU~5% \^I2!ynɐ&UMin}iب˘}a%TwV=XWs5o~k^ȩc KMc&(0D3IX\WPnYޝlVpogǿ=#kɢ X:W6`]p8S| yX;EE7@ :IJ]OJʣn>#r!:I︆԰SŎK*`(Kn8k?xZKuPRK(R5NsS;‘Kfs__(]~uwN#f޳A#OIFPΰ7.IKb]^#(c/2̐P'.Ji9xE ݉+>.66!_BZ'iMOy?Q =Э9N8e0PS*GEhég<,6j6FlC~d弤,GN3fm+Ss%X]YI8#E)TL~#_~F-pUA~p4f#)x<#1l {J@gox1y\By η& cPl|7cYBw.`hfFNw3 U v.iiFwrMHlxC4/̒B G!vΛ96g dT\>ob4uqG qEsk؀Ps԰keDq1U7Cq'a塁fnoMj)EwG"EV7 h46y${dћ`gf12f%QW^AŚ[BpLFU[: $DRUTUҗERn雧p>L-wxxߦ\JH`g/K9́W|'j[޽R.|ݕ[f[c'Pٕ 8b-+/!^=Ib -VS?6cp '_fVA7b$?$Ҿp/~̩o!Bүk>ۦ~Xpޓf {P%3c,hp5%ewz({}o9;?BYF9qVf LK>IW_l~1{sPu 0RS&-Pџ%x=NCuP@[kjFQ`z#ch: ɛT'<_}?j +:M5DNI;?Dy?DN,z$rCwS}OCo<Ş= F~)'чaWa|]Gkxhxw[W>!}˹+k!)y(LTP\G'GsMֿ:a7XfIaү c 'k gD%T 2!KNI-yy7 JX[ H1Q00V~]2@7*GkUNN :ĶB>'m({ߡ XsJ4p #|0յvTalebgtNUab3쇣 w2Weo\谹=t`ex{q'Qƭh*Km7#lSp>uZKaQDr7cw?w-od#7-k+PH"CkY\u" 4l|hL g+,Cp9߳?跊^ќyѣ١^ 3 fUAD&Pa =-DnUa/Uzo)} UeY8UjyMFQmQw:x r!NZ~ pCiE2*6֌:َ1EՑU2`u1 Z:'~thWF// \!:y05].A~4}vbo$Mrs2c:wq6 8^LT 4#r˦9$wbPaiAVpը9(r(ړ*"F5Dvez&i 7jRf5~i%ن`;KBr>.p/޽_Q+,C}3R3Kc9 c[lH̦А`C'vdCʳ'2ii0^'=B(y&Qԃ yxoҋ_A㢏֓>TxszTiϨ5}7ZL}^%}Q3P7:|*x#9d3`v 24B-y ',Mwև$5v> ZC|9ٕ"W7 -/_GX ^z"7/SYAk**$KIwȬf#ۜB(8Gx]Q?SJzSGm_k$9V%Fԧ]~` \t'c@V76T]1mJaGJQcɯ]v];xDCq8o2QӆB>8[@ JM< 7DG5=VH7+MFdf,/"[PR4pBԀV[d-!L3%` X\ bOuW~mہ;Ls#G<;ZڠXhst0wѡM +G # 2^Pd-VGp%' HcQ-o$';3 2JJ$Fkt䇟&jMgVVd抝3$y8OPX:&y_Zːt1#E 5^,҇7[dh0 S$bU ׸FqݐJ ^cnpWbx2ߏyJ5OASoMNB1u)Y].\vfGS:/:8g*jq"sѹ֥'PoMXg`xI?eb hM80z:Mg6Fz( ,\Jbᚗ `SveG)ƽVG~_/$y Ji;&8Sz\n);Nd]Rs+Y`_Y&2{-D8!i ɜѷ9>0 YZcar/data/Friendly.rda0000644000175100001440000000046612215160035014213 0ustar hornikusersK@7#AA TI^z 1MP:3Ԝrx߼ݝ ټl!J)6O | [eRO !Sﴴl.i>ۼvWۼی:te 'i[;E ޑwM1jDhgi߾ Vɇj2-ꊌvΦay^%m2]59i!f1 KBB3Bh) xJpRcar/data/Freedman.rda0000644000175100001440000000410412215160035014151 0ustar hornikuserseyl\GgݷIﴀB6iI UX'q;1vZ'k;>v  @PABD@ @BHP?J~onyw|ÿnǁ3OȎt# skMv2y4 -&7sIHles5vn3},Co)5乴ș8>)#ϜoFqZ6ϛߖțOwҍC?bb/ϸ:>ϜW9w3fl]C*$|2KyY~_06/fq ݷj?ͭ+^b칏 q'>k)2{"w'pxr◡簧^ Qފ5dAN9edחӝc?&'pj?w1tA 7o)C07o*}+lobCS1jOR[=_gg;Զ2}g myORdy+: BLSc~oޟǐ{r+ux=jbQc-):29YlR<3 cE ΌxjKQ[jK{qo͕x|~6[ 339sktNn)(gI甿Ӝ U̩(@9kG mFţk/ܬUp\qGYg/k;.;cui.˾۱9otG([71/PudE>ebԼf>#j@iw\˾\Jlozu#.4[Z;~8t-'pD椯۩-H-(RBHHƂEj.fFasP^HgAn8lznBiѕl]o[ƛ*KfQU#9; #aRdpC lepaS:XמENoz{rZ=n֙; %I wOvǙw;L2C7Y ngU]V3hNumwZZK]5LgE=*+ܕYVeMz"}DVg[n-VD` $ [h !ju]EQ N%DMHP1nJD FB"ˢ AI>ܷ.y>=9=޶vTY;DRMf2S6P"`aNFi|q>0>DPEz'C+w)Q 1v9g*8k]P=$ Y&zRϘNU ^0^nzS~8]C9직_?rk1| <\~v>ckJwkޕ!SA=\w_ (0*Wk GXJa~eqzEKF[=Qm:9y~ǞO1zJ>X *i&{I3yt}?V6 ; U.+Pch.k{8,ݕuf| B9܏W-l=o<)|5g"ayLa}7k֔6 g}7FsAזkOK5-:P˨piap.|HG;]µh;6 y5A\Uz}+{n?c.z/&vm. 꺅cZam)W"օcѫ ;.;W}Mo 4OQڲ!Aq#QB?ᜓ,P;dqy!-nX VWRH8ÞgUaJ$l|>+^?hW8 $\|\;yqka. sJyn|75Dgyk5ޝTk X۽ch"k1縍c=}J8Gc+;`x[W~mޫd -, JPf,OYrYi4$$~ul9b2_{>ڥFJ\RP6 car/data/Guyer.rda0000644000175100001440000000044612215160035013530 0ustar hornikusersMK@'UHDM R4M (=%B!f%Z|[YGO0<#"A8"ۧΈ>~V |pN@F ౺;9G p\늆8Xf;:a{UʨsT_>NTTŅ⟱aj zPf_mͫ*3ULZؤZ@zK7o ՙf\f棳ޱ͓,K%dD,!e%ZzBk}k5#/J/ t1car/data/Baumann.rda0000644000175100001440000000110112215160034014002 0ustar hornikusersBZh91AY&SYx^4@/߀]`hɨzS)D6Ҋ=?*h@h#E"T=54 @"\ ʐKSL[ZPK$ 5K My-E謐qQeόT0T9XFN* .pS. j,H 8uV{աC\ l?YsS !LpX39'&ȕXV4M9gQ~e0av1­21L` S 01,?z3car/data/Moore.rda0000644000175100001440000000070212215160035013511 0ustar hornikusersBZh91AY&SYAŎ@/ߠ-, SLM& چ4zS"H4D'@48c6Q28m JPU@T7KpDPW[ET6plhΩ1-f|B4nn5jϢ:O.] CYӫ$dQG.ӧv   _7 $`%CDJ%1lr8To[Nsab?+! 4 6 ГLHX ell@y\ϕYeffmc%""!)kC33"""""^ޙ{`.)8>w1X<\ps9|aހbP IښD*K -yy0 ܑN$篗eWk֜yt?Uq8V۪RnWʪں?))jm~Z-jm/)û{ڹSyַn+Z^|\--NZ6)?w˶ $<)rHBZc$$ @f}˗] F4)4Jii|'z=1c1;:Jy:Zc}$L033RH 2BI!"EV !)S$3B1cii$I$I:VcUUW9*I+$JI%bRIX$TV*I+nݮꪪՊJI%bRIX$TUIMW;mʪޚaUUU49ݪzhsUjֵiZ$I&e{9@gi$I$I3/{9r;I$I$I{sUUUU}w9zN?Z 5{]TKH{(0 %:U}KhB 7GhӍKf ҈𪲿 #aLH[)„acar/data/USPop.rda0000644000175100001440000000061012215160036013435 0ustar hornikusers r0b```b`f`d`b2Y# 'f /```+b`b1 @,2@@l.@@9@\ @SxM@| ?A5Od.MߥGk6s00]Pc5 XJ<%,{;fx~C0Mzpk_qjLs-3O-f*!UɮiY23Wټʑr ܸ}D|S^;N;X=sS pAY*SlҜĒ<4Ez0f_ۑX &ȕXVa{=car/data/Mroz.rda0000644000175100001440000002346012215160035013365 0ustar hornikusers7zXZi"6!X&])TW"nRʟsef,ť:6ٔ51Jdwq֩Ge)#rܔ_1.yЪnkl@ᄲ"aPsRAs9̍׾9k3aZ\ u ;MDD.Z ]"ӒY1 pZĤjx$Yecp* s5,xEY|g6&}|3a`'g j #?-JraTӖkoV6śB0o-.y<D6ň-wPAtA[z36jyJ<]`hP$avc)+vG˓e}5FH9y!Mۯ|ṨIG_/'g.W"S&/&Pl] Rz*(\emvz(l|[Nay~bzgl4q-(BL.EZO;:HLQFK;ߥThh_SĿl 9a !%K1;"Cq=4)+tzMSxbEʂ-F(_B#D`K7^N]|sLjT8Wd! 37POB,q}W0'DƷz;ghn9^^9?\s'˖AT>@$X bܗ|3@h73hTyT:8^[ <0rНj{ UdٶE@嘦Jvn ֿ&^zL[a5!x] I#m''z%RS 9{!r)8S =7^.ITi ^waI:gcuQ7jp!S f~ ~Fc=_Tdxj"VE0!Do(=Rq| gHu;vb_kk0fd,N@" 4T}x;XޚT9C83%p9Nq&yoגwzqF(aYݼ}l!>fN`(*tÁw6GMF o1S_X 6k'.kTy [6BD!(mW`-[ ~ {<$ma:"p6!M:"ϋoK7T7{TusRgO+wHFRghzac|X]5gΜ"B]?D}r1{?;`V__o/| KN+dFBxCa8Sf4h ` WD%VyhvwT㾗ǃc傄&㩯tW?/`"(!?~av)E2BY-< \a /CG4ܧJ8kF1@ (\{|G'x/cЉX}o󢨇JWPQiKM }DCƹbU5YHWN}g! sj{#*!} }$EGtn󬝙 {dR֊u]?B+Ӥ*\_E*o|XkP-y Dӳ}=!E"J dP~?^GO:r|h6rԗ$FcGXe2j^],ahm͠W&$YSbaSB<+Yz2{2&Xp{vp7Ξ2=ob  8(IM lk6ѵ͘}&gGc x.y"TBYQU,VK=]&畿X HN?iOnB9豅R}Q"Jj7U/D堀5Z 5v ~m9<6(0qI0beWg  50j]h@yf~'xj%~|\oYa~!"ܚo~R* ) PVcC [ǚ ?65%kft=kx1GՔ#:9 @^xVf6rx<ēհ&b6eڗ `U(O.' 1R'2,N'L("0jp:n*"։A1$7̱P c%$ٯ#1xN;pw|6͸9 ҳi5;$U3fCuX=u&aAtORsN#J )>6^Y\ LA/`k vYç6j=%\_:3V6:#GZ H>izA0;@\qrH!t6:F5z[k<59?O{0[9P`u~4?ru)R4[xV1/w#G;}X?{y{w_v{-sg;= Fێ;1IMKÌ cWI!7I6cE[: F8O|"rCo<,4@ Gn,Fv`\<z<2fڥazU6K uF,Uz>fͫz˥D[a3|%f1PYn(TdحY08<ێmjZLI JsAհvD  !` ~W_22<~2+c׿κd6{t2_Jkl dO ix[H*d%tHݵv뿵H{-NtCf[:T_"B@Zwᅝc]'eswR k^Sb4~iJAhO+pčՂ84;5XLÞ߰a%#Tx{Sy!7إ솶;hj[JN=j|/ L4Y%3Z0)o1-|D'oڒ(xQ4A֝"L$X3%j8#^۱l~&{ѫŤKJ1XX^i_݄LDRt0 ō^[Ej+W_Der@W0fJr/sQAAd&Lgٞܯ;~Mfy;.=KUեsU5Q2]zq~\#R#3,T)PtEM %$-;=uDwLI)2}R[ţ4 r ΙR]܋;w:lX17n :wtfsLK:)LX_y;+fN)#!ɻ iG5|߶F m)IE4(t B_8jdb.~UX}8mZaT+(>F&|- >"D\A&TKP hƢjj=Lw6lAJr~(Jf,SY6 F=*6K[ȏy;@ZM͢"aj+I뀈GT(!+6xwQwh+|hw/E#PzZ.|5 t0Tw[Z#3>H>#]C*GGl|8\F4 ƊJc;l7)!Ó  TZAݠO1NM{ly㱍}pn8az3X{L#2+Dx}%Z9Њ3H,Q{M> 1 eYA*W 93(zx| Wޫ_D.,πP쇘 3(R^m BǙ;Z2AP<;0K5Dv7J K{.gu~7 F`TB@DњD{wʅX@& =ex$٬aB?qyw \[x: 7&$ZZLN!cwgʸ˼)t|w0pHPh bߠFz\ Ȓ| ٍ+1g!_1ۿJ9GY(a[61V-]*˯ZsZ0Fxks&]ğ~8MqQCQ!}c;xlhfAw_2m}"l BV?z2j"TSED+ػ"Z@DmeW A-d_^"EDC 80h/tCRHglMDprt9ٛy4WL,պdnqq,[xS;'@u}zޫ8-ͧQ=/;~Йp31AM" zfyh7FFF>+$jtg@6Bg"6vQy5?XGI 2Z^}(E:r&pXwZ}S{ Pr9DPI62F4룦8R"ǹrUu~[h]{#2#";䋐 \[ښE=V;a}ŦeC=x2[yt=p~8Bw;SZr- bWFbBiwvY)m 6e(<>;+lN@z Ptaw#e蘄k:WP]~[(UbJOe(*<eyiKFf^_ Wj~u][p{ =K4k}RL|뻆ArJ/:dBِ5"5m܊A(i;5Nkjo9 Q6)4,eETUزUû^`Qo+\޽L뷳a@'y=ERKG @lFTQPc8c01t~Ǖs+*RgI55Q{T/3-LJE)2X۵~S˛JH#Q:w%@|qL tgfG'Rd_C[Ts&H[@3{Ѿz/ض\ejfG\jVMPNɣiODA]괁*L3sh 4b0y:  dN08]3uLRMҁkB'C*ӑ=ljߞ/]8>G~9P)|bTh%kN"{ V|MĮ܄?f0>[׵e{&rTTJ vnʊ!2b]ec\ؼA ҷ)p%7886#bfuWifjQ1ϯO_1_|Ujn#mdб @ )ȁ bn^H=v,8#* t8/-__>D7E*GuQ/n*B GRqPOe{R*lCz1L N(Z7m-*3̺ CwgE]~Ȣ_|!rf6:w))knFk vR$ѺXKpIA?V'o@|zH@/=U⏟^u(]ZPϜ7`YnyeGDs6󂖡Ow|>E%0 YZcar/R/0000755000175100001440000000000012215157011011231 5ustar hornikuserscar/R/ceresPlots.R0000644000175100001440000001551512204733747013524 0ustar hornikusers# CERES plots (J. Fox) # last modified 9 October 2009 by J. Fox # modified 26 Nov 2009 by S. Weisberg # changed layout and point marking. # modified 15 Mar 2010 by S. Weisberg to make the following work: # m1 <- lm(longley) # ceresPlots(longley) # 14 April 2010: set id.n = 0. J. Fox # new args for showLabels 15 April S. Weisberg # modified 2 Sept 2010 by S. Weisberg, made colors, axes lables, and # arguments more consistent with other functions; ... passes args to plot # and boxplot. # 16 June 2011 allow layout=NA, in which case the layout is not set in this # function, so it is the responsibility of the user # 14 Sept 2012 use the ScatterplotSmoothers in car # 18 Sept 2012 restore smooth and span args # 20 Aug 2013 replace residuals.glm() with residuals(). John ceresPlots<-function(model, terms= ~ ., layout=NULL, ask, main, ...){ terms <- if(is.character(terms)) paste("~", terms) else terms vform <- update(formula(model), terms) if(any(is.na(match(all.vars(vform), all.vars(formula(model)))))) stop("Only predictors in the formula can be plotted.") mf <- attr(model.frame(model), "terms") terms <- attr(mf, "term.labels") # this is a list vterms <- attr(terms(vform), "term.labels") good <- NULL if (any(attr(terms(model),"order")>1)) { stop("CERES plots not available for models with interactions.")} for (term in vterms) if( inherits(model$model[[term]], "numeric") | inherits(model$model[[term]], "integer")) good <- c(good,term) nt <- length(good) if(length(good) < length(vterms)) warning("Factors skipped in drawing CERES plots.") vterms <- good if (nt == 0) stop("No plots specified") if (missing(main)) main <- if (nt == 1) "CERES Plot" else "CERES Plots" if (nt == 0) stop("No plots specified") if (nt > 1 & (is.null(layout) || is.numeric(layout))) { if(is.null(layout)){ layout <- switch(min(nt, 9), c(1, 1), c(1, 2), c(2, 2), c(2, 2), c(3, 2), c(3, 2), c(3, 3), c(3, 3), c(3, 3)) } ask <- if(missing(ask) || is.null(ask)) prod(layout)1)) { stop("ceres plot not available for models with interactions.") } .x<-xvars<-NULL for (xvar in terms){ if (is.null(model$contrasts[[xvar]])){ xvars<-c(xvars,xvar) xx[obs]<-fitted.values(loess(as.formula(paste("mod.mat[,'",xvar,"']~mod.mat[,'",var,"']",sep="")))) .x<-cbind(.x, xx) } } if (is.null(xvars)) stop("There are no covariates.") n.x<-length(xvars) mf<-na.omit(expand.model.frame(model, all.vars(formula(model)))) rownames(.x)<-all.obs mf$.x<-.x[obs,] aug.model <- update(model, . ~ . + .x, data=mf, subset=NULL) aug.mod.mat<-model.matrix(aug.model) coef<-coefficients(aug.model) k<-length(coef) posn<-k:(k-n.x+1) partial.res<-residuals(aug.model, "partial")[,var] + aug.mod.mat[,posn] %*% as.matrix(coef[posn]) xlab <- if(!missing(xlab)) xlab else var ylab <- if(!missing(ylab)) ylab else paste("CERES Residual(",responseName(model),")", sep="") plot(mod.mat[,var], partial.res, xlab=xlab, col=col, pch=pch, ylab=ylab, type="n", ...) if(grid){ grid(lty=1, equilogs=FALSE) box()} points(mod.mat[,var], partial.res, col=col, pch=pch) showLabels(mod.mat[,var], partial.res, labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col) if (line) abline(lm(partial.res~mod.mat[,var]), lty=2, lwd=lwd, col=col.lines[1]) if (is.function(smoother)) { smoother(mod.mat[, var], partial.res, col=col.lines[2], log.x=FALSE, log.y=FALSE, spread=FALSE, smoother.args=smoother.args) # lines(lowess(mod.mat[,var], partial.res, iter=iter, f=span), lwd=lwd, # col=col.lines[2]) } } ceresPlot.glm<-function(model, ...){ ceresPlot.lm(model, ...) } car/R/outlierTest.R0000644000175100001440000000345111361367620013714 0ustar hornikusers#------------------------------------------------------------------------------- # Revision history: # 2009-09-28 by J. Fox (renamed) # 2010-04-14 by J. Fox fixed error in reporting largest abs rstudent #------------------------------------------------------------------------------- # Bonferroni test for an outlier (J. Fox) outlierTest <- function(model, ...){ UseMethod("outlierTest") } outlierTest.lm <- function(model, cutoff=0.05, n.max=10, order=TRUE, labels=names(rstudent), ...){ rstudent <- rstudent(model) labels <- if(is.null(labels)) seq(along=rstudent) else labels if (length(rstudent) != length(labels)) stop("Number of labels does not correspond to number of residuals.") df <- df.residual(model) - 1 rstudent <- rstudent[!is.na(rstudent)] n <- length(rstudent) p <- if (class(model)[1] == "glm") 2*(pnorm(abs(rstudent), lower.tail=FALSE)) else 2*(pt(abs(rstudent), df, lower.tail=FALSE)) bp <- n*p ord <- if (order) order(bp) else 1:n ord <- ord[bp[ord] <= cutoff] result <- if (length(ord) == 0){ which <- which.max(abs(rstudent)) list(rstudent=rstudent[which], p=p[which], bonf.p=bp[which], signif=FALSE, cutoff=cutoff) } else { if (length(ord) > n.max) ord <- ord[1:n.max] result <- list(rstudent=rstudent[ord], p=p[ord], bonf.p=bp[ord], signif=TRUE, cutoff=cutoff) } class(result)<-"outlierTest" result } print.outlierTest<-function(x, digits=5, ...){ if (!x$signif){ cat("\nNo Studentized residuals with Bonferonni p <", x$cutoff) cat("\nLargest |rstudent|:\n") } bp <- x$bonf bp[bp > 1] <- NA table <- data.frame(rstudent=x$rstudent, "unadjusted p-value"=signif(x$p, digits), "Bonferonni p"=signif(bp, digits), check.names=FALSE) rownames(table) <- names(x$rstudent) print(table) invisible(x) } car/R/boxTidwell.R0000644000175100001440000000573611350024515013505 0ustar hornikusers#------------------------------------------------------------------------------- # Revision history: # 2009-09-29 by J. Fox (renamed) # 2010-03-11 by J. Fox: output changed # 2010-03-13 by J. Fox: output row label fixed when just one X #------------------------------------------------------------------------------- # Box-Tidwell transformations (J. Fox) boxTidwell <- function(y, ...){ UseMethod("boxTidwell") } boxTidwell.formula <- function(formula, other.x=NULL, data=NULL, subset, na.action=getOption("na.action"), verbose=FALSE, tol=.001, max.iter=25, ...) { m <- match.call(expand.dots = FALSE) if (is.matrix(eval(m$data, sys.frame(sys.parent())))) m$data <- as.data.frame(data) m$formula <- if (is.null(other.x)) formula else as.formula(paste(formula[2], "~", formula[3], "+", other.x[2])) m$max.iter <- m$tol <- m$verbose <- m$other.x <- m$... <- NULL m[[1]] <- as.name("model.frame") mf <- eval(m, sys.frame(sys.parent())) response <- attr(attr(mf, "terms"), "response") if (!response) stop(paste("no response variable in model")) X1 <- model.matrix(formula, data=mf)[,-1] X2 <- if (is.null(other.x)) NULL else model.matrix(other.x, data=mf)[,-1] y <- model.response(mf, "numeric") boxTidwell.default(y, X1, X2, max.iter=max.iter, tol=tol, verbose=verbose, ...) } boxTidwell.default <- function(y, x1, x2=NULL, max.iter=25, tol=.001, verbose=FALSE, ...) { x1 <- as.matrix(x1) if (any(x1 <= 0)) stop("the variables to be transformed must have only positive values") var.names <- if(is.null(colnames(x1))) seq(length.out=ncol(x1)) else colnames(x1) k.x1 <- length(var.names) x.log.x <- x1*log(x1) mod.1 <- lm(y ~ cbind(x1, x2), ...) mod.2 <- lm(y ~ cbind(x.log.x, x1, x2), ...) seb <- sqrt(diag(vcov(mod.2))) which.coefs <- 2:(1 + k.x1) t.vals <- ((coefficients(mod.2))/seb)[which.coefs] initial <- powers <- 1 + coefficients(mod.2)[which.coefs]/coefficients(mod.1)[which.coefs] pvalues<-2*(pnorm(abs(t.vals), lower.tail=FALSE)) iter <- 0 last.powers <- 1 while ((max(abs((powers - last.powers)/(powers + tol))) > tol) && (iter <= max.iter) ) { iter <- iter+1 x1.p <- x1^matrix(powers, nrow=nrow(x1), ncol=ncol(x1), byrow=TRUE) x.log.x <- x1.p*log(x1.p) mod.1 <- lm.fit(cbind(1, x1.p, x2), y, ...) mod.2 <- lm.fit(cbind(1, x.log.x, x1.p, x2), y, ...) last.powers <- powers powers <- powers * (1 + coefficients(mod.2)[which.coefs]/coefficients(mod.1)[which.coefs]) if (verbose) cat(" iter =", iter, " powers =", powers, "\n") } if (iter > max.iter) warning("maximum iterations exceeded") result <- cbind( t.vals, pvalues, powers) colnames(result) <- c("Score Statistic","p-value","MLE of lambda") rownames(result) <- if (nrow(result) == 1) "" else var.names result <- list(result=result, iterations=iter) class(result)<-"boxTidwell" result } print.boxTidwell <- function(x, digits=getOption("digits"), ...){ print(round(x$result, digits)) cat("\niterations = ", x$iterations,"\n") } car/R/compareCoefs.R0000644000175100001440000000561612161401342013771 0ustar hornikusers# 21 May 2010: small changes to output when there is just one model. J. Fox # 15 Aug 2010: changed name of function to compareCoefs to avoid name clash. J. Fox # 18 May 2011: check for 'mer' objects, and handle them correctly. S. Weisberg # 8 Sep 2011: check for 'lme' objects, and handle them correctly. S. Weisberg # 11 Jan 2012: fix to work with any 'S4' object with a coef() method. # suggested by David Hugh-Jones University of Warwick http://davidhughjones.googlepages.com # 3 May 2012: fixed bug if models are less than full rank. # 17 Sept 2012: suppressing printing calls when there are none. J. Fox # 22 June 2013: tweaks for lem4. J. Fox compareCoefs <- function(..., se=TRUE, print=TRUE, digits=3){ # fixefmer <- function(m) { # if(inherits(m, "mer")) m@fixef else fixef(m) # } models <- list(...) n.models <- length(models) if (n.models < 1) return(NULL) getnames <- function(model) { if (inherits(model, "merMod") || inherits(model, "mer") | inherits(model, "lme")) names(fixef(model)) else names(coef(model)) } getcoef <- function(model) { if (inherits(model, "merMod") || inherits(model, "mer") | inherits(model, "lme")) fixef(model) else coef(model) } getcall <- function(model) { deparse(if (isS4(model)) model@call else model$call, width.cutoff = getOption("width") - 9) } getvar <- function(model) { if (inherits(model, "merMod") || inherits(model, "mer")) as.matrix(vcov(model)) else vcov(model) } coef.names <- unique(unlist(lapply(models, getnames))) table <- matrix(NA, length(coef.names), n.models*(1 + se)) rownames(table) <- coef.names colnames(table) <- if (se) if (n.models > 1) paste(rep(c("Est.", "SE"), n.models), rep(1:n.models, each=2)) else c("Estimate", "Std. Error") else if (n.models > 1) paste(rep("Est.", n.models), 1:n.models) else "Estimate" calls <- !any(sapply(models, getcall) == "NULL") if(print == TRUE && calls) cat("\nCall:") for (i in 1:n.models){ model <- models[[i]] fout <- deparse(getcall(model), width.cutoff=getOption("width") - 9) mod <- if (n.models > 1) paste(i, ":", sep="") else "" if(print == TRUE && calls) cat(paste("\n", mod, fout[1], sep="")) if(length(fout) > 1) for (f in fout[-1]) if(print) cat("\n",f) if (se) { ests <- getcoef(model) new <- cbind(ests, rep(NA, length(ests))) new[!is.na(ests), 2] <- sqrt(diag(getvar(model))) table[getnames(model), 2*(i - 1) + c(1, 2)] <- new} # cbind(getcoef(model), sqrt(diag(getvar(model)))) } else table[getnames(model), i] <- getcoef(model) } if(print == TRUE){ cat("\n") printCoefmat(table, na.print="", digits=digits, tst.ind=NULL)} else table } car/R/avPlots.R0000644000175100001440000001372111576447475013041 0ustar hornikusers# October 23, 2009 avPlots by S. Weisberg. avPlot by John Fox # 13 January 2010: changed default id.n=3. J. Fox # 13 March 2010: added intercept argument. J. Fox # 14 April 2010: set id.n = 0. J. Fox # 22 April 2010: modified id.n S. Weisberg # 10 May 2010: added gridlines # 25 May 2010: changed default color scheme # 5 June 2011: made several modifications, slightly adapting code contributed by M. Friendly (J. Fox): # added ellipse, ellipse.args arguments # added main argument to avPlot.lm # return x and y residuals invisibly # 16 June 2011 allow layout=NA, in which case the layout is not set in this # function, so it is the responsibility of the user avPlots <- function(model, terms=~., intercept=FALSE, layout=NULL, ask, main, ...){ terms <- if(is.character(terms)) paste("~",terms) else terms vform <- update(formula(model),terms) if(any(is.na(match(all.vars(vform), all.vars(formula(model)))))) stop("Only predictors in the formula can be plotted.") terms.model <- attr(attr(model.frame(model), "terms"), "term.labels") terms.vform <- attr(terms(vform), "term.labels") terms.used <- match(terms.vform, terms.model) mm <- model.matrix(model) model.names <- attributes(mm)$dimnames[[2]] model.assign <- attributes(mm)$assign good <- model.names[!is.na(match(model.assign, terms.used))] if (intercept) good <- c("(Intercept)", good) nt <- length(good) if (nt == 0) stop("No plots specified") if (missing(main)) main <- if (nt == 1) paste("Added-Variable Plot:", good) else "Added-Variable Plots" if (nt == 0) stop("No plots specified") if (nt > 1 & (is.null(layout) || is.numeric(layout))) { if(is.null(layout)){ layout <- switch(min(nt, 9), c(1, 1), c(1, 2), c(2, 2), c(2, 2), c(3, 2), c(3, 2), c(3, 3), c(3, 3), c(3, 3)) } ask <- if(missing(ask) || is.null(ask)) prod(layout) DW[lag,]))/reps } } else { for (lag in 1:max.lag) { p[lag] <- (sum(dw[lag] < DW[lag,]))/reps } } result <- list(r=r, dw=dw, p=p, alternative=alternative) class(result)<-"durbinWatsonTest" result } } durbinWatsonTest.default <- function(model, max.lag=1, ...){ # in this case, "model" is the residual vectors if ((!is.vector(model)) || (!is.numeric(model)) ) stop("requires vector of residuals") if (any(is.na(model))) stop ('residuals include missing values') n <- length(model) dw <- rep(0, max.lag) den <- sum(model^2) for (lag in 1:max.lag){ dw[lag] <- (sum((model[(lag+1):n] - model[1:(n-lag)])^2))/den } dw } print.durbinWatsonTest <- function(x, ...){ max.lag <- length(x$dw) result <- if (is.null(x$p)) cbind(lag=1:max.lag,Autocorrelation=x$r, "D-W Statistic"=x$dw) else cbind(lag=1:max.lag,Autocorrelation = x$r, "D-W Statistic" = x$dw, "p-value"= x$p) rownames(result) <- rep("", max.lag) print(result) cat(paste(" Alternative hypothesis: rho", if(max.lag > 1) "[lag]" else "", c(" != ", " > ", " < ")[which(x$alternative == c("two.sided", "positive", "negative"))], "0\n", sep="")) invisible(x) } dwt <- function(...) durbinWatsonTest(...) car/R/some.R0000644000175100001440000000101111253536255012324 0ustar hornikusers# adapted from head() and tail() some <- function(x, ...) UseMethod("some") some.default <- function(x, n=10, ...){ len <- length(x) ans <- x[sort(sample(len, min(n, len)))] if (length(dim(x)) == 1) array(ans, n, list(names(ans))) else ans } some.matrix <- function(x, n=10, ...){ nr <- nrow(x) x[sort(sample(nr, min(n, nr))), , drop = FALSE] } some.data.frame <- function(x, n=10, ...){ nr <- nrow(x) x[sort(sample(nr, min(n, nr))), , drop=FALSE] } car/R/logit.R0000644000175100001440000000135011771714601012503 0ustar hornikusers# logit transformation of proportion or percent (J. Fox) # last modified 2012-06-24 by J. Fox logit <- function(p, percents=range.p[2] > 1, adjust){ range.p <- range(p, na.rm=TRUE) if (percents){ if (range.p[1] < 0 || range.p[1] > 100) stop("p must be in the range 0 to 100") p <- p/100 range.p <- range.p/100 } else if (range.p[1] < 0 || range.p[1] > 1) stop("p must be in the range 0 to 1") a <-if (missing(adjust)) { if (isTRUE(all.equal(range.p[1], 0)) || isTRUE(all.equal(range.p[2], 1))) .025 else 0 } else adjust if (missing(adjust) && a != 0) warning(paste("proportions remapped to (", a, ", ", 1-a, ")", sep="")) a <- 1 - 2*a log((0.50 + a*(p - 0.50))/(1 - (0.50 + a*(p - 0.50)))) } car/R/scatterplotMatrix.R0000644000175100001440000002011512206732123015107 0ustar hornikusers# fancy scatterplot matrices (J. Fox) # 2010-09-04: J. Fox: changed color choice # 2010-09-16: fixed point color when col is length 1 # 2011-03-08: J. Fox: changed col argument # 2012-04-18: J. Fox: fixed labels argument in scatterplotMatrix.formula() # 2012-09-12: J. Fox: smoother now given as function # 2012-09-19: J. Fox: restored smooth and span args for backwards compatibility # 2013-02-08: S. Weisberg: bug-fix for showLabels with groups # 2013-08-26: J. Fox: added use argument scatterplotMatrix <- function(x, ...){ UseMethod("scatterplotMatrix") } scatterplotMatrix.formula <- function (formula, data=NULL, subset, labels, ...) { na.save <- options(na.action=na.omit) on.exit(options(na.save)) na.pass <- function(dframe) dframe m <- match.call(expand.dots = FALSE) if (is.matrix(eval(m$data, sys.frame(sys.parent())))) m$data <- as.data.frame(data) m$na.action <- na.pass m$labels <- m$formula <- m$... <- NULL m$na.action <- na.pass m[[1]] <- as.name("model.frame") if (!inherits(formula, "formula") | length(formula) != 2) stop("invalid formula") rhs <- formula[[2]] if ("|" != deparse(rhs[[1]])){ groups <- FALSE } else{ groups <- TRUE formula<-as.character(c(formula)) formula<-as.formula(sub("\\|", "+", formula)) } m$formula <-formula if (missing(data)){ X <- na.omit(eval(m, parent.frame())) if (missing(labels)) labels <- gsub("X", "", row.names(X)) } else{ X <- eval(m, parent.frame()) } if (!groups) scatterplotMatrix(X, labels=labels, ...) else{ ncol<-ncol(X) scatterplotMatrix.default(X[, -ncol], groups=X[, ncol], labels=labels, ...) } } scatterplotMatrix.default <- function(x, var.labels=colnames(x), diagonal=c("density", "boxplot", "histogram", "oned", "qqplot", "none"), adjust=1, nclass, plot.points=TRUE, smoother=loessLine, smoother.args=list(), smooth, span, spread = !by.groups, reg.line=lm, transform=FALSE, family=c("bcPower", "yjPower"), ellipse=FALSE, levels=c(.5, .95), robust=TRUE, groups=NULL, by.groups=FALSE, use=c("complete.obs", "pairwise.complete.obs"), labels, id.method="mahal", id.n=0, id.cex=1, id.col=palette()[1], col=if (n.groups == 1) palette()[3:1] else rep(palette(), length=n.groups), pch=1:n.groups, lwd=1, lty=1, cex=par("cex"), cex.axis=par("cex.axis"), cex.labels=NULL, cex.main=par("cex.main"), legend.plot=length(levels(groups)) > 1, row1attop=TRUE, ...){ if (id.method[1] == "identify") stop("interactive point identification not permitted") family <- match.arg(family) use <- match.arg(use) na.action <- if (use == "complete.obs") na.omit else na.pass if (missing(labels)){ labels <- rownames(x) if (is.null(labels)) labels <- as.character(seq(length.out=nrow(x))) } if (!(missing(groups))){ x <- na.action(data.frame(groups, labels, x, stringsAsFactors=FALSE)) # groups <- as.factor(as.character(x[, 1])) if (!is.factor(groups)) groups <- as.factor(as.character(x[,1])) labels <- x[, 2] x <- x[, -(1:2)] } else { x <- na.action(data.frame(labels, x, stringsAsFactors=FALSE)) labels <- x[, 1] x <- x[, -1] } if (missing(nclass)) nclass <- "FD" legendPlot <- function(){ usr <- par("usr") legend("bottomleft", bg="white", legend=levels(groups), pch=pch, col=col[1:n.groups], cex=cex) } do.legend <- legend.plot # The following panel function adapted from Richard Heiberger panel.density <- function(x, ...){ dens.x <- density(x, adjust = adjust, na.rm=TRUE) lines(dens.x$x, min(x, na.rm=TRUE) + dens.x$y * diff(range(x, na.rm=TRUE))/diff(range(dens.x$y, na.rm=TRUE))) rug(x) if (do.legend) legendPlot() do.legend <<- FALSE } panel.histogram <- function(x, ...){ par(new=TRUE) hist(x, main="", axes=FALSE, breaks=nclass, col=col[1]) if (do.legend) legendPlot() do.legend <<- FALSE } panel.boxplot <- function(x, ...){ par(new=TRUE) boxplot(x, axes=FALSE, main="", col=col[1]) if (do.legend) legendPlot() do.legend <<- FALSE } # The following panel function adapted from Richard Heiberger panel.oned <- function(x, ...) { range <- range(x, na.rm=TRUE) delta <- diff(range)/50 y <- mean(range) segments(x - delta, x, x + delta, x, col = col[3]) if (do.legend) legendPlot() do.legend <<- FALSE } panel.qqplot <- function(x, ...){ par(new=TRUE) qqnorm(x, axes=FALSE, xlab="", ylab="", main="", col=col[3]) qqline(x, col=col[1]) if (do.legend) legendPlot() do.legend <<- FALSE } panel.blank <- function(x, ...){ if (do.legend) legendPlot() do.legend <<- FALSE } # smooth and span for backwards compatibility if (!missing(smooth)) { smoother <- if (isTRUE(smooth)) loessLine else FALSE } if (!missing(span)) smoother.args$span <- span which.fn <- match(match.arg(diagonal), c("density", "boxplot", "histogram", "oned", "qqplot", "none")) diag <- list(panel.density, panel.boxplot, panel.histogram, panel.oned, panel.qqplot, panel.blank)[[which.fn]] groups <- as.factor(if(missing(groups)) rep(1, length(x[, 1])) else groups) n.groups <- length(levels(groups)) if (n.groups > length(col)) stop("number of groups exceeds number of available colors") if (length(col) == 1) col <- rep(col, 3) if (transform != FALSE | length(transform) == ncol(x)){ if (transform == TRUE & length(transform) == 1){ transform <- if (by.groups) coef(powerTransform(as.matrix(x) ~ groups, family=family), round=TRUE) else coef(powerTransform(x, family=family), round=TRUE) } for (i in 1:ncol(x)){ x[, i] <- if (family == "bcPower") bcPower(x[, i], transform[i]) else yjPower(x[, i], transform[i]) var.labels[i] <- paste(var.labels[i], "^(", round(transform[i],2), ")", sep="") } } labs <- labels pairs(x, labels=var.labels, cex.axis=cex.axis, cex.main=cex.main, cex.labels=cex.labels, cex=cex, diag.panel=diag, row1attop = row1attop, panel=function(x, y, ...){ for (i in 1:n.groups){ subs <- groups == levels(groups)[i] if (plot.points) points(x[subs], y[subs], pch=pch[i], col=col[if (n.groups == 1) 3 else i], cex=cex) if (by.groups){ if (is.function(smoother)) smoother(x[subs], y[subs], col=col[i], log.x=FALSE, log.y=FALSE, spread=spread, smoother.args=smoother.args) if (is.function(reg.line)) reg(reg.line, x[subs], y[subs], lty=lty, lwd=lwd, log.x=FALSE, log.y=FALSE, col=col[i]) if (ellipse) dataEllipse(x[subs], y[subs], plot.points=FALSE, levels=levels, col=col[i], robust=robust, lwd=1) showLabels(x[subs], y[subs], labs[subs], id.method=id.method, id.n=id.n, id.col=col[i], id.cex=id.cex, all=list(labels=labs, subs=subs)) } } if (!by.groups){ if (is.function(reg.line)) abline(reg.line(y ~ x), lty=lty, lwd=lwd, col=col[1]) if (is.function(smoother)) smoother(x, y, col=col[2], log.x=FALSE, log.y=FALSE, spread=spread, smoother.args=smoother.args) if (ellipse) dataEllipse(x, y, plot.points=FALSE, levels=levels, col=col[1], robust=robust, lwd=1) showLabels(x, y, labs, id.method=id.method, id.n=id.n, id.col=id.col, id.cex=id.cex) } }, ... ) } spm <- function(x, ...){ scatterplotMatrix(x, ...) } car/R/bootCase.R0000644000175100001440000000506312166631153013130 0ustar hornikusers# March 9, 2012 modified by SW as suggested by Derek Ogle to return an object # of class c("bootCase", "matrix"). # May 2012 added methods for 'bootCase' # 2012-12-10 replaced .GlobalEnv by car:::.carEnv to suppress warnings # 2013-01-28 Changed argument f to f. # 2013-07-08 Changed .carEnv to car:::.carEnv nextBoot <- function(object, sample){UseMethod("nextBoot")} nextBoot.default <- function(object, sample){ update(object, subset=sample) } nextBoot.lm <- function(object, sample) nextBoot.default(object, sample) nextBoot.nls <- function(object, sample){ # modify to assure resampling only rows in the original subset 9/1/2005 update(object,subset=sample,start=coef(object), data=data.frame(update(object,model=TRUE)$model))} bootCase <- function(object, f.=coef, B=999){UseMethod("bootCase")} bootCase.lm <- function(object, f.=coef, B=999) { bootCase.default(object, f., B, names(resid(object))) # bootCase.default(update(object, # data=na.omit(model.frame(object))), f, B) } bootCase.glm <- function(object, f.=coef, B=999) { bootCase.lm(object, f., B) } bootCase.nls <- function(object, f.=coef, B=999) { bootCase.default(object, f., B, seq(length(resid(object)))) } bootCase.default <- function (object, f.=coef, B = 999, rows) { n <- length(resid(object)) opt<-options(show.error.messages = FALSE) on.exit(options(opt)) pointEstimate <- f.(object) coefBoot <- matrix(0, nrow=B, ncol=length(f.(object))) colnames(coefBoot) <- names(pointEstimate) # adds names if they exist class(coefBoot) <- c("bootCase", "matrix") count.error <- 0 i <- 0 while (i < B) { assign(".boot.sample", sample(rows, replace=TRUE), envir=car:::.carEnv) obj.boot <- try(update(object, subset=get(".boot.sample", envir=car:::.carEnv))) if (is.null(class(obj.boot))) { count.error <- 0 i <- i + 1 coefBoot[i, ] <- f.(obj.boot) } else { if (class(obj.boot)[1] != "try-error") { count.error <- 0 i <- i + 1 coefBoot[i, ] <- f.(obj.boot) } else { count.error <- count.error + 1 } } if (count.error >= 25) { options(show.error.messages = TRUE) stop("25 consecutive bootstraps did not converge. Bailing out.")} } remove(".boot.sample", envir=car:::.carEnv) attr(coefBoot, "pointEstimate") <- pointEstimate return(coefBoot) } car/R/wcrossprod.R0000644000175100001440000000155611410155075013574 0ustar hornikusers# added 2010-06-22; by M. Friendly, modified by J. Fox wcrossprod <- function(x, y, w) { if (is.vector(x)) x <- as.matrix(x) if (!missing(y)){ if (is.vector(y)) y <- as.matrix(y) if (nrow(x) != nrow(y)) stop("x and y not conformable") } if (missing(w)) { if (missing(y)) return(crossprod(x)) else return(crossprod(x, y)) } else if (length(w)==1 || (is.vector(w) && sd(w) < sqrt(.Machine$double.eps))) { if (missing (y)) return(w[1]*crossprod(x)) else return(w[1]*crossprod(x, y)) } else { if (is.vector(w)) { if (length(w) != nrow(x)) stop("w is the wrong length") if (missing(y)) return(crossprod(x, w*x)) else return(crossprod(x, w*y)) } else { if (nrow(w) != ncol(w) || nrow(w) != nrow(x)) stop("w is the wrong dimension") if (missing(y)) return(crossprod(x, w %*% x)) else return(crossprod(x, w %*% y)) } } } car/R/which.names.R0000644000175100001440000000073511366572777013617 0ustar hornikusers# positions of names in a data frame (J. Fox) # last modified 30 April 2010 by J. Fox which.names <- function(names, object){ row.names <- if (inherits(object, "data.frame")) row.names(object) else object check <- outer(row.names, names, '==') if (!all(matched <- apply(check, 2, any))) warning(paste(paste(names[!matched], collapse=", "), "not matched")) which(apply(check, 1, any)) } whichNames <- function(...) which.names(...) car/R/Boxplot.R0000644000175100001440000001343312204420315013005 0ustar hornikusers# checked in 26 December 2009 by J. Fox # 2012-12-12: Fixed Boxplot.default() so that it works properly when g is numeric. J. Fox # 2013-04-10: handles at argument properly, contribution of Steve Ellison. J. Fox # 2013-08-19: removed loading of stats package. J. Fox Boxplot <- function(y, ...){ UseMethod("Boxplot") } Boxplot.default <- function (y, g, labels, id.method = c("y", "identify", "none"), id.n = 10, xlab, ylab, ...) { id.method <- match.arg(id.method) if (missing(ylab)) ylab <- deparse(substitute(y)) if (missing(labels)) labels <- seq(along = y) pars <- list(...) if (missing(g)) { valid <- complete.cases(y, labels) y <- y[valid] labels <- labels[valid] b <- boxplot(y, ylab = ylab, ...) if (id.method == "none" | id.n == 0) return(invisible(NULL)) else if (id.method == "identify") { res <- identify(rep(1, length(y)), y, labels) return(if (length(res) == 0) invisible(NULL) else labels[res]) } else if (length(b$out) > 0) { sel <- y %in% b$out yy <- y[sel] labs <- labels[sel] which.low <- yy < b$stats[1, 1] y.low <- yy[which.low] labs.low <- labs[which.low] if (length(y.low) > id.n) { ord.low <- order(y.low)[1:id.n] y.low <- y.low[ord.low] labs.low <- labs.low[ord.low] } which.high <- yy > b$stats[5, 1] y.high <- yy[which.high] labs.high <- labs[which.high] if (length(y.high) > id.n) { ord.high <- order(y.high, decreasing = TRUE)[1:id.n] y.high <- y.high[ord.high] labs.high <- labs.high[ord.high] } labs <- c(labs.low, labs.high) at <- if(!is.null(pars$at)) pars$at else 1 #@@@ text(at, c(y.low, y.high), labs, pos = 2) #@@@ return(if (length(labs) == 0) invisible(NULL) else labs) } else return(invisible(NULL)) } else { if (missing(xlab)) xlab = deparse(substitute(g)) valid <- complete.cases(y, labels, g) y <- y[valid] labels <- labels[valid] g <- g[valid] b <- boxplot(split(y, g), ylab = ylab, xlab = xlab, ...) levels <- if (is.factor(g)) levels(g) else sort(unique(g)) gg <- as.numeric(g) if (id.method == "none" | id.n == 0) return(invisible(NULL)) else if (id.method == "identify") { res <- identify(gg, y, labels) return(if (length(res) == 0) invisible(NULL) else labels[res]) } else { midx <- mean(par("usr")[1:2]) identified <- character(0) if (length(b$out) > 0) { groups <- unique(b$group) for (group in groups) { grp <- g == levels[group] yy <- y[grp] labs <- labels[grp] sel <- yy %in% b$out[b$group == group] yy <- yy[sel] glabs <- labs[sel] which.low <- yy < b$stats[1, group] y.low <- yy[which.low] labs.low <- glabs[which.low] if (length(y.low) > id.n) { ord.low <- order(y.low)[1:id.n] y.low <- y.low[ord.low] labs.low <- labs.low[ord.low] } which.high <- yy > b$stats[5, group] y.high <- yy[which.high] labs.high <- glabs[which.high] if (length(y.high) > id.n) { ord.high <- order(y.high, decreasing = TRUE)[1:id.n] y.high <- y.high[ord.high] labs.high <- labs.high[ord.high] } pos <- if (group < midx) 4 else 2 at <- if(!is.null(pars$at)) pars$at[group] else group text(at, c(y.low, y.high), c(labs.low, labs.high), pos = pos) identified <- c(identified, c(labs.low, labs.high)) } } return(if (length(identified) == 0) invisible(NULL) else identified) } } } Boxplot.formula <- function(formula, data=NULL, subset, na.action=NULL, labels., id.method=c("y", "identify", "none"), xlab, ylab, ...){ # much of this function adapted from graphics:boxplot.formula id.method <- match.arg(id.method) m <- match.call(expand.dots = FALSE) if (is.matrix(eval(m$data, parent.frame()))) m$data <- as.data.frame(data) m$xlab <- m$ylab <- m$id.method <- m$... <- NULL m$na.action <- na.action m[[1]] <- as.name("model.frame") mf <- eval(m, parent.frame()) if (missing(labels.)) mf$"(labels.)" <- rownames(mf) lab.var <- which(names(mf) == "(labels.)") if (length(formula) == 3){ response <- attr(attr(mf, "terms"), "response") if (missing(ylab)) ylab <- names(mf)[response] if (missing(xlab)) xlab <- names(mf)[-c(response, lab.var)] x <- mf[, -c(response, lab.var)] if (is.data.frame(x)) x <- do.call("interaction", as.list(x)) if (length(xlab) > 1) xlab <- paste(xlab, collapse="*") Boxplot(mf[[response]], x, labels=mf[[lab.var]], xlab=xlab, ylab=ylab, id.method=id.method, ...) } else if (length(formula) == 2){ if (missing(ylab)) ylab <- names(mf)[-lab.var] Boxplot(mf[, -lab.var], labels=mf[[lab.var]], ylab=ylab, id.method=id.method, ...) } else stop("improper Boxplot formula") } car/R/crPlots.R0000644000175100001440000001263012204733747013022 0ustar hornikusers# Component + Residual Plots (J. Fox) # modified 9 October 2009 by J. Fox # modified 25 November 2009 by S. Weisberg to change # variable specification, layout and point marking # modified 1 January 2009 by J. Fox # to set default id.n=0 # changed showLabels args 15 April 2010 S. Weisberg # added grid, 10 May 2010 # modified 2 Sept 2010 by S. Weisberg, made colors, axes lables, and # arguments more consistent with other functions; ... passes args to plot # and boxplot. # 16 June 2011 allow layout=NA, in which case the layout is not set in this # function, so it is the responsibility of the user # 14 Sept 2012 use the ScatterplotSmoothers in car # 19 Sept 2012 restore smooth and span args # 20 Aug 2013 replace residuals.glm() with residuals(). John # these functions to be rewritten; simply renamed for now crp<-function(...) crPlots(...) crPlots<-function(model, terms= ~ ., layout=NULL, ask, main, ...){ terms <- if(is.character(terms)) paste("~", terms) else terms vform <- update(formula(model), terms) if(any(is.na(match(all.vars(vform), all.vars(formula(model)))))) stop("Only predictors in the formula can be plotted.") mf <- attr(model.frame(model), "terms") terms <- attr(mf, "term.labels") # this is a list vterms <- attr(terms(vform), "term.labels") if (any(attr(terms(model),"order")>1)) { stop("C+R plots not available for models with interactions.")} nt <- length(vterms) if (nt == 0) stop("No plots specified") if (missing(main)) main <- if (nt == 1) "Component + Residual Plot" else "Component + Residual Plots" if (nt > 1 & (is.null(layout) || is.numeric(layout))) { if(is.null(layout)){ layout <- switch(min(nt, 9), c(1, 1), c(1, 2), c(2, 2), c(2, 2), c(3, 2), c(3, 2), c(3, 3), c(3, 3), c(3, 3)) } ask <- if(missing(ask) || is.null(ask)) prod(layout)1)) { stop("C+R plots not available for models with interactions.") } if (!is.null(model$contrasts[[var]])){ partial.res<-residuals(model,"partial") .x<-model.frame(model)[,var] boxplot(partial.res[,var]~.x, xlab=xlab, ylab=ylab, ...) return(invisible()) } .x<-if (df.terms(model, var)>1) predict(model, type="terms", term=var) else model.matrix(model)[,var] if (order==1){ # handle first-order separately for efficiency partial.res<-residuals(model,"partial") plot(.x, partial.res[,var], type="n", xlab=xlab, ylab=ylab, ...) if(grid){ grid(lty=1, equilogs=FALSE) box()} points(.x, partial.res[,var], col=col, pch=pch) if (line) abline(lm(partial.res[,var]~.x), lty=2, lwd=lwd, col=col.lines[1]) if (is.function(smoother)) { smoother(.x, partial.res[,var], col=col.lines[2], log.x=FALSE, log.y=FALSE, spread=FALSE, smoother.args=smoother.args) } showLabels(.x, partial.res[,var], labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col) } else { if (df.terms(model, var)>1) stop(paste("Order", order, "C+R plot not available for a term with > 1 df:", var)) aug.model<-update(model, as.formula(paste(".~.-",var,"+poly(",var,",",order,")"))) partial.res<-residuals(aug.model, "partial") last<-ncol(partial.res) plot(.x, partial.res[,last], xlab=xlab, ylab=ylab, type="n", ...) if(grid){ grid(lty=1, equilogs=FALSE) box()} points(.x, partial.res[,last], col=col, pch=pch) if (line) abline(lm(partial.res[,last]~.x), lty=2, lwd=lwd, col=col.lines[1]) if (is.function(smoother)) { smoother(.x, partial.res[, last], col=col.lines[2], log.x=FALSE, log.y=FALSE, spread=FALSE, smoother.args=smoother.args) } showLabels(.x, partial.res[,last], labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col) } } car/R/scatter3d.R0000644000175100001440000004203612210367340013260 0ustar hornikusers# 3D scatterplots and point identification via rgl # checked in 23 December 2009 by J. Fox # 5 January 2010: fixed axis labeling in scatter3d.formula. J. Fox # 13 May 2010: changed default id.n to conform to showLabels # 30 July 2010: checks for rgl # 23 October 2010: added surface.alpha and ellipsoid.alpha arguments # 2012-03-02: fixed some argument abbreviations. J. Fox # 2013-02-20: fixed error message, docs for surface.col argument. J. Fox # 2013-08-20: changed rgl:::rgl.projection to rgl::rgl.projection; more such fixes to come. J. Fox # 2013-08-31: rgl functions used now exported; got rid of ::: and ::. J. Fox scatter3d <- function(x, ...){ if (!require(rgl)) stop("rgl package missing") UseMethod("scatter3d") } scatter3d.formula <- function(formula, data, subset, radius, xlab, ylab, zlab, labels, ...){ na.save <- options(na.action=na.omit) on.exit(options(na.save)) m <- match.call(expand.dots=FALSE) if (is.matrix(eval(m$data, sys.frame(sys.parent())))) m$data <- as.data.frame(data) m$na.action <- na.pass m$labels <- m$xlab <- m$ylab <- m$zlab <- m$... <- NULL m[[1]] <- as.name("model.frame") formula <- as.character(c(formula)) formula <- as.formula(sub("\\|", "+", formula)) m$formula <- formula X <- eval(m, parent.frame()) if ("(radius)" %in% names(X)){ radius <- X[, "(radius)"] X <- X[, names(X) != "(radius)"] } else radius <- 1 names <- names(X) if (missing(xlab)) xlab <- names[2] if (missing(ylab)) ylab <- names[1] if (missing(zlab)) zlab <- names[3] if (missing(labels)) labels <- rownames(X) if (ncol(X) == 3) scatter3d(X[,2], X[,1], X[,3], xlab=xlab, ylab=ylab, zlab=zlab, labels=labels, radius=radius, ...) else if (ncol(X) == 4) scatter3d(X[,2], X[,1], X[,3], groups=X[,4], xlab=xlab, ylab=ylab, zlab=zlab, labels=labels, radius=radius, ...) else stop("incorrect scatter3d formula") } scatter3d.default <- function(x, y, z, xlab=deparse(substitute(x)), ylab=deparse(substitute(y)), zlab=deparse(substitute(z)), axis.scales=TRUE, revolutions=0, bg.col=c("white", "black"), axis.col=if (bg.col == "white") c("darkmagenta", "black", "darkcyan") else c("darkmagenta", "white", "darkcyan"), surface.col=c("blue", "green", "orange", "magenta", "cyan", "red", "yellow", "gray"), surface.alpha=0.5, neg.res.col="red", pos.res.col="green", square.col=if (bg.col == "white") "black" else "gray", point.col="yellow", text.col=axis.col, grid.col=if (bg.col == "white") "black" else "gray", fogtype=c("exp2", "linear", "exp", "none"), residuals=(length(fit) == 1), surface=TRUE, fill=TRUE, grid=TRUE, grid.lines=26, df.smooth=NULL, df.additive=NULL, sphere.size=1, radius=1, threshold=0.01, speed=1, fov=60, fit="linear", groups=NULL, parallel=TRUE, ellipsoid=FALSE, level=0.5, ellipsoid.alpha=0.1, id.method=c("mahal", "xz", "y", "xyz", "identify", "none"), id.n=if (id.method == "identify") Inf else 0, labels=as.character(seq(along=x)), offset = ((100/length(x))^(1/3)) * 0.02, model.summary=FALSE, ...){ if (!require(rgl)) stop("rgl package missing") if (!require(mgcv)) stop("mgcv package missing") id.method <- match.arg(id.method) if (residuals == "squares"){ residuals <- TRUE squares <- TRUE } else squares <- FALSE summaries <- list() if ((!is.null(groups)) && (nlevels(groups) > length(surface.col))) stop(sprintf("Number of groups (%d) exceeds number of colors (%d)", nlevels(groups), length(surface.col))) if ((!is.null(groups)) && (!is.factor(groups))) stop("groups variable must be a factor") bg.col <- match.arg(bg.col) fogtype <- match.arg(fogtype) if ((length(fit) > 1) && residuals && surface) stop("cannot plot both multiple surfaces and residuals") xlab # cause these arguments to be evaluated ylab zlab rgl.clear() rgl.viewpoint(fov=fov) rgl.bg(color=bg.col, fogtype=fogtype) if (id.method == "identify"){ xg <- x yg <- y zg <- z ggroups <- groups glabels <- labels } valid <- if (is.null(groups)) complete.cases(x, y, z) else complete.cases(x, y, z, groups) x <- x[valid] y <- y[valid] z <- z[valid] labels <- labels[valid] minx <- min(x) maxx <- max(x) miny <- min(y) maxy <- max(y) minz <- min(z) maxz <- max(z) if (axis.scales){ lab.min.x <- nice(minx) lab.max.x <- nice(maxx) lab.min.y <- nice(miny) lab.max.y <- nice(maxy) lab.min.z <- nice(minz) lab.max.z <- nice(maxz) minx <- min(lab.min.x, minx) maxx <- max(lab.max.x, maxx) miny <- min(lab.min.y, miny) maxy <- max(lab.max.y, maxy) minz <- min(lab.min.z, minz) maxz <- max(lab.max.z, maxz) min.x <- (lab.min.x - minx)/(maxx - minx) max.x <- (lab.max.x - minx)/(maxx - minx) min.y <- (lab.min.y - miny)/(maxy - miny) max.y <- (lab.max.y - miny)/(maxy - miny) min.z <- (lab.min.z - minz)/(maxz - minz) max.z <- (lab.max.z - minz)/(maxz - minz) } if (!is.null(groups)) groups <- groups[valid] x <- (x - minx)/(maxx - minx) y <- (y - miny)/(maxy - miny) z <- (z - minz)/(maxz - minz) size <- sphere.size*((100/length(x))^(1/3))*0.015 radius <- radius/median(radius) if (is.null(groups)){ if (size > threshold) rgl.spheres(x, y, z, color=point.col, radius=size*radius) else rgl.points(x, y, z, color=point.col) } else { if (size > threshold) rgl.spheres(x, y, z, color=surface.col[as.numeric(groups)], radius=size*radius) else rgl.points(x, y, z, color=surface.col[as.numeric(groups)]) } if (!axis.scales) axis.col[1] <- axis.col[3] <- axis.col[2] rgl.lines(c(0,1), c(0,0), c(0,0), color=axis.col[1]) rgl.lines(c(0,0), c(0,1), c(0,0), color=axis.col[2]) rgl.lines(c(0,0), c(0,0), c(0,1), color=axis.col[3]) rgl.texts(1, 0, 0, xlab, adj=1, color=axis.col[1]) rgl.texts(0, 1.05, 0, ylab, adj=1, color=axis.col[2]) rgl.texts(0, 0, 1, zlab, adj=1, color=axis.col[3]) if (axis.scales){ rgl.texts(min.x, -0.05, 0, lab.min.x, col=axis.col[1]) rgl.texts(max.x, -0.05, 0, lab.max.x, col=axis.col[1]) rgl.texts(0, -0.1, min.z, lab.min.z, col=axis.col[3]) rgl.texts(0, -0.1, max.z, lab.max.z, col=axis.col[3]) rgl.texts(-0.05, min.y, -0.05, lab.min.y, col=axis.col[2]) rgl.texts(-0.05, max.y, -0.05, lab.max.y, col=axis.col[2]) } if (ellipsoid) { dfn <- 3 if (is.null(groups)){ dfd <- length(x) - 1 ell.radius <- sqrt(dfn * qf(level, dfn, dfd)) ellips <- ellipsoid(center=c(mean(x), mean(y), mean(z)), shape=cov(cbind(x,y,z)), radius=ell.radius) if (fill) shade3d(ellips, col=surface.col[1], alpha=ellipsoid.alpha, lit=FALSE) if (grid) wire3d(ellips, col=surface.col[1], lit=FALSE) } else{ levs <- levels(groups) for (j in 1:length(levs)){ group <- levs[j] select.obs <- groups == group xx <- x[select.obs] yy <- y[select.obs] zz <- z[select.obs] dfd <- length(xx) - 1 ell.radius <- sqrt(dfn * qf(level, dfn, dfd)) ellips <- ellipsoid(center=c(mean(xx), mean(yy), mean(zz)), shape=cov(cbind(xx,yy,zz)), radius=ell.radius) if (fill) shade3d(ellips, col=surface.col[j], alpha=ellipsoid.alpha, lit=FALSE) if (grid) wire3d(ellips, col=surface.col[j], lit=FALSE) coords <- ellips$vb[, which.max(ellips$vb[1,])] if (!surface) rgl.texts(coords[1] + 0.05, coords[2], coords[3], group, col=surface.col[j]) } } } if (surface){ vals <- seq(0, 1, length.out=grid.lines) dat <- expand.grid(x=vals, z=vals) for (i in 1:length(fit)){ f <- match.arg(fit[i], c("linear", "quadratic", "smooth", "additive")) if (is.null(groups)){ mod <- switch(f, linear = lm(y ~ x + z), quadratic = lm(y ~ (x + z)^2 + I(x^2) + I(z^2)), smooth = if (is.null(df.smooth)) gam(y ~ s(x, z)) else gam(y ~ s(x, z, fx=TRUE, k=df.smooth)), additive = if (is.null(df.additive)) gam(y ~ s(x) + s(z)) else gam(y ~ s(x, fx=TRUE, k=df.additive[1]+1) + s(z, fx=TRUE, k=(rev(df.additive+1)[1]+1))) ) if (model.summary) summaries[[f]] <- summary(mod) yhat <- matrix(predict(mod, newdata=dat), grid.lines, grid.lines) if (fill) rgl.surface(vals, vals, yhat, color=surface.col[i], alpha=surface.alpha, lit=FALSE) if(grid) rgl.surface(vals, vals, yhat, color=if (fill) grid.col else surface.col[i], alpha=surface.alpha, lit=FALSE, front="lines", back="lines") if (residuals){ n <- length(y) fitted <- fitted(mod) colors <- ifelse(residuals(mod) > 0, pos.res.col, neg.res.col) rgl.lines(as.vector(rbind(x,x)), as.vector(rbind(y,fitted)), as.vector(rbind(z,z)), color=as.vector(rbind(colors,colors))) if (squares){ res <- y - fitted xx <- as.vector(rbind(x, x, x + res, x + res)) yy <- as.vector(rbind(y, fitted, fitted, y)) zz <- as.vector(rbind(z, z, z, z)) rgl.quads(xx, yy, zz, color=square.col, alpha=surface.alpha, lit=FALSE) rgl.lines(xx, yy, zz, color=square.col) } } } else{ if (parallel){ mod <- switch(f, linear = lm(y ~ x + z + groups), quadratic = lm(y ~ (x + z)^2 + I(x^2) + I(z^2) + groups), smooth = if (is.null(df.smooth)) gam(y ~ s(x, z) + groups) else gam(y ~ s(x, z, fx=TRUE, k=df.smooth) + groups), additive = if (is.null(df.additive)) gam(y ~ s(x) + s(z) + groups) else gam(y ~ s(x, fx=TRUE, k=df.additive[1]+1) + s(z, fx=TRUE, k=(rev(df.additive+1)[1]+1)) + groups) ) if (model.summary) summaries[[f]] <- summary(mod) levs <- levels(groups) for (j in 1:length(levs)){ group <- levs[j] select.obs <- groups == group yhat <- matrix(predict(mod, newdata=cbind(dat, groups=group)), grid.lines, grid.lines) if (fill) rgl.surface(vals, vals, yhat, color=surface.col[j], alpha=surface.alpha, lit=FALSE) if (grid) rgl.surface(vals, vals, yhat, color=if (fill) grid.col else surface.col[j], alpha=surface.alpha, lit=FALSE, front="lines", back="lines") rgl.texts(1, predict(mod, newdata=data.frame(x=1, z=1, groups=group)), 1, paste(group, " "), adj=1, color=surface.col[j]) if (residuals){ yy <- y[select.obs] xx <- x[select.obs] zz <- z[select.obs] fitted <- fitted(mod)[select.obs] res <- yy - fitted rgl.lines(as.vector(rbind(xx,xx)), as.vector(rbind(yy,fitted)), as.vector(rbind(zz,zz)), col=surface.col[j]) if (squares) { xxx <- as.vector(rbind(xx, xx, xx + res, xx + res)) yyy <- as.vector(rbind(yy, fitted, fitted, yy)) zzz <- as.vector(rbind(zz, zz, zz, zz)) rgl.quads(xxx, yyy, zzz, color=surface.col[j], alpha=surface.alpha, lit=FALSE) rgl.lines(xxx, yyy, zzz, color=surface.col[j]) } } } } else { levs <- levels(groups) for (j in 1:length(levs)){ group <- levs[j] select.obs <- groups == group mod <- switch(f, linear = lm(y ~ x + z, subset=select.obs), quadratic = lm(y ~ (x + z)^2 + I(x^2) + I(z^2), subset=select.obs), smooth = if (is.null(df.smooth)) gam(y ~ s(x, z), subset=select.obs) else gam(y ~ s(x, z, fx=TRUE, k=df.smooth), subset=select.obs), additive = if (is.null(df.additive)) gam(y ~ s(x) + s(z), subset=select.obs) else gam(y ~ s(x, fx=TRUE, k=df.additive[1]+1) + s(z, fx=TRUE, k=(rev(df.additive+1)[1]+1)), subset=select.obs) ) if (model.summary) summaries[[paste(f, ".", group, sep="")]] <- summary(mod) yhat <- matrix(predict(mod, newdata=dat), grid.lines, grid.lines) if (fill) rgl.surface(vals, vals, yhat, color=surface.col[j], alpha=surface.alpha, lit=FALSE) if (grid) rgl.surface(vals, vals, yhat, color=if (fill) grid.col else surface.col[j], alpha=surface.alpha, lit=FALSE, front="lines", back="lines") rgl.texts(1, predict(mod, newdata=data.frame(x=1, z=1, groups=group)), 1, paste(group, " "), adj=1, color=surface.col[j]) if (residuals){ yy <- y[select.obs] xx <- x[select.obs] zz <- z[select.obs] fitted <- fitted(mod) res <- yy - fitted rgl.lines(as.vector(rbind(xx,xx)), as.vector(rbind(yy,fitted)), as.vector(rbind(zz,zz)), col=surface.col[j]) if (squares) { xxx <- as.vector(rbind(xx, xx, xx + res, xx + res)) yyy <- as.vector(rbind(yy, fitted, fitted, yy)) zzz <- as.vector(rbind(zz, zz, zz, zz)) rgl.quads(xxx, yyy, zzz, color=surface.col[j], alpha=surface.alpha, lit=FALSE) rgl.lines(xxx, yyy, zzz, color=surface.col[j]) } } } } } } } else levs <- levels(groups) if (id.method == "identify"){ identify3d(xg, yg, zg, axis.scales=axis.scales, groups=ggroups, labels=glabels, col=surface.col, offset=offset) } else if (id.method != "none"){ if (is.null(groups)) showLabels3d(x, y, z, labels, id.method=id.method, id.n=id.n, col=surface.col[1]) else { for (j in 1:length(levs)){ group <- levs[j] select.obs <- groups == group showLabels3d(x[select.obs], y[select.obs], z[select.obs], labels[select.obs], id.method=id.method, id.n=id.n, col=surface.col[j]) } } } if (revolutions > 0) { for (i in 1:revolutions){ for (angle in seq(1, 360, length.out=360/speed)) rgl.viewpoint(-angle, fov=fov) } } if (model.summary) return(summaries) else return(invisible(NULL)) } # the following function is a slight modification of rgl.select3d() in the rgl package, # altered to pass through arguments (via ...) to rgl.select() car.select3d <- function (...) { .check3d() rect <- rgl.select(...) llx <- rect[1] lly <- rect[2] urx <- rect[3] ury <- rect[4] if (llx > urx) { temp <- llx llx <- urx urx <- temp } if (lly > ury) { temp <- lly lly <- ury ury <- temp } proj <- rgl.projection() function(x, y, z) { pixel <- rgl.user2window(x, y, z, projection = proj) apply(pixel, 1, function(p) (llx <= p[1]) && (p[1] <= urx) && (lly <= p[2]) && (p[2] <= ury) && (0 <= p[3]) && (p[3] <= 1)) } } identify3d <- function (x, y, z, axis.scales=TRUE, groups = NULL, labels = 1:length(x), col = c("blue", "green", "orange", "magenta", "cyan", "red", "yellow", "gray"), offset = ((100/length(x))^(1/3)) * 0.02){ valid <- if (is.null(groups)) complete.cases(x, y, z) else complete.cases(x, y, z, groups) labels <- labels[valid] x <- x[valid] y <- y[valid] z <- z[valid] groups <- groups[valid] minx <- min(x) maxx <- max(x) miny <- min(y) maxy <- max(y) minz <- min(z) maxz <- max(z) if (axis.scales){ lab.min.x <- nice(minx) lab.max.x <- nice(maxx) lab.min.y <- nice(miny) lab.max.y <- nice(maxy) lab.min.z <- nice(minz) lab.max.z <- nice(maxz) minx <- min(lab.min.x, minx) maxx <- max(lab.max.x, maxx) miny <- min(lab.min.y, miny) maxy <- max(lab.max.y, maxy) minz <- min(lab.min.z, minz) maxz <- max(lab.max.z, maxz) min.x <- (lab.min.x - minx)/(maxx - minx) max.x <- (lab.max.x - minx)/(maxx - minx) min.y <- (lab.min.y - miny)/(maxy - miny) max.y <- (lab.max.y - miny)/(maxy - miny) min.z <- (lab.min.z - minz)/(maxz - minz) max.z <- (lab.max.z - minz)/(maxz - minz) } x <- (x - minx)/(maxx - minx) y <- (y - miny)/(maxy - miny) z <- (z - minz)/(maxz - minz) rgl.bringtotop() identified <- character(0) groups <- if (!is.null(groups)) as.numeric(groups[valid]) else rep(1, length(x)) repeat { f <- car.select3d(button="right") which <- f(x, y, z) if (!any(which)) break rgl.texts(x[which], y[which] + offset, z[which], labels[which], color = col[groups][which]) identified <- c(identified, labels[which]) } unique(identified) } showLabels3d <- function(x, y, z, labels, id.method = "identify", id.n=length(x), col=c("blue"), res=y - mean(y), range.x=range(x), range.z=range(z), offset = ((100/length(x))^(1/3)) * 0.02) { if (id.method == "none") return(NULL) if(id.n > 0L) { if (missing(labels)) labels <- as.character(seq(along=x)) getPoints <- function(w) { names(w) <- labels iid <- seq(length=id.n) ws <- w[order(-w)[iid]] match(names(ws), labels) } ind <- switch(id.method, xz = getPoints(rowSums(qr.Q(qr(cbind(1, x, z))) ^ 2)), y = getPoints(abs(res)), xyz = union(getPoints(abs(x - mean(x))), union(abs(z - mean(z)), getPoints(abs(res)))), mahal= getPoints(rowSums(qr.Q(qr(cbind(1, x, y, z))) ^ 2))) rgl.texts(x[ind], y[ind] + offset, z[ind], labels[ind], color = col) return(labels[ind]) } } ellipsoid <- function(center=c(0, 0, 0), radius=1, shape=diag(3), n=30){ # adapted from the shapes3d demo in the rgl package degvec <- seq(0, 2*pi, length.out=n) ecoord2 <- function(p) c(cos(p[1])*sin(p[2]), sin(p[1])*sin(p[2]), cos(p[2])) v <- t(apply(expand.grid(degvec,degvec), 1, ecoord2)) v <- center + radius * t(v %*% chol(shape)) v <- rbind(v, rep(1,ncol(v))) e <- expand.grid(1:(n-1), 1:n) i1 <- apply(e, 1, function(z) z[1] + n*(z[2] - 1)) i2 <- i1 + 1 i3 <- (i1 + n - 1) %% n^2 + 1 i4 <- (i2 + n - 1) %% n^2 + 1 i <- rbind(i1, i2, i4, i3) qmesh3d(v, i) } car/R/showLabels.R0000644000175100001440000001037012105010710013450 0ustar hornikusers# last modified 25 Februrary 2010 by J. Fox # rewritten 15 April 2010 S Weisberg # 2013-02-07 S. Weisberg bug fix for use with 'scatterplot' with groups. # Added an argument to showLabels1 'all' that gives a list of two # elements for the original labels and subset indicator. See # scatterplot.R for an example of its use. # If a list of cases to be labelled is supplied, id.n is needed only # if all n labels are to be printed. showLabels <- function(x, y, labels=NULL, id.method="identify", id.n = length(x), id.cex=1, id.col=palette()[1], ...) { res <- NULL id.method <- if(is.list(id.method)) id.method else list(id.method) for (meth in id.method) res <- c(res, showLabels1(x, y, labels, meth, id.n, id.cex, id.col, ...)) return(if(is.null(res)) invisible(res) else res) } showLabels1 <- function(x, y, labels=NULL, id.method="identify", id.n = length(x), id.cex=1, id.col=palette()[1], all=NULL, ...) { # If labels are NULL, try to get the labels from x: if (is.null(labels)) labels <- names(x) if (is.null(labels)) labels <- paste(seq_along(x)) if (is.null(id.col)) id.col <- palette()[1] # logged-axes? log.x <- par("xlog") log.y <- par("ylog") # id.method can be any of the following: # --- a list of row numbers # --- a list of labels # --- a vector of n numbers # --- a text string: 'identify', 'x', 'y', 'mahal'- idmeth <- pmatch(id.method[1], c("x", "y", "mahal", "identify")) if(!is.na(idmeth)) idmeth <- c("x", "y", "mahal", "identify")[idmeth] # if idmeth is NA, then it must be <= n numbers or row names id.var <- NULL if(is.na(idmeth)){ if(is.null(all)) all <- list(labels=labels, subs=rep(TRUE, length(labels))) names(all$labels) <- all$labels if(length(id.method) >= length(x)){ id.var <- id.method[which(all$subs)] id.n <- min(id.n, length(id.var)) } else { id.var <- rep(0, length(x)) names(id.var) <- labels inSubset <- all$labels[all$subs] %in% all$labels[id.method] id.var[inSubset] <- 1 id.n <- sum(inSubset) } } else { # use identify? if(idmeth == "identify"){ result <- labels[identify(x, y, labels, n=length(x), cex=id.cex, col=id.col, ...)] if(length(result) > 0) return(unique(result)) else return(NULL) } # missing values need to be removed ismissing <- is.na(x) | is.na(y) | is.na(labels) if( any(ismissing) ) { x <- x[!ismissing] y <- y[!ismissing] labels <- labels[!ismissing] } # other methods: id.var <- switch(id.method, x = if(log.x==TRUE) suppressWarnings(if(all(x) > 0) abs(log(x) - mean(log(x))) else return(invisible(NULL))) else abs(x - mean(x)), y = if(log.y==TRUE) suppressWarnings(if(all(y) > 0) abs(log(y) - mean(log(y))) else return(invisible(NULL))) else abs(y - mean(y)), mahal = if(log.x == TRUE & log.y == TRUE) { suppressWarnings(if(all(x) > 0 & all(y) > 0) rowSums( qr.Q(qr(cbind(1, log(x), log(y))))^2 ) else return(invisible(NULL))) } else { if(log.x == TRUE) { suppressWarnings(if(all(x) > 0 ) rowSums( qr.Q(qr(cbind(1, log(x), y)))^2 ) else return(invisible(NULL))) } else { if(log.y == TRUE) { suppressWarnings(if(all(y) > 0 ) rowSums( qr.Q(qr(cbind(1, x, log(y))))^2 ) else return(invisible(NULL))) } else { rowSums( qr.Q(qr(cbind(1, x, y)))^2 ) }}}) } # require id.n positive if(id.n <= 0L) return(invisible(NULL)) # criterion ind <- order(-id.var)[1L:min(length(id.var), id.n)] # position mid <- mean(if(par("xlog")==TRUE) 10^(par("usr")[1:2]) else par("usr")[1:2]) labpos <- c(4,2)[1+as.numeric(x > mid)] # print for (i in ind) { text(x[i], y[i], labels[i], cex = id.cex, xpd = TRUE, col = id.col, pos = labpos[i], offset = 0.25, ...)} names(ind) <- labels[ind] result <- ind if (length(result) == 0) return(NULL) else return(result) } car/R/TransformationAxes.R0000644000175100001440000001234611322706674015226 0ustar hornikusers# Axes for transformations (J. Fox) # last modified 27 December 2009 by J. Fox # functions to add untransformed axis to right or top of a plot # for power, Box-Cox, or Yeo-Johnson transformations basicPowerAxis <- function(power, base=exp(1), side=c("right", "above", "left", "below"), at, start=0, lead.digits=1, n.ticks, grid=FALSE, grid.col=gray(0.50), grid.lty=2, axis.title="Untransformed Data", cex=1, las=par("las")) { side <- if(is.numeric(side)) side else which(match.arg(side) == c("below", "left", "above", "right")) axp <- if (side %% 2 == 1) par("xaxp") else par("yaxp") if (missing(n.ticks)) n.ticks <- axp[3] + 1 ticks <- nice(seq(from=axp[1], to=axp[2], length=n.ticks), lead.digits=lead.digits) ticks.x <- if (power != 0) nice(ticks[ticks > 0]^(1/power), lead.digits=lead.digits) else nice(log(base)*exp(ticks), lead.digits=lead.digits) ticks.x <- if (missing(at)) ticks.x else at ticks.text <- as.character(ticks.x - start) ticks.trans <- if (power != 0) ticks.x^power else log(ticks.x, base) axis(side, labels=ticks.text, at=ticks.trans, las=las) if (grid && (side %% 2 == 0)) abline(h=ticks.trans, lty=grid.lty, col=grid.col) if (grid && (side %% 2 == 1)) abline(v=ticks.trans, lty=grid.lty, col=grid.col) mtext(axis.title, side=side, line=3, cex=cex) } bcPowerAxis <- function(power, side=c("right", "above", "left", "below"), at, start=0, lead.digits=1, n.ticks, grid=FALSE, grid.col=gray(0.50), grid.lty=2, axis.title="Untransformed Data", cex=1, las=par("las")) { inverse.power <- function(x, p){ if (p == 0) exp(x) else (1 + p*x)^(1/p) } side <- if (is.numeric(side)) side else which(match.arg(side) == c("below", "left", "above", "right")) axp <- if (side %% 2 == 1) par("xaxp") else par("yaxp") if (missing(n.ticks)) n.ticks <- axp[3] + 1 ticks <- nice(seq(from=axp[1], to=axp[2], length=n.ticks), lead.digits=lead.digits) ticks.x <- if (power != 0) nice(inverse.power(ticks[ticks > 0], power), lead.digits=lead.digits) else nice(inverse.power(ticks, 0), lead.digits=lead.digits) ticks.x <- if (missing(at)) ticks.x else at ticks.text <- as.character(ticks.x - start) ticks.trans <- bcPower(ticks.x, power) axis(side, labels=ticks.text, at=ticks.trans, las=las) if (grid && (side %% 2 == 0)) abline(h=ticks.trans, lty=grid.lty, col=grid.col) if (grid && (side %% 2 == 1)) abline(v=ticks.trans, lty=grid.lty, col=grid.col) mtext(axis.title, side=side, line=3, cex=cex) } yjPowerAxis <- function(power, side=c("right", "above", "left", "below"), at, lead.digits=1, n.ticks, grid=FALSE, grid.col=gray(0.50), grid.lty=2, axis.title="Untransformed Data", cex=1, las=par("las")) { inverse.bc <- function(x,p){ if (p == 0) exp(x) else (1 + p*x)^(1/p) } inverse.power <- function(x, p){ ifelse(x == 0, 0, ifelse(x > 0, inverse.bc(x, p) - 1, -inverse.bc(abs(x), 2 - p) + 1)) } side <- if(is.numeric(side)) side else which(match.arg(side) == c("below", "left", "above", "right")) axp <- if (side %% 2 == 1) par("xaxp") else par("yaxp") if (missing(n.ticks)) n.ticks <- axp[3] + 1 ticks <- nice(seq(from=axp[1], to=axp[2], length=n.ticks), lead.digits=lead.digits) ticks.x <- nice(inverse.power(ticks, power), lead.digits=lead.digits) ticks.x <- if (missing(at)) ticks.x else at ticks.text <- as.character(ticks.x) ticks.trans <- yjPower(ticks.x, power) axis(side, labels=ticks.text, at=ticks.trans, las=las) if (grid && (side %% 2 == 0)) abline(h=ticks.trans, lty=grid.lty, col=grid.col) if (grid && (side %% 2 == 1)) abline(v=ticks.trans, lty=grid.lty, col=grid.col) mtext(axis.title, side=side, line=3, cex=cex) } # function to add a right or top probability axis to a plot of logits or probits probabilityAxis <- function(scale=c("logit", "probit"), side=c("right", "above", "left", "below"), at, lead.digits=1, grid=FALSE, grid.lty=2, grid.col=gray(0.50), axis.title = "Probability", interval = 0.1, cex = 1, las=par("las")){ side <- if(is.numeric(side)) side else which(match.arg(side) == c("below", "left", "above", "right")) scale <- match.arg(scale) trans <- if (scale == "logit") function(p) log(p/(1 - p)) else qnorm inv.trans <- if (scale == "logit") function(x) 1/(1 + exp(-x)) else pnorm x <- if (side %% 2 == 1) par("usr")[c(1, 2)] else par("usr")[c(3, 4)] fact <- 10^( - (floor(log(interval, 10)))) p.min <- nice(inv.trans(x[1]), direction="down", lead.digits=lead.digits) p.max <- nice(inv.trans(x[2]), direction="up", lead.digits=lead.digits) tick.min <- max(interval, (floor(fact*p.min))/fact) tick.max <- min(1 - interval, (ceiling(fact*p.max))/fact) ticks.p <- seq(tick.min, tick.max, interval) mins <- c(.05, .01, .005, .001, .0005, .0001) maxs <- c(.95, .99, .995, .999, .9995, .9999) ticks.p <- c(mins[mins >= p.min], ticks.p) ticks.p <- c(ticks.p, c(maxs[maxs <= p.max])) ticks.p <- if (missing(at)) ticks.p else at ticks.text <- as.character(ticks.p) ticks.x <- trans(ticks.p) axis(side, labels=ticks.text, at=ticks.x, las=las) if (grid && (side %% 2 == 0)) abline(h=ticks.x, lty=grid.lty, col=grid.col) if (grid && (side %% 2 == 1)) abline(v=ticks.x, lty=grid.lty, col=grid.col) mtext(axis.title, side=side, line=3, cex=cex) } car/R/marginalModelPlot.R0000644000175100001440000002673112166631153015010 0ustar hornikusers############################################# # marginal model plots Rev 12/30/09 # To do: # Allow a Groups arg that will draw the plot for the specified group # BUG: sd's are WRONG with weights; see cards data # 15 March 2010 changed to make # mmps(lm(longley)) work without specifying data or response # fixed bug when only one plot is requested --- suppress call to par() # added 'outerLegend' to label lines # modified to work correctly with # 28 May 2010 S. Weisberg, fixed bugs in logistic models # changed line thickness of mean smooths # excluded SD smooth from bernoulli models # added grid lines # 15 August 2010 fixed colors of points to work properly # 16 January 2011 improved handling of splines and polynomials in mmps to # allow plots against base variables (e.g., bs(x, 3) could be # replaced by just x in the 'terms' argument to mmps. # 16 June 2011 allow layout=NA, in which case the layout is not set in this # function, so it is the responsibility of the user # 14 September 2012 improved the smoothers # 22 September 2012 added conditioning on one categorical regressor ############################################# marginalModelPlot <- function(...){mmp(...)} mmp <- function(model, ...){UseMethod("mmp")} mmp.lm <- function (model, variable, sd = FALSE, xlab = deparse(substitute(variable)), smoother = loessLine, smoother.args=list(span=2/3), key=TRUE, pch, groups=NULL, ...) { mmp.default(model, variable, sd, xlab, smoother=smoother, smoother.args=smoother.args, key, pch=pch, groups=groups, ...) } mmp.default <- function (model, variable, sd = FALSE, xlab = deparse(substitute(variable)), smoother=loessLine, smoother.args, key=TRUE, pch, groups=NULL, col.line = palette()[c(4, 2)], col=palette()[1], labels, id.method="y", id.n=if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], grid=TRUE, ...) { lwd <- match.call(expand.dots=TRUE)$lwd if(missing(pch)) pch <- 1 groups.col <- col if (!is.null(groups)){ if(is.data.frame(groups)) { groups.label <- colnames(groups)[1] groups <- groups[,1] } else { groups.label <- deparse(substitute(groups)) } groups.levels <- unique(na.omit(groups)) for (j in 1:(length(groups.levels))) { pch[groups==groups.levels[j]] <- j groups.col[groups==groups.levels[j]] <- palette()[j]} } if (!is.function(smoother)) { smoother <- loessLine smoother.args <- list() } if (!is.null(attr(model$model, "na.action"))) { if (attr(attr(model$model, "na.action"), "class") == "exclude") model <- update(model, na.action=na.omit)} if (missing(variable)) { xlab <- "Fitted values" u <- fitted(model) } else { u <- variable} if(missing(labels)) labels <- names(residuals(model)) resp <- model.response(model.frame(model)) plot(u, resp, xlab = xlab, ylab = colnames(model$model[1]), type="n", ...) if(grid){ grid(lty=1, equilogs=FALSE) box()} points(u, model$model[ , 1], col=groups.col, pch=pch, ...) ow <- options(warn=-1) on.exit(options(ow)) smoother.args$lty <- smoother.args$lty.spread <- 1 smoother.args$lwd <- smoother.args$lwd.spread <- if(is.null(lwd)) 2 else lwd if(is.null(groups)) { smoother(u, resp, col.line[1], log.x=FALSE, log.y=FALSE, spread=sd, smoother.args=smoother.args) smoother.args$lty <- smoother.args$lty.spread <- 2 smoother(u, predict(model), col.line[2], log.x=FALSE, log.y=FALSE, spread=sd, smoother.args=smoother.args) if(key){ outerLegend(c("Data", "Model"), lty=1:2, col=col.line, bty="n", cex=0.75, fill=col.line, border=col.line, horiz=TRUE, offset=0) } } else { for (j in 1:length(groups.levels)) { smoother.args$lwd <- if(is.null(lwd)) 1.75 else lwd smoother.args$lty <- 1 sel <- groups == groups.levels[j] smoother(u[sel], resp[sel], palette()[j], log.x=FALSE, log.y=FALSE, spread=FALSE, smoother.args=smoother.args) smoother.args$lty <- 2 smoother(u[sel], predict(model)[sel], palette()[j], log.x=FALSE, log.y=FALSE, spread=FALSE, smoother.args=smoother.args) } items <- paste(groups.label, groups.levels, sep= " = ") col.items <- palette()[1:length(groups.levels)] lty.items <- 1 if(key) plotArrayLegend(location="top", items=items, col.items=col.items, lty.items=lty.items , lwd.items=2, title="Legend") } showLabels(u, resp, labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col) } mmp.glm <- function (model, variable, sd = FALSE, xlab = deparse(substitute(variable)), smoother=gamLine, smoother.args=list(k=3), key=TRUE, pch, groups=NULL, col.line = palette()[c(4, 2)], col=palette()[1], labels, id.method="y", id.n=if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], grid=TRUE, ...) { lwd <- match.call(expand.dots=TRUE)$lwd if(missing(pch)) pch <- 1 groups.col <- col groups.pch <- match.call(expand.dots=TRUE)$pch if(is.null(groups.pch)) groups.pch <- 1 if (!is.null(groups)){ if(is.data.frame(groups)) { groups.label <- colnames(groups)[1] groups <- groups[,1] } else { groups.label <- deparse(substitute(groups)) } groups.levels <- unique(na.omit(groups)) for (j in 1:(length(groups.levels))) { pch[groups==groups.levels[j]] <- j groups.col[groups==groups.levels[j]] <- palette()[j]} } if (missing(variable)) { xlab <- "Linear Predictor" u <- fitted(update(model, na.action=na.omit)) } else { u <- variable } if(missing(labels)) labels <- names(residuals(model)[!is.na(residuals(model))]) response <- model.response(model.frame(model)) fam <- model$family$family lin <- model$family$link pw <- model$prior.weights # relevant only for binomial bernoulli <- FALSE if(fam == "binomial") { if(!any(pw > 1.1)) bernoulli <- TRUE if (is.factor(response)) {response <- as.numeric(response) - 1} if (is.matrix(response)){response <- response[, 1]/pw} } plot(u, response, type="n", xlab = xlab, ylab = colnames(model$model[1])) if(grid){ grid(lty=1, equilogs=FALSE) box()} points(u, response, col=col, pch=pch, ...) ow <- options(warn=-1) on.exit(options(ow)) smoother.args$lty <- 1 smoother.args$family <- fam smoother.args$link <- lin smoother.args$weights <- pw model.fit <- if(fam=="binomial") predict(model, type="response")/pw else predict(model, type="response") if(is.null(groups)) { smoother(u, response, col.line[1], log.x=FALSE, log.y=FALSE, spread=FALSE, smoother.args=smoother.args) smoother.args$lty <- 2 smoother(u, model.fit, col.line[2], log.x=FALSE, log.y=FALSE, spread=FALSE, smoother.args=smoother.args) if(key){ outerLegend(c("Data", "Model"), lty=1:2, col=col.line, bty="n", cex=0.75, fill=col.line, border=col.line, horiz=TRUE, offset=0) } } else { for (j in 1:length(groups.levels)) { smoother.args$lwd <- if(is.null(lwd)) 1.75 else lwd smoother.args$lty <- 1 sel <- groups == groups.levels[j] smoother(u[sel], response[sel], palette()[j], log.x=FALSE, log.y=FALSE, spread=FALSE, smoother.args=smoother.args) smoother.args$lty <- 2 smoother(u[sel], model.fit[sel], palette()[j], log.x=FALSE, log.y=FALSE, spread=FALSE, smoother.args=smoother.args) } items <- paste(groups.label, groups.levels, sep= " = ") col.items <- palette()[1:length(groups.levels)] lty.items <- 1 if(key) plotArrayLegend(location="top", items=items, col.items=col.items, lty.items=lty.items , lwd.items=2, title="Legend") } showLabels(u, model$model[, 1], labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col) } marginalModelPlots <- function(...) mmps(...) mmps <- function(model, terms= ~ ., fitted=TRUE, layout=NULL, ask, main, groups, key=TRUE, ...){ mf <- if(!is.null(terms)) termsToMf(model, terms) else NULL labels2 <- attr(attr(mf$mf.vars, "terms"), "term.labels") order2 <- attr(attr(mf$mf.vars, "terms"), "order") type2 <- rep("good", length(labels2)) if(length(labels2) > 0) { for (j in 1:length(labels2)){ if(order2[j] > 1) type2[j] <- NA #exclude interatctions if(inherits(mf$mf.vars[[labels2[j]]], "factor")) type2[j] <- NA #no factors if(inherits(mf$mf.vars[[labels2[j]]], "matrix")) type2[j] <- "original" } if (any( type2=="original", na.rm=TRUE )){ p1 <- try(predict(model, type="terms"), silent=TRUE) if(class(p1) == "try-error") {type2[type2=="original"] <- NA} else warning("Splines and/or polynomials replaced by a fitted linear combination") } } groups <- if (!missing(groups)) { termsToMf(model, as.formula(paste("~",deparse(substitute(groups)))))$mf.vars[, 2, drop=FALSE] } else { if(is.null(mf$mf.groups)) NULL else mf$mf.groups[, 2, drop=FALSE] } # If key=TRUE, determine the coordinates of the key: oma3 <- 1.5 # room for title in the outer margin ALWAYS mar3 <- if (is.null(groups)) 1.5 else .2 + if(is.data.frame(groups)) length(unique(groups[, 1])) else length(unique(groups)) nt <- sum(!is.na(type2)) + fitted if (missing(main)) main <- if (nt == 1) "Marginal Model Plot" else "Marginal Model Plots" if (nt == 0) stop("No plots specified") if (nt > 1 & (is.null(layout) || is.numeric(layout))) { if(is.null(layout)){ layout <- switch(min(nt, 9), c(1, 1), c(1, 2), c(2, 2), c(2, 2), c(3, 2), c(3, 2), c(3, 3), c(3, 3), c(3, 3)) } ask <- if(missing(ask) || is.null(ask)) prod(layout) 1) par(mfrow=layout, ask=ask, no.readonly=TRUE, oma=c(0, 0, oma3 , 0), mar=c(5.1, 4.1, mar3, 2.1)) else par(oma=c(0, 0, oma3 , 0), mar=c(5.1, 4.1, mar3, 2.1)) on.exit(par(op)) legend2 <- function(){ usr <- par("usr") coords <-list(x=usr[1], y=usr[3]) leg <- legend( coords, c("Data", "Model"), lty=1:2, lwd=2, bty="n", cex=0.9, plot=FALSE) coords <- list(x = usr[2] - leg$rect$w, y=usr[4] + leg$rect$h) legend( coords, c("Data", "Model"), lty=1:2, lwd=2, bty="n", xpd=NA, cex=0.9) } if (length(labels2) > 0) { for (j in 1:length(labels2)) { if(!is.na(type2[j])) { horiz <- if(type2[j] == "original"){p1[, labels2[j]]} else { if(type2[j] == "good") mf$mf.vars[ , labels2[j]] else NULL} lab <- labels2[j] mmp(model, horiz, xlab=lab, groups=groups, key=key, ...) if(!is.null(groups)) legend2()} } } if(fitted==TRUE) mmp(model, groups=groups, key=key, ...) if(!is.null(groups)) legend2() mtext(side=3, outer=TRUE, main, line=0.1, cex=1.2) if(any(is.na(type2))) warning("Interactions and/or factors skipped") invisible() } car/R/deltaMethod.R0000644000175100001440000001175612175507303013630 0ustar hornikusers#------------------------------------------------------------------------------- # Revision history: # 2009-10-29: renamed var argument to .vcov; tidied code. John # 2010-07-02; added method for survreg and coxph objects. # 2010-07-02; rewrote default method to permit prarmeter names to have # meta-characters # 2011-07028 Removed meta-character checks; removed parameterPrefix because # it didn't work and caused problems; added parameterNames to restore the # utility of parameterPrefix # 2011-10-02 Fixed bugs in the .survreg and .coxph methods so parameterNames # works correctly # 2012-03-02: fixed abbreviation of envir argument. J. Fox # 2012-04-08: modfied deltaMethod.default() to use coef and vcov # 2012-12-10: removed the 'deltaMethodMessageFlag' # 2013-06-20: added deltaMethod.merMod(). J. Fox # 2013-06-20: tweaks for lme4. J. Fox # 2013-07-01: New 'constants' argument for use when called from within a function. # 2013-07-18: fixed a bug in passing the 'func' argument #------------------------------------------------------------------------------- deltaMethod <- function (object, ...) { UseMethod("deltaMethod") } deltaMethod.default <- function (object, g, vcov., func = g, constants, ...) { if (!is.character(g)) stop("The argument 'g' must be a character string") if ((exists.method("coef", object, default=FALSE) || (!is.atomic(object) && !is.null(object$coefficients))) && exists.method("vcov", object, default=FALSE)){ if (missing(vcov.)) vcov. <- vcov(object) object <- coef(object) } para <- object para.names <- names(para) g <- parse(text = g) q <- length(para) for (i in 1:q) { assign(names(para)[i], para[i]) } if(!missing(constants)){ for (i in seq_along(constants)) assign(names(constants[i]), constants[[i]])} est <- eval(g) names(est) <- NULL gd <- rep(0, q) for (i in 1:q) { gd[i] <- eval(D(g, names(para)[i])) } se.est <- as.vector(sqrt(t(gd) %*% vcov. %*% gd)) data.frame(Estimate = est, SE = se.est, row.names = c(func)) } deltaMethod.lm <- function (object, g, vcov. = vcov, parameterNames = names(coef(object)), ...) { # if( !exists("deltaMethodMessageFlag", envir=.carEnv)){ # message("deltaMethod arguments have changed, see help(deltaMethod)") # assign("deltaMethodMessageFlag", TRUE, envir=.carEnv) # } para <- coef(object) para.names <- parameterNames para.names[1] <- gsub("\\(Intercept\\)", "Intercept", para.names[1]) names(para) <- para.names vcov. <- if (is.function(vcov.)) vcov.(object) else vcov. deltaMethod.default(para, g, vcov., ...) } # nls has named parameters so parameterNames is ignored deltaMethod.nls <- function(object, g, vcov.=vcov,...){ vcov. <- if(is.function(vcov.)) vcov.(object) deltaMethod.default(coef(object), g, vcov., ...) } deltaMethod.polr <- function(object,g,vcov.=vcov,...){ sel <- 1:(length(coef(object))) vcov. <- if(is.function(vcov.)) vcov.(object)[sel, sel] deltaMethod.lm(object, g, vcov., ...) } deltaMethod.multinom <- function(object, g, vcov.=vcov, parameterNames = if(is.matrix(coef(object))) colnames(coef(object)) else names(coef(object)), ...){ out <- NULL coefs <- coef(object) if (!is.matrix(coefs)) { coefs <- t(as.matrix(coefs)) } colnames(coefs) <- parameterNames nc <- dim(coefs)[2] for (i in 1:dim(coefs)[1]){ para <- coefs[i, ] ans <- deltaMethod(para, g, vcov.(object)[(i - 1) + 1:nc, (i - 1) + 1:nc], ...) rownames(ans)[1] <- paste(rownames(coefs)[i], rownames(ans)[1]) out <- rbind(out,ans) } out} # method for survreg objects. deltaMethod.survreg <- function(object, g, vcov. = vcov, parameterNames = names(coef(object)), ...) { deltaMethod.lm(object, g, vcov., parameterNames , ...) } # method for coxph objects. deltaMethod.coxph <- function(object, g, vcov. = vcov, parameterNames = names(coef(object)), ...) { deltaMethod.lm(object, g, vcov., parameterNames, ...) } # lmer deltaMethod.merMod <- function(object, g, vcov. = vcov, parameterNames = names(fixef(object)), ...) { deltaMethod.mer(object=object, g=g, vcov.=vcov, parameterNames=parameterNames, ...) } deltaMethod.mer <- function(object, g, vcov. = vcov, parameterNames = names(fixef(object)), ...) { para <- fixef(object) names(para) = parameterNames vcov. <- if (is.function(vcov.)) vcov.(object) else vcov. deltaMethod(para, g, vcov., ...) } #lme deltaMethod.lme <- function(object, g, vcov. = vcov, parameterNames = names(fixef(object)), ...) { para <- fixef(object) names(para) = parameterNames vcov. <- if (is.function(vcov.)) vcov.(object) else vcov. deltaMethod(para, g, vcov., ...) } # nlsList lsList deltaMethod.lmList <- function(object, g, ...) { out <- t(sapply(object, function(x) deltaMethod(x, g, ...))) rownames(out) <- paste(rownames(out), g) out } car/R/qqPlot.R0000644000175100001440000001200512140542666012645 0ustar hornikusers# Quantile-comparison plots (J. Fox) # last modified 30 September 2009 by J. Fox # November 2009 by S. Weisberg -- changed to use showLabels for point identification # 14 April 2010: set id.n = 0. J. Fox # 1 June 2010: set reps=100 in qqPlot.lm. J. Fox # 28 June 2010: fixed labeling bug S. Weisberg # 11 March 2011: moved up ... argument. J. Fox # 23 May 2012: line="none" now honored in qqPlot.default. J. Fox # 2 May 2013: qqPlot.lm() now works with "aov" objects (fixing problem reported by Thomas Burk). J. Fox qqp <- function(...) qqPlot(...) qqPlot<-function(x, ...) { UseMethod("qqPlot") } qqPlot.default <- function(x, distribution="norm", ..., ylab=deparse(substitute(x)), xlab=paste(distribution, "quantiles"), main=NULL, las=par("las"), envelope=.95, col=palette()[1], col.lines=palette()[2], lwd=2, pch=1, cex=par("cex"), line=c("quartiles", "robust", "none"), labels = if(!is.null(names(x))) names(x) else seq(along=x), id.method = "y", id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], grid=TRUE) { line <- match.arg(line) good <- !is.na(x) ord <- order(x[good]) ord.x <- x[good][ord] ord.lab <- labels[good][ord] q.function <- eval(parse(text=paste("q", distribution, sep=""))) d.function <- eval(parse(text=paste("d", distribution, sep=""))) n <- length(ord.x) P <- ppoints(n) z <- q.function(P, ...) plot(z, ord.x, type="n", xlab=xlab, ylab=ylab, main=main, las=las) if(grid){ grid(lty=1, equilogs=FALSE) box()} points(z, ord.x, col=col, pch=pch, cex=cex) if (line == "quartiles" || line == "none"){ Q.x <- quantile(ord.x, c(.25,.75)) Q.z <- q.function(c(.25,.75), ...) b <- (Q.x[2] - Q.x[1])/(Q.z[2] - Q.z[1]) a <- Q.x[1] - b*Q.z[1] if (line == "quartiles") abline(a, b, col=col.lines, lwd=lwd) } if (line=="robust") { coef <- coef(rlm(ord.x ~ z)) a <- coef[1] b <- coef[2] abline(a, b, col=col.lines, lwd=lwd) } conf <- if (envelope == FALSE) .95 else envelope zz <- qnorm(1 - (1 - conf)/2) SE <- (b/d.function(z, ...))*sqrt(P*(1 - P)/n) fit.value <- a + b*z upper <- fit.value + zz*SE lower <- fit.value - zz*SE if (envelope != FALSE) { lines(z, upper, lty=2, lwd=lwd, col=col.lines) lines(z, lower, lty=2, lwd=lwd, col=col.lines) } showLabels(z, ord.x, labels=ord.lab, id.method = id.method, id.n = id.n, id.cex=id.cex, id.col=id.col) } qqPlot.lm <- function(x, xlab=paste(distribution, "Quantiles"), ylab=paste("Studentized Residuals(", deparse(substitute(x)), ")", sep=""), main=NULL, distribution=c("t", "norm"), line=c("robust", "quartiles", "none"), las=par("las"), simulate=TRUE, envelope=.95, reps=100, col=palette()[1], col.lines=palette()[2], lwd=2, pch=1, cex=par("cex"), labels, id.method = "y", id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], grid=TRUE, ...){ result <- NULL distribution <- match.arg(distribution) line <- match.arg(line) rstudent <- rstudent(x) if (missing(labels)) labels <- names(rstudent) good <- !is.na(rstudent) rstudent <- rstudent[good] labels <- labels[good] sumry <- summary.lm(x) res.df <- sumry$df[2] if(!simulate) result <- qqPlot(rstudent, distribution=if (distribution == "t") "t" else "norm", df=res.df-1, line=line, main=main, xlab=xlab, ylab=ylab, las=las, envelope=envelope, col=col, col.lines=col.lines, lwd=lwd, pch=pch, cex=cex, labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col, ...) else { n <- length(rstudent) ord <- order(rstudent) ord.x <- rstudent[ord] ord.lab <- labels[ord] P <- ppoints(n) z <- if (distribution == 't') qt(P, df=res.df-1) else qnorm(P) plot(z, ord.x, type="n", xlab=xlab, ylab=ylab, main=main, las=las) if(grid) grid(lty=1, equilogs=FALSE) points(z, ord.x, pch=pch, col=col, cex=cex) yhat <- na.omit(fitted.values(x)) S <- sumry$sigma Y <- matrix(yhat, n, reps) + matrix(rnorm(n*reps, sd=S), n, reps) X <- model.matrix(x) rstud <- apply(rstudent(lm(Y ~ X - 1)), 2, sort) lower <- apply(rstud, 1, quantile, prob=(1 - envelope)/2) upper <- apply(rstud, 1, quantile, prob=(1 + envelope)/2) lines(z, upper, lty=2, lwd=lwd, col=col.lines) lines(z, lower, lty=2, lwd=lwd, col=col.lines) if (line == "quartiles"){ Q.x <- quantile(rstudent, c(.25,.75)) Q.z <- if (distribution == 't') qt(c(.25,.75), df=res.df - 1) else qnorm(c(.25,.75)) b <- (Q.x[2] - Q.x[1])/(Q.z[2] - Q.z[1]) a <- Q.x[1] - b*Q.z[1] abline(a, b, col=col.lines, lwd=lwd) } if (line=="robust"){ coef <- coefficients(rlm(ord.x~z)) a <- coef[1] b <- coef[2] abline(a, b, col=col.lines, lwd=lwd) } result <- showLabels(z, ord.x,labels=ord.lab, id.method = id.method, id.n = id.n, id.cex=id.cex, id.col=id.col) } if (length(result) == 0) invisible(result) else if (is.numeric(result)) sort(result) else result } qqPlot.glm <- function(x, ...){ stop("QQ plot for studentized residuals not available for glm") } car/R/linearHypothesis.R0000644000175100001440000006311612204420315014713 0ustar hornikusers#--------------------------------------------------------------------------------------- # Revision history: # 2009-01-16: replaced unlist(options("foo")) with getOption("foo") # 2009-09-16: optionally allow models with aliased coefficients. J. Fox # 2009-12-10: modification by A. Zeileis to allow wider range of coef. names. # 2009-12-22: small changes to linearHypothesis.mlm() to handle user-specified # within-subjects designs in Anova() # 2010-05-21: linearHypothesis.default() and .lm() changed so that differences # in df, etc. will be postive. # 2010-06-12: linearHypothesis.mlm() changed to allow observation weights # 2010-06-22: fixed bug in linearHypothesis.lm caused by 2010-05-21 revision # 2010-01-21: added methods for mixed models; added matchCoefs() and methods. J. Fox # 2011-05-03: fixed bug in displaying numbers starting with "-1" or "+1" in printed representation. J. Fox # 2011-06-09: added matchCoefs.mlm(). J. Fox # 2011-11-27: added linearHypothesis.svyglm(). John # 2011-12-27: fixed printing bug in linearHypothesis(). John # 2012-02-28: added F-test to linearHypothesis.mer(). John # 2012-03-07: singular.ok argument added to linearHypothesis.mlm(). J. Fox # 2012-08-20: Fixed p-value bug for chisq test in .mer method. John # 2012-09-17: updated linearHypothesis.mer for pkrtest 0.3-2. John # 2012-11-21: test for NULL rhs to avoid warning in R 2.16.0. John # 2013-01-28: hypotheses can now contain newlines and tabs # 2013-02-14: fixed bug in printing constants of the form 1.x*. John # 2013-06-20: added .merMod() method. John # 2013-06-22: tweaks for lme4. John # 2013-06-22: test argument uniformly uses "Chisq" rather than "chisq". J. Fox # 2013-08-19: removed calls to unexported functions in stats. J. Fox #--------------------------------------------------------------------------------------- vcov.default <- function(object, ...){ stop(paste("there is no vcov() method for models of class", paste(class(object), collapse=", "))) } has.intercept.matrix <- function (model, ...) { "(Intercept)" %in% colnames(model) } makeHypothesis <- function(cnames, hypothesis, rhs = NULL){ parseTerms <- function(terms){ component <- gsub("^[-\\ 0-9\\.]+", "", terms) component <- gsub(" ", "", component, fixed=TRUE) component } stripchars <- function(x) { x <- gsub("\\n", " ", x) x <- gsub("\\t", " ", x) x <- gsub(" ", "", x, fixed = TRUE) x <- gsub("*", "", x, fixed = TRUE) x <- gsub("-", "+-", x, fixed = TRUE) x <- strsplit(x, "+", fixed = TRUE)[[1]] x <- x[x!=""] x } char2num <- function(x) { x[x == ""] <- "1" x[x == "-"] <- "-1" as.numeric(x) } constants <- function(x, y) { with.coef <- unique(unlist(sapply(y, function(z) which(z == parseTerms(x))))) if (length(with.coef) > 0) x <- x[-with.coef] x <- if (is.null(x)) 0 else sum(as.numeric(x)) if (any(is.na(x))) stop('The hypothesis "', hypothesis, '" is not well formed: contains bad coefficient/variable names.') x } coefvector <- function(x, y) { rv <- gsub(" ", "", x, fixed=TRUE) == parseTerms(y) if (!any(rv)) return(0) if (sum(rv) > 1) stop('The hypothesis "', hypothesis, '" is not well formed.') rv <- sum(char2num(unlist(strsplit(y[rv], x, fixed=TRUE)))) if (is.na(rv)) stop('The hypothesis "', hypothesis, '" is not well formed: contains non-numeric coefficients.') rv } if (!is.null(rhs)) rhs <- rep(rhs, length.out = length(hypothesis)) if (length(hypothesis) > 1) return(rbind(Recall(cnames, hypothesis[1], rhs[1]), Recall(cnames, hypothesis[-1], rhs[-1]))) cnames_symb <- sapply(c("@", "#", "~"), function(x) length(grep(x, cnames)) < 1) if(any(cnames_symb)) { cnames_symb <- head(c("@", "#", "~")[cnames_symb], 1) cnames_symb <- paste(cnames_symb, seq_along(cnames), cnames_symb, sep = "") hypothesis_symb <- hypothesis for(i in order(nchar(cnames), decreasing = TRUE)) hypothesis_symb <- gsub(cnames[i], cnames_symb[i], hypothesis_symb, fixed = TRUE) } else { stop('The hypothesis "', hypothesis, '" is not well formed: contains non-standard coefficient names.') } lhs <- strsplit(hypothesis_symb, "=", fixed=TRUE)[[1]] if (is.null(rhs)) { if (length(lhs) < 2) rhs <- "0" else if (length(lhs) == 2) { rhs <- lhs[2] lhs <- lhs[1] } else stop('The hypothesis "', hypothesis, '" is not well formed: contains more than one = sign.') } else { if (length(lhs) < 2) as.character(rhs) else stop('The hypothesis "', hypothesis, '" is not well formed: contains a = sign although rhs was specified.') } lhs <- stripchars(lhs) rhs <- stripchars(rhs) rval <- sapply(cnames_symb, coefvector, y = lhs) - sapply(cnames_symb, coefvector, y = rhs) rval <- c(rval, constants(rhs, cnames_symb) - constants(lhs, cnames_symb)) names(rval) <- c(cnames, "*rhs*") rval } printHypothesis <- function(L, rhs, cnames){ hyp <- rep("", nrow(L)) for (i in 1:nrow(L)){ sel <- L[i,] != 0 h <- L[i, sel] h <- ifelse(h < 0, as.character(h), paste("+", h, sep="")) nms <- cnames[sel] h <- paste(h, nms) h <- gsub("-", " - ", h) h <- gsub("+", " + ", h, fixed=TRUE) h <- paste(h, collapse="") h <- gsub(" ", " ", h, fixed=TRUE) h <- sub("^\\ \\+", "", h) h <- sub("^\\ ", "", h) h <- sub("^-\\ ", "-", h) h <- paste(" ", h, sep="") h <- paste(h, "=", rhs[i]) h <- gsub(" 1([^[:alnum:]_.]+)[ *]*", "", gsub("-1([^[:alnum:]_.]+)[ *]*", "-", gsub("- +1 +", "-1 ", h))) h <- sub("Intercept)", "(Intercept)", h) h <- gsub("-", " - ", h) h <- gsub("+", " + ", h, fixed=TRUE) h <- gsub(" ", " ", h, fixed=TRUE) h <- sub("^ *", "", h) hyp[i] <- h } hyp } linearHypothesis <- function (model, ...) UseMethod("linearHypothesis") lht <- function (model, ...) UseMethod("linearHypothesis") linearHypothesis.nlsList <- function(model, ..., vcov., coef.){ vcov.nlsList <- function(object, ...) { vlist <- lapply(object, vcov) ng <- length(vlist) nv <- dim(vlist[[1]])[1] v <- matrix(0, nrow=ng*nv, ncol=ng*nv) for (j in 1:ng){ cells <- ((j-1)*nv + 1):(j*nv) v[cells, cells] <- vlist[[j]] } v } linearHypothesis.default(model, vcov.=vcov.nlsList(model), coef.=unlist(lapply(model, coef)), ...)} linearHypothesis.default <- function(model, hypothesis.matrix, rhs=NULL, test=c("Chisq", "F"), vcov.=NULL, singular.ok=FALSE, verbose=FALSE, coef. = coef(model), ...){ df <- df.residual(model) if (is.null(df)) df <- Inf ## if no residual df available V <- if (is.null(vcov.)) vcov(model) else if (is.function(vcov.)) vcov.(model) else vcov. b <- coef. if (any(aliased <- is.na(b)) && !singular.ok) stop("there are aliased coefficients in the model") b <- b[!aliased] if (is.null(b)) stop(paste("there is no coef() method for models of class", paste(class(model), collapse=", "))) if (is.character(hypothesis.matrix)) { L <- makeHypothesis(names(b), hypothesis.matrix, rhs) if (is.null(dim(L))) L <- t(L) rhs <- L[, NCOL(L)] L <- L[, -NCOL(L), drop = FALSE] rownames(L) <- hypothesis.matrix } else { L <- if (is.null(dim(hypothesis.matrix))) t(hypothesis.matrix) else hypothesis.matrix if (is.null(rhs)) rhs <- rep(0, nrow(L)) } q <- NROW(L) if (verbose){ cat("\nHypothesis matrix:\n") print(L) cat("\nRight-hand-side vector:\n") print(rhs) cat("\nEstimated linear function (hypothesis.matrix %*% coef - rhs)\n") print(drop(L %*% b - rhs)) cat("\n") } SSH <- as.vector(t(L %*% b - rhs) %*% solve(L %*% V %*% t(L)) %*% (L %*% b - rhs)) test <- match.arg(test) if (!(is.finite(df) && df > 0)) test <- "Chisq" name <- try(formula(model), silent = TRUE) if (inherits(name, "try-error")) name <- substitute(model) title <- "Linear hypothesis test\n\nHypothesis:" topnote <- paste("Model 1: restricted model","\n", "Model 2: ", paste(deparse(name), collapse = "\n"), sep = "") note <- if (is.null(vcov.)) "" else "\nNote: Coefficient covariance matrix supplied.\n" rval <- matrix(rep(NA, 8), ncol = 4) colnames(rval) <- c("Res.Df", "Df", test, paste("Pr(>", test, ")", sep = "")) rownames(rval) <- 1:2 rval[,1] <- c(df+q, df) if (test == "F") { f <- SSH/q p <- pf(f, q, df, lower.tail = FALSE) rval[2, 2:4] <- c(q, f, p) } else { p <- pchisq(SSH, q, lower.tail = FALSE) rval[2, 2:4] <- c(q, SSH, p) } if (!(is.finite(df) && df > 0)) rval <- rval[,-1] structure(as.data.frame(rval), heading = c(title, printHypothesis(L, rhs, names(b)), "", topnote, note), class = c("anova", "data.frame")) } linearHypothesis.glm <- function(model, ...) linearHypothesis.default(model, ...) linearHypothesis.lm <- function(model, hypothesis.matrix, rhs=NULL, test=c("F", "Chisq"), vcov.=NULL, white.adjust=c(FALSE, TRUE, "hc3", "hc0", "hc1", "hc2", "hc4"), singular.ok=FALSE, ...){ if (!singular.ok && is.aliased(model)) stop("there are aliased coefficients in the model.") test <- match.arg(test) white.adjust <- as.character(white.adjust) white.adjust <- match.arg(white.adjust) if (white.adjust != "FALSE"){ if (white.adjust == "TRUE") white.adjust <- "hc3" vcov. <- hccm(model, type=white.adjust) } rval <- linearHypothesis.default(model, hypothesis.matrix, rhs = rhs, test = test, vcov. = vcov., singular.ok=singular.ok, ...) if (is.null(vcov.)) { rval2 <- matrix(rep(NA, 4), ncol = 2) colnames(rval2) <- c("RSS", "Sum of Sq") SSH <- rval[2,test] if (test == "F") SSH <- SSH * abs(rval[2, "Df"]) df <- rval[2, "Res.Df"] error.SS <- deviance(model) rval2[,1] <- c(error.SS + SSH * error.SS/df, error.SS) rval2[2,2] <- abs(diff(rval2[,1])) rval2 <- cbind(rval, rval2)[,c(1, 5, 2, 6, 3, 4)] class(rval2) <- c("anova", "data.frame") attr(rval2, "heading") <- attr(rval, "heading") rval <- rval2 } rval } check.imatrix <- function(X, terms){ # check block orthogonality of within-subjects model matrix XX <- crossprod(X) if (missing(terms)) terms <- attr(X, "assign") for (term in unique(terms)){ subs <- term == terms XX[subs, subs] <- 0 } if (any(abs(XX) > sqrt(.Machine$double.eps))) stop("Terms in the intra-subject model matrix are not orthogonal.") } linearHypothesis.mlm <- function(model, hypothesis.matrix, rhs=NULL, SSPE, V, test, idata, icontrasts=c("contr.sum", "contr.poly"), idesign, iterms, check.imatrix=TRUE, P=NULL, title="", singular.ok=FALSE, verbose=FALSE, ...){ if (missing(test)) test <- c("Pillai", "Wilks", "Hotelling-Lawley", "Roy") test <- match.arg(test, c("Pillai", "Wilks", "Hotelling-Lawley", "Roy"), several.ok=TRUE) df.residual <- df.residual(model) wts <- if (!is.null(model$weights)) model$weights else rep(1,nrow(model.matrix(model))) # V = (X'WX)^{-1} if (missing (V)) V <- solve(wcrossprod(model.matrix(model), w=wts)) B <- coef(model) if (is.character(hypothesis.matrix)) { L <- makeHypothesis(rownames(B), hypothesis.matrix, rhs) if (is.null(dim(L))) L <- t(L) L <- L[, -NCOL(L), drop = FALSE] rownames(L) <- hypothesis.matrix } else { L <- if (is.null(dim(hypothesis.matrix))) t(hypothesis.matrix) else hypothesis.matrix } # SSPE = E'WE if (missing(SSPE)) SSPE <- wcrossprod(residuals(model),w=wts) if (missing(idata)) idata <- NULL if (missing(idesign)) idesign <- NULL if (!is.null(idata)){ for (i in 1:length(idata)){ if (is.null(attr(idata[,i], "contrasts"))){ contrasts(idata[,i]) <- if (is.ordered(idata[,i])) icontrasts[2] else icontrasts[1] } } if (is.null(idesign)) stop("idesign (intra-subject design) missing.") X.design <- model.matrix(idesign, data=idata) if (check.imatrix) check.imatrix(X.design) intercept <- has.intercept(X.design) term.names <- term.names(idesign) if (intercept) term.names <- c("(Intercept)", term.names) which.terms <- match(iterms, term.names) if (any(nas <- is.na(which.terms))){ if (sum(nas) == 1) stop('The term "', iterms[nas],'" is not in the intrasubject design.') else stop("The following terms are not in the intrasubject design: ", paste(iterms[nas], collapse=", "), ".") } select <- apply(outer(which.terms, attr(X.design, "assign") + intercept, "=="), 2, any) P <- X.design[, select, drop=FALSE] } if (!is.null(P)){ rownames(P) <- colnames(B) SSPE <- t(P) %*% SSPE %*% P B <- B %*% P } rank <- sum(eigen(SSPE, only.values=TRUE)$values >= sqrt(.Machine$double.eps)) if (!singular.ok && rank < ncol(SSPE)) stop("The error SSP matrix is apparently of deficient rank = ", rank, " < ", ncol(SSPE)) r <- ncol(B) if (is.null(rhs)) rhs <- matrix(0, nrow(L), r) rownames(rhs) <- rownames(L) colnames(rhs) <- colnames(B) q <- NROW(L) if (verbose){ cat("\nHypothesis matrix:\n") print(L) cat("\nRight-hand-side matrix:\n") print(rhs) cat("\nEstimated linear function (hypothesis.matrix %*% coef - rhs):\n") print(drop(L %*% B - rhs)) cat("\n") } SSPH <- t(L %*% B - rhs) %*% solve(L %*% V %*% t(L)) %*% (L %*% B - rhs) rval <- list(SSPH=SSPH, SSPE=SSPE, df=q, r=r, df.residual=df.residual, P=P, title=title, test=test, singular=rank < ncol(SSPE)) class(rval) <- "linearHypothesis.mlm" rval } #linearHypothesis.mlm <- function(model, hypothesis.matrix, rhs=NULL, SSPE, V, # test, idata, icontrasts=c("contr.sum", "contr.poly"), idesign, iterms, # check.imatrix=TRUE, P=NULL, title="", verbose=FALSE, ...){ # if (missing(test)) test <- c("Pillai", "Wilks", "Hotelling-Lawley", "Roy") # test <- match.arg(test, c("Pillai", "Wilks", "Hotelling-Lawley", "Roy"), # several.ok=TRUE) # df.residual <- df.residual(model) # if (missing (V)) V <- solve(crossprod(model.matrix(model))) # B <- coef(model) # if (is.character(hypothesis.matrix)) { # L <- makeHypothesis(rownames(B), hypothesis.matrix, rhs) # if (is.null(dim(L))) L <- t(L) # L <- L[, -NCOL(L), drop = FALSE] # rownames(L) <- hypothesis.matrix # } # else { # L <- if (is.null(dim(hypothesis.matrix))) t(hypothesis.matrix) # else hypothesis.matrix # } # if (missing(SSPE)) SSPE <- crossprod(residuals(model)) # if (missing(idata)) idata <- NULL # if (missing(idesign)) idesign <- NULL # if (!is.null(idata)){ # for (i in 1:length(idata)){ # if (is.null(attr(idata[,i], "contrasts"))){ # contrasts(idata[,i]) <- if (is.ordered(idata[,i])) icontrasts[2] # else icontrasts[1] # } # } # if (is.null(idesign)) stop("idesign (intra-subject design) missing.") # X.design <- model.matrix(idesign, data=idata) # if (check.imatrix) check.imatrix(X.design) # intercept <- has.intercept(X.design) # term.names <- term.names(idesign) # if (intercept) term.names <- c("(Intercept)", term.names) # which.terms <- match(iterms, term.names) # if (any(nas <- is.na(which.terms))){ # if (sum(nas) == 1) # stop('The term "', iterms[nas],'" is not in the intrasubject design.') # else stop("The following terms are not in the intrasubject design: ", # paste(iterms[nas], collapse=", "), ".") # } # select <- apply(outer(which.terms, attr(X.design, "assign") + intercept, "=="), # 2, any) # P <- X.design[, select, drop=FALSE] # } # if (!is.null(P)){ # rownames(P) <- colnames(B) # SSPE <- t(P) %*% SSPE %*% P # B <- B %*% P # } # rank <- sum(eigen(SSPE, only.values=TRUE)$values >= sqrt(.Machine$double.eps)) # if (rank < ncol(SSPE)) # stop("The error SSP matrix is apparently of deficient rank = ", # rank, " < ", ncol(SSPE)) # r <- ncol(B) # if (is.null(rhs)) rhs <- matrix(0, nrow(L), r) # rownames(rhs) <- rownames(L) # colnames(rhs) <- colnames(B) # q <- NROW(L) # if (verbose){ # cat("\nHypothesis matrix:\n") # print(L) # cat("\nRight-hand-side matrix:\n") # print(rhs) # cat("\nEstimated linear function (hypothesis.matrix %*% coef - rhs):\n") # print(drop(L %*% B - rhs)) # cat("\n") # } # SSPH <- t(L %*% B - rhs) %*% solve(L %*% V %*% t(L)) %*% (L %*% B - rhs) # rval <- list(SSPH=SSPH, SSPE=SSPE, df=q, r=r, df.residual=df.residual, P=P, # title=title, test=test) # class(rval) <- "linearHypothesis.mlm" # rval #} print.linearHypothesis.mlm <- function(x, SSP=TRUE, SSPE=SSP, digits=getOption("digits"), ...){ test <- x$test if (!is.null(x$P) && SSP){ P <- x$P cat("\n Response transformation matrix:\n") attr(P, "assign") <- NULL attr(P, "contrasts") <- NULL print(P, digits=digits) } if (SSP){ cat("\nSum of squares and products for the hypothesis:\n") print(x$SSPH, digits=digits) } if (SSPE){ cat("\nSum of squares and products for error:\n") print(x$SSPE, digits=digits) } if ((!is.null(x$singular)) && x$singular){ warning("the error SSP matrix is singular; multivariate tests are unavailable") return(invisible(x)) } SSPE.qr <- qr(x$SSPE) # the following code is adapted from summary.manova eigs <- Re(eigen(qr.coef(SSPE.qr, x$SSPH), symmetric = FALSE)$values) tests <- matrix(NA, 4, 4) rownames(tests) <- c("Pillai", "Wilks", "Hotelling-Lawley", "Roy") if ("Pillai" %in% test) tests[1, 1:4] <- Pillai(eigs, x$df, x$df.residual) if ("Wilks" %in% test) tests[2, 1:4] <- Wilks(eigs, x$df, x$df.residual) if ("Hotelling-Lawley" %in% test) tests[3, 1:4] <- HL(eigs, x$df, x$df.residual) if ("Roy" %in% test) tests[4, 1:4] <- Roy(eigs, x$df, x$df.residual) tests <- na.omit(tests) ok <- tests[, 2] >= 0 & tests[, 3] > 0 & tests[, 4] > 0 ok <- !is.na(ok) & ok tests <- cbind(x$df, tests, pf(tests[ok, 2], tests[ok, 3], tests[ok, 4], lower.tail = FALSE)) colnames(tests) <- c("Df", "test stat", "approx F", "num Df", "den Df", "Pr(>F)") tests <- structure(as.data.frame(tests), heading = paste("\nMultivariate Test", if (nrow(tests) > 1) "s", ": ", x$title, sep=""), class = c("anova", "data.frame")) print(tests, digits=digits) invisible(x) } linearHypothesis.survreg <- function(model, hypothesis.matrix, rhs=NULL, test=c("Chisq", "F"), vcov., verbose=FALSE, ...){ if (missing(vcov.)) { vcov. <- vcov(model) p <- nrow(vcov.) vcov. <- vcov.[-p, -p] } linearHypothesis.default(model, hypothesis.matrix, rhs, test, vcov., verbose=verbose, ...) } linearHypothesis.polr <- function (model, hypothesis.matrix, rhs=NULL, vcov., verbose=FALSE, ...){ k <- length(coef(model)) V <- vcov(model)[1:k, 1:k] linearHypothesis.default(model, hypothesis.matrix, rhs, vcov.=V, verbose=verbose, ...) } coef.multinom <- function(object, ...){ # the following local function is copied from nnet:::coef.multinom coef.m <- function (object, ...) { r <- length(object$vcoefnames) if (length(object$lev) == 2L) { coef <- object$wts[1L + (1L:r)] names(coef) <- object$vcoefnames } else { coef <- matrix(object$wts, nrow = object$n[3L], byrow = TRUE)[, 1L + (1L:r), drop = FALSE] if (length(object$lev)) dimnames(coef) <- list(object$lev, object$vcoefnames) if (length(object$lab)) dimnames(coef) <- list(object$lab, object$vcoefnames) coef <- coef[-1L, , drop = FALSE] } coef } b <- coef.m(object, ...) cn <- colnames(b) rn <- rownames(b) b <- as.vector(t(b)) names(b) <- as.vector(outer(cn, rn, function(c, r) paste(r, c, sep=":"))) b } ## functions for mixed models linearHypothesis.merMod <- function(model, hypothesis.matrix, rhs=NULL, vcov.=NULL, test=c("Chisq", "F"), singular.ok=FALSE, verbose=FALSE, ...){ linearHypothesis.mer(model=model, hypothesis.matrix=hypothesis.matrix, vcov.=vcov., test=test, singular.ok=singular.ok, verbose=verbose, ...) } linearHypothesis.mer <- function(model, hypothesis.matrix, rhs=NULL, vcov.=NULL, test=c("Chisq", "F"), singular.ok=FALSE, verbose=FALSE, ...){ test <- match.arg(test) V <- as.matrix(if (is.null(vcov.))vcov(model) else if (is.function(vcov.)) vcov.(model) else vcov.) b <- fixef(model) if (any(aliased <- is.na(b)) && !singular.ok) stop("there are aliased coefficients in the model") b <- b[!aliased] if (is.character(hypothesis.matrix)) { L <- makeHypothesis(names(b), hypothesis.matrix, rhs) if (is.null(dim(L))) L <- t(L) rhs <- L[, NCOL(L)] L <- L[, -NCOL(L), drop = FALSE] rownames(L) <- hypothesis.matrix } else { L <- if (is.null(dim(hypothesis.matrix))) t(hypothesis.matrix) else hypothesis.matrix if (is.null(rhs)) rhs <- rep(0, nrow(L)) } q <- NROW(L) if (verbose){ cat("\nHypothesis matrix:\n") print(L) cat("\nRight-hand-side vector:\n") print(rhs) cat("\nEstimated linear function (hypothesis.matrix %*% coef - rhs)\n") print(drop(L %*% b - rhs)) cat("\n") } if (test == "Chisq"){ df <- Inf SSH <- as.vector(t(L %*% b - rhs) %*% solve(L %*% V %*% t(L)) %*% (L %*% b - rhs)) } else { if (!require(pbkrtest) || packageVersion("pbkrtest") < "0.3.2") stop("pbkrtest package version >= 0.3.2 required for F-test on linear mixed model") if (!isREML(model)) stop("F test available only for linear mixed model fit by REML") res <- KRmodcomp(model, L)$test df <- res["Ftest", "ddf"] F <- res["Ftest", "stat"] p <- res["Ftest", "p.value"] } name <- try(formula(model), silent = TRUE) if (inherits(name, "try-error")) name <- substitute(model) title <- "Linear hypothesis test\n\nHypothesis:" topnote <- paste("Model 1: restricted model","\n", "Model 2: ", paste(deparse(name), collapse = "\n"), sep = "") note <- if (is.null(vcov.)) "" else "\nNote: Coefficient covariance matrix supplied.\n" rval <- matrix(rep(NA, 8), ncol = 4) if (test == "Chisq"){ colnames(rval) <- c("Res.Df", "Df", "Chisq", paste("Pr(>Chisq)", sep = "")) rownames(rval) <- 1:2 rval[,1] <- c(df+q, df) p <- pchisq(SSH, q, lower.tail = FALSE) rval[2, 2:4] <- c(q, SSH, p) rval <- rval[,-1] } else{ colnames(rval) <- c("Res.Df", "Df", "F", paste("Pr(>F)", sep = "")) rownames(rval) <- 1:2 rval[,1] <- c(df+q, df) rval[2, 2:4] <- c(q, F, p) } structure(as.data.frame(rval), heading = c(title, printHypothesis(L, rhs, names(b)), "", topnote, note), class = c("anova", "data.frame")) } linearHypothesis.lme <- function(model, hypothesis.matrix, rhs=NULL, vcov.=NULL, singular.ok=FALSE, verbose=FALSE, ...){ V <- as.matrix(if (is.null(vcov.))vcov(model) else if (is.function(vcov.)) vcov.(model) else vcov.) b <- fixef(model) if (any(aliased <- is.na(b)) && !singular.ok) stop("there are aliased coefficients in the model") b <- b[!aliased] if (is.character(hypothesis.matrix)) { L <- makeHypothesis(names(b), hypothesis.matrix, rhs) if (is.null(dim(L))) L <- t(L) rhs <- L[, NCOL(L)] L <- L[, -NCOL(L), drop = FALSE] rownames(L) <- hypothesis.matrix } else { L <- if (is.null(dim(hypothesis.matrix))) t(hypothesis.matrix) else hypothesis.matrix if (is.null(rhs)) rhs <- rep(0, nrow(L)) } q <- NROW(L) if (verbose){ cat("\nHypothesis matrix:\n") print(L) cat("\nRight-hand-side vector:\n") print(rhs) cat("\nEstimated linear function (hypothesis.matrix %*% coef - rhs)\n") print(drop(L %*% b - rhs)) cat("\n") } df <- Inf SSH <- as.vector(t(L %*% b - rhs) %*% solve(L %*% V %*% t(L)) %*% (L %*% b - rhs)) name <- try(formula(model), silent = TRUE) if (inherits(name, "try-error")) name <- substitute(model) title <- "Linear hypothesis test\n\nHypothesis:" topnote <- paste("Model 1: restricted model","\n", "Model 2: ", paste(deparse(name), collapse = "\n"), sep = "") note <- if (is.null(vcov.)) "" else "\nNote: Coefficient covariance matrix supplied.\n" rval <- matrix(rep(NA, 8), ncol = 4) colnames(rval) <- c("Res.Df", "Df", "Chisq", paste("Pr(>Chisq)", sep = "")) rownames(rval) <- 1:2 rval[,1] <- c(df+q, df) p <- pchisq(SSH, q, lower.tail = FALSE) rval[2, 2:4] <- c(q, SSH, p) rval <- rval[,-1] structure(as.data.frame(rval), heading = c(title, printHypothesis(L, rhs, names(b)), "", topnote, note), class = c("anova", "data.frame")) } ## for svyglm linearHypothesis.svyglm <- function(model, ...) linearHypothesis.default(model, ...) ## matchCoefs matchCoefs <- function(model, pattern, ...) UseMethod("matchCoefs") matchCoefs.default <- function(model, pattern, coef.=coef, ...){ names <- names(coef.(model)) grep(pattern, names, value=TRUE) } matchCoefs.mer <- function(model, pattern, ...) NextMethod(coef.=fixef) matchCoefs.merMod <- function(model, pattern, ...) NextMethod(coef.=fixef) matchCoefs.lme <- function(model, pattern, ...) NextMethod(coef.=fixef) matchCoefs.mlm <- function(model, pattern, ...){ names <- rownames(coef(model)) grep(pattern, names, value=TRUE) } car/R/regLine.R0000644000175100001440000000105711261463162012753 0ustar hornikusers# draw regression line from model to extremes of fit (J. Fox) # last modified 2 October 2009 by J. Fox regLine <- function(mod, col=palette()[2], lwd=2, lty=1, ...){ if(!is.null(class(mod$na.action)) && class(mod$na.action) == "exclude") class(mod$na.action) <-"omit" coef <- coefficients(mod) if (length(coef) != 2) stop("requires simple linear regression") x <- model.matrix(mod)[,2] y <- fitted.values(mod) min <- which.min(x) max <- which.max(x) lines(c(x[min], x[max]), c(y[min], y[max]), col=col, lty=lty, lwd=lwd, ...) } car/R/invResPlot.R0000644000175100001440000000234711757473476013521 0ustar hornikusers# Last modified 25 Nov 2009 for point marking # 18 January 2012 added robust estimation from Pendergast and Sheather inverseResponsePlot <- function(model, lambda=c(-1, 0, 1), robust=FALSE, xlab=NULL, ...) UseMethod("inverseResponsePlot") inverseResponsePlot.lm <- function(model, lambda=c(-1, 0, 1), xlab=NULL, labels = names(residuals(model)), ...) { mf <- model$model if (is.null(mf)) mf <- update(model, model=TRUE, method="model.frame") xlab <- if(is.null(xlab)) names(mf)[1] y <- mf[, 1] yhat <- predict(model) invTranPlot(y, yhat, lambda=lambda, xlab=xlab, labels=labels, ...) } invResPlot <- function(model, ...) UseMethod("inverseResponsePlot") ##########NEW inverseResponsePlot.lm <- function(model, lambda=c(-1, 0, 1), robust=FALSE, xlab=NULL, labels = names(residuals(model)), ...) { if(robust == TRUE){ m <- model$call m[[1L]] <- as.name("rlm") model <- eval(m, parent.frame()) } mf <- model$model if (is.null(mf)) mf <- update(model, model=TRUE, method="model.frame") xlab <- if(is.null(xlab)) names(mf)[1] y <- mf[, 1] yhat <- predict(model) invTranPlot(y, yhat, lambda=lambda, xlab=xlab, labels=labels, robust=robust, ...) }car/R/recode.R0000644000175100001440000000315712032107526012626 0ustar hornikusers# recode function (J. Fox) # last modified 2012-09-30 by J. Fox recode <- function(var, recodes, as.factor.result, as.numeric.result=TRUE, levels){ recodes <- gsub("\n|\t", " ", recodes) recode.list <- rev(strsplit(recodes, ";")[[1]]) is.fac <- is.factor(var) if (missing(as.factor.result)) as.factor.result <- is.fac if (is.fac) var <- as.character(var) result <- var if (is.numeric(var)) { lo <- min(var, na.rm=TRUE) hi <- max(var, na.rm=TRUE) } for (term in recode.list){ if (0 < length(grep(":", term))) { range <- strsplit(strsplit(term, "=")[[1]][1],":") low <- eval(parse(text=range[[1]][1])) high <- eval(parse(text=range[[1]][2])) target <- eval(parse(text=strsplit(term, "=")[[1]][2])) result[(var >= low) & (var <= high)] <- target } else if (0 < length(grep("^else=", squeezeBlanks(term)))) { target <- eval(parse(text=strsplit(term, "=")[[1]][2])) result[1:length(var)] <- target } else { set <- eval(parse(text=strsplit(term, "=")[[1]][1])) target <- eval(parse(text=strsplit(term, "=")[[1]][2])) for (val in set){ if (is.na(val)) result[is.na(var)] <- target else result[var == val] <- target } } } if (as.factor.result) { result <- if (!missing(levels)) factor(result, levels=levels) else as.factor(result) } else if (as.numeric.result && (!is.numeric(result))) { result.valid <- na.omit(result) opt <- options("warn"=-1) result.valid <- as.numeric(result.valid) options(opt) if (!any(is.na(result.valid))) result <- as.numeric(result) } result } Recode <- function (...) car::recode(...) car/R/densityPlot.R0000644000175100001440000000707612153775407013724 0ustar hornikusers# checked in 2013-06-05 by J. Fox densityPlot <- function(x, ...){ UseMethod("densityPlot") } densityPlot.default <- function (x, g, bw="SJ", adjust=1, kernel = c("gaussian", "epanechnikov", "rectangular", "triangular", "biweight", "cosine", "optcosine"), xlab=deparse(substitute(x)), ylab="Density", col=palette(), lty=seq_along(col), lwd=2, grid=TRUE, legend.location="topright", legend.title=deparse(substitute(g)), show.bw=FALSE, rug=TRUE, ...) { ylab if (!is.numeric(x)) stop("argument x must be numeric") kernel <- match.arg(kernel) if (missing(g)) { density <- density(x, bw=bw, adjust=adjust, kernel=kernel) if (show.bw) xlab <- paste(xlab, " (bandwidth = ", format(density$bw), ")", sep="") plot(density, xlab=xlab, ylab=ylab, main="", type="n", ...) if (rug) rug(x) if (grid) grid() lines(density, lwd=lwd) } else { if (!is.factor(g)) stop("argument g must be a factor") legend.title valid <- complete.cases(x, g) x <- x[valid] g <- g[valid] levels <- levels(g) if (length(bw) == 1) bw <- rep(bw, length(levels)) if (length(adjust) == 1) adjust <- rep(adjust, length(levels)) if (length(bw) != length(levels)) stop("number of entries in bw be 1 or must equal number of groups") if (length(adjust) != length(levels)) stop("number of entries in adjust must be 1 or must equal number of groups") densities <- vector(length(levels), mode="list") names(bw) <- names(adjust) <- names(densities) <- levels for (group in levels){ densities[[group]] <- density(x[g == group], bw=bw[group], adjust=adjust[group], kernel=kernel) } range.x <- range(unlist(lapply(densities, function(den) range(den$x)))) max.y <- max(sapply(densities, function(den) max(den$y))) plot(range.x, c(0, max.y), xlab=xlab, ylab=ylab, type="n", ...) if (grid) grid() for (i in 1:length(levels)){ lines(densities[[i]]$x, densities[[i]]$y, lty=lty[i], col=col[i], lwd=lwd) } if (show.bw){ bws <- sapply(densities, function(den) den$bw) legend <- paste(levels, " (bw = ", format(bws), ")", sep="") } else legend <- levels legend(legend.location, legend=legend, col=col[1:length(levels)], lty=lty, title=legend.title, inset=0.02) abline(h=0, col="gray") if (rug){ for (i in 1:length(levels)) rug(x[g == levels[i]], col=col[i]) } } return(invisible(NULL)) } densityPlot.formula <- function(formula, data=NULL, subset, na.action=NULL, xlab, ylab, ...){ m <- match.call(expand.dots = FALSE) if (is.matrix(eval(m$data, parent.frame()))) m$data <- as.data.frame(data) m$xlab <- m$ylab <- m$... <- NULL m$na.action <- na.action m[[1]] <- as.name("model.frame") mf <- eval(m, parent.frame()) if (missing(ylab)) ylab <- "Density" if (length(formula) == 3){ response <- attr(attr(mf, "terms"), "response") if (missing(xlab)) xlab <- names(mf)[response] g <- mf[, -response] densityPlot(mf[[response]], g, xlab=xlab, ylab=ylab, legend.title=names(mf)[-response], ...) } else if (length(formula) == 2){ if (missing(xlab)) xlab <- names(mf) densityPlot(mf[[1]], xlab=xlab, ylab=ylab, ...) } else stop("improper densityPlot formula") } car/R/carWeb.R0000644000175100001440000000205011500724660012562 0ustar hornikuserscarWeb <- function (page = c("webpage", "errata", "taskviews"), script, data) { data.page <- "http://socserv.socsci.mcmaster.ca/jfox/Books/Companion/data/" script.page <- "http://socserv.socsci.mcmaster.ca/jfox/Books/Companion/scripts/" page = match.arg(page) urls = c(webpage = "http://socserv.socsci.mcmaster.ca/jfox/Books/Companion/", errata = "http://socserv.socsci.mcmaster.ca/jfox/Books/Companion/errata.html", taskviews = "http://cran.r-project.org/web/views") url <- urls[page] if(!missing(data)) { dfile <- unlist(strsplit(data, ".", fixed=TRUE)) if(length(dfile) > 1) dfile <- dfile[1:(length(dfile)-1)] dfile <- paste(c(dfile, "txt"), collapse="." ) url <- paste(data.page, dfile, sep="")} if(!missing(script)) { sfile <- unlist(strsplit(script, ".", fixed=TRUE)) if(length(sfile) > 1) sfile <- sfile[1:(length(sfile)-1)] sfile <- paste(c(sfile, "R"), collapse="." ) url <- paste(script.page, sfile, sep="")} browseURL(url) }car/R/vif.R0000644000175100001440000000236411272331344012152 0ustar hornikusers#------------------------------------------------------------------------------- # Revision history: # 2009-09-28 by J. Fox #------------------------------------------------------------------------------- # Generalized Variance-Inflation Factors (Henric Nilsson and John Fox) vif<-function(mod, ...){ UseMethod("vif") } vif.lm <- function(mod, ...) { if (any(is.na(coef(mod)))) stop ("there are aliased coefficients in the model") v <- vcov(mod) assign <- attributes(model.matrix(mod))$assign if (names(coefficients(mod)[1]) == "(Intercept)") { v <- v[-1, -1] assign <- assign[-1] } else warning("No intercept: vifs may not be sensible.") terms <- labels(terms(mod)) n.terms <- length(terms) if (n.terms < 2) stop("model contains fewer than 2 terms") R <- cov2cor(v) detR <- det(R) result <- matrix(0, n.terms, 3) rownames(result) <- terms colnames(result) <- c("GVIF", "Df", "GVIF^(1/(2*Df))") for (term in 1:n.terms) { subs <- which(assign == term) result[term, 1] <- det(as.matrix(R[subs, subs])) * det(as.matrix(R[-subs, -subs])) / detR result[term, 2] <- length(subs) } if (all(result[, 2] == 1)) result <- result[, 1] else result[, 3] <- result[, 1]^(1/(2 * result[, 2])) result } car/R/boxCox.R0000644000175100001440000000561711377355111012640 0ustar hornikusersboxCox <- function(object,...) UseMethod("boxCox") boxCox.formula <- function (object, lambda = seq(-2, 2, 1/10), plotit = TRUE, interp = (plotit && (m < 100)), eps = 1/50, xlab = expression(lambda), ylab = "log-Likelihood",family="bcPower", ...) { m <- length(lambda) object <- lm(object, y = TRUE, qr = TRUE, ...) result <- NextMethod() if (plotit) invisible(result) else result } boxCox.lm <- function (object, lambda = seq(-2, 2, 1/10), plotit = TRUE, interp = (plotit && (m < 100)), eps = 1/50, xlab = expression(lambda), ylab = "log-Likelihood", family="bcPower", ...) { m <- length(lambda) if (is.null(object$y) || is.null(object$qr)) object <- update(object, y = TRUE, qr = TRUE, ...) result <- NextMethod() if (plotit) invisible(result) else result } boxCox.default <- function(object, lambda = seq(-2, 2, 1/10), plotit = TRUE, interp = (plotit && (m < 100)), eps = 1/50, xlab = expression(lambda), ylab = "log-Likelihood", family="bcPower", grid=TRUE, ...) { fam <- match.fun(family) if (is.null(object$y) || is.null(object$qr)) stop(paste(deparse(substitute(object)), "does not have both 'qr' and 'y' components")) y <- object$y n <- length(y) xqr <- object$qr xl <- loglik <- as.vector(lambda) m <- length(xl) for (i in 1L:m) { yt <- fam(y,xl[i],j=TRUE) loglik[i] <- -n/2 * log(sum(qr.resid(xqr, yt)^2)) } if (interp) { sp <- spline(xl, loglik, n = 100) xl <- sp$x loglik <- sp$y m <- length(xl) } if (plotit) { mx <- (1L:m)[loglik == max(loglik)][1L] Lmax <- loglik[mx] lim <- Lmax - qchisq(19/20, 1)/2 plot(xl, loglik, xlab = xlab, ylab = ylab, type = "n", ylim = range(loglik, lim)) if(grid){ grid(lty=1, equilogs=FALSE) box()} lines(xl, loglik) plims <- par("usr") abline(h = lim, lty = 2) y0 <- plims[3L] scal <- (1/10 * (plims[4L] - y0))/par("pin")[2L] scx <- (1/10 * (plims[2L] - plims[1L]))/par("pin")[1L] text(xl[1L] + scx, lim + scal, " 95%") la <- xl[mx] if (mx > 1 && mx < m) segments(la, y0, la, Lmax, lty = 2) ind <- range((1L:m)[loglik > lim]) if (loglik[1L] < lim) { i <- ind[1L] x <- xl[i - 1] + ((lim - loglik[i - 1]) * (xl[i] - xl[i - 1]))/(loglik[i] - loglik[i - 1]) segments(x, y0, x, lim, lty = 2) } if (loglik[m] < lim) { i <- ind[2L] + 1 x <- xl[i - 1] + ((lim - loglik[i - 1]) * (xl[i] - xl[i - 1]))/(loglik[i] - loglik[i - 1]) segments(x, y0, x, lim, lty = 2) } } list(x = xl, y = loglik) } car/R/boxCoxVariable.R0000644000175100001440000000060511272331344014272 0ustar hornikusers#------------------------------------------------------------------------------- # Revision history: # 2009-09-29 by J. Fox (renamed) #------------------------------------------------------------------------------- # constructed variable for Box-Cox transformation (J. Fox) boxCoxVariable <- function(y) { geo.mean <- exp(mean(log(y), na.rm=TRUE)) y*(log(y/geo.mean) - 1) } car/R/scatterplot.R0000644000175100001440000003010712105010710013711 0ustar hornikusers# fancy scatterplots (J. Fox) # 2010-09-05: J. Fox: changed color choice # 2010-09-16: fixed point color when col is length 1 # 2010-12-19: J. Fox: added argument legend.coords to place legend. # 2011-01-15: J. Fox: If x is a factor, calls Boxplot() # 2011-03-08: J. Fox: changed col argument # 2012-04-18: J. Fox: fixed labels argument in scatterplot.formula(). # 2012-04-24: J. Fox: further fix to labels # 2012-09-12: J. Fox: modified treatment of smoother; added loessLine(), gamLine(), quantregLine(). # 2012-09-17: S. Weisberg: smoothers moved to scatterplotSmoothers.R, defaults changed # 2012-09-19: J. Fox: restored smooth and span arguments for backwards compatibility # 2013-02-07: S. Weisberg: modifed call to showLabels to work correctly with groups reg <- function(reg.line, x, y, col, lwd, lty, log.x, log.y){ if(log.x) x <- log(x) if(log.y) y <- log(y) mod <- reg.line(y ~ x) y.hat <- fitted.values(mod) x <- model.matrix(mod)[, 2] min <- which.min(x) max <- which.max(x) if (!log.x){ x1 <- x[min] x2 <- x[max] } else { x1 <- exp(x[min]) x2 <- exp(x[max]) } if (!log.y){ y1 <- y.hat[min] y2 <- y.hat[max] } else { y1 <- exp(y.hat[min]) y2 <- exp(y.hat[max]) } lines(c(x1, x2), c(y1, y2), lwd=lwd, col=col, lty=lty) } scatterplot <- function(x, ...){ UseMethod("scatterplot", x) } scatterplot.formula <- function (formula, data, subset, xlab, ylab, legend.title, legend.coords, labels, ...) { na.save <- options(na.action=na.omit) on.exit(options(na.save)) na.pass <- function(dframe) dframe m <- match.call(expand.dots=FALSE) if (is.matrix(eval(m$data, sys.frame(sys.parent())))) m$data <- as.data.frame(data) m$na.action <- na.pass m$legend.coords <- m$legend.title <- m$labels <- m$xlab <- m$ylab <- m$... <- NULL m[[1]] <- as.name("model.frame") if (!inherits(formula, "formula") | length(formula) != 3) stop("invalid formula") formula <- as.character(c(formula)) formula <- as.formula(sub("\\|", "+", formula)) m$formula <- formula if (missing(data)){ X <- na.omit(eval(m, parent.frame())) if (missing(labels)) labels <- gsub("X", "", row.names(X)) } else{ X <- eval(m, parent.frame()) if (missing(labels)) labels <- row.names(X) } names <- names(X) if (missing(xlab)) xlab <- names[2] if (missing(ylab)) ylab <- names[1] if (ncol(X) == 2) scatterplot(X[,2], X[,1], xlab=xlab, ylab=ylab, labels=labels, ...) else { if (missing(legend.title)) legend.title <- names[3] scatterplot(X[,2], X[,1], groups=X[,3], xlab=xlab, ylab=ylab, legend.title=legend.title, legend.coords=legend.coords, labels=labels, ...) } } scatterplot.default <- function(x, y, smoother=loessLine, smoother.args=list(), smooth, span, spread=!by.groups, reg.line=lm, boxplots=if (by.groups) "" else "xy", xlab=deparse(substitute(x)), ylab=deparse(substitute(y)), las=par("las"), lwd=1, lty=1, labels, id.method = "mahal", id.n = if(id.method[1]=="identify") length(x) else 0, id.cex = 1, id.col = palette()[1], log="", jitter=list(), xlim=NULL, ylim=NULL, cex=par("cex"), cex.axis=par("cex.axis"), cex.lab=par("cex.lab"), cex.main=par("cex.main"), cex.sub=par("cex.sub"), groups, by.groups=!missing(groups), legend.title=deparse(substitute(groups)), legend.coords, ellipse=FALSE, levels=c(.5, .95), robust=TRUE, col=if (n.groups == 1) palette()[3:1] else rep(palette(), length=n.groups), pch=1:n.groups, legend.plot=!missing(groups), reset.par=TRUE, grid=TRUE, ...){ logged <- function(axis=c("x", "y")){ axis <- match.arg(axis) 0 != length(grep(axis, log)) } hbox <- function(x){ if (logged("x")){ log.x <- "x" .x <- log(x) } else { log.x <- "" .x <- x } plot(x, seq(0, 1, length=length(x)), type="n", axes=FALSE, xlab="", ylab="", log=log.x, xlim=xlim) res <- boxplot.stats(.x, coef = 1.5, do.conf=FALSE) if (logged("x")){ res$stats <- exp(res$stats) if (!is.null(res$out)) res$out <- exp(res$out) } LW <- res$stats[1] Q1 <- res$stats[2] M <- res$stats[3] Q3 <- res$stats[4] UW <- res$stats[5] lines(c(Q1, Q1, Q3, Q3, Q1), c(0, 1, 1, 0, 0)) lines(c(M, M), c(0, 1)) lines(c(LW, Q1), c(.5, .5)) lines(c(Q3, UW), c(.5, .5)) if (!is.null(res$out)) points(res$out, rep(.5, length(res$out)), cex=cex) } vbox <- function(y){ if (logged("y")){ log.y <- "y" .y <- log(y) } else { log.y <- "" .y <- y } plot(seq(0, 1, length=length(y)), y, type="n", axes=FALSE, xlab="", ylab="", log=log.y, ylim=ylim) res <- boxplot.stats(.y, coef = 1.5, do.conf=FALSE) if (logged("y")){ res$stats <- exp(res$stats) if (!is.null(res$out)) res$out <- exp(res$out) } LW <- res$stats[1] Q1 <- res$stats[2] M <- res$stats[3] Q3 <- res$stats[4] UW <- res$stats[5] lines(c(0, 1, 1, 0, 0), c(Q1, Q1, Q3, Q3, Q1)) lines(c(0, 1), c(M, M)) lines(c(.5, .5), c(LW, Q1)) lines(c(.5, .5), c(Q3, UW)) if (!is.null(res$out)) points(rep(.5, length(res$out)), res$out, cex=cex) } # force evaluation of some arguments by.groups legend.plot legend.title # smooth and span for backwards compatibility if (!missing(smooth)) { smoother <- if (isTRUE(smooth)) loessLine else FALSE } if (!missing(span)) smoother.args$span <- span if (is.character(family)) family <- eval(parse(text=family)) if (missing(labels)){ labels <- if (is.null(names(y))) seq(along=y) else names(y) } if (length(labels) != length(y)) stop("labels argument is the wrong length") if (is.factor(x)) { if (!(id.method %in% c("y", "identify", "none"))) id.method <- "y" return(Boxplot(y, x, id.method="y", labels=labels, xlab=xlab, ylab=ylab)) } mar <- par("mar") mfcol <- par("mfcol") if (reset.par) on.exit(par(mar=mar, mfcol=mfcol)) if( FALSE == boxplots) boxplots <- "" if (!missing(groups)){ data <- na.omit(data.frame(groups, x, y, labels, stringsAsFactors=FALSE)) groups <- data[,1] if (!is.factor(groups)) groups <- as.factor(groups) .x <- data[,2] .y <- data[,3] labels <- data[,4] top <- if (legend.plot && missing(legend.coords)) 4 + nlevels(groups) else mar[3] } else { .x <- x .y <- y top <- mar[3] groups <- factor(rep(1, length(.x))) } xbox <- length(grep("x", boxplots)) > 0 ybox <- length(grep("y", boxplots)) > 0 if (xbox && ybox) layout(matrix(c(1, 0, 3, 2), 2, 2), widths = c(5, 95), heights= c(95, 5)) else if (ybox) layout(matrix(c(1, 2),1, 2), widths = c(5, 95), heights= 100) else if (xbox) layout(matrix(c(2, 1), 2, 1), widths = 100, heights= c(95, 5)) else layout (matrix(1, 1, 1), widths=100, heights=100) par(mar=c(mar[1], 0, top, 0)) if (ybox > 0) vbox(.y) par(mar=c(0, mar[2], 0, mar[4])) if (xbox > 0) hbox(.x) par(mar=c(mar[1:2], top, mar[4])) plot(.x, .y, xlab=xlab, ylab=ylab, las=las, log=log, cex=cex, cex.axis=cex.axis, cex.lab=cex.lab, cex.main=cex.main, cex.sub=cex.sub, type="n", xlim=xlim, ylim=ylim, ...) if(grid){ grid(lty=1, equilogs=FALSE) box()} n.groups <- length(levels(groups)) if (n.groups > length(col)) stop("number of groups exceeds number of available colors") if (length(col) == 1) col <- rep(col, 3) indices <- NULL range.x <- if (logged("x")) range(log(.x), na.rm=TRUE) else range(.x, na.rm=TRUE) for (i in 1:n.groups){ subs <- groups == levels(groups)[i] points(if (is.null(jitter$x) || jitter$x == 0) .x[subs] else jitter(.x[subs], factor=jitter$x), if (is.null(jitter$y) || jitter$y == 0) .y[subs] else jitter(.y[subs], factor=jitter$y), pch=pch[i], col=col[if (n.groups == 1) 3 else i], cex=cex) if (by.groups){ if (is.function(smoother)) smoother(.x[subs], .y[subs], col=col[i], log.x=logged("x"), log.y=logged("y"), spread=spread, smoother.args=smoother.args) if (is.function(reg.line)) reg(reg.line, .x[subs], .y[subs], lty=lty, lwd=lwd, log.x=logged("x"), log.y=logged("y"), col=col[i]) if (ellipse) { X <- na.omit(data.frame(x=.x[subs], y=.y[subs])) if (logged("x")) X$x <- log(x) if (logged("y")) X$y <- log(y) with(X, dataEllipse(x, y, plot.points=FALSE, lwd=1, log=log, levels=levels, col=col[i], robust=robust)) } if (id.method[1] != "identify") indices <- c(indices, showLabels(.x[subs], .y[subs], labels=labels[subs], id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=col[i], all=list(labels=labels, subs=subs))) # if (id.method[1] != "identify") indices <- c(indices, # showLabels(.x[subs], .y[subs], labels=labels[subs], id.method=id.method, # id.n=id.n, id.cex=id.cex, id.col=col[i])) }} if (!by.groups){ if (is.function(smoother)) smoother(.x, .y, col=col[2], log.x=logged("x"), log.y=logged("y"), spread, smoother.args=smoother.args) if (is.function(reg.line)) reg(reg.line, .x, .y, lty=lty, lwd=lwd, log.x=logged("x"), log.y=logged("y"), col=col[1]) if (ellipse) { X <- na.omit(data.frame(x=.x, y=.y)) if (logged("x")) X$x <- log(X$x) if (logged("y")) X$y <- log(X$y) with(X, dataEllipse(x, y, plot.points=FALSE, lwd=1, log=log, levels=levels, col=col[1], robust=robust)) } if (id.method[1] != "identify") indices <- showLabels( .x, .y, labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col) } if (legend.plot) { xpd <- par(xpd=TRUE) on.exit(par(xpd=xpd), add=TRUE) usr <- par("usr") if (missing(legend.coords)){ legend.x <- if (logged("x")) 10^(usr[1]) else usr[1] legend.y <- if (logged("y")) 10^(usr[4] + 1.2*top*strheight("x")) else usr[4] + 1.2*top*strheight("x") legend.coords <- list(x=legend.x, y=legend.y) } legend(legend.coords, legend=levels(groups), pch=pch, col=col[1:n.groups], pt.cex=cex, cex=cex.lab, title=legend.title, bg="white") } if (id.method[1] == "identify") indices <- showLabels(.x, .y, labels, id.method=id.method, id.n=length(.x), id.cex=id.cex, id.col=id.col) if (is.null(indices)) invisible(indices) else if (is.numeric(indices)) sort(indices) else indices } sp <- function(...) scatterplot(...) car/R/Anova.R0000644000175100001440000017300712204420315012426 0ustar hornikusers#------------------------------------------------------------------------------- # Revision history: # 2009-01-05: bug fix in Anova.II.lm(). J. Fox # 2009-01-16: Cox models with clusters now handled. J. Fox # 2009-09-16: reworked glm and lm methods to handle aliased parameters. J. Fox # 2009-09-30: renamed "Anova" to "Analysis of Deviance" in output for some methods. J. Fox # 2009-12-22: modified Anova.mlm() to handle a user-supplied within-subject model matrix. J. Fox # 2009-12-28: named the components of P in Anova.III.mlm(). John # 2010-01-01: Anova.II.mlm() now hands off (again) to Anova.III.mlm() when there # is only an intercept in the between-subjects model # 2010-02-17: Fixed bug that caused some models with aliased coefficients to fail. J. Fox # 2010-06-14: added wcrossprod and allow use of observation weights in Anova.mlm() # 2010-06-28: Fixed Anova() tables for coxph and survreg models # (failed because of changes in survival package. # 2011-01-21: Added functions for mixed models. J. Fox # 2011-01-25: Fixed Anova.polr() and Anova.multinom() to work with models with only one term. J. Fox # 2011-05-19: local fixef() to avoid nlme/lme4 issues. J. Fox # 2011-05-11: changed order of columns in ANOVA tables for mixed models. J. Fox # 2011-11-27: added Anova.svyglm(). J. Fox # 2011-12-31: fixed bug in Anova.II(and III).F.glm() when na.exclude used. J. Fox # 2012-02-28: added test.statistic argument to Anova.mer(). J.Fox # 2012-03-02: fixed test abbreviation of test.statistic argument to Anova.default() # called by other Anova() methods. J. Fox # 2013-06-17: modified summary.Anova.mlm(), introduced print.summary.Anova.mlm(), # adapting code contributed by Gabriel Baud-Bovy. J. Fox # 2013-06-20: added Anova.merMod() method. J. Fox # 2013-06-22: tweaks to local fixef(). J. Fox # 2013-06-22: test argument uniformly uses "Chisq" rather than "chisq". J. Fox # 2013-08-19: replaced calls to print.anova(). J. Fox #------------------------------------------------------------------------------- # Type II and III tests for linear, generalized linear, and other models (J. Fox) ConjComp <- function(X, Z = diag( nrow(X)), ip = diag(nrow(X))) { # This function by Georges Monette # finds the conjugate complement of the proj of X in span(Z) wrt # inner product ip # - assumes Z is of full column rank # - projects X conjugately wrt ip into span Z xq <- qr(t(Z) %*% ip %*% X) if (xq$rank == 0) return(Z) Z %*% qr.Q(xq, complete = TRUE) [ ,-(1:xq$rank)] } relatives <- function(term, names, factors){ is.relative <- function(term1, term2) { all(!(factors[,term1]&(!factors[,term2]))) } if(length(names) == 1) return(NULL) which.term <- which(term==names) (1:length(names))[-which.term][sapply(names[-which.term], function(term2) is.relative(term, term2))] } Anova <- function(mod, ...){ UseMethod("Anova", mod) } # linear models Anova.lm <- function(mod, error, type=c("II","III", 2, 3), white.adjust=c(FALSE, TRUE, "hc3", "hc0", "hc1", "hc2", "hc4"), singular.ok, ...){ type <- as.character(type) white.adjust <- as.character(white.adjust) type <- match.arg(type) white.adjust <- match.arg(white.adjust) if (missing(singular.ok)){ singular.ok <- type == "2" || type == "II" } if (has.intercept(mod) && length(coef(mod)) == 1 && (type == "2" || type == "II")) { type <- "III" warning("the model contains only an intercept: Type III test substituted") } if (white.adjust != "FALSE"){ if (white.adjust == "TRUE") white.adjust <- "hc3" return(Anova.default(mod, type=type, vcov.=hccm(mod, type=white.adjust), test.statistic="F", singular.ok=singular.ok)) } switch(type, II=Anova.II.lm(mod, error, singular.ok=singular.ok, ...), III=Anova.III.lm(mod, error, singular.ok=singular.ok, ...), "2"=Anova.II.lm(mod, error, singular.ok=singular.ok, ...), "3"=Anova.III.lm(mod, error, singular.ok=singular.ok,...)) } Anova.aov <- function(mod, ...){ class(mod) <- "lm" Anova.lm(mod, ...) } Anova.II.lm <- function(mod, error, singular.ok=TRUE, ...){ if (!missing(error)){ sumry <- summary(error, corr=FALSE) s2 <- sumry$sigma^2 error.df <- error$df.residual error.SS <- s2*error.df } SS.term <- function(term){ which.term <- which(term == names) subs.term <- which(assign == which.term) relatives <- relatives(term, names, fac) subs.relatives <- NULL for (relative in relatives) subs.relatives <- c(subs.relatives, which(assign == relative)) hyp.matrix.1 <- I.p[subs.relatives,,drop=FALSE] hyp.matrix.1 <- hyp.matrix.1[, not.aliased, drop=FALSE] hyp.matrix.2 <- I.p[c(subs.relatives,subs.term),,drop=FALSE] hyp.matrix.2 <- hyp.matrix.2[, not.aliased, drop=FALSE] hyp.matrix.term <- if (nrow(hyp.matrix.1) == 0) hyp.matrix.2 else t(ConjComp(t(hyp.matrix.1), t(hyp.matrix.2), vcov(mod))) hyp.matrix.term <- hyp.matrix.term[!apply(hyp.matrix.term, 1, function(x) all(x == 0)), , drop=FALSE] if (nrow(hyp.matrix.term) == 0) return(c(SS=NA, df=0)) lh <- linearHypothesis(mod, hyp.matrix.term, singular.ok=singular.ok, ...) abs(c(SS=lh$"Sum of Sq"[2], df=lh$Df[2])) } not.aliased <- !is.na(coef(mod)) if (!singular.ok && !all(not.aliased)) stop("there are aliased coefficients in the model") fac <- attr(mod$terms, "factors") intercept <- has.intercept(mod) I.p <- diag(length(coefficients(mod))) assign <- mod$assign assign[!not.aliased] <- NA names <- term.names(mod) if (intercept) names <-names[-1] n.terms <- length(names) p <- df <- f <- SS <- rep(0, n.terms + 1) sumry <- summary(mod, corr = FALSE) SS[n.terms + 1] <- if (missing(error)) sumry$sigma^2*mod$df.residual else error.SS df[n.terms + 1] <- if (missing(error)) mod$df.residual else error.df p[n.terms + 1] <- f[n.terms + 1] <- NA for (i in 1:n.terms){ ss <- SS.term(names[i]) SS[i] <- ss["SS"] df[i] <- ss["df"] f[i] <- df[n.terms+1]*SS[i]/(df[i]*SS[n.terms + 1]) p[i] <- pf(f[i], df[i], df[n.terms + 1], lower.tail = FALSE) } result <- data.frame(SS, df, f, p) row.names(result) <- c(names,"Residuals") names(result) <- c("Sum Sq", "Df", "F value", "Pr(>F)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- c("Anova Table (Type II tests)\n", paste("Response:", responseName(mod))) result } # type III Anova.III.lm <- function(mod, error, singular.ok=FALSE, ...){ if (!missing(error)){ error.df <- df.residual(error) error.SS <- deviance(error) } else { error.df <- df.residual(mod) error.SS <- deviance(mod) } intercept <- has.intercept(mod) I.p <- diag(length(coefficients(mod))) Source <- term.names(mod) n.terms <- length(Source) p <- df <- f <- SS <- rep(0, n.terms + 1) assign <- mod$assign not.aliased <- !is.na(coef(mod)) if (!singular.ok && !all(not.aliased)) stop("there are aliased coefficients in the model") for (term in 1:n.terms){ subs <- which(assign == term - intercept) hyp.matrix <- I.p[subs,,drop=FALSE] hyp.matrix <- hyp.matrix[, not.aliased, drop=FALSE] hyp.matrix <- hyp.matrix[!apply(hyp.matrix, 1, function(x) all(x == 0)), , drop=FALSE] if (nrow(hyp.matrix) == 0){ SS[term] <- NA df[term] <- 0 f[term] <- NA p[term] <- NA } else { test <- if (missing(error)) linearHypothesis(mod, hyp.matrix, singular.ok=singular.ok, ...) else linearHypothesis(mod, hyp.matrix, error.SS=error.SS, error.df=error.df, singular.ok=singular.ok, ...) SS[term] <- test$"Sum of Sq"[2] df[term] <- test$"Df"[2] f[term] <- test$"F"[2] p[term] <- test$"Pr(>F)"[2] } } Source[n.terms + 1] <- "Residuals" SS[n.terms + 1] <- error.SS df[n.terms + 1] <- error.df p[n.terms + 1] <- f[n.terms + 1] <- NA result <- data.frame(SS, df, f, p) row.names(result) <- Source names(result) <- c("Sum Sq", "Df", "F value", "Pr(>F)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- c("Anova Table (Type III tests)\n", paste("Response:", responseName(mod))) result } # generalized linear models Anova.glm <- function(mod, type=c("II","III", 2, 3), test.statistic=c("LR", "Wald", "F"), error, error.estimate=c("pearson", "dispersion", "deviance"), singular.ok, ...){ type <- as.character(type) type <- match.arg(type) if (has.intercept(mod) && length(coef(mod)) == 1 && (type == "2" || type == "II")) { type <- "III" warning("the model contains only an intercept: Type III test substituted") } if (missing(singular.ok)){ singular.ok <- type == "2" || type == "II" } test.statistic <- match.arg(test.statistic) error.estimate <- match.arg(error.estimate) switch(type, II=switch(test.statistic, LR=Anova.II.LR.glm(mod, singular.ok=singular.ok), Wald=Anova.default(mod, type="II", singular.ok=singular.ok), F=Anova.II.F.glm(mod, error, error.estimate, singular.ok=singular.ok)), III=switch(test.statistic, LR=Anova.III.LR.glm(mod, singular.ok=singular.ok), Wald=Anova.default(mod, type="III", singular.ok=singular.ok), F=Anova.III.F.glm(mod, error, error.estimate, singular.ok=singular.ok)), "2"=switch(test.statistic, LR=Anova.II.LR.glm(mod, singular.ok=singular.ok), Wald=Anova.default(mod, type="II", singular.ok=singular.ok), F=Anova.II.F.glm(mod, error, error.estimate, singular.ok=singular.ok)), "3"=switch(test.statistic, LR=Anova.III.LR.glm(mod, singular.ok=singular.ok), Wald=Anova.default(mod, type="III", singular.ok=singular.ok), F=Anova.III.F.glm(mod, error, error.estimate, singular.ok=singular.ok))) } # type III # LR test Anova.III.LR.glm <- function(mod, singular.ok=FALSE, ...){ if (!singular.ok && any(is.na(coef(mod)))) stop("there are aliased coefficients in the model") Source <- if (has.intercept(mod)) term.names(mod)[-1] else term.names(mod) n.terms <- length(Source) p <- df <- LR <- rep(0, n.terms) dispersion <- summary(mod, corr = FALSE)$dispersion deviance <- deviance(mod)/dispersion for (term in 1:n.terms){ mod.1 <- drop1(mod, scope=eval(parse(text=paste("~",Source[term])))) LR[term] <- (mod.1$Deviance[2]/dispersion)-deviance df[term] <- mod.1$Df[2] p[term] <- pchisq(LR[term], df[term], lower.tail = FALSE) } result <- data.frame(LR, df, p) row.names(result) <- Source names(result) <- c("LR Chisq", "Df", "Pr(>Chisq)") class(result) <- c("anova","data.frame") attr(result, "heading") <- c("Analysis of Deviance Table (Type III tests)\n", paste("Response:", responseName(mod))) result } # F test Anova.III.F.glm <- function(mod, error, error.estimate, singular.ok=FALSE, ...){ if (!singular.ok && any(is.na(coef(mod)))) stop("there are aliased coefficients in the model") fam <- family(mod)$family if (fam == "binomial" || fam == "poisson") warning("dispersion parameter estimated from the Pearson residuals, not taken as 1") if (missing(error)) error <- mod df.res <- df.residual(error) error.SS <- switch(error.estimate, pearson=sum(residuals(error, "pearson")^2, na.rm=TRUE), dispersion=df.res*summary(error, corr = FALSE)$dispersion, deviance=deviance(error)) Source <- if (has.intercept(mod)) term.names(mod)[-1] else term.names(mod) n.terms <- length(Source) p <- df <- f <- SS <-rep(0, n.terms+1) f[n.terms+1] <- p[n.terms+1] <- NA df[n.terms+1] <- df.res SS[n.terms+1] <- error.SS dispersion <- error.SS/df.res deviance <- deviance(mod) for (term in 1:n.terms){ mod.1 <- drop1(mod, scope=eval(parse(text=paste("~",Source[term])))) df[term] <- mod.1$Df[2] SS[term] <- mod.1$Deviance[2] - deviance f[term] <- (SS[term]/df[term])/dispersion p[term] <- pf(f[term], df[term], df.res, lower.tail = FALSE) } result <- data.frame(SS, df, f, p) row.names(result) <- c(Source, "Residuals") names(result) <- c("SS", "Df", "F", "Pr(>F)") class(result) <- c("anova","data.frame") attr(result, "heading") <- c("Analysis of Deviance Table (Type III tests)\n", paste("Response:", responseName(mod))) result } # type II # LR test Anova.II.LR.glm <- function(mod, singular.ok=TRUE, ...){ if (!singular.ok && any(is.na(coef(mod)))) stop("there are aliased coefficients in the model") # (some code adapted from drop1.glm) which.nms <- function(name) which(asgn == which(names == name)) fac <- attr(mod$terms, "factors") names <- if (has.intercept(mod)) term.names(mod)[-1] else term.names(mod) n.terms <- length(names) X <- model.matrix(mod) y <- mod$y if (is.null(y)) y <- model.response(model.frame(mod), "numeric") wt <- mod$prior.weights if (is.null(wt)) wt <- rep(1, length(y)) asgn <- attr(X, 'assign') df <- p <- LR <- rep(0, n.terms) dispersion <- summary(mod, corr = FALSE)$dispersion for (term in 1:n.terms){ rels <- names[relatives(names[term], names, fac)] exclude.1 <- as.vector(unlist(sapply(c(names[term], rels), which.nms))) mod.1 <- glm.fit(X[, -exclude.1, drop = FALSE], y, wt, offset = mod$offset, family = mod$family, control = mod$control) dev.1 <- deviance(mod.1) mod.2 <- if (length(rels) == 0) mod else { exclude.2 <- as.vector(unlist(sapply(rels, which.nms))) glm.fit(X[, -exclude.2, drop = FALSE], y, wt, offset = mod$offset, family = mod$family, control = mod$control) } dev.2 <- deviance(mod.2) df[term] <- df.residual(mod.1) - df.residual(mod.2) if (df[term] == 0) LR[term] <- p[term] <- NA else { LR[term] <- (dev.1 - dev.2)/dispersion p[term] <- pchisq(LR[term], df[term], lower.tail=FALSE) } } result <- data.frame(LR, df, p) row.names(result) <- names names(result) <- c("LR Chisq", "Df", "Pr(>Chisq)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- c("Analysis of Deviance Table (Type II tests)\n", paste("Response:", responseName(mod))) result } # F test Anova.II.F.glm <- function(mod, error, error.estimate, singular.ok=TRUE, ...){ # (some code adapted from drop1.glm) if (!singular.ok && any(is.na(coef(mod)))) stop("there are aliased coefficients in the model") fam <- family(mod)$family if (fam == "binomial" || fam == "poisson") warning("dispersion parameter estimated from the Pearson residuals, not taken as 1") which.nms <- function(name) which(asgn == which(names == name)) if (missing(error)) error <- mod df.res <- df.residual(error) error.SS <- switch(error.estimate, pearson = sum(residuals(error, "pearson")^2, na.rm=TRUE), dispersion = df.res*summary(error, corr = FALSE)$dispersion, deviance = deviance(error)) fac <- attr(mod$terms, "factors") names <- if (has.intercept(mod)) term.names(mod)[-1] else term.names(mod) n.terms <- length(names) X <- model.matrix(mod) y <- mod$y if (is.null(y)) y <- model.response(model.frame(mod), "numeric") wt <- mod$prior.weights if (is.null(wt)) wt <- rep(1, length(y)) asgn <- attr(X, 'assign') p <- df <- f <- SS <- rep(0, n.terms+1) f[n.terms+1] <- p[n.terms+1] <- NA df[n.terms+1] <- df.res SS[n.terms+1] <- error.SS dispersion <- error.SS/df.res for (term in 1:n.terms){ rels <- names[relatives(names[term], names, fac)] exclude.1 <- as.vector(unlist(sapply(c(names[term], rels), which.nms))) mod.1 <- glm.fit(X[, -exclude.1, drop = FALSE], y, wt, offset = mod$offset, family = mod$family, control = mod$control) dev.1 <- deviance(mod.1) mod.2 <- if (length(rels) == 0) mod else { exclude.2 <- as.vector(unlist(sapply(rels, which.nms))) glm.fit(X[, -exclude.2, drop = FALSE], y, wt, offset = mod$offset, family = mod$family, control = mod$control) } dev.2 <- deviance(mod.2) df[term] <- df.residual(mod.1) - df.residual(mod.2) if (df[term] == 0) SS[term] <- f[term] <- p[term] <- NA else { SS[term] <- dev.1 - dev.2 f[term] <- SS[term]/(dispersion*df[term]) p[term] <- pf(f[term], df[term], df.res, lower.tail=FALSE) } } result <- data.frame(SS, df, f, p) row.names(result) <- c(names, "Residuals") names(result) <- c("SS", "Df", "F", "Pr(>F)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- c("Analysis of Deviance Table (Type II tests)\n", paste("Response:", responseName(mod))) result } # multinomial logit models (via multinom in the nnet package) Anova.multinom <- function (mod, type = c("II", "III", 2, 3), ...) { type <- as.character(type) type <- match.arg(type) if (has.intercept(mod) && length(coef(mod)) == 1 && (type == "2" || type == "II")) { type <- "III" warning("the model contains only an intercept: Type III test substituted") } switch(type, II = Anova.II.multinom(mod, ...), III = Anova.III.multinom(mod, ...), "2" = Anova.II.multinom(mod, ...), "3" = Anova.III.multinom(mod, ...)) } Anova.II.multinom <- function (mod, ...) { which.nms <- function(name) which(asgn == which(names == name)) fac <- attr(mod$terms, "factors") names <- if (has.intercept(mod)) term.names(mod)[-1] else term.names(mod) n.terms <- length(names) X <- model.matrix(mod) y <- model.response(model.frame(mod)) wt <- mod$weights asgn <- attr(X, "assign") p <- LR <- rep(0, n.terms) df <- df.terms(mod) for (term in 1:n.terms) { rels <- names[relatives(names[term], names, fac)] exclude.1 <- as.vector(unlist(sapply(c(names[term], rels), which.nms))) mod.1 <-if (n.terms > 1) multinom(y ~ X[, -c(1, exclude.1)], weights=wt, trace=FALSE) else multinom(y ~ 1, weights=wt, race=FALSE) dev.1 <- deviance(mod.1) mod.2 <- if (length(rels) == 0) mod else { exclude.2 <- as.vector(unlist(sapply(rels, which.nms))) multinom(y ~ X[, -c(1, exclude.2)], weights=wt, trace=FALSE) } dev.2 <- deviance(mod.2) LR[term] <- dev.1 - dev.2 p[term] <- pchisq(LR[term], df[term], lower.tail=FALSE) } result <- data.frame(LR, df, p) row.names(result) <- names names(result) <- c("LR Chisq", "Df", "Pr(>Chisq)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- c("Analysis of Deviance Table (Type II tests)\n", paste("Response:", responseName(mod))) result } Anova.III.multinom <- function (mod, ...) { names <- if (has.intercept(mod)) term.names(mod)[-1] else term.names(mod) n.terms <- length(names) X <- model.matrix(mod) y <- model.response(model.frame(mod)) wt <- mod$weights asgn <- attr(X, "assign") p <- LR <- rep(0, n.terms) df <- df.terms(mod) deviance <- deviance(mod) for (term in 1:n.terms) { mod.1 <- if (n.terms > 1) multinom(y ~ X[, term != asgn][, -1], weights=wt, trace=FALSE) else multinom(y ~ 1, weights=wt, trace=FALSE) LR[term] <- deviance(mod.1) - deviance p[term] <- pchisq(LR[term], df[term], lower.tail=FALSE) } result <- data.frame(LR, df, p) row.names(result) <- names names(result) <- c("LR Chisq", "Df", "Pr(>Chisq)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- c("Analysis of Deviance Table (Type III tests)\n", paste("Response:", responseName(mod))) result } # proportional-odds logit models (via polr in the MASS package) Anova.polr <- function (mod, type = c("II", "III", 2, 3), ...) { type <- as.character(type) type <- match.arg(type) if (has.intercept(mod) && length(coef(mod)) == 1 && (type == "2" || type == "II")) { type <- "III" warning("the model contains only an intercept: Type III test substituted") } switch(type, II = Anova.II.polr(mod, ...), III = Anova.III.polr(mod, ...), "2" = Anova.II.polr(mod, ...), "3" = Anova.III.polr(mod, ...)) } Anova.II.polr <- function (mod, ...) { which.nms <- function(name) which(asgn == which(names == name)) fac <- attr(mod$terms, "factors") names <- term.names(mod) n.terms <- length(names) X <- model.matrix(mod) y <- model.response(model.frame(mod)) wt <- model.weights(model.frame(mod)) asgn <- attr(X, "assign") p <- LR <- rep(0, n.terms) df <- df.terms(mod) for (term in 1:n.terms) { rels <- names[relatives(names[term], names, fac)] exclude.1 <- as.vector(unlist(sapply(c(names[term], rels), which.nms))) mod.1 <- if (n.terms > 1) polr(y ~ X[, -c(1, exclude.1)], weights=wt) else polr(y ~ 1, weights=wt) dev.1 <- deviance(mod.1) mod.2 <- if (length(rels) == 0) mod else { exclude.2 <- as.vector(unlist(sapply(rels, which.nms))) polr(y ~ X[, -c(1, exclude.2)], weights=wt) } dev.2 <- deviance(mod.2) LR[term] <- dev.1 - dev.2 p[term] <- pchisq(LR[term], df[term], lower.tail=FALSE) } result <- data.frame(LR, df, p) row.names(result) <- names names(result) <- c("LR Chisq", "Df", "Pr(>Chisq)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- c("Analysis of Deviance Table (Type II tests)\n", paste("Response:", responseName(mod))) result } Anova.III.polr <- function (mod, ...) { names <- term.names(mod) n.terms <- length(names) X <- model.matrix(mod) y <- model.response(model.frame(mod)) wt <- model.weights(model.frame(mod)) asgn <- attr(X, "assign") p <- LR <- rep(0, n.terms) df <- df.terms(mod) deviance <- deviance(mod) for (term in 1:n.terms) { mod.1 <- if (n.terms > 1) polr(y ~ X[, term != asgn][, -1], weights=wt) else polr(y ~ 1, weights=wt) LR[term] <- deviance(mod.1) - deviance p[term] <- pchisq(LR[term], df[term], lower.tail=FALSE) } result <- data.frame(LR, df, p) row.names(result) <- names names(result) <- c("LR Chisq", "Df", "Pr(>Chisq)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- c("Analysis of Deviance Table (Type III tests)\n", paste("Response:", responseName(mod))) result } # multivariate linear models # the following 3 functions copied from the stats package (not exported from stats) Pillai <- function (eig, q, df.res) { test <- sum(eig/(1 + eig)) p <- length(eig) s <- min(p, q) n <- 0.5 * (df.res - p - 1) m <- 0.5 * (abs(p - q) - 1) tmp1 <- 2 * m + s + 1 tmp2 <- 2 * n + s + 1 c(test, (tmp2/tmp1 * test)/(s - test), s * tmp1, s * tmp2) } Wilks <- function (eig, q, df.res) { test <- prod(1/(1 + eig)) p <- length(eig) tmp1 <- df.res - 0.5 * (p - q + 1) tmp2 <- (p * q - 2)/4 tmp3 <- p^2 + q^2 - 5 tmp3 <- if (tmp3 > 0) sqrt(((p * q)^2 - 4)/tmp3) else 1 c(test, ((test^(-1/tmp3) - 1) * (tmp1 * tmp3 - 2 * tmp2))/p/q, p * q, tmp1 * tmp3 - 2 * tmp2) } HL <- function (eig, q, df.res) { test <- sum(eig) p <- length(eig) m <- 0.5 * (abs(p - q) - 1) n <- 0.5 * (df.res - p - 1) s <- min(p, q) tmp1 <- 2 * m + s + 1 tmp2 <- 2 * (s * n + 1) c(test, (tmp2 * test)/s/s/tmp1, s * tmp1, tmp2) } Roy <- function (eig, q, df.res) { p <- length(eig) test <- max(eig) tmp1 <- max(p, q) tmp2 <- df.res - tmp1 + q c(test, (tmp2 * test)/tmp1, tmp1, tmp2) } has.intercept.mlm <- function (model, ...) any(row.names(coefficients(model)) == "(Intercept)") Anova.mlm <- function(mod, type=c("II","III", 2, 3), SSPE, error.df, idata, idesign, icontrasts=c("contr.sum", "contr.poly"), imatrix, test.statistic=c("Pillai", "Wilks", "Hotelling-Lawley", "Roy"),...){ wts <- if (!is.null(mod$weights)) mod$weights else rep(1, nrow(model.matrix(mod))) type <- as.character(type) type <- match.arg(type) test.statistic <- match.arg(test.statistic) if (missing(SSPE)) SSPE <- wcrossprod(residuals(mod), w=wts) if (missing(idata)) { idata <- NULL idesign <- NULL } if (missing(imatrix)) imatrix <- NULL error.df <- if (missing(error.df)) df.residual(mod) else error.df switch(type, II=Anova.II.mlm(mod, SSPE, error.df, idata, idesign, icontrasts, imatrix, test.statistic, ...), III=Anova.III.mlm(mod, SSPE, error.df, idata, idesign, icontrasts, imatrix, test.statistic, ...), "2"=Anova.II.mlm(mod, SSPE, error.df, idata, idesign, icontrasts, imatrix, test.statistic, ...), "3"=Anova.III.mlm(mod, SSPE, error.df, idata, idesign, icontrasts, imatrix, test.statistic, ...)) } Anova.III.mlm <- function(mod, SSPE, error.df, idata, idesign, icontrasts, imatrix, test, ...){ intercept <- has.intercept(mod) V <- solve(crossprod(model.matrix(mod))) p <- nrow(coefficients(mod)) I.p <- diag(p) terms <- term.names(mod) n.terms <- length(terms) assign <- mod$assign if (is.null(idata) && is.null(imatrix)){ if ((n.terms == 0) && intercept) { Test <- linearHypothesis(mod, 1, SSPE=SSPE, ...) result <- list(SSP=Test$SSPH, SSPE=SSPE, df=1, error.df=error.df, terms="(Intercept)", repeated=FALSE, type="III", test=test) class(result) <- "Anova.mlm" return(result) } SSP <- as.list(rep(0, n.terms)) df <- rep(0, n.terms) names(df) <- names(SSP) <- terms for (term in 1:n.terms){ subs <- which(assign == term - intercept) hyp.matrix <- I.p[subs,,drop=FALSE] Test <- linearHypothesis(mod, hyp.matrix, SSPE=SSPE, ...) SSP[[term]] <- Test$SSPH df[term]<- length(subs) } result <- list(SSP=SSP, SSPE=SSPE, df=df, error.df=error.df, terms=terms, repeated=FALSE, type="III", test=test) } else { if (!is.null(imatrix)){ X.design <- do.call(cbind, imatrix) ncols <- sapply(imatrix, ncol) end <- cumsum(ncols) start <- c(1, (end + 1))[-(length(end) + 1)] cols <- mapply(seq, from=start, to=end) iterms <- names(end) names(cols) <- iterms check.imatrix(X.design, iterms) } else { if (is.null(idesign)) stop("idesign (intra-subject design) missing.") for (i in 1:length(idata)){ if (is.null(attr(idata[,i], "contrasts"))){ contrasts(idata[,i]) <- if (is.ordered(idata[,i])) icontrasts[2] else icontrasts[1] } } X.design <- model.matrix(idesign, data=idata) i.intercept <- has.intercept(X.design) iterms <- term.names(idesign) if (i.intercept) iterms <- c("(Intercept)", iterms) check.imatrix(X.design) } df <- rep(0, n.terms*length(iterms)) hnames <- rep("", length(df)) P <- SSPEH <- SSP <- as.list(df) i <- 0 for (iterm in iterms){ for (term in 1:n.terms){ subs <- which(assign == term - intercept) hyp.matrix <- I.p[subs,,drop=FALSE] i <- i + 1 Test <- linearHypothesis(mod, hyp.matrix, SSPE=SSPE, idata=idata, idesign=idesign, icontrasts=icontrasts, iterms=iterm, check.imatrix=FALSE, P=imatrix[[iterm]], singular.ok=TRUE, ...) SSP[[i]] <- Test$SSPH SSPEH[[i]] <- Test$SSPE P[[i]] <- Test$P df[i] <- length(subs) hnames[i] <- if (iterm == "(Intercept)") terms[term] else if (terms[term] == "(Intercept)") iterm else paste(terms[term], ":", iterm, sep="") } } names(df) <- names(SSP) <- names(SSPEH) <- names(P) <- hnames result <- list(SSP=SSP, SSPE=SSPEH, P=P, df=df, error.df=error.df, terms=hnames, repeated=TRUE, type="III", test=test, idata=idata, idesign=idesign, icontrasts=icontrasts, imatrix=imatrix, singular=Test$singular) } class(result) <- "Anova.mlm" result } Anova.II.mlm <- function(mod, SSPE, error.df, idata, idesign, icontrasts, imatrix, test, ...){ wts <- if (!is.null(mod$weights)) mod$weights else rep(1, nrow(model.matrix(mod))) V <- solve(wcrossprod(model.matrix(mod), w=wts)) SSP.term <- function(term, iterm){ which.term <- which(term == terms) subs.term <- which(assign == which.term) relatives <- relatives(term, terms, fac) subs.relatives <- NULL for (relative in relatives) subs.relatives <- c(subs.relatives, which(assign==relative)) hyp.matrix.1 <- I.p[subs.relatives,,drop=FALSE] hyp.matrix.2 <- I.p[c(subs.relatives, subs.term),,drop=FALSE] if (missing(iterm)){ SSP1 <- if (length(subs.relatives) == 0) 0 else linearHypothesis(mod, hyp.matrix.1, SSPE=SSPE, V=V, singular.ok=TRUE, ...)$SSPH SSP2 <- linearHypothesis(mod, hyp.matrix.2, SSPE=SSPE, V=V, singular.ok=TRUE, ...)$SSPH return(SSP2 - SSP1) } else { SSP1 <- if (length(subs.relatives) == 0) 0 else linearHypothesis(mod, hyp.matrix.1, SSPE=SSPE, V=V, idata=idata, idesign=idesign, iterms=iterm, icontrasts=icontrasts, P=imatrix[[iterm]], singular.ok=TRUE, ...)$SSPH lh2 <- linearHypothesis(mod, hyp.matrix.2, SSPE=SSPE, V=V, idata=idata, idesign=idesign, iterms=iterm, icontrasts=icontrasts, P=imatrix[[iterm]], singular.ok=TRUE, ...) return(list(SSP = lh2$SSPH - SSP1, SSPE=lh2$SSPE, P=lh2$P, singular=lh2$singular)) } } fac <- attr(mod$terms, "factors") intercept <- has.intercept(mod) p <- nrow(coefficients(mod)) I.p <- diag(p) assign <- mod$assign terms <- term.names(mod) if (intercept) terms <- terms[-1] n.terms <- length(terms) if (n.terms == 0){ message("Note: model has only an intercept; equivalent type-III tests substituted.") return(Anova.III.mlm(mod, SSPE, error.df, idata, idesign, icontrasts, imatrix, test, ...)) } if (is.null(idata) && is.null(imatrix)){ SSP <- as.list(rep(0, n.terms)) df <- rep(0, n.terms) names(df) <- names(SSP) <- terms for (i in 1:n.terms){ SSP[[i]] <- SSP.term(terms[i]) df[i]<- df.terms(mod, terms[i]) } result <- list(SSP=SSP, SSPE=SSPE, df=df, error.df=error.df, terms=terms, repeated=FALSE, type="II", test=test) } else { if (!is.null(imatrix)){ X.design <- do.call(cbind, imatrix) ncols <- sapply(imatrix, ncol) end <- cumsum(ncols) start <- c(1, (end + 1))[-(length(end) + 1)] cols <- mapply(seq, from=start, to=end) iterms <- names(end) names(cols) <- iterms check.imatrix(X.design, iterms) } else { if (is.null(idesign)) stop("idesign (intra-subject design) missing.") for (i in 1:length(idata)){ if (is.null(attr(idata[,i], "contrasts"))){ contrasts(idata[,i]) <- if (is.ordered(idata[,i])) icontrasts[2] else icontrasts[1] } } X.design <- model.matrix(idesign, data=idata) iintercept <- has.intercept(X.design) iterms <- term.names(idesign) if (iintercept) iterms <- c("(Intercept)", iterms) check.imatrix(X.design) } df <- rep(0, (n.terms + intercept)*length(iterms)) hnames <- rep("", length(df)) P <- SSPEH <- SSP <- as.list(df) i <- 0 for (iterm in iterms){ if (intercept){ i <- i + 1 hyp.matrix.1 <- I.p[-1,,drop=FALSE] SSP1 <- linearHypothesis(mod, hyp.matrix.1, SSPE=SSPE, V=V, idata=idata, idesign=idesign, iterms=iterm, icontrasts=icontrasts, check.imatrix=FALSE, P=imatrix[[iterm]], singular.ok=TRUE, ...)$SSPH lh2 <- linearHypothesis(mod, I.p, SSPE=SSPE, V=V, idata=idata, idesign=idesign, iterms=iterm, icontrasts=icontrasts, check.imatrix=FALSE, P=imatrix[[iterm]], singular.ok=TRUE, ...) SSP[[i]] <- lh2$SSPH - SSP1 SSPEH[[i]] <- lh2$SSPE P[[i]] <- lh2$P df[i] <- 1 hnames[i] <- iterm } for (term in 1:n.terms){ subs <- which(assign == term) i <- i + 1 Test <- SSP.term(terms[term], iterm) SSP[[i]] <- Test$SSP SSPEH[[i]] <- Test$SSPE P[[i]] <- Test$P df[i]<- length(subs) hnames[i] <- if (iterm == "(Intercept)") terms[term] else paste(terms[term], ":", iterm, sep="") } } names(df) <- names(P) <- names(SSP) <- names(SSPEH) <- hnames result <- list(SSP=SSP, SSPE=SSPEH, P=P, df=df, error.df=error.df, terms=hnames, repeated=TRUE, type="II", test=test, idata=idata, idesign=idesign, icontrasts=icontrasts, imatrix=imatrix, singular=Test$singular) } class(result) <- "Anova.mlm" result } print.Anova.mlm <- function(x, ...){ if ((!is.null(x$singular)) && x$singular) stop("singular error SSP matrix; multivariate tests unavailable\ntry summary(object, multivariate=FALSE)") test <- x$test repeated <- x$repeated ntests <- length(x$terms) tests <- matrix(NA, ntests, 4) if (!repeated) SSPE.qr <- qr(x$SSPE) for (term in 1:ntests){ # some of the code here adapted from stats:::summary.manova eigs <- Re(eigen(qr.coef(if (repeated) qr(x$SSPE[[term]]) else SSPE.qr, x$SSP[[term]]), symmetric = FALSE)$values) tests[term, 1:4] <- switch(test, Pillai = Pillai(eigs, x$df[term], x$error.df), Wilks = Wilks(eigs, x$df[term], x$error.df), "Hotelling-Lawley" = HL(eigs, x$df[term], x$error.df), Roy = Roy(eigs, x$df[term], x$error.df)) } ok <- tests[, 2] >= 0 & tests[, 3] > 0 & tests[, 4] > 0 ok <- !is.na(ok) & ok tests <- cbind(x$df, tests, pf(tests[ok, 2], tests[ok, 3], tests[ok, 4], lower.tail = FALSE)) rownames(tests) <- x$terms colnames(tests) <- c("Df", "test stat", "approx F", "num Df", "den Df", "Pr(>F)") tests <- structure(as.data.frame(tests), heading = paste("\nType ", x$type, if (repeated) " Repeated Measures", " MANOVA Tests: ", test, " test statistic", sep=""), class = c("anova", "data.frame")) print(tests) invisible(x) } # path <- "D:/R-package-sources/car/R" # files <- list.files(path, pattern=".*\\.R") # files <- paste(path, files, sep="/") # for (file in files) source(file) # summary.Anova.mlm and print.summary.Anova.mlm methods # with contributions from Gabriel Baud-Bovy summary.Anova.mlm <- function (object, test.statistic, univariate=TRUE, multivariate=TRUE, ...) { GG <- function(SSPE, P) { # Greenhouse-Geisser correction p <- nrow(SSPE) if (p < 2) return(NA) lambda <- eigen(SSPE %*% solve(t(P) %*% P))$values lambda <- lambda[lambda > 0] ((sum(lambda)/p)^2)/(sum(lambda^2)/p) } HF <- function(gg, error.df, p) { # Huynh-Feldt correction ((error.df + 1) * p * gg - 2)/(p * (error.df - p * gg)) } mauchly <- function(SSD, P, df) { # most of this function borrowed from stats:::mauchly.test.SSD if (nrow(SSD) < 2) return(c(NA, NA)) Tr <- function(X) sum(diag(X)) p <- nrow(P) I <- diag(p) Psi <- t(P) %*% I %*% P B <- SSD pp <- nrow(SSD) U <- solve(Psi, B) n <- df logW <- log(det(U)) - pp * log(Tr(U/pp)) rho <- 1 - (2 * pp^2 + pp + 2)/(6 * pp * n) w2 <- (pp + 2) * (pp - 1) * (pp - 2) * (2 * pp^3 + 6 * pp^2 + 3 * p + 2)/(288 * (n * pp * rho)^2) z <- -n * rho * logW f <- pp * (pp + 1)/2 - 1 Pr1 <- pchisq(z, f, lower.tail = FALSE) Pr2 <- pchisq(z, f + 4, lower.tail = FALSE) pval <- Pr1 + w2 * (Pr2 - Pr1) c(statistic = c(W = exp(logW)), p.value = pval) } if (missing(test.statistic)) test.statistic <- c("Pillai", "Wilks", "Hotelling-Lawley", "Roy") test.statistic <- match.arg(test.statistic, c("Pillai", "Wilks", "Hotelling-Lawley", "Roy"), several.ok = TRUE) nterms <- length(object$terms) summary.object <- list(type=object$type, repeated=object$repeated, multivariate.tests=NULL, univariate.tests=NULL, pval.adjustments=NULL, sphericity.tests=NULL) if (multivariate){ summary.object$multivariate.tests <- vector(nterms, mode="list") names(summary.object$multivariate.tests) <- object$terms summary.object$SSPE <- object$SSPE for (term in 1:nterms) { hyp <- list(SSPH = object$SSP[[term]], SSPE = if (object$repeated) object$SSPE[[term]] else object$SSPE, P = if (object$repeated) object$P[[term]] else NULL, test = test.statistic, df = object$df[term], df.residual = object$error.df, title = object$terms[term]) class(hyp) <- "linearHypothesis.mlm" summary.object$multivariate.tests[[term]] <- hyp } } if (object$repeated && univariate) { singular <- object$singular error.df <- object$error.df table <- matrix(0, nterms, 6) table2 <- matrix(0, nterms, 4) table3 <- matrix(0, nterms, 2) rownames(table3) <- rownames(table2) <- rownames(table) <- object$terms colnames(table) <- c("SS", "num Df", "Error SS", "den Df", "F", "Pr(>F)") colnames(table2) <- c("GG eps", "Pr(>F[GG])", "HF eps","Pr(>F[HF])") colnames(table3) <- c("Test statistic", "p-value") if (singular) warning("Singular error SSP matrix:\nnon-sphericity test and corrections not available") for (term in 1:nterms) { SSP <- object$SSP[[term]] SSPE <- object$SSPE[[term]] P <- object$P[[term]] p <- ncol(P) PtPinv <- solve(t(P) %*% P) gg <- if (!singular) GG(SSPE, P) else NA table[term, "SS"] <- sum(diag(SSP %*% PtPinv)) table[term, "Error SS"] <- sum(diag(SSPE %*% PtPinv)) table[term, "num Df"] <- object$df[term] * p table[term, "den Df"] <- error.df * p table[term, "F"] <- (table[term, "SS"]/table[term, "num Df"])/ (table[term, "Error SS"]/table[term, "den Df"]) table[term, "Pr(>F)"] <- pf(table[term, "F"], table[term, "num Df"], table[term, "den Df"], lower.tail = FALSE) table2[term, "GG eps"] <- gg table2[term, "HF eps"] <- if (!singular) HF(gg, error.df, p) else NA table3[term, ] <- if (!singular) mauchly(SSPE, P, object$error.df) else NA } table3 <- na.omit(table3) if (nrow(table3) > 0) { table2[, "Pr(>F[GG])"] <- pf(table[, "F"], table2[, "GG eps"] * table[, "num Df"], table2[, "GG eps"] * table[, "den Df"], lower.tail = FALSE) table2[, "Pr(>F[HF])"] <- pf(table[, "F"], pmin(1, table2[, "HF eps"]) * table[, "num Df"], pmin(1, table2[, "HF eps"]) * table[, "den Df"], lower.tail = FALSE) table2 <- na.omit(table2) if (any(table2[, "HF eps"] > 1)) warning("HF eps > 1 treated as 1") } class(table3) <- class(table) <- "anova" summary.object$univariate.tests <- table summary.object$pval.adjustments <- table2 summary.object$sphericity.tests <- table3 } class(summary.object) <- "summary.Anova.mlm" summary.object } print.summary.Anova.mlm <- function(x, digits = getOption("digits"), ... ) { if (!is.null(x$multivariate.tests)) { cat(paste("\nType ", x$type, if (x$repeated) " Repeated Measures", " MANOVA Tests:\n", sep = "")) if (!x$repeated) { cat("\nSum of squares and products for error:\n") print(x$SSPE, digits = digits) } for (term in 1:length(x$multivariate.tests)) { cat(paste("\n------------------------------------------\n", "\nTerm:", names(x$multivariate.tests)[term], "\n")) print(x$multivariate.tests[[term]], digits = digits, SSPE = x$repeated, ...) } } if (!is.null(x$univariate.tests)) { cat("\nUnivariate Type", x$type, "Repeated-Measures ANOVA Assuming Sphericity\n\n") print(x$univariate.tests) if (nrow(x$sphericity.tests) > 0) { cat("\n\nMauchly Tests for Sphericity\n\n") print(x$sphericity.tests) cat("\n\nGreenhouse-Geisser and Huynh-Feldt Corrections\n", "for Departure from Sphericity\n\n") table <- x$pval.adjustments[, 1:2, drop = FALSE] class(table) <- "anova" print(table) cat("\n") table <- x$pval.adjustments[, 3:4, drop = FALSE] class(table) print(table) } } invisible(x) } Anova.manova <- function(mod, ...){ class(mod) <- c("mlm", "lm") Anova(mod, ...) } Manova <- function(mod, ...){ UseMethod("Manova") } Manova.mlm <- function(mod, ...){ Anova(mod, ...) } # Cox regression models df.residual.coxph <- function(object, ...){ object$n - sum(!is.na(coef(object))) } alias.coxph <- function(model){ if(any(which <- is.na(coef(model)))) return(list(Complete=which)) else list() } logLik.coxph <- function(object, ...) object$loglik[2] Anova.coxph <- function(mod, type=c("II","III", 2, 3), test.statistic=c("LR", "Wald"), ...){ type <- as.character(type) type <- match.arg(type) test.statistic <- match.arg(test.statistic) if (length((mod$rscore) > 0) && (test.statistic == "LR")){ warning("LR tests unavailable with robust variances\nWald tests substituted") test.statistic <- "Wald" } switch(type, II=switch(test.statistic, LR=Anova.II.LR.coxph(mod), Wald=Anova.default(mod, type="II", test.statistic="Chisq", vcov.=vcov(mod))), III=switch(test.statistic, LR=Anova.III.LR.coxph(mod), Wald=Anova.default(mod, type="III", test.statistic="Chisq", vcov.=vcov(mod))), "2"=switch(test.statistic, LR=Anova.II.LR.coxph(mod), Wald=Anova.default(mod, type="II", test.statistic="Chisq", vcov.=vcov(mod))), "3"=switch(test.statistic, LR=Anova.III.LR.coxph(mod), Wald=Anova.default(mod, type="III", test.statistic="Chisq", vcov.=vcov(mod)))) } Anova.II.LR.coxph <- function(mod, ...){ which.nms <- function(name) which(asgn == which(names == name)) fac <-attr(terms(mod), "factors") names <- term.names(mod) n.terms <- length(names) if (n.terms < 2) return(anova(mod, test="Chisq")) X <- model.matrix(mod) asgn <- attr(X, 'assign') p <- LR <- rep(0, n.terms) df <- df.terms(mod) for (term in 1:n.terms){ rels <- names[relatives(names[term], names, fac)] exclude.1 <- as.vector(unlist(sapply(c(names[term], rels), which.nms))) mod.1 <- coxph(mod$y ~ X[, -exclude.1, drop = FALSE]) loglik.1 <- logLik(mod.1) mod.2 <- if (length(rels) == 0) mod else { exclude.2 <- as.vector(unlist(sapply(rels, which.nms))) coxph(mod$y ~ X[, -exclude.2, drop = FALSE]) } loglik.2 <- logLik(mod.2) LR[term] <- -2*(loglik.1 - loglik.2) p[term] <- pchisq(LR[term], df[term], lower.tail=FALSE) } result <- data.frame(LR, df, p) row.names(result) <- names names(result) <- c("LR Chisq", "Df", "Pr(>Chisq)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- "Analysis of Deviance Table (Type II tests)" result } Anova.III.LR.coxph <- function(mod, ...){ which.nms <- function(name) which(asgn == which(names == name)) fac <-attr(terms(mod), "factors") names <- term.names(mod) n.terms <- length(names) if (n.terms < 2) return(anova(mod, test="Chisq")) X <- model.matrix(mod) asgn <- attr(X, 'assign') df <- df.terms(mod) LR <- p <- rep(0, n.terms) loglik1 <- logLik(mod) for (term in 1:n.terms){ mod.0 <- coxph(mod$y ~ X[, -which.nms(names[term])]) LR[term] <- -2*(logLik(mod.0) - loglik1) p[term] <- pchisq(LR[term], df[term], lower.tail=FALSE) } result <- data.frame(LR, df, p) row.names(result) <- names names(result) <- c("LR Chisq", "Df","Pr(>Chisq)") class(result) <- c("anova", "data.frame") attr(result,"heading") <- "Analysis of Deviance Table (Type III tests)" result } # parametric survival regression models alias.survreg <- function(model){ if(any(which <- diag(vcov(model)) < 1e-10)) return(list(Complete=which)) else list() } logLik.survreg <- function(object, ...) object$loglik[2] Anova.survreg <- function(mod, type=c("II","III", 2, 3), test.statistic=c("LR", "Wald"), ...){ type <- as.character(type) type <- match.arg(type) test.statistic <- match.arg(test.statistic) if (length((mod$rscore) > 0) && (test.statistic == "LR")){ warning("LR tests unavailable with robust variances\nWald tests substituted") test.statistic <- "Wald" } switch(type, II=switch(test.statistic, LR=Anova.II.LR.survreg(mod), Wald=Anova.II.Wald.survreg(mod)), III=switch(test.statistic, LR=Anova.III.LR.survreg(mod), Wald=Anova.III.Wald.survreg(mod)), "2"=switch(test.statistic, LR=Anova.II.LR.survreg(mod), Wald=Anova.II.Wald.survreg(mod)), "3"=switch(test.statistic, LR=Anova.III.LR.survreg(mod), Wald=Anova.III.Wald.survreg(mod))) } Anova.II.LR.survreg <- function(mod, ...){ which.nms <- function(name) which(asgn == which(names == name)) fac <-attr(terms(mod), "factors") names <- term.names(mod) X <- model.matrix(mod) asgn <- attr(X, 'assign') asgn <- asgn[asgn != 0] if (has.intercept(mod)){ int <- which(names == "(Intercept)") X <- X[, -int] names <- names[-int] } n.terms <- length(names) if (n.terms < 2) return(anova(mod)) p <- LR <- rep(0, n.terms) df <- df.terms(mod) y <- model.frame(mod)[,1] for (term in 1:n.terms){ rels <- names[relatives(names[term], names, fac)] exclude.1 <- as.vector(unlist(sapply(c(names[term], rels), which.nms))) mod.1 <- survreg(y ~ X[, -exclude.1, drop = FALSE]) loglik.1 <- logLik(mod.1) mod.2 <- if (length(rels) == 0) mod else { exclude.2 <- as.vector(unlist(sapply(rels, which.nms))) survreg(y ~ X[, -exclude.2, drop = FALSE]) } loglik.2 <- logLik(mod.2) LR[term] <- -2*(loglik.1 - loglik.2) p[term] <- pchisq(LR[term], df[term], lower.tail=FALSE) } result <- data.frame(LR, df, p) row.names(result) <- names names(result) <- c("LR Chisq", "Df", "Pr(>Chisq)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- "Analysis of Deviance Table (Type II tests)" result } Anova.III.LR.survreg <- function(mod, ...){ which.nms <- function(name) which(asgn == which(names == name)) fac <-attr(terms(mod), "factors") names <- term.names(mod) X <- model.matrix(mod) asgn <- attr(X, 'assign') asgn <- asgn[asgn != 0] if (has.intercept(mod)){ int <- which(names == "(Intercept)") X <- X[, -int] names <- names[-int] } n.terms <- length(names) if (n.terms < 2) return(anova(mod)) p <- LR <- rep(0, n.terms) df <- df.terms(mod) y <- model.frame(mod)[,1] loglik1 <- logLik(mod) for (term in 1:n.terms){ mod.0 <- survreg(y ~ X[, -which.nms(names[term])]) LR[term] <- -2*(logLik(mod.0) - loglik1) p[term] <- pchisq(LR[term], df[term], lower.tail=FALSE) } result <- data.frame(LR, df, p) row.names(result) <- names names(result) <- c("LR Chisq", "Df","Pr(>Chisq)") class(result) <- c("anova", "data.frame") attr(result,"heading") <- "Analysis of Deviance Table (Type III tests)" result } Anova.II.Wald.survreg <- function(mod){ V <- vcov(mod) p <- nrow(V) V <- V[-p, -p] Anova.II.default(mod, V, test="Chisq") } Anova.III.Wald.survreg <- function(mod){ V <- vcov(mod) p <- nrow(V) V <- V[-p, -p] Anova.III.default(mod, V, test="Chisq") } # Default Anova() method: requires methods for vcov() (if vcov. argument not specified) and coef(). Anova.default <- function(mod, type=c("II","III", 2, 3), test.statistic=c("Chisq", "F"), vcov.=vcov(mod), singular.ok, ...){ type <- as.character(type) type <- match.arg(type) test.statistic <- match.arg(test.statistic) if (missing(singular.ok)) singular.ok <- type == "2" || type == "II" switch(type, II=Anova.II.default(mod, vcov., test.statistic, singular.ok=singular.ok), III=Anova.III.default(mod, vcov., test.statistic, singular.ok=singular.ok), "2"=Anova.II.default(mod, vcov., test.statistic, singular.ok=singular.ok), "3"=Anova.III.default(mod, vcov., test.statistic, singular.ok=singular.ok)) } Anova.II.default <- function(mod, vcov., test, singular.ok=TRUE, ...){ hyp.term <- function(term){ which.term <- which(term==names) subs.term <- which(assign==which.term) relatives <- relatives(term, names, fac) subs.relatives <- NULL for (relative in relatives) subs.relatives <- c(subs.relatives, which(assign==relative)) hyp.matrix.1 <- I.p[subs.relatives,,drop=FALSE] hyp.matrix.1 <- hyp.matrix.1[, not.aliased, drop=FALSE] hyp.matrix.2 <- I.p[c(subs.relatives,subs.term),,drop=FALSE] hyp.matrix.2 <- hyp.matrix.2[, not.aliased, drop=FALSE] hyp.matrix.term <- if (nrow(hyp.matrix.1) == 0) hyp.matrix.2 else t(ConjComp(t(hyp.matrix.1), t(hyp.matrix.2), vcov.)) hyp.matrix.term <- hyp.matrix.term[!apply(hyp.matrix.term, 1, function(x) all(x == 0)), , drop=FALSE] if (nrow(hyp.matrix.term) == 0) return(c(statistic=NA, df=0)) hyp <- linearHypothesis.default(mod, hyp.matrix.term, vcov.=vcov., test=test, singular.ok=singular.ok, ...) if (test=="Chisq") c(statistic=hyp$Chisq[2], df=hyp$Df[2]) else c(statistic=hyp$F[2], df=hyp$Df[2]) } not.aliased <- !is.na(coef(mod)) if (!singular.ok && !all(not.aliased)) stop("there are aliased coefficients in the model") fac <- attr(mod$terms, "factors") intercept <- has.intercept(mod) p <- length(coefficients(mod)) I.p <- diag(p) assign <- attr(model.matrix(mod), "assign") assign[!not.aliased] <- NA names <- term.names(mod) if (intercept) names <- names[-1] n.terms <- length(names) df <- c(rep(0, n.terms), df.residual(mod)) if (inherits(mod, "coxph")){ assign <- assign[assign != 0] clusters <- grep("^cluster\\(", names) if (length(clusters) > 0) { names <- names[-clusters] df <- df[-clusters] } } p <- teststat <- rep(0, n.terms + 1) teststat[n.terms + 1] <- p[n.terms + 1] <- NA for (i in 1:n.terms){ hyp <- hyp.term(names[i]) teststat[i] <- abs(hyp["statistic"]) df[i] <- abs(hyp["df"]) p[i] <- if (test == "Chisq") pchisq(teststat[i], df[i], lower.tail=FALSE) else pf(teststat[i], df[i], df[n.terms + 1], lower.tail=FALSE) } result <- data.frame(df, teststat, p) row.names(result) <- c(names,"Residuals") names(result) <- c ("Df", test, if (test == "Chisq") "Pr(>Chisq)" else "Pr(>F)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- c("Analysis of Deviance Table (Type II tests)\n", paste("Response:", responseName(mod))) result } Anova.III.default <- function(mod, vcov., test, singular.ok=FALSE, ...){ intercept <- has.intercept(mod) p <- length(coefficients(mod)) I.p <- diag(p) names <- term.names(mod) n.terms <- length(names) assign <- attr(model.matrix(mod), "assign") df <- c(rep(0, n.terms), df.residual(mod)) if (inherits(mod, "coxph")){ if (intercept) names <- names[-1] assign <- assign[assign != 0] clusters <- grep("^cluster\\(", names) if (length(clusters) > 0) { names <- names[-clusters] df <- df[-clusters] } } if (intercept) df[1] <- 1 teststat <- rep(0, n.terms + 1) p <- rep(0, n.terms + 1) teststat[n.terms + 1] <- p[n.terms + 1] <- NA not.aliased <- !is.na(coef(mod)) if (!singular.ok && !all(not.aliased)) stop("there are aliased coefficients in the model") for (term in 1:n.terms){ subs <- which(assign == term - intercept) hyp.matrix <- I.p[subs,,drop=FALSE] hyp.matrix <- hyp.matrix[, not.aliased, drop=FALSE] hyp.matrix <- hyp.matrix[!apply(hyp.matrix, 1, function(x) all(x == 0)), , drop=FALSE] if (nrow(hyp.matrix) == 0){ teststat[term] <- NA df[term] <- 0 p[term] <- NA } else { hyp <- linearHypothesis.default(mod, hyp.matrix, vcov.=vcov., test=test, singular.ok=singular.ok, ...) teststat[term] <- if (test=="Chisq") hyp$Chisq[2] else hyp$F[2] df[term] <- abs(hyp$Df[2]) p[term] <- if (test == "Chisq") pchisq(teststat[term], df[term], lower.tail=FALSE) else pf(teststat[term], df[term], df[n.terms + 1], lower.tail=FALSE) } } result <- data.frame(df, teststat, p) row.names(result) <- c(names, "Residuals") names(result) <- c ("Df", test, if (test == "Chisq") "Pr(>Chisq)" else "Pr(>F)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- c("Analysis of Deviance Table (Type III tests)\n", paste("Response:", responseName(mod))) result } ## functions for mixed models # the following function, not exported, to make car consistent with CRAN and development versions of lme4 and with nlme fixef <- function (object){ if (isS4(object)) { if (!inherits(object, "merMod")) object@fixef else lme4::fixef(object) } else object$coefficients$fixed } Anova.merMod <- function(mod, type=c("II","III", 2, 3), test.statistic=c("Chisq", "F"), vcov.=vcov(mod), singular.ok, ...){ type <- as.character(type) type <- match.arg(type) test.statistic <- match.arg(test.statistic) if (missing(singular.ok)) singular.ok <- type == "2" || type == "II" Anova.mer(mod=mod, type=type, test.statistic=test.statistic, vcov.=vcov., singular.ok=singular.ok, ...) } Anova.mer <- function(mod, type=c("II","III", 2, 3), test.statistic=c("Chisq", "F"), vcov.=vcov(mod), singular.ok, ...){ type <- as.character(type) type <- match.arg(type) test.statistic <- match.arg(test.statistic) if (missing(singular.ok)) singular.ok <- type == "2" || type == "II" switch(type, II=Anova.II.mer(mod, test=test.statistic, vcov., singular.ok=singular.ok), III=Anova.III.mer(mod, test=test.statistic, vcov., singular.ok=singular.ok), "2"=Anova.II.mer(mod, test=test.statistic, vcov., singular.ok=singular.ok), "3"=Anova.III.mer(mod, test=test.statistic, vcov., singular.ok=singular.ok)) } Anova.II.mer <- function(mod, vcov., singular.ok=TRUE, test=c("Chisq", "F"), ...){ hyp.term <- function(term){ which.term <- which(term==names) subs.term <- which(assign==which.term) relatives <- relatives(term, names, fac) subs.relatives <- NULL for (relative in relatives) subs.relatives <- c(subs.relatives, which(assign==relative)) hyp.matrix.1 <- I.p[subs.relatives,,drop=FALSE] hyp.matrix.1 <- hyp.matrix.1[, not.aliased, drop=FALSE] hyp.matrix.2 <- I.p[c(subs.relatives,subs.term),,drop=FALSE] hyp.matrix.2 <- hyp.matrix.2[, not.aliased, drop=FALSE] hyp.matrix.term <- if (nrow(hyp.matrix.1) == 0) hyp.matrix.2 else t(ConjComp(t(hyp.matrix.1), t(hyp.matrix.2), vcov.)) hyp.matrix.term <- hyp.matrix.term[!apply(hyp.matrix.term, 1, function(x) all(x == 0)), , drop=FALSE] if (nrow(hyp.matrix.term) == 0) return(c(statistic=NA, df=0)) hyp <- linearHypothesis(mod, hyp.matrix.term, vcov.=vcov., singular.ok=singular.ok, test=test, ...) if (test == "Chisq") return(c(statistic=hyp$Chisq[2], df=hyp$Df[2])) else return(c(statistic=hyp$F[2], df=hyp$Df[2], res.df=hyp$Res.Df[2])) } test <- match.arg(test) not.aliased <- !is.na(fixef(mod)) if (!singular.ok && !all(not.aliased)) stop("there are aliased coefficients in the model") fac <- attr(terms(mod), "factors") intercept <- has.intercept(mod) p <- length(fixef(mod)) I.p <- diag(p) if (!missing(vcov.)){ vcov. <- if (test == "F"){ if (!require(pbkrtest)) stop("pbkrtest package required for F-tests on linear mixed model") as.matrix(vcovAdj(mod, details=0)) } else vcov(mod) } assign <- attr(model.matrix(mod), "assign") assign[!not.aliased] <- NA names <- term.names(mod) if (intercept) names <- names[-1] n.terms <- length(names) p <- teststat <- df <- res.df <- rep(0, n.terms) for (i in 1:n.terms){ hyp <- hyp.term(names[i]) teststat[i] <- abs(hyp["statistic"]) df[i] <- abs(hyp["df"]) res.df[i] <- hyp["res.df"] p[i] <- if (test == "Chisq") pchisq(teststat[i], df[i], lower.tail=FALSE) else pf(teststat[i], df[i], res.df[i], lower.tail=FALSE) } if (test=="Chisq"){ result <- data.frame(teststat, df, p) row.names(result) <- names names(result) <- c ("Chisq", "Df", "Pr(>Chisq)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- c("Analysis of Deviance Table (Type II Wald chisquare tests)\n", paste("Response:", responseName(mod))) } else { result <- data.frame(teststat, df, res.df, p) row.names(result) <- names names(result) <- c ("F", "Df", "Df.res", "Pr(>F)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- c("Analysis of Deviance Table (Type II Wald F tests with Kenward-Roger df)\n", paste("Response:", responseName(mod))) } result } Anova.III.mer <- function(mod, vcov., singular.ok=FALSE, test=c("Chisq", "F"), ...){ intercept <- has.intercept(mod) p <- length(fixef(mod)) I.p <- diag(p) names <- term.names(mod) n.terms <- length(names) assign <- attr(model.matrix(mod), "assign") p <- teststat <- df <- res.df <- rep(0, n.terms) if (intercept) df[1] <- 1 not.aliased <- !is.na(fixef(mod)) if (!singular.ok && !all(not.aliased)) stop("there are aliased coefficients in the model") if (!missing(vcov.)){ vcov. <- if (test == "F"){ if (!require(pbkrtest)) stop("pbkrtest package required for F-tests on linear mixed model") as.matrix(vcovAdj(mod, details=0)) } else vcov(mod) } for (term in 1:n.terms){ subs <- which(assign == term - intercept) hyp.matrix <- I.p[subs,,drop=FALSE] hyp.matrix <- hyp.matrix[, not.aliased, drop=FALSE] hyp.matrix <- hyp.matrix[!apply(hyp.matrix, 1, function(x) all(x == 0)), , drop=FALSE] if (nrow(hyp.matrix) == 0){ teststat[term] <- NA df[term] <- 0 p[term] <- NA } else { hyp <- linearHypothesis(mod, hyp.matrix, test=test, vcov.=vcov., singular.ok=singular.ok, ...) if (test == "Chisq"){ teststat[term] <- hyp$Chisq[2] df[term] <- abs(hyp$Df[2]) p[term] <- pchisq(teststat[term], df[term], lower.tail=FALSE) } else{ teststat[term] <- hyp$F[2] df[term] <- abs(hyp$Df[2]) res.df[term]=hyp$Res.Df[2] p[term] <- pf(teststat[term], df[term], res.df[term], lower.tail=FALSE) } } } if (test == "Chisq"){ result <- data.frame(teststat, df, p) row.names(result) <- names names(result) <- c ("Chisq", "Df", "Pr(>Chisq)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- c("Analysis of Deviance Table (Type III Wald chisquare tests)\n", paste("Response:", responseName(mod))) } else { result <- data.frame(teststat, df, res.df, p) row.names(result) <- names names(result) <- c ("F", "Df", "Df.res", "Pr(>F)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- c("Analysis of Deviance Table (Type III Wald F tests with Kenward-Roger df)\n", paste("Response:", responseName(mod))) } result } Anova.lme <- function(mod, type=c("II","III", 2, 3), vcov.=vcov(mod), singular.ok, ...){ type <- as.character(type) type <- match.arg(type) if (missing(singular.ok)) singular.ok <- type == "2" || type == "II" switch(type, II=Anova.II.lme(mod, vcov., singular.ok=singular.ok), III=Anova.III.lme(mod, vcov., singular.ok=singular.ok), "2"=Anova.II.lme(mod, vcov., singular.ok=singular.ok), "3"=Anova.III.lme(mod, vcov., singular.ok=singular.ok)) } Anova.II.lme <- function(mod, vcov., singular.ok=TRUE, ...){ hyp.term <- function(term){ which.term <- which(term==names) subs.term <- which(assign==which.term) relatives <- relatives(term, names, fac) subs.relatives <- NULL for (relative in relatives) subs.relatives <- c(subs.relatives, which(assign==relative)) hyp.matrix.1 <- I.p[subs.relatives,,drop=FALSE] hyp.matrix.1 <- hyp.matrix.1[, not.aliased, drop=FALSE] hyp.matrix.2 <- I.p[c(subs.relatives,subs.term),,drop=FALSE] hyp.matrix.2 <- hyp.matrix.2[, not.aliased, drop=FALSE] hyp.matrix.term <- if (nrow(hyp.matrix.1) == 0) hyp.matrix.2 else t(ConjComp(t(hyp.matrix.1), t(hyp.matrix.2), vcov.)) hyp.matrix.term <- hyp.matrix.term[!apply(hyp.matrix.term, 1, function(x) all(x == 0)), , drop=FALSE] if (nrow(hyp.matrix.term) == 0) return(c(statistic=NA, df=0)) hyp <- linearHypothesis(mod, hyp.matrix.term, vcov.=vcov., singular.ok=singular.ok, ...) c(statistic=hyp$Chisq[2], df=hyp$Df[2]) } not.aliased <- !is.na(fixef(mod)) if (!singular.ok && !all(not.aliased)) stop("there are aliased coefficients in the model") fac <- attr(terms(mod), "factors") intercept <- has.intercept(mod) p <- length(fixef(mod)) I.p <- diag(p) assign <- attr(model.matrix(mod), "assign") assign[!not.aliased] <- NA names <- term.names(mod) if (intercept) names <- names[-1] n.terms <- length(names) p <- teststat <- df <- rep(0, n.terms) for (i in 1:n.terms){ hyp <- hyp.term(names[i]) teststat[i] <- abs(hyp["statistic"]) df[i] <- abs(hyp["df"]) p[i] <- pchisq(teststat[i], df[i], lower.tail=FALSE) } result <- data.frame(teststat, df, p) row.names(result) <- names names(result) <- c("Chisq", "Df", "Pr(>Chisq)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- c("Analysis of Deviance Table (Type II tests)\n", paste("Response:", responseName(mod))) result } Anova.III.lme <- function(mod, vcov., singular.ok=FALSE, ...){ intercept <- has.intercept(mod) p <- length(coefficients(mod)) I.p <- diag(p) names <- term.names(mod) n.terms <- length(names) assign <- attr(model.matrix(mod), "assign") df <- rep(0, n.terms) if (intercept) df[1] <- 1 p <- teststat <-rep(0, n.terms) not.aliased <- !is.na(fixef(mod)) if (!singular.ok && !all(not.aliased)) stop("there are aliased coefficients in the model") for (term in 1:n.terms){ subs <- which(assign == term - intercept) hyp.matrix <- I.p[subs,,drop=FALSE] hyp.matrix <- hyp.matrix[, not.aliased, drop=FALSE] hyp.matrix <- hyp.matrix[!apply(hyp.matrix, 1, function(x) all(x == 0)), , drop=FALSE] if (nrow(hyp.matrix) == 0){ teststat[term] <- NA df[term] <- 0 p[term] <- NA } else { hyp <- linearHypothesis(mod, hyp.matrix, vcov.=vcov., singular.ok=singular.ok, ...) teststat[term] <- hyp$Chisq[2] df[term] <- abs(hyp$Df[2]) p[term] <- pchisq(teststat[term], df[term], lower.tail=FALSE) } } result <- data.frame(teststat, df, p) row.names(result) <- names names(result) <- c ("Chisq", "Df", "Pr(>Chisq)") class(result) <- c("anova", "data.frame") attr(result, "heading") <- c("Analysis of Deviance Table (Type III tests)\n", paste("Response:", responseName(mod))) result } Anova.svyglm <- function(mod, ...) Anova.default(mod, ...) car/R/car-deprecated.R0000644000175100001440000000462711276640620014241 0ustar hornikusers# last modified 2009-11-11 by J. Fox av.plot <- function (...) { .Deprecated("avPlot", package="car") avPlot(...) } av.plots <- function (...) { .Deprecated("avPlots", package="car") avPlots(...) } box.cox <- function (...) { .Deprecated("bcPower", package="car") bcPower(...) } bc <- function (...) { .Deprecated("bcPower", package="car") bcPower(...) } box.cox.powers <- function (...) { .Deprecated("powerTransform", package="car") powerTransform(...) } box.cox.var <- function (...) { .Deprecated("boxCoxVariable", package="car") boxCoxVariable(...) } box.tidwell <- function (...) { .Deprecated("boxTidwell", package="car") boxTidwell(...) } ceres.plot <- function (...) { .Deprecated("ceresPlot", package="car") ceresPlot(...) } ceres.plots <- function (...) { .Deprecated("ceresPlots", package="car") ceresPlots(...) } confidence.ellipse <- function (...) { .Deprecated("confidenceEllipse", package="car") confidenceEllipse(...) } cookd <- function (...) { .Deprecated("cooks.distance", package="stats") cooks.distance(...) } cr.plot <- function (...) { .Deprecated("crPlot", package="car") crPlot(...) } cr.plots <- function (...) { .Deprecated("crPlots", package="car") crPlots(...) } data.ellipse <- function (...) { .Deprecated("dataEllipse", package="car") dataEllipse(...) } durbin.watson <- function (...) { .Deprecated("durbinWatsonTest", package="car") durbinWatsonTest(...) } levene.test <- function (...) { .Deprecated("leveneTest", package="car") leveneTest(...) } leverage.plot <- function (...) { .Deprecated("leveragePlot", package="car") leveragePlot(...) } leverage.plots <- function (...) { .Deprecated("leveragePlots", package="car") leveragePlots(...) } linear.hypothesis <- function (...) { .Deprecated("linearHypothesis", package="car") linearHypothesis(...) } outlier.test <- function (...) { .Deprecated("outlierTest", package="car") outlierTest(...) } ncv.test <- function (...) { .Deprecated("ncvTest", package="car") ncvTest(...) } qq.plot <- function (...) { .Deprecated("qqPlot", package="car") qqPlot(...) } scatterplot.matrix <- function (...) { .Deprecated("scatterplotMatrix", package="car") scatterplotMatrix(...) } spread.level.plot <- function (...) { .Deprecated("spreadLevelPlot", package="car") spreadLevelPlot(...) }car/R/Ellipse.R0000644000175100001440000003004412074564170012765 0ustar hornikusers# Ellipses (orignally by J. Fox and G. Monette) # added grid lines, 25 May 2010 by S. Weisberg # arguments more consistent with other functions; ... passes args to plot, 5 Sept 2010 by J. Fox # confidenceEllipse.lm and .glm can add to current plot, applying patch from Rafael Laboissiere, 17 Oct 2010 by J. Fox # added fill and fill.alpha arguments for translucent fills (suggested by Michael Friendly), 14 Nov 2010 by J. Fox # modified 2 May 2011 by Michael Friendly # - allow pivot=TRUE (with warning) # - barf on non-symmetric shape # - return coordinates of ellipse invisibly # dataEllipse() and confidenceEllipse() invisibly return coordinates, 3 May 2011 by J. Fox # Modified 5 May 2011 by Michael Friendly # - dataEllipse now honors add=FALSE, plot.points=FALSE # Modified 16 May 2011 by Michaell Friendly # - corrected bug introduced in dataEllipse via allowing pivot=TRUE # Modified 7 Aug 2011 by J. Fox: added draw argument # Modified 28 Nov 2011 by J. Fox (suggested by Michael Friendly): # - corrected bug in xlab, ylab in confidenceEllipse() # - added dfn argument to .lm and .glm methods for confidenceEllipse() # Modified 14&16 Dec 2011 by J. Fox (suggested by Michael Friendly) to add weights argument to dataEllipse(). # Modified 2 Feb 2012 by J. Fox: Improved handling of center.pch argument to ellipse() (suggestion of Rob Kushler). # 16 July 2012 added showLabels to dataEllipse ellipse <- function(center, shape, radius, log="", center.pch=19, center.cex=1.5, segments=51, draw=TRUE, add=draw, xlab="", ylab="", col=palette()[2], lwd=2, fill=FALSE, fill.alpha=0.3, grid=TRUE, ...) { trans.colors <- function(col, alpha=0.5, names=NULL) { # this function by Michael Friendly nc <- length(col) na <- length(alpha) # make lengths conform, filling out to the longest if (nc != na) { col <- rep(col, length.out=max(nc,na)) alpha <- rep(alpha, length.out=max(nc,na)) } clr <-rbind(col2rgb(col)/255, alpha=alpha) col <- rgb(clr[1,], clr[2,], clr[3,], clr[4,], names=names) col } logged <- function(axis=c("x", "y")){ axis <- match.arg(axis) 0 != length(grep(axis, log)) } if (! (is.vector(center) && 2==length(center))) stop("center must be a vector of length 2") if (! (is.matrix(shape) && all(2==dim(shape)))) stop("shape must be a 2 by 2 matrix") if (max(abs(shape - t(shape)))/max(abs(shape)) > 1e-10) stop("shape must be a symmetric matrix") angles <- (0:segments)*2*pi/segments unit.circle <- cbind(cos(angles), sin(angles)) # ellipse <- t(center + radius*t(unit.circle %*% chol(shape,pivot=TRUE))) Q <- chol(shape, pivot=TRUE) order <- order(attr(Q, "pivot")) ellipse <- t( center + radius*t( unit.circle %*% Q[,order])) colnames(ellipse) <- c("x", "y") if (logged("x")) ellipse[, "x"] <- exp(ellipse[, "x"]) if (logged("y")) ellipse[, "y"] <- exp(ellipse[, "y"]) fill.col <- trans.colors(col, fill.alpha) if (draw) { if (add) { lines(ellipse, col=col, lwd=lwd, ...) if (fill) polygon(ellipse, col=fill.col, border=NA) } else { plot(ellipse, type="n", xlab = xlab, ylab = ylab, ...) if(grid){ grid(lty=1, equilogs=FALSE) box()} lines(ellipse, col=col, lwd=lwd, ... ) if (fill) polygon(ellipse, col=fill.col, border=NA) } if ((center.pch != FALSE) && (!is.null(center.pch))) points(center[1], center[2], pch=center.pch, cex=center.cex, col=col) } invisible(ellipse) } dataEllipse <- function(x, y, groups, group.labels=group.levels, ellipse.label, weights, log="", levels=c(0.5, 0.95), center.pch=19, center.cex=1.5, draw=TRUE, plot.points=draw, add=!plot.points, segments=51, robust=FALSE, xlab=deparse(substitute(x)), ylab=deparse(substitute(y)), col=if (missing(groups)) palette()[1:2] else palette()[1:length(group.levels)], pch=if (missing(groups)) 1 else seq(group.levels), lwd=2, fill=FALSE, fill.alpha=0.3, grid=TRUE, labels, id.method = "mahal", id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=if (missing(groups)) palette()[1] else palette()(1:length(groups)), ...) { label.ellipse <- function(ellipse, label, col, ...){ # This sub-function from Michael Friendly if (cor(ellipse)[1,2] >= 0){ # position label above top right index <- which.max(ellipse[,2]) x <- ellipse[index, 1] + 0.5 * strwidth(label) y <- ellipse[index, 2] + 0.5 * strheight("A") adj <- c(1, 0) } else { # position label below bot left index <- which.min(ellipse[,2]) x <- ellipse[index, 1] - 0.5 * strwidth(label) y <- ellipse[index, 2] - 0.5 * strheight("A") adj <- c(0, 1) } text(x, y, label, adj=adj, col=col, ...) } if(missing(y)){ if (is.matrix(x) && ncol(x) == 2) { if (missing(xlab)) xlab <- colnames(x)[1] if (missing(ylab)) ylab <- colnames(x)[2] y <- x[,2] x <- x[,1] } else stop("x and y must be vectors, or x must be a 2 column matrix") } else if(!(is.vector(x) && is.vector(y) && length(x) == length(y))) stop("x and y must be vectors of the same length") if (missing(weights)) weights <- rep(1, length(x)) if (length(weights) != length(x)) stop("weights must be of the same length as x and y") if (!missing(groups)){ xlab ylab if (!is.factor(groups)) stop ("groups must be a factor") if (!(length(groups) == length(x))) stop ("groups, x, and y must all be of the same length") if(missing(labels)) labels <- seq(length(x)) valid <- complete.cases(x, y, groups) x <- x[valid] y <- y[valid] weights <- weights[valid] groups <- groups[valid] labels <- labels[valid] group.levels <- levels(groups) result <- vector(length(group.levels), mode="list") names(result) <- group.levels if(draw) { if (!add) { plot(x, y, type="n", xlab=xlab, ylab=ylab, ...) if(grid){ grid(lty=1, equilogs=FALSE) box() } } } for (lev in 1:length(group.levels)){ level <- group.levels[lev] sel <- groups == level result[[lev]] <- dataEllipse(x[sel], y[sel], weights=weights[sel], log=log, levels=levels, center.pch=center.pch, center.cex=center.cex, draw=draw, plot.points=plot.points, add=TRUE, segments=segments, robust=robust, col=rep(col[lev], 2), pch=pch[lev], lwd=lwd, fill=fill, fill.alpha=fill.alpha, labels=labels[sel], id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=col[lev], ellipse.label=group.labels[lev], ...) } return(invisible(result)) } if (length(col) == 1) col <- rep(col, 2) if(draw) { if (!add) { plot(x, y, type="n", xlab=xlab, ylab=ylab, ...) if(grid){ grid(lty=1, equilogs=FALSE) box()} } if (plot.points) points(x, y, col=col[1], pch=pch[1], ...) } dfn <- 2 dfd <- length(x) - 1 if (robust) { use <- weights > 0 v <- cov.trob(cbind(x[use], y[use]), wt=weights[use]) shape <- v$cov center <- v$center } else { v <- cov.wt(cbind(x, y), wt=weights) shape <- v$cov center <- v$center } result <- vector("list", length=length(levels)) names(result) <- levels for (i in seq(along=levels)) { level <- levels[i] radius <- sqrt(dfn * qf(level, dfn, dfd )) result[[i]] <- ellipse(center, shape, radius, log=log, center.pch=center.pch, center.cex=center.cex, segments=segments, col=col[2], lwd=lwd, fill=fill, fill.alpha=fill.alpha, draw=draw, ...) if (!missing(ellipse.label)) { lab <- if (length(ellipse.label) < i) ellipse.label[1] else ellipse.label[i] label.ellipse(result[[i]], lab, col[2], ...) } } if (missing(labels)) labels <- seq(length(x)) showLabels(x, y, labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col) invisible(if (length(levels) == 1) result[[1]] else result) } confidenceEllipse <- function (model, ...) { UseMethod("confidenceEllipse") } confidenceEllipse.lm <- function(model, which.coef, L, levels=0.95, Scheffe=FALSE, dfn, center.pch=19, center.cex=1.5, segments=51, xlab, ylab, col=palette()[2], lwd=2, fill=FALSE, fill.alpha=0.3, draw=TRUE, add=!draw, ...){ if (missing(dfn)) dfn <- if (Scheffe) sum(df.terms(model)) else 2 dfd <- df.residual(model) if (missing(L)){ which.coef <- if(length(coefficients(model)) == 2) c(1, 2) else{ if (missing(which.coef)){ if (has.intercept(model)) c(2,3) else c(1, 2) } else which.coef } coef <- coefficients(model)[which.coef] if (missing(xlab)) xlab <- paste(names(coef)[1], "coefficient") if (missing(ylab)) ylab <- paste(names(coef)[2], "coefficient") shape <- vcov(model)[which.coef, which.coef] } else { res <- makeLinearCombinations(L, coef(model), vcov(model)) coef <- res$coef xlab <- res$xlab ylab <- res$ylab shape <- res$shape } levels <- rev(sort(levels)) result <- vector("list", length=length(levels)) names(result) <- levels for (i in seq(along=levels)){ level <- levels[i] radius <- sqrt(dfn*qf(level, dfn, dfd)) add.plot <- !level==max(levels) | add result[[i]] <- ellipse(coef, shape, radius, add=add.plot, xlab=xlab, ylab=ylab, center.pch=center.pch, center.cex=center.cex, segments=segments, col=col, lwd=lwd, fill=fill, fill.alpha=fill.alpha, draw=draw, ...) } invisible(if (length(levels) == 1) result[[1]] else result) } confidenceEllipse.default <- function(model, which.coef, L, levels=0.95, Scheffe=FALSE, dfn, center.pch=19, center.cex=1.5, segments=51, xlab, ylab, col=palette()[2], lwd=2, fill=FALSE, fill.alpha=0.3, draw=TRUE, add=!draw, ...){ if (missing(L)){ which.coef <- if(length(coefficients(model)) == 2) c(1, 2) else{ if (missing(which.coef)){ if (has.intercept(model)) c(2, 3) else c(1, 2) } else which.coef } coef <- coefficients(model)[which.coef] shape <- vcov(model)[which.coef, which.coef] xlab <- if (missing(xlab)) paste(names(coef)[1], "coefficient") ylab <- if (missing(ylab)) paste(names(coef)[2], "coefficient") } else { res <- makeLinearCombinations(L, coef(model), vcov(model)) coef <- res$coef xlab <- res$xlab ylab <- res$ylab shape <- res$shape } df <- if (!missing(dfn)) dfn else if (Scheffe) sum(df.terms(model)) else 2 levels <- rev(sort(levels)) result <- vector("list", length=length(levels)) names(result) <- levels for (i in seq(along=levels)){ level <- levels[i] radius <- sqrt(qchisq(level, df)) add.plot <- !level==max(levels) | add result[[i]] <- ellipse(coef, shape, radius, add=add.plot, xlab=xlab, ylab=ylab, center.pch=center.pch, center.cex=center.cex, segments=segments, col=col, lwd=lwd, fill=fill, fill.alpha=fill.alpha, draw=draw, ...) } invisible(if (length(levels) == 1) result[[1]] else result) } confidenceEllipse.glm <- function (model, chisq, ...) { sumry <- summary(model) if (missing(chisq)) chisq <- is.null(sumry$dispersion) if (chisq) confidenceEllipse.default(model, ...) else confidenceEllipse.lm(model, ...) } makeLinearCombinations <- function(L, coef, V){ nms <- names(coef) if (is.character(L)){ L <- makeHypothesis(nms, L) L <- L[, -ncol(L)] } if (nrow(L) != 2 || ncol(L) != length(coef)) stop("the hypothesis matrix is the wrong size") coef <- as.vector(L %*% coef) shape <- L %*% V %*% t(L) L.nms <- printHypothesis(L, c(0, 0), nms) names(coef) <- sub(" =.*", "", L.nms) xlab <- names(coef)[1] ylab <- names(coef)[2] list(coef=coef, shape=shape, xlab=xlab, ylab=ylab) } car/R/Contrasts.R0000644000175100001440000000621211253536255013351 0ustar hornikusers# last modified 2 Dec 2002 by J. Fox # all of these functions are adapted from functions in the R base package contr.Treatment <- function (n, base = 1, contrasts = TRUE) { if (is.numeric(n) && length(n) == 1) levs <- 1:n else { levs <- n n <- length(n) } lev.opt <- getOption("decorate.contrasts") pre <- if (is.null(lev.opt)) "[" else lev.opt[1] suf <- if (is.null(lev.opt)) "]" else lev.opt[2] dec <- getOption("decorate.contr.Treatment") dec <- if (!contrasts) "" else if (is.null(dec)) "T." else dec contr.names <- paste(pre, dec, levs, suf, sep="") contr <- array(0, c(n, n), list(levs, contr.names)) diag(contr) <- 1 if (contrasts) { if (n < 2) stop(paste("Contrasts not defined for", n - 1, "degrees of freedom")) if (base < 1 | base > n) stop("Baseline group number out of range") contr <- contr[, -base, drop = FALSE] } contr } contr.Sum <- function (n, contrasts = TRUE) { if (length(n) <= 1) { if (is.numeric(n) && length(n) == 1 && n > 1) levels <- 1:n else stop("Not enough degrees of freedom to define contrasts") } else levels <- n lenglev <- length(levels) lev.opt <- getOption("decorate.contrasts") pre <- if (is.null(lev.opt)) "[" else lev.opt[1] suf <- if (is.null(lev.opt)) "]" else lev.opt[2] dec <- getOption("decorate.contr.Sum") dec <- if (!contrasts) "" else if (is.null(dec)) "S." else dec show.lev <- getOption("contr.Sum.show.levels") contr.names <- if ((is.null(show.lev)) || show.lev) paste(pre, dec, levels, suf, sep="") if (contrasts) { cont <- array(0, c(lenglev, lenglev - 1), list(levels, contr.names[-lenglev])) cont[col(cont) == row(cont)] <- 1 cont[lenglev, ] <- -1 } else { cont <- array(0, c(lenglev, lenglev), list(levels, contr.names)) cont[col(cont) == row(cont)] <- 1 } cont } contr.Helmert <- function (n, contrasts = TRUE) { if (length(n) <= 1) { if (is.numeric(n) && length(n) == 1 && n > 1) levels <- 1:n else stop("contrasts are not defined for 0 degrees of freedom") } else levels <- n lenglev <- length(levels) lev.opt <- getOption("decorate.contrasts") pre <- if (is.null(lev.opt)) "[" else lev.opt[1] suf <- if (is.null(lev.opt)) "]" else lev.opt[2] dec <- getOption("decorate.contr.Helmert") dec <- if (!contrasts) "" else if (is.null(dec)) "H." else dec nms <- if (contrasts) 1:lenglev else levels contr.names <- paste(pre, dec, nms, suf, sep="") if (contrasts) { cont <- array(-1, c(lenglev, lenglev - 1), list(levels, contr.names[-lenglev])) cont[col(cont) <= row(cont) - 2] <- 0 cont[col(cont) == row(cont) - 1] <- 1:(lenglev - 1) } else { cont <- array(0, c(lenglev, lenglev), list(levels, contr.names)) cont[col(cont) == row(cont)] <- 1 } cont } car/R/spreadLevelPlot.R0000644000175100001440000001305611437776501014506 0ustar hornikusers# spread-level plots (J. Fox) # 16 March 2010 by J. Fox: spreadLevelPlot.lm now deletes observations with negative fitted values # 25 May 2010 by J. Fox: corrected errors due to introduction of grid() slp <- function(...) spreadLevelPlot(...) spreadLevelPlot <- function(x, ...) { UseMethod("spreadLevelPlot") } spreadLevelPlot.default <- function(x, by, robust.line=TRUE, start=0, xlab="Median", ylab="Hinge-Spread", point.labels=TRUE, las=par("las"), main=paste("Spread-Level Plot for", deparse(substitute(x)), "by", deparse(substitute(by))), col=palette()[1], col.lines=palette()[2], pch=1, lwd=2, grid=TRUE, ...){ good <- complete.cases(x, by) if (sum(good) != length(x)) { warning("NAs ignored") x <- x[good] by <- by[good] } min.x <- min(x) if (min.x <= -start){ start <- nice(-min.x + 0.05*diff(quantile(x, c(.25, .75))), direction="up") warning(paste("Start =", start," added to avoid 0 or negative values.")) } if (start != 0) { xlab <- paste(xlab, "+", signif(start, getOption("digits"))) x <- x + start } values <- unique(as.character(by)) result <- matrix(0, length(values), 4) dimnames(result) <-list(values, c("LowerHinge", "Median", "UpperHinge", "Hinge-Spread")) for (i in seq(along=values)){ five <- fivenum(x[by == values[i]]) result[i, ] <- c(five[2:4], five[4] - five[2]) } medians<-result[ ,2] spreads<-result[ ,4] plot(medians, spreads, type="n", log="xy", main=main, xlab=xlab, ylab=ylab, las=las, pch=pch, col=col, ...) if(grid){ grid(lty=1, equilogs=FALSE) box()} points(medians, spreads, col=col, pch=pch) pos <- ifelse(medians > median(medians), 2, 4) if (point.labels) text(medians, spreads, as.character(values), pos=pos, ...) mod <- if (robust.line) rlm(log(spreads) ~ log(medians)) else lm(log(spreads) ~ log(medians), ...) ord <- order(medians) first <- ord[1] last <- ord[length(ord)] lines(start + medians[c(first, last)], exp(fitted.values(mod)[c(first, last)]), col=col.lines, lwd=lwd, ...) p <- 1 - (coefficients(mod))[2] names(p) <- NULL result <- list(Statistics=as.data.frame(result[ord,]), PowerTransformation=p) class(result) <- "spreadLevelPlot" result } #spreadLevelPlot.lm <- function(x, start=0, robust.line=TRUE, # xlab="Fitted Values", # ylab="Absolute Studentized Residuals", las=par("las"), # main=paste("Spread-Level Plot for\n", deparse(substitute(x))), # pch=1, col=palette()[2], lwd=2, ...){ # resid <- na.omit(abs(rstudent(x))) # fitval <- na.omit(fitted.values(x)) # min <- min(fitval) # if (min <= -start) { # start<- nice(-min +0.05*diff(quantile(fitval, c(.25, .75))), direction="up") # warning(paste("Start = ", start, # "added to fitted values to avoid 0 or negative values.")) # } # if (start != 0) xlab <- paste(xlab, "+", signif(start, getOption("digits"))) # plot(fitval + start, resid, log="xy", main=main, xlab=xlab, ylab=ylab, # las=las, col=col, pch=pch, ...) # mod <- if (robust.line) # rlm(log(resid) ~ log(fitval + start)) # else lm(log(resid) ~ log(fitval + start), ...) # first <- which.min(fitval) # last <- which.max(fitval) # lines((fitval + start)[c(first, last)], exp(fitted.values(mod)[c(first, last)]), # lwd=lwd, col=col, ...) # p <- 1 - (coefficients(mod))[2] # names(p) <- NULL # result <- list(PowerTransformation=p) # class(result) <- "spreadLevelPlot" # result #} spreadLevelPlot.lm <- function(x, robust.line=TRUE, xlab="Fitted Values", ylab="Absolute Studentized Residuals", las=par("las"), main=paste("Spread-Level Plot for\n", deparse(substitute(x))), pch=1, col=palette()[1], col.lines=palette()[2], lwd=2, grid=TRUE, ...){ resid <- na.omit(abs(rstudent(x))) fitval <- na.omit(fitted.values(x)) non.pos <- fitval <= 0 if (any(non.pos)){ fitval <- fitval[!non.pos] resid <- resid[!non.pos] n.non.pos <- sum(non.pos) warning(n.non.pos, " negative", if(n.non.pos > 1) " fitted values" else " fitted value", " removed") } min <- min(fitval) plot(fitval, resid, log="xy", main=main, xlab=xlab, ylab=ylab, las=las, col=col, pch=pch, type="n", ...) if(grid){ grid(lty=1, equilogs=FALSE) box()} points(fitval, resid, col=col, pch=pch) mod <- if (robust.line) rlm(log(resid) ~ log(fitval)) else lm(log(resid) ~ log(fitval), ...) first <- which.min(fitval) last <- which.max(fitval) lines((fitval)[c(first, last)], exp(fitted.values(mod)[c(first, last)]), lwd=lwd, col=col.lines, ...) p <- 1 - (coefficients(mod))[2] names(p) <- NULL result <- list(PowerTransformation=p) class(result) <- "spreadLevelPlot" result } spreadLevelPlot.formula <- function (x, data=NULL, subset, na.action, main=paste("Spread-Level Plot for", varnames[response], "by", varnames[-response]), ...) { if (missing(na.action)) na.action <- getOption("na.action") m <- match.call(expand.dots = FALSE) m$formula <- x if (is.matrix(eval(m$data, sys.frame(sys.parent())))) m$data <- as.data.frame(data) m$... <- m$main <- m$x <- NULL m[[1]] <- as.name("model.frame") mf <- eval(m, sys.frame(sys.parent())) response <- attr(attr(mf, "terms"), "response") varnames <- names(mf) if (!response) stop ("no response variable specified") if (length(varnames) > 2) stop("right-hand side of model has more than one variable") x <- mf[[response]] by <- mf[[varnames[-response]]] spreadLevelPlot(x, by, main=main, ...) } print.spreadLevelPlot <- function(x, ...){ if (!is.null(x$Statistics)) print(x$Statistics, ...) cat('\nSuggested power transformation: ', x$PowerTransformation,'\n') invisible(x) } car/R/utility-functions.R0000644000175100001440000002671512170045647015113 0ustar hornikusers # Utility functions (J. Fox) # 16 March 2010 changed 'vars' argument to 'terms' # 28 June 2010 added df.terms.surveg and model.matrix.survreg # 15 November 2010 added squeezeBlanks # 21 January 2011 added functions to support mixed models # 2012-04-08 added exists.method # 2012-06-23: added call to globalVariables(). John # 2012-12-10: added .carEnv to avoid warnings in R > 2.16.0 # 2013-06020: added .merMod methods to df.residual() and has.intercept(). John #if (getRversion() >= "2.15.1") globalVariables(c(".boot.sample", ".boot.indices")) .carEnv <- new.env(parent=emptyenv()) # function to find "nice" numbers nice <- function(x, direction=c("round", "down", "up"), lead.digits=1){ direction <- match.arg(direction) if (length(x) > 1) return(sapply(x, nice, direction=direction, lead.digits=lead.digits)) if (x == 0) return(0) power.10 <- floor(log(abs(x),10)) if (lead.digits > 1) power.10 <- power.10 - lead.digits + 1 lead.digit <- switch(direction, round=round(abs(x)/10^power.10), down=floor(abs(x)/10^power.10), up=ceiling(abs(x)/10^power.10)) sign(x)*lead.digit*10^power.10 } has.intercept <- function (model, ...) { UseMethod("has.intercept") } has.intercept.default <- function(model, ...) any(names(coefficients(model))=="(Intercept)") term.names <- function (model, ...) { UseMethod("term.names") } term.names.default <- function (model, ...) { term.names <- labels(terms(model)) if (has.intercept(model)) c("(Intercept)", term.names) else term.names } predictor.names <- function(model, ...) { UseMethod("predictor.names") } predictor.names.default <- function(model, ...){ predictors <- attr(terms(model), "variables") as.character(predictors[3:length(predictors)]) } responseName <- function (model, ...) { UseMethod("responseName") } responseName.default <- function (model, ...) deparse(attr(terms(model), "variables")[[2]]) response <- function(model, ...) { UseMethod("response") } response.default <- function (model, ...) model.response(model.frame(model)) is.aliased <- function(model){ !is.null(alias(model)$Complete) } df.terms <- function(model, term, ...){ UseMethod("df.terms") } df.terms.default <- function(model, term, ...){ if (is.aliased(model)) stop("Model has aliased term(s); df ambiguous.") if (!missing(term) && 1 == length(term)){ assign <- attr(model.matrix(model), "assign") which.term <- which(term == labels(terms(model))) if (0 == length(which.term)) stop(paste(term, "is not in the model.")) sum(assign == which.term) } else { terms <- if (missing(term)) labels(terms(model)) else term result <- numeric(0) for (term in terms) result <- c(result, Recall(model, term)) names(result) <- terms result } } df.terms.multinom <- function (model, term, ...){ nlev <- length(model$lev) if (!missing(term) && 1 == length(term)) { assign <- attr(model.matrix(model), "assign") which.term <- which(term == labels(terms(model))) if (0 == length(which.term)) stop(paste(term, "is not in the model.")) sum(assign == which.term) * (nlev - 1) } else { terms <- if (missing(term)) labels(terms(model)) else term result <- numeric(0) for (term in terms) result <- c(result, Recall(model, term)) names(result) <- terms result } } df.terms.polr <- function (model, term, ...){ if (!missing(term) && 1 == length(term)) { assign <- attr(model.matrix(model), "assign") which.term <- which(term == labels(terms(model))) if (0 == length(which.term)) stop(paste(term, "is not in the model.")) sum(assign == which.term) } else { terms <- if (missing(term)) labels(terms(model)) else term result <- numeric(0) for (term in terms) result <- c(result, Recall(model, term)) names(result) <- terms result } } df.terms.survreg <- function(model, term, ...){ if (is.aliased(model)) stop("Model has aliased term(s); df ambiguous.") if (!missing(term) && 1 == length(term)){ assign <- attr(model.matrix(model, data=model.frame(model)), "assign") which.term <- which(term == labels(terms(model))) if (0 == length(which.term)) stop(paste(term, "is not in the model.")) sum(assign == which.term) } else { terms <- if (missing(term)) labels(terms(model)) else term result <- numeric(0) for (term in terms) result <- c(result, Recall(model, term)) names(result) <- terms result } } model.matrix.survreg <- function(object, ...) model.matrix.default(object, model.frame(object)) 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) } inv <- function(x) solve(x) coefnames2bs <- function(g, para.names, parameterPrefix="b"){ metas <- c("(", ")", "[", "]", "{", "}", ".", "*", "+", "^", "$", ":", "|") metas2 <- paste("\\", metas, sep="") metas3 <- paste("\\\\", metas, sep="") for (i in seq(along=metas)) para.names <- gsub(metas2[i], metas3[i], para.names) # fix up metacharacters para.order <- order(nchar(para.names), decreasing=TRUE) para.names <- para.names[para.order] # avoid partial-name substitution std.names <- if ("(Intercept)" %in% para.names) paste(parameterPrefix, 0:(length(para.names) - 1), sep = "") else paste(parameterPrefix, 1:length(para.names), sep = "") std.names.ordered <- std.names[para.order] for (i in seq(along=para.names)){ g <- gsub(para.names[i], std.names.ordered[i], g) } list(g=g, std.names=std.names) } showLabelsScatter <- function(x, y, labels, id.var = NULL, id.method = c("mahal", "identify", "none"), log="", id.cex=.75, id.n=3, id.col=palette()[1], range.x=range(.x), show=TRUE) { id.method <- match.arg(id.method) if (id.method == "none" || id.n == 0 || !show) return(invisible(NULL)) if(id.n > 0L) { if (missing(labels)) labels <- if (!is.null(id.var)) names(id.var) else as.character(seq(along=x)) getPoints <- function(z) { names(z) <- labels iid <- seq(length=id.n) zs <- z[order(-z)[iid]] match(names(zs), labels) } logged <- function(axis=c("x", "y")){ axis <- match.arg(axis) 0 != length(grep(axis, log)) } valid <- complete.cases(x, y) x <- x[valid] y <- y[valid] labels <- labels[valid] if (length(id.var) == length(valid)) id.var <- id.var[valid] .x <- if (logged("x")) log(x) else x .y <- if (logged("y")) log(y) else y ind <- if (!is.null(id.var)) { if (length(id.var) == length(x)) order(-abs(id.var))[1L:id.n] else if(is.character(id.var)) match(id.var, labels) else id.var } else switch(id.method, x = getPoints(abs(.x - mean(.x))), y = getPoints(abs(.y - mean(.y))), xy = union(getPoints(abs(.x - mean(.x))), getPoints(abs(.y - mean(.y)))), mahal= getPoints(rowSums(qr.Q(qr(cbind(1, .x, .y))) ^ 2))) ind <- na.omit(ind) if (length(ind) == 0) return(invisible(NULL)) labpos <- c(4, 2)[1 + as.numeric(.x > mean(range.x))] text(x[ind], y[ind], labels[ind], cex = id.cex, xpd = TRUE, pos = labpos[ind], offset = 0.25, col=id.col) return(labels[ind]) } } # outerLegend, written by S. Weisberg Feb 2010 # outerLegend function # puts a legend in the margin, either at the upper left (margin = 3) # the default or upper right side otherwise # all the args from legend are used except for x, y, and xpd which are # set in the function. # offset is a fraction of the plot width or height to locate the legend outerLegend <- function(..., margin=3, offset=0, adjust=FALSE){ lims <- par("usr") if (margin == 3) { x0 <- lims[1] + offset*(lims[2]-lims[1]) y0 <- lims[4] } else { x0 <- lims[2] + offset*(lims[2]-lims[1]) y0 <- lims[4] } leg <- legend(x0, y0, ... , xpd=TRUE, plot=FALSE) if (margin == 3) { y0 <- y0 + leg$rect$h if(adjust == TRUE) x0 <- x0 - leg$text$x[1] } legend(x0, y0, ... , xpd=TRUE) } # added by J. Fox 18 Nov 2010 squeezeBlanks <- function(text){ gsub(" *", "", text) } # added by J. Fox 21 Jan 2011 to support mixed models df.residual.mer <- function(object, ...) NULL df.residual.merMod <- function(object, ...) NULL df.residual.lme <- function(object, ...) Inf has.intercept.mer <- function(model){ any(names(fixef(model))=="(Intercept)") } has.intercept.merMod <- function(model){ any(names(fixef(model))=="(Intercept)") } model.matrix.lme <- function(object, ...){ model.matrix(as.formula(object$call$fixed), eval(object$call$data)) } # added by J. Fox 2012-04-08 to use in deltaMethod.default() exists.method <- function(generic, object, default=TRUE, strict=FALSE){ classes <- class(object) if (default) classes <- c(classes, "default") if (strict) classes <- classes[1] any(paste(generic, ".", classes, sep="") %in% as.character(methods(generic))) } # Used by marginalModelPlots, residualPlots added 2012-09-24 plotArrayLegend <- function( location=c("top", "none", "separate"), items, col.items, lty.items, lwd.items, title="legend", pch=1:length(items)) { if(location== "none") return() n <- length(items) if(location == "top" ) { # add legend usr <- par("usr") coords <-list(x=usr[1], y=usr[3]) leg <- legend( coords, items, col=col.items, pch=pch, bty="n", cex=1, xpd=NA, plot=FALSE) coords <- list(x = usr[1], y=usr[4] + leg$rect$h) legend( coords, items, col=col.items, pch=pch, bty="n", cex=1, xpd=NA) } if(location == "separate") { plot(0:1, 0:1, xaxt="n", yaxt="n", xlab="", ylab="", type="n") bg <- par()$bg legend("center", items, lty=lty.items, lwd=lwd.items, fill=col.items, border=col.items,, col=col.items, box.col=par()$bg, title=title) } } termsToMf <- function(model, terms){ gform <- function(formula) { if (is.null(formula)){ return(list(vars=formula, groups=NULL)) } rhs <- formula[[2 + (length(formula) == 3)]] if (class(rhs) == "name"){ return(list(vars=formula, groups=NULL)) } if (length(rhs) == 1){ return(list(vars=formula, groups=NULL)) } if (length(rhs) != 3) stop("bad terms argument") if ("|" != deparse(rhs[[1]])) stop("bad terms argument") vars <- as.formula(paste("~", deparse(rhs[[2]]))) groups <- as.formula(paste("~", deparse(rhs[[3]]))) list(vars=vars, groups=groups) } terms <- gform(as.formula(terms)) mf.vars <- try(update(model, terms$vars, method="model.frame"), silent=TRUE) # This second test is used for models like m1 <- lm(longley) which # fail the first test because update doesn't work if(class(mf.vars) == "try-error") mf.vars <- try(update(model, terms$vars, method="model.frame", data=model.frame(model)), silent=TRUE) if(class(mf.vars) == "try-error") stop("argument 'terms' not interpretable.") if(!is.null(terms$groups)){ mf.groups <- try(update(model, terms$groups, method="model.frame"), silent=TRUE) if(class(mf.groups) == "try-error") mf.groups <- try(update(model, terms$groups, method="model.frame", data=model.frame(model)), silent=TRUE) if(class(mf.groups) == "try-error") stop("argument 'terms' not interpretable.") } else {mf.groups <- NULL} list(mf.vars=mf.vars, mf.groups=mf.groups) } car/R/sigmaHat.R0000644000175100001440000000065611413365341013126 0ustar hornikusers#------------------------------------------------------------------------------- # Revision history: # 2010-07-01: moved from alr3 and renamed. S. Weisberg ## method to return sigmaHat sigmaHat <- function(object){UseMethod("sigmaHat")} sigmaHat.default <- function(object){summary(object)$sigma} sigmaHat.lm <- function(object) sigmaHat.default(object) sigmaHat.glm <- function(object){sqrt(summary(object)$dispersion)}car/R/leveragePlots.R0000644000175100001440000000662011576447475014225 0ustar hornikusers# Leverage plots (J. Fox) # last modified 9 October 2009 by J. Fox # modified 25 November for layout and marking points only # changed 'vars' to 'terms' 16 March 2010 SW # 14 April 2010: set id.n = 0. J. Fox # 15 August 2010 S. Weisberg, added col.lines and col arguments # 5 Sept 2010 J. Fox, pass ... down to plot() and points() etc. # 16 June 2011 allow layout=NA, in which case the layout is not set in this # function, so it is the responsibility of the user # these functions to be rewritten; simply renamed for now leveragePlots <- function(model, terms= ~ ., layout=NULL, ask, main, ...){ terms <- if(is.character(terms)) paste("~",terms) else terms vform <- update(formula(model),terms) terms.model <- attr(attr(model.frame(model), "terms"), "term.labels") terms.vform <- attr(terms(vform), "term.labels") good <- terms.model[match(terms.vform, terms.model)] nt <- length(good) if (nt == 0) stop("No plots specified") if (missing(main)) main <- if (nt == 1) "Leverage Plot" else "Leverage Plots" nr <- 0 if (nt > 1 & (is.null(layout) || is.numeric(layout))) { if(is.null(layout)){ layout <- switch(min(nt, 9), c(1, 1), c(1, 2), c(2, 2), c(2, 2), c(3, 2), c(3, 2), c(3, 3), c(3, 3), c(3, 3)) } ask <- if(missing(ask) || is.null(ask)) prod(layout) 1 & (is.null(layout) || is.numeric(layout))) { if(is.null(layout)){ layout <- switch(min(nt, 9), c(1, 1), c(1, 2), c(2, 2), c(2, 2), c(3, 2), c(3, 2), c(3, 3), c(3, 3), c(3, 3)) } ask <- if(missing(ask) || is.null(ask)) prod(layout) < nt else ask oma3 <- if(legend == "top") 0.5 + estPoint + estDensity + estNormal else 1.5 op <- par(mfrow=layout, ask=ask, no.readonly=TRUE, oma=c(0, 0, oma3, 0), mar=c(5, 4, 1, 2) + .1) on.exit(par(op)) } if(ci != "none") clim <- confint(x, method=ci, level=level) pn <- colnames(x$t) names(pn) <- pn what <- c(estNormal & !freq, estDensity & !freq, ci != "none", estPoint) for (j in parm){ # determine the range of the y-axis z <- na.omit(x$t[, j]) h <- hist(z, plot=FALSE) d <- density(z) n <- pnorm(0)/(sd <- sd(z)) m <- if(freq == FALSE) max(h$density, d$y, n) else max(h$counts) plot(h, xlab=pn[j], freq=freq, main=if(length(parm)==1) main else "", ylim=c(0, m), ...) if(estDensity & !freq){ lines(d, col=den.col, lty=den.lty, lwd=den.lwd) } if(estNormal & !freq){ z <- na.omit(x$t[, j]) xx <- seq(-4, 4, length=400) xbar <- mean(z) sd <- sd(z) lines( xbar + sd*xx, dnorm(xx)/sd, col=nor.col, lty=nor.lty, lwd=nor.lwd) } if(ci != "none") lines( clim[j ,], c(0, 0), lwd=4) if(estPoint) abline(v=pe[j], lty=point.lty, col=point.col, lwd=point.lwd) if(box) box() if( j == parm[1] & legend == "top" ) { # add legend usr <- par("usr") legend.coords <- list(x=usr[1], y=usr[4] + 1.3 * (1 + sum(what)) *strheight("N")) legend( legend.coords, c("Normal Density", "Kernel Density", paste(ci, " ", round(100*level), "% CI", sep=""), "Obs. Value")[what], lty=c(nor.lty, den.lty, 1, point.lty)[what], col=c(nor.col, den.col, "black", point.col)[what], fill=c(nor.col, den.col, "black", point.col)[what], lwd=c(2, 2, 4, 2)[what], border=c(nor.col, den.col, "black", point.col)[what], bty="n", cex=0.9, xpd=NA)#, #horiz=TRUE, offset= } } mtext(side=3, outer=TRUE, main, cex=1.2) if(legend == "separate") { plot(0:1, 0:1, xaxt="n", yaxt="n", xlab="", ylab="", type="n") use <- (1:4)[c( estNormal, estDensity, TRUE, ci != "none")] curves <- c("fitted normal density", "Kernel density est", paste(100*level, "% ", ci, " confidence interval", sep=""), "Observed value of statistic") colors <- c(nor.col, den.col, "black", point.col) lines <- c(nor.lty, den.lty, 1, point.lty) widths<- c(nor.lwd, den.lwd, 2, point.lty) legend("center", curves[use], lty=lines[use], lwd=widths[use], col=colors[use], box.col=par()$bg, title="Bootstrap histograms") } invisible(NULL) } car/R/residualPlots.R0000644000175100001440000002201212122706625014213 0ustar hornikusers# Modified Nov. 24, 2009 by S. Weisberg to use showLabels # rather than showExtremes # 11 & 20 January 2010: changed lty=3 to lty=1 for fitted curve. J. Fox # 14 April 2010: set id.n = 0. J. Fox # 15 April 2010; rewrite showLabels # 25 May 2010 added grid() to plots, S. Weisberg # 15 August 2010, fixed so col= works correctly with plot, but not Boxplot # 15 August 2010, deleted pch= argument, as it wasn't used # 17 January 2011, allow spline terms; plot against # predict(model, type="terms")[[term.name]] # 1 February 2011 default for AsIs changed to TRUE # 31 March 2011 tukeyNonaddTest updated to check that yhat^2 is not # a linear combination of other predictors (as in 1-way anova). # 6 April 2011 omit printing lack-of-fit if no lack-of-fit test is possible # 16 June 2011 allow layout=NA, in which case the layout is not set in this # function, so it is the responsibility of the user # 10 Feb 2013: adjusted colinearity check in tukeyNonaddTest # 21 March 2013: fixed nonconstant variance test with missing values for glms residualPlots <- function(model, ...){UseMethod("residualPlots")} residualPlots.default <- function(model, terms= ~ . , layout=NULL, ask, main="", fitted=TRUE, AsIs=TRUE, plot=TRUE, tests=TRUE, ...){ mf <- attr(model.frame(model), "terms") vform <- update(formula(model), terms) if(any(is.na(match(all.vars(vform), all.vars(formula(model)))))) stop("Only predictors in the formula can be plotted.") terms <- attr(mf, "term.labels") # this is a list vterms <- attr(terms(vform), "term.labels") # drop interactions (order > 1) vterms <- setdiff(vterms, terms[attr(mf, "order") > 1]) # keep only terms that are numeric or integer or factors or poly good <- NULL for (term in vterms) if( (AsIs == TRUE & inherits(model$model[[term]], "AsIs")) | inherits(model$model[[term]], "numeric") | inherits(model$model[[term]], "integer") | inherits(model$model[[term]], "factor") | inherits(model$model[[term]], "matrix") | inherits(model$model[[term]], "poly")) good <- c(good, term) nt <- length(good) + fitted nr <- 0 if (nt == 0) stop("No plots specified") if (nt > 1 & plot == TRUE & (is.null(layout) || is.numeric(layout))) { if(is.null(layout)){ layout <- switch(min(nt, 9), c(1, 1), c(1, 2), c(2, 2), c(2, 2), c(3, 2), c(3, 2), c(3, 3), c(3, 3), c(3, 3)) } ask <- if(missing(ask) || is.null(ask)) prod(layout)|t|)") return(if(tests == FALSE) invisible(ans) else if(all(is.na(ans))) warning("No possible lack-of-fit tests") else round(ans, 3)) } else invisible(NULL) } residualPlots.lm <- function(model, ...) { residualPlots.default(model, ...) } residualPlots.glm <- function(model, ...) { residualPlots.default(model, ...) } residualPlot <- function(model, ...) UseMethod("residualPlot") residualPlot.default <- function(model, variable = "fitted", type = "pearson", plot = TRUE, quadratic = TRUE, smoother=NULL, smoother.args=list(), col.smooth=palette()[3], labels, id.method = "y", id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], col = palette()[1], col.quad = palette()[2], xlab, ylab, lwd = 1, lty = 1, grid=TRUE, ...) { string.capitalize <- function(string) { paste(toupper(substring(string, 1, 1)), substring(string, 2), sep="")} if(missing(labels)) labels <- names(residuals(model)[!is.na(residuals(model))]) ylab <- if(!missing(ylab)) ylab else paste(string.capitalize(type), "residuals") column <- match(variable, names(model$model)) if(is.na(column) && variable != "fitted") stop(paste(variable, "is not a term in the mean function")) horiz <- if(variable == "fitted") predict(model) else model$model[[column]] lab <- if(variable == "fitted") { if(inherits(model, "glm")) "Linear Predictor" else "Fitted values"} else variable lab <- if(!missing(xlab)) xlab else lab if(class(horiz)[1] == "ordered") horiz <- factor(horiz, ordered=FALSE) ans <- if(inherits(horiz, "poly")) { horiz <- horiz[ , 1] lab <- paste("Linear part of", lab) c(NA, NA)} else if (inherits(horiz, "matrix")) { horiz <- try(predict(model, type="terms"), silent=TRUE) if(class(horiz) == "try-error") stop("Could not plot spline terms") warning("Splines replaced by a fitted linear combination") horiz <- horiz[ , variable] c(NA, NA) } else if (inherits(horiz, "factor")) c(NA, NA) else residCurvTest(model, variable) # ans <- if (class(horiz) != "factor") else c(NA, NA) if(plot==TRUE){ vert <- switch(type, "rstudent"=rstudent(model), "rstandard"=rstandard(model), residuals(model, type=type)) if(class(horiz) == "factor") { idm <- if(is.list(id.method)) { lapply(id.method, function(x) if(x[1]=="xy") "y" else x)} else { if(id.method[1] == "xy") "y"} Boxplot(vert, horiz, xlab=lab, ylab=ylab, labels=labels, id.method=idm, id.n=id.n, id.cex=id.cex, id.col=id.col, ...) abline(h=0, lty=2) } else { plot(horiz, vert, xlab=lab, ylab=ylab, ...) if(grid){ grid(lty=1, equilogs=FALSE) box()} points(horiz, vert, col=col, ...) abline(h=0, lty=2) if(quadratic==TRUE){ new <- seq(min(horiz), max(horiz), length=200) if(length(unique(horiz)) > 2){ lm2 <- lm(residuals(model, type="pearson")~poly(horiz, 2)) lines(new, predict(lm2, list(horiz=new)), lty=1, lwd=2, col=col.quad) }} if(is.function(smoother)) smoother(horiz, vert, col.smooth, log.x=FALSE, log.y=FALSE, spread=FALSE, smoother.args=smoother.args) showLabels(horiz, vert, labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col) } } invisible(ans)} residCurvTest <- function(model, variable) {UseMethod("residCurvTest")} residCurvTest.lm <- function(model, variable) { if(variable == "fitted") tukeyNonaddTest(model) else { if(is.na(match(variable, attr(model$terms, "term.labels")))) stop(paste(variable, "is not a term in the mean function")) else { xsqres <- qr.resid(model$qr, model.frame(model)[[variable]]^2) r <- residuals(model, type="pearson") m1 <- lm(r ~ xsqres, weights=weights(model)) df.correction <- sqrt((df.residual(model)-1) / df.residual(m1)) test <- summary(m1)$coef[2, 3] * df.correction c(Test=test, Pvalue=2 * pt(-abs(test), df.residual(model)-1)) }}} residCurvTest.glm <- function(model, variable) { if(variable == "fitted") c(NA, NA) else { if(is.na(match(variable, attr(model$terms, "term.labels")))) stop(paste(variable, "is not a term in the mean function")) else { newmod <- paste(" ~ . + I(", variable, "^2)") m2 <- update(model, newmod, start=NULL) c(Test= test<-deviance(model)-deviance(m2), Pvalue=1-pchisq(test, 1)) }}} tukeyNonaddTest <- function(model){ tol <- model$qr$tol qr <- model$qr fitsq <- predict(model, type="response")^2 fitsq <- qr.resid(qr, fitsq/sqrt(sum(fitsq^2))) if(sd(fitsq) < tol) { return(c(Test=NA, Pvalue=NA)) } else { r <- residuals(model, type="pearson") m1 <- lm(r ~ fitsq, weights=weights(model)) df.correction <- sqrt((df.residual(model) - 1)/df.residual(m1)) tukey <- summary(m1)$coef[2, 3] * df.correction c(Test=tukey, Pvalue=2*pnorm(-abs(tukey))) } } residualPlot.lm <- function(model, ...) { residualPlot.default(model, ...) } residualPlot.glm <- function(model, variable = "fitted", type = "pearson", plot = TRUE, quadratic = FALSE, smoother = loessLine, smoother.args=list(k=3), ...) { residualPlot.default(model, variable=variable, type=type, plot=plot, quadratic=quadratic, smoother=smoother, smoother.args=smoother.args, ...) } car/R/symbox.R0000644000175100001440000000235612204420315012701 0ustar hornikusers# 2010-09-05: J. Fox: allow xlab argument, pass through ... # 2013-08-19: J. Fox: remove loading of stats package symbox <- function(x, ...){ UseMethod("symbox") } symbox.formula <- function(formula, data=NULL, subset, na.action=NULL, ylab, ...){ variable <- all.vars(formula) if (length(variable) != 1) stop("the formula must specify one variable") m <- match.call(expand.dots = FALSE) if (is.matrix(eval(m$data, parent.frame()))) m$data <- as.data.frame(data) m$ylab <- m$... <- NULL m$na.action <- na.action m[[1]] <- as.name("model.frame") mf <- eval(m, parent.frame()) if (missing(ylab)) ylab <- paste("Transformations of", variable) symbox(as.vector(mf[[1]]), ylab=ylab, ...) } symbox.default <- function(x, powers = c(-1, -0.5, 0, 0.5, 1), start=0, trans=bcPower, xlab="Powers", ylab, ...) { if (!(is.vector(x) && is.numeric(x))) stop("x should be a numeric vector.") if (missing(ylab)) ylab <- deparse(substitute(x)) x <- x + start result <- lapply(powers, function(lambda) trans(x, lambda)) names <- as.character(powers) names[powers == 0] <- "log" names(result) <- names result <- as.data.frame(scale(do.call(cbind, result))) boxplot(result, xlab=xlab, ylab=ylab, yaxt="n", ...) } car/R/leveneTest.R0000644000175100001440000000321311520551612013474 0ustar hornikusers# moved from Rcmdr 13 July 2004 # levene.test.default function slightly modified and generalized from Brian Ripley via R-help # the original generic version was contributed by Derek Ogle # last modified 28 January 2010 by J. Fox leveneTest <- function (y, ...) { UseMethod("leveneTest") } leveneTest.default <- function (y, group, center=median, ...) { # original levene.test if (!is.numeric(y)) stop(deparse(substitute(y)), " is not a numeric variable") if (!is.factor(group)) { warning(deparse(substitute(group)), " coerced to factor.") group <- as.factor(group) } valid <- complete.cases(y, group) meds <- tapply(y[valid], group[valid], center, ...) resp <- abs(y - meds[group]) table <- anova(lm(resp ~ group))[, c(1, 4, 5)] rownames(table)[2] <- " " dots <- deparse(substitute(...)) attr(table, "heading") <- paste("Levene's Test for Homogeneity of Variance (center = ", deparse(substitute(center)), if(!(dots == "NULL")) paste(":", dots), ")", sep="") table } leveneTest.formula <- function(y, data, ...) { form <- y mf <- if (missing(data)) model.frame(form) else model.frame(form, data) if (any(sapply(2:dim(mf)[2], function(j) is.numeric(mf[[j]])))) stop("Levene's test is not appropriate with quantitative explanatory variables.") y <- mf[,1] if(dim(mf)[2]==2) group <- mf[,2] else { if (length(grep("\\+ | \\| | \\^ | \\:",form))>0) stop("Model must be completely crossed formula only.") group <- interaction(mf[,2:dim(mf)[2]]) } leveneTest.default(y=y, group=group, ...) } leveneTest.lm <- function(y, ...) { leveneTest.formula(formula(y), data=model.frame(y), ...) } car/R/hccm.R0000644000175100001440000000435611737324344012313 0ustar hornikusers#------------------------------------------------------------------------------- # Revision history: # 2009-09-16: optionally allow models with aliased coefficients J. Fox # 2012-04-04: modified to allow weighted linear models. J. Fox #------------------------------------------------------------------------------- # Heteroscedasticity-corrected standard errors (White adjustment) (J. Fox) hccm <- function(model, ...){ #last modified 12 Dec 2000 by J. Fox UseMethod("hccm") } #hccm.lm <- function (model, type = c("hc3", "hc0", "hc1", "hc2", "hc4"), # singular.ok=TRUE, ...) { # if (!is.null(weights(model))) # stop("requires unweighted lm") # type <- match.arg(type) # if (any(aliased <- is.na(coef(model))) && !singular.ok) # stop("there are aliased coefficients in the model") # sumry <- summary(model, corr = FALSE) # s2 <- sumry$sigma^2 # V <- sumry$cov.unscaled # if (type == FALSE) # return(s2 * V) # e <- na.omit(residuals(model)) # X <- model.matrix(model)[, !aliased] # df.res <- df.residual(model) # n <- length(e) # h <- hat(X) # p <- ncol(X) # factor <- switch(type, hc0 = 1, hc1 = df.res/n, hc2 = 1 - # h, hc3 = (1 - h)^2, hc4 = (1 - h)^pmin(4, n * h/p)) # V %*% t(X) %*% apply(X, 2, "*", (e^2)/factor) %*% V #} hccm.lm <-function (model, type = c("hc3", "hc0", "hc1", "hc2", "hc4"), singular.ok = TRUE, ...) { e <- na.omit(residuals(model)) removed <- attr(e, "na.action") wts <- if (is.null(weights(model))) 1 else weights(model) type <- match.arg(type) if (any(aliased <- is.na(coef(model))) && !singular.ok) stop("there are aliased coefficients in the model") sumry <- summary(model, corr = FALSE) s2 <- sumry$sigma^2 V <- sumry$cov.unscaled if (type == FALSE) return(s2 * V) h <- hatvalues(model) if (!is.null(removed)){ wts <- wts[-removed] h <- h[-removed] } X <- model.matrix(model)[, !aliased] df.res <- df.residual(model) n <- length(e) e <- wts*e p <- ncol(X) factor <- switch(type, hc0 = 1, hc1 = df.res/n, hc2 = 1 - h, hc3 = (1 - h)^2, hc4 = (1 - h)^pmin(4, n * h/p)) V %*% t(X) %*% apply(X, 2, "*", (e^2)/factor) %*% V } hccm.default<-function(model, ...){ #last modified 12 Dec 2000 by J. Fox stop("requires an lm object") } car/R/invTranPlot.R0000644000175100001440000001063311777553003013654 0ustar hornikusers# Modified 25 Nov 2009 for point marking # 20 Jan 2010: changed line types. J. Fox # 15 August 2010: fixed colors of points # 18 January 2011; added robust M estimation invTranPlot <- function(x,...) UseMethod("invTranPlot") invTranPlot.formula <- function(x, data, subset, na.action, ...) { mf <- call <- match.call() m <- match(c("x", "data", "subset", "na.action"), names(mf), 0L) mf <- mf[c(1L,m)] mf$drop.unused.levels <- TRUE mf[[1L]] <- as.name("model.frame") names(mf)[which(names(mf)=="x")] <- "formula" mf <- eval(mf, parent.frame()) if(dim(mf)[2] != 2) stop("Formula must be of the form y ~ x") vx <- mf[,2] vy <- mf[,1] if( is.null(call$xlab) & is.null(call$ylab)) invTranPlot(vx,vy,xlab=colnames(mf)[2],ylab=colnames(mf)[1],...) else if(is.null(call$xlab) & !is.null(call$ylab)) invTranPlot(vx,vy,xlab=colnames(mf)[2],...) else if(!is.null(call$xlab) & is.null(call$ylab)) invTranPlot(vx,vy,ylab=colnames(mf)[1],...) else invTranPlot(vx,vy,...) } invTranPlot.default<- function(x, y, lambda=c(-1, 0, 1), robust=FALSE, lty.lines=rep(c("solid", "dashed", "dotdash", "longdash", "twodash"), length=1 + length(lambda)), lwd.lines=2, col=palette()[1], col.lines=palette(), xlab=deparse(substitute(x)), ylab=deparse(substitute(y)), family="bcPower", optimal=TRUE, key="auto", id.method = "x", labels, id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], grid=TRUE, ...){ if (missing(labels)) labels <- seq(length(x)) if (is.factor(x)) stop("Predictor variable may not be a factor") if (is.factor(y)) stop("Response variable may not be a factor") if (optimal){ opt <- invTranEstimate(x, y, family=family, confidence=FALSE, robust=robust) lam <- c(opt$lambda, lambda)} else lam <- lambda fam <- match.fun(family) plot(x, y, xlab=xlab, ylab=ylab, type="n", col=col, ...) if(grid){ grid(lty=1, equilogs=FALSE) box()} points(x, y, col=col, ...) rss <- NULL new <- seq(min(x, na.rm=TRUE), max(x,na.rm=TRUE), length=100) for (j in 1:length(lam)){ m1 <- if(robust) rlm(y ~ fam(x, lam[j])) else lm(y~fam(x, lam[j])) rss <- c(rss, sum(residuals(m1)^2)) lines(new,predict(m1, data.frame(x=new)), lty=lty.lines[j], col=col.lines[j], lwd=lwd.lines)} showLabels(x, y, labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col) if (!is.null(key)) { loc <- key if(length(lam) <= 4) { lims <- par("usr")[c(1,4)] llam <- expression(paste(hat(lambda), ":")) text(lims[1],lims[2], llam, xpd=TRUE, pos=3) outerLegend( as.character(round(lam,2)), lwd=lwd.lines, lty=lty.lines, col=col.lines, bty="n", cex=0.85, fill=col.lines, border=col.lines, horiz=TRUE, adjust=FALSE)} else { legend(ifelse(cor(x, y)>0,"bottomright","topright"), legend = c(expression(hat(lambda)),as.character(round(lam,2))), lwd=lwd.lines, lty=c("blank", lty.lines), col=c("#00000000",col.lines), inset=0.02, cex=0.75, fill=c("#00000000",col.lines), border=c("#00000000",col.lines)) }} data.frame(lambda=lam, RSS=rss) } invTranEstimate <- function(x, y, family="bcPower", confidence=0.95, robust=FALSE){ if (is.factor(x)) stop("Predictor variable may not be a factor") if (is.factor(y)) stop("Response variable may not be a factor") if (robust) confidence <- FALSE fam <- match.fun(family) f <- if(robust==FALSE) function(lambda,x,y,family){deviance(lm(y~fam(x,lambda)))} else function(lambda,x,y,family){sum(residuals(rlm(y ~ fam(x,lambda)))^2)} lhat <- optimize(f = function(lambda) f(lambda,x,y,family),interval=c(-10,10)) if (confidence==FALSE){ return(list(lambda=lhat$minimum)) } else { g <- lm(y~fam(x,lhat$minimum)) n = length(residuals(g)) dev0 <- -n*log(deviance(g)) cutoff <- qchisq(confidence,1)/2 f1 <- function(lam) abs(dev0 + n*log(deviance(lm(y~fam(x,lam)))) -cutoff) lowlim <- optimize(f1, interval=c(-10,lhat$minimum)) hilim <- optimize(f1, interval=c(lhat$minimum,10)) return(list(lambda=lhat$minimum,lowerCI=lowlim$minimum,upperCI=hilim$minimum))} } car/R/scatterplotSmoothers.R0000644000175100001440000001677312027126234015646 0ustar hornikusers# Scatterplot Smoothers (J. Fox and S. Weisberg) # Sept 17, 2012 moved from scatterplot.R to scatterplotSmoothers.R default.arg <- function(args.list, arg, default){ if (is.null(args.list[[arg]])) default else args.list[[arg]] } loessLine <- function(x, y, col, log.x, log.y, spread=FALSE, smoother.args, draw=TRUE) { lty <- default.arg(smoother.args, "lty", 1) lwd <- default.arg(smoother.args, "lwd", 2) lty.spread <- default.arg(smoother.args, "lty.spread", 2) lwd.spread <- default.arg(smoother.args, "lwd.spread", 1) span <- default.arg(smoother.args, "span", 0.5) family <- default.arg(smoother.args, "family", "symmetric") degree <- default.arg(smoother.args, "degree", 2) iterations <- default.arg(smoother.args, "iterations", 4) if (log.x) x <- log(x) if (log.y) y <- log(y) valid <- complete.cases(x, y) x <- x[valid] y <- y[valid] ord <- order(x) x <- x[ord] y <- y[ord] warn <- options(warn=-1) on.exit(options(warn)) # mean smooth fit <- try(loess(y ~ x, span=span, family=family, degree=degree, control=loess.control(iterations=iterations)), silent=TRUE) if (class(fit)[1] != "try-error"){ if (log.x) x <- exp(x) y <- if (log.y) exp(fitted(fit)) else fitted(fit) if(draw)lines(x, y, lwd=lwd, col=col, lty=lty) else out <- list(x=x, y=y) } else{ options(warn) warning("could not fit smooth") return()} # spread smooth, if requested if(spread) { res <- residuals(fit) pos <- res > 0 pos.fit <- try(loess(res^2 ~ x, span=span, degree=0, family=family, subset=pos, control=loess.control(iterations=1)), silent=TRUE) neg.fit <- try(loess(res^2 ~ x, span=span, degree=0, family=family, subset=!pos, control=loess.control(iterations=1)), silent=TRUE) if(class(pos.fit)[1] != "try-error"){ y.pos <- if (log.y) exp(fitted(fit)[pos] + sqrt(fitted(pos.fit))) else fitted(fit)[pos] + sqrt(fitted(pos.fit)) if(draw) lines(x[pos], y.pos, lwd=lwd.spread, lty=lty.spread, col=col) else {out$x.pos <- x[pos] out$y.pos <- y.pos} } else{ options(warn) warning("coud not fit positive part of the spread") } if(class(neg.fit)[1] != "try-error"){ y.neg <- if (log.y) exp(fitted(fit)[!pos] - sqrt(fitted(neg.fit))) else fitted(fit)[!pos] - sqrt(fitted(neg.fit)) if(draw) lines(x[!pos], y.neg, lwd=lwd.spread, lty=lty.spread, col=col) else {out$x.neg <- x[!pos] out$y.neg <- y.neg} } else {options(warn) warning("cound not fit negative part of the spread") } } if(!draw) return(out) } gamLine <- function(x, y, col, log.x, log.y, spread=FALSE, smoother.args, draw=TRUE) { if (!require(mgcv)) stop("mgcv package missing") lty <- default.arg(smoother.args, "lty", 1) lwd <- default.arg(smoother.args, "lwd", 2) lty.spread <- default.arg(smoother.args, "lty.spread", 2) lwd.spread <- default.arg(smoother.args, "lwd.spread", 1) family <- default.arg(smoother.args, "family", gaussian) k <- default.arg(smoother.args, "k", -1) bs <- default.arg(smoother.args, "bs", "tp") if (is.character(family)) family <- eval(parse(text=family)) link <- default.arg(smoother.args, "link", NULL) weights <- default.arg(smoother.args, "weights", NULL) spread <- spread && identical(family, gaussian) && is.null(link) if (log.x) x <- log(x) if (log.y) y <- log(y) valid <- complete.cases(x, y) x <- x[valid] y <- y[valid] ord <- order(x) x <- x[ord] y <- y[ord] w <-if (is.null(weights)) rep(1, length(y)) else weights[valid][ord] warn <- options(warn=-1) on.exit(options(warn)) fit <- try(if (is.null(link)) gam(y ~ s(x, k=k, bs=bs), weights=w, family=family) else gam(y ~ s(x, k=k, bs=bs), weights=w, family=family(link=link)), silent=TRUE) if (class(fit)[1] != "try-error"){ if (log.x) x <- exp(x) y <- if (log.y) exp(fitted(fit)) else fitted(fit) if (draw) lines(x, y, lwd=lwd, col=col, lty=lty) else out <- list(x=x, y=y) } else{ options(warn) warning("could not fit smooth") return()} if(spread) { res <- residuals(fit) pos <- res > 0 pos.fit <- try(gam(res^2 ~ s(x, k=k, bs=bs), subset=pos), silent=TRUE) neg.fit <- try(gam(res^2 ~ s(x, k=k, bs=bs), subset=!pos), silent=TRUE) if(class(pos.fit)[1] != "try-error"){ y.pos <- if (log.y) exp(fitted(fit)[pos] + sqrt(fitted(pos.fit))) else fitted(fit)[pos] + sqrt(fitted(pos.fit)) if(draw) lines(x[pos], y.pos, lwd=lwd.spread, lty=lty.spread, col=col) else {out$x.pos <- x[pos] out$y.pos <- y.pos} } else{ options(warn) warning("coud not fit positive part of the spread") } if(class(neg.fit)[1] != "try-error"){ y.neg <- if (log.y) exp(fitted(fit)[!pos] - sqrt(fitted(neg.fit))) else fitted(fit)[!pos] - sqrt(fitted(neg.fit)) if(draw) lines(x[!pos], y.neg, lwd=lwd.spread, lty=lty.spread, col=col) else {out$x.neg <- x[!pos] out$y.neg <- y.neg} } else {options(warn) warning("cound not fit negative part of the spread") } } if(!draw) return(out) } quantregLine <- function(x, y, col, log.x, log.y, spread=FALSE, smoother.args, draw=TRUE) { if (!require(quantreg)) stop("quantreg package missing") lty <- default.arg(smoother.args, "lty", 1) lwd <- default.arg(smoother.args, "lwd", 2) lty.spread <- default.arg(smoother.args, "lty.spread", 2) lwd.spread <- default.arg(smoother.args, "lwd.spread", 1) if (log.x) x <- log(x) if (log.y) y <- log(y) lambda <- default.arg(smoother.args, "lambda", IQR(x)) valid <- complete.cases(x, y) x <- x[valid] y <- y[valid] ord <- order(x) x <- x[ord] y <- y[ord] if (!spread){ fit <- rqss(y ~ qss(x, lambda=lambda)) if (log.x) x <- exp(x) y <-if (log.y) exp(fitted(fit)) else fitted(fit) if(draw) lines(x, y, lwd=lwd, col=col, lty=lty) else out <- list(x=x, y=x) } else{ fit <- rqss(y ~ qss(x, lambda=lambda)) q1fit <- rqss(y ~ qss(x, lambda=lambda), tau=0.25) q3fit <- rqss(y ~ qss(x, lambda=lambda), tau=0.75) if (log.x) x <- exp(x) y <- if (log.y) exp(fitted(fit)) else fitted(fit) if(draw) lines(x, y, lwd=lwd, col=col, lty=lty) else out <- list(x=x, y=y) y.q1 <- if (log.y) exp(fitted(q1fit)) else fitted(q1fit) if(draw) lines(x, y.q1, lwd=lwd.spread, lty=lty.spread, col=col) else {out$x.neg <- x out$y.neg <- y.q1} y.q3 <- if (log.y) exp(fitted(q3fit)) else fitted(q3fit) if(draw) lines(x, y.q3, lwd=lwd.spread, lty=lty.spread, col=col) else {out$x.neg <- x out$y.neg <- y.q1} } if(!draw) return(out) } car/R/dfbetaPlots.R0000644000175100001440000001046411576447475013661 0ustar hornikusers# added 13 March 2010 by J. Fox # modified 2 Sept 2010 by J. Fox, made colors, axes lables, and # arguments more consistent with other functions; ... passes args to plot dfbetasPlots <- function(model, ...){ UseMethod("dfbetasPlots") } dfbetasPlots.lm <- function(model, terms= ~ ., intercept=FALSE, layout=NULL, ask, main, xlab, ylab, labels=rownames(dfbeta), id.method="y", id.n=if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], col=palette()[1], grid=TRUE, ...){ terms <- if(is.character(terms)) paste("~",terms) else terms vform <- update(formula(model),terms) if(any(is.na(match(all.vars(vform), all.vars(formula(model)))))) stop("Only predictors in the formula can be plotted.") terms.model <- attr(attr(model.frame(model), "terms"), "term.labels") terms.vform <- attr(terms(vform), "term.labels") terms.used <- match(terms.vform, terms.model) mm <- model.matrix(model) model.names <- attributes(mm)$dimnames[[2]] model.assign <- attributes(mm)$assign good <- model.names[!is.na(match(model.assign, terms.used))] if (intercept) good <- c("(Intercept)", good) nt <- length(good) if (nt == 0) stop("No plots specified") if (missing(main)) main <- if (nt == 1) "dfbetas Plot" else "dfbetas Plots" if (missing(xlab)) xlab <- "Index" autolabel <- missing(ylab) if (nt > 1 & (is.null(layout) || is.numeric(layout))) { if(is.null(layout)){ layout <- switch(min(nt, 9), c(1, 1), c(1, 2), c(2, 2), c(2, 2), c(3, 2), c(3, 2), c(3, 3), c(3, 3), c(3, 3)) } ask <- if(missing(ask) || is.null(ask)) prod(layout) 1 & (is.null(layout) || is.numeric(layout))) { if(is.null(layout)){ layout <- switch(min(nt, 9), c(1, 1), c(1, 2), c(2, 2), c(2, 2), c(3, 2), c(3, 2), c(3, 3), c(3, 3), c(3, 3)) } ask <- if(missing(ask) || is.null(ask)) prod(layout) cutoff, col[2], col[1])) points(hatval, rstud, cex=scale*cook, ...) if(id.method != "identify"){ which.rstud <- order(abs(rstud), decreasing=TRUE)[1:id.n] which.cook <- order(cook, decreasing=TRUE)[1:id.n] which.hatval <- order(hatval, decreasing=TRUE)[1:id.n] which.all <- union(which.rstud, union(which.cook, which.hatval)) id.method <- which.all } noteworthy <- showLabels(hatval, rstud, labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col) if (length(noteworthy > 0)) return(data.frame(StudRes=rstud[noteworthy], Hat=hatval[noteworthy], CookD=cook[noteworthy])) } car/R/infIndexPlot.R0000644000175100001440000000426711452676100013777 0ustar hornikusers# influence index plot written 9 Dec 09 by S. Weisberg # 21 Jan 10: added wrapper influenceIndexPlot(). J. Fox # 30 March 10: bug-fixes and changed arguments, S. Weisberg influenceIndexPlot <- function(model, ...) {UseMethod("infIndexPlot")} infIndexPlot <- function(model, ...) {UseMethod("infIndexPlot")} infIndexPlot.lm <- function(model, vars=c("Cook", "Studentized", "Bonf", "hat"), main="Diagnostic Plots", labels, id.method = "y", id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], grid=TRUE, ...) { what <- pmatch(tolower(vars), tolower(c("Cook", "Studentized", "Bonf", "hat"))) if(length(what) < 1) stop("Nothing to plot") names <- c("Cook's distance", "Studentized residuals", "Bonferroni p-value", "hat-values") # check for row.names, and use them if they are numeric. if(missing(labels)) labels <- row.names(model$model) op <- par(mfrow=c(length(what),1),mar=c(1,4,0,2)+.0,mgp=c(2,1,0), oma=c(6,0,6,0)) oldwarn <- options()$warn options(warn=-1) xaxis <- as.numeric(row.names(model$model)) options(warn=oldwarn) if (any (is.na(xaxis))) xaxis <- 1:length(xaxis) on.exit(par(op)) outlier.t.test <- pmin(outlierTest(model, order=FALSE, n.max=length(xaxis), cutoff=length(xaxis))$bonf.p, 1) for (j in what){ y <- switch(j,cooks.distance(model),rstudent(model), outlier.t.test, hatvalues(model)) xa <- if(j==4) "s" else "s" plot(xaxis, y, type="n", ylab=names[j], xlab="", xaxt="n", tck=0.1, ...) if(grid){ grid(lty=1, equilogs=FALSE) box()} if(j==3) { for (k in which(y < 1)) lines(c(xaxis[k], xaxis[k]), c(1, y[k]))} else points(xaxis, y, type="h", ...) points(xaxis, y, type="p", ...) if (j == 2) abline(h=0, lty=2 ) axis(1, labels= ifelse(j= 0 z <- rep(NA, length(U)) z[which(nonnegs)] <- bcPower(U[which(nonnegs)]+1, lambda, jacobian.adjusted=FALSE) z[which(!nonnegs)] <- -bcPower(-U[which(!nonnegs)]+1, 2-lambda, jacobian.adjusted=FALSE) if (jacobian.adjusted == TRUE) z * (exp(mean(log((1 + abs(U))^(2 * nonnegs - 1)), na.rm=TRUE)))^(1 - lambda) else z } out <- U out <- if(is.matrix(out) | is.data.frame(out)){ if(is.null(colnames(out))) colnames(out) <- paste("Z", 1:dim(out)[2], sep="") for (j in 1:ncol(out)) {out[, j] <- yj1(out[, j], lambda[j]) } colnames(out) <- paste(colnames(out), round(lambda, 2), sep="^") out} else yj1(out, lambda) out} powerTransform <- function(object, ...) UseMethod("powerTransform") powerTransform.default <- function(object, ...) { y <- object if(!inherits(y, "matrix") & !inherits(y, "data.frame")) { y <- matrix(y,ncol=1) colnames(y) <- c(paste(deparse(substitute(object))))} y <- na.omit(y) x <- rep(1, dim(y)[1]) estimateTransform(x, y, NULL, ...) } powerTransform.lm <- function(object,...) { mf <- if(is.null(object$model)) update(object, model=TRUE, method="model.frame")$model else object$model mt <- attr(mf, "terms") y <- model.response(mf, "numeric") w <- as.vector(model.weights(mf)) if (is.null(w)) w <- rep(1, dim(mf)[1]) if (is.empty.model(mt)) { x <- matrix(rep(1,dim(mf)[1]), ncol=1) } else { x <- model.matrix(mt, mf, contrasts) } estimateTransform(x, y, w, ...) } powerTransform.formula <- function(object, data, subset, weights, na.action, ...) { mf <- match.call(expand.dots = FALSE) m <- match(c("object", "data", "subset", "weights", "na.action"), names(mf), 0L) mf <- mf[c(1L, m)] mf$drop.unused.levels <- TRUE mf[[1L]] <- as.name("model.frame") names(mf)[which(names(mf)=="object")] <- "formula" mf <- eval(mf, parent.frame()) mt <- attr(mf, "terms") y <- model.response(mf, "numeric") w <- as.vector(model.weights(mf)) if (is.null(w)) w <- rep(1, dim(mf)[1]) if (is.empty.model(mt)) { x <- matrix(rep(1, dim(mf)[1]), ncol=1) } else { x <- model.matrix(mt, mf) } estimateTransform(x, y, w, ...) } estimateTransform <- function(X, Y, weights=NULL, family="bcPower", start=NULL, method="L-BFGS-B", ...) { fam <- match.fun(family) Y <- as.matrix(Y) # coerces Y to be a matrix. X <- as.matrix(X) # coerces X to be a matrix. w <- if(is.null(weights)) 1 else sqrt(weights) nc <- dim(Y)[2] nr <- nrow(Y) xqr <- qr(w * X) llik <- function(lambda){ (nr/2)*log(((nr - 1)/nr) * det(var(qr.resid(xqr, w*fam(Y, lambda, j=TRUE))))) } llik1d <- function(lambda,Y){ (nr/2)*log(((nr - 1)/nr) * var(qr.resid(xqr, w*fam(Y, lambda, j=TRUE)))) } if (is.null(start)) { start <- rep(1, nc) for (j in 1:nc){ res<- suppressWarnings(optimize( f = function(lambda) llik1d(lambda,Y[ , j, drop=FALSE]), lower=-3, upper=+3)) start[j] <- res$minimum } } res<-optim(start, llik, hessian=TRUE, method=method, ...) if(res$convergence != 0) warning(paste("Convergence failure: return code =", res$convergence)) res$start<-start res$lambda <- res$par names(res$lambda) <- if (is.null(colnames(Y))) paste("Y", 1:dim(Y)[2], sep="") else colnames(Y) roundlam <- res$lambda stderr <- sqrt(diag(solve(res$hessian))) lamL <- roundlam - 1.96 * stderr lamU <- roundlam + 1.96 * stderr for (val in rev(c(1, 0, -1, .5, .33, -.5, -.33, 2, -2))) { sel <- lamL <= val & val <= lamU roundlam[sel] <- val } res$roundlam <- roundlam res$par <- NULL res$family<-family res$xqr <- xqr res$y <- Y res$x <- X res$weights <- weights class(res) <- "powerTransform" res } testTransform <- function(object, lambda) UseMethod("testTransform") testTransform.powerTransform <- function(object, lambda=rep(1, dim(object$y)[2])){ fam <- match.fun(object$family) Y <- cbind(object$y) # coerces Y to be a matrix. nc <- dim(Y)[2] nr <- nrow(Y) lam <- if(length(lambda)==1) rep(lambda, nc) else lambda xqr <- object$xqr w <- if(is.null(object$weights)) 1 else sqrt(object$weights) llik <- function(lambda){ (nr/2) * log(((nr - 1)/nr) * det(var(qr.resid(xqr, w*fam(Y, lam,j=TRUE))))) } LR <- 2 * (llik(lambda) - object$value) df <- length(object$lambda) pval <- 1-pchisq(LR, df) out <- data.frame(LRT=LR, df=df, pval=pval) rownames(out) <- c(paste("LR test, lambda = (", paste(round(lam, 2), collapse=" "), ")", sep="")) out} print.powerTransform<-function(x, ...) { cat("Estimated transformation parameters \n") print(x$lambda) invisible(x)} summary.powerTransform<-function(object,...){ one <- 1==length(object$lambda) label <- paste(object$family, (if(one) "Transformation to Normality" else "Transformations to Multinormality"), "\n\n") lambda<-object$lambda stderr<-sqrt(diag(solve(object$hessian))) df<-length(lambda) result <- cbind(lambda, stderr, lambda - 1.96*stderr, lambda + 1.96*stderr) rownames(result)<-names(object$lambda) colnames(result)<-c("Est.Power", "Std.Err.", "Wald Lower Bound", "Wald Upper Bound") tests <- testTransform(object, 0) tests <- rbind(tests, testTransform(object, 1)) if ( !(all(object$roundlam==0) | all(object$roundlam==1) | length(object$roundlam)==1 )) tests <- rbind(tests, testTransform(object, object$roundlam)) out <- list(label=label, result=result, tests=tests) class(out) <- "summary.powerTransform" out } print.summary.powerTransform <- function(x,digits=4, ...) { cat(x$label) print(round(x$result, digits)) cat("\nLikelihood ratio tests about transformation parameters\n") print(x$tests) } coef.powerTransform <- function(object, round=FALSE, ...) if(round==TRUE) object$roundlam else object$lambda vcov.powerTransform <- function(object,...) { ans <- solve(object$hessian) rownames(ans) <- names(coef(object)) colnames(ans) <- names(coef(object)) ans} plot.powerTransform <- function(x, z=NULL, round=TRUE, plot=pairs, ...){ y <- match.fun(x$family)(x$y, coef(x, round=round)) if (is.null(z)) plot(y, ...) else if (is.matrix(z) | is.data.frame(z)) plot(cbind(y, z), ...) else { y <- cbind(y,z) colnames(y)[dim(y)[2]] <- deparse(substitute(z)) plot(y, ...) } } car/R/subsets.R0000644000175100001440000000333711424555002013055 0ustar hornikusers# Plot optimal subsets regressions -- output from regsubsets # function in leaps package # last modified 30 July 2010 by J. Fox subsets <- function(object, ...){ if (!require(leaps)) stop("leaps package missing") UseMethod("subsets") } subsets.regsubsets <- function(object, names=abbreviate(object$xnames, minlength=abbrev), abbrev=1, min.size=1, max.size=length(names), legend, statistic=c("bic", "cp", "adjr2", "rsq", "rss"), las=par("las"), cex.subsets=1, ...) { if (missing(legend)) legend <- missing(names) sumry <- summary(object) incidence <- sumry$which if (object$xnames[1] == "(Intercept)"){ if (missing(names)) names <- names[-1] incidence <- incidence[, -1] } statistic <- match.arg(statistic) stat <- switch(statistic, bic = sumry$bic, cp = sumry$cp, adjr2 = sumry$adjr2, rsq = sumry$rsq, rss = sumry$rss) subset.size <- as.numeric(rownames(incidence)) select <- subset.size >= min.size & subset.size <= max.size subset.size <- subset.size[select] stat <- stat[select] incidence <- incidence[select, ] plot(c(min.size, max.size), range(stat), type="n", xlab="Subset Size", ylab=paste("Statistic:", statistic), las=las, ...) for (i in seq(along=stat)){ adj <- if (subset.size[i] == min.size) 0 else if (subset.size[i] == max.size) 1 else .5 text(subset.size[i], stat[i], do.call("paste", c(as.list(names[incidence[i,]]),sep='-')), cex=cex.subsets, adj=adj) } if (legend) { legend(locator(1), legend=apply(cbind(names, names(names)), 1, function(x) do.call("paste", c(as.list(x), sep=": "))), xpd=TRUE) return(invisible(NULL)) } else { Abbreviation <- names return(as.data.frame(Abbreviation)) } } car/vignettes/0000755000175100001440000000000012215160034013037 5ustar hornikuserscar/vignettes/embedding.bib0000644000175100001440000000121212176234207015441 0ustar hornikusers@misc{cantyripley13, author = {Angelo Canty and Brian Ripley}, title = {boot: Bootstrap {R} ({S}-{P}lus) Functions. {R} package version 1.3-9}, year = {2013} } @BOOK{FoxWeisberg11, author = {J. Fox and S. Weisberg}, year = 2011, title = {An {R} Companion to Applied Regression}, edition={2nd}, publisher = {Sage}, address = {Thousand Oaks {CA}}, url={http://z.umn.edu/carbook} } @techreport{FoxWeisberg12, author = {J. Fox and S. Weisberg}, year = 2012, title = {Bootstrapping Regression Models in {R}}, url={http://socserv.mcmaster.ca/jfox/Books/Companion/appendix/Appendix-Bootstrapping.pdf} } car/vignettes/embedding.Rnw0000644000175100001440000002375512204420315015460 0ustar hornikusers\documentclass{article} \usepackage{url,Sweave} %\usepackage{fpage} %\VignetteIndexEntry{Using car functions inside user functions} \newcommand{\R}{{\normalfont\textsf{R}}{}} \newcommand{\car}{\texttt{car}} \newcommand{\effects}{\texttt{effects}} \newcommand{\code}[1]{\texttt{#1}} \usepackage[authoryear,round]{natbib} \bibliographystyle{plainnat} <>= options(width=80, digits=4, useFancyQuotes=FALSE, prompt=" ", continue=" ") @ \title{Using \car{} Functions in Other Functions} \author{John Fox\footnote{Department of Sociology, McMaster University} \&{} Sanford Weisberg\footnote{ School of Statistics, University of Minnesota}} \date{\today} \begin{document} \maketitle \begin{abstract} The \car{} package \citep{FoxWeisberg11} provides many functions that are applied to a fitted regression model, perform additional calculations on the model or possibly compute a different model, and then return values and graphs. In some cases, users may wish to write functions that call functions in \car{} for a particular purpose. Because of the scoping rules used in \R{}, several functions in \car{} that work when called from the command prompt may fail when called inside another function. We discuss how users can modify their programs to avoid this problem. \end{abstract} \section{\code{deltaMethod}} The \car{} package includes many functions that require an object created by a modeling function like \code{lm}, \code{glm} or \code{nls} as input. For a simple example, the function \code{deltaMethod} uses the delta method \citep[Sec.~4.4.6]{FoxWeisberg11} to estimate the value and standard error of a nonlinear combination of parameter estimates. For example <<>>= library(car) m1 <- lm(time ~ t1 + t2, Transact) deltaMethod(m1, "t1/(t2 + 2)") @ Here \code{deltaMethod} returns the standard error of the estimate of $\beta_1/(\beta_2+2)$, where $\beta_j$ is the parameter corresponding to the regressor \texttt{t}$_j$. The code <<>>= ans <- NULL for (z in 1:4) { ans <- rbind(ans, deltaMethod(m1, "t1/(t2 + z)", func = gsub("z", z, "t1/(t1+z)"))) } ans @ also works as expected. The \code{func} argument uses \code{gsub} to get the right row labels. Consider the function: <<>>= f1 <- function(mod) { ans <- NULL for (x in 1:4) { ans <- rbind(ans, deltaMethod(mod, "t1/(t2 + x)", func = gsub("x", x, "t1/(t1+x)")) )} ans } @ which simply puts the code used above into a function. Executing this function fails: \begin{Schunk} \begin{Sinput} f1(m1) \end{Sinput} \begin{Soutput} Error in eval(expr, envir, enclos) : object 'x' not found \end{Soutput} \end{Schunk} Worse yet, if \texttt{x} is defined in the same environment as \texttt{m1}, this function gives the wrong answer: <<>>= x <- 10 f1(m1) @ The core of the problem is the way that \R{} does scoping. The regression object \texttt{m1} was created in the global environment, whereas the argument \texttt{z} in the \texttt{f1} function is created in the local environment of the function. The call to \code{deltaMethod} is evaluated in the global environment where \texttt{m1} is defined, leading to the error message if \texttt{z} does not exist in the global environment, and to wrong answers if it does exist. For \code{deltaMethod}, there is an additional argument \texttt{constants} that can be used to fix the problem: <<>>= f2 <- function(mod) { ans <- NULL for (x in 1:4) { ans <- rbind(ans, deltaMethod(mod, "t1/(t2 + x)", func = gsub("x", x, "t1/(t1+x)"), constants=list(x=x)) )} ans } f2(m1) @ The \texttt{constants} argument is a named list of quantities defined in the local function that are needed in the evaluation of \code{deltaMethod}. \section{\code{ncvTest}} The function \code{ncvTest} \citep[Sec.~6.5.2]{FoxWeisberg11} computes tests for non-constant variance in linear models as a function of the mean, the default, or any other linear function of regressors, even for regressors not part of the mean function. For example, <<>>= m2 <- lm(prestige ~ education, Prestige) ncvTest(m2, ~ income) @ fits \texttt{prestige} as a linear function of \texttt{education}, and tests for nonconstant variance as a function of \texttt{income}, another regressor in the data set \texttt{Prestige}. Embedding this in a function fails: <>= f3 <- function(meanmod, dta, varmod) { m3 <- lm(meanmod, dta) ncvTest(m3, varmod) } f3(prestige ~ education, Prestige, ~ income) @ \begin{Schunk} \begin{Soutput} Error in is.data.frame(data) : object 'dta' not found \end{Soutput} \end{Schunk} In this case the model \texttt{m3} is defined in the environment of the function, and the argument \texttt{dta} is defined in the global environment, and is therefore invisible when \code{ncvTest} is called. A solution is to copy \code{dta} to the global environment. <<>>= f4 <- function(meanmod, dta, varmod) { assign(".dta", dta, envir=.GlobalEnv) assign(".meanmod", meanmod, envir=.GlobalEnv) m1 <- lm(.meanmod, .dta) ans <- ncvTest(m1, varmod) remove(".dta", envir=.GlobalEnv) remove(".meanmod", envir=.GlobalEnv) ans } f4(prestige ~ education, Prestige, ~income) f4(prestige ~ education, Prestige, ~income) @ The \code{assign} function copies the \code{dta} and \code{meanmod} arguments to the global environment where \code{ncvTest} will be evaluated, and the \code{remove} function removes them before exiting the function. This is an inherently problematic strategy, because an object assigned in the global environment will replace an existing object of the same name. Consequently we renamed the \code{dta} argument \code{.dta}, with an initial period, but this is not a \emph{guarantee} that there was no preexisting object with this name. This same method can be used with functions in the \code{effects} package. Suppose, for example, you want to write a function that will fit a model, provide printed summaries and also draw a effects plot. The following function will fail: <>= library(effects) fc <- function(dta, formula, terms) { print(m1 <- lm(formula, .dta)) Effect(terms, m1) } form <- prestige ~ income*type + education terms <- c("income", "type") fc(Duncan, form, terms) @ As with \code{ncvTest}, \code{dta} will not be in the correct environment when \code{Effect} is evaluated. The solution is to copy \code{dta} to the global environment: <>= library(effects) fc.working <- function(dta, formula, terms) { assign(".dta", dta, env=.GlobalEnv) print(m1 <- lm(formula, .dta)) Effect(terms, m1) remove(".dta", envir=.GlobalEnv) } fc.working(Duncan, form, terms) @ Assigning \code{formula} to the global environment is not necessary here because it is used by \code{lm} but not by \code{Effect}. \section{\code{Boot}} The \code{Boot} function in \car{} provides a convenience front-end for the function \code{boot} in the \texttt{boot} package \citep{cantyRipley13,FoxWeisberg12}. With no arguments beyond the name of a regression object and the number of replications \texttt{R}, \code{Boot} creates the proper arguments for \code{boot} for case resampling bootstraps, and returns the coefficient vector for each sample: <<>>= m1 <- lm(time ~ t1 + t2, Transact) b1 <- Boot(m1, R=999) summary(b1) @ The returned object \texttt{b1} is of class \texttt{"boot"}, as are objects created directly from the \texttt{boot} function, so helper functions in the \texttt{boot} package and in \car{} can be used on these objects, e.g., <<>>= confint(b1) @ The \code{Boot} function would have scoping problems even without the user embedding it in a function because the \code{boot} function called by \code{Boot} tries to evaluate the model defined in the global environment in a local environment. In \code{car} we define an environment <>= .carEnv <- new.env(parent=emptyenv()) @ and then evaluate the model in the environment \code{.carEnv}. This environment is not exported, so to see that it exists you would need to enter <<>>= car:::.carEnv @ We use this same trick in the \code{Boot.default} function so that \code{.carEnv} is globally visible. Here is a copy of \code{Boot.default} to show how this works. <>= Boot.default <- function(object, f=coef, labels=names(coef(object)), R=999, method=c("case", "residual")) { if(!(require(boot))) stop("The 'boot' package is missing") f0 <- f(object) if(length(labels) != length(f0)) labels <- paste("V", seq(length(f0)), sep="") method <- match.arg(method) if(method=="case") { boot.f <- function(data, indices, .fn) { assign(".boot.indices", indices, envir=car:::.carEnv) mod <- update(object, subset=get(".boot.indices", envir=car:::.carEnv)) if(mod$qr$rank != object$qr$rank){ out <- .fn(object) out <- rep(NA, length(out)) } else {out <- .fn(mod)} out } } else { boot.f <- function(data, indices, .fn) { first <- all(indices == seq(length(indices))) res <- if(first) object$residuals else residuals(object, type="pearson")/sqrt(1 - hatvalues(object)) res <- if(!first) (res - mean(res)) else res val <- fitted(object) + res[indices] if (!is.null(object$na.action)){ pad <- object$na.action attr(pad, "class") <- "exclude" val <- naresid(pad, val) } assign(".y.boot", val, envir=car:::.carEnv) mod <- update(object, get(".y.boot", envir=car:::.carEnv) ~ .) if(mod$qr$rank != object$qr$rank){ out <- .fn(object) out <- rep(NA, length(out)) } else {out <- .fn(mod)} out } } b <- boot(data.frame(update(object, model=TRUE)$model), boot.f, R, .fn=f) colnames(b$t) <- labels if(exists(".y.boot", envir=car:::.carEnv)) remove(".y.boot", envir=car:::.carEnv) if(exists(".boot.indices", envir=car:::.carEnv)) remove(".boot.indices", envir=car:::.carEnv) b } @ The was also fixed in \code{bootCase}. \bibliography{embedding} \end{document} car/MD50000644000175100001440000002511112216355405011350 0ustar hornikusers86a682e9ef21f594593ebc4bb4771257 *DESCRIPTION a54f6585e49144b50dced9e2b254f285 *NAMESPACE c0921d51e0bf75af56e8acdf66ac722f *NEWS 54d4c64c7296d96348da632d69e7dde6 *R/Anova.R 6e71e0893eb778c391e866280e0f84f6 *R/Boot.R 55cc561fe1c4cdc9e8cfd031d5b4269f *R/Boxplot.R e6e27da69e618a88c9a9cc715059b7d5 *R/Contrasts.R 3c57dad8fd30b15ba6a85e9a3f84e2a0 *R/Ellipse.R ac2f24e690e2aafbb5cd7a0b1454f399 *R/TransformationAxes.R 1294fdc53707237cd25f1663c9ffe214 *R/avPlots.R f3e605c17d1ee7abd9507100770a4147 *R/bootCase.R c0b8054ac13cad75d8b72c62c43bad6e *R/boxCox.R 9ee884a60458a71168caeaa9c0db0766 *R/boxCoxVariable.R 16f7207a55f8a871635b2d49fea3c422 *R/boxTidwell.R 03db7145a3647f94e1d69fde66eb56aa *R/car-deprecated.R b9e05cea8482d00fa0dd8b97b60db87c *R/carWeb.R 47ef6831b91734190567aaa6da2ab26d *R/ceresPlots.R ef8cc75c53d7c33007890c78c9f50e1d *R/compareCoefs.R 6654b7f290671313c7935752e6d1f92c *R/crPlots.R 7e76141a5a4a442b0c110cd2fa15046e *R/deltaMethod.R 52b55a0ba9113514f21ab633a30ee3d4 *R/densityPlot.R 2b3a999e1cf7f82b3fe416c589a08cb5 *R/dfbetaPlots.R fc3957367225bd200be9ac6dd23e10b8 *R/durbinWatsonTest.R ffb8def1053d3971e21852803d868749 *R/hccm.R fd250f4ab37494d8604836fc7e469916 *R/infIndexPlot.R 5a26d0b6b2f0b57bf2dc3f4b9a540510 *R/influencePlot.R 4a42623bf84621cfa6f9190ad7ace35e *R/invResPlot.R 4e01544ceecb79224045373a8dc658d9 *R/invTranPlot.R fb408f740d16f05bd4f71144c74d078a *R/leveneTest.R 3a7ea9f4ece747da986ba432f6d5fe45 *R/leveragePlots.R a4182c488390f23da599778fb0949ae4 *R/linearHypothesis.R 1018d0332b3c63f2ee6731e444dccc61 *R/logit.R 6cdc721bdd51696cf60336426c4efddd *R/marginalModelPlot.R d5a9c6caee9ffcd6c799d169669d9aa3 *R/ncvTest.R fd273df0fb1a99b5a014a872ddff1835 *R/outlierTest.R fdbf7722fb6f1bfe9da6c5d176cb9cff *R/panel.car.R e84a4335a72d3c0813880dfb862faf6c *R/powerTransform.R 94953bc9d96604e3fb887dbf2431f68c *R/qqPlot.R 7abe8f41516e71dcad04ddf2dceeafeb *R/recode.R efcac7db573821da21ee4de56ac5d79e *R/regLine.R 4809cd6c397814220258ede66f7e0f88 *R/residualPlots.R 23ad7545250037406b20a4838a358d5d *R/scatter3d.R 3c0ee8bc15fc6198cacbba1fa508813b *R/scatterplot.R 2f7f2f5c413b48d880d1422796d8e41c *R/scatterplotMatrix.R 92bcafbeada58962c1eb04427ab002cc *R/scatterplotSmoothers.R 959fd61067ec2c5a2d8d58dac757f384 *R/showLabels.R 24c3680c3b73eba48976557aab9ade89 *R/sigmaHat.R 234146b7470fadb3a9345bf070f86478 *R/some.R e39b3ef7445abad187d224a2dfa6a0ab *R/spreadLevelPlot.R 918608cc987dc485a7349838a61f967e *R/subsets.R b384a7c1d38c452095aecd402afaad4e *R/symbox.R 89b81086579a345b5501a9fbbf5c11bd *R/utility-functions.R 0f23854c0c76e4dbde19717aaa30e719 *R/vif.R d01087a33adaa2fc42d2351250feddc0 *R/wcrossprod.R 48a87c07f1657002a7d3be861a4cb4f0 *R/which.names.R 7092c33c6bcc924e9f1bc37279c951f6 *build/vignette.rds 576f7f8b619cc3ef4401c05a9509ca0f *data/AMSsurvey.rda 3f3adf1d0837b85e4a4c598d9ad656d5 *data/Adler.rda d2f3177d2dc9bfb1140fd38a63a689a5 *data/Angell.rda 0d1c60c276488f357c501e1724f5e347 *data/Anscombe.rda 54f6e608e39d04084015bda96fc816bb *data/Baumann.rda 292af0bfa5ed0b54af78d93907ce5c2b *data/Bfox.rda f6190a0e76fe48563bc85e7d509ef753 *data/Blackmoor.rda e9a3efa6eaba0c843dd6437fc4a55487 *data/Burt.rda 6e63e8c15e4e6d2774bdc38ba2c12573 *data/CanPop.rda 198ff4c6cb18e23c0d099ea5ae91bfba *data/Chile.rda bfee7ace3069931c3a83d6447cd17d80 *data/Chirot.rda 8bd8b3e80dd6604c973cbe4f7fc0ac83 *data/Cowles.rda 926d9586b622551249e031224d846e2e *data/Davis.rda fef8616a1ae94a017a12a8cb729c77c2 *data/DavisThin.rda 447e4a834d218bcf39b85dd3dd2bc6df *data/Depredations.rda 1275487536576e7a1b49cf807739596c *data/Duncan.rda 5d00f28bcc9cd6f5e3566b309b733ac3 *data/Ericksen.rda 83a17a6d6952799fba24f5e625f0d9f0 *data/Florida.rda 22a17c5cc4eade1506998db318096bb6 *data/Freedman.rda c16ada97f578130453793ac566801fab *data/Friendly.rda be3f4df1636038445372a2a1e634123c *data/Ginzberg.rda 43a97dc87de47204fdb488988be80e1d *data/Greene.rda 7974700112d3bb8a233f461f24742a2f *data/Guyer.rda 0774281273c77f05de5c3545eb60ad07 *data/Hartnagel.rda 5301c517c913dd69eacc940712e675d5 *data/Highway1.rda d76af486fafd5418d5afb52ac9fbde5a *data/Leinhardt.rda acc68ce6437ba31b97d8687c6370a299 *data/Mandel.rda 4a46ba60183feacbbda09f6c2c483061 *data/Migration.rda 41734a7ccb280b9cace6a2363bedd0c0 *data/Moore.rda 126810f0a31feef27c99341cac82c972 *data/Mroz.rda 2737026ce5fce5a2cef8d71f47369609 *data/OBrienKaiser.rda 00867b2601ebb97a920bc105081a951a *data/Ornstein.rda 98af811bdb2aad48affd89a901a8ed0f *data/Pottery.rda be23c7fdec672c45d1f9f98709252e5b *data/Prestige.rda 924150324dedf680ffeddffd4e2f9e91 *data/Quartet.rda bd78d481228839ab8c0ad9fbfb999fd4 *data/Robey.rda ebd21b2c2e2093217c40e3c740a516a4 *data/SLID.rda 34e732cb2cee4699c8f6f7f990947b5e *data/Sahlins.rda 0737bc4c346e1bab0f31bc72885fd822 *data/Salaries.rda b1ad01e57bef15399373df9664dc6092 *data/Soils.rda 145277c8ce005ce7a8dad663c408774b *data/States.rda de206a0b0315dab83bba96dbad2d8dd2 *data/Transact.rda 82d72e9439706c75cfca4ef5e71ebb4f *data/UN.rda 569a3ace29483dc3d471525c220e4c40 *data/USPop.rda 874186bd21bbb0dc4450f821c2495d0f *data/Vocab.rda 3f23faf7908bcd0f8a2ae5d7f04f3ff7 *data/WeightLoss.rda bb5090dfa56d96da156fc83673313a95 *data/Womenlf.rda 6c1b33365aa9313c4c98786627134d6e *data/Wool.rda e58584a26bbb414d417fca2ad22f2489 *inst/CITATION d08dca5bbdd67a31bbf41220a2d6fff2 *inst/doc/embedding.R bb7ad32f36ea9f9f9161e76390a34c9b *inst/doc/embedding.Rnw 1b62e300117ef3bb27dabb4ab4b83856 *inst/doc/embedding.pdf d31d41f78652b335604ac4f9c5b6da11 *man/AMSsurvey.Rd 0121ac092471417593ac2e32b134a883 *man/Adler.Rd 8a3ad189a7bd629bc812b28322acc5b3 *man/Angell.Rd af4d3ced50771fdc795b8eddd1e30784 *man/Anova.Rd 771c447ef810aecde56774754ce0c8ad *man/Anscombe.Rd 74a8a2ff389993de7fd3ee2dd155aea1 *man/Baumann.Rd f5edd689536ad670cc6c9d4baa8bc510 *man/Bfox.Rd a583e667a28cb7728add4ebc1c763afb *man/Blackmoor.Rd dbda0ff40b758b7fbbc30f40b1d8c66d *man/Boot.Rd 57f975e3d72b6e33a30e02bb9baff7ff *man/Boxplot.Rd de2800215e5b97fb0bda981d3fba28a3 *man/Burt.Rd 34a37e0170916ee4031dd2cc21141ce4 *man/CanPop.Rd 3cdca9b9db097398bb9702313d9258bf *man/Chile.Rd d0fd43aa5d2cb9781c2f3cc71c9a6da8 *man/Chirot.Rd 215d45a517d69d6c9482f1bf3255ecc3 *man/Contrasts.Rd 9905d4779ca5dfc6f791051df947a9a5 *man/Cowles.Rd 9358fdf7fb326801b7f8a4e8898acfb8 *man/Davis.Rd 32c77e77ee278a36461b569b97680f78 *man/DavisThin.Rd ec077f2d0094dec87b4307045956cafa *man/Depredations.Rd c029351f725834c6dd6a9aa64e82559a *man/Duncan.Rd 95759c1d1c6b71fce475eb8bae958759 *man/Ellipses.Rd f3ac5e71978effb01e50fdae170a2a0c *man/Ericksen.Rd 25986f22cccf8624663808f791102fcd *man/Florida.Rd 66370967ad107335a7c6a169cf780bc6 *man/Freedman.Rd 83d84e8243f963d63efa0ece7d025438 *man/Friendly.Rd 14c43d5a6f4030f8a705474c9f8a87dd *man/Ginzberg.Rd d41ad22629d86914b38cc0d2fb88112f *man/Greene.Rd 2c4b6887a6acde39bb763d81b705576f *man/Guyer.Rd 73d76fd4ac46673ccbdbd07b8e199300 *man/Hartnagel.Rd 43be875fc46df265bb6a24cd851adad3 *man/Highway1.Rd 4874901f99af7e039d0c9e9085051465 *man/Leinhardt.Rd 96404021dc7876a7425360f2b455b9da *man/Mandel.Rd da24d0e10305ce257605ccad1c901665 *man/Migration.Rd 748d463e7b5eece35e9b805a14b80e3f *man/Moore.Rd 50a72bb2326719b55744db96a99d7559 *man/Mroz.Rd 1e1978647e830d80bc645326d85b59c6 *man/OBrienKaiser.Rd 28a04ddbc600c04fbb0374ca4a71eaf8 *man/Ornstein.Rd a935f42bec62f0646158c34ef6e99b50 *man/Pottery.Rd 5eae506a0d5d5c87bbb024f2002956d7 *man/Prestige.Rd 38c6140d5872a0af21f54ac25ef140bf *man/Quartet.Rd 23505aa922f7872aac5eb48a4b540fd0 *man/Robey.Rd 3dfc1fbb30f38b71c23c1cb9411b673e *man/SLID.Rd a992ab5ece3f497e157be9a979c7bfed *man/Sahlins.Rd 0c05af0a3f9b86ab122701f16e14155d *man/Salaries.Rd 4e381f672b30fa7a7cc15b53a05a544f *man/ScatterplotSmoothers.Rd f9cc53e5c89527f86a58401921fcef24 *man/Soils.Rd 6a72f5912f065446466b6176544c906b *man/States.Rd 60f7b91e434017f47216d1514103aee6 *man/Transact.Rd ba3d6469fa429dd3c5cc56cf5ccc18bf *man/TransformationAxes.Rd 03f9c160eb6f61baa79e8fd543adff83 *man/UN.Rd c22b7b6c7509558e641260a85779cdab *man/USPop.Rd 6e561abf92e089f316e0c5043ba72ff2 *man/Vocab.Rd 3458e87631e84c9d73949e2630012f3c *man/WeightLoss.Rd 7d86575518c3e51f57109d6b4e26af6d *man/Womenlf.Rd cc1a3a0e4522b8ab5a6b6ddc30c5a664 *man/Wool.Rd 15cdabee5c3d682197aade848ac7d75e *man/avPlots.Rd 71e0989c6efcc8f30f8b1c36e38e8166 *man/bcPower.Rd a0856449971251553b75a14e740c49dc *man/bootCase.Rd 8d4183782c6bd0efc2b3df06795954fe *man/boxCox.Rd 10ed4775b0c83ddc27cf772f9deee75f *man/boxCoxVariable.Rd de4255eb83dc7ff062699b63b8316d03 *man/boxTidwell.Rd ea9540069b63940fd6ffb3634ff4b05d *man/car-deprecated.Rd 7eb81de7e703c40bc67f2fc0d0f0d1b1 *man/car-package.Rd 94f2797f81c5989877684857b49e6c02 *man/carWeb.Rd c21f5cf79283021c8da52f33f681b64f *man/ceresPlots.Rd 398a2e3f449600419a47d4a994a32aa5 *man/compareCoefs.Rd e4b26d2af21032bf393b022cc2db9088 *man/crPlots.Rd 5c16ce875c3f9170923f24aecd7fac73 *man/deltaMethod.Rd f8bdf9752375e1e80cbeb6d54445b2cc *man/densityPlot.Rd 00f739f53beacd6a7d64fc68d4eed43c *man/dfbetaPlots.Rd f81d7bb90460ef0ad7d0a773b5fc172a *man/durbinWatsonTest.Rd bd61ca8abcca352e8c36ad2a5668cf60 *man/estimateTransform.Rd 6c5372c2517d417aa69639c51704a72e *man/hccm.Rd 6b24dda7bb9e6d4895fe24a545afa215 *man/hist.boot.Rd 30c9c51cecf48cfcbea3291126991e98 *man/infIndexPlot.Rd b2131035ff325d680702ccae2edc0e26 *man/influencePlot.Rd 1855e28203c4dc964163e57f74f00f60 *man/invResPlot.Rd 7d0f887f6759455798045aa80499f2c8 *man/invTranPlot.Rd 5b098563c8b52d0de147596a7348b649 *man/leveneTest.Rd f22d846c8d3119e61227016a5c0bb410 *man/leveragePlots.Rd e13216d6e54dcbc838ee83477f4f325d *man/linearHypothesis.Rd 7f6774c46aec762888f3ffc7fad4a48a *man/logit.Rd 3eaf9b6a7f7f412a53bb4fef30c8e963 *man/marginalModelPlot.Rd 6b7af2075fe4bccd79c5391431af7a10 *man/ncvTest.Rd 757f8c459c0eacbb8566b77560d9215f *man/outlierTest.Rd 8c6c6b497220550385ebd3a4dbfa5dea *man/panel.car.Rd ed30fccf3e9e5cf88fa42454117d6dd5 *man/plot.powerTransform.Rd 9f0c381f9c06545c1fd64df4af33828b *man/powerTransform.Rd e355f8bd3bdb845e9213cb6b538086a2 *man/qqPlot.Rd ab18d9d55a79de4e2a5eeffe2ebd3f15 *man/recode.Rd 28b9888be6dd64f37a2e388a9fdf4a4e *man/regLine.Rd 6a674775cd53f783085121bae93a361d *man/residualPlots.Rd f9c8d52abe85465d7efb49f63ca56bd1 *man/scatter3d.Rd 408c606740e25d78f6d579ab61cf6557 *man/scatterplot.Rd 89783ed35d9c3a61acc32a8be2863e7a *man/scatterplotMatrix.Rd c1ef1b586611603286a74ba67f1d6789 *man/showLabels.Rd ecf14f5f34a04bc4360e333508c78588 *man/sigmaHat.Rd f98d9936887336d48326805f2c201d70 *man/some.Rd 5f2cf678afc56d1cd0e86ff66e9bb16a *man/spreadLevelPlot.Rd 888450f5e3d0f997b8859fffaf8d1530 *man/subsets.Rd 0f04a7c53fee398f8bf641b5af8ea2e2 *man/symbox.Rd e82b0dc6e305531d44b8dbe4f3ccdc5e *man/testTransform.Rd 10b2ffd0e6a09d80e714db13c0a47dd7 *man/vif.Rd 011d77213781e258f477d119df9a60f9 *man/wcrossprod.Rd 86e4112f8dae970e327228c049eaadf2 *man/which.names.Rd bb7ad32f36ea9f9f9161e76390a34c9b *vignettes/embedding.Rnw 6b07f76684a6bc62752b6afdc196ccf2 *vignettes/embedding.bib car/build/0000755000175100001440000000000012215160034012126 5ustar hornikuserscar/build/vignette.rds0000644000175100001440000000033412215160034014465 0ustar hornikusersuQ0 ?`HL|]C4:Y1K`!|r(ڤ]_5;{X o bO p.5eB&i#ZRQ!@]Kjz2n_л6' rЛ/C(Aote[[T#gV 5v$2EX0R#5|w ;:4}$cJ_fAZ!D car/DESCRIPTION0000644000175100001440000000453512216355405012555 0ustar hornikusersPackage: car Version: 2.0-19 Date: 2013/09/14 Title: Companion to Applied Regression Authors@R: c(person("John", "Fox", role = c("aut", "cre"), email = "jfox@mcmaster.ca"), person("Sanford", "Weisberg", role = "aut", email = "sandy@umn.edu"), person("Daniel", "Adler", role="ctb"), person("Douglas", "Bates", role = "ctb"), person("Gabriel", "Baud-Bovy", role = "ctb"), person("Steve", "Ellison", role="ctb"), person("David", "Firth", role = "ctb"), person("Michael", "Friendly", role = "ctb"), person("Gregor", "Gorjanc", role = "ctb"), person("Spencer", "Graves", role = "ctb"), person("Richard", "Heiberger", role = "ctb"), person("Rafael", "Laboissiere", role = "ctb"), person("Georges", "Monette", role = "ctb"), person("Duncan", "Murdoch", role="ctb"), person("Henric", "Nilsson", role = "ctb"), person("Derek", "Ogle", role = "ctb"), person("Brian", "Ripley", role = "ctb"), person("William", "Venables", role = "ctb"), person("Achim", "Zeileis", role = "ctb"), person("R-Core", role="ctb")) Depends: R (>= 2.14.0), stats, graphics Imports: MASS, nnet Suggests: alr3, boot, leaps, lme4, lmtest, nlme, quantreg, sandwich, mgcv, pbkrtest (>= 0.3-2), rgl (>= 0.93.960), survival, survey ByteCompile: yes LazyLoad: yes LazyData: yes Description: This package accompanies J. Fox and S. Weisberg, An R Companion to Applied Regression, Second Edition, Sage, 2011. License: GPL (>= 2) URL: https://r-forge.r-project.org/projects/car/, http://CRAN.R-project.org/package=car, http://socserv.socsci.mcmaster.ca/jfox/Books/Companion/index.html Author: John Fox [aut, cre], Sanford Weisberg [aut], Daniel Adler [ctb], Douglas Bates [ctb], Gabriel Baud-Bovy [ctb], Steve Ellison [ctb], David Firth [ctb], Michael Friendly [ctb], Gregor Gorjanc [ctb], Spencer Graves [ctb], Richard Heiberger [ctb], Rafael Laboissiere [ctb], Georges Monette [ctb], Duncan Murdoch [ctb], Henric Nilsson [ctb], Derek Ogle [ctb], Brian Ripley [ctb], William Venables [ctb], Achim Zeileis [ctb], R-Core [ctb] Maintainer: John Fox Repository: CRAN Repository/R-Forge/Project: car Repository/R-Forge/Revision: 358 Repository/R-Forge/DateTimeStamp: 2013-09-14 18:27:25 Date/Publication: 2013-09-18 18:55:33 Packaged: 2013-09-14 22:15:56 UTC; rforge NeedsCompilation: no car/man/0000755000175100001440000000000012215157012011604 5ustar hornikuserscar/man/Contrasts.Rd0000644000175100001440000001162411401002012014040 0ustar hornikusers\name{Contrasts} \alias{Contrasts} \alias{contr.Treatment} \alias{contr.Sum} \alias{contr.Helmert} \title{Functions to Construct Contrasts} \description{ These are substitutes for similarly named functions in the \pkg{stats} package (note the uppercase letter starting the second word in each function name). The only difference is that the contrast functions from the \pkg{car} package produce easier-to-read names for the contrasts when they are used in statistical models. The functions and this documentation are adapted from the \pkg{stats} package. } \usage{ contr.Treatment(n, base = 1, contrasts = TRUE) contr.Sum(n, contrasts = TRUE) contr.Helmert(n, contrasts = TRUE) } \arguments{ \item{n}{a vector of levels for a factor, or the number of levels.} \item{base}{an integer specifying which level is considered the baseline level. Ignored if \code{contrasts} is \code{FALSE}.} \item{contrasts}{a logical indicating whether contrasts should be computed.} } \details{ These functions are used for creating contrast matrices for use in fitting analysis of variance and regression models. The columns of the resulting matrices contain contrasts which can be used for coding a factor with \code{n} levels. The returned value contains the computed contrasts. If the argument \code{contrasts} is \code{FALSE} then a square matrix is returned. Several aspects of these contrast functions are controlled by options set via the \code{options} command: \describe{ \item{\code{decorate.contrasts}}{This option should be set to a 2-element character vector containing the prefix and suffix characters to surround contrast names. If the option is not set, then \code{c("[", "]")} is used. For example, setting \code{options(decorate.contrasts=c(".", ""))} produces contrast names that are separated from factor names by a period. Setting \code{options( decorate.contrasts=c("", ""))} reproduces the behaviour of the R base contrast functions.} \item{\code{decorate.contr.Treatment}}{A character string to be appended to contrast names to signify treatment contrasts; if the option is unset, then \code{"T."} is used.} \item{\code{decorate.contr.Sum}}{Similar to the above, with default \code{"S."}.} \item{\code{decorate.contr.Helmert}}{Similar to the above, with default \code{"H."}.} \item{\code{contr.Sum.show.levels}}{Logical value: if \code{TRUE} (the default if unset), then level names are used for contrasts; if \code{FALSE}, then numbers are used, as in \code{contr.sum} in the \code{base} package.} } Note that there is no replacement for \code{contr.poly} in the \code{base} package (which produces orthogonal-polynomial contrasts) since this function already constructs easy-to-read contrast names. } \value{ A matrix with \code{n} rows and \code{k} columns, with \code{k = n - 1} if \code{contrasts} is \code{TRUE} and \code{k = n} if \code{contrasts} is \code{FALSE}. } \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \author{John Fox \email{jfox@mcmaster.ca}} \seealso{\code{\link[stats]{contr.treatment}}, \code{\link[stats]{contr.sum}}, \code{\link[stats]{contr.helmert}}, \code{\link[stats]{contr.poly}} } \examples{ # contr.Treatment vs. contr.treatment in the base package: lm(prestige ~ (income + education)*type, data=Prestige, contrasts=list(type="contr.Treatment")) ## Call: ## lm(formula = prestige ~ (income + education) * type, data = Prestige, ## contrasts = list(type = "contr.Treatment")) ## ## Coefficients: ## (Intercept) income education ## 2.275753 0.003522 1.713275 ## type[T.prof] type[T.wc] income:type[T.prof] ## 15.351896 -33.536652 -0.002903 ## income:type[T.wc] education:type[T.prof] education:type[T.wc] ## -0.002072 1.387809 4.290875 lm(prestige ~ (income + education)*type, data=Prestige, contrasts=list(type="contr.treatment")) ## Call: ## lm(formula = prestige ~ (income + education) * type, data = Prestige, ## contrasts = list(type = "contr.treatment")) ## ## Coefficients: ## (Intercept) income education ## 2.275753 0.003522 1.713275 ## typeprof typewc income:typeprof ## 15.351896 -33.536652 -0.002903 ## income:typewc education:typeprof education:typewc ## -0.002072 1.387809 4.290875 } \keyword{models} \keyword{regression} car/man/which.names.Rd0000644000175100001440000000155411401002012014265 0ustar hornikusers\name{which.names} \alias{which.names} \alias{whichNames} \title{Position of Row Names} \description{ These functions return the indices of row names in a data frame or a vector of names. \code{whichNames} is just an alias for \code{which.names}. } \usage{ which.names(names, object) whichNames(...) } \arguments{ \item{names}{a name or character vector of names.} \item{object}{a data frame or character vector of (row) names.} \item{\dots}{arguments to be passed to \code{which.names}.} } \value{ Returns the index or indices of \code{names} within \code{object}. } \author{John Fox \email{jfox@mcmaster.ca}} \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \examples{ which.names(c('minister', 'conductor'), Duncan) ## [1] 6 16 } \keyword{utilities} car/man/marginalModelPlot.Rd0000644000175100001440000002110612166631153015515 0ustar hornikusers\name{mmps} \alias{mmps} \alias{mmp} \alias{mmp.lm} \alias{mmp.glm} \alias{mmp.default} \alias{marginalModelPlot} \alias{marginalModelPlots} \title{Marginal Model Plotting} \description{ For a regression object, plots the response on the vertical axis versus a linear combination \eqn{u} of terms in the mean function on the horizontal axis. Added to the plot are a \code{loess} smooth for the graph, along with a loess smooth from the plot of the fitted values on \eqn{u}. \code{mmps} is an alias for \code{marginalModelPlots}, and \code{mmp} is an alias for \code{marginalModelPlot}. } \usage{ marginalModelPlots(...) mmps(model, terms= ~ ., fitted=TRUE, layout=NULL, ask, main, groups, key=TRUE, ...) marginalModelPlot(...) \method{mmp}{lm}(model, variable, sd = FALSE, xlab = deparse(substitute(variable)), smoother = loessLine, smoother.args=list(span=2/3), key=TRUE, pch, groups=NULL, ...) \method{mmp}{default}(model, variable, sd = FALSE, xlab = deparse(substitute(variable)), smoother=loessLine, smoother.args, key=TRUE, pch, groups=NULL, col.line = palette()[c(4, 2)], col=palette()[1], labels, id.method="y", id.n=if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], grid=TRUE, ...) \method{mmp}{glm}(model, variable, sd = FALSE, xlab = deparse(substitute(variable)), smoother=gamLine, smoother.args=list(k=3), key=TRUE, pch, groups=NULL, col.line = palette()[c(4, 2)], col=palette()[1], labels, id.method="y", id.n=if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], grid=TRUE, ...) } \arguments{ \item{model}{A regression object, usually of class either \code{lm} or \code{glm}, for which there is a \code{predict} method defined. } \item{terms}{A one-sided formula. A marginal model plot will be drawn for each variable on the right-side of this formula that is not a factor. The default is \code{~ .}, which specifies that all the terms in \code{formula(object)} will be used. If a conditioning argument is given, eg \code{terms = ~. | a}, then separate colors and smoothers are used for each unique non-missing value of \code{a}. See examples below.} \item{fitted}{If the default \code{TRUE}, then a marginal model plot in the direction of the fitted values or linear predictor of a generalized linear model will be drawn.} \item{layout}{ If set to a value like \code{c(1, 1)} or \code{c(4, 3)}, the layout of the graph will have this many rows and columns. If not set, the program will select an appropriate layout. If the number of graphs exceed nine, you must select the layout yourself, or you will get a maximum of nine per page. If \code{layout=NA}, the function does not set the layout and the user can use the \code{par} function to control the layout, for example to have plots from two models in the same graphics window. } \item{ask}{If \code{TRUE}, ask before clearing the graph window to draw more plots.} \item{main}{ Main title for the array of plots. Use \code{main=""} to suppress the title; if missing, a title will be supplied. } \item{\dots}{ Additional arguments passed from \code{mmps} to \code{mmp} and then to \code{plot}. Users should generally use \code{mmps}, or equivalently \code{marginalModelPlots}. } \item{variable}{ The quantity to be plotted on the horizontal axis. The default is the predicted values \code{predict(object)}. Can be any other vector of length equal to the number of observations in the object. Thus the \code{mmp} function can be used to get a marginal model plot versus any predictor or term while the \code{mmps} function can be used only to get marginal model plots for the first-order terms in the formula. In particular, terms defined by a spline basis are skipped by \code{mmps}, but you can use \code{mmp} to get the plot for the variable used to define the splines.} \item{sd}{ If \code{TRUE}, compare sd smooths. For a binomial regression with all sample sizes equal to one, this argument is ignored as the SD bounds don't make any sense. } \item{xlab}{ label for horizontal axis } \item{smoother}{the name of the smoother to use, selected from the choices descripbed at \code{\link{ScatterplotSmoothers}}. For linear models and the default method, the default smoother is the function is the function \code{loessLine}. For generalized linear models the default is \code{gamLine}, using the \code{gam} package and using splines. } \item{smoother.args}{arguments passed to the smoother. For linear models the defaults match the smoother used before September 2012, and may be changed later. See \code{\link{ScatterplotSmoothers}}. } \item{groups}{The name of a vector that specifies a grouping variable for separate colors/smoothers. This can also be specified as a conditioning argument on the \code{terms} argument.} \item{key}{If \code{TRUE}, include a key at the top of the plot, if \code{FALSE} omit the key. If grouping is present, the key is only printed for the upper-left plot.} \item{id.method,labels,id.n,id.cex,id.col}{Arguments for labelling points. The default \code{id.n=0} suppresses labelling, and setting this argument greater than zero will include labelling. See \code{\link{showLabels}} for these arguments.} \item{pch}{plotting character to use if no grouping is present.} \item{col.line}{ colors for data and model smooth, respectively. Using the default palette, these are blue and red. } \item{col}{color(s) for the plotted points.} \item{grid}{If TRUE, the default, a light-gray background grid is put on the graph} } \details{ \code{mmp} and \code{marginalModelPlot} draw one marginal model plot against whatever is specified as the horizontal axis. \code{mmps} and \code{marginalModelPlots} draws marginal model plots versus each of the terms in the \code{terms} argument and versus fitted values. \code{mmps} skips factors and interactions if they are specified in the \code{terms} argument. Terms based on polynomials or on splines (or potentially any term that is represented by a matrix of predictors) will be used to form a marginal model plot by returning a linear combination of the terms. For example, if you specify \code{terms ~ X1 + poly(X2, 3)} and \code{poly(X2, 3)} was part of the original model formula, the horizontal axis of the marginal model plot will be the value of \code{predict(model, type="terms")[, "poly(X2, 3)"])}. If the \code{predict} method for the model you are using doesn't support \code{type="terms"}, then the polynomial/spline term is skipped. Adding a conditioning variable, e.g., \code{terms = ~ a + b | c}, will produce marginal model plots for \code{a} and \code{b} with different colors and smoothers for each unique non-missing value of \code{c}. The smoothers used were changed in September 2012. For linear models, the default smoother is still loess with the same smoothing parameters as were used in the past, but these can be changed with the argument \code{smoother.args}. For generalized linear models, the default smoother uses \code{gamLine}, fitting a generalized additive model with the same family, link and weights as the fit of the model. SD smooths are not computed for for generalized linear models. For generalized linear models the default number of elements in the spline basis is \code{k=3}; this is done to allow fitting for predictors with just a few support points. If you have many support points you may wish to set \code{k} to a higher number, or \code{k=-1} for the default used by \code{\link{gam}}. } \value{ Used for its side effect of producing plots. } \seealso{\code{\link{ScatterplotSmoothers}}, \code{\link{plot}} } \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition. Sage. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition, Wiley, Chapter 8. } \author{Sanford Weisberg, \email{sandy@umn.edu}} \examples{ \dontrun{ c1 <- lm(infant.mortality ~ gdp, UN) mmps(c1) c2 <- update(c1, ~ poly(gdp, 4), data=na.omit(UN)) # plot against predict(c2, type="terms")[, "poly(gdp, 4)"] and # and against gdp mmps(c2, ~ poly(gdp,4) + gdp) # include SD lines p1 <- lm(prestige ~ income + education, Prestige) mmps(p1, sd=TRUE) # logisitic regression example # smoothers return warning messages. mmps(p1, ~. | type) # fit a separate smoother and color for each type of occupation. m1 <- glm(lfp ~ ., family=binomial, data=Mroz) mmps(m1) } } \keyword{hplot }% at least one, from doc/KEYWORDS \keyword{regression} car/man/wcrossprod.Rd0000644000175100001440000000300511410155075014301 0ustar hornikusers\name{wcrossprod} \alias{wcrossprod} \title{ Weighted Matrix Crossproduct } \description{ Given matrices \code{x} and \code{y} as arguments and an optional matrix or vector of weights, \code{w}, return a weighted matrix cross-product, \code{t(x) w y}. If no weights are supplied, or the weights are constant, the function uses \code{\link[base]{crossprod}} for speed. } \usage{ wcrossprod(x, y, w) } \arguments{ \item{x,y}{ x, y numeric matrices; \code{missing(y)} is taken to be the same matrix as x. Vectors are promoted to single-column or single-row matrices, depending on the context. } \item{w}{ A numeric vector or matrix of weights, conformable with \code{x} and \code{y}. } } \value{ A numeric matrix, with appropriate dimnames taken from \code{x} and \code{y}. } \author{ Michael Friendly, John Fox \email{jfox@mcmaster.ca} } \seealso{ \code{\link[base]{crossprod}} } \examples{ set.seed(12345) n <- 24 drop <- 4 sex <- sample(c("M", "F"), n, replace=TRUE) x1 <- 1:n x2 <- sample(1:n) extra <- c( rep(0, n - drop), floor(15 + 10 * rnorm(drop)) ) y1 <- x1 + 3*x2 + 6*(sex=="M") + floor(10 * rnorm(n)) + extra y2 <- x1 - 2*x2 - 8*(sex=="M") + floor(10 * rnorm(n)) + extra # assign non-zero weights to 'dropped' obs wt <- c(rep(1, n-drop), rep(.2,drop)) X <- cbind(x1, x2) Y <- cbind(y1, y2) wcrossprod(X) wcrossprod(X, w=wt) wcrossprod(X, Y) wcrossprod(X, Y, w=wt) wcrossprod(x1, y1) wcrossprod(x1, y1, w=wt) } \keyword{ array} \keyword{algebra} car/man/Burt.Rd0000644000175100001440000000171111366046456013026 0ustar hornikusers\name{Burt} \alias{Burt} \docType{data} \title{Fraudulent Data on IQs of Twins Raised Apart} \description{ The \code{Burt} data frame has 27 rows and 4 columns. The ``data'' were simply (and notoriously) manufactured. The same data are in the dataset ``twins" in the \code{alr3} package, but with different labels. } \format{ This data frame contains the following columns: \describe{ \item{IQbio}{ IQ of twin raised by biological parents } \item{IQfoster}{ IQ of twin raised by foster parents } \item{class}{ A factor with levels (note: out of order): \code{high}; \code{low}; \code{medium}. } } } \source{ Burt, C. (1966) The genetic determination of differences in intelligence: A study of monozygotic twins reared together and apart. \emph{British Journal of Psychology} \bold{57}, 137--153. } \usage{ Burt } \keyword{datasets} car/man/invResPlot.Rd0000644000175100001440000000544312166631153014216 0ustar hornikusers\name{invResPlot} \alias{invResPlot} \alias{inverseResponsePlot} \alias{inverseResponsePlot.lm} \title{Inverse Response Plots to Transform the Response} \description{ For a \code{lm} model, draws an inverse.response plot with the response \eqn{Y}{Y} on the vertical axis and the fitted values \eqn{\hat{Y}}{Yhat} on the horizontal axis. Uses \code{nls} to estimate \eqn{\lambda}{lambda} in the function \eqn{\hat{Y}=b_0+b_1Y^{\lambda}}{Yhat = b0 + b1(Y)^(lambda)}. Adds the fitted curve to the plot. \code{invResPlot} is an alias for \code{inverseResponsePlot}. } \usage{ inverseResponsePlot(model, lambda=c(-1,0,1), robust=FALSE, xlab=NULL, ...) \S3method{inverseResponsePlot}{lm}(model, lambda=c(-1,0,1), robust=FALSE, xlab=NULL, labels=names(residuals(model)), ...) invResPlot(model, ...) } \arguments{ \item{model}{A \code{lm} regression object} \item{lambda}{A vector of values for lambda. A plot will be produced with curves corresponding to these lambdas and to the least squares estimate of lambda} \item{xlab}{The horizontal axis label. If \code{NULL}, it is constructed by the function.} \item{labels}{Case labels if labeling is turned on; see \code{\link{invTranPlot}} and \code{\link{showLabels}} for arguments.} \item{robust}{If TRUE, then estimation uses Huber M-estimates with the median absolute deviation to estimate scale and k= 1.345. The default is FALSE.} \item{\dots}{Other arguments passed to \code{invTranPlot} and then to \code{plot}.} } \value{ As a side effect, a plot is produced with the response on the horizontal axis and fitted values on the vertical axis. Several lines are added to be plot as the ols estimates of the regression of \eqn{\hat{Y}}{Yhat} on \eqn{Y^{\lambda}}{Y^(lambda)}, interpreting \eqn{\lambda}{lambda} = 0 to be natural logarithms. Numeric output is a list with elements \item{lambda}{Estimate of transformation parameter for the response} \item{RSS}{The residual sum of squares at the minimum if robust=FALSE. If robust = TRUE, the value of Huber objective function is returned.} } \seealso{\code{\link{invTranPlot}}, \code{\link{powerTransform}}, \code{\link{showLabels}}} \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Pendergast, L, and Sheather, S. (in press). On sensitivity of response plot estimation of a robust estimation approach. \emph{Scandinavian Journal of Statistics}. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition, Wiley, Chapter 7. } \author{Sanford Weisberg, \code{sandy@umn.edu}} \examples{ m2 <- lm(rate ~ log(len) + log(ADT) + slim + shld + log(sigs1), Highway1) invResPlot(m2) } \keyword{ hplot }% at least one, from doc/KEYWORDS \keyword{ regression} car/man/crPlots.Rd0000644000175100001440000001177212204733747013546 0ustar hornikusers\name{crPlots} \alias{crPlots} \alias{crp} \alias{crPlot} \alias{crPlot.lm} \title{Component+Residual (Partial Residual) Plots} \description{ These functions construct component+residual plots (also called partial-residual plots) for linear and generalized linear models. } \usage{ crPlots(model, terms = ~., layout = NULL, ask, main, ...) crp(...) crPlot(model, ...) \method{crPlot}{lm}(model, variable, id.method = list(abs(residuals(model, type="pearson")), "x"), labels, id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], order=1, line=TRUE, smoother=loessLine, smoother.args=list(), smooth, span, col=palette()[1], col.lines=palette()[-1], xlab, ylab, pch=1, lwd=2, grid=TRUE, ...) } \arguments{ \item{model}{model object produced by \code{lm} or \code{glm}.} \item{terms}{ A one-sided formula that specifies a subset of the predictors. One component-plus-residual plot is drawn for each term. The default \code{~.} is to plot against all numeric predictors. For example, the specification \code{terms = ~ . - X3} would plot against all predictors except for \code{X3}. If this argument is a quoted name of one of the predictors, the component-plus-residual plot is drawn for that predictor only. } \item{layout}{ If set to a value like \code{c(1, 1)} or \code{c(4, 3)}, the layout of the graph will have this many rows and columns. If not set, the program will select an appropriate layout. If the number of graphs exceed nine, you must select the layout yourself, or you will get a maximum of nine per page. If \code{layout=NA}, the function does not set the layout and the user can use the \code{par} function to control the layout, for example to have plots from two models in the same graphics window. } \item{ask}{If \code{TRUE}, ask the user before drawing the next plot; if \code{FALSE}, the default, don't ask. This is relevant only if not all the graphs can be drawn in one window.} \item{main}{The title of the plot; if missing, one will be supplied.} \item{\dots}{\code{crPlots} passes these arguments to \code{crPlot}. \code{crPlot} passes them to \code{plot}. } \item{variable}{A quoted string giving the name of a variable for the horizontal axis } \item{id.method,labels,id.n,id.cex,id.col}{Arguments for the labelling of points. The default is \code{id.n=0} for labeling no points. See \code{\link{showLabels}} for details of these arguments. } \item{order}{order of polynomial regression performed for predictor to be plotted; default \code{1}.} \item{line}{\code{TRUE} to plot least-squares line.} \item{smoother}{Function to add a nonparametric smooth. } \item{smoother.args}{see \code{\link{ScatterplotSmoothers}} for available smooethers and arguments. } \item{smooth, span}{these arguments are included for backwards compatility: if \code{smooth=TRUE} then \code{smoother} is set to \code{loessLine}, and if \code{span} is specified, it is added to \code{smoother.args}.} \item{col}{color for points; the default is the first entry in the current color palette (see \code{\link[grDevices]{palette}} and \code{\link[graphics]{par}}).} \item{col.lines}{a list of at least two colors. The first color is used for the ls line and the second color is used for the fitted lowess line. To use the same color for both, use, for example, \code{col.lines=c("red", "red")}} \item{xlab,ylab}{labels for the x and y axes, respectively. If not set appropriate labels are created by the function.} \item{pch}{plotting character for points; default is \code{1} (a circle, see \code{\link[graphics]{par}}).} \item{lwd}{line width; default is \code{2} (see \code{\link[graphics]{par}}).} \item{grid}{If TRUE, the default, a light-gray background grid is put on the graph} } \details{ The function intended for direct use is \code{crPlots}, for which \code{crp} is an abbreviation. The model cannot contain interactions, but can contain factors. Parallel boxplots of the partial residuals are drawn for the levels of a factor. } \value{ \code{NULL}. These functions are used for their side effect of producing plots. } \references{ Cook, R. D. and Weisberg, S. (1999) \emph{Applied Regression, Including Computing and Graphics.} Wiley. Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \author{John Fox \email{jfox@mcmaster.ca}} \seealso{\code{\link{ceresPlots}}, \code{\link{avPlots}}} \examples{ crPlots(m<-lm(prestige~income+education, data=Prestige)) # get only one plot crPlots(m, terms=~ . - education) crPlots(lm(prestige ~ log2(income) + education + poly(women,2), data=Prestige)) crPlots(glm(partic != "not.work" ~ hincome + children, data=Womenlf, family=binomial)) } \keyword{hplot} \keyword{regression} car/man/CanPop.Rd0000644000175100001440000000163011401006152013245 0ustar hornikusers\name{CanPop} \alias{CanPop} \docType{data} \title{Canadian Population Data} \description{ The \code{CanPop} data frame has 16 rows and 2 columns. Decennial time-series of Canadian population, 1851--2001. } \format{ This data frame contains the following columns: \describe{ \item{year}{ census year. } \item{population}{ Population, in millions } } } \source{ Urquhart, M. C. and Buckley, K. A. H. (Eds.) (1965) \emph{Historical Statistics of Canada}. Macmillan, p. 1369. Canada (1994) \emph{Canada Year Book}. Statistics Canada, Table 3.2. Statistics Canada: \url{http://www12.statcan.ca/english/census01/products/standard/popdwell/Table-PR.cfm}. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. } \usage{ CanPop } \keyword{datasets} car/man/durbinWatsonTest.Rd0000644000175100001440000000403711401002012015377 0ustar hornikusers\name{durbinWatsonTest} \alias{durbinWatsonTest} \alias{dwt} \alias{durbinWatsonTest.lm} \alias{durbinWatsonTest.default} \alias{print.durbinWatsonTest} \title{Durbin-Watson Test for Autocorrelated Errors} \description{ Computes residual autocorrelations and generalized Durbin-Watson statistics and their bootstrapped p-values. \code{dwt} is an abbreviation for \code{durbinWatsonTest}. } \usage{ durbinWatsonTest(model, ...) dwt(...) \method{durbinWatsonTest}{lm}(model, max.lag=1, simulate=TRUE, reps=1000, method=c("resample","normal"), alternative=c("two.sided", "positive", "negative"), ...) \method{durbinWatsonTest}{default}(model, max.lag=1, ...) \method{print}{durbinWatsonTest}(x, ...) } \arguments{ \item{model}{a linear-model object, or a vector of residuals from a linear model.} \item{max.lag}{maximum lag to which to compute residual autocorrelations and Durbin-Watson statistics.} \item{simulate}{if \code{TRUE} p-values will be estimated by bootstrapping.} \item{reps}{number of bootstrap replications.} \item{method}{bootstrap method: \code{"resample"} to resample from the observed residuals; \code{"normal"} to sample normally distributed errors with 0 mean and standard deviation equal to the standard error of the regression.} \item{alternative}{sign of autocorrelation in alternative hypothesis; specify only if \code{max.lag = 1}; if \code{max.lag > 1}, then \code{alternative} is taken to be \code{"two.sided"}.} \item{\dots}{arguments to be passed down.} \item{x}{\code{durbinWatsonTest} object.} } \value{ Returns an object of type \code{"durbinWatsonTest"}. } \note{ p-values are available only from the \code{lm} method. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. } \author{John Fox \email{jfox@mcmaster.ca}} \examples{ durbinWatsonTest(lm(fconvict ~ tfr + partic + degrees + mconvict, data=Hartnagel)) } \keyword{regression} \keyword{ts} car/man/residualPlots.Rd0000644000175100001440000002116612166631153014743 0ustar hornikusers\name{residualPlots} \alias{residualPlots} \alias{residualPlots.default} \alias{residualPlots.lm} \alias{residualPlots.glm} \alias{residualPlot} \alias{residualPlot.default} \alias{residualPlot.lm} \alias{residualPlot.glm} \alias{residCurvTest} \alias{residCurvTest.lm} \alias{residCurvTest.glm} \alias{tukeyNonaddTest} \title{Residual Plots and Curvature Tests for Linear Model Fits} \description{ Plots the residuals versus each term in a mean function and versus fitted values. Also computes a curvature test for each of the plots by adding a quadratic term and testing the quadratic to be zero. This is Tukey's test for nonadditivity when plotting against fitted values. } \usage{ ### This is a generic function with only one required argument: residualPlots (model, ...) \S3method{residualPlots}{default}(model, terms = ~., layout = NULL, ask, main = "", fitted = TRUE, AsIs=TRUE, plot = TRUE, tests = TRUE, ...) \S3method{residualPlots}{lm}(model, ...) \S3method{residualPlots}{glm}(model, ...) ### residualPlots calls residualPlot, so these arguments can be ### used with either function residualPlot(model, ...) \S3method{residualPlot}{default}(model, variable = "fitted", type = "pearson", plot = TRUE, quadratic = TRUE, smoother=NULL, smoother.args=list(), col.smooth=palette()[3], labels, id.method = "y", id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], col = palette()[1], col.quad = palette()[2], xlab, ylab, lwd = 1, lty = 1, grid=TRUE, ...) \S3method{residualPlot}{lm}(model, ...) \S3method{residualPlot}{glm}(model, variable = "fitted", type = "pearson", plot = TRUE, quadratic = FALSE, smoother = loessLine, smoother.args=list(k=3), ...) } \arguments{ \item{model}{ A regression object. } \item{terms}{ A one-sided formula that specifies a subset of the predictors. One residual plot is drawn for each specified. The default \code{~ .} is to plot against all predictors. For example, the specification \code{terms = ~ . - X3} would plot against all predictors except for \code{X3}. To get a plot against fitted values only, use the arguments \code{terms = ~ 1, fitted=TRUE}, Interactions are skipped. For polynomial terms, the plot is against the first-order variable (which may be centered and scaled depending on how the \code{poly} function is used). Plots against factors are boxplots. Plots against other matrix terms, like splines, use the result of \code{predict(model), type="terms")[, variable])} as the horizontal axis; if the \code{predict} method doesn't permit this type, then matrix terms are skipped. } \item{layout}{ If set to a value like \code{c(1, 1)} or \code{c(4, 3)}, the layout of the graph will have this many rows and columns. If not set, the program will select an appropriate layout. If the number of graphs exceed nine, you must select the layout yourself, or you will get a maximum of nine per page. If \code{layout=NA}, the function does not set the layout and the user can use the \code{par} function to control the layout, for example to have plots from two models in the same graphics window. } \item{ask}{ If \code{TRUE}, ask the user before drawing the next plot; if \code{FALSE}, don't ask. } \item{main}{ Main title for the graphs. The default is \code{main=""} for no title. } \item{fitted}{ If \code{TRUE}, the default, include the plot against fitted values. } \item{AsIs}{ If \code{FALSE}, terms that use the \dQuote{as-is} function \code{I} are skipped; if \code{TRUE}, the default, they are included. } \item{plot}{ If \code{TRUE}, draw the plot(s). } \item{tests}{ If \code{TRUE}, display the curvature tests. With glm's, the argument \code{start} is ignored in computing the curvature tests. } \item{...}{ Additional arguments passed to \code{residualPlot} and then to \code{plot}. } \item{variable}{ Quoted variable name for the horizontal axis, or \code{"fitted"} to plot versus fitted values. } \item{type}{ Type of residuals to be used. Pearson residuals are appropriate for \code{lm} objects since these are equivalent to ordinary residuals with ols and correctly weighted residuals with wls. Any quoted string that is an appropriate value of the \code{type} argument to \code{\link{residuals.lm}} or \code{"rstudent"} or \code{"rstandard"} for Studentized or standardized residuals. } \item{quadratic}{ if \code{TRUE}, fits the quadratic regression of the vertical axis on the horizontal axis and displays a lack of fit test. Default is \code{TRUE} for \code{lm} and \code{}FALSE for \code{glm}. } \item{smoother}{the name of the smoother to use, selected from the choices descripbed at \code{\link{ScatterplotSmoothers}} For \code{lm} objects the default is \code{NULL}. For \code{glm} object the default is \code{loessLine}. } \item{smoother.args}{arguments passed to the smoother. See \code{\link{ScatterplotSmoothers}}. For generalized linear models the number of elements in the spline basis is set to \code{k=3}; this is done to allow fitting for predictors with just a few support points. If you have many support points you may wish to set \code{k} to a higher number, or \code{k=-1} for the default used by \code{\link{gam}}. } \item{col.smooth}{color for the smoother } \item{id.method,labels,id.n,id.cex,id.col}{Arguments for the labelling of points. The default is \code{id.n=0} for labeling no points. See \code{\link{showLabels}} for details of these arguments. } \item{col}{ default color for points } \item{col.quad}{ default color for quadratic fit } \item{xlab}{ X-axis label. If not specified, a useful label is constructed by the function. } \item{ylab}{ Y-axis label. If not specified, a useful label is constructed by the function. } \item{lwd}{ line width for lines. } \item{lty}{ line type for quadratic. } \item{grid}{If TRUE, the default, a light-gray background grid is put on the graph} } \details{ \code{residualPlots} draws one or more residuals plots depending on the value of the \code{terms} and \code{fitted} arguments. If \code{terms = ~ .}, the default, then a plot is produced of residuals versus each first-order term in the formula used to create the model. Interaction terms, spline terms, and polynomial terms of more than one predictor are skipped. In addition terms that use the \dQuote{as-is} function, e.g., \code{I(X^2)}, will also be skipped unless you set the argument \code{AsIs=TRUE}. A plot of residuals versus fitted values is also included unless \code{fitted=FALSE}. In addition to plots, a table of curvature tests is displayed. For plots against a term in the model formula, say \code{X1}, the test displayed is the t-test for for \code{I(X^2)} in the fit of \code{update, model, ~. + I(X^2))}. Econometricians call this a specification test. For factors, the displayed plot is a boxplot, and no curvature test is computed. For fitted values, the test is Tukey's one-degree-of-freedom test for nonadditivity. You can suppress the tests with the argument \code{tests=FALSE}. \code{residualPlot}, which is called by \code{residualPlots}, should be viewed as an internal function, and is included here to display its arguments, which can be used with \code{residualPlots} as well. The \code{residualPlot} function returns the curvature test as an invisible result. \code{residCurvTest} computes the curvature test only. For any factors a boxplot will be drawn. For any polynomials, plots are against the linear term. Other non-standard predictors like B-splines are skipped. } \value{ For \code{lm} objects, returns a data.frame with one row for each plot drawn, one column for the curvature test statistic, and a second column for the corresponding p-value. This function is used primarily for its side effect of drawing residual plots. } \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition. Sage. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition, Wiley, Chapter 8} \author{Sanford Weisberg, \email{sandy@umn.edu}} \seealso{See Also \code{\link{lm}}, \code{\link{identify}}, \code{\link{showLabels}} } \examples{ residualPlots(lm(longley)) } \keyword{ hplot }% at least one, from doc/KEYWORDS \keyword{ regression }% __ONLY ONE__ keyword per line car/man/subsets.Rd0000644000175100001440000000545711424555002013600 0ustar hornikusers\name{subsets} \alias{subsets} \alias{subsets.regsubsets} \title{Plot Output from regsubsets Function in leaps package} \description{ The \code{\link[leaps]{regsubsets}} function in the \pkg{leaps} package finds optimal subsets of predictors. This function plots a measure of fit (see the \code{statistic} argument below) against subset size. } \usage{ subsets(object, ...) \method{subsets}{regsubsets}(object, names=abbreviate(object$xnames, minlength = abbrev), abbrev=1, min.size=1, max.size=length(names), legend, statistic=c("bic", "cp", "adjr2", "rsq", "rss"), las=par('las'), cex.subsets=1, ...) } \arguments{ \item{object}{a \code{regsubsets} object produced by the \code{regsubsets} function in the \pkg{leaps} package.} \item{names}{a vector of (short) names for the predictors, excluding the regression intercept, if one is present; if missing, these are derived from the predictor names in \code{object}.} \item{abbrev}{minimum number of characters to use in abbreviating predictor names.} \item{min.size}{minimum size subset to plot; default is \code{1}.} \item{max.size}{maximum size subset to plot; default is number of predictors.} \item{legend}{\code{TRUE} to plot a legend of predictor names; defaults to \code{TRUE} if abbreviations are computed for predictor names. The legend is placed on the plot interactively with the mouse. By expanding the left or right plot margin, you can place the legend in the margin, if you wish (see \code{\link{par}}).} \item{statistic}{statistic to plot for each predictor subset; one of: \code{"bic"}, Bayes Information Criterion; \code{"cp"}, Mallows's \eqn{C_{p}}{Cp}; \code{"adjr2"}, \eqn{R^{2}}{R^2} adjusted for degrees of freedom; \code{"rsq"}, unadjusted \eqn{R^{2}}{R^2}; \code{"rss"}, residual sum of squares.} \item{las}{if \code{0}, ticks labels are drawn parallel to the axis; set to \code{1} for horizontal labels (see \code{\link[graphics]{par}}).} \item{cex.subsets}{can be used to change the relative size of the characters used to plot the regression subsets; default is \code{1}.} \item{\dots}{arguments to be passed down to \code{subsets.regsubsets} and \code{plot}.} } \value{ \code{NULL} if the \code{legend} is \code{TRUE}; otherwise a data frame with the legend. } \author{John Fox} \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \seealso{\code{\link[leaps]{regsubsets}}} \examples{ if (interactive() && require(leaps)){ subsets(regsubsets(undercount ~ ., data=Ericksen)) } } \keyword{hplot} \keyword{regression} car/man/dfbetaPlots.Rd0000644000175100001440000000756311576447475014405 0ustar hornikusers\name{dfbetaPlots} \alias{dfbetaPlots} \alias{dfbetasPlots} \alias{dfbetaPlots.lm} \alias{dfbetasPlots.lm} \title{dfbeta and dfbetas Index Plots} \description{ These functions display index plots of dfbeta (effect on coefficients of deleting each observation in turn) and dfbetas (effect on coefficients of deleting each observation in turn, standardized by a deleted estimate of the coefficient standard error). In the plot of dfbeta, horizontal lines are drawn at 0 and +/- one standard error; in the plot of dfbetas, horizontal lines are drawn and 0 and +/- 1. } \usage{ dfbetaPlots(model, ...) dfbetasPlots(model, ...) \method{dfbetaPlots}{lm}(model, terms= ~ ., intercept=FALSE, layout=NULL, ask, main, xlab, ylab, labels=rownames(dfbeta), id.method="y", id.n=if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], col=palette()[1], grid=TRUE, ...) \method{dfbetasPlots}{lm}(model, terms=~., intercept=FALSE, layout=NULL, ask, main, xlab, ylab, labels=rownames(dfbeta), id.method="y", id.n=if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], col=palette()[1], grid=TRUE, ...) } \arguments{ \item{model}{model object produced by \code{lm} or \code{glm}. } \item{terms}{ A one-sided formula that specifies a subset of the terms in the model. One dfbeta or dfbetas plot is drawn for each regressor. The default \code{~.} is to plot against all terms in the model with the exception of an intercept. For example, the specification \code{terms = ~.-X3} would plot against all terms except for \code{X3}. If this argument is a quoted name of one of the terms, the index plot is drawn for that term only. } \item{intercept}{Include the intercept in the plots; default is \code{FALSE}.} \item{layout}{ If set to a value like \code{c(1, 1)} or \code{c(4, 3)}, the layout of the graph will have this many rows and columns. If not set, the program will select an appropriate layout. If the number of graphs exceed nine, you must select the layout yourself, or you will get a maximum of nine per page. If \code{layout=NA}, the function does not set the layout and the user can use the \code{par} function to control the layout, for example to have plots from two models in the same graphics window. } \item{main}{The title of the graph; if missing, one will be supplied. } \item{xlab}{Horizontal axis label; defaults to \code{"Index"}.} \item{ylab}{Vertical axis label; defaults to coefficient name.} \item{ask}{If \code{TRUE}, ask the user before drawing the next plot; if \code{FALSE}, the default, don't ask. } \item{\dots}{optional additional arguments to be passed to \code{\link{plot}}, \code{\link{points}}, and \code{\link{showLabels}}}. \item{id.method,labels,id.n,id.cex,id.col}{Arguments for the labelling of points. The default is \code{id.n=0} for labeling no points. See \code{\link{showLabels}} for details of these arguments. } \item{col}{color for points; defaults to the first entry in the color \code{\link{palette}}.} \item{grid}{If \code{TRUE}, the default, a light-gray background grid is put on the graph} } \value{ \code{NULL}. These functions are used for their side effect: producing plots. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \author{John Fox \email{jfox@mcmaster.ca}, Sanford Weisberg \email{sandy@umn.edu}} \seealso{\code{\link{dfbeta}} ,\code{\link{dfbetas}}} \examples{ dfbetaPlots(lm(prestige ~ income + education + type, data=Duncan)) dfbetasPlots(glm(partic != "not.work" ~ hincome + children, data=Womenlf, family=binomial)) } \keyword{hplot} \keyword{regression} car/man/plot.powerTransform.Rd0000644000175100001440000000317512166631153016116 0ustar hornikusers\name{plot.powerTransform} \Rdversion{1.1} \alias{plot.powerTransform} \title{ plot Method for powerTransform Objects } \description{ This function provides a simple function for plotting data using power transformations. } \usage{ \method{plot}{powerTransform}(x, z = NULL, round = TRUE, plot = pairs, ...) } \arguments{ \item{x}{name of the power transformation object } \item{z}{ Additional variables of the same length as those used to get the transformation to be plotted, default is \code{NULL}. } \item{round}{ If \code{TRUE}, the default, use rounded transforms, if \code{FALSE} use the MLEs. } \item{plot}{ Plotting method. Default is \code{pairs}. Another possible choice is \code{scatterplot.matrix} from the \code{car} package. } \item{\dots}{ Optional arguments passed to the plotting method } } \details{ The data used to estimate transformations using \code{powerTransform} are plotted in the transformed scale. } \value{ None. Produces a graph as a side-effect. } \references{ Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition. Wiley. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Linear Regression}, Second Edition, Sage. } \author{ Sanford Weisberg, } \seealso{ \code{\link{powerTransform}} } \examples{ summary(a3 <- powerTransform(cbind(len, ADT, trks, sigs1) ~ hwy, Highway1)) with(Highway1, plot(a3, z=rate, col=as.numeric(hwy))) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. \keyword{ hplot } \keyword{ regression }% __ONLY ONE__ keyword per line car/man/qqPlot.Rd0000644000175100001440000001221511536443644013372 0ustar hornikusers\name{qqPlot} \alias{qqPlot} \alias{qqp} \alias{qqPlot.default} \alias{qqPlot.lm} \alias{qqPlot.glm} \title{Quantile-Comparison Plots} \description{ Plots empirical quantiles of a variable, or of studentized residuals from a linear model, against theoretical quantiles of a comparison distribution. } \usage{ qqPlot(x, ...) qqp(...) \method{qqPlot}{default}(x, distribution="norm", ..., ylab=deparse(substitute(x)), xlab=paste(distribution, "quantiles"), main=NULL, las=par("las"), envelope=.95, col=palette()[1], col.lines=palette()[2], lwd=2, pch=1, cex=par("cex"), line=c("quartiles", "robust", "none"), labels = if(!is.null(names(x))) names(x) else seq(along=x), id.method = "y", id.n =if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], grid=TRUE) \method{qqPlot}{lm}(x, xlab=paste(distribution, "Quantiles"), ylab=paste("Studentized Residuals(", deparse(substitute(x)), ")", sep=""), main=NULL, distribution=c("t", "norm"), line=c("robust", "quartiles", "none"), las=par("las"), simulate=TRUE, envelope=.95, reps=100, col=palette()[1], col.lines=palette()[2], lwd=2, pch=1, cex=par("cex"), labels, id.method = "y", id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], grid=TRUE, ...) } \arguments{ \item{x}{vector of numeric values or \code{lm} object.} \item{distribution}{root name of comparison distribution -- e.g., \code{"norm"} for the normal distribution; \code{t} for the t-distribution.} \item{ylab}{label for vertical (empirical quantiles) axis.} \item{xlab}{label for horizontal (comparison quantiles) axis.} \item{main}{label for plot.} \item{envelope}{confidence level for point-wise confidence envelope, or \code{FALSE} for no envelope.} \item{las}{if \code{0}, ticks labels are drawn parallel to the axis; set to \code{1} for horizontal labels (see \code{\link[graphics]{par}}).} \item{col}{color for points; the default is the \emph{first} entry in the current color palette (see \code{\link[grDevices]{palette}} and \code{\link[graphics]{par}}).} \item{col.lines}{color for lines; the default is the \emph{second} entry in the current color palette.} \item{pch}{plotting character for points; default is \code{1} (a circle, see \code{\link[graphics]{par}}).} \item{cex}{factor for expanding the size of plotted symbols; the default is \code{1}.} \item{labels}{vector of text strings to be used to identify points, defaults to \code{names(x)} or observation numbers if \code{names(x)} is \code{NULL}.} \item{id.method}{point identification method. The default \code{id.method="y"} will identify the \code{id.n} points with the largest value of \code{abs(y-mean(y))}. See \code{\link{showLabels}} for other options.} \item{id.n}{number of points labeled. If \code{id.n=0}, the default, no point identification.} \item{id.cex}{set size of the text for point labels; the default is \code{cex} (which is typically \code{1}).} \item{id.col}{color for the point labels.} \item{lwd}{line width; default is \code{2} (see \code{\link[graphics]{par}}).} \item{line}{\code{"quartiles"} to pass a line through the quartile-pairs, or \code{"robust"} for a robust-regression line; the latter uses the \code{rlm} function in the \code{MASS} package. Specifying \code{line = "none"} suppresses the line.} \item{simulate}{if \code{TRUE} calculate confidence envelope by parametric bootstrap; for \code{lm} object only. The method is due to Atkinson (1985).} \item{reps}{integer; number of bootstrap replications for confidence envelope.} \item{\dots}{arguments such as \code{df} to be passed to the appropriate quantile function.} \item{grid}{If TRUE, the default, a light-gray background grid is put on the graph} } \details{ Draws theoretical quantile-comparison plots for variables and for studentized residuals from a linear model. A comparison line is drawn on the plot either through the quartiles of the two distributions, or by robust regression. Any distribution for which quantile and density functions exist in R (with prefixes \code{q} and \code{d}, respectively) may be used. Studentized residuals from linear models are plotted against the appropriate t-distribution. The function \code{qqp} is an abbreviation for \code{qqPlot}. } \value{ These functions return the labels of identified points. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Atkinson, A. C. (1985) \emph{Plots, Transformations, and Regression.} Oxford. } \author{John Fox \email{jfox@mcmaster.ca}} \seealso{\code{\link[stats]{qqplot}}, \code{\link[stats]{qqnorm}}, \code{\link[stats]{qqline}}, \code{\link{showLabels}}} \examples{ x<-rchisq(100, df=2) qqPlot(x) qqPlot(x, dist="chisq", df=2) qqPlot(lm(prestige ~ income + education + type, data=Duncan), envelope=.99) } \keyword{distribution} \keyword{univar} \keyword{regression} car/man/Davis.Rd0000644000175100001440000000236311401002012013126 0ustar hornikusers\name{Davis} \alias{Davis} \docType{data} \title{Self-Reports of Height and Weight} \description{ The \code{Davis} data frame has 200 rows and 5 columns. The subjects were men and women engaged in regular exercise. There are some missing data. } \format{ This data frame contains the following columns: \describe{ \item{sex}{ A factor with levels: \code{F}, female; \code{M}, male. } \item{weight}{ Measured weight in kg. } \item{height}{ Measured height in cm. } \item{repwt}{ Reported weight in kg. } \item{repht}{ Reported height in cm. } } } \source{ Personal communication from C. Davis, Departments of Physical Education and Psychology, York University. } \references{ Davis, C. (1990) Body image and weight preoccupation: A comparison between exercising and non-exercising women. \emph{Appetite}, \bold{15}, 13--21. Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \usage{ Davis } \keyword{datasets} car/man/invTranPlot.Rd0000644000175100001440000001103712166631153014365 0ustar hornikusers\name{invTranPlot} \alias{invTranPlot} \alias{invTranPlot.default} \alias{invTranPlot.formula} \alias{invTranEstimate} \title{ Choose a Predictor Transformation Visually or Numerically } \description{ \code{invTranPlot} draws a two-dimensional scatterplot of \eqn{Y}{Y} versus \eqn{X}{X}, along with the OLS fit from the regression of \eqn{Y}{Y} on \eqn{(X^{\lambda}-1)/\lambda}{(Y^(lam)-1)/lam}. \code{invTranEstimate} finds the nonlinear least squares estimate of \eqn{\lambda}{lambda} and its standard error. } \usage{ invTranPlot(x, ...) \S3method{invTranPlot}{formula}(x, data, subset, na.action, ...) \S3method{invTranPlot}{default}(x, y, lambda=c(-1, 0, 1), robust=FALSE, lty.lines=rep(c("solid", "dashed", "dotdash", "longdash", "twodash"), length=1 + length(lambda)), lwd.lines=2, col=palette()[1], col.lines=palette(), xlab=deparse(substitute(x)), ylab=deparse(substitute(y)), family="bcPower", optimal=TRUE, key="auto", id.method = "x", labels, id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], grid=TRUE, ...) invTranEstimate(x, y, family="bcPower", confidence=0.95, robust=FALSE) } \arguments{ \item{x}{The predictor variable, or a formula with a single response and a single predictor } \item{y}{The response variable } \item{data}{An optional data frame to get the data for the formula} \item{subset}{Optional, as in \code{lm}, select a subset of the cases} \item{na.action}{Optional, as in \code{lm}, the action for missing data} \item{lambda}{The powers used in the plot. The optimal power than minimizes the residual sum of squares is always added unless optimal is \code{FALSE}. } \item{robust}{If TRUE, then the estimated transformation is computed using Huber M-estimation with the MAD used to estimate scale and k=1.345. The default is FALSE.} \item{family}{The transformation family to use, \code{"bcPower"}, \code{"yjPower"}, or a user-defined family.} \item{confidence}{returns a profile likelihood confidence interval for the optimal transformation with this confidence level. If \code{FALSE}, or if \code{robust=TRUE}, no interval is returned.} \item{optimal}{Include the optimal value of lambda?} \item{lty.lines}{line types corresponding to the powers} \item{lwd.lines}{the width of the plotted lines, defaults to 2 times the standard} \item{col}{color(s) of the points in the plot. If you wish to distinguish points according to the levels of a factor, we recommend using symbols, specified with the \code{pch} argument, rather than colors.} \item{col.lines}{color of the fitted lines corresponding to the powers. The default is to use the colors returned by \code{\link{palette}}} \item{key}{The default is \code{"auto"}, in which case a legend is added to the plot, either above the top marign or in the bottom right or top right corner. Set to NULL to suppress the legend.} \item{xlab}{Label for the horizontal axis.} \item{ylab}{Label for the vertical axis.} \item{id.method,labels,id.n,id.cex,id.col}{Arguments for the labelling of points. The default is \code{id.n=0} for labeling no points. See \code{\link{showLabels}} for details of these arguments. } \item{...}{Additional arguments passed to the plot method, such as \code{pch}.} \item{grid}{If TRUE, the default, a light-gray background grid is put on the graph} } \value{ \code{invTranPlot} plots a graph and returns a data frame with \eqn{\lambda}{lam} in the first column, and the residual sum of squares from the regression for that \eqn{\lambda}{lam} in the second column. \code{invTranEstimate} returns a list with elements \code{lambda} for the estimate, \code{se} for its standard error, and \code{RSS}, the minimum value of the residual sum of squares. } \seealso{ \code{\link{inverseResponsePlot}},\code{\link{optimize}}} \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Pendergast, L, and Sheather, S. (in press). On sensitivity of response plot estimation of a robust estimation approach. \emph{Scandinavian Journal of Statistics}. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition. Wiley. } \author{Sanford Weisberg, \email{sandy@umn.edu} } \examples{ with(UN, invTranPlot(gdp, infant.mortality)) with(UN, invTranEstimate(gdp, infant.mortality)) } \keyword{ hplot }% at least one, from doc/KEYWORDS \keyword{regression} car/man/Florida.Rd0000644000175100001440000000222211364355404013462 0ustar hornikusers\name{Florida} \alias{Florida} \docType{data} \title{Florida County Voting} \description{ The \code{Florida} data frame has 67 rows and 11 columns. Vote by county in Florida for President in the 2000 election. } \format{ This data frame contains the following columns: \describe{ \item{GORE}{ Number of votes for Gore } \item{BUSH}{ Number of votes for Bush. } \item{BUCHANAN}{ Number of votes for Buchanan. } \item{NADER}{ Number of votes for Nader. } \item{BROWNE}{ Number of votes for Browne (whoever that is). } \item{HAGELIN}{ Number of votes for Hagelin (whoever that is). } \item{HARRIS}{ Number of votes for Harris (whoever that is). } \item{MCREYNOLDS}{ Number of votes for McReynolds (whoever that is). } \item{MOOREHEAD}{ Number of votes for Moorehead (whoever that is). } \item{PHILLIPS}{ Number of votes for Phillips (whoever that is). } \item{Total}{ Total number of votes. } } } \source{ Adams, G. D. and Fastnow, C. F. (2000) A note on the voting irregularities in Palm Beach, FL. Formerly at \url{http://madison.hss.cmu.edu/}, but no longer available there. } \usage{ Florida } \keyword{datasets} car/man/Bfox.Rd0000644000175100001440000000255611401002012012762 0ustar hornikusers\name{Bfox} \alias{Bfox} \docType{data} \title{Canadian Women's Labour-Force Participation} \description{ The \code{Bfox} data frame has 30 rows and 7 columns. Time-series data on Canadian women's labor-force participation, 1946--1975. } \format{ This data frame contains the following columns: \describe{ \item{partic}{ Percent of adult women in the workforce. } \item{tfr}{ Total fertility rate: expected births to a cohort of 1000 women at current age-specific fertility rates. } \item{menwage}{ Men's average weekly wages, in constant 1935 dollars and adjusted for current tax rates. } \item{womwage}{ Women's average weekly wages. } \item{debt}{ Per-capita consumer debt, in constant dollars. } \item{parttime}{ Percent of the active workforce working 34 hours per week or less. } } } \section{Warning}{ The value of \code{tfr} for 1973 is misrecorded as 2931; it should be 1931. } \source{ Fox, B. (1980) \emph{Women's Domestic Labour and their Involvement in Wage Work.} Unpublished doctoral dissertation, p. 449. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. } \usage{ Bfox } \keyword{datasets} car/man/Guyer.Rd0000644000175100001440000000251111401002012013146 0ustar hornikusers\name{Guyer} \alias{Guyer} \docType{data} \title{Anonymity and Cooperation} \description{ The \code{Guyer} data frame has 20 rows and 3 columns. The data are from an experiment in which four-person groups played a prisoner's dilemma game for 30 trails, each person making either a cooperative or competitive choice on each trial. Choices were made either anonymously or in public; groups were composed either of females or of males. The observations are 20 groups. } \format{ This data frame contains the following columns: \describe{ \item{cooperation}{ Number of cooperative choices (out of 120 in all). } \item{condition}{ A factor with levels: \code{A}, Anonymous; \code{P}, Public-Choice. } \item{sex}{ Sex. A factor with levels: \code{F}, Female; \code{M}, Male. } } } \source{ Fox, J. and Guyer, M. (1978) Public choice and cooperation in n-person prisoner's dilemma. \emph{Journal of Conflict Resolution} \bold{22}, 469--481. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \usage{ Guyer } \keyword{datasets} car/man/Salaries.Rd0000644000175100001440000000215611401002012013623 0ustar hornikusers\name{Salaries} \Rdversion{1.1} \alias{Salaries} \docType{data} \title{ Salaries for Professors } \description{ The 2008-09 nine-month academic salary for Assistant Professors, Associate Professors and Professors in a college in the U.S. The data were collected as part of the on-going effort of the college's administration to monitor salary differences between male and female faculty members. } \usage{Salaries} \format{ A data frame with 397 observations on the following 6 variables. \describe{ \item{\code{rank}}{a factor with levels \code{AssocProf} \code{AsstProf} \code{Prof}} \item{\code{discipline}}{a factor with levels \code{A} (``theoretical'' departments) or \code{B} (``applied'' departments).} \item{\code{yrs.since.phd}}{years since PhD.} \item{\code{yrs.service}}{years of service.} \item{\code{sex}}{a factor with levels \code{Female} \code{Male}} \item{\code{salary}}{nine-month salary, in dollars.} } } \references{ Fox J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition Sage. } \keyword{datasets} car/man/WeightLoss.Rd0000644000175100001440000000214111313776250014172 0ustar hornikusers\name{WeightLoss} \Rdversion{1.1} \alias{WeightLoss} \docType{data} \title{ Weight Loss Data } \description{ Contrived data on weight loss and self esteem over three months, for three groups of individuals: Control, Diet and Diet + Exercise. The data constitute a double-multivariate design. } \usage{WeightLoss} \format{ A data frame with 34 observations on the following 7 variables. \describe{ \item{\code{group}}{a factor with levels \code{Control} \code{Diet} \code{DietEx}.} \item{\code{wl1}}{Weight loss at 1 month} \item{\code{wl2}}{Weight loss at 2 months} \item{\code{wl3}}{Weight loss at 3 months} \item{\code{se1}}{Self esteem at 1 month} \item{\code{se2}}{Self esteem at 2 months} \item{\code{se3}}{Self esteem at 3 months} } } \details{ Helmert contrasts are assigned to \code{group}, comparing \code{Control} vs. (\code{Diet} \code{DietEx}) and \code{Diet} vs. \code{DietEx}. } \source{ Originally taken from \url{http://www.csun.edu/~ata20315/psy524/main.htm}, but modified slightly. Courtesy of Michael Friendly. } \keyword{datasets} car/man/ScatterplotSmoothers.Rd0000644000175100001440000001421412027126234016310 0ustar hornikusers\name{ScatterplotSmoothers} \alias{ScatterplotSmoothers} \alias{gamLine} \alias{quantregLine} \alias{loessLine} \title{ Smoothers to Draw Lines on Scatterplots } \description{ These smoothers are used to draw nonparametric-regression lines on scatterplots produced by the \code{\link{scatterplot}}, \code{\link{scatterplotMatrix}} and other \code{car} functions. The functions aren't meant to be called directly by the user, although the user can supply options via the \code{smoother.args} argument, the contents of which vary by the smoother (see \emph{Details} below). The \code{gamLine} smoother uses the \code{\link[mgcv]{gam}} function in the \pkg{mgcv} package, the \code{loessLine} smoother uses the \code{\link[stats]{loess}} function in the \pkg{stats} package, and the \code{quantregLine} smoother uses the \code{\link[quantreg]{rqss}} function in the \pkg{quantreg} package. } \usage{ gamLine(x, y, col, log.x, log.y, spread=FALSE, smoother.args, draw=TRUE) loessLine(x, y, col, log.x, log.y, spread=FALSE, smoother.args, draw=TRUE) quantregLine(x, y, col, log.x, log.y, spread=FALSE, smoother.args, draw=TRUE) } \arguments{ \item{x}{$x$ coordinates of points.} \item{y}{$y$ coordinates of points.} \item{col}{line color.} \item{log.x}{\code{TRUE} if the $x$-axis is logged.} \item{log.y}{\code{TRUE} if the $y$-axis is logged.} \item{spread}{the default is to plot only an estimated mean or median. If this argument is TRUE, then a measure of spread is also plotted.} \item{smoother.args}{additional options accapted by the smoother, in the form of a list of named values (see \emph{Details} below).} \item{draw}{if TRUE, the default, draw the smoother on the currently active graph. If FALSE, return a list with coordinates \code{x} and \code{y} for the points that make up the smooth and if requested \code{x.pos, y.pos, x.neg, y.neg} for the spread smooths.} } \details{ The function \code{loessLine} is a reimplementation of the \code{loess} smoother that has been used in \code{car} prior to September 2012. The only enhancement is the ability to set more arguments through the \code{smoother.args} argument. The function \code{gamLine} is new and more general than the \code{loess} fitting because it allows fitting a generalized additive model using splines. You can specify a error distribution and link function. The function \code{quantregLine} fits an additive model using splines with estimation based on L1 regression and quantile regression if you ask for the spread. It is likely to be more robust than the other smoothers. The argument \code{smoother.args} is a list of named elements used to pass additional arguments to the smoother. For \code{loessLine} the default value is \code{smoother.args=list(lty=1, lwd=2, lty.spread=2, lwd.spread=1, span=0.5, degree=2, family="symmetric", iterations=4)}. The arguments \code{lty} and \code{lwd} are the type and width respectively of the mean or median smooth, \code{smooth.lty} and \code{smooth.lwd} are the type and color of the spread smooths if requested. The arguments \code{span}, \code{degree} and \code{family} are passed to the \code{\link{loess}} function, \code{iterations=0} by default specifies no robustness iterations. For \code{gamLine} the default is \code{smoother.args=list(lty=1, lwd=2, lty.spread=2, lwd.spread=1, k=-1, bs="tp", family="gaussian", link=NULL, weights=NULL)} The first for arguments are as for \code{loessLine}. The next two arguments are passed to the \code{gam} function to control the smoothing: \code{k=-1} allows \code{gam} to choose the number of splines in the basis function; \code{bs="tp"} provides the type of spline basis to be used with \code{"tp"} for the default thin-plate splines. The last three arguments allow providing a family, link and weights as in generalized linear models. See examples below. For \code{quantregLine} the default is \code{smoother.args=list(lty=1, lwd=2, lty.spread=2, lwd.spread=1, lambda=IQR(x)}. The first four arguments are as for \code{loessLine}. The last argument is passed to the \code{\link[quantreg]{qss}} function in \code{quantreg}. It is a smoothing parameter, here a robust estimate of the scale of the horizontal axis variable. This is an arbitrary choice, and may not work well in all circumstances. } \author{John Fox \email{jfox@mcmaster.ca} and Sanford Weisberg\email{sandy@umn.edu}.} \seealso{\code{\link{scatterplot}}, \code{\link{scatterplotMatrix}}, \code{\link[mgcv]{gam}}, \code{\link[stats]{loess}}, and \code{\link[quantreg]{rqss}}.} \examples{ scatterplot(prestige ~ income, data=Prestige) scatterplot(prestige ~ income, data=Prestige, smoother=gamLine) scatterplot(prestige ~ income, data=Prestige, smoother=quantregLine) scatterplot(prestige ~ income | type, data=Prestige) scatterplot(prestige ~ income | type, data=Prestige, smoother=gamLine) scatterplot(prestige ~ income | type, data=Prestige, smoother=quantregLine) scatterplot(prestige ~ income | type, data=Prestige, smoother=NULL) scatterplot(prestige ~ income | type, data=Prestige, spread=TRUE) scatterplot(prestige ~ income | type, data=Prestige, smoother=gamLine, spread=TRUE) scatterplot(prestige ~ income | type, data=Prestige, smoother=quantregLine, spread=TRUE) scatterplot(weight ~ repwt | sex, spread=TRUE, data=Davis, smoother=loessLine) scatterplot(weight ~ repwt | sex, spread=TRUE, data=Davis, smoother=gamLine) # messes up scatterplot(weight ~ repwt | sex, spread=TRUE, data=Davis, smoother=quantregLine) # robust set.seed(12345) w <- 1 + rpois(100, 5) x <- rnorm(100) p <- 1/(1 + exp(-(x + 0.5*x^2))) s <- rbinom(100, w, p) scatterplot(s/w ~ x, smoother=gamLine, smoother.args=list(family="binomial", weights=w)) scatterplot(s/w ~ x, smoother=gamLine, smoother.args=list(family=binomial, link="probit", weights=w)) scatterplot(s/w ~ x, smoother=gamLine, smoother.args=list(family=binomial, link="probit", weights=w)) scatterplot(s/w ~ x, smoother=loessLine, reg=FALSE) y <- rbinom(100, 1, p) scatterplot(y ~ x, smoother=gamLine, smoother.args=list(family=binomial)) } \keyword{hplot} car/man/Anova.Rd0000644000175100001440000003510412161401342013140 0ustar hornikusers%------------------------------------------------------------------------------- % Revision history: % checked in 2008-12-29 by J. Fox (corresponds to version 1.2-10 of car) % 2009-01-16 updated doc to correspond to changes in linearHypothesis. J. Fox % 2009-09-16 updated to reflect new singular.ok argument % 2009-09-26 updated for removal from car. J. Fox % 2009-12-22 updated to reflect new imatrix argument to Anova.mlm(). J. Fox % 2012-02-28 updated to reflect new test.statistic argument to Anova.mer(). J. Fox % 2012-03-01 removed commented-out output listings. J. Fox % 2013-06-17 update for summary.Anova.mlm and print.summary.Anova.mlm. J. Fox % 2013-06-20 added Anova.merMod(). J. Fox %------------------------------------------------------------------------------- \name{Anova} \alias{Anova} \alias{Anova.lm} \alias{Anova.lme} \alias{Anova.aov} \alias{Anova.glm} \alias{Anova.multinom} \alias{Anova.polr} \alias{Anova.mer} \alias{Anova.merMod} \alias{Anova.mlm} \alias{Anova.manova} \alias{Manova} \alias{Manova.mlm} \alias{print.Anova.mlm} \alias{summary.Anova.mlm} \alias{print.summary.Anova.mlm} \alias{Anova.coxph} \alias{Anova.svyglm} \alias{Anova.default} \title{Anova Tables for Various Statistical Models} \description{ Calculates type-II or type-III analysis-of-variance tables for model objects produced by \code{lm}, \code{glm}, \code{multinom} (in the \pkg{nnet} package), \code{polr} (in the \pkg{MASS} package), \code{coxph} (in the \pkg{survival} package), \code{lmer} in the \pkg{lme4} package, \code{lme} in the \pkg{nlme} package, and for any model with a linear predictor and asymptotically normal coefficients that responds to the \code{vcov} and \code{coef} functions. For linear models, F-tests are calculated; for generalized linear models, likelihood-ratio chisquare, Wald chisquare, or F-tests are calculated; for multinomial logit and proportional-odds logit models, likelihood-ratio tests are calculated. Various test statistics are provided for multivariate linear models produced by \code{lm} or \code{manova}. Partial-likelihood-ratio tests or Wald tests are provided for Cox models. Wald chi-square tests are provided for fixed effects in linear and generalized linear mixed-effects models. Wald chi-square or F tests are provided in the default case. } \usage{ Anova(mod, ...) Manova(mod, ...) \method{Anova}{lm}(mod, error, type=c("II","III", 2, 3), white.adjust=c(FALSE, TRUE, "hc3", "hc0", "hc1", "hc2", "hc4"), singular.ok, ...) \method{Anova}{aov}(mod, ...) \method{Anova}{glm}(mod, type=c("II","III", 2, 3), test.statistic=c("LR", "Wald", "F"), error, error.estimate=c("pearson", "dispersion", "deviance"), singular.ok, ...) \method{Anova}{multinom}(mod, type = c("II","III", 2, 3), ...) \method{Anova}{polr}(mod, type = c("II","III", 2, 3), ...) \method{Anova}{mlm}(mod, type=c("II","III", 2, 3), SSPE, error.df, idata, idesign, icontrasts=c("contr.sum", "contr.poly"), imatrix, test.statistic=c("Pillai", "Wilks", "Hotelling-Lawley", "Roy"),...) \method{Anova}{manova}(mod, ...) \method{Manova}{mlm}(mod, ...) \method{print}{Anova.mlm}(x, ...) \method{summary}{Anova.mlm}(object, test.statistic, univariate=TRUE, multivariate=TRUE, ...) \method{print}{summary.Anova.mlm}(x, digits = getOption("digits"), ... ) \method{Anova}{coxph}(mod, type=c("II","III", 2, 3), test.statistic=c("LR", "Wald"), ...) \method{Anova}{lme}(mod, type=c("II","III", 2, 3), vcov.=vcov(mod), singular.ok, ...) \method{Anova}{mer}(mod, type=c("II","III", 2, 3), test.statistic=c("Chisq", "F"), vcov.=vcov(mod), singular.ok, ...) \method{Anova}{merMod}(mod, type=c("II","III", 2, 3), test.statistic=c("Chisq", "F"), vcov.=vcov(mod), singular.ok, ...) \method{Anova}{svyglm}(mod, ...) \method{Anova}{default}(mod, type=c("II","III", 2, 3), test.statistic=c("Chisq", "F"), vcov.=vcov(mod), singular.ok, ...) } \arguments{ \item{mod}{\code{lm}, \code{aov}, \code{glm}, \code{multinom}, \code{polr} \code{mlm}, \code{coxph}, \code{lme}, \code{mer}, \code{merMod}, \code{svyglm} or other suitable model object.} \item{error}{for a linear model, an \code{lm} model object from which the error sum of squares and degrees of freedom are to be calculated. For F-tests for a generalized linear model, a \code{glm} object from which the dispersion is to be estimated. If not specified, \code{mod} is used.} \item{type}{type of test, \code{"II"}, \code{"III"}, \code{2}, or \code{3}.} \item{singular.ok}{defaults to \code{TRUE} for type-II tests, and \code{FALSE} for type-III tests (where the tests for models with aliased coefficients will not be straightforwardly interpretable); if \code{FALSE}, a model with aliased coefficients produces an error.} \item{test.statistic}{for a generalized linear model, whether to calculate \code{"LR"} (likelihood-ratio), \code{"Wald"}, or \code{"F"} tests; for a Cox model, whether to calculate \code{"LR"} (partial-likelihood ratio) or \code{"Wald"} tests; in the default case or for linear mixed models fit by \code{lmer}, whether to calculate Wald \code{"Chisq"} or \code{"F"} tests. For a multivariate linear model, the multivariate test statistic to compute --- one of \code{"Pillai"}, \code{"Wilks"}, \code{"Hotelling-Lawley"}, or \code{"Roy"}, with \code{"Pillai"} as the default. The \code{summary} method for \code{Anova.mlm} objects permits the specification of more than one multivariate test statistic, and the default is to report all four.} \item{error.estimate}{for F-tests for a generalized linear model, base the dispersion estimate on the Pearson residuals (\code{"pearson"}, the default); use the dispersion estimate in the model object (\code{"dispersion"}), which, e.g., is fixed to 1 for binomial and Poisson models; or base the dispersion estimate on the residual deviance (\code{"deviance"}).} \item{white.adjust}{if not \code{FALSE}, the default, tests use a heteroscedasticity-corrected coefficient covariance matrix; the various values of the argument specify different corrections. See the documentation for \code{\link{hccm}} for details. If \code{white.adjust=TRUE} then the \code{"hc3"} correction is selected.} \item{SSPE}{The error sum-of-squares-and-products matrix; if missing, will be computed from the residuals of the model.} \item{error.df}{The degrees of freedom for error; if missing, will be taken from the model.} \item{idata}{an optional data frame giving a factor or factors defining the intra-subject model for multivariate repeated-measures data. See \emph{Details} for an explanation of the intra-subject design and for further explanation of the other arguments relating to intra-subject factors.} \item{idesign}{a one-sided model formula using the ``data'' in \code{idata} and specifying the intra-subject design.} \item{icontrasts}{names of contrast-generating functions to be applied by default to factors and ordered factors, respectively, in the within-subject ``data''; the contrasts must produce an intra-subject model matrix in which different terms are orthogonal. The default is \code{c("contr.sum", "contr.poly")}.} \item{imatrix}{as an alternative to specifying \code{idata}, \code{idesign}, and (optionally) \code{icontrasts}, the model matrix for the within-subject design can be given directly in the form of list of named elements. Each element gives the columns of the within-subject model matrix for a term to be tested, and must have as many rows as there are responses; the columns of the within-subject model matrix for different terms must be mutually orthogonal.} \item{x, object}{object of class \code{"Anova.mlm"} to print or summarize.} \item{multivariate, univariate}{compute and print multivariate and univariate tests for a repeated-measures ANOVA; the default is \code{TRUE} for both.} \item{digits}{minimum number of significant digits to print.} \item{vcov.}{an optional coefficient-covariance matrix, computed by default by applying the generic \code{vcov} function to the model object.} \item{\dots}{do not use.} } \details{ The designations "type-II" and "type-III" are borrowed from SAS, but the definitions used here do not correspond precisely to those employed by SAS. Type-II tests are calculated according to the principle of marginality, testing each term after all others, except ignoring the term's higher-order relatives; so-called type-III tests violate marginality, testing each term in the model after all of the others. This definition of Type-II tests corresponds to the tests produced by SAS for analysis-of-variance models, where all of the predictors are factors, but not more generally (i.e., when there are quantitative predictors). Be very careful in formulating the model for type-III tests, or the hypotheses tested will not make sense. As implemented here, type-II Wald tests are a generalization of the linear hypotheses used to generate these tests in linear models. For tests for linear models, multivariate linear models, and Wald tests for generalized linear models, Cox models, mixed-effects models, generalized linear models fit to survey data, and in the default case, \code{Anova} finds the test statistics without refitting the model. The \code{svyglm} method simply calls the \code{default} method and therefore can take the same arguments. The standard R \code{anova} function calculates sequential ("type-I") tests. These rarely test interesting hypotheses in unbalanced designs. A MANOVA for a multivariate linear model (i.e., an object of class \code{"mlm"} or \code{"manova"}) can optionally include an intra-subject repeated-measures design. If the intra-subject design is absent (the default), the multivariate tests concern all of the response variables. To specify a repeated-measures design, a data frame is provided defining the repeated-measures factor or factors via \code{idata}, with default contrasts given by the \code{icontrasts} argument. An intra-subject model-matrix is generated from the formula specified by the \code{idesign} argument; columns of the model matrix corresponding to different terms in the intra-subject model must be orthogonal (as is insured by the default contrasts). Note that the contrasts given in \code{icontrasts} can be overridden by assigning specific contrasts to the factors in \code{idata}. As an alternative, the within-subjects model matrix can be specified directly via the \code{imatrix} argument. \code{Manova} is essentially a synonym for \code{Anova} for multivariate linear models. } \value{ An object of class \code{"anova"}, or \code{"Anova.mlm"}, which usually is printed. For objects of class \code{"Anova.mlm"}, there is also a \code{summary} method, which provides much more detail than the \code{print} method about the MANOVA, including traditional mixed-model univariate F-tests with Greenhouse-Geisser and Huynh-Feldt corrections. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Hand, D. J., and Taylor, C. C. (1987) \emph{Multivariate Analysis of Variance and Repeated Measures: A Practical Approach for Behavioural Scientists.} Chapman and Hall. O'Brien, R. G., and Kaiser, M. K. (1985) MANOVA method for analyzing repeated measures designs: An extensive primer. \emph{Psychological Bulletin} \bold{97}, 316--333. } \author{John Fox \email{jfox@mcmaster.ca}; the code for the Mauchly test and Greenhouse-Geisser and Huynh-Feldt corrections for non-spericity in repeated-measures ANOVA are adapted from the functions \code{stats:::stats:::mauchly.test.SSD} and \code{stats:::sphericity} by R Core; \code{summary.Anova.mlm} and \code{print.summary.Anova.mlm} incorporates code contributed by Gabriel Baud-Bovy.} \section{Warning}{Be careful of type-III tests.} \seealso{ \code{\link{linearHypothesis}}, \code{\link[stats]{anova}} \code{\link[stats]{anova.lm}}, \code{\link[stats]{anova.glm}}, \code{\link[stats]{anova.mlm}}, \code{\link[survival]{anova.coxph}}, \code{link[survey]{svyglm}}.} \examples{ ## Two-Way Anova mod <- lm(conformity ~ fcategory*partner.status, data=Moore, contrasts=list(fcategory=contr.sum, partner.status=contr.sum)) Anova(mod) ## One-Way MANOVA ## See ?Pottery for a description of the data set used in this example. summary(Anova(lm(cbind(Al, Fe, Mg, Ca, Na) ~ Site, data=Pottery))) ## MANOVA for a randomized block design (example courtesy of Michael Friendly: ## See ?Soils for description of the data set) soils.mod <- lm(cbind(pH,N,Dens,P,Ca,Mg,K,Na,Conduc) ~ Block + Contour*Depth, data=Soils) Manova(soils.mod) ## a multivariate linear model for repeated-measures data ## See ?OBrienKaiser for a description of the data set used in this example. phase <- factor(rep(c("pretest", "posttest", "followup"), c(5, 5, 5)), levels=c("pretest", "posttest", "followup")) hour <- ordered(rep(1:5, 3)) idata <- data.frame(phase, hour) idata mod.ok <- lm(cbind(pre.1, pre.2, pre.3, pre.4, pre.5, post.1, post.2, post.3, post.4, post.5, fup.1, fup.2, fup.3, fup.4, fup.5) ~ treatment*gender, data=OBrienKaiser) (av.ok <- Anova(mod.ok, idata=idata, idesign=~phase*hour)) summary(av.ok, multivariate=FALSE) ## A "doubly multivariate" design with two distinct repeated-measures variables ## (example courtesy of Michael Friendly) ## See ?WeightLoss for a description of the dataset. imatrix <- matrix(c( 1,0,-1, 1, 0, 0, 1,0, 0,-2, 0, 0, 1,0, 1, 1, 0, 0, 0,1, 0, 0,-1, 1, 0,1, 0, 0, 0,-2, 0,1, 0, 0, 1, 1), 6, 6, byrow=TRUE) colnames(imatrix) <- c("WL", "SE", "WL.L", "WL.Q", "SE.L", "SE.Q") rownames(imatrix) <- colnames(WeightLoss)[-1] (imatrix <- list(measure=imatrix[,1:2], month=imatrix[,3:6])) contrasts(WeightLoss$group) <- matrix(c(-2,1,1, 0,-1,1), ncol=2) (wl.mod<-lm(cbind(wl1, wl2, wl3, se1, se2, se3)~group, data=WeightLoss)) Anova(wl.mod, imatrix=imatrix, test="Roy") ## mixed-effects models examples: \dontrun{ library(nlme) example(lme) Anova(fm2) } \dontrun{ library(lme4) example(glmer) Anova(gm1) } } \keyword{htest} \keyword{models} \keyword{regression} car/man/AMSsurvey.Rd0000644000175100001440000000274512126621426014007 0ustar hornikusers\name{AMSsurvey} \alias{AMSsurvey} \docType{data} \title{ American Math Society Survey Data } \description{ Counts of new PhDs in the mathematical sciences for 2008-09 and 2011-12 categorized by type of institution, gender, and US citizenship status. } \usage{AMSsurvey} \format{ A data frame with 24 observations on the following 5 variables. \describe{ \item{type}{a factor with levels \code{I(Pu)} for group I public universities, \code{I(Pr)} for group I private universities, \code{II} and \code{III} for groups II and III, \code{IV} for statistics and biostatistics programs, and \code{Va} for applied mathemeatics programs.} \item{sex}{a factor with levels \code{Female}, \code{Male} of the recipient} \item{citizen}{a factor with levels \code{Non-US}, \code{US} giving citizenship status} \item{count}{The number of individuals of each type in 2008-09} \item{count11}{The number of individuals of each type in 2011-12} } } \details{ These data are produced yearly by the American Math Society. } \source{ \url{http://www.ams.org/employment/surveyreports.html} Supplementary Table 4 in the 2008-09 data. } \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Phipps, Polly, Maxwell, James W. and Rose, Colleen (2009), \emph{2009 Annual Survey of the Mathematical Sciences}, 57, {250--259}, Supplementary Table 4, \url{http://www.ams/org/employment/2009Survey-First-Report-Supp-Table4.pdf} } \keyword{datasets} car/man/vif.Rd0000644000175100001440000000435211401002012012644 0ustar hornikusers\name{vif} \alias{vif} \alias{vif.lm} \title{Variance Inflation Factors} \description{ Calculates variance-inflation and generalized variance-inflation factors for linear and generalized linear models. } \usage{ vif(mod, ...) \method{vif}{lm}(mod, ...) } \arguments{ \item{mod}{an object that inherits from class \code{lm}, such as an \code{lm} or \code{glm} object.} \item{\dots}{not used.} } \details{ If all terms in an unweighted linear model have 1 df, then the usual variance-inflation factors are calculated. If any terms in an unweighted linear model have more than 1 df, then generalized variance-inflation factors (Fox and Monette, 1992) are calculated. These are interpretable as the inflation in size of the confidence ellipse or ellipsoid for the coefficients of the term in comparison with what would be obtained for orthogonal data. The generalized vifs are invariant with respect to the coding of the terms in the model (as long as the subspace of the columns of the model matrix pertaining to each term is invariant). To adjust for the dimension of the confidence ellipsoid, the function also prints \eqn{GVIF^{1/(2\times df)}}{GVIF^[1/(2*df)]} where \eqn{df} is the degrees of freedom associated with the term. Through a further generalization, the implementation here is applicable as well to other sorts of models, in particular weighted linear models and generalized linear models, that inherit from class \code{lm}. } \value{ A vector of vifs, or a matrix containing one row for each term in the model, and columns for the GVIF, df, and \eqn{GVIF^{1/(2\times df)}}{GVIF^[1/(2*df)]}. } \references{ Fox, J. and Monette, G. (1992) Generalized collinearity diagnostics. \emph{JASA}, \bold{87}, 178--183. Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \author{Henric Nilsson and John Fox \email{jfox@mcmaster.ca}} \examples{ vif(lm(prestige ~ income + education, data=Duncan)) vif(lm(prestige ~ income + education + type, data=Duncan)) } \keyword{regression} car/man/compareCoefs.Rd0000644000175100001440000000333111652536444014517 0ustar hornikusers\name{compareCoefs} \alias{compareCoefs} \title{ Print estimated coefficients and their standard errors in a table for several regression models. } \description{ This simple function extracts estimates of regression parameters and their standard errors from one or more models and prints them in a table. } \usage{ compareCoefs(..., se = TRUE, print=TRUE, digits = 3) } \arguments{ \item{\dots}{ One or more regression-model objects. These may be of class \code{lm}, \code{glm}, \code{nlm}, or any other regression method for which the functions \code{coef} and \code{vcov} return appropriate values, or if the object inherits from the \code{mer} class created by the \code{lme4} package or \code{lme} in the \code{nlme} package. } \item{se}{ If \code{TRUE}, the default, show standard errors as well as estimates, if \code{FALSE}, show only estimates. } \item{print}{ If \code{TRUE}, the defualt, the results are printed in a nice format using \code{\link{printCoefmat}}. If \code{FALSE}, the results are returned as a matrix } \item{digits}{ Passed to the \code{\link{printCoefmat}} function for printing the result. } } \value{ This function is used for its side-effect of printing the result. It returns a matrix of estimates and standard errors. } \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \author{John Fox \email{jfox@mcmaster.ca}} \examples{ mod1 <- lm(prestige ~ income + education, data=Duncan) mod2 <- update(mod1, subset=-c(6,16)) mod3 <- update(mod1, . ~ . + type) compareCoefs(mod1) compareCoefs(mod1, mod2) compareCoefs(mod1, mod2, mod3) compareCoefs(mod1, mod2, se=FALSE) } \keyword{print } car/man/Transact.Rd0000644000175100001440000000144311401002012013635 0ustar hornikusers\name{Transact} \alias{Transact} \docType{data} \title{Transaction data} \description{ Data on transaction times in branch offices of a large Australian bank. } \format{This data frame contains the following columns: \describe{ \item{t1}{ number of type 1 transactions } \item{t2}{ number of type 2 transactions } \item{time}{ total transaction time, minutes } } } \source{ Cunningham, R. and Heathcote, C. (1989), Estimating a non-Gaussian regression model with multicollinearity. Australian Journal of Statistics, 31,12-17.} \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition. Wiley, Section 4.6.1. } \usage{ Transact } \keyword{datasets} car/man/Moore.Rd0000644000175100001440000000301311401002012013132 0ustar hornikusers\name{Moore} \alias{Moore} \docType{data} \title{Status, Authoritarianism, and Conformity} \description{ The \code{Moore} data frame has 45 rows and 4 columns. The data are for subjects in a social-psychological experiment, who were faced with manipulated disagreement from a partner of either of low or high status. The subjects could either conform to the partner's judgment or stick with their own judgment. } \format{ This data frame contains the following columns: \describe{ \item{partner.status}{ Partner's status. A factor with levels: \code{high}, \code{low}. } \item{conformity}{ Number of conforming responses in 40 critical trials. } \item{fcategory}{ F-Scale Categorized. A factor with levels (note levels out of order): \code{high}, \code{low}, \code{medium}. } \item{fscore}{ Authoritarianism: F-Scale score. } } } \source{ Moore, J. C., Jr. and Krupat, E. (1971) Relationship between source status, authoritarianism and conformity in a social setting. \emph{Sociometry} \bold{34}, 122--134. Personal communication from J. Moore, Department of Sociology, York University. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \usage{ Moore } \keyword{datasets} car/man/spreadLevelPlot.Rd0000644000175100001440000001104211437776501015215 0ustar hornikusers\name{spreadLevelPlot} \alias{spreadLevelPlot} \alias{slp} \alias{spreadLevelPlot.formula} \alias{spreadLevelPlot.default} \alias{spreadLevelPlot.lm} \alias{print.spreadLevelPlot} \title{Spread-Level Plots} \description{ Creates plots for examining the possible dependence of spread on level, or an extension of these plots to the studentized residuals from linear models. } \usage{ spreadLevelPlot(x, ...) slp(...) \method{spreadLevelPlot}{formula}(x, data=NULL, subset, na.action, main=paste("Spread-Level Plot for", varnames[response], "by", varnames[-response]), ...) \method{spreadLevelPlot}{default}(x, by, robust.line=TRUE, start=0, xlab="Median", ylab="Hinge-Spread", point.labels=TRUE, las=par("las"), main=paste("Spread-Level Plot for", deparse(substitute(x)), "by", deparse(substitute(by))), col=palette()[1], col.lines=palette()[2], pch=1, lwd=2, grid=TRUE, ...) \method{spreadLevelPlot}{lm}(x, robust.line=TRUE, xlab="Fitted Values", ylab="Absolute Studentized Residuals", las=par("las"), main=paste("Spread-Level Plot for\n", deparse(substitute(x))), pch=1, col=palette()[1], col.lines=palette()[2], lwd=2, grid=TRUE, ...) \method{print}{spreadLevelPlot}(x, ...) } \arguments{ \item{x}{a formula of the form \code{y ~ x}, where \code{y} is a numeric vector and \code{x} is a factor, or an \code{lm} object to be plotted; alternatively a numeric vector.} \item{data}{an optional data frame containing the variables to be plotted. By default the variables are taken from the environment from which \code{spreadLevelPlot} is called.} \item{subset}{an optional vector specifying a subset of observations to be used.} \item{na.action}{a function that indicates what should happen when the data contain \code{NA}s. The default is set by the \code{na.action} setting of \code{options}.} \item{by}{a factor, numeric vector, or character vector defining groups.} \item{robust.line}{if \code{TRUE} a robust line is fit using the \code{rlm} function in the \code{MASS} package; if \code{FALSE} a line is fit using \code{lm}.} \item{start}{add the constant \code{start} to each data value.} \item{main}{title for the plot.} \item{xlab}{label for horizontal axis.} \item{ylab}{label for vertical axis.} \item{point.labels}{if \code{TRUE} label the points in the plot with group names.} \item{las}{if \code{0}, ticks labels are drawn parallel to the axis; set to \code{1} for horizontal labels (see \code{\link[graphics]{par}}).} \item{col}{color for points; the default is the first entry in the current color palette (see \code{\link[grDevices]{palette}} and \code{\link[graphics]{par}}).} \item{col.lines}{color for lines; default is the second entry in the current palette} \item{pch}{plotting character for points; default is \code{1} (a circle, see \code{\link[graphics]{par}}).} \item{lwd}{line width; default is \code{2} (see \code{\link[graphics]{par}}).} \item{grid}{If TRUE, the default, a light-gray background grid is put on the graph} \item{\dots}{arguments passed to plotting functions.} } \details{ Except for linear models, computes the statistics for, and plots, a Tukey spread-level plot of log(hinge-spread) vs. log(median) for the groups; fits a line to the plot; and calculates a spread-stabilizing transformation from the slope of the line. For linear models, plots log(abs(studentized residuals) vs. log(fitted values). The function \code{slp} is an abbreviation for \code{spreadLevelPlot}. } \value{ An object of class \code{spreadLevelPlot} containing: \item{Statistics}{a matrix with the lower-hinge, median, upper-hinge, and hinge-spread for each group. (Not for an \code{lm} object.)} \item{PowerTransformation}{spread-stabilizing power transformation, calculated as \eqn{1 - slope} of the line fit to the plot.} } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Hoaglin, D. C., Mosteller, F. and Tukey, J. W. (Eds.) (1983) \emph{Understanding Robust and Exploratory Data Analysis.} Wiley. } \author{John Fox \email{jfox@mcmaster.ca}} \seealso{\code{\link{hccm}}, \code{\link{ncvTest}} } \examples{ spreadLevelPlot(interlocks + 1 ~ nation, data=Ornstein) slp(lm(interlocks + 1 ~ assets + sector + nation, data=Ornstein)) } \keyword{hplot} \keyword{regression} car/man/Friendly.Rd0000644000175100001440000000231711401002012013633 0ustar hornikusers\name{Friendly} \alias{Friendly} \docType{data} \title{Format Effects on Recall} \description{ The \code{Friendly} data frame has 30 rows and 2 columns. The data are from an experiment on subjects' ability to remember words based on the presentation format. } \format{ This data frame contains the following columns: \describe{ \item{condition}{ A factor with levels: \code{Before}, Recalled words presented before others; \code{Meshed}, Recalled words meshed with others; \code{SFR}, Standard free recall. } \item{correct}{ Number of words correctly recalled, out of 40 on final trial of the experiment. } } } \source{ Friendly, M. and Franklin, P. (1980) Interactive presentation in multitrial free recall. \emph{Memory and Cognition} \bold{8} 265--270 [Personal communication from M. Friendly]. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \usage{ Friendly } \keyword{datasets} car/man/Leinhardt.Rd0000644000175100001440000000306511401002012013772 0ustar hornikusers\name{Leinhardt} \alias{Leinhardt} \docType{data} \title{Data on Infant-Mortality} \description{ The \code{Leinhardt} data frame has 105 rows and 4 columns. The observations are nations of the world around 1970. } \format{ This data frame contains the following columns: \describe{ \item{income}{ Per-capita income in U. S. dollars. } \item{infant}{ Infant-mortality rate per 1000 live births. } \item{region}{ A factor with levels: \code{Africa}; \code{Americas}; \code{Asia}, Asia and Oceania; \code{Europe}. } \item{oil}{ Oil-exporting country. A factor with levels: \code{no}, \code{yes}. } } } \details{ The infant-mortality rate for Jamaica is misprinted in Leinhardt and Wasserman; the correct value is given here. Some of the values given in Leinhardt and Wasserman do not appear in the original New York Times table and are of dubious validity. } \source{ Leinhardt, S. and Wasserman, S. S. (1979) Exploratory data analysis: An introduction to selected methods. In Schuessler, K. (Ed.) \emph{Sociological Methodology 1979} Jossey-Bass. \emph{The New York Times}, 28 September 1975, p. E-3, Table 3. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \usage{ Leinhardt } \keyword{datasets} car/man/symbox.Rd0000644000175100001440000000377711440714170013435 0ustar hornikusers\name{symbox} \alias{symbox} \alias{symbox.formula} \alias{symbox.default} \title{Boxplots for transformations to symmetry} \description{\code{symbox} first transforms \code{x} to each of a series of selected powers, with each transformation standardized to mean 0 and standard deviation 1. The results are then displayed side-by-side in boxplots, permiting a visual assessment of which power makes the distribution reasonably symmetric.} \usage{ symbox(x, ...) \method{symbox}{formula}(formula, data=NULL, subset, na.action=NULL, ylab, ...) \method{symbox}{default}(x, powers = c(-1, -0.5, 0, 0.5, 1), start=0, trans=bcPower, xlab="Powers", ylab, ...) } \arguments{ \item{x}{a numeric vector.} \item{formula}{a one-sided formula specifying a single numeric variable.} \item{data, subset, na.action}{as for statistical modeling functions (see, e.g., \code{\link{lm}}).} \item{xlab, ylab}{axis labels; if \code{ylab} is missing, a label will be supplied.} \item{powers}{a vector of selected powers to which \code{x} is to be raised. For meaningful comparison of powers, \code{1} should be included in the vector of powers.} \item{start}{a constant to be added to \code{x}.} \item{trans}{a transformation function whose first argument is a numeric vector and whose second argument is a transformation parameter, given by the \code{powers} argument; the default is \code{\link{bcPower}}, and another possibility is \code{\link{yjPower}}.} \item{\ldots}{arguments to be passed down.} } \value{as returned by \code{boxplot}.} \author{Gregor Gorjanc, John Fox \email{jfox@mcmaster.ca}, and Sanford Weisberg.} \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition. Sage. } \seealso{\code{\link[graphics]{boxplot}}, \code{\link[MASS]{boxcox}}, \code{\link{bcPower}}, \code{\link{yjPower}}} \examples{ symbox(~ income, data=Prestige) } \keyword{hplot} car/man/boxCoxVariable.Rd0000644000175100001440000000364511401002012014774 0ustar hornikusers\name{boxCoxVariable} \alias{boxCoxVariable} \title{Constructed Variable for Box-Cox Transformation} \description{ Computes a constructed variable for the Box-Cox transformation of the response variable in a linear model. } \usage{ boxCoxVariable(y) } \arguments{ \item{y}{response variable.} } \details{ The constructed variable is defined as \eqn{y[\log(y/\widetilde{y}) - 1]}{y[log(y/y') -1]}, where \eqn{\widetilde{y}}{y'} is the geometric mean of \code{y}. The constructed variable is meant to be added to the right-hand-side of the linear model. The t-test for the coefficient of the constructed variable is an approximate score test for whether a transformation is required. If \eqn{b} is the coefficient of the constructed variable, then an estimate of the normalizing power transformation based on the score statistic is \eqn{1 - b}{1 - b}. An added-variable plot for the constructed variable shows leverage and influence on the decision to transform \code{y}. } \value{ a numeric vector of the same length as \code{y}. } \references{ Atkinson, A. C. (1985) \emph{Plots, Transformations, and Regression}. Oxford. Box, G. E. P. and Cox, D. R. (1964) An analysis of transformations. \emph{JRSS B} \bold{26} 211--246. Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \author{John Fox \email{jfox@mcmaster.ca}} \seealso{\code{\link[MASS]{boxcox}}, \code{\link{powerTransform}}, \code{\link{bcPower}}} % , \code{\link{avPlots}} \examples{ mod <- lm(interlocks + 1 ~ assets, data=Ornstein) mod.aux <- update(mod, . ~ . + boxCoxVariable(interlocks + 1)) summary(mod.aux) # avPlots(mod.aux, "boxCoxVariable(interlocks + 1)") } \keyword{manip} \keyword{regression} car/man/car-package.Rd0000644000175100001440000000223512215125215014233 0ustar hornikusers\name{car-package} \alias{car-package} \alias{car} \docType{package} \title{ Companion to Applied Regression } \description{ This package accompanies Fox, J. and Weisberg, S., \emph{An R Companion to Applied Regression}, Second Edition, Sage, 2011. } \details{ \tabular{ll}{ Package: \tab car\cr Version: \tab 2.0-19\cr Date: \tab 2013/09/14\cr Depends: \tab R (>= 2.14.0), stats, graphics, MASS, nnet\cr Suggests: \tab alr3, boot, leaps, lme4, lmtest, nlme, quantreg, sandwich, mgcv, pbkrtest (>= 0.3-2), rgl, survival, survey\cr License: \tab GPL (>= 2)\cr URL: \tab \url{http://CRAN.R-project.org/package=car}, \url{http://socserv.socsci.mcmaster.ca/jfox/Books/Companion}, \url{https://r-forge.r-project.org/projects/car/} \cr } } \author{ John Fox and Sanford Weisberg. We are grateful to Douglas Bates, Gabriel Baud-Bovy, David Firth, Michael Friendly, Gregor Gorjanc, Spencer Graves, Richard Heiberger, Rafael Laboissiere, Georges Monette, Henric Nilsson, Derek Ogle, Brian Ripley, Achim Zeleis, and R Core for various suggestions and contributions. Maintainer: John Fox } \keyword{ package } car/man/Soils.Rd0000644000175100001440000000523511401002012013152 0ustar hornikusers\name{Soils} \alias{Soils} \docType{data} \title{Soil Compositions of Physical and Chemical Characteristics} \description{ Soil characteristics were measured on samples from three types of contours (Top, Slope, and Depression) and at four depths (0-10cm, 10-30cm, 30-60cm, and 60-90cm). The area was divided into 4 blocks, in a randomized block design. (Suggested by Michael Friendly.) } \usage{Soils} \format{ A data frame with 48 observations on the following 14 variables. There are 3 factors and 9 response variables. \describe{ \item{\code{Group}}{a factor with 12 levels, corresponding to the combinations of \code{Contour} and \code{Depth} } \item{\code{Contour}}{a factor with 3 levels: \code{Depression} \code{Slope} \code{Top}} \item{\code{Depth}}{a factor with 4 levels: \code{0-10} \code{10-30} \code{30-60} \code{60-90}} \item{\code{Gp}}{a factor with 12 levels, giving abbreviations for the groups: \code{D0} \code{D1} \code{D3} \code{D6} \code{S0} \code{S1} \code{S3} \code{S6} \code{T0} \code{T1} \code{T3} \code{T6}} \item{\code{Block}}{a factor with levels \code{1} \code{2} \code{3} \code{4}} \item{\code{pH}}{soil pH} \item{\code{N}}{total nitrogen in \%} \item{\code{Dens}}{bulk density in gm/cm$^3$ } \item{\code{P}}{total phosphorous in ppm} \item{\code{Ca}}{calcium in me/100 gm.} \item{\code{Mg}}{magnesium in me/100 gm.} \item{\code{K}}{phosphorous in me/100 gm.} \item{\code{Na}}{sodium in me/100 gm.} \item{\code{Conduc}}{conductivity} } } \details{ These data provide good examples of MANOVA and canonical discriminant analysis in a somewhat complex multivariate setting. They may be treated as a one-way design (ignoring \code{Block}), by using either \code{Group} or \code{Gp} as the factor, or a two-way randomized block design using \code{Block}, \code{Contour} and \code{Depth} (quantitative, so orthogonal polynomial contrasts are useful). } \source{ Horton, I. F.,Russell, J. S., and Moore, A. W. (1968) Multivariate-covariance and canonical analysis: A method for selecting the most effective discriminators in a multivariate situation. \emph{Biometrics} \bold{24}, 845--858. \url{http://www.stat.lsu.edu/faculty/moser/exst7037/soils.sas} } \references{ Khattree, R., and Naik, D. N. (2000) \emph{Multivariate Data Reduction and Discrimination with SAS Software.} SAS Institute. Friendly, M. (2006) Data ellipses, HE plots and reduced-rank displays for multivariate linear models: SAS software and examples. \emph{Journal of Statistical Software}, 17(6), \url{http://www.jstatsoft.org/v17/i06}. } \keyword{datasets} car/man/panel.car.Rd0000644000175100001440000000232411261463162013745 0ustar hornikusers\name{panel.car} \alias{panel.car} \title{Panel Function for Coplots} \description{ a panel function for use with \code{coplot} that plots points, a lowess line, and a regression line. } \usage{ panel.car(x, y, col, pch, cex=1, span=0.5, lwd=2, reg.line=lm, lowess.line=TRUE, ...) } \arguments{ \item{x}{vector giving horizontal coordinates.} \item{y}{vector giving vertical coordinates.} \item{col}{point color.} \item{pch}{plotting character for points.} \item{cex}{character expansion factor for points.} \item{span}{span for lowess smoother.} \item{lwd}{line width, default is \code{2}.} \item{reg.line}{function to compute coefficients of regression line, or \code{FALSE} for no line.} \item{lowess.line}{if \code{TRUE} plot lowess smooth.} \item{\dots}{other arguments to pass to functions \code{lines} and \code{regLine}.} } \value{ \code{NULL}. This function is used for its side effect: producing a panel in a coplot. } \author{John Fox \email{jfox@mcmaster.ca}} \seealso{\code{\link[graphics]{coplot}}, \code{\link{regLine}}} \examples{ coplot(prestige ~ income|education, panel=panel.car, col="red", data=Prestige) } \keyword{aplot} car/man/hist.boot.Rd0000644000175100001440000001455611762135737014037 0ustar hornikusers\name{hist.boot} \alias{hist.boot} \alias{summary.boot} \alias{confint.boot} \title{ Generic functions to provide support for \code{boot} objects } \description{ The \code{Boot} function in \code{car} uses the \code{boot} function from the \code{boot} package to do a straightforward case or residual bootstrap for a regression object. These are generic functions to summarize the results of the bootstrap. } \usage{ \method{hist}{boot}(x, parm, layout = NULL, ask, main = "", freq = FALSE, estPoint = TRUE, point.col = "black", point.lty = 2, point.lwd = 2, estDensity = !freq, den.col = "blue", den.lty = 1, den.lwd = 2, estNormal = !freq, nor.col = "red", nor.lty = 2, nor.lwd = 2, ci = c("bca", "none", "percentile"), level = 0.95, legend = c("top", "none", "separate"), box = TRUE, ...) \method{summary}{boot}(object, parm, high.moments = FALSE, extremes = FALSE, ...) \method{confint}{boot}(object, parm, level = 0.95, type = c("bca", "norm", "basic", "perc", "all"), ...) } \arguments{ \item{x, object}{ An object created by a call to \code{boot} of class \code{"boot"}. } \item{parm}{ A vector of numbers or coefficient names giving the coefficients for which a histogram or confidence interval is desired. If numbers are used, 1 corresponds to the intercept, if any. The default is all coefficients. } \item{layout}{ If set to a value like \code{c(1, 1)} or \code{c(4, 3)}, the layout of the graph will have this many rows and columns. If not set, the program will select an appropriate layout. If the number of graphs exceed nine, you must select the layout yourself, or you will get a maximum of nine per page. If \code{layout=NA}, the function does not set the layout and the user can use the \code{par} function to control the layout, for example to have plots from two models in the same graphics window. } \item{ask}{ If \code{TRUE}, ask the user before drawing the next plot; if \code{FALSE}, don't ask. } \item{main}{ Main title for the graphs. The default is \code{main=""} for no title. } \item{freq}{ The usual default for \code{hist} is \code{freq=TRUE} to give a frequency histogram. The default here is \code{freq=FALSE} to give a density histogram. A density estimate and/or a fitted normal density can be added to the graph if \code{freq=FALSE} but not if \code{freq=TRUE}. } \item{estPoint, point.col, point.lty, point.lwd}{ If \code{estPoint=TRUE}, the default, a vertical line is drawn on the histgram at the value of the point estimate computed from the complete data. The remaining three optional arguments set the color, line type and line width of the line that is drawn. } \item{estDensity, den.col, den.lty, den.lwd}{ If \code{estDensity=TRUE} and\code{freq=FALSE}, the default, a kernel density estimate is drawn on the plot with a call to the \code{density} function with no additional arguments. The remaining three optional arguments set the color, line type and line width of the lines that are drawn. } \item{estNormal, nor.col, nor.lty, nor.lwd}{ If \code{estNormal=TRUE} and\code{freq=FALSE}, the default, a normal density with mean and sd computed from the data is drawn on the plot. The remaining three optional arguments set the color, line type and line width of the lines that are drawn. } \item{ci}{ A confidence interval based on the bootstrap will be added to the histogram using the BCa method if \code{ci="bca"} or using the percentile method if \code{ci="percentile"}. No interval is drawn if \code{ci="none"}. The default is \code{"bca"}. The interval is indicated by a thick horizontal line at \code{y=0}. For some bootstraps the BCa method is unavailable and another method should be used. } \item{legend}{ A legend can be added to the (array of) histograms. The value \dQuote{"top"} puts at the top-left of the plots. The value \dQuote{"separate"} puts the legend in its own graph following all the histograms. The value \dQuote{"none"} suppresses the legend. } \item{box}{ Add a box around each histogram. } \item{\dots}{ Additional arguments passed to \code{hist}; for other methods this is included for compatibility with the generic method. For example, the argument \code{border=par()$bg} in \code{hist} will draw the histogram transparently, leaving only the density estimates. } \item{high.moments}{ Should the skewness and kurtosis be included in the summary? Default is FALSE. } \item{extremes}{ Should the minimum, maximum and range be included in the summary? Default is FALSE. } \item{level}{ Confidence level, a number between 0 and 1. In \code{confint}, \code{level} can be a vector; for example \code{level=c(.68, .90, .95)} will return the estimated quantiles at \code{c(.025, .05, .16, .84, .95, .975)}. } \item{type}{ Selects the confidence interval type. The types implemented are the \code{"percentile"} method, which uses the function \code{quantile} to return the appropriate quantiles for the confidence limit specified, the default \code{bca} which uses the bias-corrected and accelerated method presented by Efron and Tibshirani (1993, Chapter 14). For the other types, see the documentation for \code{\link[boot]{boot}}. } } \value{ \code{hist} is used for the side-effect of drawing an array of historgams of each column of the first argument. \code{summary} returns a matrix of summary statistics for each of the columns in the bootstrap object. The \code{confint} method returns confidence intervals. Print method } \references{ Efron, B. and Tibsharini, R. (1993) \emph{An Introduction to the Bootstrap}. New York: Chapman and Hall. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition. Sage. Fox, J. and Weisberg, S. (2012) \emph{Bootstrapping}, \url{http://socserv.mcmaster.ca/jfox/Books/Companion/appendix/Appendix-Bootstrapping.pdf}. Weisberg, S. (2013) \emph{Applied Linear Regression}, Fourth Edition, Wiley } \author{Sanford Weisberg, \email{sandy@umn.edu}} \seealso{See Also \code{\link{Boot}}, \code{\link{hist}}, \code{\link{density}} } \examples{ m1 <- lm(Fertility ~ ., swiss) betahat.boot <- Boot(m1, R=99) # 99 bootstrap samples--too small to be useful summary(betahat.boot) # default summary confint(betahat.boot) hist(betahat.boot) } \keyword{regression}% at least one, from doc/KEYWORDS car/man/testTransform.Rd0000644000175100001440000000431312166631153014757 0ustar hornikusers\name{testTransform} \alias{testTransform} \alias{testTransform.powerTransform} \title{Likelihood-Ratio Tests for Univariate or Multivariate Power Transformations to Normality} \description{ \code{testTransform} computes likelihood ratio tests for particular transformations based on \code{powerTransform} objects. } \usage{ testTransform(object, lambda) \S3method{testTransform}{powerTransform}(object, lambda=rep(1, dim(object$y)[2])) } \arguments{ \item{object}{An object created by a call to \code{estimateTransform} or \code{powerTransform}.} \item{lambda}{A vector of values of length equal to the number of variables to be transformed.} } \details{The function \code{\link{powerTransform}} is used to estimate a power transformation for a univariate or multivariate sample or multiple linear regression problem, using the method of Box and Cox (1964). It is usual to round the estimates to nearby convenient values, and this function is use to compulte a likelihood ratio test for values of the transformation parameter other than the ml estimate. This is a generic function, but with only one method, for objects of class \code{powerTransform}.} \value{ A data frame with one row giving the value of the test statistic, its degrees of freedom, and a p-value. The test is the likelihood ratio test, comparing the value of the log-likelihood at the hypothesized value to the value of the log-likelihood at the maximum likelihood estimate. } \references{Box, G. E. P. and Cox, D. R. (1964) An analysis of transformations. \emph{Journal of the Royal Statisistical Society, Series B}. 26 211-46. Cook, R. D. and Weisberg, S. (1999) \emph{Applied Regression Including Computing and Graphics}. Wiley. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition. Wiley. } \author{ Sanford Weisberg, } \seealso{\code{\link{powerTransform}}. } \examples{ summary(a3 <- powerTransform(cbind(len, ADT, trks, sigs1) ~ hwy, Highway1)) # test lambda = (0 0 0 -1) testTransform(a3, c(0, 0, 0, -1)) } \keyword{ regression}% at least one, from doc/KEYWORDS car/man/Vocab.Rd0000644000175100001440000000204111401002012013103 0ustar hornikusers\name{Vocab} \alias{Vocab} \docType{data} \title{Vocabulary and Education} \description{ The \code{Vocab} data frame has 21,638 rows and 5 columns. The observations are respondents to U.S. General Social Surveys, 1972-2004. } \format{ This data frame contains the following columns: \describe{ \item{year}{Year of the survey.} \item{sex}{Sex of the respondent, \code{Female} or \code{Male}.} \item{education}{ Education, in years. } \item{vocabulary}{ Vocabulary test score: number correct on a 10-word test. } } } \source{ National Opinion Research Center \emph{General Social Survey.} GSS Cumulative Datafile 1972-2004, downloaded from \url{http://sda.berkeley.edu/archive.htm}. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \usage{ Vocab } \keyword{datasets} car/man/ceresPlots.Rd0000644000175100001440000001175712026361333014234 0ustar hornikusers\name{ceresPlots} \alias{ceresPlots} \alias{ceresPlot} \alias{ceresPlot.lm} \alias{ceresPlot.glm} \title{Ceres Plots} \description{ These functions draw Ceres plots for linear and generalized linear models. } \usage{ ceresPlots(model, terms = ~., layout = NULL, ask, main, ...) ceresPlot(model, ...) \method{ceresPlot}{lm}(model, variable, id.method = list(abs(residuals(model, type="pearson")), "x"), labels, id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], line=TRUE, smoother=loessLine, smoother.args=list(), smooth, span, col=palette()[1], col.lines=palette()[-1], xlab, ylab, pch=1, lwd=2, grid=TRUE, ...) \method{ceresPlot}{glm}(model, ...) } \arguments{ \item{model}{model object produced by \code{lm} or \code{glm}.} \item{terms}{ A one-sided formula that specifies a subset of the predictors. One component-plus-residual plot is drawn for each term. The default \code{~.} is to plot against all numeric predictors. For example, the specification \code{terms = ~ . - X3} would plot against all predictors except for \code{X3}. Factors and nonstandard predictors such as B-splines are skipped. If this argument is a quoted name of one of the predictors, the component-plus-residual plot is drawn for that predictor only. } \item{layout}{ If set to a value like \code{c(1, 1)} or \code{c(4, 3)}, the layout of the graph will have this many rows and columns. If not set, the program will select an appropriate layout. If the number of graphs exceed nine, you must select the layout yourself, or you will get a maximum of nine per page. If \code{layout=NA}, the function does not set the layout and the user can use the \code{par} function to control the layout, for example to have plots from two models in the same graphics window. } \item{ask}{If \code{TRUE}, ask the user before drawing the next plot; if \code{FALSE}, the default, don't ask. This is relevant only if not all the graphs can be drawn in one window.} \item{main}{Overall title for any array of cerers plots; if missing a default is provided.} \item{\dots}{\code{ceresPlots} passes these arguments to \code{ceresPlot}. \code{ceresPlot} passes them to \code{plot}. } \item{variable}{A quoted string giving the name of a variable for the horizontal axis} \item{id.method,labels,id.n,id.cex,id.col}{Arguments for the labelling of points. The default is \code{id.n=0} for labeling no points. See \code{\link{showLabels}} for details of these arguments. } \item{line}{\code{TRUE} to plot least-squares line. } \item{smoother}{Function to add a nonparametric smooth. } \item{smoother.args}{see \code{\link{ScatterplotSmoothers}} for available smooethers and arguments. } \item{smooth, span}{these arguments are included for backwards compatility: if \code{smooth=TRUE} then \code{smoother} is set to \code{loessLine}, and if \code{span} is specified, it is added to \code{smoother.args}.} \item{col}{color for points; the default is the first entry in the current color palette (see \code{\link[grDevices]{palette}} and \code{\link[graphics]{par}}). } \item{col.lines}{a list of at least two colors. The first color is used for the ls line and the second color is used for the fitted lowess line. To use the same color for both, use, for example, \code{col.lines=c("red", "red")} } \item{xlab,ylab}{labels for the x and y axes, respectively. If not set appropriate labels are created by the function.} \item{pch}{plotting character for points; default is \code{1} (a circle, see \code{\link[graphics]{par}}). } \item{lwd}{line width; default is \code{2} (see \code{\link[graphics]{par}}). } \item{grid}{If TRUE, the default, a light-gray background grid is put on the graph } } \details{ Ceres plots are a generalization of component+residual (partial residual) plots that are less prone to leakage of nonlinearity among the predictors. The function intended for direct use is \code{ceresPlots}. The model cannot contain interactions, but can contain factors. Factors may be present in the model, but Ceres plots cannot be drawn for them. } \value{ \code{NULL}. These functions are used for their side effect: producing plots. } \references{ Cook, R. D. and Weisberg, S. (1999) \emph{Applied Regression, Including Computing and Graphics.} Wiley. Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition. Wiley. } \author{John Fox \email{jfox@mcmaster.ca}} \seealso{\code{\link{crPlots}}, \code{\link{avPlots}}, \code{\link{showLabels}}} \examples{ ceresPlots(lm(prestige~income+education+type, data=Prestige), terms= ~ . - type) } \keyword{hplot} \keyword{regression} car/man/Mroz.Rd0000644000175100001440000000336411401002012013011 0ustar hornikusers\name{Mroz} \alias{Mroz} \docType{data} \title{U.S. Women's Labor-Force Participation} \usage{Mroz} \description{ The \code{Mroz} data frame has 753 rows and 8 columns. The observations, from the Panel Study of Income Dynamics (PSID), are married women. } \format{ This data frame contains the following columns: \describe{ \item{lfp}{labor-force participation; a factor with levels: \code{no}; \code{yes}. } \item{k5}{number of children 5 years old or younger.} \item{k618}{number of children 6 to 18 years old.} \item{age}{in years.} \item{wc}{wife's college attendance; a factor with levels: \code{no}; \code{yes}. } \item{hc}{husband's college attendance; a factor with levels: \code{no}; \code{yes}. } \item{lwg}{log expected wage rate; for women in the labor force, the actual wage rate; for women not in the labor force, an imputed value based on the regression of \code{lwg} on the other variables.} \item{inc}{family income exclusive of wife's income.} } } \source{ Mroz, T. A. (1987) The sensitivity of an empirical model of married women's hours of work to economic and statistical assumptions. \emph{Econometrica} \bold{55}, 765--799. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. (2000) \emph{Multiple and Generalized Nonparametric Regression.} Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Long. J. S. (1997) \emph{Regression Models for Categorical and Limited Dependent Variables.} Sage. } \keyword{datasets} car/man/Prestige.Rd0000644000175100001440000000301111401002012013631 0ustar hornikusers\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 of occupational incumbents, years, in 1971. } \item{income}{ Average income of incumbents, dollars, in 1971. } \item{women}{ Percentage of incumbents who are women. } \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. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \usage{ Prestige } \keyword{datasets} car/man/leveragePlots.Rd0000644000175100001440000000774111576447475014750 0ustar hornikusers\name{leveragePlots} \alias{leveragePlots} \alias{leveragePlot} \alias{leveragePlot.lm} \alias{leveragePlot.glm} \title{Regression Leverage Plots} \description{ These functions display a generalization, due to Sall (1990) and Cook and Weisberg (1991), of added-variable plots to multiple-df terms in a linear model. When a term has just 1 df, the leverage plot is a rescaled version of the usual added-variable (partial-regression) plot. } \usage{ leveragePlots(model, terms = ~., layout = NULL, ask, main, ...) leveragePlot(model, ...) \method{leveragePlot}{lm}(model, term.name, id.method = list(abs(residuals(model, type="pearson")), "x"), labels, id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], col=palette()[1], col.lines=palette()[2], lwd=2, xlab, ylab, main="Leverage Plot", grid=TRUE, ...) \method{leveragePlot}{glm}(model, ...) } \arguments{ \item{model}{model object produced by \code{lm} } \item{terms}{ A one-sided formula that specifies a subset of the predictors. One added-variable plot is drawn for each term. The default \code{~.} is to plot against all numeric predictors. For example, the specification \code{terms = ~ . - X3} would plot against all predictors except for \code{X3}. If this argument is a quoted name of one of the predictors, the added-variable plot is drawn for that predictor only. } \item{layout}{ If set to a value like \code{c(1, 1)} or \code{c(4, 3)}, the layout of the graph will have this many rows and columns. If not set, the program will select an appropriate layout. If the number of graphs exceed nine, you must select the layout yourself, or you will get a maximum of nine per page. If \code{layout=NA}, the function does not set the layout and the user can use the \code{par} function to control the layout, for example to have plots from two models in the same graphics window. } \item{ask}{if \code{TRUE}, a menu is provided in the R Console for the user to select the term(s) to plot. } \item{xlab, ylab}{axis labels; if missing, labels will be supplied. } \item{main}{title for plot; if missing, a title will be supplied. } \item{\dots}{arguments passed down to method functions.} \item{term.name}{Quoted name of term in the model to be plotted; this argument is omitted for \code{leveragePlots}.} \item{id.method,labels,id.n,id.cex,id.col}{Arguments for the labelling of points. The default is \code{id.n=0} for labeling no points. See \code{\link{showLabels}} for details of these arguments. } \item{col}{color(s) of points} \item{col.lines}{color of the fitted line } \item{lwd}{line width; default is \code{2} (see \code{\link[graphics]{par}}). } \item{grid}{If TRUE, the default, a light-gray background grid is put on the graph} } \details{ The function intended for direct use is \code{leveragePlots}. The model can contain factors and interactions. A leverage plot can be drawn for each term in the model, including the constant. \code{leveragePlot.glm} is a dummy function, which generates an error message. } \value{ \code{NULL}. These functions are used for their side effect: producing plots. } \references{ Cook, R. D. and Weisberg, S. (1991). Added Variable Plots in Linear Regression. In Stahel, W. and Weisberg, S. (eds.), \emph{Directions in Robust Statistics and Diagnostics}. Springer, 47-60. Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Sall, J. (1990) Leverage plots for general linear hypotheses. \emph{American Statistician} \bold{44}, 308--315. } \author{John Fox \email{jfox@mcmaster.ca}} \seealso{\code{\link{avPlots}}} \examples{ leveragePlots(lm(prestige~(income+education)*type, data=Duncan)) } \keyword{hplot} \keyword{regression} car/man/Migration.Rd0000644000175100001440000000506011401002012014006 0ustar hornikusers\name{Migration} \alias{Migration} \docType{data} \title{Canadian Interprovincial Migration Data} \description{ The \code{Migration} data frame has 90 rows and 8 columns. } \format{ This data frame contains the following columns: \describe{ \item{source}{ Province of origin (source). A factor with levels: \code{ALTA}, Alberta; \code{BC}, British Columbia; \code{MAN}, Manitoba; \code{NB}, New Brunswick; \code{NFLD}, New Foundland; \code{NS}, Nova Scotia; \code{ONT}, Ontario; \code{PEI}, Prince Edward Island; \code{QUE}, Quebec; \code{SASK}, Saskatchewan. } \item{destination}{ Province of destination (1971 residence). A factor with levels: \code{ALTA}, Alberta; \code{BC}, British Columbia; \code{MAN}, Manitoba; \code{NB}, New Brunswick; \code{NFLD}, New Foundland; \code{NS}, Nova Scotia; \code{ONT}, Ontario; \code{PEI}, Prince Edward Island; \code{QUE}, Quebec; \code{SASK}, Saskatchewan. } \item{migrants}{ Number of migrants (from source to destination) in the period 1966--1971. } \item{distance}{ Distance (between principal cities of provinces): NFLD, St. John; PEI, Charlottetown; NS, Halifax; NB, Fredricton; QUE, Montreal; ONT, Toronto; MAN, Winnipeg; SASK, Regina; ALTA, Edmonton; BC, Vancouver. } \item{pops66}{ 1966 population of source province. } \item{pops71}{ 1971 population of source province. } \item{popd66}{ 1966 population of destination province. } \item{popd71}{ 1971 population of destination province. } } } \details{ There is one record in the data file for each migration stream. You can average the 1966 and 1971 population figures for each of the source and destination provinces. } \source{ Canada (1962) \emph{Map}. Department of Mines and Technical Surveys. Canada (1971) \emph{Census of Canada}. Statistics Canada, Vol. 1, Part 2 [Table 32]. Canada (1972) \emph{Canada Year Book}. Statistics Canada [p. 1369]. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. } \usage{ Migration } \keyword{datasets} car/man/boxCox.Rd0000644000175100001440000001007212204733747013352 0ustar hornikusers\name{boxCox} \alias{boxCox} \alias{boxCox.lm} \alias{boxCox.default} \alias{boxCox.formula} \title{ Box-Cox Transformations for Linear Models } \description{ Computes and optionally plots profile log-likelihoods for the parameter of the Box-Cox power transformation. This is a slight generalization of the \code{boxcox} function in the \pkg{MASS} package that allows for families of transformations other than the Box-Cox power family. } \usage{ boxCox(object, ...) \method{boxCox}{default}(object, lambda = seq(-2, 2, 1/10), plotit = TRUE, interp = (plotit && (m < 100)), eps = 1/50, xlab = expression(lambda), ylab = "log-Likelihood", family="bcPower", grid=TRUE, ...) \method{boxCox}{formula}(object, lambda = seq(-2, 2, 1/10), plotit = TRUE, interp = (plotit && (m < 100)), eps = 1/50, xlab = expression(lambda), ylab = "log-Likelihood", family="bcPower", ...) \method{boxCox}{lm}(object, lambda = seq(-2, 2, 1/10), plotit = TRUE, interp = (plotit && (m < 100)), eps = 1/50, xlab = expression(lambda), ylab = "log-Likelihood", family="bcPower", ...) } \arguments{ \item{object}{ a formula or fitted model object. Currently only \code{lm} and \code{aov} objects are handled. } \item{lambda}{ vector of values of lambda, with default (-2, 2) in steps of 0.1, where the profile log-likelihood will be evaluated. } \item{plotit}{ logical which controls whether the result should be plotted; default \code{TRUE}. } \item{interp}{ logical which controls whether spline interpolation is used. Default to \code{TRUE} if plotting with lambda of length less than 100. } \item{eps}{ Tolerance for lambda = 0; defaults to 0.02. } \item{xlab}{ defaults to \code{"lambda"}. } \item{ylab}{ defaults to \code{"log-Likelihood"}. } \item{family}{ Defaults to \code{"bcPower"} for the Box-Cox power family of transformations. If set to \code{"yjPower"} the Yeo-Johnson family, which permits negative responses, is used. } \item{grid}{If TRUE, the default, a light-gray background grid is put on the graph. } \item{\dots}{ additional parameters to be used in the model fitting. } } \details{ This routine is an elaboration of the \code{\link{boxcox}} function in the \pkg{MASS} package. All arguments except for \code{family} and \code{grid} are identical, and if the arguments \code{family = "bcPower", grid=FALSE} is set it gives an identical graph. If \code{family = "yjPower"} then the Yeo-Johnson power transformations, which allow nonpositive responses, will be used. } \value{ A list of the lambda vector and the computed profile log-likelihood vector, invisibly if the result is plotted. If \code{plotit=TRUE} plots log-likelihood vs lambda and indicates a 95% confidence interval about the maximum observed value of lambda. If \code{interp=TRUE}, spline interpolation is used to give a smoother plot. } \references{ Box, G. E. P. and Cox, D. R. (1964) An analysis of transformations. \emph{Journal of the Royal Statisistical Society, Series B}. 26 211-46. Cook, R. D. and Weisberg, S. (1999) \emph{Applied Regression Including Computing and Graphics}. Wiley. Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition. Wiley. Yeo, I. and Johnson, R. (2000) A new family of power transformations to improve normality or symmetry. \emph{Biometrika}, 87, 954-959. } \author{ Sanford Weisberg, } \seealso{ \code{\link{boxcox}}, \code{\link{yjPower}}, \code{\link{bcPower}}, \code{\link{powerTransform}} } \examples{ boxCox(Volume ~ log(Height) + log(Girth), data = trees, lambda = seq(-0.25, 0.25, length = 10)) data("quine", package = "MASS") boxCox(Days ~ Eth*Sex*Age*Lrn, data = quine, lambda = seq(-0.05, 0.45, len = 20), family="yjPower") } \keyword{ regression} car/man/OBrienKaiser.Rd0000644000175100001440000000370511401002012014376 0ustar hornikusers\name{OBrienKaiser} \alias{OBrienKaiser} \docType{data} \title{O'Brien and Kaiser's Repeated-Measures Data} \description{ These contrived repeated-measures data are taken from O'Brien and Kaiser (1985). The data are from an imaginary study in which 16 female and male subjects, who are divided into three treatments, are measured at a pretest, postest, and a follow-up session; during each session, they are measured at five occasions at intervals of one hour. The design, therefore, has two between-subject and two within-subject factors. The contrasts for the \code{treatment} factor are set to \eqn{-2, 1, 1} and \eqn{0, -1, 1}. The contrasts for the \code{gender} factor are set to \code{contr.sum}. } \usage{OBrienKaiser} \format{ A data frame with 16 observations on the following 17 variables. \describe{ \item{\code{treatment}}{a factor with levels \code{control} \code{A} \code{B}} \item{\code{gender}}{a factor with levels \code{F} \code{M}} \item{\code{pre.1}}{pretest, hour 1} \item{\code{pre.2}}{pretest, hour 2} \item{\code{pre.3}}{pretest, hour 3} \item{\code{pre.4}}{pretest, hour 4} \item{\code{pre.5}}{pretest, hour 5} \item{\code{post.1}}{posttest, hour 1} \item{\code{post.2}}{posttest, hour 2} \item{\code{post.3}}{posttest, hour 3} \item{\code{post.4}}{posttest, hour 4} \item{\code{post.5}}{posttest, hour 5} \item{\code{fup.1}}{follow-up, hour 1} \item{\code{fup.2}}{follow-up, hour 2} \item{\code{fup.3}}{follow-up, hour 3} \item{\code{fup.4}}{follow-up, hour 4} \item{\code{fup.5}}{follow-up, hour 5} } } \source{ O'Brien, R. G., and Kaiser, M. K. (1985) MANOVA method for analyzing repeated measures designs: An extensive primer. \emph{Psychological Bulletin} \bold{97}, 316--333, Table 7. } \examples{ OBrienKaiser contrasts(OBrienKaiser$treatment) contrasts(OBrienKaiser$gender) } \keyword{datasets} car/man/linearHypothesis.Rd0000644000175100001440000004365512161401342015440 0ustar hornikusers%------------------------------------------------------------------------------- % Revision history: % checked in 2008-12-29 by J. Fox (corresponds to version 1.2-10 of car % with function renamed from linear.hypothesis) % 2009-01-16 updated doc to correspond to changes in linearHypothesis. J. Fox % 2009-12-22 updated to reflect changes in linearHypothesis.mlm(). J. Fox % 2010-07-09 added linearHypothesis.polr() and coef.multinom(). J. Fox % 2010-07-27 coef.multinom() no longer exported. J. Fox % 2011-01-21 added linearHypothesis.mer(), linearHypothesis.lme, % matchCoefs() and methods. J. Fox % 2011-06-09 added matchCoefs.mlm(). J. Fox % 2011-11-13 clarification of test argument in linearHypothesis.mlm(). J. Fox % 2012-02-28 added test argument to linearHypothesis.mer(). J. Fox % 2012-03-07 singular.ok argument added to linearHypothesis.mlm(). J. Fox % 2012-11-06 coef. argument added to linearHypothesis.default(), S. Weisberg % 2013-06-20 added .merMod methods to linearHypothesis() and matchCoefs(). J. Fox %------------------------------------------------------------------------------- \name{linearHypothesis} \alias{linearHypothesis} \alias{lht} \alias{linearHypothesis.lm} \alias{linearHypothesis.glm} \alias{linearHypothesis.mlm} \alias{linearHypothesis.polr} \alias{linearHypothesis.default} \alias{linearHypothesis.mer} \alias{linearHypothesis.merMod} \alias{linearHypothesis.lme} \alias{linearHypothesis.svyglm} \alias{print.linearHypothesis.mlm} \alias{matchCoefs} \alias{matchCoefs.default} \alias{matchCoefs.mer} \alias{matchCoefs.merMod} \alias{matchCoefs.lme} \alias{matchCoefs.mlm} \alias{linearHypothesis.nlsList} %%\alias{coef.multinom} \title{Test Linear Hypothesis} \description{ Generic function for testing a linear hypothesis, and methods for linear models, generalized linear models, multivariate linear models, linear and generalized linear mixed-effects models, and other models that have methods for \code{coef} and \code{vcov}. For mixed-effects models, the tests are Wald chi-square tests for the fixed effects. } \usage{ linearHypothesis(model, ...) lht(model, ...) \method{linearHypothesis}{default}(model, hypothesis.matrix, rhs=NULL, test=c("Chisq", "F"), vcov.=NULL, singular.ok=FALSE, verbose=FALSE, coef. = coef(model), ...) \method{linearHypothesis}{lm}(model, hypothesis.matrix, rhs=NULL, test=c("F", "Chisq"), vcov.=NULL, white.adjust=c(FALSE, TRUE, "hc3", "hc0", "hc1", "hc2", "hc4"), singular.ok=FALSE, ...) \method{linearHypothesis}{glm}(model, ...) \method{linearHypothesis}{nlsList}(model, ..., vcov., coef.) \method{linearHypothesis}{mlm}(model, hypothesis.matrix, rhs=NULL, SSPE, V, test, idata, icontrasts=c("contr.sum", "contr.poly"), idesign, iterms, check.imatrix=TRUE, P=NULL, title="", singular.ok=FALSE, verbose=FALSE, ...) \method{linearHypothesis}{polr}(model, hypothesis.matrix, rhs=NULL, vcov., verbose=FALSE, ...) \method{print}{linearHypothesis.mlm}(x, SSP=TRUE, SSPE=SSP, digits=getOption("digits"), ...) \method{linearHypothesis}{lme}(model, hypothesis.matrix, rhs=NULL, vcov.=NULL, singular.ok=FALSE, verbose=FALSE, ...) \method{linearHypothesis}{mer}(model, hypothesis.matrix, rhs=NULL, vcov.=NULL, test=c("Chisq", "F"), singular.ok=FALSE, verbose=FALSE, ...) \method{linearHypothesis}{merMod}(model, hypothesis.matrix, rhs=NULL, vcov.=NULL, test=c("Chisq", "F"), singular.ok=FALSE, verbose=FALSE, ...) \method{linearHypothesis}{svyglm}(model, ...) %%\method{coef}{multinom}(object, ...) matchCoefs(model, pattern, ...) \method{matchCoefs}{default}(model, pattern, coef.=coef, ...) \method{matchCoefs}{lme}(model, pattern, ...) \method{matchCoefs}{mer}(model, pattern, ...) \method{matchCoefs}{merMod}(model, pattern, ...) \method{matchCoefs}{mlm}(model, pattern, ...) } \arguments{ \item{model}{fitted model object. The default method of \code{linearHypothesis} works for models for which the estimated parameters can be retrieved by \code{coef} and the corresponding estimated covariance matrix by \code{vcov}. See the \emph{Details} for more information.} \item{hypothesis.matrix}{matrix (or vector) giving linear combinations of coefficients by rows, or a character vector giving the hypothesis in symbolic form (see \emph{Details}).} \item{rhs}{right-hand-side vector for hypothesis, with as many entries as rows in the hypothesis matrix; can be omitted, in which case it defaults to a vector of zeroes. For a multivariate linear model, \code{rhs} is a matrix, defaulting to 0.} \item{singular.ok}{if \code{FALSE} (the default), a model with aliased coefficients produces an error; if \code{TRUE}, the aliased coefficients are ignored, and the hypothesis matrix should not have columns for them. For a multivariate linear model: will return the hypothesis and error SSP matrices even if the latter is singular; useful for computing univariate repeated-measures ANOVAs where there are fewer subjects than df for within-subject effects.} \item{idata}{an optional data frame giving a factor or factors defining the intra-subject model for multivariate repeated-measures data. See \emph{Details} for an explanation of the intra-subject design and for further explanation of the other arguments relating to intra-subject factors.} \item{icontrasts}{names of contrast-generating functions to be applied by default to factors and ordered factors, respectively, in the within-subject ``data''; the contrasts must produce an intra-subject model matrix in which different terms are orthogonal.} \item{idesign}{a one-sided model formula using the ``data'' in \code{idata} and specifying the intra-subject design.} \item{iterms}{the quoted name of a term, or a vector of quoted names of terms, in the intra-subject design to be tested.} \item{check.imatrix}{check that columns of the intra-subject model matrix for different terms are mutually orthogonal (default, \code{TRUE}). Set to \code{FALSE} only if you have \emph{already} checked that the intra-subject model matrix is block-orthogonal.} \item{P}{transformation matrix to be applied to the repeated measures in multivariate repeated-measures data; if \code{NULL} \emph{and} no intra-subject model is specified, no response-transformation is applied; if an intra-subject model is specified via the \code{idata}, \code{idesign}, and (optionally) \code{icontrasts} arguments, then \code{P} is generated automatically from the \code{iterms} argument.} \item{SSPE}{in \code{linearHypothesis} method for \code{mlm} objects: optional error sum-of-squares-and-products matrix; if missing, it is computed from the model. In \code{print} method for \code{linearHypothesis.mlm} objects: if \code{TRUE}, print the sum-of-squares and cross-products matrix for error.} \item{test}{character string, \code{"F"} or \code{"Chisq"}, specifying whether to compute the finite-sample F statistic (with approximate F distribution) or the large-sample Chi-squared statistic (with asymptotic Chi-squared distribution). For a multivariate linear model, the multivariate test statistic to report --- one or more of \code{"Pillai"}, \code{"Wilks"}, \code{"Hotelling-Lawley"}, or \code{"Roy"}, with \code{"Pillai"} as the default.} \item{title}{an optional character string to label the output.} \item{V}{inverse of sum of squares and products of the model matrix; if missing it is computed from the model.} \item{vcov.}{a function for estimating the covariance matrix of the regression coefficients, e.g., \code{\link{hccm}}, or an estimated covariance matrix for \code{model}. See also \code{white.adjust}.} \item{coef.}{a vector of coefficient estimates. The default is to get the coefficient estimates from the \code{model} argument, but the user can input any vector of the correct length.} \item{white.adjust}{logical or character. Convenience interface to \code{hccm} (instead of using the argument \code{vcov.}). Can be set either to a character value specifying the \code{type} argument of \code{\link{hccm}} or \code{TRUE}, in which case \code{"hc3"} is used implicitly. The default is \code{FALSE}.} \item{verbose}{If \code{TRUE}, the hypothesis matrix, right-hand-side vector (or matrix), and estimated value of the hypothesis are printed to standard output; if \code{FALSE} (the default), the hypothesis is only printed in symbolic form and the value of the hypothesis is not printed.} \item{x}{an object produced by \code{linearHypothesis.mlm}.} \item{SSP}{if \code{TRUE} (the default), print the sum-of-squares and cross-products matrix for the hypothesis and the response-transformation matrix.} \item{digits}{minimum number of signficiant digits to print.} %% \item{object}{a \code{multinom} model object.} \item{pattern}{a \link[base:regex]{regular expression} to be matched against coefficient names.} \item{...}{arguments to pass down.} } \details{ \code{linearHypothesis} computes either a finite-sample F statistic or asymptotic Chi-squared statistic for carrying out a Wald-test-based comparison between a model and a linearly restricted model. The default method will work with any model object for which the coefficient vector can be retrieved by \code{coef} and the coefficient-covariance matrix by \code{vcov} (otherwise the argument \code{vcov.} has to be set explicitly). For computing the F statistic (but not the Chi-squared statistic) a \code{df.residual} method needs to be available. If a \code{formula} method exists, it is used for pretty printing. The method for \code{"lm"} objects calls the default method, but it changes the default test to \code{"F"}, supports the convenience argument \code{white.adjust} (for backwards compatibility), and enhances the output by the residual sums of squares. For \code{"glm"} objects just the default method is called (bypassing the \code{"lm"} method). The \code{svyglm} method also calls the default method. The function \code{lht} also dispatches to \code{linearHypothesis}. The hypothesis matrix can be supplied as a numeric matrix (or vector), the rows of which specify linear combinations of the model coefficients, which are tested equal to the corresponding entries in the right-hand-side vector, which defaults to a vector of zeroes. Alternatively, the hypothesis can be specified symbolically as a character vector with one or more elements, each of which gives either a linear combination of coefficients, or a linear equation in the coefficients (i.e., with both a left and right side separated by an equals sign). Components of a linear expression or linear equation can consist of numeric constants, or numeric constants multiplying coefficient names (in which case the number precedes the coefficient, and may be separated from it by spaces or an asterisk); constants of 1 or -1 may be omitted. Spaces are always optional. Components are separated by plus or minus signs. Newlines or tabs in hypotheses will be treated as spaces. See the examples below. If the user sets the arguments \code{coef.} and \code{vcov.}, then the computations are done without reference to the \code{model} argument. This is like assuming that \code{coef.} is normally distibuted with estimated variance \code{vcov.} and the \code{linearHypothesis} will compute tests on the mean vector for \code{coef.}, without actually using the \code{model} argument. A linear hypothesis for a multivariate linear model (i.e., an object of class \code{"mlm"}) can optionally include an intra-subject transformation matrix for a repeated-measures design. If the intra-subject transformation is absent (the default), the multivariate test concerns all of the corresponding coefficients for the response variables. There are two ways to specify the transformation matrix for the repeated measures: \enumerate{ \item The transformation matrix can be specified directly via the \code{P} argument. \item A data frame can be provided defining the repeated-measures factor or factors via \code{idata}, with default contrasts given by the \code{icontrasts} argument. An intra-subject model-matrix is generated from the one-sided formula specified by the \code{idesign} argument; columns of the model matrix corresponding to different terms in the intra-subject model must be orthogonal (as is insured by the default contrasts). Note that the contrasts given in \code{icontrasts} can be overridden by assigning specific contrasts to the factors in \code{idata}. The repeated-measures transformation matrix consists of the columns of the intra-subject model matrix corresponding to the term or terms in \code{iterms}. In most instances, this will be the simpler approach, and indeed, most tests of interests can be generated automatically via the \code{\link{Anova}} function. } \code{matchCoefs} is a convenience function that can sometimes help in formulating hypotheses; for example \code{matchCoefs(mod, ":")} will return the names of all interaction coefficients in the model \code{mod}. } \value{ For a univariate model, an object of class \code{"anova"} which contains the residual degrees of freedom in the model, the difference in degrees of freedom, Wald statistic (either \code{"F"} or \code{"Chisq"}), and corresponding p value. For a multivariate linear model, an object of class \code{"linearHypothesis.mlm"}, which contains sums-of-squares-and-product matrices for the hypothesis and for error, degrees of freedom for the hypothesis and error, and some other information. The returned object normally would be printed. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Hand, D. J., and Taylor, C. C. (1987) \emph{Multivariate Analysis of Variance and Repeated Measures: A Practical Approach for Behavioural Scientists.} Chapman and Hall. O'Brien, R. G., and Kaiser, M. K. (1985) MANOVA method for analyzing repeated measures designs: An extensive primer. \emph{Psychological Bulletin} \bold{97}, 316--333. } \author{Achim Zeileis and John Fox \email{jfox@mcmaster.ca}} \seealso{\code{\link[stats]{anova}}, \code{\link{Anova}}, \code{\link[lmtest]{waldtest}}, \code{\link{hccm}}, \code{\link[sandwich]{vcovHC}}, \code{\link[sandwich]{vcovHAC}}, \code{\link[stats]{coef}}, \code{\link[stats]{vcov}} } \examples{ mod.davis <- lm(weight ~ repwt, data=Davis) ## the following are equivalent: linearHypothesis(mod.davis, diag(2), c(0,1)) linearHypothesis(mod.davis, c("(Intercept) = 0", "repwt = 1")) linearHypothesis(mod.davis, c("(Intercept)", "repwt"), c(0,1)) linearHypothesis(mod.davis, c("(Intercept)", "repwt = 1")) ## use asymptotic Chi-squared statistic linearHypothesis(mod.davis, c("(Intercept) = 0", "repwt = 1"), test = "Chisq") ## the following are equivalent: ## use HC3 standard errors via white.adjust option linearHypothesis(mod.davis, c("(Intercept) = 0", "repwt = 1"), white.adjust = TRUE) ## covariance matrix *function* linearHypothesis(mod.davis, c("(Intercept) = 0", "repwt = 1"), vcov = hccm) ## covariance matrix *estimate* linearHypothesis(mod.davis, c("(Intercept) = 0", "repwt = 1"), vcov = hccm(mod.davis, type = "hc3")) mod.duncan <- lm(prestige ~ income + education, data=Duncan) ## the following are all equivalent: linearHypothesis(mod.duncan, "1*income - 1*education = 0") linearHypothesis(mod.duncan, "income = education") linearHypothesis(mod.duncan, "income - education") linearHypothesis(mod.duncan, "1income - 1education = 0") linearHypothesis(mod.duncan, "0 = 1*income - 1*education") linearHypothesis(mod.duncan, "income-education=0") linearHypothesis(mod.duncan, "1*income - 1*education + 1 = 1") linearHypothesis(mod.duncan, "2income = 2*education") mod.duncan.2 <- lm(prestige ~ type*(income + education), data=Duncan) coefs <- names(coef(mod.duncan.2)) ## test against the null model (i.e., only the intercept is not set to 0) linearHypothesis(mod.duncan.2, coefs[-1]) ## test all interaction coefficients equal to 0 linearHypothesis(mod.duncan.2, coefs[grep(":", coefs)], verbose=TRUE) linearHypothesis(mod.duncan.2, matchCoefs(mod.duncan.2, ":"), verbose=TRUE) # equivalent ## a multivariate linear model for repeated-measures data ## see ?OBrienKaiser for a description of the data set used in this example. mod.ok <- lm(cbind(pre.1, pre.2, pre.3, pre.4, pre.5, post.1, post.2, post.3, post.4, post.5, fup.1, fup.2, fup.3, fup.4, fup.5) ~ treatment*gender, data=OBrienKaiser) coef(mod.ok) ## specify the model for the repeated measures: phase <- factor(rep(c("pretest", "posttest", "followup"), c(5, 5, 5)), levels=c("pretest", "posttest", "followup")) hour <- ordered(rep(1:5, 3)) idata <- data.frame(phase, hour) idata ## test the four-way interaction among the between-subject factors ## treatment and gender, and the intra-subject factors ## phase and hour linearHypothesis(mod.ok, c("treatment1:gender1", "treatment2:gender1"), title="treatment:gender:phase:hour", idata=idata, idesign=~phase*hour, iterms="phase:hour") ## mixed-effects models examples: \dontrun{ library(nlme) example(lme) linearHypothesis(fm2, "age = 0") } \dontrun{ library(lme4) example(glmer) linearHypothesis(gm1, matchCoefs(gm1, "period")) } } \keyword{htest} \keyword{models} \keyword{regression} car/man/Adler.Rd0000644000175100001440000000305011253536255013133 0ustar hornikusers\name{Adler} \alias{Adler} \docType{data} \title{Experimenter Expectations} \description{ The \code{Adler} data frame has 97 rows and 3 columns. The ``experimenters'' were the actual subjects of the study. They collected ratings of the apparent successfulness of people in pictures who were pre-selected for their average appearance. The experimenters were told prior to collecting data that the pictures were either high or low in their appearance of success, and were instructed to get good data, scientific data, or were given no such instruction. Each experimenter collected ratings from 18 randomly assigned respondents; a few subjects were deleted at random to produce an unbalanced design. } \format{ This data frame contains the following columns: \describe{ \item{instruction}{ a factor with levels: \code{GOOD}, good data; \code{NONE}, no stress; \code{SCIENTIFIC}, scientific data. } \item{expectation}{ a factor with levels: \code{HIGH}, expect high ratings; \code{LOW}, expect low ratings. } \item{rating}{ The average rating obtained. } } } \source{ Adler, N. E. (1973) Impact of prior sets given experimenters and subjects on the experimenter expectancy effect. \emph{Sociometry} \bold{36}, 113--126. } \references{ Erickson, B. H., and Nosanchuk, T. A. (1977) \emph{Understanding Data.} McGraw-Hill Ryerson. } \usage{ Adler } \keyword{datasets} car/man/Hartnagel.Rd0000644000175100001440000000334011401002012013761 0ustar hornikusers\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} car/man/regLine.Rd0000644000175100001440000000311711401002012013443 0ustar hornikusers\name{regLine} \alias{regLine} \title{Plot Regression Line} \description{ Plots a regression line on a scatterplot; the line is plotted between the minimum and maximum x-values. } \usage{ regLine(mod, col=palette()[2], lwd=2, lty=1,...) } \arguments{ \item{mod}{a model, such as produced by \code{lm}, that responds to the \code{coef} function by returning a 2-element vector, whose elements are interpreted respectively as the intercept and slope of a regresison line.} \item{col}{color for points and lines; the default is the \emph{second} entry in the current color palette (see \code{\link[grDevices]{palette}} and \code{\link[graphics]{par}}).} \item{lwd}{line width; default is \code{2} (see \code{\link[graphics]{par}}).} \item{lty}{line type; default is \code{1}, a solid line (see \code{\link[graphics]{par}}).} \item{\dots}{optional arguments to be passed to the \code{lines} plotting function.} } \details{ In contrast to \code{abline}, this function plots only over the range of the observed x-values. The x-values are extracted from \code{mod} as the second column of the model matrix. } \value{ \code{NULL}. This function is used for its side effect: adding a line to the plot. } \author{John Fox \email{jfox@mcmaster.ca}} \seealso{\code{\link[graphics]{abline}}, \code{\link[graphics]{lines}}} \examples{ plot(repwt ~ weight, pch=c(1,2)[sex], data=Davis) regLine(lm(repwt~weight, subset=sex=="M", data=Davis)) regLine(lm(repwt~weight, subset=sex=="F", data=Davis), lty=2) } \keyword{aplot} car/man/Boxplot.Rd0000644000175100001440000000512112131336567013534 0ustar hornikusers\name{Boxplot} \alias{Boxplot} \alias{Boxplot.default} \alias{Boxplot.formula} \title{ Boxplots With Point Identification } \description{ \code{Boxplot} is a wrapper for the standard \R{} \code{\link{boxplot}} function, providing point identification, axis labels, and a formula interface for boxplots without a grouping variable. } \usage{ Boxplot(y, ...) \method{Boxplot}{default}(y, g, labels, id.method = c("y", "identify", "none"), id.n=10, xlab, ylab, ...) \method{Boxplot}{formula}(formula, data = NULL, subset, na.action = NULL, labels., id.method = c("y", "identify", "none"), xlab, ylab, ...) } \arguments{ \item{y}{a numeric variable for which the boxplot is to be constructed.} \item{g}{a grouping variable, usually a factor, for constructing parallel boxplots.} \item{labels, labels.}{point labels; if not specified, \code{Boxplot} will use the row names of the \code{data} argument, if one is given, or observation numbers.} \item{id.method}{if \code{"y"} (the default), all outlying points are labeled; if \code{"identify"}, points may be labeled interactive; if \code{"none"}, no point identification is performed.} \item{id.n}{up to \code{id.n} high outliers and low outliers will be identified in each group, (default, 10).} \item{xlab, ylab}{text labels for the horizontal and vertical axes; if missing, \code{Boxplot} will use the variable names.} \item{formula}{a `model' formula, of the form \code{~ y} to produce a boxplot for the variable \code{y}, or of the form \code{y ~ g}, \code{y ~ g1*g2*...}, or \code{y ~ g1 + g2 + ...} to produce parallel boxplots for \code{y} within levels of the grouping variable(s) \code{g}, etc., usually factors.} \item{data, subset, na.action}{as for statistical modeling functions (see, e.g., \code{\link{lm}}).} \item{\dots}{further arguments, such as \code{at}, to be passed to \code{\link{boxplot}}.} } \author{John Fox \email{jfox@mcmaster.ca}, with a contribution from Steve Ellison to handle \code{at} argument (see \code{\link{boxplot}}).} \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \seealso{ \code{\link{boxplot}} } \examples{ Boxplot(~income, data=Prestige, id.n=Inf) # identify all outliers Boxplot(income ~ type, data=Prestige) Boxplot(income ~ type, data=Prestige, at=c(1, 3, 2)) Boxplot(k5 + k618 ~ lfp*wc, data=Mroz) with(Prestige, Boxplot(income, labels=rownames(Prestige))) with(Prestige, Boxplot(income, type, labels=rownames(Prestige))) } \keyword{hplot} car/man/Mandel.Rd0000644000175100001440000000133111401002012013252 0ustar hornikusers\name{Mandel} \alias{Mandel} \docType{data} \title{Contrived Collinear Data} \description{ The \code{Mandel} data frame has 8 rows and 3 columns. } \format{ This data frame contains the following columns: \describe{ \item{x1}{ first predictor. } \item{x2}{ second predictor. } \item{y}{ response. } } } \source{ Mandel, J. (1982) Use of the singular value decomposition in regression analysis. \emph{The American Statistician} \bold{36}, 15--24. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. } \usage{ Mandel } \keyword{datasets} car/man/UN.Rd0000644000175100001440000000157011401002012012401 0ustar hornikusers\name{UN} \alias{UN} \docType{data} \title{GDP and Infant Mortality} \description{ The \code{UN} data frame has 207 rows and 2 columns. The data are for 1998 and are from the United Nations; the observations are nations of the world. There are some missing data. } \format{ This data frame contains the following columns: \describe{ \item{infant.mortality}{ Infant morality rate, infant deaths per 1000 live births. } \item{gdp}{ GDP per capita, in U.S.~dollars. } } } \source{ United Nations (1998) Social indicators. \url{http://www.un.org/Depts/unsd/social/main.htm}. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \usage{ UN } \keyword{datasets} car/man/Chirot.Rd0000644000175100001440000000172011401002012013304 0ustar hornikusers\name{Chirot} \alias{Chirot} \docType{data} \title{The 1907 Romanian Peasant Rebellion} \description{ The \code{Chirot} data frame has 32 rows and 5 columns. The observations are counties in Romania. } \format{ This data frame contains the following columns: \describe{ \item{intensity}{ Intensity of the rebellion } \item{commerce}{ Commercialization of agriculture } \item{tradition}{ Traditionalism } \item{midpeasant}{ Strength of middle peasantry } \item{inequality}{ Inequality of land tenure } } } \source{ Chirot, D. and C. Ragin (1975) The market, tradition and peasant rebellion: The case of Romania. \emph{American Sociological Review} \bold{40}, 428--444 [Table 1]. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. } \usage{ Chirot } \keyword{datasets} car/man/leveneTest.Rd0000644000175100001440000000426111401002012014175 0ustar hornikusers\name{leveneTest} \alias{leveneTest} \alias{leveneTest.formula} \alias{leveneTest.lm} \alias{leveneTest.default} \title{Levene's Test} \description{ Computes Levene's test for homogeneity of variance across groups. } \usage{ leveneTest(y, ...) \method{leveneTest}{formula}(y, data, ...) \method{leveneTest}{lm}(y, ...) \method{leveneTest}{default}(y, group, center=median, ...) } \arguments{ \item{y}{response variable for the default method, or a \code{lm} or \code{formula} object. If \code{y} is a linear-model object or a formula, the variables on the right-hand-side of the model must all be factors and must be completely crossed.} \item{group}{factor defining groups.} \item{center}{The name of a function to compute the center of each group; \code{mean} gives the original Levene's test; the default, \code{median}, provides a more robust test.} \item{data}{a data frame for evaluating the \code{formula}.} \item{...}{arguments to be passed down, e.g., \code{data} for the \code{formula} and \code{lm} methods; can also be used to pass arguments to the function given by \code{center} (e.g., \code{center=mean} and \code{trim=0.1} specify the 10\% trimmed mean).} } \value{ returns an object meant to be printed showing the results of the test. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \author{John Fox \email{jfox@mcmaster.ca}; original generic version contributed by Derek Ogle} \note{adapted from a response posted by Brian Ripley to the r-help email list.} \examples{ with(Moore, leveneTest(conformity, fcategory)) with(Moore, leveneTest(conformity, interaction(fcategory, partner.status))) leveneTest(conformity ~ fcategory*partner.status, data=Moore) leveneTest(lm(conformity ~ fcategory*partner.status, data=Moore)) leveneTest(conformity ~ fcategory*partner.status, data=Moore, center=mean) leveneTest(conformity ~ fcategory*partner.status, data=Moore, center=mean, trim=0.1) } \keyword{htest} car/man/Blackmoor.Rd0000644000175100001440000000150711253536255014022 0ustar hornikusers\name{Blackmoor} \alias{Blackmoor} \docType{data} \title{Exercise Histories of Eating-Disordered and Control Subjects} \usage{Blackmoor} \description{ The \code{Blackmoor} data frame has 945 rows and 4 columns. Blackmoor and Davis's data on exercise histories of 138 teenaged girls hospitalized for eating disorders and 98 control subjects. } \format{ This data frame contains the following columns: \describe{ \item{subject}{a factor with subject id codes.} \item{age}{age in years.} \item{exercise}{hours per week of exercise.} \item{group}{a factor with levels: \code{control}, Control subjects; \code{patient}, Eating-disordered patients. } } } \source{ Personal communication from Elizabeth Blackmoor and Caroline Davis, York University. } \keyword{datasets} car/man/logit.Rd0000644000175100001440000000311011401002012013165 0ustar hornikusers\name{logit} \alias{logit} \title{Logit Transformation} \description{ Compute the logit transformation of proportions or percentages. } \usage{ logit(p, percents=range.p[2] > 1, adjust) } \arguments{ \item{p}{numeric vector or array of proportions or percentages.} \item{percents}{\code{TRUE} for percentages.} \item{adjust}{adjustment factor to avoid proportions of 0 or 1; defaults to \code{0} if there are no such proportions in the data, and to \code{.025} if there are.} } \details{ Computes the logit transformation logit \eqn{=\log [p/(1-p)]}{= log[p/(1 - p)]} for the proportion \eqn{p}. If \eqn{p=0}{p = 0} or \eqn{1}, then the logit is undefined. \code{logit} can remap the proportions to the interval \code{(adjust, 1 - adjust)} prior to the transformation. If it adjusts the data automatically, \code{logit} will print a warning message. } \value{ a numeric vector or array of the same shape and size as \code{p}. } \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \author{John Fox \email{jfox@mcmaster.ca}} \seealso{\code{\link{probabilityAxis}}} \examples{ options(digits=4) logit(.1*0:10) ## [1] -3.6636 -1.9924 -1.2950 -0.8001 -0.3847 0.0000 0.3847 ## [8] 0.8001 1.2950 1.9924 3.6636 ## Warning message: ## proportions remapped to (0.025, 0.975) in: logit(0.1 * 0:10) logit(.1*0:10, adjust=0) ## [1] -Inf -2.1972 -1.3863 -0.8473 -0.4055 0.0000 0.4055 ## [8] 0.8473 1.3863 2.1972 Inf } \keyword{manip} car/man/boxTidwell.Rd0000644000175100001440000000540311401002012014173 0ustar hornikusers\name{boxTidwell} \alias{boxTidwell} \alias{boxTidwell.formula} \alias{boxTidwell.default} \alias{print.boxTidwell} \title{Box-Tidwell Transformations} \description{ Computes the Box-Tidwell power transformations of the predictors in a linear model. } \usage{ boxTidwell(y, ...) \method{boxTidwell}{formula}(formula, other.x=NULL, data=NULL, subset, na.action=getOption("na.action"), verbose=FALSE, tol=0.001, max.iter=25, ...) \method{boxTidwell}{default}(y, x1, x2=NULL, max.iter=25, tol=0.001, verbose=FALSE, ...) \method{print}{boxTidwell}(x, digits, ...) } \arguments{ \item{formula}{two-sided formula, the right-hand-side of which gives the predictors to be transformed.} \item{other.x}{one-sided formula giving the predictors that are \emph{not} candidates for transformation, including (e.g.) factors.} \item{data}{an optional data frame containing the variables in the model. By default the variables are taken from the environment from which \code{boxTidwell} is called.} \item{subset}{an optional vector specifying a subset of observations to be used.} \item{na.action}{a function that indicates what should happen when the data contain \code{NA}s. The default is set by the \code{na.action} setting of \code{options}.} \item{verbose}{if \code{TRUE} a record of iterations is printed; default is \code{FALSE}.} \item{tol}{if the maximum relative change in coefficients is less than \code{tol} then convergence is declared.} \item{max.iter}{maximum number of iterations.} \item{y}{response variable.} \item{x1}{matrix of predictors to transform.} \item{x2}{matrix of predictors that are \emph{not} candidates for transformation.} \item{\dots}{not for the user.} \item{x}{\code{boxTidwell} object.} \item{digits}{number of digits for rounding.} } \details{ The maximum-likelihood estimates of the transformation parameters are computed by Box and Tidwell's (1962) method, which is usually more efficient than using a general nonlinear least-squares routine for this problem. Score tests for the transformations are also reported. } \value{ an object of class \code{boxTidwell}, which is normally just printed. } \references{ Box, G. E. P. and Tidwell, P. W. (1962) Transformation of the independent variables. \emph{Technometrics} \bold{4}, 531-550. Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \author{John Fox \email{jfox@mcmaster.ca}} \examples{ boxTidwell(prestige ~ income + education, ~ type + poly(women, 2), data=Prestige) } \keyword{regression} car/man/Greene.Rd0000644000175100001440000000423311401002012013263 0ustar hornikusers\name{Greene} \alias{Greene} \docType{data} \title{Refugee Appeals} \description{ The \code{Greene} data frame has 384 rows and 7 columns. These are cases filed in 1990, in which refugee claimants rejected by the Canadian Immigration and Refugee Board asked the Federal Court of Appeal for leave to appeal the negative ruling of the Board. } \format{ This data frame contains the following columns: \describe{ \item{judge}{ Name of judge hearing case. A factor with levels: \code{Desjardins}, \code{Heald}, \code{Hugessen}, \code{Iacobucci}, \code{MacGuigan}, \code{Mahoney}, \code{Marceau}, \code{Pratte}, \code{Stone}, \code{Urie}. } \item{nation}{ Nation of origin of claimant. A factor with levels: \code{Argentina}, \code{Bulgaria}, \code{China}, \code{Czechoslovakia}, \code{El.Salvador}, \code{Fiji}, \code{Ghana}, \code{Guatemala}, \code{India}, \code{Iran}, \code{Lebanon}, \code{Nicaragua}, \code{Nigeria}, \code{Pakistan}, \code{Poland}, \code{Somalia}, \code{Sri.Lanka}. } \item{rater}{ Judgment of independent rater. A factor with levels: \code{no}, case has no merit; \code{yes}, case has some merit (leave to appeal should be granted). } \item{decision}{ Judge's decision. A factor with levels: \code{no}, leave to appeal not granted; \code{yes}, leave to appeal granted. } \item{language}{ Language of case. A factor with levels: \code{English}, \code{French}. } \item{location}{ Location of original refugee claim. A factor with levels: \code{Montreal}, \code{other}, \code{Toronto}. } \item{success}{ Logit of success rate, for all cases from the applicant's nation. } } } \source{ Personal communication from Ian Greene, Department of Political Science, York University. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. } \usage{ Greene } \keyword{datasets} car/man/car-deprecated.Rd0000644000175100001440000000610011447655732014755 0ustar hornikusers\name{car-deprecated} \alias{car-deprecated} \alias{av.plot} \alias{av.plots} \alias{box.cox} \alias{bc} \alias{box.cox.powers} \alias{box.cox.var} \alias{box.tidwell} \alias{cookd} \alias{confidence.ellipse} \alias{ceres.plot} \alias{ceres.plots} \alias{cr.plot} \alias{cr.plots} \alias{data.ellipse} \alias{durbin.watson} \alias{levene.test} \alias{leverage.plot} \alias{leverage.plots} \alias{linear.hypothesis} \alias{outlier.test} \alias{ncv.test} \alias{qq.plot} \alias{scatterplot.matrix} \alias{spread.level.plot} \title{Deprecated Functions in car Package} \description{ These functions are provided for compatibility with older versions of the \pkg{car} package only, and may be removed eventually. Commands that worked in versions of the \pkg{car} package prior to version 2.0-0 will not necessarily work in version 2.0-0 and beyond, or may not work in the same manner. } \usage{ av.plot(...) av.plots(...) box.cox(...) bc(...) box.cox.powers(...) box.cox.var(...) box.tidwell(...) cookd(...) confidence.ellipse(...) ceres.plot(...) ceres.plots(...) cr.plot(...) cr.plots(...) data.ellipse(...) durbin.watson(...) levene.test(...) leverage.plot(...) leverage.plots(...) linear.hypothesis(...) ncv.test(...) outlier.test(...) qq.plot(...) scatterplot.matrix(...) spread.level.plot(...) } \arguments{ \item{\dots}{pass arguments down.} } \details{ \code{av.plot} and \code{av.plots} are now synonyms for the \code{\link{avPlot}} and \code{\link{avPlots}} functions. \code{box.cox} and \code{bc} are now synonyms for \code{\link{bcPower}}. \code{box.cox.powers} is now a synonym for \code{\link{powerTransform}}. \code{box.cox.var} is now a synonym for \code{\link{boxCoxVariable}}. \code{box.tidwell} is now a synonym for \code{\link{boxTidwell}}. \code{cookd} is now a synonym for \code{\link[stats:influence.measures]{cooks.distance}} in the \pkg{stats} package. \code{confidence.ellipse} is now a synonym for \code{\link{confidenceEllipse}}. \code{ceres.plot} and \code{ceres.plots} are now synonyms for the \code{\link{ceresPlot}} and \code{\link{ceresPlots}} functions. \code{cr.plot} and \code{cr.plots} are now synonyms for the \code{\link{crPlot}} and \code{\link{crPlots}} functions. \code{data.ellipse} is now a synonym for \code{\link{dataEllipse}}. \code{durbin.watson} is now a synonym for \code{\link{durbinWatsonTest}}. \code{levene.test} is now a synonym for \code{\link{leveneTest}} function. \code{leverage.plot} and \code{leverage.plots} are now synonyms for the \code{\link{leveragePlot}} and \code{\link{leveragePlots}} functions. \code{linear.hypothesis} is now a synonym for the \code{\link{linearHypothesis}} function. \code{ncv.test} is now a synonym for \code{\link{ncvTest}}. \code{outlier.test} is now a synonym for \code{\link{outlierTest}}. \code{qq.plot} is now a synonym for \code{\link{qqPlot}}. \code{scatterplot.matrix} is now a synonym for \code{\link{scatterplotMatrix}}. \code{spread.level.plot} is now a synonym for \code{\link{spreadLevelPlot}}. }car/man/Ginzberg.Rd0000644000175100001440000000222111401002012013620 0ustar hornikusers\name{Ginzberg} \alias{Ginzberg} \docType{data} \title{Data on Depression} \description{ The \code{Ginzberg} data frame has 82 rows and 6 columns. The data are for psychiatric patients hospitalized for depression. } \format{ This data frame contains the following columns: \describe{ \item{simplicity}{ Measures subject's need to see the world in black and white. } \item{fatalism}{ Fatalism scale. } \item{depression}{ Beck self-report depression scale. } \item{adjsimp}{ Adjusted Simplicity: Simplicity adjusted (by regression) for other variables thought to influence depression. } \item{adjfatal}{ Adjusted Fatalism. } \item{adjdep}{ Adjusted Depression. } } } \source{ Personal communication from Georges Monette, Department of Mathematics and Statistics, York University, with the permission of the original investigator. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. } \usage{ Ginzberg } \keyword{datasets} car/man/Baumann.Rd0000644000175100001440000000235711401002012013444 0ustar hornikusers\name{Baumann} \alias{Baumann} \docType{data} \title{Methods of Teaching Reading Comprehension} \description{ The \code{Baumann} data frame has 66 rows and 6 columns. The data are from an experimental study conducted by Baumann and Jones, as reported by Moore and McCabe (1993) Students were randomly assigned to one of three experimental groups. } \format{ This data frame contains the following columns: \describe{ \item{group}{ Experimental group; a factor with levels: \code{Basal}, traditional method of teaching; \code{DRTA}, an innovative method; \code{Strat}, another innovative method. } \item{pretest.1}{ First pretest. } \item{pretest.2}{ Second pretest. } \item{post.test.1}{ First post-test. } \item{post.test.2}{ Second post-test. } \item{post.test.3}{ Third post-test. } } } \source{ Moore, D. S. and McCabe, G. P. (1993) \emph{Introduction to the Practice of Statistics, Second Edition.} Freeman, p. 794--795. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \usage{ Baumann } \keyword{datasets} car/man/bootCase.Rd0000644000175100001440000000701212166631153013642 0ustar hornikusers\name{bootCase} \alias{bootCase} \alias{bootCase.lm} \alias{bootCase.glm} \alias{bootCase.nls} \alias{nextBoot} \alias{nextBoot.lm} \alias{nextBoot.nls} \title{ Case bootstrap for regression models } \description{ This routine does a case bootstrap resampling for regression models. It returns a matrix of the estimated coefficients from each of the bootstrap samples. } \usage{ \S3method{bootCase}{lm}(object, f.=coef, B=999) \S3method{bootCase}{glm}(object, f.=coef, B=999) \S3method{bootCase}{nls}(object, f.=coef, B=999) nextBoot(object, sample) } \arguments{ \item{object}{ A regression object of type \code{lm}, \code{glm} or class \code{nls}. May work with other regression objects that support the \code{update} method and has a \code{subset} argument. See details below.} \item{f.}{A function that will be applied to the updated regression object to compute the statistics of interest. The default is \code{coef}, to return to regression coefficient estimates.} \item{B}{Number of bootstrap samples.} \item{sample}{A sample with replacement of the integers from 1 to n=non-missing sample size that defines a bootstrap sample.} } \details{ This routine does the case-bootstrap described in the references below. Begin with a regression object. For each of B bootstrap samples, sample the non-missing rows of the data matrix with replacement, and recompute and save estimates. For nls objects there may be convergence problems in the bootstrap. The routine will continue until convergence is attained B times, or until there are 25 consecutive failures to converge. \code{nextBoot} is an internal function that will update a model correctly, depending on the class of the model object. This simple routine should return a result with any S3 regression object that can be updated using the \code{update} function and has a \code{subset} argument. It is OK in general for linear regression, logistic regression in which the response is either zero or one. With bionomial responses, one would generally want to resample one observation, not all the observations in m trials, so this function will incorrect results. The function can be used with Poisson regression with Poisson sampling, but it is probably wrong for contingency tables with multinomial sampling. It is OK proportional odds models without Frequencies set, but inappropriate with Frequencies. } \value{ A matrix (with class \code{c("bootCase", "matrix")}) with B rows and rank(object) columns giving the bootstrap estimates. These can be summarized as needed using standard R tools. The returned object has an attribute \code{"pointEstimate"} that contains the value of the function \code{f} applied to the argument \code{object}. } \references{ Fox, J. and Weisberg, S. (2011) \emph{Companion to Applied Regression}, Second Edition. Thousand Oaks: Sage. S. Weisberg (2005) \emph{Applied Linear Regression}, Third Edition. Wiley, Chapters 4 and 11.} \author{ Sanford Weisberg, \email{sandy@umn.edu}. The error checking was written by Lexin Li.} \seealso{See Also \code{\link{update}}} \examples{ m1 <- lm(Fertility ~ ., swiss) betahat <- coef(m1) betahat.boot <- bootCase(m1, B=99) # 99 bootstrap samples--too small to be useful summary(betahat.boot) # default summary cbind("Bootstrap SD"=apply(betahat.boot, 2, sd), t(apply(betahat.boot, 2, function(x) quantile(x, c(.025, .975))))) } \keyword{regression}% at least one, from doc/KEYWORDS \keyword{internal}% __ONLY ONE__ keyword per line car/man/powerTransform.Rd0000644000175100001440000001665412166631153015147 0ustar hornikusers\name{powerTransform} \alias{powerTransform} \alias{powerTransform.default} \alias{powerTransform.lm} \alias{powerTransform.formula} \title{Finding Univariate or Multivariate Power Transformations} \description{ \code{powerTransform} computes members of families of transformations indexed by one parameter, the Box-Cox power family, or the Yeo and Johnson (2000) family, or the basic power family, interpreting zero power as logarithmic. The family can be modified to have Jacobian one, or not, except for the basic power family. } \usage{ powerTransform(object,...) \S3method{powerTransform}{default}(object,...) \S3method{powerTransform}{lm}(object, ...) \S3method{powerTransform}{formula}(object, data, subset, weights, na.action, ...) } \arguments{ \item{object}{This can either be an object of class \code{lm}, a formula, or a matrix or vector; see below.} \item{data}{A data frame or environment, as in \code{\link{lm}}.} \item{subset}{Case indices to be used, as in \code{\link{lm}}.} \item{weights}{Weights as in \code{\link{lm}}.} \item{na.action}{Missing value action, as in \sQuote{lm}.} \item{...}{Additional arguments that are passed to \code{\link{estimateTransform}}, which does the actual computing, or the \code{\link{optim}} function, which does the maximization. See the documentation for these functions for the arguments that are permitted, including \code{family} for setting the power transformation family.} } \details{The function powerTransform is used to estimate normalizing transformations of a univariate or a multivariate random variable. For a univariate transformation, a formula like \code{z~x1+x2+x3} will find estimate a transformation for the response \code{z} from the family of transformations indexed by the parameter \code{lambda} that makes the residuals from the regression of the transformed \code{z} on the predictors as closed to normally distributed as possible. This generalizes the Box and Cox (1964) transformations to normality only by allowing for families other than the power transformations used in that paper. For a formula like \code{cbind(y1,y2,y3)~x1+x2+x3}, the three variables on the left-side are all transformed, generally with different transformations to make all the residuals as close to normally distributed as possible. \code{cbind(y1,y2,y3)~1} would specify transformations to multivariate normality with no predictors. This generalizes the multivariate power transformations suggested by Velilla (1993) by allowing for different families of transformations, and by allowing for predictors. Cook and Weisberg (1999) and Weisberg (2005) suggest the usefulness of transforming a set of predictors \code{z1, z2, z3} for multivariate normality and for transforming for multivariate normality conditional on levels of a factor, which is equivalent to setting the predictors to be indicator variables for that factor. Specifying the first argument as a vector, for example \code{powerTransform(ais$LBM)}, is equivalent to \code{powerTransform(LBM ~ 1, ais)}. Similarly, \code{powerTransform( cbind(ais$LBM, ais$SSF))}, where the first argument is a matrix rather than a formula is equivalent to \code{powerTransform(cbind(LBM, SSF) ~ 1, ais)}. Two families of power transformations are available. The bcPower family of \emph{scaled power transformations}, \code{family="bctrans"}, equals \eqn{(U^{\lambda}-1)/\lambda}{(U^(lambda)-1)/lambda} for \eqn{\lambda}{lambda} \eqn{\neq}{not equal to} 0, and \eqn{\log(U)}{log(U)} if \eqn{\lambda =0}{lambda = 0}. If \code{family="yjPower"} then the Yeo-Johnson transformations are used. This is is Box-Cox transformation of \eqn{U+1} for nonnegative values, and of \eqn{|U|+1} with parameter \eqn{2-\lambda}{2-lambda} for \eqn{U} negative. Other families can be added by writing a function whose first argument is a matrix or vector to be transformed, and whose second argument is the value of the transformation parameter. The function must return modified transformations so that the Jacobian of the transformation is equal to one; see Cook and Weisberg (1982). The function \code{powerTransform} is a front-end for \code{\link{estimateTransform}}. The function \code{\link{testTransform}} is used to obtain likelihood ratio tests for any specified value for the transformation parameters. It is used by the summary method for powerTransform objects. } \value{ The result of \code{powerTransform} is an object of class \code{powerTransform} that gives the estimates of the the transformation parameters and related statistics. The \code{print} method for the object will display the estimates only; the \code{summary} method provides both the estimates, standard errors, marginal Wald confidence intervals and relevant likelihood ratio tests. Several helper functions are available. The \code{coef} method returns the estimated transformation parameters, while \code{coef(object,round=TRUE)} will return the transformations rounded to nearby convenient values within 1.96 standard errors of the mle. The \code{vcov} function returns the estimated covariance matrix of the estimated transformation parameters. A \code{print} method is used to print the objects and \code{summary} to provide more information. By default the summary method calls \code{testTransform} and provides likelihood ratio type tests that all transformation parameters equal one and that all transformation parameters equal zero, for log transformations, and for a convenient rounded value not far from the mle. The function can be called directly to test any other value for \eqn{\lambda}{lambda}. } \references{Box, G. E. P. and Cox, D. R. (1964) An analysis of transformations. \emph{Journal of the Royal Statisistical Society, Series B}. 26 211-46. Cook, R. D. and Weisberg, S. (1999) \emph{Applied Regression Including Computing and Graphics}. Wiley. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Velilla, S. (1993) A note on the multivariate Box-Cox transformation to normality. \emph{Statistics and Probability Letters}, 17, 259-263. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition. Wiley. Yeo, I. and Johnson, R. (2000) A new family of power transformations to improve normality or symmetry. \emph{Biometrika}, 87, 954-959. } \author{ Sanford Weisberg, } \seealso{\code{\link{estimateTransform}}, \code{\link{testTransform}}, \code{\link{optim}}, \code{\link{bcPower}}, \code{\link{transform}}. } \examples{ # Box Cox Method, univariate summary(p1 <- powerTransform(cycles ~ len + amp + load, Wool)) # fit linear model with transformed response: coef(p1, round=TRUE) summary(m1 <- lm(bcPower(cycles, p1$roundlam) ~ len + amp + load, Wool)) # Multivariate Box Cox summary(powerTransform(cbind(len, ADT, trks, sigs1) ~ 1, Highway1)) # Multivariate transformation to normality within levels of 'hwy' summary(a3 <- powerTransform(cbind(len, ADT, trks, sigs1) ~ hwy, Highway1)) # test lambda = (0 0 0 -1) testTransform(a3, c(0, 0, 0, -1)) # save the rounded transformed values, plot them with a separate # color for each highway type transformedY <- bcPower(with(Highway1, cbind(len, ADT, trks, sigs1)), coef(a3, round=TRUE)) \dontrun{pairs(transformedY, col=as.numeric(Highway1$hwy)) } } \keyword{ regression}% at least one, from doc/KEYWORDS car/man/showLabels.Rd0000644000175100001440000001060012105010710014162 0ustar hornikusers\name{showLabels} \Rdversion{1.1} \alias{showLabels} \title{ Utility Functions to Identify and Mark Extreme Points in a 2D Plot. } \description{ This function is called by several graphical functions in the \code{car} package to mark extreme points in a 2D plot. Although the user is unlikely to call this function directly, the documentation below applies to all these other functions. } \usage{ showLabels(x, y, labels=NULL, id.method="identify", id.n = length(x), id.cex=1, id.col=palette()[1], ...) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{x}{ Plotted horizontal coordinates. } \item{y}{ Plotted vertical coordinates. } \item{labels}{ Plotting labels. If \code{NULL}, case numbers will be used. If labels are long, the \code{\link{substr}} or \code{\link{abbreviate}} function can be used to shorten them. } \item{id.method}{ How points are to be identified. See Details below. } \item{id.n}{ Number of points to be identified. If set to zero, no points are identified. } \item{id.cex}{ Controls the size of the plotted labels. The default is \code{1}. } \item{id.col}{ Controls the color of the plotted labels. } \item{...}{additional arguments passed to \code{identify} or to \code{text}.} } \details{ The argument \code{id.method} determine how the points to be identified are selected. For the default value of \code{id.method="identify"}, the \code{\link{identify}} function is used to identify points interactively using the mouse. Up to \code{id.n} points can be identified, so if \code{id.n=0}, which is the default in many functions in the \code{car} package, then no point identification is done. Automatic point identification can be done depending on the value of the argument \code{id.method}. \itemize{ \item \code{id.method = "x"} select points according to their value of \code{abs(x - mean(x))} \item \code{id.method = "y"} select points according to their value of \code{abs(y - mean(y))} \item \code{id.method = "mahal"} Treat \code{(x, y)} as if it were a bivariate sample, and select cases according to their Mahalanobis distance from \code{(mean(x), mean(y))} \item \code{id.method} can be a vector of the same length as \code{x} consisting of values to determine the points to be labeled. For example, for a linear model \code{m}, setting \code{id.method=cooks.distance(m), id.n=4} will label the points corresponding to the four largest values of Cook's distance, or \code{id.method = abs(residuals(m, type="pearson")), id.n=2} would label the two observations corresponding to the largest absolute Pearson residuals. Warning: If missing data are present, points may be incorrectly labelled. \item \code{id.method} can be a vector of case numbers or case-labels, in which case those cases will be labeled. Warning: If missing data are present, a list of case numbers may identify the wrong points. A list of case labels, however, will work correctly with missing values. } With \code{showLabels}, the \code{id.method} argument can be a list, so, for example \code{id.method=list("x", "y")} would label according to the horizontal and vertical axes variables. Finally, if the axes in the graph are logged, the function uses logged-variables where appropriate. } \value{ A utility function primarily used for its side-effect of drawing labels on a plot. Returns invisibly the labels of the selected points, or NULL if no points are selected. Although intended for use with other functions in the car package, this function can be used directly. } \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition, Wiley. } \author{John Fox \email{jfox@mcmaster.ca}, Sanford Weisberg \email{sandy@umn.edu}} \seealso{\code{\link{avPlots}}, \code{\link{residualPlots}}, \code{\link{crPlots}}, \code{\link{leveragePlots}} } \examples{ plot(income ~ education, Prestige) with(Prestige, showLabels(education, income, labels = rownames(Prestige), id.method=list("x", "y"), id.n=3)) m <- lm(income ~ education, Prestige) plot(income ~ education, Prestige) abline(m) with(Prestige, showLabels(education, income, labels=rownames(Prestige), id.method=abs(residuals(m)), id.n=4)) } \keyword{ utilities } car/man/Quartet.Rd0000644000175100001440000000142311253536255013533 0ustar hornikusers\name{Quartet} \alias{Quartet} \docType{data} \title{Four Regression Datasets} \description{ The \code{Quartet} data frame has 11 rows and 5 columns. These are contrived data. } \format{ This data frame contains the following columns: \describe{ \item{x}{ X-values for datasets 1--3. } \item{y1}{ Y-values for dataset 1. } \item{y2}{ Y-values for dataset 2. } \item{y3}{ Y-values for dataset 3. } \item{x4}{ X-values for dataset 4. } \item{y4}{ Y-values for dataset 4. } } } \source{ Anscombe, F. J. (1973) Graphs in statistical analysis. \emph{American Statistician} \bold{27}, 17--21. } \usage{ Quartet } \keyword{datasets} car/man/Duncan.Rd0000644000175100001440000000252311401002012013266 0ustar hornikusers\name{Duncan} \alias{Duncan} \docType{data} \title{Duncan's Occupational Prestige Data} \description{ The \code{Duncan} data frame has 45 rows and 4 columns. Data on the prestige and other characteristics of 45 U. S. occupations in 1950. } \format{ This data frame contains the following columns: \describe{ \item{type}{ Type of occupation. A factor with the following levels: \code{prof}, professional and managerial; \code{wc}, white-collar; \code{bc}, blue-collar. } \item{income}{ Percent of males in occupation earning $3500 or more in 1950. } \item{education}{ Percent of males in occupation in 1950 who were high-school graduates. } \item{prestige}{ Percent of raters in NORC study rating occupation as excellent or good in prestige. } } } \source{ Duncan, O. D. (1961) A socioeconomic index for all occupations. In Reiss, A. J., Jr. (Ed.) \emph{Occupations and Social Status.} Free Press [Table VI-1]. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \usage{ Duncan } \keyword{datasets} car/man/USPop.Rd0000644000175100001440000000133111401006152013071 0ustar hornikusers\name{USPop} \alias{USPop} \docType{data} \title{Population of the United States} \description{ The \code{USPop} data frame has 22 rows and 1 columns. This is a decennial time-series, from 1790 to 2000. } \format{ This data frame contains the following columns: \describe{ \item{year}{ census year. } \item{population}{ Population in millions. } } } \source{ U.S.~Census Bureau: \url{http://www.census-charts.com/Population/pop-us-1790-2000.html}, downloaded 1 May 2008. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. } \usage{ USPop } \keyword{datasets} car/man/estimateTransform.Rd0000644000175100001440000000744012166631153015617 0ustar hornikusers\name{estimateTransform} \alias{estimateTransform} \title{Finding Univariate or Multivariate Power Transformations} \description{ \code{estimateTransform} computes members of families of transformations indexed by one parameter, the Box-Cox power family, or the Yeo and Johnson (2000) family, or the basic power family, interpreting zero power as logarithmic. The family can be modified to have Jacobian one, or not, except for the basic power family. Most users will use the function \code{\link{powerTransform}}, which is a front-end for this function. } \usage{ estimateTransform(X, Y, weights=NULL, family="bcPower", start=NULL, method="L-BFGS-B", ...) } \arguments{ \item{X}{A matrix or data.frame giving the \dQuote{right-side variables}.} \item{Y}{A vector or matrix or data.frame giving the \dQuote{left-side variables.}} \item{weights}{Weights as in \code{lm}.} \item{family}{The transformation family to use. This is the quoted name of a function for computing the transformed values. The default is \code{bcPower} for the Box-Cox power family and the most likely alternative is \code{yjPower} for the Yeo-Johnson family of transformations.} \item{start}{Starting values for the computations. It is usually adequate to leave this at its default value of NULL.} \item{method}{The computing alogrithm used by \code{\link{optim}} for the maximization. The default \code{"L-BFGS-B"} appears to work well.} \item{...}{Additional arguments that are passed to the \code{\link{optim}} function that does the maximization. Needed only if there are convergence problems.} } \details{See the documentation for the function \code{\link{powerTransform}}.} \value{An object of class \code{powerTransform} with components \item{value}{The value of the loglikelihood at the mle.} \item{counts}{See \code{\link{optim}}.} \item{convergence}{See \code{\link{optim}}.} \item{message}{See \code{\link{optim}}.} \item{hessian}{The hessian matrix.} \item{start}{Starting values for the computations.} \item{lambda}{The ml estimate} \item{roundlam}{Convenient rounded values for the estimates. These rounded values will often be the desirable transformations.} \item{family}{The transformation family} \item{xqr}{QR decomposition of the predictor matrix.} \item{y}{The responses to be transformed} \item{x}{The predictors} \item{weights}{The weights if weighted least squares.} } \references{Box, G. E. P. and Cox, D. R. (1964) An analysis of transformations. \emph{Journal of the Royal Statisistical Society, Series B}. 26 211-46. Cook, R. D. and Weisberg, S. (1999) \emph{Applied Regression Including Computing and Graphics}. Wiley. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Velilla, S. (1993) A note on the multivariate Box-Cox transformation to normality. \emph{Statistics and Probability Letters}, 17, 259-263. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition. Wiley. Yeo, I. and Johnson, R. (2000) A new family of power transformations to improve normality or symmetry. \emph{Biometrika}, 87, 954-959. } \author{ Sanford Weisberg, } \seealso{\code{\link{powerTransform}}, \code{\link{testTransform}}, \code{\link{optim}}. } \examples{ data(trees,package="MASS") summary(out1 <- powerTransform(Volume~log(Height)+log(Girth),trees)) # multivariate transformation: summary(out2 <- powerTransform(cbind(Volume,Height,Girth)~1,trees)) testTransform(out2,c(0,1,0)) # same transformations, but use lm objects m1 <- lm(Volume~log(Height)+log(Girth),trees) (out3 <- powerTransform(m1)) # update the lm model with the transformed response update(m1,basicPower(out3$y,out3$roundlam)~.) } \keyword{ regression}% at least one, from doc/KEYWORDS car/man/ncvTest.Rd0000644000175100001440000000422011773371015013530 0ustar hornikusers\name{ncvTest} \alias{ncvTest} \alias{ncvTest.lm} \alias{ncvTest.glm} \title{Score Test for Non-Constant Error Variance} \description{ Computes a score test of the hypothesis of constant error variance against the alternative that the error variance changes with the level of the response (fitted values), or with a linear combination of predictors. } \usage{ ncvTest(model, ...) \method{ncvTest}{lm}(model, var.formula, ...) \method{ncvTest}{glm}(model, ...) # to report an error } \arguments{ \item{model}{a weighted or unweighted linear model, produced by \code{lm}.} \item{var.formula}{a one-sided formula for the error variance; if omitted, the error variance depends on the fitted values.} \item{\dots}{arguments passed down to methods functions; not currently used.} } \details{ This test is often called the Breusch-Pagan test; it was independently suggested with some extension by Cook and Weisberg (1983). \code{ncvTest.glm} is a dummy function to generate an error when a \code{glm} model is used. } \value{ The function returns a \code{chisqTest} object, which is usually just printed. } \references{ Breusch, T. S. and Pagan, A. R. (1979) A simple test for heteroscedasticity and random coefficient variation. \emph{Econometrica} \bold{47}, 1287--1294. Cook, R. D. and Weisberg, S. (1983) Diagnostics for heteroscedasticity in regression. \emph{Biometrika} \bold{70}, 1--10. Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition, Wiley. } \author{John Fox \email{jfox@mcmaster.ca}, Sandy Weisberg \email{sandy@umn.edu}} \seealso{\code{\link{hccm}}, \code{\link[car]{spreadLevelPlot}} } \examples{ ncvTest(lm(interlocks ~ assets + sector + nation, data=Ornstein)) ncvTest(lm(interlocks ~ assets + sector + nation, data=Ornstein), ~ assets + sector + nation, data=Ornstein) } \keyword{htest} \keyword{regression} car/man/SLID.Rd0000644000175100001440000000221711401002012012611 0ustar hornikusers\name{SLID} \alias{SLID} \docType{data} \title{Survey of Labour and Income Dynamics} \description{ The \code{SLID} data frame has 7425 rows and 5 columns. The data are from the 1994 wave of the Canadian Survey of Labour and Income Dynamics, for the province of Ontario. There are missing data, particularly for wages. } \format{ This data frame contains the following columns: \describe{ \item{wages}{ Composite hourly wage rate from all jobs. } \item{education}{ Number of years of schooling. } \item{age}{ in years. } \item{sex}{ A factor with levels: \code{Female}, \code{Male}. } \item{language}{ A factor with levels: \code{English}, \code{French}, \code{Other}. } } } \source{ The data are taken from the public-use dataset made available by Statistics Canada, and prepared by the Institute for Social Research, York University. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \usage{ SLID } \keyword{datasets} car/man/scatterplotMatrix.Rd0000644000175100001440000001651112206732123015632 0ustar hornikusers\name{scatterplotMatrix} \alias{scatterplotMatrix} \alias{scatterplotMatrix.formula} \alias{scatterplotMatrix.default} \alias{spm} \title{Scatterplot Matrices} \description{ Enhanced scatterplot matrices with univariate displays down the diagonal; \code{spm} is an abbreviation for \code{scatterplotMatrix}. This function just sets up a call to \code{pairs} with custom panel functions. } \usage{ scatterplotMatrix(x, ...) \method{scatterplotMatrix}{formula}(formula, data=NULL, subset, labels, ...) \method{scatterplotMatrix}{default}(x, var.labels=colnames(x), diagonal=c("density", "boxplot", "histogram", "oned", "qqplot", "none"), adjust=1, nclass, plot.points=TRUE, smoother=loessLine, smoother.args=list(), smooth, span, spread = !by.groups, reg.line=lm, transform=FALSE, family=c("bcPower", "yjPower"), ellipse=FALSE, levels=c(.5, .95), robust=TRUE, groups=NULL, by.groups=FALSE, use=c("complete.obs", "pairwise.complete.obs"), labels, id.method="mahal", id.n=0, id.cex=1, id.col=palette()[1], col=if (n.groups == 1) palette()[3:1] else rep(palette(), length=n.groups), pch=1:n.groups, lwd=1, lty=1, cex=par("cex"), cex.axis=par("cex.axis"), cex.labels=NULL, cex.main=par("cex.main"), legend.plot=length(levels(groups)) > 1, row1attop=TRUE, ...) spm(x, ...) } \arguments{ \item{x}{a data matrix, numeric data frame.} \item{formula}{a one-sided \dQuote{model} formula, of the form \code{ ~ x1 + x2 + ... + xk} or \code{ ~ x1 + x2 + ... + xk | z} where \code{z} evaluates to a factor or other variable to divide the data into groups.} \item{data}{for \code{scatterplotMatrix.formula}, a data frame within which to evaluate the formula.} \item{subset}{expression defining a subset of observations.} \item{labels,id.method,id.n,id.cex,id.col}{Arguments for the labelling of points. The default is \code{id.n=0} for labeling no points. See \code{\link{showLabels}} for details of these arguments. If the plot uses different colors for groups, then the \code{id.col} argument is ignored and label colors are determined by the \code{col} argument. } \item{var.labels}{variable labels (for the diagonal of the plot).} \item{diagonal}{contents of the diagonal panels of the plot.} \item{adjust}{relative bandwidth for density estimate, passed to \code{density} function.} \item{nclass}{number of bins for histogram, passed to \code{hist} function.} \item{plot.points}{if \code{TRUE} the points are plotted in each off-diagonal panel.} \item{smoother}{a function to draw a nonparametric-regression smooth; the default is \code{\link{gamLine}}, which uses the \code{\link[mgcv]{gam}} function in the \pkg{mgcv} package. For this and other smoothers, see \code{\link{ScatterplotSmoothers}}. Setting this argument to something other than a function, e.g., \code{FALSE} suppresses the smoother.} \item{smoother.args}{a list of named values to be passed to the smoother function; the specified elements of the list depend upon the smoother (see \code{\link{ScatterplotSmoothers}}).} \item{smooth, span}{these arguments are included for backwards compatility: if \code{smooth=TRUE} then \code{smoother} is set to \code{loessLine}, and if \code{span} is specified, it is added to \code{smoother.args}.} \item{spread}{if TRUE, estimate the (square root) of the variance function. For \code{loessLine} and for \code{gamLine}, this is done by separately smoothing the squares of the postive and negative residuals from the mean fit, and then adding the square root of the fitted values to the mean fit. For \code{quantregLine}, fit the .25 and .75 quantiles with a quantile regression additive model. The default is TRUE if \code{by.groups=FALSE} and FALSE is \code{by.groups=TRUE}.} \item{reg.line}{if not \code{FALSE} a line is plotted using the function given by this argument; e.g., using \code{rlm} in package \code{MASS} plots a robust-regression line.} \item{transform}{if \code{TRUE}, multivariate normalizing power transformations are computed with \code{\link{powerTransform}}, rounding the estimated powers to `nice' values for plotting; if a vector of powers, one for each variable, these are applied prior to plotting. If there are \code{groups} and \code{by.groups} is \code{TRUE}, then the transformations are estimated \emph{conditional} on the \code{groups} factor.} \item{family}{family of transformations to estimate: \code{"bcPower"} for the Box-Cox family or \code{"yjPower"} for the Yeo-Johnson family (see \code{\link{powerTransform}}).} \item{ellipse}{if \code{TRUE} data-concentration ellipses are plotted in the off-diagonal panels.} \item{levels}{levels or levels at which concentration ellipses are plotted; the default is \code{c(.5, .9)}.} \item{robust}{if \code{TRUE} use the \code{cov.trob} function in the \code{MASS} package to calculate the center and covariance matrix for the data ellipses.} \item{groups}{a factor or other variable dividing the data into groups; groups are plotted with different colors and plotting characters.} \item{by.groups}{if \code{TRUE}, regression lines are fit by groups.} \item{use}{if \code{"complete.obs"} (the default), cases with missing data are omitted; if \code{"pairwise.complete.obs"), all valid cases are used in each panel of the plot.}} \item{pch}{plotting characters for points; default is the plotting characters in order (see \code{\link[graphics]{par}}).} \item{col}{colors for lines and points; the default is taken from the color palette, with \code{palette()[3]} for linear regression lines, \code{palette()[2]} for nonparametric regression lines, and \code{palette()[1]} for points if there are no groups, and successive colors for the groups if there are groups.} \item{lwd}{width of linear-regression lines (default \code{1}).} \item{lty}{type of linear-regression lines (default \code{1}, solid line).} \item{cex, cex.axis, cex.labels, cex.main}{set sizes of various graphical elements (see \code{\link[graphics]{par}}).} \item{legend.plot}{if \code{TRUE} then a legend for the groups is plotted in the first diagonal cell.} \item{row1attop}{If \code{TRUE} (the default) the first row is at the top, as in a matrix, as opposed to at the bottom, as in graph (argument suggested by Richard Heiberger).} \item{...}{arguments to pass down.} } \value{ \code{NULL}. This function is used for its side effect: producing a plot. } \author{John Fox \email{jfox@mcmaster.ca}} \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \seealso{\code{\link[graphics]{pairs}}, \code{\link{scatterplot}}, \code{\link{dataEllipse}}, \code{\link{powerTransform}}, \code{\link{bcPower}}, \code{\link{yjPower}}, \code{\link[MASS]{cov.trob}}, \code{\link{showLabels}}, \code{\link{ScatterplotSmoothers}}.} \examples{ scatterplotMatrix(~ income + education + prestige | type, data=Duncan) scatterplotMatrix(~ income + education + prestige, transform=TRUE, data=Duncan, smoother=loessLine) scatterplotMatrix(~ income + education + prestige | type, smoother=FALSE, by.group=TRUE, transform=TRUE, data=Duncan) } \keyword{hplot} car/man/Pottery.Rd0000644000175100001440000000162511401002012013526 0ustar hornikusers\name{Pottery} \alias{Pottery} \docType{data} \title{Chemical Composition of Pottery} \description{ The data give the chemical composition of ancient pottery found at four sites in Great Britain. They appear in Hand, et al. (1994), and are used to illustrate MANOVA in the SAS Manual. (Suggested by Michael Friendly.) } \usage{ Pottery } \format{ A data frame with 26 observations on the following 6 variables. \describe{ \item{\code{Site}}{a factor with levels \code{AshleyRails} \code{Caldicot} \code{IsleThorns} \code{Llanedyrn}} \item{\code{Al}}{Aluminum} \item{\code{Fe}}{Iron} \item{\code{Mg}}{Magnesium} \item{\code{Ca}}{Calcium} \item{\code{Na}}{Sodium} } } \source{ Hand, D. J., Daly, F., Lunn, A. D., McConway, K. J., and E., O. (1994) \emph{A Handbook of Small Data Sets}. Chapman and Hall. } \examples{ Pottery } \keyword{datasets} car/man/Womenlf.Rd0000644000175100001440000000260411401002012013465 0ustar hornikusers\name{Womenlf} \alias{Womenlf} \docType{data} \title{Canadian Women's Labour-Force Participation} \description{ The \code{Womenlf} data frame has 263 rows and 4 columns. The data are from a 1977 survey of the Canadian population. } \format{ This data frame contains the following columns: \describe{ \item{partic}{ Labour-Force Participation. A factor with levels (note: out of order): \code{fulltime}, Working full-time; \code{not.work}, Not working outside the home; \code{parttime}, Working part-time. } \item{hincome}{ Husband's income, $1000s. } \item{children}{ Presence of children in the household. A factor with levels: \code{absent}, \code{present}. } \item{region}{ A factor with levels: \code{Atlantic}, Atlantic Canada; \code{BC}, British Columbia; \code{Ontario}; \code{Prairie}, Prairie provinces; \code{Quebec}. } } } \source{ \emph{Social Change in Canada Project.} York Institute for Social Research. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \usage{ Womenlf } \keyword{datasets} car/man/Boot.Rd0000644000175100001440000001264012161374714013013 0ustar hornikusers\name{Boot} \alias{Boot} \alias{Boot.default} \alias{Boot.lm} \alias{Boot.glm} \alias{Boot.nls} \title{Bootstrapping for regression models } \description{ This function provides a simple front-end to the \code{boot} function in the package also called \code{boot}. Whereas \code{boot} is very general and therefore has many arguments, the \code{Boot} function has very few arguments, but should meet the needs of many users. } \usage{ \S3method{Boot}{default}(object, f=coef, labels=names(coef(object)), R=999, method=c("case", "residual")) \S3method{Boot}{lm}(object, f=coef, labels=names(coef(object)), R=999, method=c("case", "residual")) \S3method{Boot}{glm}(object, f=coef, labels=names(coef(object)), R=999, method=c("case", "residual")) \S3method{Boot}{nls}(object, f=coef, labels=names(coef(object)), R=999, method=c("case", "residual")) } \arguments{ \item{object}{ A regression object of class \code{lm}, \code{glm} or \code{nls}. The function may work with other regression objects that support the \code{update} method and have a \code{subset} argument} \item{f}{A function whose one argument is the name of a regression object that will be applied to the updated regression object to compute the statistics of interest. The default is \code{coef}, to return to regression coefficient estimates. For example, \code{f = function(obj) coef(obj)[1]/coef(obj[2]} will bootstrap the ratio of the first and second coefficient estimates.} \item{labels}{Provides labels for the statistics computed by \code{f}. If this argument is of the wrong length, then generic labels will be generated. } \item{R}{Number of bootstrap samples. The number of bootstrap samples actually computed may be smaller than this value if either the fitting method is iterative, or if the rank of a fittle \code{lm} or \code{glm} model is different in the bootstrap replication than in the original data.} \item{method}{The bootstrap method, either \dQuote{case} for resampling cases or \dQuote{residuals} for a residual bootstrap. See the details below. The residual bootstrap is available only for \code{lm} and \code{nls} objects and will return an error for \code{glm} objects.} } \details{ Whereas the \code{boot} function is very general, \code{Boot} is very specific. It takes the information from a regression object and the choice of \code{method}, and creates a function that is passed as the \code{statistic} argument to \code{boot}. The argument \code{R} is also passed to \code{boot}. All other arguments to \code{boot} are kept at their default values. The methods available for \code{lm} and \code{nls} objects are \dQuote{case} and \dQuote{residual}. The case bootstrap resamples from the joint distribution of the terms in the model and the response. The residual bootstrap fixes the fitted values from the original data, and creates bootstraps by adding a bootstrap sample of the residuals to the fitted values to get a bootstrap response. It is an implementation of Algorithm 6.3, page 271, of Davison and Hinkley (1997). For \code{nls} objects ordinary residuals are used in the resampling rather than the standardized residuals used in the \code{lm} method. The residual bootstrap for generalized linear models has several competing approaches, but none are without problems. If you want to do a residual bootstrap for a glm, you will need to write your own call to \code{boot}. An attempt to model fit to a bootstrap sample may fail. In a \code{lm} or \code{glm} fit, the bootstrap sample could have a different rank from the original fit. In an \code{nls} fit, convergence may not be obtained for some bootstraps. In either case, \code{NA} are returned for the value of the function \code{f}. The summary methods handle the \code{NA}s appropriately. } \value{ See \code{\link[boot]{boot}} for the returned value from this function. The car package includes additional generic functions summary, confint and hist that works with boot objects. } \references{ Davison, A, and Hinkley, D. (1997) \emph{Bootstrap Methods and their Applications}. Oxford: Oxford University Press. Fox, J. and Weisberg, S. (2011) \emph{Companion to Applied Regression}, Second Edition. Thousand Oaks: Sage. Fox, J. and Weisberg, S. (2012) \emph{Bootstrapping}, \url{http://socserv.mcmaster.ca/jfox/Books/Companion/appendix/Appendix-Bootstrapping.pdf}. S. Weisberg (2005) \emph{Applied Linear Regression}, Third Edition. Wiley, Chapters 4 and 11.} \author{ Sanford Weisberg, \email{sandy@umn.edu}.} \seealso{Functions that work with \code{Boot} objects from the \code{boot} package are \code{\link[boot]{boot.array}}, \code{\link[boot]{boot.ci}}, \code{\link[boot]{plot.boot}} and \code{\link[boot]{empinf}}. Additional functions in the \code{car} package are \code{\link{summary.boot}}, \code{\link{confint.boot}}, and \code{\link{hist.boot}}. } \examples{ m1 <- lm(Fertility ~ ., swiss) betahat.boot <- Boot(m1, R=199) # 199 bootstrap samples--too small to be useful summary(betahat.boot) # default summary confint(betahat.boot) hist(betahat.boot) # Bootstrap for the estimated residual standard deviation: sigmahat.boot <- Boot(m1, R=199, f=sigmaHat, labels="sigmaHat") summary(sigmahat.boot) confint(sigmahat.boot) } \keyword{regression}% at least one, from doc/KEYWORDS car/man/Angell.Rd0000644000175100001440000000221711401002012013260 0ustar hornikusers\name{Angell} \alias{Angell} \docType{data} \title{Moral Integration of American Cities} \description{ The \code{Angell} data frame has 43 rows and 4 columns. The observations are 43 U. S. cities around 1950. } \format{ This data frame contains the following columns: \describe{ \item{moral}{ Moral Integration: Composite of crime rate and welfare expenditures. } \item{hetero}{ Ethnic Heterogenity: From percentages of nonwhite and foreign-born white residents. } \item{mobility}{ Geographic Mobility: From percentages of residents moving into and out of the city. } \item{region}{ A factor with levels: \code{E} Northeast; \code{MW} Midwest; \code{S} Southeast; \code{W} West. } } } \source{ Angell, R. C. (1951) The moral integration of American Cities. \emph{American Journal of Sociology} \bold{57} (part 2), 1--140. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. } \usage{ Angell } \keyword{datasets} car/man/Depredations.Rd0000644000175100001440000000174311621026615014525 0ustar hornikusers\name{Depredations} \alias{Depredations} \docType{data} \title{ Minnesota Wolf Depredation Data } \description{ Wolf depredations of livestock on Minnesota farms, 1976-1998. } \usage{Depredations} \format{ A data frame with 434 observations on the following 5 variables. \describe{ \item{\code{longitude}}{longitude of the farm} \item{\code{latitude}}{latitude of the farm} \item{\code{number}}{number of depredations 1976-1998} \item{\code{early}}{number of depredations 1991 or before} \item{\code{late}}{number of depredations 1992 or later} } } \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Harper, Elizabeth K. and Paul, William J. and Mech, L. David and Weisberg, Sanford (2008), Effectiveness of Lethal, Directed Wolf-Depredation Control in Minnesota, \emph{Journal of Wildlife Management}, 72, 3, 778-784. \url{http://pinnacle.allenpress.com/doi/abs/10.2193/2007-273} } \keyword{datasets} car/man/densityPlot.Rd0000644000175100001440000000744312153775407014440 0ustar hornikusers\name{densityPlot} \alias{densityPlot} \alias{densityPlot.default} \alias{densityPlot.formula} \title{ Nonparametric Density Estimates } \description{ \code{densityPlot} contructs and graphs nonparametric density estimates, possibly conditioned on a factor. It is a wrapper for the standard \R{} \code{\link{density}} function. } \usage{ densityPlot(x, ...) \method{densityPlot}{default}(x, g, bw = "SJ", adjust=1, kernel = c("gaussian", "epanechnikov", "rectangular", "triangular", "biweight", "cosine", "optcosine"), xlab = deparse(substitute(x)), ylab = "Density", col = palette(), lty = seq_along(col), lwd = 2, grid=TRUE, legend.location = "topright", legend.title = deparse(substitute(g)), show.bw = FALSE, rug = TRUE, ...) \method{densityPlot}{formula}(formula, data = NULL, subset, na.action = NULL, xlab, ylab, ...) } \arguments{ \item{x}{a numeric variable, the density of which is estimated.} \item{g}{an optional factor to divide the data.} \item{formula}{an \R{} model formula, of the form \code{~ variable} to estimate the unconditional density of \code{variable}, or \code{variable ~ factor} to estimate the density of \code{variable} within each level of \code{factor}.} \item{data}{an optional data frame containing the data.} \item{subset}{an optional vector defining a subset of the data.} \item{na.action}{a function to handle missing values; defaults to the value of the \R{} \code{na.action} option, initially set to \code{\link{na.omit}}.} \item{bw}{the bandwidth for the density estimate(s); either the quoted name of a rule to compute the bandwidth, or a numeric value; the default is \code{"SJ"}; if plotting by groups, \code{bw} may be a vector of values or rules, one for each group. See \code{\link{density}} and \code{\link{bw.SJ}} for details.} \item{adjust}{a multiplicative adjustment factor for the bandwidth; the default, \code{1}, indicates no adjustment; if plotting by groups, \code{adjust} may be a vector of adjustment factors, one for each group.} \item{kernel}{kernel function; the default is "gaussian" (see \code{\link{density}}).} \item{xlab}{label for the horizontal-axis; defaults to the name of the variable \code{x}.} \item{ylab}{label for the vertical axis; defaults to \code{"Density"}.} \item{col}{vector of colors for the density estimate(s); defaults to the color \code{\link{palette}}.} \item{lty}{vector of line types for the density estimate(s); defaults to the successive integers, starting at 1.} \item{lwd}{line width for the density estimate(s); defaults to 2.} \item{grid}{if \code{TRUE} (the default), grid lines are drawn on the plot.} \item{legend.location}{location for the legend when densities are plotted for several groups; defaults to \code{"upperright"}; see \code{\link{legend}}.} \item{legend.title}{label for the legend, which is drawn if densities are plotted by groups; the default is the name of the factor {g}.} \item{show.bw}{if \code{TRUE}, show the bandwidth(s) in the horizontal-axis label or (for multiple groups) the legend; the default is \code{FALSE}.} \item{rug}{if \code{TRUE} (the default), draw a rug plot (one-dimentional scatterplot) at the bottom of the density estimate.} \item{\dots}{arguments to be passed to \code{\link{plot}}.} } \value{ These functions return \code{NULL} invisibly and draw graphs. } \references{ W. N. Venables and B. D. Ripley (2002) \emph{Modern Applied Statistics with S}. New York: Springer.} \author{ John Fox \email{jfox@mcmaster.ca} } \seealso{ \code{\link{density}}, \code{\link{bw.SJ}}, \code{link{plot.density}} } \examples{ densityPlot(~ income, show.bw=TRUE, data=Prestige) densityPlot(income ~ type, data=Prestige) } \keyword{hplot} car/man/bcPower.Rd0000644000175100001440000000502512166631153013506 0ustar hornikusers\name{bcPower} \alias{bcPower} \alias{yjPower} \alias{basicPower} \title{Box-Cox and Yeo-Johnson Power Transformations} \description{ Transform the elements of a vector using, the Box-Cox, Yeo-Johnson, or simple power transformations. } \usage{ bcPower(U, lambda, jacobian.adjusted = FALSE) yjPower(U, lambda, jacobian.adjusted = FALSE) basicPower(U,lambda) } \arguments{ \item{U}{A vector, matrix or data.frame of values to be transformed} \item{lambda}{The one-dimensional transformation parameter, usually in the range from \eqn{-2} to \eqn{2}, or if \code{U} is a matrix or data frame, a vector of length \code{ncol(U)} of transformation parameters} \item{jacobian.adjusted}{If \code{TRUE}, the transformation is normalized to have Jacobian equal to one. The default is \code{FALSE}.} } \details{ The Box-Cox family of \emph{scaled power transformations} equals \eqn{(U^{\lambda}-1)/\lambda}{(U^(lambda)-1)/lambda} for \eqn{\lambda \neq 0}{lambda not equal to zero}, and \eqn{\log(U)}{log(U)} if \eqn{\lambda =0}{lambda = 0}. If \code{family="yeo.johnson"} then the Yeo-Johnson transformations are used. This is the Box-Cox transformation of \eqn{U+1} for nonnegative values, and of \eqn{|U|+1} with parameter \eqn{2-\lambda}{2-lambda} for \eqn{U} negative. If \code{jacobian.adjusted} is \code{TRUE}, then the scaled transformations are divided by the Jacobian, which is a function of the geometric mean of \eqn{U}. The basic power transformation returns \eqn{U^{\lambda}} if \eqn{\lambda} is not zero, and \eqn{\log(\lambda)} otherwise. Missing values are permitted, and return \code{NA} where ever \code{U}is equal to \code{NA}. } \value{ Returns a vector or matrix of transformed values. } \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition. Wiley, Chapter 7. Yeo, In-Kwon and Johnson, Richard (2000) A new family of power transformations to improve normality or symmetry. \emph{Biometrika}, 87, 954-959. } \author{ Sanford Weisberg, } \seealso{\code{\link{powerTransform}} } \examples{ U <- c(NA, (-3:3)) \dontrun{bcPower(U, 0)} # produces an error as U has negative values bcPower(U+4,0) bcPower(U+4, .5, jacobian.adjusted=TRUE) yjPower(U, 0) yjPower(U+3, .5, jacobian.adjusted=TRUE) V <- matrix(1:10, ncol=2) bcPower(V, c(0,1)) #basicPower(V, c(0,1)) } \keyword{regression} car/man/scatter3d.Rd0000644000175100001440000002440212155743516014006 0ustar hornikusers\name{scatter3d} \alias{scatter3d} \alias{scatter3d.formula} \alias{scatter3d.default} \alias{identify3d} \title{Three-Dimensional Scatterplots and Point Identification} \description{ The \code{scatter3d} function uses the \code{rgl} package to draw 3D scatterplots with various regression surfaces. The function \code{identify3d} allows you to label points interactively with the mouse: Press the right mouse button (on a two-button mouse) or the centre button (on a three-button mouse), drag a rectangle around the points to be identified, and release the button. Repeat this procedure for each point or set of \dQuote{nearby} points to be identified. To exit from point-identification mode, click the right (or centre) button in an empty region of the plot. } \usage{ scatter3d(x, ...) \method{scatter3d}{formula}(formula, data, subset, radius, xlab, ylab, zlab, labels, ...) \method{scatter3d}{default}(x, y, z, xlab=deparse(substitute(x)), ylab=deparse(substitute(y)), zlab=deparse(substitute(z)), axis.scales=TRUE, revolutions=0, bg.col=c("white", "black"), axis.col=if (bg.col == "white") c("darkmagenta", "black", "darkcyan") else c("darkmagenta", "white", "darkcyan"), surface.col=c("blue", "green", "orange", "magenta", "cyan", "red", "yellow", "gray"), surface.alpha=0.5, neg.res.col="red", pos.res.col="green", square.col=if (bg.col == "white") "black" else "gray", point.col="yellow", text.col=axis.col, grid.col=if (bg.col == "white") "black" else "gray", fogtype=c("exp2", "linear", "exp", "none"), residuals=(length(fit) == 1), surface=TRUE, fill=TRUE, grid=TRUE, grid.lines=26, df.smooth=NULL, df.additive=NULL, sphere.size=1, radius=1, threshold=0.01, speed=1, fov=60, fit="linear", groups=NULL, parallel=TRUE, ellipsoid=FALSE, level=0.5, ellipsoid.alpha=0.1, id.method=c("mahal", "xz", "y", "xyz", "identify", "none"), id.n=if (id.method == "identify") Inf else 0, labels=as.character(seq(along=x)), offset = ((100/length(x))^(1/3)) * 0.02, model.summary=FALSE, ...) identify3d(x, y, z, axis.scales=TRUE, groups = NULL, labels = 1:length(x), col = c("blue", "green", "orange", "magenta", "cyan", "red", "yellow", "gray"), offset = ((100/length(x))^(1/3)) * 0.02) } \note{ You have to install the \code{rgl} package to produce 3D plots. } \arguments{ \item{formula}{``model'' formula, of the form \code{y ~ x + z} or (to plot by groups) \code{y ~ x + z | g}, where \code{g} evaluates to a factor or other variable dividing the data into groups.} \item{data}{data frame within which to evaluate the formula.} \item{subset}{expression defining a subset of observations.} \item{x}{variable for horizontal axis.} \item{y}{variable for vertical axis (response).} \item{z}{variable for out-of-screen axis.} \item{xlab, ylab, zlab}{axis labels.} \item{axis.scales}{if \code{TRUE}, label the values of the ends of the axes. \emph{Note:} For \code{identify3d} to work properly, the value of this argument must be the same as in \code{scatter3d}.} \item{revolutions}{number of full revolutions of the display.} \item{bg.col}{background colour; one of \code{"white"}, \code{"black"}.} \item{axis.col}{colours for axes; if \code{axis.scales} is \code{FALSE}, then the second colour is used for all three axes.} \item{surface.col}{vector of colours for regression planes, used in the order specified by \code{fit}; for multi-group plots, the colours are used for the regression surfaces and points in the several groups.} \item{surface.alpha}{transparency of regression surfaces, from \code{0.0} (fully transparent) to \code{1.0} (opaque); default is \code{0.5}.} \item{neg.res.col, pos.res.col}{colours for lines representing negative and positive residuals.} \item{square.col}{colour to use to plot squared residuals.} \item{point.col}{colour of points.} \item{text.col}{colour of axis labels.} \item{grid.col}{colour of grid lines on the regression surface(s).} \item{fogtype}{type of fog effect; one of \code{"exp2"}, \code{"linear"}, \code{"exp"}, \code{"none".}} \item{residuals}{plot residuals if \code{TRUE}; if \code{residuals="squares"}, then the squared residuals are shown as squares (using code adapted from Richard Heiberger). Residuals are available only when there is one surface plotted.} \item{surface}{plot surface(s) (\code{TRUE} or \code{FALSE}).} \item{fill}{fill the plotted surface(s) with colour (\code{TRUE} or \code{FALSE}).} \item{grid}{plot grid lines on the regression surface(s) (\code{TRUE} or \code{FALSE}).} \item{grid.lines}{number of lines (default, 26) forming the grid, in each of the x and z directions.} \item{df.smooth}{degrees of freedom for the two-dimensional smooth regression surface; if \code{NULL} (the default), the \code{\link[mgcv]{gam}} function will select the degrees of freedom for a smoothing spline by generalized cross-validation; if a positive number, a fixed regression spline will be fit with the specified degrees of freedom.} \item{df.additive}{degrees of freedom for each explanatory variable in an additive regression; if \code{NULL} (the default), the \code{gam} function will select degrees of freedom for the smoothing splines by generalized cross-validation; if a positive number or a vector of two positive numbers, fixed regression splines will be fit with the specified degrees of freedom for each term.} \item{sphere.size}{general size of spheres representing points; the actual size is dependent on the number of observations.} \item{radius}{relative radii of the spheres representing the points. This is normally a vector of the same length as the variables giving the coordinates of the points, and for the \code{formula} method, that must be the case or the argument may be omitted, in which case spheres are the same size; for the \code{default} method, the default for the argument, \code{1}, produces spheres all of the same size. The radii are scaled so that their median is 1.} \item{threshold}{if the actual size of the spheres is less than the threshold, points are plotted instead.} \item{speed}{relative speed of revolution of the plot.} \item{fov}{field of view (in degrees); controls degree of perspective.} \item{fit}{one or more of \code{"linear"}, \code{"quadratic"}, \code{"smooth"}, \code{"additive"}; to display fitted surface(s); partial matching is supported -- e.g., \code{c("lin", "quad")}.} \item{groups}{if \code{NULL} (the default), no groups are defined; if a factor, a different surface or set of surfaces is plotted for each level of the factor; in this event, the colours in \code{surface.col} are used successively for the points, surfaces, and residuals corresponding to each level of the factor.} \item{parallel}{when plotting surfaces by \code{groups}, should the surfaces be constrained to be parallel? A logical value, with default \code{TRUE}.} \item{ellipsoid}{plot concentration ellipsoid(s) (\code{TRUE} or \code{FALSE}).} \item{level}{expected proportion of bivariate-normal observations included in the concentration ellipsoid(s); default is 0.5.} \item{ellipsoid.alpha}{transparency of ellipsoids, from \code{0.0} (fully transparent) to \code{1.0} (opaque); default is \code{0.1}.} \item{id.method}{if \code{"mahal"} (the default), relatively extreme points are identified automatically according to their Mahalanobis distances from the centroid (point of means); if \code{"identify"}, points are identified interactively by right-clicking and dragging a box around them; right-click in an empty area to exit from interactive-point-identification mode; if \code{"xz"}, identify extreme points in the predictor plane; if \code{"y"}, identify unusual values of the response; if \code{"xyz"} identify unusual values of an variable; if \code{"none"}, no point identification. See \code{\link{showLabels}} for more information.} \item{id.n}{Number of relatively extreme points to identify automatically (default, \code{0} unless \code{id.method="identify"}).} \item{model.summary}{print summary or summaries of the model(s) fit (\code{TRUE} or \code{FALSE}). \code{scatter3d} rescales the three variables internally to fit in the unit cube; this rescaling will affect regression coefficients.} \item{labels}{text labels for the points, one for each point; in the \code{default} method defaults to the observation indices, in the \code{formula} method to the row names of the data.} \item{col}{colours for the point labels, given by group. There must be at least as many colours as groups; if there are no groups, the first colour is used. Normally, the colours would correspond to the \code{surface.col} argument to \code{scatter3d}.} \item{offset}{vertical displacement for point labels (to avoid overplotting the points).} \item{\dots}{arguments to be passed down.} } \value{ \code{scatter3d} does not return a useful value; it is used for its side-effect of creating a 3D scatterplot. \code{identify3d} returns the labels of the identified points. } \author{John Fox \email{jfox@mcmaster.ca}} \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \seealso{\code{\link[rgl]{rgl-package}}, \code{\link[mgcv]{gam}}} \examples{ if(interactive() && require(rgl) && require(mgcv)){ scatter3d(prestige ~ income + education, data=Duncan) Sys.sleep(5) # wait 5 seconds scatter3d(prestige ~ income + education | type, data=Duncan) Sys.sleep(5) scatter3d(prestige ~ income + education | type, surface=FALSE, ellipsoid=TRUE, revolutions=3, data=Duncan) scatter3d(prestige ~ income + education, fit=c("linear", "additive"), data=Prestige) Sys.sleep(5) scatter3d(prestige ~ income + education | type, radius=(1 + women)^(1/3), data=Prestige) } \dontrun{ # drag right mouse button to identify points, click right button in open area to exit scatter3d(prestige ~ income + education, data=Duncan, id.method="identify") scatter3d(prestige ~ income + education | type, data=Duncan, id.method="identify") } } \keyword{hplot} car/man/Freedman.Rd0000644000175100001440000000166611401002012013606 0ustar hornikusers\name{Freedman} \alias{Freedman} \docType{data} \title{Crowding and Crime in U. S. Metropolitan Areas} \description{ The \code{Freedman} data frame has 110 rows and 4 columns. The observations are U. S. metropolitan areas with 1968 populations of 250,000 or more. There are some missing data. } \format{ This data frame contains the following columns: \describe{ \item{population}{ Total 1968 population, 1000s. } \item{nonwhite}{ Percent nonwhite population, 1960. } \item{density}{ Population per square mile, 1968. } \item{crime}{ Crime rate per 100,000, 1969. } } } \source{ United States (1970) \emph{Statistical Abstract of the United States}. Bureau of the Census. } \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Freedman, J. (1975) \emph{Crowding and Behavior.} Viking. } \usage{ Freedman } \keyword{datasets} car/man/Robey.Rd0000644000175100001440000000206111401002012013133 0ustar hornikusers\name{Robey} \alias{Robey} \docType{data} \title{Fertility and Contraception} \description{ The \code{Robey} data frame has 50 rows and 3 columns. The observations are developing nations around 1990. } \format{ This data frame contains the following columns: \describe{ \item{region}{ A factor with levels: \code{Africa}; \code{Asia}, Asia and Pacific; \code{Latin.Amer}, Latin America and Caribbean; \code{Near.East}, Near East and North Africa. } \item{tfr}{ Total fertility rate (children per woman). } \item{contraceptors}{ Percent of contraceptors among married women of childbearing age. } } } \source{ Robey, B., Shea, M. A., Rutstein, O. and Morris, L. (1992) The reproductive revolution: New survey findings. \emph{Population Reports}. Technical Report M-11. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. } \usage{ Robey } \keyword{datasets} car/man/Cowles.Rd0000644000175100001440000000151511253536255013344 0ustar hornikusers\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. } \keyword{datasets} car/man/deltaMethod.Rd0000644000175100001440000002372712166631153014350 0ustar hornikusers\name{deltaMethod} \alias{deltaMethod} \alias{deltaMethod.default} \alias{deltaMethod.lm} \alias{deltaMethod.nls} \alias{deltaMethod.multinom} \alias{deltaMethod.polr} \alias{deltaMethod.survreg} \alias{deltaMethod.coxph} \alias{deltaMethod.mer} \alias{deltaMethod.merMod} \alias{deltaMethod.lme} \alias{deltaMethod.lmList} \title{Estimate and Standard Error of a Nonlinear Function of Estimated Regression Coefficients} \description{ \code{deltaMethod} is a generic function that uses the delta method to get a first-order approximate standard error for a nonlinear function of a vector of random variables with known or estimated covariance matrix. } \usage{ deltaMethod(object, ...) \method{deltaMethod}{default}(object, g, vcov., func=g, constants, ...) \method{deltaMethod}{lm} (object, g, vcov.=vcov, parameterNames=names(coef(object)), ...) \method{deltaMethod}{nls}(object, g, vcov.=vcov, ...) \method{deltaMethod}{multinom} (object, g, vcov. = vcov, parameterNames = if (is.matrix(coef(object))) colnames(coef(object)) else names(coef(object)), ...) \method{deltaMethod}{polr} (object, g, vcov.=vcov, ...) \method{deltaMethod}{survreg} (object, g, vcov. = vcov, parameterNames = names(coef(object)), ...) \method{deltaMethod}{coxph} (object, g, vcov. = vcov, parameterNames = names(coef(object)), ...) \method{deltaMethod}{mer} (object, g, vcov. = vcov, parameterNames = names(fixef(object)), ...) \method{deltaMethod}{merMod} (object, g, vcov. = vcov, parameterNames = names(fixef(object)), ...) \method{deltaMethod}{lme} (object, g, vcov. = vcov, parameterNames = names(fixef(object)), ...) \method{deltaMethod}{lmList} (object, g, ...) } \arguments{ \item{object}{For the default method, \code{object} is either (1) a vector of \code{p} named elements, so \code{names(object)} returns a list of \code{p} character strings that are the names of the elements of \code{object}; or (2) a model object for which there are \code{\link[stats]{coef}} and \code{\link[stats]{vcov}} methods, and for which the named coefficient vector returned by \code{coef} is asymptotically normally distributed with asymptotic covariance matrix returned by \code{vcov}. For the other methods, \code{object} is a regression object for which \code{coef(object)} or \code{fixef(object)} returns a vector of parameter estimates.} \item{g}{A quoted string that is the function of the parameter estimates to be evaluated; see the details below. } \item{vcov.}{The (estimated) covariance matrix of the coefficient estimates. For the default method, this argument is required. For all other methods, this argument must either provide the estimated covariance matrix or a function that when applied to \code{object} returns a covariance matrix. The default is to use the function \code{vcov}.} \item{func}{A quoted string used to annotate output. The default of \code{func = g} is usually appropriate.} \item{parameterNames}{A character vector of length \code{p} that gives the names of the parameters in the same order as they appear in the vector of estimates. This argument will be useful if some of the names in the vector of estimates include special characters, like \code{I(x2^2)}, or \code{x1:x2} that will confuse the numerical differentiation function. See details below.} \item{constants}{This argument is a named vector whose elements are constants that are used in the \code{f} argument. This is needed only when the function is called from within another function to comply to R scoping rules. See example below.} \item{...}{Used to pass arguments to the generic method.} } \details{ Suppose \eqn{x} is a random vector of length \eqn{p} that is at least approximately normally distributed with mean \eqn{\beta} and estimated covariance matrix \eqn{C}. Then any function \eqn{g(\beta)} of \eqn{\beta}, is estimated by \eqn{g(x)}, which is in large samples normally distributed with mean \eqn{g(\beta)} and estimated variance \eqn{h'Ch}, where \eqn{h} is the first derivative of \eqn{g(\beta)} with respect to \eqn{\beta} evaluated at \eqn{x}. This function returns both \eqn{g(x)} and its standard error, the square root of the estimated variance. The default method requires that you provide \eqn{x} in the argument \code{object}, \eqn{C} in the argument \code{vcov.}, and a text expression in argument \code{g} that when evaluated gives the function \eqn{g}. The call \code{names(object)} must return the names of the elements of \code{x} that are used in the expression \code{g}. Since the delta method is often applied to functions of regression parameter estimates, the argument \code{object} may be the name of a regression object from which the the estimates and their estimated variance matrix can be extracted. In most regression models, estimates are returned by the \code{coef(object)} and the variance matrix from \code{vcov(object)}. You can provide an alternative function for computing the sample variance matrix, for example to use a sandwich estimator. For mixed models using \code{lme4} or \code{nlme}, the coefficient estimates are returned by the \code{fixef} function, while for \code{multinom}, \code{lmList} and \code{nlsList} coefficient estimates are returned by \code{coef} as a matrix. Methods for these models are provided to get the correct estimates and variance matrix. The argument \code{g} must be a quoted character string that gives the function of interest. For example, if you set \code{m2 <- lm(Y ~ X1 + X2 + X1:X2)}, then \code{deltaMethod(m2,"X1/X2")} applies the delta method to the ratio of the coefficient estimates for \code{X1} and \code{X2}. The argument \code{g} can consist of constants and names associated with the elements of the vector of coefficient estimates. In some cases the names may include characters including such as the colon \code{:} used in interactions, or mathematical symbols like \code{+} or \code{-} signs that would confuse the function that computes numerical derivatives, and for this case you can replace the names of the estimates with the \code{parameterNames} argument. For example, the ratio of the \code{X2} main effect to the interaction term could be computed using \code{deltaMethod(m2, "b1/b3", parameterNames=c("b0", "b1", "b2", "b3"))}. The name \dQuote{\code{(Intercept)}} used for the intercept in linear and generalized linear models is an exception, and it will be correctly interpreted by \code{deltaMethod}. For \code{multinom} objects, the \code{coef} function returns a matrix of coefficients, with each row giving the estimates for comparisons of one category to the baseline. The \code{deltaMethod} function applies the delta method to each row of this matrix. Similarly, for \code{lmList} and \code{nlsList} objects, the delta method is computed for each element of the list of models fit. For nonlinear regression objects of type nls, the call \code{coef(object)} returns the estimated coefficient vectors with names corresponding to parameter names. For example, \code{m2 <- nls(y ~ theta/(1 + gamma * x), start = list(theta=2, gamma=3))} will have parameters named \code{c("theta", "gamma")}. In many other familiar regression methods, such as lm and glm, the names of the coefficient estimates are the corresponding variable names, not parameter names. For mixed-effects models fit with \code{lmer} and \code{nlmer} from the \code{lme4} package or \code{lme} and \code{nlme} from the \code{nlme} package, only fixed-effect coefficients are considered. For regression models for which methods are not provided, you can extract the named vector of coefficient estimates and and estimate of its covariance matrix and then apply the default \code{deltaMethod} function. Earlier versions of \code{deltaMethod} included an argument \code{parameterPrefix} that implemented the same functionality as the \code{parameterNames} argument, but it caused several unintended bugs that were not easily fixed without the change in syntax. } \value{ A data.frame with two components named \code{Estimate} for the estimate, \code{SE} for its standard error. The value of \code{g} is given as a row label. } \seealso{First derivatives of \code{g} are computed using symbolic differentiation by the function \code{\link{D}}.} \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. S. Weisberg (2005) \emph{Applied Linear Regression}, Third Edition, Wiley, Section 6.1.2. } \author{Sanford Weisberg, \email{sandy@umn.edu}, and John Fox \email{jfox@mcmaster.ca}} \examples{ m1 <- lm(time ~ t1 + t2, data = Transact) deltaMethod(m1, "b1/b2", parameterNames= paste("b", 0:2, sep="")) deltaMethod(m1, "t1/t2") # use names of preds. rather than coefs. deltaMethod(m1, "t1/t2", vcov=hccm) # use hccm function to est. vars. # to get the SE of 1/intercept, rename coefficients deltaMethod(m1, "1/b0", parameterNames= paste("b", 0:2, sep="")) # The next example calls the default method by extracting the # vector of estimates and covariance matrix explicitly deltaMethod(coef(m1), "t1/t2", vcov.=vcov(m1)) # the following works: a <- 5 deltaMethod(m1, "(t1 + a)/t2") # ...but embedded in a function this will fail f1 <- function(mod, ...) { z <- 3 deltaMethod(m1, "(t1+z)/t2", ...) } \dontrun{f1(m1)} # if z is defined globally f1 could even return the wrong answer. # the following function works f2 <- function(mod, ...) { deltaMethod(m1, "(t1+z)/t2", ...) } f2(m1, constants=c(z=3)) # as does f3 <- function(mod) { a <- 3 deltaMethod(m1, "(t1+z)/t2", constants=c(z=a)) } f3(m1) } \keyword{ models }% at least one, from doc/KEYWORDS \keyword{ regression } car/man/Highway1.Rd0000644000175100001440000000360411401002012013540 0ustar hornikusers\name{Highway1} \alias{Highway1} \docType{data} \title{Highway Accidents} \description{ The data comes from a unpublished master's paper by Carl Hoffstedt. They relate the automobile accident rate, in accidents per million vehicle miles to several potential terms. The data include 39 sections of large highways in the state of Minnesota in 1973. The goal of this analysis was to understand the impact of design variables, \code{Acpts}, \code{Slim}, \code{Sig}, and \code{Shld} that are under the control of the highway department, on accidents. } \format{This data frame contains the following columns: \describe{ \item{rate}{ 1973 accident rate per million vehicle miles } \item{len}{ length of the \code{Highway1} segment in miles } \item{ADT}{ average daily traffic count in thousands } \item{trks}{ truck volume as a percent of the total volume } \item{sigs1}{ (number of signalized interchanges per mile times len + 1)/len, the number of signals per mile of roadway, adjusted to have no zero values. } \item{slim}{ speed limit in 1973 } \item{shld}{ width in feet of outer shoulder on the roadway } \item{lane}{ total number of lanes of traffic } \item{acpt}{ number of access points per mile } \item{itg}{ number of freeway-type interchanges per mile } \item{lwid}{ lane width, in feet } \item{hwy}{An indicator of the type of roadway or the source of funding for the road, either MC, FAI, PA, or MA } } } \source{Carl Hoffstedt. This differs from the dataset \code{highway} in the \code{alr3} package only by transformation of some of the columns.} \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition. Wiley, Section 7.2. } \usage{ Highway1 } \keyword{datasets} car/man/infIndexPlot.Rd0000644000175100001440000000466112166631153014515 0ustar hornikusers\name{infIndexPlot} \alias{infIndexPlot} \alias{influenceIndexPlot} \alias{infIndexPlot.lm} \title{Influence Index Plot} \description{ Provides index plots of Cook's distances, leverages, Studentized residuals, and outlier significance levels for a regression object. } \usage{ infIndexPlot(model, ...) influenceIndexPlot(model, ...) \method{infIndexPlot}{lm}(model, vars=c("Cook", "Studentized", "Bonf", "hat"), main="Diagnostic Plots", labels, id.method = "y", id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], grid=TRUE, ...) } \arguments{ \item{model}{A regression object of class \code{lm} or \code{glm}.} \item{vars}{ All the quantities listed in this argument are plotted. Use \code{"Cook"} for Cook's distances, \code{"Studentized"} for Studentized residuals, \code{"Bonf"} for Bonferroni p-values for an outlier test, and and \code{"hat"} for hat-values (or leverages). Capitalization is optional. All may be abbreviated by the first one or more letters. } \item{main}{main title for graph} \item{id.method,labels,id.n,id.cex,id.col}{Arguments for the labelling of points. The default is \code{id.n=0} for labeling no points. See \code{\link{showLabels}} for details of these arguments. } \item{grid}{If TRUE, the default, a light-gray background grid is put on the graph} \item{\dots}{Arguments passed to \code{plot}} } \value{ Used for its side effect of producing a graph. Produces four index plots of Cook's distance, Studentized Residuals, the corresponding Bonferroni p-values for outlier tests, and leverages. } \references{ Cook, R. D. and Weisberg, S. (1999) \emph{Applied Regression, Including Computing and Graphics.} Wiley. Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition. Wiley. } \author{Sanford Weisberg, \email{sandy@umn.edu}} \seealso{ \code{\link{cooks.distance}}, \code{\link{rstudent}}, \code{\link{outlierTest}}, \code{\link{hatvalues}} } \examples{ m1 <- lm(prestige ~ income + education + type, Duncan) influenceIndexPlot(m1) } \keyword{ hplot }% at least one, from doc/KEYWORDS \keyword{ regression }% __ONLY ONE__ keyword per line car/man/scatterplot.Rd0000644000175100001440000002073112155743516014457 0ustar hornikusers\name{scatterplot} \alias{scatterplot} \alias{scatterplot.formula} \alias{scatterplot.default} \alias{sp} \title{Scatterplots with Boxplots} \description{ Makes enhanced scatterplots, with boxplots in the margins, a nonparametric regression smooth, smoothed conditional spread, outlier identification, and a regression line; \code{sp} is an abbreviation for \code{scatterplot}. } \usage{ scatterplot(x, ...) \method{scatterplot}{formula}(formula, data, subset, xlab, ylab, legend.title, legend.coords, labels, ...) \method{scatterplot}{default}(x, y, smoother=loessLine, smoother.args=list(), smooth, span, spread=!by.groups, reg.line=lm, boxplots=if (by.groups) "" else "xy", xlab=deparse(substitute(x)), ylab=deparse(substitute(y)), las=par("las"), lwd=1, lty=1, labels, id.method = "mahal", id.n = if(id.method[1]=="identify") length(x) else 0, id.cex = 1, id.col = palette()[1], log="", jitter=list(), xlim=NULL, ylim=NULL, cex=par("cex"), cex.axis=par("cex.axis"), cex.lab=par("cex.lab"), cex.main=par("cex.main"), cex.sub=par("cex.sub"), groups, by.groups=!missing(groups), legend.title=deparse(substitute(groups)), legend.coords, ellipse=FALSE, levels=c(.5, .95), robust=TRUE, col=if (n.groups == 1) palette()[3:1] else rep(palette(), length=n.groups), pch=1:n.groups, legend.plot=!missing(groups), reset.par=TRUE, grid=TRUE, ...) sp(...) } \arguments{ \item{x}{vector of horizontal coordinates} \item{y}{vector of vertical coordinates.} \item{formula}{a ``model'' formula, of the form \code{y ~ x} or (to plot by groups) \code{y ~ x | z}, where \code{z} evaluates to a factor or other variable dividing the data into groups. If \code{x} is a factor, then parallel boxplots are produced using the \code{\link{Boxplot}} function.} \item{data}{data frame within which to evaluate the formula.} \item{subset}{expression defining a subset of observations.} \item{smoother}{a function to draw a nonparametric-regression smooth; the default is \code{\link{loessLine}}, which does loess smoothing. The function \code{\link{gamLine}} fits a generalized additive model and allows including a link and error function. See \code{\link{ScatterplotSmoothers}}. Setting this argument to something other than a function, e.g., \code{FALSE} suppresses the smoother.} \item{smoother.args}{a list of named values to be passed to the smoother function; the specified elements of the list depend upon the smoother (see \code{\link{ScatterplotSmoothers}}).} \item{smooth, span}{these arguments are included for backwards compatility: if \code{smooth=TRUE} then \code{smoother} is set to \code{loessLine}, and if \code{span} is specified, it is added to \code{smoother.args}.} \item{spread}{if TRUE, estimate the (square root) of the variance function. For \code{loessLine} and for \code{gamLine}, this is done by separately smoothing the squares of the postive and negative residuals from the mean fit, and then adding the square root of the fitted values to the mean fit. For \code{quantregLine}, fit the .25 and .75 quantiles with a quantile regression additive model. The default is TRUE if \code{by.groups=FALSE} and FALSE is \code{by.groups=TRUE}.} \item{reg.line}{function to draw a regression line on the plot or \code{FALSE} not to plot a regression line.} \item{boxplots}{if \code{"x"} a boxplot for \code{x} is drawn below the plot; if \code{"y"} a boxplot for \code{y} is drawn to the left of the plot; if \code{"xy"} both boxplots are drawn; set to \code{""} or \code{FALSE} to suppress both boxplots.} \item{xlab}{label for horizontal axis.} \item{ylab}{label for vertical axis.} \item{las}{if \code{0}, ticks labels are drawn parallel to the axis; set to \code{1} for horizontal labels (see \code{\link[graphics]{par}}).} \item{lwd}{width of linear-regression lines (default \code{1}).} \item{lty}{type of linear-regression lines (default \code{1}, solid line).} \item{id.method,id.n,id.cex,id.col}{Arguments for the labelling of points. The default is \code{id.n=0} for labeling no points. See \code{\link{showLabels}} for details of these arguments. If the plot uses different colors for groups, then the \code{id.col} argument is ignored and label colors are determined by the \code{col} argument.} \item{labels}{a vector of point labels; if absent, the function tries to determine reasonable labels, and, failing that, will use observation numbers.} \item{log}{same as the \code{log} argument to \code{\link{plot}}, to produce log axes.} \item{jitter}{a list with elements \code{x} or \code{y} or both, specifying jitter factors for the horizontal and vertical coordinates of the points in the scatterplot. The \code{\link[base]{jitter}} function is used to randomly perturb the points; specifying a factor of \code{1} produces the default jitter. Fitted lines are unaffected by the jitter.} \item{xlim}{the x limits (min, max) of the plot; if \code{NULL}, determined from the data.} \item{ylim}{the y limits (min, max) of the plot; if \code{NULL}, determined from the data.} \item{groups}{a factor or other variable dividing the data into groups; groups are plotted with different colors and plotting characters.} \item{by.groups}{if \code{TRUE}, regression lines are fit by groups.} \item{legend.title}{title for legend box; defaults to the name of the groups variable.} \item{legend.coords}{coordinates for placing legend; an be a list with components x and y to specify the coordinates of the upper-left-hand corner of the legend; or a quoted keyword, such as \code{"topleft"}, recognized by \code{\link{legend}}.} \item{ellipse}{if \code{TRUE} data-concentration ellipses are plotted.} \item{levels}{level or levels at which concentration ellipses are plotted; the default is \code{c(.5, .95)}.} \item{robust}{if \code{TRUE} (the default) use the \code{cov.trob} function in the \code{MASS} package to calculate the center and covariance matrix for the data ellipses.} \item{col}{colors for lines and points; the default is taken from the color palette, with \code{palette()[3]} for linear regression lines, \code{palette()[2]} for nonparametric regression lines, and \code{palette()[1]} for points if there are no groups, and successive colors for the groups if there are groups.} \item{pch}{plotting characters for points; default is the plotting characters in order (see \code{\link[graphics]{par}}).} \item{cex, cex.axis, cex.lab, cex.main, cex.sub}{set sizes of various graphical elements; (see \code{\link[graphics]{par}}).} \item{legend.plot}{if \code{TRUE} then a legend for the groups is plotted in the upper margin.} \item{reset.par}{if \code{TRUE} then plotting parameters are reset to their previous values when \code{scatterplot} exits; if \code{FALSE} then the \code{mar} and \code{mfcol} parameters are altered for the current plotting device. Set to \code{FALSE} if you want to add graphical elements (such as lines) to the plot.} \item{\dots}{other arguments passed down and to \code{plot}.} \item{grid}{If TRUE, the default, a light-gray background grid is put on the graph} } \value{ If points are identified, their labels are returned; otherwise \code{NULL} is returned invisibly. } \author{John Fox \email{jfox@mcmaster.ca}} \seealso{\code{\link[graphics]{boxplot}}, \code{\link[base]{jitter}}, \code{\link{legend}}, \code{\link{scatterplotMatrix}}, \code{\link{dataEllipse}}, \code{\link{Boxplot}}, \code{\link[MASS]{cov.trob}}, \code{\link{showLabels}}, \code{\link{ScatterplotSmoothers}}.} \examples{ scatterplot(prestige ~ income, data=Prestige, ellipse=TRUE) if (interactive()){ scatterplot(prestige ~ income, data=Prestige, smoother=quantregLine) } scatterplot(prestige ~ income|type, data=Prestige, smoother=loessLine, smoother.args=list(span=1)) scatterplot(prestige ~ income|type, data=Prestige, legend.coords="topleft") scatterplot(vocabulary ~ education, jitter=list(x=1, y=1), data=Vocab, id.n=0, smoother=FALSE) scatterplot(infant.mortality ~ gdp, log="xy", data=UN, id.n=5) scatterplot(income ~ type, data=Prestige) \dontrun{ scatterplot(infant.mortality ~ gdp, id.method="identify", data=UN) scatterplot(infant.mortality ~ gdp, id.method="identify", smoother=loessLine, data=UN) } } \keyword{hplot} car/man/outlierTest.Rd0000644000175100001440000000507611401002012014407 0ustar hornikusers\name{outlierTest} \alias{outlierTest} \alias{outlierTest.lm} \alias{outlierTest.glm} \alias{print.outlierTest} \title{Bonferroni Outlier Test} \description{ Reports the Bonferroni p-values for Studentized residuals in linear and generalized linear models, based on a t-test for linear models and normal-distribution test for generalized linear models. } \usage{ outlierTest(model, ...) \method{outlierTest}{lm}(model, cutoff=0.05, n.max=10, order=TRUE, labels=names(rstudent), ...) \method{print}{outlierTest}(x, digits=5, ...) } \arguments{ \item{model}{an \code{lm} or \code{glm} model object.} \item{cutoff}{observations with Bonferonni p-values exceeding \code{cutoff} are not reported, unless no observations are nominated, in which case the one with the largest Studentized residual is reported.} \item{n.max}{maximum number of observations to report (default, \code{10}).} \item{order}{report Studenized residuals in descending order of magnitude? (default, \code{TRUE}).} \item{labels}{an optional vector of observation names.} \item{...}{arguments passed down to methods functions.} \item{x}{\code{outlierTest} object.} \item{digits}{number of digits for reported p-values.} } \details{ For a linear model, p-values reported use the t distribution with degrees of freedom one less than the residual df for the model. For a generalized linear model, p-values are based on the standard-normal distribution. The Bonferroni adjustment multiplies the usual two-sided p-value by the number of observations. The \code{lm} method works for \code{glm} objects. To show all of the observations set \code{cutoff=Inf} and \code{n.max=Inf}. } \value{ an object of class \code{outlierTest}, which is normally just printed. } \references{ Cook, R. D. and Weisberg, S. (1982) \emph{Residuals and Influence in Regression.} Chapman and Hall. Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition, Wiley. Williams, D. A. (1987) Generalized linear model diagnostics using the deviance and single case deletions. \emph{Applied Statistics} \bold{36}, 181--191. } \author{John Fox \email{jfox@mcmaster.ca} and Sanford Weisberg} \examples{ outlierTest(lm(prestige ~ income + education, data=Duncan)) } \keyword{regression} \keyword{htest} car/man/States.Rd0000644000175100001440000000336311401002012013324 0ustar hornikusers\name{States} \alias{States} \docType{data} \title{Education and Related Statistics for the U.S. States} \description{ The \code{States} data frame has 51 rows and 8 columns. The observations are the U. S. states and Washington, D. C. } \format{ This data frame contains the following columns: \describe{ \item{region}{ U. S. Census regions. A factor with levels: \code{ENC}, East North Central; \code{ESC}, East South Central; \code{MA}, Mid-Atlantic; \code{MTN}, Mountain; \code{NE}, New England; \code{PAC}, Pacific; \code{SA}, South Atlantic; \code{WNC}, West North Central; \code{WSC}, West South Central. } \item{pop}{ Population: in 1,000s. } \item{SATV}{ Average score of graduating high-school students in the state on the \emph{verbal} component of the Scholastic Aptitude Test (a standard university admission exam). } \item{SATM}{ Average score of graduating high-school students in the state on the \emph{math} component of the Scholastic Aptitude Test. } \item{percent}{ Percentage of graduating high-school students in the state who took the SAT exam. } \item{dollars}{ State spending on public education, in \$1000s per student. } \item{pay}{ Average teacher's salary in the state, in $1000s. } } } \source{ United States (1992) \emph{Statistical Abstract of the United States.} Bureau of the Census. } \references{ Moore, D. (1995) \emph{The Basic Practice of Statistics}. Freeman, Table 2.1. } \usage{ States } \keyword{datasets} car/man/hccm.Rd0000644000175100001440000001001111737324344013012 0ustar hornikusers%------------------------------------------------------------------------------- % Revision history: % checked in 2008-12-29 by J. Fox (corresponds to version 1.2-10 of car) % 2009-09-16: added argument singular.ok to lm method. J. Fox % 2012-04-04: weighted lm now allowed. John %------------------------------------------------------------------------------- \name{hccm} \alias{hccm} \alias{hccm.lm} \alias{hccm.default} \title{Heteroscedasticity-Corrected Covariance Matrices} \description{ Calculates heteroscedasticity-corrected covariance matrices linear models fit by least squares or weighted least squares. These are also called \dQuote{White-corrected} or \dQuote{White-Huber} covariance matrices. } \usage{ hccm(model, ...) \method{hccm}{lm}(model, type=c("hc3", "hc0", "hc1", "hc2", "hc4"), singular.ok=TRUE, ...) \method{hccm}{default}(model, ...) } \arguments{ \item{model}{a unweighted or weighted linear model, produced by \code{lm}.} \item{type}{one of \code{"hc0"}, \code{"hc1"}, \code{"hc2"}, \code{"hc3"}, or \code{"hc4"}; the first of these gives the classic White correction. The \code{"hc1"}, \code{"hc2"}, and \code{"hc3"} corrections are described in Long and Ervin (2000); \code{"hc4"} is described in Cribari-Neto (2004).} \item{singular.ok}{if \code{FALSE} (the default is \code{TRUE}), a model with aliased coefficients produces an error; otherwise, the aliased coefficients are ignored in the coefficient covariance matrix that's returned.} \item{...}{arguments to pass to \code{hccm.lm}.} } \details{ The classical White-corrected coefficient covariance matrix (\code{"hc0"}) (for an unweighted model) is \deqn{V(b)=(X^{\prime }X)^{-1}X^{\prime }diag(e_{i}^{2})X(X^{\prime }X)^{-1}}{V(b) = inv(X'X) X' diag(e^2) X inv(X'X)} where \eqn{e_{i}^{2}}{e^2} are the squared residuals, and \eqn{X} is the model matrix. The other methods represent adjustments to this formula. If there are weights, these are incorporated in the corrected covariance amtrix. The function \code{hccm.default} simply catches non-\code{lm} objects. } \value{ The heteroscedasticity-corrected covariance matrix for the model. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Cribari-Neto, F. (2004) Asymptotic inference under heteroskedasticity of unknown form. \emph{Computational Statistics and Data Analysis} \bold{45}, 215--233. Long, J. S. and Ervin, L. H. (2000) Using heteroscedasity consistent standard errors in the linear regression model. \emph{The American Statistician} \bold{54}, 217--224. \url{http://www.jstor.org/stable/2685594} White, H. (1980) A heteroskedastic consistent covariance matrix estimator and a direct test of heteroskedasticity. \emph{Econometrica} \bold{48}, 817--838. } \author{John Fox \email{jfox@mcmaster.ca}} \examples{ options(digits=4) mod<-lm(interlocks~assets+nation, data=Ornstein) vcov(mod) ## (Intercept) assets nationOTH nationUK nationUS ## (Intercept) 1.079e+00 -1.588e-05 -1.037e+00 -1.057e+00 -1.032e+00 ## assets -1.588e-05 1.642e-09 1.155e-05 1.362e-05 1.109e-05 ## nationOTH -1.037e+00 1.155e-05 7.019e+00 1.021e+00 1.003e+00 ## nationUK -1.057e+00 1.362e-05 1.021e+00 7.405e+00 1.017e+00 ## nationUS -1.032e+00 1.109e-05 1.003e+00 1.017e+00 2.128e+00 hccm(mod) ## (Intercept) assets nationOTH nationUK nationUS ## (Intercept) 1.664e+00 -3.957e-05 -1.569e+00 -1.611e+00 -1.572e+00 ## assets -3.957e-05 6.752e-09 2.275e-05 3.051e-05 2.231e-05 ## nationOTH -1.569e+00 2.275e-05 8.209e+00 1.539e+00 1.520e+00 ## nationUK -1.611e+00 3.051e-05 1.539e+00 4.476e+00 1.543e+00 ## nationUS -1.572e+00 2.231e-05 1.520e+00 1.543e+00 1.946e+00 } \keyword{regression} car/man/carWeb.Rd0000644000175100001440000000316711500504070013301 0ustar hornikusers\name{carWeb} \alias{carWeb} \title{ Access to the R Companion to Applied Regression website } \description{ This function will access the website for \emph{An R Companion to Applied Regression}.} \usage{ carWeb(page = c("webpage", "errata", "taskviews"), script, data) } \arguments{ \item{page}{ A character string indicating what page to open. The default \code{"webpage"} will open the main web page, \code{"errata"} displays the errata sheet for the book, and \code{"taskviews"} fetches and displays a list of available task views from CRAN. } \item{script}{The quoted name of a chapter in \emph{An R Companion to Applied Regression}, like \code{"chap-1"}, \code{"chap-2"}, up to \code{"chap-8"}. All the R commands used in that chapter will be displayed in your browser, where you can save them as a text file. } \item{data}{The quoted name of a data file in \emph{An R Companion to Applied Regression}, like \code{"Duncan.txt"} or \code{"Prestige.txt"}. The file will be opened in your web browser. You do not need to specify the extension \code{.txt} } } \value{ Either a web page or a PDF document is displayed. Only one of the three arguments \code{page}, \code{rfile}, or \code{data}, should be used. } \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \author{ Sanford Weisberg, based on the function \code{UsingR} in the \pkg{UsingR} package by John Verzani } \examples{ \dontrun{carWeb()} } \keyword{ interface } car/man/Chile.Rd0000644000175100001440000000267511401002012013112 0ustar hornikusers\name{Chile} \alias{Chile} \docType{data} \title{Voting Intentions in the 1988 Chilean Plebiscite} \description{ The \code{Chile} data frame has 2700 rows and 8 columns. The data are from a national survey conducted in April and May of 1988 by FLACSO/Chile. There are some missing data. } \format{ This data frame contains the following columns: \describe{ \item{region}{ A factor with levels: \code{C}, Central; \code{M}, Metropolitan Santiago area; \code{N}, North; \code{S}, South; \code{SA}, city of Santiago. } \item{population}{ Population size of respondent's community. } \item{sex}{ A factor with levels: \code{F}, female; \code{M}, male. } \item{age}{ in years. } \item{education}{ A factor with levels (note: out of order): \code{P}, Primary; \code{PS}, Post-secondary; \code{S}, Secondary. } \item{income}{ Monthly income, in Pesos. } \item{statusquo}{ Scale of support for the status-quo. } \item{vote}{ a factor with levels: \code{A}, will abstain; \code{N}, will vote no (against Pinochet); \code{U}, undecided; \code{Y}, will vote yes (for Pinochet). } } } \source{ Personal communication from FLACSO/Chile. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \usage{ Chile } \keyword{datasets} car/man/Sahlins.Rd0000644000175100001440000000144011401002012013454 0ustar hornikusers\name{Sahlins} \alias{Sahlins} \docType{data} \title{Agricultural Production in Mazulu Village} \description{ The \code{Sahlins} data frame has 20 rows and 2 columns. The observations are households in a Central African village. } \format{ This data frame contains the following columns: \describe{ \item{consumers}{ Consumers/Gardener, ratio of consumers to productive individuals. } \item{acres}{ Acres/Gardener, amount of land cultivated per gardener. } } } \source{ Sahlins, M. (1972) \emph{Stone Age Economics.} Aldine [Table 3.1]. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. } \usage{ Sahlins } \keyword{datasets} car/man/influencePlot.Rd0000644000175100001440000000445712166631153014724 0ustar hornikusers\name{influencePlot} \alias{influencePlot} \alias{influencePlot.lm} \alias{influence.plot} \title{Regression Influence Plot} \description{ This function creates a \dQuote{bubble} plot of Studentized residuals by hat values, with the areas of the circles representing the observations proportional to Cook's distances. Vertical reference lines are drawn at twice and three times the average hat value, horizontal reference lines at -2, 0, and 2 on the Studentized-residual scale. } \usage{ influencePlot(model, ...) \method{influencePlot}{lm}(model, scale=10, xlab="Hat-Values", ylab="Studentized Residuals", labels, id.method = "noteworthy", id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], ...) } \arguments{ \item{model}{a linear or generalized-linear model. } \item{scale}{a factor to adjust the size of the circles. } \item{xlab, ylab}{axis labels. } \item{labels, id.method, id.n, id.cex, id.col}{settings for labelling points; see \code{link{showLabels}} for details. To omit point labelling, set \code{id.n=0}, the default. The default \code{id.method="noteworthy"} is used only in this function and indicates setting labels for points with large Studentized residuals, hat-values or Cook's distances. Set \code{id.method="identify"} for interactive point identification. } \item{\dots}{arguments to pass to the \code{plot} and \code{points} functions. } } \value{ If points are identified, returns a data frame with the hat values, Studentized residuals and Cook's distance of the identified points. If no points are identified, nothing is returned. This function is primarily used for its side-effect of drawing a plot. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \author{John Fox \email{jfox@mcmaster.ca}, minor changes by S. Weisberg \email{sandy@umn.edu}} \seealso{\code{\link[stats]{cooks.distance}}, \code{\link[stats]{rstudent}}, \code{\link[stats]{hatvalues}}, \code{\link{showLabels}}} \examples{ influencePlot(lm(prestige ~ income + education, data=Duncan)) } \keyword{regression} car/man/recode.Rd0000644000175100001440000000557112032107526013346 0ustar hornikusers\name{recode} \alias{recode} \alias{Recode} \title{Recode a Variable} \description{ Recodes a numeric vector, character vector, or factor according to simple recode specifications. \code{Recode} is an alias for \code{recode} that avoids name clashes with packages, such as \pkg{Hmisc}, that have a \code{recode} function. } \usage{ recode(var, recodes, as.factor.result, as.numeric.result=TRUE, levels) Recode(...) } \arguments{ \item{var}{numeric vector, character vector, or factor.} \item{recodes}{character string of recode specifications: see below.} \item{as.factor.result}{return a factor; default is \code{TRUE} if \code{var} is a factor, \code{FALSE} otherwise.} \item{as.numeric.result}{if \code{TRUE} (the default), and \code{as.factor.result} is \code{FALSE}, then the result will be coerced to numeric if all values in the result are numerals---i.e., represent numbers.} \item{levels}{an optional argument specifying the order of the levels in the returned factor; the default is to use the sort order of the level names.} \item{...}{arguments to be passed to \code{recode}.} } \details{ Recode specifications appear in a character string, separated by semicolons (see the examples below), of the form \code{input=output}. If an input value satisfies more than one specification, then the first (from left to right) applies. If no specification is satisfied, then the input value is carried over to the result. \code{NA} is allowed on input and output. Several recode specifications are supported: \describe{ \item{single value}{For example, \code{0=NA}.} \item{vector of values}{For example, \code{c(7,8,9)='high'}.} \item{range of values}{For example, \code{7:9='C'}. The special values \code{lo} and \code{hi} may appear in a range. For example, \code{lo:10=1}. \emph{Note:} \code{:} is \emph{not} the R sequence operator.} \item{\code{else}}{everything that does not fit a previous specification. For example, \code{else=NA}. Note that \code{else} matches \emph{all} otherwise unspecified values on input, including \code{NA}.} } If all of the output values are numeric, and if \code{as.factor.result} is \code{FALSE}, then a numeric result is returned; if \code{var} is a factor, then by default so is the result. } \value{ a recoded vector of the same length as \code{var}. } \author{John Fox \email{jfox@mcmaster.ca}} \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \seealso{\code{\link[base]{cut}}, \code{\link[base]{factor}}} \examples{ x<-rep(1:3,3) x ## [1] 1 2 3 1 2 3 1 2 3 recode(x, "c(1,2)='A'; else='B'") ## [1] "A" "A" "B" "A" "A" "B" "A" "A" "B" Recode(x, "1:2='A'; 3='B'") ## [1] "A" "A" "B" "A" "A" "B" "A" "A" "B" } \keyword{manip} car/man/some.Rd0000644000175100001440000000204311401002012013016 0ustar hornikusers\name{some} \alias{some} \alias{some.data.frame} \alias{some.matrix} \alias{some.default} \title{Sample a Few Elements of an Object} \description{ Randomly select a few elements of an object, typically a data frame, matrix, vector, or list. If the object is a data frame or a matrix, then rows are sampled. } \usage{ some(x, ...) \method{some}{data.frame}(x, n=10, ...) \method{some}{matrix}(x, n=10, ...) \method{some}{default}(x, n=10, ...) } \arguments{ \item{x}{the object to be sampled.} \item{n}{number of elements to sample.} \item{\dots}{arguments passed down.} } \value{ Sampled elements or rows. } \author{John Fox \email{jfox@mcmaster.ca}} \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \note{These functions are adapted from \code{head} and \code{tail} in the \code{utils} package. } \seealso{\code{\link[utils]{head}}, \code{\link[utils]{tail}}.} \examples{ some(Duncan) } \keyword{utilities} car/man/TransformationAxes.Rd0000644000175100001440000001252311401002012015706 0ustar hornikusers\name{TransformationAxes} \alias{basicPowerAxis} \alias{bcPowerAxis} \alias{yjPowerAxis} \alias{probabilityAxis} \title{Axes for Transformed Variables} \description{ These functions produce axes for the original scale of transformed variables. Typically these would appear as additional axes to the right or at the top of the plot, but if the plot is produced with \code{axes=FALSE}, then these functions could be used for axes below or to the left of the plot as well. } \usage{ basicPowerAxis(power, base=exp(1), side=c("right", "above", "left", "below"), at, start=0, lead.digits=1, n.ticks, grid=FALSE, grid.col=gray(0.50), grid.lty=2, axis.title="Untransformed Data", cex=1, las=par("las")) bcPowerAxis(power, side=c("right", "above", "left", "below"), at, start=0, lead.digits=1, n.ticks, grid=FALSE, grid.col=gray(0.50), grid.lty=2, axis.title="Untransformed Data", cex=1, las=par("las")) yjPowerAxis(power, side=c("right", "above", "left", "below"), at, lead.digits=1, n.ticks, grid=FALSE, grid.col=gray(0.50), grid.lty=2, axis.title="Untransformed Data", cex=1, las=par("las")) probabilityAxis(scale=c("logit", "probit"), side=c("right", "above", "left", "below"), at, lead.digits=1, grid=FALSE, grid.lty=2, grid.col=gray(0.50), axis.title = "Probability", interval = 0.1, cex = 1, las=par("las")) } \arguments{ \item{power}{power for Box-Cox, Yeo-Johnson, or simple power transformation.} \item{scale}{transformation used for probabilities, \code{"logit"} (the default) or \code{"probit"}.} \item{side}{side at which the axis is to be drawn; numeric codes are also permitted: \code{side = 1} for the bottom of the plot, \code{side=2} for the left side, \code{side = 3} for the top, \code{side = 4} for the right side.} \item{at}{numeric vector giving location of tick marks on original scale; if missing, the function will try to pick nice locations for the ticks.} \item{start}{if a \emph{start} was added to a variable (e.g., to make all data values positive), it can now be subtracted from the tick labels.} \item{lead.digits}{number of leading digits for determining `nice' numbers for tick labels (default is \code{1}.} \item{n.ticks}{number of tick marks; if missing, same as corresponding transformed axis.} \item{grid}{if \code{TRUE} grid lines for the axis will be drawn.} \item{grid.col}{color of grid lines.} \item{grid.lty}{line type for grid lines.} \item{axis.title}{title for axis.} \item{cex}{relative character expansion for axis label.} \item{las}{if \code{0}, ticks labels are drawn parallel to the axis; set to \code{1} for horizontal labels (see \code{\link[graphics]{par}}).} \item{base}{base of log transformation for \code{power.axis} when \code{power = 0}.} \item{interval}{desired interval between tick marks on the probability scale.} } \details{ The transformations corresponding to the three functions are as follows: \describe{ \item{\code{basicPowerAxis}:}{Simple power transformation, \eqn{x^{\prime }=x^{p}}{x' = x^p} for \eqn{p\neq 0}{p != 0} and \eqn{x^{\prime }=\log x}{x' = log x} for \eqn{p=0}{p = 0}.} \item{\code{bcPowerAxis}:}{Box-Cox power transformation, \eqn{x^{\prime }=(x^{\lambda }-1)/\lambda}{x' = (x^p - 1)/p} for \eqn{\lambda \neq 0}{x != 0} and \eqn{x^{\prime }=\log x}{x' = log(x)} for \eqn{\lambda =0}{p = 0}.} \item{\code{yjPowerAxis}:}{Yeo-Johnson power transformation, for non-negative \eqn{x}{x}, the Box-Cox transformation of \eqn{x + 1}{x + 1}; for negative \eqn{x}{x}, the Box-Cox transformation of \eqn{|x| + 1}{|x| + 1} with power \eqn{2 - p}{2 - p}.} \item{\code{probabilityAxis}:}{logit or probit transformation, logit \eqn{=\log [p/(1-p)]}{= log[p/(1 - p)]}, or probit \eqn{=\Phi^{-1}(p)}{= Phi^-1(p)}, where \eqn{\Phi^{-1}}{Phi^-1} is the standard-normal quantile function.} } These functions will try to place tick marks at reasonable locations, but producing a good-looking graph sometimes requires some fiddling with the \code{at} argument. } \value{ These functions are used for their side effects: to draw axes. } \author{John Fox \email{jfox@mcmaster.ca}} \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \seealso{\code{\link{basicPower}}, \code{\link{bcPower}}, \code{\link{yjPower}}, \code{\link{logit}}.} \examples{ UN <- na.omit(UN) par(mar=c(5, 4, 4, 4) + 0.1) # leave space on right with(UN, plot(log(gdp, 10), log(infant.mortality, 10))) basicPowerAxis(0, base=10, side="above", at=c(50, 200, 500, 2000, 5000, 20000), grid=TRUE, axis.title="GDP per capita") basicPowerAxis(0, base=10, side="right", at=c(5, 10, 20, 50, 100), grid=TRUE, axis.title="infant mortality rate per 1000") with(UN, plot(bcPower(gdp, 0), bcPower(infant.mortality, 0))) bcPowerAxis(0, side="above", grid=TRUE, axis.title="GDP per capita") bcPowerAxis(0, side="right", grid=TRUE, axis.title="infant mortality rate per 1000") with(UN, qqPlot(logit(infant.mortality/1000))) probabilityAxis() with(UN, qqPlot(qnorm(infant.mortality/1000))) probabilityAxis(at=c(.005, .01, .02, .04, .08, .16), scale="probit") } \keyword{aplot} car/man/Ornstein.Rd0000644000175100001440000000346211401002012013662 0ustar hornikusers\name{Ornstein} \alias{Ornstein} \docType{data} \title{Interlocking Directorates Among Major Canadian Firms} \description{ The \code{Ornstein} data frame has 248 rows and 4 columns. The observations are the 248 largest Canadian firms with publicly available information in the mid-1970s. The names of the firms were not available. } \format{ This data frame contains the following columns: \describe{ \item{assets}{ Assets in millions of dollars. } \item{sector}{ Industrial sector. A factor with levels: \code{AGR}, agriculture, food, light industry; \code{BNK}, banking; \code{CON}, construction; \code{FIN}, other financial; \code{HLD}, holding companies; \code{MAN}, heavy manufacturing; \code{MER}, merchandizing; \code{MIN}, mining, metals, etc.; \code{TRN}, transport; \code{WOD}, wood and paper. } \item{nation}{ Nation of control. A factor with levels: \code{CAN}, Canada; \code{OTH}, other foreign; \code{UK}, Britain; \code{US}, United States. } \item{interlocks}{ Number of interlocking director and executive positions shared with other major firms. } } } \source{ Ornstein, M. (1976) The boards and executives of the largest Canadian corporations. \emph{Canadian Journal of Sociology} \bold{1}, 411--437. Personal communication from M. Ornstein, Department of Sociology, York University. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \usage{ Ornstein } \keyword{datasets} car/man/Anscombe.Rd0000644000175100001440000000162211401002012013604 0ustar hornikusers\name{Anscombe} \alias{Anscombe} \docType{data} \title{U. S. State Public-School Expenditures} \description{ The \code{Anscombe} data frame has 51 rows and 4 columns. The observations are the U. S. states plus Washington, D. C. in 1970. } \format{ This data frame contains the following columns: \describe{ \item{education}{ Per-capita education expenditures, dollars. } \item{income}{ Per-capita income, dollars. } \item{young}{ Proportion under 18, per 1000. } \item{urban}{ Proportion urban, per 1000. } } } \source{ Anscombe, F. J. (1981) \emph{Computing in Statistical Science Through APL}. Springer-Verlag. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. } \usage{ Anscombe } \keyword{datasets} car/man/Wool.Rd0000644000175100001440000000207711401002012013002 0ustar hornikusers\name{Wool} \alias{Wool} \docType{data} \title{Wool data} \description{ This is a three-factor experiment with each factor at three levels, for a total of 27 runs. Samples of worsted yarn were with different levels of the three factors were given a cyclic load until the sample failed. The goal is to understand how cycles to failure depends on the factors. } \format{This data frame contains the following columns: \describe{ \item{len}{ length of specimen (250, 300, 350 mm) } \item{amp}{ amplitude of loading cycle (8, 9, 10 min) } \item{load}{ load (40, 45, 50g) } \item{cycles}{ number of cycles until failure } } } \source{ Box, G. E. P. and Cox, D. R. (1964). An analysis of transformations (with discussion). \emph{J. Royal Statist. Soc.}, B26, 211-46.} \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition. Wiley, Section 6.3. } \usage{ Wool } \keyword{datasets} car/man/Ericksen.Rd0000644000175100001440000000327711401002012013630 0ustar hornikusers\name{Ericksen} \alias{Ericksen} \docType{data} \title{The 1980 U.S. Census Undercount} \description{ The \code{Ericksen} data frame has 66 rows and 9 columns. The observations are 16 large cities, the remaining parts of the states in which these cities are located, and the other U. S. states. } \format{ This data frame contains the following columns: \describe{ \item{minority}{ Percentage black or Hispanic. } \item{crime}{ Rate of serious crimes per 1000 population. } \item{poverty}{ Percentage poor. } \item{language}{ Percentage having difficulty speaking or writing English. } \item{highschool}{ Percentage age 25 or older who had not finished highschool. } \item{housing}{ Percentage of housing in small, multiunit buildings. } \item{city}{A factor with levels: \code{city}, major city; \code{state}, state or state-remainder. } \item{conventional}{ Percentage of households counted by conventional personal enumeration. } \item{undercount}{ Preliminary estimate of percentage undercount. } } } \source{ Ericksen, E. P., Kadane, J. B. and Tukey, J. W. (1989) Adjusting the 1980 Census of Population and Housing. \emph{Journal of the American Statistical Association} \bold{84}, 927--944 [Tables 7 and 8]. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \usage{ Ericksen } \keyword{datasets} car/man/Ellipses.Rd0000644000175100001440000002261012074564170013666 0ustar hornikusers\name{Ellipses} \alias{ellipse} \alias{dataEllipse} \alias{confidenceEllipse} \alias{confidenceEllipse.default} \alias{confidenceEllipse.lm} \alias{confidenceEllipse.glm} \title{Ellipses, Data Ellipses, and Confidence Ellipses} \description{ These functions draw ellipses, including data ellipses, and confidence ellipses for linear, generalized linear, and possibly other models. } \usage{ ellipse(center, shape, radius, log="", center.pch=19, center.cex=1.5, segments=51, draw=TRUE, add=draw, xlab="", ylab="", col=palette()[2], lwd=2, fill=FALSE, fill.alpha=0.3, grid=TRUE, ...) dataEllipse(x, y, groups, group.labels = group.levels, ellipse.label, weights, log = "", levels = c(0.5, 0.95), center.pch = 19, center.cex = 1.5, draw = TRUE, plot.points = draw, add = !plot.points, segments = 51, robust = FALSE, xlab = deparse(substitute(x)), ylab = deparse(substitute(y)), col = if (missing(groups)) palette()[1:2] else palette()[1:length(group.levels)], pch = if (missing(groups)) 1 else seq(group.levels), lwd = 2, fill = FALSE, fill.alpha = 0.3, grid = TRUE, labels, id.method = "mahal", id.n = if (id.method[1] == "identify") Inf else 0, id.cex = 1, id.col = if (missing(groups)) palette()[1] else palette()(1:length(groups)), ...) confidenceEllipse(model, ...) \method{confidenceEllipse}{lm}(model, which.coef, L, levels=0.95, Scheffe=FALSE, dfn, center.pch=19, center.cex=1.5, segments=51, xlab, ylab, col=palette()[2], lwd=2, fill=FALSE, fill.alpha=0.3, draw=TRUE, add=!draw, ...) \method{confidenceEllipse}{glm}(model, chisq, ...) \method{confidenceEllipse}{default}(model, which.coef, L, levels=0.95, Scheffe=FALSE, dfn, center.pch=19, center.cex=1.5, segments=51, xlab, ylab, col=palette()[2], lwd=2, fill=FALSE, fill.alpha=0.3, draw=TRUE, add=!draw, ...) } \arguments{ \item{center}{2-element vector with coordinates of center of ellipse.} \item{shape}{\eqn{2\times 2}{2 * 2} shape (or covariance) matrix.} \item{radius}{radius of circle generating the ellipse.} \item{log}{when an ellipse is to be added to an existing plot, indicates whether computations were on logged values and to be plotted on logged axes; \code{"x"} if the x-axis is logged, \code{"y"} if the y-axis is logged, and \code{"xy"} or \code{"yx"} if both axes are logged. The default is \code{""}, indicating that neither axis is logged.} \item{center.pch}{character for plotting ellipse center; if \code{FALSE} or \code{NULL} the center point isn't plotted.} \item{center.cex}{relative size of character for plotting ellipse center.} \item{segments}{number of line-segments used to draw ellipse.} \item{draw}{if \code{TRUE} produce graphical output; if \code{FALSE}, only invisibly return coordinates of ellipse(s).} \item{add}{if \code{TRUE} add ellipse(s) to current plot.} \item{xlab}{label for horizontal axis.} \item{ylab}{label for vertical axis.} \item{x}{a numeric vector, or (if \code{y} is missing) a 2-column numeric matrix.} \item{y}{a numeric vector, of the same length as \code{x}.} \item{groups}{optional: a factor to divide the data into groups; a separate ellipse will be plotted for each group (level of the factor).} \item{group.labels}{labels to be plotted for the groups; by default, the levels of the \code{groups} factor.} \item{ellipse.label}{a label for the ellipse(s) or a vector of labels; if several ellipses are drawn and just one label is given, then that label will be repeated. The default is not to label the ellipses.} \item{weights}{a numeric vector of weights, of the same length as \code{x} and \code{y} to be used by \code{\link[stats]{cov.wt}} or \code{\link[MASS]{cov.trob}} in computing a weighted covariance matrix; if absent, weights of \code{1} are used.} \item{plot.points}{if \code{FALSE} data ellipses are drawn, but points are not plotted.} \item{levels}{draw elliptical contours at these (normal) probability or confidence levels.} \item{robust}{if \code{TRUE} use the \code{cov.trob} function in the \pkg{MASS} package to calculate the center and covariance matrix for the data ellipse.} \item{model}{a model object produced by \code{lm} or \code{glm}.} \item{which.coef}{2-element vector giving indices of coefficients to plot; if missing, the first two coefficients (disregarding the regression constant) will be selected.} \item{L}{As an alternative to selecting coefficients to plot, a transformation matrix can be specified to compute two linear combinations of the coefficients; if the \code{L} matrix is given, it takes precedence over the \code{which.coef} argument. \code{L} should have two rows and as many columns as there are coefficients. It can be given directly as a numeric matrix, or specified by a pair of character-valued expressions, in the same manner as for the \code{link{linearHypothesis}} function, but with no right-hand side.} \item{Scheffe}{if \code{TRUE} scale the ellipse so that its projections onto the axes give Scheffe confidence intervals for the coefficients.} \item{dfn}{``numerator'' degrees of freedom (or just degrees of freedom for a GLM) for drawing the confidence ellipse. Defaults to the number of coefficients in the model (disregarding the constant) if \code{Scheffe} is \code{TRUE}, or to \code{2} otherwise; selecting \code{dfn = 1} will draw the ``confidence-interval generating'' ellipse, with projections on the axes corresponding to individual confidence intervals with the stated level of coverage.} \item{chisq}{if \code{TRUE}, the confidence ellipse for the coefficients in a generalized linear model are based on the chisquare statistic, if \code{FALSE} on the $F$-statistic. This corresponds to using the default and linear-model methods respectively.} \item{col}{color for lines and ellipse center; the default is the \emph{second} entry in the current color palette (see \code{\link[grDevices]{palette}} and \code{\link[graphics]{par}}). For \code{dataEllipse}, two colors can be given, in which case the first is for plotted points and the second for lines and the ellipse center; if ellipses are plotted for \code{groups}, then this is a vector of colors for the groups.} \item{pch}{for \code{dataEllipse} this is the plotting character (default, symbol \code{1}, a hollow circle) to use for the points; if ellipses are plotted by \code{groups}, then this a vector of plotting characters, with consecutive symbols starting with \code{1} as the default.} \item{lwd}{line width; default is \code{2} (see \code{\link[graphics]{par}}).} \item{fill}{fill the ellipse with translucent color \code{col} (default, \code{FALSE})?} \item{fill.alpha}{transparency of fill (default = \code{0.3}).} \item{\dots}{other plotting parameters to be passed to \code{plot} and \code{line}.} \item{labels,id.method,id.n,id.cex,id.col}{Arguments for the labelling of points. The default is \code{id.n=0} for labeling no points. See \code{\link{showLabels}} for details of these arguments.} \item{grid}{If TRUE, the default, a light-gray background grid is put on the graph} } \details{ The ellipse is computed by suitably transforming a unit circle. \code{dataEllipse} superimposes the normal-probability contours over a scatterplot of the data. } \value{ These functions are mainly used for their side effect of producing plots. For greater flexibility (e.g., adding plot annotations), however, \code{ellipse} returns invisibly the (x, y) coordinates of the calculated ellipse. \code{dataEllipse} and \code{confidenceEllipse} return invisibly the coordinates of one or more ellipses, in the latter instance a list named by \code{levels}. } \references{ Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Monette, G. (1990) Geometry of multiple regression and 3D graphics. In Fox, J. and Long, J. S. (Eds.) \emph{Modern Methods of Data Analysis.} Sage. } \author{Georges Monette, John Fox \email{jfox@mcmaster.ca}, and Michael Friendly.} \seealso{\code{\link[MASS]{cov.trob}}, \code{\link[stats]{cov.wt}}, \code{\link{linearHypothesis}}.} \examples{ dataEllipse(Duncan$income, Duncan$education, levels=0.1*1:9, ellipse.label=0.1*1:9, lty=2, fill=TRUE, fill.alpha=0.1) confidenceEllipse(lm(prestige~income+education, data=Duncan), Scheffe=TRUE) confidenceEllipse(lm(prestige~income+education, data=Duncan), L=c("income + education", "income - education")) wts <- rep(1, nrow(Duncan)) wts[c(6, 16)] <- 0 # delete Minister, Conductor with(Duncan, { dataEllipse(income, prestige, levels=0.68) dataEllipse(income, prestige, levels=0.68, robust=TRUE, plot.points=FALSE, col="green3") dataEllipse(income, prestige, weights=wts, levels=0.68, plot.points=FALSE, col="brown") dataEllipse(income, prestige, weights=wts, robust=TRUE, levels=0.68, plot.points=FALSE, col="blue") }) with(Prestige, dataEllipse(income, education, type, id.n=2, pch=15:17, labels=rownames(Prestige), xlim=c(0, 25000), center.pch="+", group.labels=c("Blue Collar", "Professional", "White Collar"), ylim=c(5, 20), level=.95, fill=TRUE, fill.alpha=0.1)) } \keyword{hplot} \keyword{aplot} car/man/sigmaHat.Rd0000644000175100001440000000156312166631153013645 0ustar hornikusers\name{sigmaHat} \alias{sigmaHat} \alias{sigmaHat.default} \alias{sigmaHat.glm} \alias{sigmaHat.lm} \title{ Return the scale estimate for a regression model } \description{ This function provides a consistent method to return the estimated scale from a linear, generalized linear, nonlinear, or other model. } \usage{ sigmaHat(object) } \arguments{ \item{object}{A regression object of type lm, glm or nls} } \details{ For an lm or nls object, the returned quantity is the square root of the estimate of \eqn{\sigma}{sigma}. For a glm object, the returned quantity is the square root of the estimated dispersion parameter. } \value{ A nonnegative number } \author{Sanford Weisberg, \email{sandy@umn.edu} } \examples{ m1 <- lm(prestige ~ income + education, data=Duncan) sigmaHat(m1) } \keyword{ regression }% at least one, from doc/KEYWORDS car/man/avPlots.Rd0000644000175100001440000001230611576447475013555 0ustar hornikusers\name{avPlots} \alias{avPlots} \alias{avp} \alias{avPlot} \alias{avPlot.lm} \alias{avPlot.glm} \title{Added-Variable Plots} \description{ These functions construct added-variable (also called partial-regression) plots for linear and generalized linear models. } \usage{ avPlots(model, terms=~., intercept=FALSE, layout=NULL, ask, main, ...) avp(...) avPlot(model, ...) \method{avPlot}{lm}(model, variable, id.method = list(abs(residuals(model, type="pearson")), "x"), labels, id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], col = palette()[1], col.lines = palette()[2], xlab, ylab, pch = 1, lwd = 2, main=paste("Added-Variable Plot:", variable), grid=TRUE, ellipse=FALSE, ellipse.args=NULL, ...) \method{avPlot}{glm}(model, variable, id.method = list(abs(residuals(model, type="pearson")), "x"), labels, id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], col = palette()[1], col.lines = palette()[2], xlab, ylab, pch = 1, lwd = 2, type=c("Wang", "Weisberg"), main=paste("Added-Variable Plot:", variable), grid=TRUE, ellipse=FALSE, ellipse.args=NULL, ...) } \arguments{ \item{model}{model object produced by \code{lm} or \code{glm}. } \item{terms}{ A one-sided formula that specifies a subset of the predictors. One added-variable plot is drawn for each term. For example, the specification \code{terms = ~.-X3} would plot against all terms except for \code{X3}. If this argument is a quoted name of one of the terms, the added-variable plot is drawn for that term only. } \item{intercept}{Include the intercept in the plots; default is \code{FALSE}.} \item{variable}{A quoted string giving the name of a regressor in the model matrix for the horizontal axis } \item{layout}{ If set to a value like \code{c(1, 1)} or \code{c(4, 3)}, the layout of the graph will have this many rows and columns. If not set, the program will select an appropriate layout. If the number of graphs exceed nine, you must select the layout yourself, or you will get a maximum of nine per page. If \code{layout=NA}, the function does not set the layout and the user can use the \code{par} function to control the layout, for example to have plots from two models in the same graphics window. } \item{main}{The title of the plot; if missing, one will be supplied. } \item{ask}{If \code{TRUE}, ask the user before drawing the next plot; if \code{FALSE} don't ask. } \item{\dots}{\code{avPlots} passes these arguments to \code{avPlot}. \code{avPlot} passes them to \code{plot}. } \item{id.method,labels,id.n,id.cex,id.col}{Arguments for the labelling of points. The default is \code{id.n=0} for labeling no points. See \code{\link{showLabels}} for details of these arguments. } \item{col}{color for points; the default is the \emph{second} entry in the current color palette (see \code{\link[grDevices]{palette}} and \code{\link[graphics]{par}}).} \item{col.lines}{color for the fitted line.} \item{pch}{plotting character for points; default is \code{1} (a circle, see \code{\link[graphics]{par}}).} \item{lwd}{line width; default is \code{2} (see \code{\link[graphics]{par}}).} \item{xlab}{x-axis label. If omitted a label will be constructed.} \item{ylab}{y-axis label. If omitted a label will be constructed.} \item{type}{if \code{"Wang"} use the method of Wang (1985); if \code{"Weisberg"} use the method in the Arc software associated with Cook and Weisberg (1999).} \item{grid}{If \code{TRUE}, the default, a light-gray background grid is put on the graph.} \item{ellipse}{If \code{TRUE}, plot a concentration ellipse; default is \code{FALSE}.} \item{ellipse.args}{Arguments to pass to the \code{link{dataEllipse}} function, in the form of a list with named elements; e.g., \code{ellipse.args=list(robust=TRUE))} will cause the ellipse to be plotted using a robust covariance-matrix.} } \details{ The function intended for direct use is \code{avPlots} (for which \code{avp} is an abbreviation). } \value{ These functions are used for their side effect id producing plots, but also invisibly return the coordinates of the plotted points. } \references{ Cook, R. D. and Weisberg, S. (1999) \emph{Applied Regression, Including Computing and Graphics.} Wiley. Fox, J. (2008) \emph{Applied Regression Analysis and Generalized Linear Models}, Second Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Wang, P C. (1985) Adding a variable in generalized linear models. \emph{Technometrics} \bold{27}, 273--276. Weisberg, S. (2005) \emph{Applied Linear Regression}, Third Edition, Wiley. } \author{John Fox \email{jfox@mcmaster.ca}, Sanford Weisberg \email{sandy@umn.edu}} \seealso{\code{\link{residualPlots}}, \code{\link{crPlots}}, \code{\link{ceresPlots}}, \code{link{dataEllipse}} % \code{\link{leveragePlots}} } \examples{ avPlots(lm(prestige~income+education+type, data=Duncan)) avPlots(glm(partic != "not.work" ~ hincome + children, data=Womenlf, family=binomial)) } \keyword{hplot} \keyword{regression} car/man/DavisThin.Rd0000644000175100001440000000224511401002012013750 0ustar hornikusers\name{DavisThin} \alias{DavisThin} \docType{data} \title{Davis's Data on Drive for Thinness} \usage{DavisThin} \description{ The \code{DavisThin} data frame has 191 rows and 7 columns. This is part of a larger dataset for a study of eating disorders. The seven variables in the data frame comprise a "drive for thinness" scale, to be formed by summing the items. } \format{ This data frame contains the following columns: \describe{ \item{DT1}{a numeric vector} \item{DT2}{a numeric vector} \item{DT3}{a numeric vector} \item{DT4}{a numeric vector} \item{DT5}{a numeric vector} \item{DT6}{a numeric vector} \item{DT7}{a numeric vector} } } \source{ Davis, C., G. Claridge, and D. Cerullo (1997) Personality factors predisposing to weight preoccupation: A continuum approach to the association between eating disorders and personality disorders. \emph{Journal of Psychiatric Research} \bold{31}, 467--480. [personal communication from the authors.] } \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. } \keyword{datasets}