car/0000755000175100001440000000000013020235426011032 5ustar hornikuserscar/inst/0000755000175100001440000000000013017662407012020 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/0000755000175100001440000000000013017662407012565 5ustar hornikuserscar/inst/doc/embedding.R0000644000175100001440000001420613017662407014631 0ustar hornikusers### R code from vignette source 'embedding.Rnw' ################################################### ### code chunk number 1: embedding.Rnw:11-12 ################################################### options(width=80, digits=4, useFancyQuotes=FALSE, prompt=" ", continue=" ") ################################################### ### code chunk number 2: embedding.Rnw:28-31 ################################################### library(car) m1 <- lm(time ~ t1 + t2, Transact) deltaMethod(m1, "t1/(t2 + 2)") ################################################### ### code chunk number 3: embedding.Rnw:34-39 ################################################### 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:44-51 ################################################### 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:63-65 ################################################### x <- 10 f1(m1) ################################################### ### code chunk number 6: embedding.Rnw:71-79 ################################################### 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:85-87 ################################################### m2 <- lm(prestige ~ education, Prestige) ncvTest(m2, ~ income) ################################################### ### code chunk number 8: embedding.Rnw:90-95 (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:103-114 ################################################### 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:119-127 (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:130-138 (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:144-147 ################################################### m1 <- lm(time ~ t1 + t2, Transact) b1 <- Boot(m1, R=999) summary(b1) ################################################### ### code chunk number 13: embedding.Rnw:150-151 ################################################### confint(b1) ################################################### ### code chunk number 14: embedding.Rnw:155-156 (eval = FALSE) ################################################### ## .carEnv <- new.env(parent=emptyenv()) ################################################### ### code chunk number 15: embedding.Rnw:159-160 ################################################### car:::.carEnv ################################################### ### code chunk number 16: embedding.Rnw:163-206 (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.pdf0000644000175100001440000067770413017662407015223 0ustar hornikusers%PDF-1.5 % 3 0 obj << /Length 2344 /Filter /FlateDecode >> stream xڽn_Ah!a hmmڋ<$yeVV6$Ssr(ʛ-Pp̹f˯t.\v}i)Buleջ~Wܯts2x `u'p3V҄ GFaGE`8/1ʀ7T Gi&̏aߞqyT=Jk/q? :h "ٹڨPT0(lU)]WKbAkSޯX=+06IYI$% GH5 As+>3V; g}8aMPi9b1qݚllX=4 h@Ñ5ϵC C5 KTBK! , Ran'n•=mOQ8!ԉv sI4 aM8er8qGCfHD|f\[\iEb]3 F׶KgTe*+FlXw8'{k0Sڐ⵶$o ^ngIvGcl5'iMť' ^X\Gڻ!"'}`g}djTp&By>+x.1|1ߊ1#J/1eh ה1j}r;|3N䠑 [=W$SćIO:(?Ψo>o4] m~~SJDXZ*@gf~D i>%!oID;H"G j4[BOŢ0% );deMOOXsq8P'_EpL z L-N.:An3;SڀXS1=3N:g&  1'#;į$NG vA!<~lCw'ܲV(8B%dž1ܶ\1- -Le.W@y 3yaXEk[**H@.rOq71. s*"3Pn3;\=KL4p;vH j~Q~5 @Yz;h"ig $,A\E/ϡiʕC=vHI G+S"<WK^5֗\(;Ny>BD\ԘG%jQ0k `ձQdzl"'[G2CTx4&ɴHy?_F!ƦS._( F#_g^7qHtn慺N{/\_tޜg:֪x^:۶g΢l'm+>kw)Kn\W1tw/o4C|i px%]sҭx`c6^5'`c>ǷHnf-ccUexH?$_m6392wgH}5p-]~;4#j&vfR>?r,OdS/ɥZ?IO endstream endobj 25 0 obj << /Length 1780 /Filter /FlateDecode >> stream xXKsEWXUk)@9 8)a-e[؁_3}86H3_?{>{UjU]tU]YKeffsa`l`\h佝/L'x>/t ol90SW~?vnZ^x >v8\aZG_+[ ,iYFW}5G 4HK j  v#aO sчc A悤/U2lɰcp ]d`W O=$yz2mVū* @l21 /TYfJ S7$Y 1"n.K "֏D딫 %v@v c c9g ַ-FqVT*7:|G1CD $$^8}2AL `U}@ 7砻H WD c|ӡn kMāeʺKцI\Ԫ4c_fI9kZE?Ə"Y2/I#G~ǟa|G#^ۆYe/WE iG>e(b.gV\鄩2b˃|/sd]>K cH? oNH>oG+B5l=04yzM9δc䔂UKB*jՑM+>t#fzi)u"^_'ZذYVE] i!Ń~b J~]>sojϕ=2rX]{)y*eD) *z>גr@be|TFi7TGf@%l-e@#rdzC&C,h@*9}b`Z5~jw: mݏ!J秇+T]qُI' I>+MZ۠Oau H=Ft6 ѱvdO&P^8éYIDwxy&Uebv*'sae@Zs nB $&9~z(Ye[έ\dʋTHX%;9a8+G> TCS E8tPC'$wftۉFt,rh?2`LZ3v4 u \|OOi*{MPDxۨd$HdXnD]#eTK&ðq# D%]Y\w&g8]tm"WDpYf EDћpZxuT<.8CVUZ?_VˎDR Vte*& IT߭Kc:Aք|ʾY*;UPRO8wa{z'lb3Iz#P0uɅJv?1 zݞovX#TQnCU/H]&Oz]”Tʕ&U3ɤO#jHc6,J)5*ucZQÇTkp32CGPAzዂccIp[/vR.> stream xYYo7~ϯWP?ph Fam:Ivo\%wWh֤p83ߐɋWTm>9_LLVY&/LNfu/;] _us%|{!A[6)U4$\ EGC)qsϓHvjUv23FUo%=J6p+Ye {\Az&#դ+/ezȚ{;3^G4"^#ol1sʼKѝtReʎЦ %d:r2(c,s8vr-,jݜln蟝̌ISeϸ`ϰVYS9t&+'-G2LF5OU^,hmlv\IG*/QRGJ\fWR=<ۤMtE PҧJqhi4T)Ś%FEN-y0 W9=1)[/L ys&~./ F嬀#i^hf˞iV5nۀ]{t },q!ȃgbwFVmP|-w<\v.n#E/ۆTٲhgȍ_}MQm{ZKrGnJ,>?9m p綻G2u!I0s#Oy˺(TrE>ުJBGxe*C.ʐPܶ#w2[wT궞.\¼w^*vFDt{44 ܉2ٿ6uFT1mAcudM5! =x'R9i\*4طӫBDL> 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 2181 /Filter /FlateDecode >> stream xڥێ}P"ft]$ M4<OKF#yEQs7~ F5כV:,+czJ/0ngW緟|mvvQ @`aal&mR Pv:xHy kwA-:5N2a\ZBx1{*5`9^3Mjor;}BŌW mXeUeȦN U:> !uǖZ|/!W[Md y.q82A8TB6f|NQP[aeάcѹ5_ٮP_zvL*?Zq~r5Ҋvp{`=[`JmStܒS?G<-E EÒD?<ޡ60u` >2&q#v// #r~kQ/qE$96C%ET&*J^e&DL]ͤ,*5Ħ3ke4,@؊x%}?V~&ku<< ♧|j] ?i掑v}R7պTHE9iG 7C/b3wtCPOG z,@XKsVxF0VD,I< BO wV31tFܣ̍]~G;)R$F8lbX5z(׸kl?" 0lK) QL}ʫP@v IzjEy L$ `-.?7%@kUMT? /ѣr(t8DgPe+p2 dTl$qkwޮJ`gn&ԺI<8BĈ @L{-_S6H3QR@qG :%*#/9:s ˱^\ٙDE8|S o=sojA3^%"H:P]g!S!"՚Zc+=Uj[E nAa喅XT*MUpnf:cXф/< HE0f0@Bʆ0j @ 9;Y7[ňQrD:; S8Cȓ NU[at{P%M!$Thr)i$t{0Ec'"qf^[8~< & 9RyHONE/zQnR)꿜ؾJdb. gy4<f`.@*)L֟A`lɬ3Yz8 ≮=~1klOkZU b/)I%=z〆 cp5cL CC-X#ru=1d*bQ\;^^E+'s"IÐ-ޱcdeԃ+)d'-T9DcBuZj^l_kS\k"fO*m^}":m]V6r\kheܴ ǟT]d Z~p-cUe3w@1;@eT!3_ya(TmT~y3 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 737 /Filter /FlateDecode >> stream xڍTr +tD3 0f{C3Ȳ&5I]V&,{f˅Ӊ*)`\me88;dNeIصU CX]].|dp<ɴ>qϴm}>LżlSg )Q1MX!a%(qfaM=#,OJB=4e"!Z:ɰb:2}rTCU ZQaL),Wnk7F<$T5( w8BH* `\*ZE `<@K5 rCN™*WybFSmL['aw(NjQ,vqڑr g5*7׌댕G{\.tQn(]<2wXO~J ̧ غaEd/ fYQhu9Z r#qvU/ <mǾ51BJ7*WVBVOd0Ff;5 L8 טW3#},2›07!VdK=t'`m (q!sI =bݶ *#`Sr@I] }P\q{|dwcq> stream xڍtT\5t34HЂt0330 - %JK "ݡtw( "Ok}ߚffϹw߻`痃"m`H_P$ PД7@ >+aC`(``ML!j"5w'0@PLRP\@(I"h Ԑ>G߬_7 (!! C!`@9߬;8 Rh$)vv@dxp=@Cy_Z`g؟9p?H['7U5.0d?|? ( w?5#~!  GlN0 #`'7M= w~o Po N49f%T COAn:"߿-%4D]arnB`h(\0/=.I_ .H ?v(w&P8 t l7{@7~}gq0(M)祿< /*  KEAZU- vo-{?^Z$ | _]Wݝ~ ?y3Oƍs7SSa< 9U4fvN#M?Gנ90+w3]ǛƓSJkʄD` (Wf0.HM F?u@_HBoA o(rSzGZD7FQ7hOo/wf{F_y 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 1448 /Length2 6897 /Length3 0 /Length 7874 /Filter /FlateDecode >> stream xڍw4]6тDFeFE] 3 w;E'z zD I>}^ksvgƬ#AZAW>^8@ASH  @ll0W8/1(D vEh;M$ DA ?$/C$JvA5$BtBl\k pv9BQ0k0 v:wzHk!8$\]ā@^ /e+ t.P;U0@ S/@Gq"\n@oS|` Bs{e{m|J54To<#$ Ą"?haWaݦe8N?ci!Ѭ8&Hd?Sῢo$jG v2@=H ghpT]1CD2 цZPm ץK,k&o=7R a0~!a{>|I@=SE ].tq~$y rDV#1߈ODDq( Bo6K}7@PkDgrt<_F&پr̡.^rVe<[BȽ|Mq,vs^xKN_Z fǨ?l1nt}Ռ١Ɩ&JG~ѫYW:?6EgJXt' ,x-*s>+dS'dn^p ,??^,we5a:&gFѧ(N-,ȆbQ,X1'Y{oOJuV}eӐԊO{OӾ;xOH"PռƁD{V L_nM, Z0U}>Gډ*J{WEP"rt8Ho5:!ֹ{DC%ڗ3Fzu9$3 goM:iEMΚvkM8@uРV45rS@k|U/S*:;# zr=/Ea,a&QP[ Q-z{'?_짷OvRe20){`ȶVRqU,G&?|ׅ2;΅(UG$'Ho ۷4Iy_SJi}WRE"}&:g{ѠQ(m߁Ҿl-~ҙ [#CqEǹ5,ɉ&簃#qA"iۤP5H"Ԓq*H{ lJ|,@H;QrѨ:pe=` ʐO鑔Ҹr[]`#F-vR-uNj%cOlZFYIore utl7aE݅܊4(rT'*OyF\MǍh{bUt*'SP$Ҫ âF sC-KEDQld>ߚq Ȕd=QӥoqQL^ E8uEpoઽYZD [F5:%3N LwB>lN/^5Y@>?(-+u ˜!ieaQ>(nadb&n~X\!Y66O,%Wχ^drz <_86X?ר뙨aB"?]-;}LD;Z41s93EZ2&(|M=MwkpBBum .ّc)F=U|!xsy2;oBr/Ec2R(]x0 ET#h"J, Fլ=wM`\'DsAƮ8 ^:r!J,<`b_ta Ӧ!S'Bn% ^3Z: 1kyrvIOVKtᶘC'ƷbӨ)5moalW'͎g[%I^ߍ"XYS];*lӁlMc{ yZte>>KRzJ%6Ke!1׋5C@noG%d cM)ڪzOxGmG^KS9E׸ne1#(>)M1aFclkqtGj>S?ۜc9}dJw8Čթslc8m2G,=ih<,k‰PMB5QFC=y qn=X lM&=am;pbō'Rzǥc8`p+e"a/SV}7Y'AlOgQf3}WN,gӥډOwlݡ{^w΄3w 5,#ɡ|docjT@ jwֶٌ_-{ЈQ {E͇@/,?^lUme7-ݳ.i<.R_R)*y3sK#&<4Cԩh=(ҌQ~w|n)6+ZeqgGvKN֫oK_}V=US;3ͯO9V x.Q< L\?!BuwJu9x"/8ڷҥG6 awpاzuq75x#>ty܍Է鬀1ZT.s{ƏuDd"9>8$NŨb4.f[c$f^|>ը>om햴C #.FJLod)p53áB xM9EqD'WO+*HɅ&U5aoW7UvX}I@YߊOVdG=U͵T1џ>58'՗mA_1j'+*%HTnGWcQitdx3g<|[za4Ve. &-ci%z[K0dqu7P(?_QQىq;-c!6ƥk%vt|PK-3~*oLHYvȏ.:e _^{NM' tDj|X.o庥p>6TMJ>=`h3]Bd 3l. _32<8,Nܽ"w1O%?],Ȼ%w8oIXaBzI$pdjMwOɛJ %}{Yz4(M0(&=Ϫ>:GXu'dzYeD]I~5qxFP,LS;k)<,E M4~QbC5YHHM+4Ť@{ޗy(E͍> ǯ SviQneU!EzCBS7. 8q$.H'l#[UV.(;tDpn,U*휟GI$JZ#>0kSCD9-{FG-g3o&z:GG dֺP?91p!eK|73x8TwٻSghtmF ri uVK'psw`p475U^/KuG1{D*cw-Bɤȳ_J#e}ɽ+9v6b3' &'OHEשUS=Qm~0 .qܺlk7"Q +$<0{22CM|fzԪ,KdT.BZa61ŶkŋȻvϘԩ*B*}sFWlJbZ01)'stil bxLQe 2⬰8LTEZ4If]Lx= '^1D,/>q*׈=ۇ> L1((|^<8uyZŴp+~Żi|':t"sl\>ZCX994 K9#H{q|[L9(*qgR8ÃNB<c=7]*Cv2+j2c=qs,uGv7ojpY8My/TXŀcq̈́OLGZyyl [Lr9 dJ{8%df4mqB>fUAbX]:_+OS6\8|o"+I]z57n-ca^[fcG(-pJ醥WGWECrҥ \ eGrHrp.^.4I 75/`9]0) .D,kU~9Ei19 nz}:/#~6nLnu`szMT~N(|ǮԘlOai_CYZApMƑ84@4D&z|,x40X3"ɾШ~^Py3] PhBuz}3!ٮ (}DBOG%5t-,^ Pft,C!11]+'2Wl4y!yƓl4p~-e){F+}=ۼՂo/:=:x1=5cV^s(T\Q3GKԳD;_(vH&s(QӓUQē(N>MS e08+g~Yb1.wDZa/PIFԁٶx)dM/o䲕P␁ ;;N:JP?c@3J$ eM5U/ʤI[% kL0ev8fƏ='ER2-j~V &qa.E`J+ɉmgisd\eA!o8Z,|f4rIgMEMx;l3 8QpMNNC* ۉ/\ HZ2ʜY!fM?4hK`ZqG]ʻ#K^F=['L#] W+7(}1s9E͓Wdw@.ysazNԤ:wI57\]vS19` Cr6K\~;O\Q!*|᷼U=;W3@Vm<`ȅL0$@a@V^t4u*/b<}y PĨy$=)wkz;cU""IX\3Zizi.~xNY6-,avFnGMdIqShÂ:٨Ht`خ?K{8fOc@@v&"Ɠ]tDӔR Rm\!_MOӍf쥍v^yF?,duФ+xnO56>(0=#k҅cb=J*[8% endstream endobj 72 0 obj << /Length1 1414 /Length2 6187 /Length3 0 /Length 7154 /Filter /FlateDecode >> stream xڍwT6 E -(p$4W 5 ! I^ޛtA* JWJ"rZ߷Vg3{?ϻp3PGA`j($N$(j PD&4䜦0 BJB>0E!Z$.+@ɿ(@ PHSp}^<]_EW#`#p%ep8 +8<8'! ø?G]aF$;F(8S a~w@ C$W?? P( Fz8Wy`O E`8 ~) ̇bhV GQg1"Q0$K?8şПuA<>[p1Lp0M?>G +"!`P'{an ~>hw}`wy?-r`#Ix7᷍ ` keg= 7 i**kh_A%%'G@D ,?HgBx,S7ӭb@( V_=@ ~Ź8S/]^ ~kWfQM/E# QAo?߃NioSp8v|ೀUu?Fxnx~]O?PEBQ?',&c0`/r-1/S{/v(>h0@Áz9A!,u^ _$7K0' Jau m;VdX!N?2.!.&dOk?U RqSr;ʝYc=`S[sdO^\O9d=IL,UUCp%LޱLjڮI\tejw;˲u%M|2ĵ@W(d)**M/L1yGB@ u7˘ -o8jU~f+U3䕺of@i6{8-lZs'wuKv}>fF)c W?F5%bM2*>hEi{Mw,xi7_7Q|_8wpֿSUy6B z993af–Nmr%3""&ׅ>])8=/moWvAz/f=> f*{{.Vy.Z*\ž.LQ?EIrltD1FݮZNoOPd/M/@ܽ,(dl0G&~zhx_AriZ3C^~veI0 N~^ 3YO|ۦג3V4j[lٛ{"LveY۲]@.P7)1͟^i1p1'xgu_ \Ĺm/bLCn_oǜm_k@+Cˮt -ZOvNq!PK.sZs^GNFMa\~4s ItҖ !m4]`)Tz&$xed)=NJ}%&{L1&jDAKL3s;|DŬVxV9~E)70Qwbfmz9Ӱ?_by~N5X6IDeh77JۋS~_:q~;3)*k.Ec=r`^ (NeX+Ln0A6ráQ曳c.͈9N=Wk %.`[3o|ޢCG=Ujs 5'Jgt+|vz8}?j#slQ<5 ֲM.CպkuyAH;nNՑdpFc)^7id)6m!TW䴆-ȍ W=QvEͯ9?޴D/*M}C`z7no1b O f RiQd_%] ]_%'ߓ1jDWQ;hZ afpI`m`})&~ TH{( f2To3\ /^ndȓX쵮mq!N1sDOϚ__ ) ~SIL0QBP(:T>`rn+P)wt@h "OKlM⮡͛/^T{&@%7եxq6kk̬œm_S[:iH9 ad*Dqqhoߢ(Hg$\?ξl߮'}{9ßd$=vvQYz`޻+[T}vvRB7 = 87)=gzۨ4 3r/M\ٻх プ+60)]hq+ zP޸=p̚!Dx>@u/] *y\ԾO:q|X]J?Lηs4;CiF+͹"rܼ < ta?Sΐ \l;,_gDWem9qjI@67lI?~$Ey$+ɱ{&GoxIr= V.6x=pԬGP8LFP4Zn,WG>u0\,jٱHU Vu\>W}vɁqh0UxgޫGzT $. /5TeBJ#1Nk[_g+\+qcIVF>}pbb@#ibz&#<Էxu﹑ WpyC3T*5C)lq.sY9,jeWf޺D]}P=sVq[8]M_Ya}kFʽ"#]\=t2AsXKR8XFϨ/+twBRbZ5,&~.u.V-l=ۑc^Kֱ|/ERSĥ\AmwMV{B^xU)+o7c!La9+9i'da-.xrHQd"׃Ec2_S->@B|C҆ (aUXi65Lbln ZUc 'w^JCU%Ugu9\zIMk^1B,Mwdo'K Hd )y-ȗ"Xee]V-Au r_~DP |z@-4}R5*N'Bb6vl]g Z ,U?Pֳ8fً$3Q}ɕpE!V^6/?9X\4YizIB>L> 8fˇ{^*:IĀ/R}=x5(+`/B@P+}[_QkKWOcB$$a(G[)|Cw51ܱ-!Ɨ>LٛcOR5քػ﮸y.zR dG^ίڢe1WVNtr\'3u1ɥs̰P eHO{R#Nf.fB d2RsI B抄lBUe&BDHwqd_U,^ ar^R TCu._罹&̾`9~wB~`Rl|tdžl3)/PgwGz;)$n4hv:m*y\wYᥗ2CG4=@DvuiAyh41/#5Ɛ4u(guDTI\]tIzKtZKFvW 3Ke h4inglo?E;c7vt,2KOtb"d]S82ғx\HyR9qC4*)0}M.ZRw?O:~"'}bon.dq9洞S4/$e8G9wV. s}tj[n{^d0'i}?&1ٔ̅W"YHy][ <r\zt'D(ˋZjwoX{5+u6rt)9 n@>zWe[T%GDWևKhx))ךqZ׬T+*u;Ѥ*Re1aOztfYEY:ίt: pdUy:M2fc]q>DȾqӫ:[$#zT M=A݉ӘʷY\o SW||69,crZhQ ˜a1o\[Ȗpu@ucު* 8Hdא֓B]-II_Y\yGSU"=g֝b"XObUz~}l">9]Z5o;KL]~c[ 3{hx3A[tEE@tHgʍ3wlVK"܂ endstream endobj 74 0 obj << /Length1 1385 /Length2 6008 /Length3 0 /Length 6963 /Filter /FlateDecode >> stream xڍtT.)t 3t7Hw 03 !HIJ# !! HHI419߹w{׬ͷ~~~|H $ZZjH  (g_7G"$@A}JD=`AXD,*@ %PG"`@E;>_(',..; sC!sA8 P8 R(?7Ńn/0k`6g2> oCyCa!<[;}8@M Ck wٿ !P(#vpg@GE@g$:;ClЀߝC*zzy@(>A߲2VC<~wAgN7aGӕw)]Pa@7u"]v!`p;=a;O ¡(  OufF/0~M/[$?Wynbg>^0W@EQK?B'U aAE_ӿ:K6Z?$ So UEnHwwC\ξhzBeo h`pO h!#d *p.uC?~_Rs#`Ho : Z_P'?!Zlkerg(Eww/zhKF ~>Ng! ~ ;.}o:[0 J07J9ֆV{I [z'$dekU,;N_-1 2|gI9JOT=yVbЖZ>&JCP&xBq>)5ے/v*_\\7K]^ PWFW=Vԏ>1ems;8{N:u so fo4Doȼ-[9ؕoxIC{+CS?ë"&Δ{m<}R=V)i{UOG^%:MEt%?PJ-wE%J'w)Wͩ[ Q=T[ᮡ ZpbِMaAiO<yDKۄ?ڴs[9Cױ/9mL=.W &{CIdžu>pzo$ 8\;1)){u"R,bnǍRC% no,lhcfVDQ6P̞A'ໟ'F sIW7r_--7c BGi1?%caz ;0 sYk/]$Hs]; >, Od Ixqq-;59*FoVEBDV /Cq=/,[ QEW&smљPh+~ W 2ul'oZ[2G.5NF k'VU|5=Rcgvu~JܺbrM}u<[kENiPQUV8[j:+7: N 3b~֯(>%7Lݿ8ΧoG%%/(LA}~٣ {q#?, }vם&3WwUvEX?s8m%ZYiH )ݨ(-?Xc|5] YNq/;o'2ѩ rMɗm1 vmڟE*[ UX(:G6;wMQ >.uhpU8N~w9½𩀧Š&RB B#GgDҼ) "ez'GʁJUT Y#r:^jߚɢЭzM -Lz8kҝ8$DŽQXeF1;mfXATSxGZҊ5N $A!eQ\:Vɀ"O?+y<ӾMḸX^~Х ѢS5kr9_"P7ww"zC:ƒ`M]FXiJ&8_)P$͸Ѐ+cuuu^)")Lln}>aQyS,aټiRoEݦ1s^".6U$cx fwsh&бJ 'uFa_!TWzȔl8tU]2J(¤=gP'd+=%M";Oq?ۅA ՜uyqhj\r$'j7ynd99(C@m8.qdCBzV*F^q+Req2N#HOKU@J{ }cG81OFzJx_<ؽ.# eۈr-N8yF?VT,FQ"-Ug|䅳- {2v1ΨxU'MG=I_J9D+lQ!j*#ol0VN@=T^,'"wbNbTCgE3Ug"Iaf>#kv dN1,׬Ck0Heb[ ^tnNq˦wmM;{zVBXPCn9{Ew1^>xn^2wKyEGL[U_RFJo^rhK@urCB~$_YhyB@ ji12*O]u?7(vf)a)+ /Vw`v$:iRazp>}L{o(0HX)dE(ajS#Է?ϩ{w& @m6^C.Z9[vWR0[OYe7{[`3dok-1)qyˮ+IsuzF֖qnMiqT[?j-5c*BQ,VsK|_+:"I Ħ cD 4kVJ\^d}*KFLMCy's5f*]\=^[E0#?|~띅m˶ΠTDKx 7zlFT ?J̻Ꙁh_o<;Ԟz[@})lӠ9aj/;; $~`YÉb@J&6:^ށfKb:v"-q>HX emK42uڐ<0L.Nm"Q|pE(џGx:p6[{pTn !=W3mרV0~ia?`ܶ8 &LspGAs -t 帴,}$a?*[xat7ǖӂykmdj&8ZjN>;Sa/us󦍳I$HQ :@Q]5]{Ffnakq &Rv7:#2q{̽2UQY+$JX'8( Twb2(8:g(̜Kzַk0K_bq R_m%z:v_㉨[tS ]F-/kXFasI=nXswcلhWqY:be#gڃ&3شkScof 60tv rL@՘d!rOm3buXg嗝sD]j =G#̸(N;/7,R ά◸6utnoc|Q;65$9p|Uʃ{ 4iō$@J͘{nOo$=yyq!<'|\MJx7|'7h{xeEC[x6r+]pafL38VW.SC,37<,+{ );ڔ6":8gY$R\(TH^␁P5:#ל7f.,,њ֋:E20 Qy!!7%ڣT4-NPgѡbElj[r察pH 5=9ҵ>W-;Լ-_RY=jzvtrvM1  (\F÷SBw@OXaw͍ޢyz)|b^"x $7=Po(skdv( -lӞ7$saRas<)$RxUa~^nXфq 8`{q/~\{ke,TN5b9>Zaëd,pB,4r%A,X bmQx2S`Af$稔Ղ]$c%>e5'sDa$ yRuncpOKWғ8W$ \wAL3ҵV_~kCg^ΗGh ULvJVZ@؉L)yE2ixE/QuΝit\Lޤ`+nc4ç% sTTRg"#{z"_.4ɾ TRexOZl{\)=~,'+,Jt fIa%#xJ'*_[_J9~p~9mizbs7~r(ec9ƊGK@k*2)hm.K/e19adxwx`EAН'TSe ycCgq~xz2O >|g~z&f9OaxAf̾ ڜ1ƈuNե Q~B+ׄe!kY.^vntWESx[0gCPZtjB:>֠Qd>ȤԼ7S&FΫg41.dk2+*5խޒTr7;('iUϡ丸(GzS#L㻠-mқw $Ig泷1fɑKD߅1S{b endstream endobj 76 0 obj << /Length1 2301 /Length2 19700 /Length3 0 /Length 21056 /Filter /FlateDecode >> stream xڌP\. 5ww >Xpw'KpwwwKN{kNS'л/p|@MH[Lz-JK`69NI/Firaaoa۳d*BN$V Q*G;%E(e{=?/uV`RC )j$E2$ޏth| Q={HȘrR/c^A1N2? J;;$n"%$u%T*EiZ[99Ci#} `]?<% ia[n2l)Kۚclrf LJ-{K&_ ?Hc n\f(?mG|Q9vJi,#ܘ;$37.B|eG"c Q) Slf=mEOY &gu@'IaTǃ,!31c(NYM-w@&k^Ѐ% K rWZEQyO~a(-a#17Mm +OIf[P:1.wP8zcj!h*fV (rϼGھ,{=49b_FZoLsI+8M᪎bUfbi0}(@7 u_--Sd>PS]j FAF/gO0k*#? 4qCTlAZN%1)M7ҒҴ3mp,bx6qvXgހM}{N-`$482-,g?g@& s$E=bh^vH[8'7 e)%+x||4h| ΐSPڔe6~ݝ|-Į?eG64;9#a:^0WDl+8+ÕvK*Yб8 VpA-Gy9*=T"&yr:kn#讲ad4%n^P "Y6`L1p92\;Ҟm/>\^y NR شTg@0%9 ࢫ3|[XDԹ[BL#L90(&f^+9up0CX춐 l\Lt%x4oNL5 Buh>8fKi)xlٻ|}Y ۽Ő|uQ¢jf?{(l~lM{G demU>ъp.#B>_R瑋;p@,c⏔KH^d醸G>â~Qw"mK*14A *ckqb|`bB؇sˈ]9^n2J\4gTR܉}^Ӏ^SM;gkR^fO11pUiiYTp:~p-E1T Ekbjv! geS٘uR&̲AWJ%z2uL6"uB~w:9Bwi /)k]G^ا29 rUzݟBНeW~2'{c[ 9$`v]_YkC~HnXt;&P=uDX8V9{k C@S$crIJ>v(FTK $&ZzZ~7B'Mj!,fZ` [wkpZ!$.:/"qk * ̀H.;,'NLs"a?hCZ]8+]73Spa8U]'|A*}inSBtD9q,Ԉ]ؖSE΁,ޔg " _|k4NܡїX3&eȃk9ynE׍zaL.eK^fO5lA2y(,FdKjw#EnFb~ٱ:@ΜF9z>H2{`aQR`>.86m4 ubطOzkغz˦u^}QDBk⊘FvEۘ li+^Xe\*$ݦ_<; (* #LQj&!ޱfeE;Ȣ/*TMxv}A2q=Qov1=vSyv&ܘi;r,%RKC ԗupDA]F+[9viNpg`MšADbنVtcg{o~BLU$pf= $܌nt4ŁQhE cG>0̷f43m bM]?/eWvx/7Tg`a>xw1i "\V&**ƿ|+_L _^y1sKoo-i&,A {tM#V*f6($qum湜L7"qN3}hɺr<߿M*^VOe"0 ;CtSШS33Oa1O"v&/ 78Iw_{\=v%蔅Ry |uJ/{2_23ape@\NwZzdAoРCKuZY({e kMwe}VK'rf*Ig*ڧ_ ]C'0Il t}̎@5l= q9_%^'8"xuӲwz<~M{8AQ+oeH\e,S} ^&`K6zyB6/{S$t(TO:'ܶuq6"\)|TY?ko|j”æf %4ߞX5ҨpىʧߊjTyKed3;IלpMYan}#x ]"s#*1|e#bdaksuޣ- I)9Ca/gs{ݩ&q^\I{sBVAuM4sR՝'S E~DE,*AAhHt4[Źf[3p8ұh=*E;Φq[.av9Pԉe %;<=̈:cD0Tǻ[4#h\d jWӟjMr>1 Gr31xi1T?(킺w^ kdVuXz>)-$@#乴>?@K?1l}СSpKXsϊCr&˭mk6nצG;юb|ťZ!Lo^>i|f+>2]sNhSzzt;Bӗ{,a\X&Iz.zyﰛ[RgINQ$#-bIAMnRʜ(KDpȄSRH%{!M-pK%es8U+h}%[)6Vp)l[콱>VK.cc]m7 Yx/jQ[HH=%@vA߂OLG5u>{kq&"5Ys@>t}ʀ 3DRNl'/t(t4XJf>L$!$"o2|Ǒ@DYqUy"*Muׅ1Xyt$?%zJhۅ f<e=$M; 1wtrTE:UrW3?';> ,ߗ{EU\e+i1Pf$&`̰PA =IOhL%(5! Q1B X5ss:P:}yd׏z/楗F[ .:CQ89`gPMb6$'t9[X bn/!.T'ռg Sa, c 3X~ļVd&XiHqΨm2ʼn`]֕GgNl2FhIUkA y܅2"KGܘ9ㆅ'Tl2+l%{TaPd_K(Vyd S48UmxZtt*BSb@j'#*S!ev;t]"^8epgһ@]L9nM< x%C|=-n:ÖW#ϡlxF}qWwFũ{{VLL,LH(pv :QD}@V9:K >Ŧ-=H3MÑJ~~w|[B0#b8nQUwkaOO}֩ZUl䔴 Bomr96H╿ߗF,_n0B)6w"k7bdIN3!{#F $C}kclswo+ . h0C7b-L _ߛfr 3Sڬj YV<\bLDogϖ *omuWįqV @Sˆ?2OgXFL` EshAꌧĨyJ-T>qQo]'B4du)>|U_զ˭gQyު3F%;3;+B#(u׽:KR9+er ZYWCߗHsډ3 IH?:v7QD_KXqk~֩޹RMͰ3|Yr`@}UuI{*I@"!6߫Ӑ %(v5)I{,KL$XT$玄4̷ jݩ< {u{#([+jM)cHjt,E $ljV"I!M#]_|1.WRci1|OЊٜq$sZ; @;"^>k'T<ȭ%\bIKD$c^/w=>&ƒ!\Dݮ4뽠yhN9QW:ʲ-E%KMsU$QdNA$VxjƷ2.#3e R |,(-. l8bԣDWxAx*޴_GGt kA9s'ю]VP޲g]+ݻ~Gݬg$l5pYQEhLGfGω;(tN-ɉs t*tE')ǪW(ު+)5')IA[ BUB4N% ȘjpRU~6F=.1Sۊtpt%7x(mN ~NOXX3|՜ v /ȹ=%/<%P3QC3o,y5~U aZy>/I=@cW Qb En3d%Ob〖!'˶'*mDXQ7 |cu?boHQC|IJfwwjUN;g~%$Ym]HW4J([@]6֟ i 3, ͐Kg $etLFyP w=5ޅ#27{;y`b)u6IѠ1cnݛg|yK!9'hʦ惐X5bc`{_+ \@`%"dg@$ǹ2x799++;2F2< E O^ i|hէMmב+[8S2v/]䫒@AV\RrL-~;u:1xq)ijׂi{GkMKDw}Jch >i7NV(H-£Y 1e/ ؋ Ņo~%ͭSy !GOD}n~XЋ>g1KۆLһzuMK>O!1N&H0SWЮܗ͓UܥN@@Y99$ >\(rR'=Xo~)TpYrItӱ]`ᡓWHZv-!oH[(Gٱ_S?#Nsea}"5=k%H{]KΤ'.0{@ק_3cōW}~څeӯFq ld7`Y""+^eb &R zvYE z'5p ՖIBދ+hU{/Yq? O)XV]v_XjV\?+EK1 BBk /r/AVSnv. $2"Ud]]Oʍb]oJJѱzrFצ.ܔ$SAEęB, 1S@-n%W}Z4۟qM[T^UϯU;9Vr΀ ?~pI|ψ(~=l?k{"MY٧v"u[S×i-[iWc*Ή">}Հu ϑϣ/<7ct\A2bP<y:jt/}7'vk炞w C%iy9, 4Kx3А,]·҉Kw*2J7/!?*0dx`cvhEy6#0|IKyLv9(TKB&xxw$w10`#\Z9GZ!i;.*ỸĘid??F2/X4ǝ@ /ڒIPg~5[Pֶ}D5\ЁH8ѹ+B3"\bB2ZFB›kD\ƯF9WEvrfM7Dik!1l~c1|wLJw<9ګ64*R%AN/$%4k#RӜZazG!~1j/3䲡_; yБPYM= /"&Kw1b#VNYҒ4α*F(xqO OJmH*i,PE9ް4 ẹRNa"nui4H0O(Ob&U k.6ŻڐS>te!;QGH|KO:e J|1KOeYI~:mMP_zwڎT-0<W Ӗ֤L٣V [#Q]]gHMWHO%trqjڶ@tBq7X>/'OvH%?}+k.%XwM>^]vǷFIʂƵcb~p"1`Z⠢,4iYjt>46 F{~hOCZ 1Cf9daťfvV/Cɋ.Q!D>37y8N„ݰ( !9C:mɞ6M-U^&uJg!Y~I"\n h^'댚& ( `YӺ9+A3#mx)‹ᙟ(P4|oˉk7[abw*N-cpvQRn?jeVРKtqfaىP̉,HOpG!@@M/qX5U~AKC["*v%{-<لCMF\NV ʍKMk#4 ]wSUZ|ʦrJl:HgacB& u[ kTLG83KpelԼӆK/4fK^р%@{!%UJK9H}m=7񕇞!C/}+kkdv44M$@W Tn՜GxRH}aByRgUE"#qdgF:9*1zQwp\uI͊AYP Dz:_וA9SY)7=5&2lc;C.Ta<&D>s;s%نH&/C laًȎTA{%#a#hגwWuu74袝$6X^ ɽ+Sbytī{]idẻF>WN`bAwJi:Ϭ[Vp \'EO(iv8T$a)Y7g8G޽5/#(rE) fq ｌW33Ojp)( E!,\+ `5ƩeH'mOޅ~Z #K2N J{#:u%,]4 _|&D央X/MY5c{є-uFe, j]7MAIp(X'q~ GF0u_w{x2"8;9<#M7~w߹dmXܬ H}hldC0ؙFy(/Fg9K8Y?$Fw&xQ!_Jx/=g'oR#w|U@9 !`\@)yQAlEJ zWlctx-w\;'{SztpboHd.M;`^$#mx#VGD=[b̢~~4XGN|Aigh`P:'U),,܆{C!؆_ܢ wC ˚x"IhV2 * mze%n>f W=ʣD'A&ƦCE/th ǻ-CD7+;:gS:-t4jS:#H?d`W=Ǭj?zrk]ލ y ک|w7wƞ [#oWIk!: ,v+[OEF֣)G_5jd/رF="nZ(T8=KʍF&_уѽ'0y~\9ƀ>恾>aqDu3pmLJ]8/qFv8G22hpBk{x:5Rs; JDϢ5LRq1,na.5!3a#3?Aa4UdsP4!"HtK&g 9>;`-4h)kNPjgu&*ix{mAtSAvz??ʸfUh Q_LmJqۇMޱُA;rn(R.i!cفŋ \췩/-XL յ*g°Dh.LR21~jCl2`KI-q']*ʨ4 !6MMtN_/p橶CZ -ӧ|,gB*TWA~\Z }G]S`bsr6! Cmwt|f䂯Za{6G5ZEN0m*/jUo~<T89WP%CsvV.v2qa45cȟ|ޝ$A<-aFm<4LZ.y.IJ/mpjtMC !j&P^U_J/du'}$o=cѧqtw>IvWgw*BW>3!c f%+in^I7äb~:d[CtꢐArQ6{/1GpfčK.%ǖJCa>[jato#gm۔>ϴiphC6kRc,"[|x.:X3(R/-|]la>0}OYQKQ+J3_O&Rxǚhl֨H-oZxR}F=p~ʣٴdV`6iuo1v옰Q"g:؆Z F-qow "%1pw6v2zל\d"P ǽ~21Q1M!9$x-)h4T@?h3FgR:TF3?W¢yD[bƦFdW` 􌭪f'A1#ȇvfT$)c9vqS:qz0eY)p ʛ).FǑ K -bg(X:G`SoQ±!7v3^YAU_BI1g%"s1yrҧb).p {vV7{e~v jbPv_᲍gm1I~9U~ qS[pc-M6`L‡pťȸ>\2FV0#OrY!jqL$*ܰһlKo㫚yȨTߏQRyy-P B'RV Ш^B9N YW~#Zz @CTo+֪+W]^J N17)-Io@͉^)wpHOWjg$˄jzoVAkO_s\<`T*t Ǫ3l_#&+f%rLE c^zga2-{R_ H!(1 +kO3I@H-⻤ nmf?^kp+WշfҖaJLm[7C9i:ſWeDϻ.lу^ӣԙѲ'2UJZά1EiU2@a0)RkA!/b棞HƮE_+ S`R}YF4A&jZ{(:*H橑zMpP0/Ze R_5[nE_łSS8~)XF@CuH^*iOEdqg.6-U}jM~J3O*?A$ wlkbpͰ f:uWKzu&1_"~,)0Gk؂áy[ug2Sd9NtAk+F)KQ.dwx*X73~{7)3睙 aL00{@)/!.CpAo$ }-wZǽeu#y-ǷU:gIZ]X8MZ8|Yc_DSyb$ET~΃>Zpv%9SJW}e{Blyg"N `X$/h NLvwTCX,gDǨpEssӴN8z}$/* rGh~N]/zMIq 00DWθ#f"Ugt^ݪWD z φwO(ٔ,pd,k:zB"}_B+ˑ^"1$ >qS#) ANkA9_'çWw#~Ҹ ?H;M=mWwGgHɛ։"jVfqԪ3d?pIS͵ W\f̷g?i}l*caߵ[b2.2;9Y=?X, Xuf/ص2^! uutDU"e&SBoӉ@$-;];ܳ<';21#wK`a?rcgzm*s@(>ļ_ZeH/7a ^(r:tEK)k^mey4rnc&d+"P,7(ȸ;7>zȧԇ%`1Y?Z qc[ u@JIc," !L|3+Ƙ>C?lKǽ=_5UuDUgM \;YdRzqNrJPS(y4(%!-gRSZ%DRfٛV.\֪]s![a oɖԦK;lZGiטˈ A/bgQmsςVG{8K~X_*@M-VVX x+ۡb5pJ:s=);sB;wZ6㔥)VȀ۪|dp}8\"VvbmeSdao|3-)e-Dy.GFK냇} |X& n˳ 4q:}kċm\^> EN1$42"3v]KX\vȡUǔdXIuĵ~.gΖ<ޛ8 U&) I9fc] EU+O`A6e`4=U^ ;0N*Ъn3Nr u c@#WB9޿<Mٹ_4JNP>N2~TWD7OnV^d8"&yKDipboɴ8d`~6z1f?u#R; aU̝FeX]mv'9#Qw-B'Y@X 0끿;s ap?E-’o䆟7-#a~Y65ֲؔ4.( _.ұM") U%#qb K['ۼjMVybg2E`{/c$/CY[/s{L[9no`hza5NYb3T"gy%opñ7Sn@b!jjp)lu?6ź(%BуD/ 6?Dn' MEh0:5nj Abtyi ɂT ; GۮbG0EYkX(4+`>vbƋYdEqRPsE2~˾W՚{OJaM{?O >+5|FI[/AG'D3{}SG?('(_Έ=KxGG9MX#6$6H'{2vq0N59{ސpG]tpCT[ha`4|h INAc9 Ñ˯i":!)ZN49O$/M%r$kqF%aXX~>IكTGו*U/ ՖcQcIx\ fB=ܮӫW%D*?v=W_:^ɡAGm^lQp꯺~C /"lnR9=TmЎo(Q/~rb]_Uc4^Q,'\Y=ƿxuH܏g uvfacNi,9,}yp{LF5pR9{L6 Nzk;+㖌p=#USz|C =Ό-kBA&vצ9v_11!<<4@]ŒA .G Ayfp93Ǜ!% k&]< OVh]JY7&Gj# +qS)G/5_8ϒ/&v܃8#}\A#{*S7sl= \mK$>3~;-THumD2֩4+9FnxkA &'H_:<`X]kwH}Unے[`%>em M4J\T&bPQw]DW"z6Bd߇惉Ì̄c!mnVk&DWq$2Tg,Ijo~4p_ۡ }嵏 XkqJcԢTpK8`ZV==gёxi&w_gqM}V &K##T7XOEgsʈN\V8N%M endstream endobj 78 0 obj << /Length1 1745 /Length2 10749 /Length3 0 /Length 11865 /Filter /FlateDecode >> stream xڍP.Skpww.Eݥ@S\;HqwP(-r=g$y^y^h(4Y$,@WVvA'F jKLrv;@e Ȥ/v +'dg @( d)G/gKЛ38pH؃@@j hh:A^EA/l( waupe`x] ;` ge4-k˟rMKW3" ./n 3%8@SA i38X973C`;@UVӕX6ڹ8݁`;ًKb vtuau.7Ke R {9Y[/` XX.͑Mvr)He"BGfr𰳳 p@N5oz-/GJ |/Ed;2l 0Y!A;=/`zY8@1clz JLVNR `x~͢? Kɾt? 5n\*/K oy_87MH5heg\__ k fA`7*_@bew.`OeS ``ge۾./ r8Rb`8yx@gg2"q|8^NX!/.ȿ'`-dA6ſ?M` ߈h$o?Hf7~Xl6п '_%7:A_%?%_%?ؾ0'$`Qx&`_Lupj¬~V@ϩ>DǭcаM'DBӢEY =⯿2_]il@3!m ܶʬ:ZӢYV=~hsy|%2'wW4a;t.A*M1r O x3X4%*$g_i6cH%̡@jV?,{cVӷsgi~wuZ9'{ZN^SGyk( X0ܣRɷ*h?jtK=3@͉Fߠ~D?J[,F o?ːTDeO-ߣ΄$c/1ڒ~tGxX+\Ǥ훖 l!t),uS c[VP$B:Pڛ'bvb*8UWXq´ <&Za^mofd^) UFVIb|+Gps7#a,R|j#mn6`+w:sik2rMwvj4 :C-hm YXX"@ q}.i&cu |}4cyGS%S(!Gq=qiPQğpH:XEM+w<ލasaJ 7ơHqy3aK=VX1˜rxyIbnors9.n-;bPrߐ<[bA3wƲ5ވBp5+"J."IX)'^ !r>E[wu y切_ISCO=ytϏAڮ\rU 49o櫔^ Z&t)߾r2j6Weh,TH(Rpƒ%W P ʆe\Tb̿`e]E9s)AJ2Ymn+URc˲ȘzmecgLfJ~BKuǒ-G k'3ӚvYV4-t vȽYB{?bN5/m.IƯ(^XT7565Z(PW{9޵Yr=cw؞]2#`Xnnb6*:װoV>sub8 *WT^!j\%3N޵eJB,5 IixG`Aѩ#!{W`?_j@v(^Pxk 5(~]^%ҹ_RYnpk.<<99\E`4JgB٠Ko¨{aU|)4 j}RQUpq5Aq0ơxM;O@qwJgģѶɼ}5PF[X | {5ИpHa|Q+\UcQԠ $0Ō{QUZm-{5;nvbY1jGoLc-qHsjt%:KngVTK%Dr(0Uc'͈BdⶀNop/vϫfj56_y;.c0֥?fWߊ b1a聹XKuu )6 ;IrD^k/C%z݋CAg!ֱ<tMfp"W@FLe@|pEc:9Lo ʸsyJ.ZD/G#t;w$> i D閈ȩ=gPCrLYM+?>Jy8Ф"n#0F~M8=K2Z؜`aOxC(,ۣ53iuq}t硪VL_m7~5GzǑȓ_Ŏ6ӶS]s"(8 X֏J Ux?%?Ⱦ<)3ᕬ; <"+[:9رQXh|[MfO:)a4L' abpAtOFK5APr_[{;tsBoD`# S~~:jzs;mB~+%-DFR^[u!Ci?8=F0aSxShCA 7*jȥ^6Eۯ\OUI>p>^`~A9-$)t[_#E"'8Qhnr%~ qo>L'xECTmC(BIҭ#mx0'Ȉ~6ۥs(9]V |#" 'Ʋw.s3x9o >$3zj)ڈ|[9,iGr!5pHojY=T6jm䩎&Ul d(VBʖD> dHcC4=!~ҵ질~z]- CK2%dX50r$Ѡ7R'}U/JZID">TC><6%0on͞;  .g,C*6n2RE|gLЇ?ʏip)kQPީd(8f~Pl,3QŸ>2#X'*8Bl7?XQ2,0'DϮV&rjfZemldw]Ff'j.Sz|® *Kcv k.Y}"g. 18BʼnR؅R%Ï.VW%RkCء_ h97 -96s6%+:nƳ?`0}[6s:,Hegsh^}")Nw]?[C; Jkd sJ?_:duYJGqP2T +m!ԅ"T.CFr 1NX7b[8ޯc|RJXEWטWwϼB!qHj r;{j4uF4U]޷YvH"nam55GL6<×^0SM,֤bç6X*wfJb$u4ddt42zXL~v| a|2ҾMH˰`izF7̰ܵޡca6Ȋ裝 GbsK|(S`LOz=;zn8r(df0{Q Ɗ'a D+nBWzPg؏Cm&8~iOU<{ !^# ͸x}e>ퟻ%(Zm`3{{sX箰v?ӌu-];{|%%Z)4,>[VCoCV2<"(k4%1+b5Z|)mom't85FLp,}[5TJ9zuԁǫ^i (08T&@喐2m W˄r97GZu#.X5c{raRmb^mLZT AL[N =Z㺵CB )K̨[+D:3I5 "8 <=EEZFZ6:0"c~z+\[L*!(ݡdyd X&f TTIw>[c9~CfwF 1+wC}򖎤+ R̘䨤E,W:μHԘ67U SzVS׮=Ȧ?"C8Ff ~g]i)㳇--ytg^ N5#\?'..2~懰i#0 ӢwFǿ22ȣWY/r\}gO|a~ >,#x(,soDN`*g{,K߇,^J{YYx'˰*` f0WV|x_J4aw^:)#$GAc䪮+b~ ݎ?spOo:iǖ #z@2XmO-T_My4SJko_%nXfyH>!$تܙe|Tq&:^M475>΄3CE!~fIK?z[RR ؆D Sa;N37kC8)u'V` o9y\:$dW?'̘z!A)x4IIܐ$pr'դ=jv\H-Z Λҫٕ0Oܒ(kQȶqHxXh{W-{.p52oK|Vs?˭'ʦNVmٕE+z?>䩢{s}A7OI*>ўek4bluSM֐SJQx-c U ;Z=~{ar\1v/H]qTeC'xr¯IL>xBLs1$cDUN\ dzU]h9S1ԗ!Sm^O)vbdixdWF<>{swS R?QW_\>cR2.Rw+k1))yWxg^E/̖ s4A epݔ7.5yZt^lo ޭG8IAYJ)dY ^&S=J{|V#X82:vPIP~7F5Ps:ltƕ΅Fd(@DYpGGk:;>26%|DSa"~{=WDz*+z&-ORK51nGSHOBRDfMe%xhh߶@{<N˫~I^2QC|Tciie1)#7 z9 +)' .E,Hg`Zx--#)ٷb;n 3Ԛw|\-$A= Ku54w˥yⱁg'7w"ڮwp?d&%})9ECC8يZFd\į.$5: IT$enG!480ݬD5 H&Aqղ@x䪫 lbʝc%+ =<:7?X@'y ُa` y̿|O-apPɐw9@3(.~>?1[o*9tg: Qو>3M#K4 k>n9+"<9Eiqb4jº yr_MH;Q5lزey۟)B$6-;/;LK[VnIMU x9܃lv#T֛~G3KB#b@e')wAfSF>=+Z=єz=gǣ`~΂Y`IM~YoGpTМ qb0y*3((3NVmL56snWhJWؔJ"%q7;KݙT2Oɧ=m%_E`"ݵ Xo~0!۶0˫, y(ܮ}1‡[qpV%GtlF_;mcU\ʣli6#ڇN\⧮׹wGW^=8K7ۣ.)<y$ki]h!awec\mPr :s oo#WO2$y?ttIK7*XEI-nSh4PՏle>L85z)Rj(<E `kq3CίU~WowBa5fEG&ZB&?h9q!CURr~mj0rVC/o$>*JQ51  *- I+f`F$|3z?Z#([(8KG5?>V2VT^XeNbs|}sg -:ӹ%b43:&kA 5>iYew Aˬ$$%"O(-i3RH( MԳ'fOm "ڔ#ٻv؋w:*EV^Dq;NV6 ;&7jE['/,c?3z@Ef%#D$6WۘK5؋]ӉL.~U/0&%.c^8QQŒQAfU~CҧoTe}"m".6b~ډyv֜+v(vđ\( !2iE+.Q)k:}Jt1@+X8AI5馴s/ed6n fjIy,A6/5x,NǕ&++X>&S?CJCEӥv 2%h%Ǎ"l)Ov6磝v7ѦP,ߴȸĊD# FWͭ0drvaXt d5:<\m=#SPZq:IMVxe"]05GQl!FPrc܁;.)|)[x௛ sXy2^e0vnj/JK'I$fa51GJ?Y-j'zx>|+xƙ!2Z+68VuҰV{O|_ayjf8+j ɔȳ%@s>K-9sδ{0Lkc}S Z_ ;K5[+smX( \!rg7Eƹ@|I#c#^tkYjۭuÎ"CD`uW_J.2Tj~=(n퇉iáD٘H$0VDӪ#PQ1X361/Ź gp9hq'eHPO3Er)mV3+;c|k`@DN3> Fc&ˆ@ʤ[H,S~ F%[gsFA0vLi|TV下&>/gߦ^ HK> 2 F11 2VL^@z KK$>>>Zn{N7iY)8JDA.ox֞>G+l|K"ŭ:!Tok}Wrظ7.u]Vfns *|Ьy{6R(IZ}a =MEiDgGX%KQ܄`;maE=WK71J`Q4zr<;3ꫠVi{Ty,ݝ7Cǜ5ҌL}ؽS*ϫG1: hi)f}0-=6pʺXM&ӎo,G X 96O~l+nã$p#Sȵmt!kGp7^n(;CfXQ I{FtKm~t8'%鐘ﾰ"L.ĭ4D 0.}'dԵp3${,:(xT ~*AJZOf;,u襻PfWDÀ!v ݨRf@9TmpWyp?aj1Qb7#<Nԩ<~P`b5hc_iy5}TgIOO]{'ˋjfF2էœ4&Ż@wݬOLㆺ􎜷8:ENaBqBYo1yuQO=> stream xڍTk6L4Hǐ %Cw03PRJK4HJAw+y9k}z֚v{{ !xby.0qXX_bC')v 8 =@ b7aOyq>l>QQaYW G` AW6 GMLJpb@]'bU0@ S @GG= { A<T5Znc?\z;_޿AapW70 sC] -% / 2x` w`|__yz@gz\n¥ E3E;1[ZNl$/ڑŦ֗=0{5W^"$>ʾu}eFftT=Vp[6ɝh`Z<͒o3C >%>;"WK Mxoʟt5dB߳Ҕxd_ 597<?r,vcq,BzԻ0vWX}!Q_.B1(c14Qlqա} E!4=p9㵧6QE vKzN&fh[7_qP# gBdY{Jb+BOڙ]_ҥ㭰Z)]$.fA7ㆯK@*(kLs~iG k9*xd)g?xec..t#H_tnl ~;]wl,@ o(U"WAdDwt<1 F-F G\u36X+8tUaZ#趒E$RҚ(:O*PSWQifig`C;M<~: IK~xu(Kez`+(m_ҵk=㛃B$ZW.ϸ?YPbrp:-)=Ry54o"se5$E"QREjic1O4 b-Q$#JMI۾5)v0@ruTПד' bya#4Doĵod*T4]2n },qEz;0n1y>j%-NY4O_ /.6Β[uŧ(˶ħD{?|#dp0=8ȉ5c^O*?o=w[mzʖgvѹ* "+ pE&VWu+9^ .T|3Hރ]a^l3 lq+Dg?[P8|?~|!<3͝g'-l9T y{E:G/(ĭdsq-vMjvV{m?\5ҧ|(ܮ!Esizd4d_h pTnw/1VA7!ڡDm%̦ uxv3pxd5A5yqSi.5!j 'ɡ*1lI S7<*X" j+ 6uӾZaL7$Wod0i -\b% #C/1GxnްK(e%C&l[Ej뷰/f_ڒ3p\>U> ,m?PJ @2Ӣ\};!)Ȳbʕ @]u\+ ν߱j,Lƅ0?[x4>xZ-wG)؊LuW=\C`ԞoމNRRx2'["Og pڞʰp y54`e.(-c7,Ř$ѧ] X)K3Gy|;8+ĥO:gdxTvKJͽhY y=Mڔ.-]oRlƘ3*/_Q@ekЙ|M:)_~i?~|e;-ڊ&5Upa+rD%̐ 'iDsRLwLskg=dES?q ns"AaEl:sᇋďr7JPG€g9u/ #*&;M(5UҚB2+ HY9iҺ+$so 4ō*-ДV lG_|ӨqL#ԁC~?a7X| F 0ùҠ^ƴ)mFߒTְT9mBP#6,G|Z N}m=r׆l ͸O%7X EuUm+ @OwR#$"xi /Ya[zO!'`U?:͋\8B,|Gi<,LVfK^w&GaAxVРh(yVPgMWшEoj*餃TZNvmuv"h̵נ]Mbڍ郚(e}B5./Z{"gPkt?-FbgD~~f%em…= ]yEz@M, 9őA@橔\e8ឞb0ONw+~?C6{]1-h}qFZ/\nАLdCll>/NoLބ{iC+k$3t] ܬ|:4*FK5dU O'6:ׯB|j8ulCNֻpbȁ/K&0ޭjᆲ)7)IHR־=1*( +̓64}Q,̥0MX d}=LGND6#saw3\GdnN W\}) V8z> 8 0el@QE>b:]}S³pq='urDW1 `BdžxZ_S%Uk`9\ԍ]3ڇvL,lR^Vnj]MftIJ8R5|e˂uD ߪi?xWGuuI0 ÍK  !<"Q->ȗg )ظ̓yAL1w~R&l0 ]Oe%˘r=r>u,sܤfA$cQ<8kG)Zq4M13}B: ++1jIʲ84{`J'r? ӧ+O}P+F<茒"V6O6 %ْc m{g'Hw/Z-O_xq 4Ls'UwZ?'MnLWUړT9He4XRSU_*jaYmyeM9E.?d91 M2.As"ߋ N܍ZfJC3ػ%CR~[S Qrٲ7c8~> zZy, `]c_]SUZ#ݒrt ַG{wZp7ޱ'N0﹯\+Q"bC峫'CL ;E*Nㆉ}tl.J݆bYi]MrPxέkc.]J%nŊ5Wr{AL8 x% V>[(lr%9Iӟ ?ņЕE` i;Bi]5±S =N!+&g5HM.ieS9C_i|oU:+)؋ٶtBUK˺ցoRݬ ޯ>[k#D WNȢjLD{f \WjNeVE/MaXc^%DF4gn˶a}Ib轰tFxWEP͸E4V-6(ZP.}3ϹОrp#l/(ʝA]$LڲvU +sw2t )ܙ ɇ F>"`vDUizn0-^@^XPIf~P?Whaŕ}zy[HlA \EsD sࣙ0ʵzaEk(`) u9X.x-C1{C`KH YNm*q;űkQuKOIe˰Т-RP=wiO|m;ڝ}nWL͊fst831,Q *2{jG{w WיCz8Q{cZɆ#Bx#OZdMb-DL~|΀VMfBPdU[ou 붒|܃5H2y%E;vO5Eϕ 8J""vB'񚀁PGܘ{!_}r|p9p̚^6}ꡇ ؛5|6,iY-0^D=XSʙ6ݼ^ls|YĬMlsarJNF&$as6bp +%M熦wf$JSa ܽaejt˿R1j<ߘMw(Ѷmړb\HHe0kR#ݛ'wo2UlH(Մr =Z$O~ ondf gGzQRUˮCʑ~Co$L=L~*r=mU9>2`?k^yJD#-BRk>9`e*9|#rʚ` Be4$(SIԴ18s4#xnYI*bӻ eTI>u>ny . ݧNVnҒdcpä=awTPqKbU0k4-nlɴ*&zPSJ-rms<k'`"-j&s9.Jh@ܯ9͞3TA!QfcUߘ3l"rQ yK'b=tBȨcTJquzD+ۣs ge17,\:caO]^%#j'0ԧ\S5&ȇ{ .W~ECRA{8 Z{OI^L4)NƇo@uFA_C2eZZj IލB|;.FN^O͗w6VUL%}Cv _{ FƋE^}i_*MӯEƸD6EA,[(ٝʐI !>R U>l!oOR>50W4YuSu7M,*[m.^MXdIQ "o,K,FK{6uC} Y%qQ\*fmx:V4X{qJnT>EKbN.cSgzvo᥽dŽDFҀ^\ۀ0gӟl:P`Qiy VsXE'E4ETW-8AX"OB2%r7fpNgTM#q'/\>ґOCUۇYK9乾\Y̏4Kq—'ڪu聍m"s\C5peilJ,2De"R(Ŕ6|IB?[m`(gݛCcG?R c6~ W>Ow";!}epT*1 al2ZDI@'^ uHV QL䏡,X)`R)i5B\fQ~*u#xwC|W=xFx6pfz^Gi> stream xڍvTl7%1:I(nI 1 ch$$QA@$$.%E@RywW_}~uc3QUg\ ŠB@uCS ,!XO_Z8F/:uP,z!@.X(+<08rc@3]m/8/gD_ "w'BCa04 D\.O8𶖁6+;B=}x u;i R5B= <Oɚ(gu4 Ga}@`0G: P.GpY޾p]=*tp,P ȁpo << B{]#C.p_x) 3:](pd1]0x ';<(Y.HZ[B68Qqef1"X] (W[W~o_obG,(ۂ0BoGUBxb7DoWK_t5;#|mBPEz>Z1 s *-~}( /U0ODο%.% b0@~xI i ` H CB.h >% [Gab0x8 aI4=Wr)Zf 1-4d/s"1Gt5Uf/pobRMςRLGWS#mpQp_x߉ n$l1.d<驘=jRZhEmD8 VR(^C%^0 d+Qg t2幹O; +!Ç8 =O⹢q[ߒ8vڡK2 W}\nQ6 Dcf2]TUyIvp\ uyΟɨy|uI:.\:4=̃?nn jnj-7=. 5\<~UO9s}e}6aHB@: G!ZX1"-(q;E}Z5eРrz-i,l%mղݚr1SB sZmB8$)UrI1՝2v/GJފc{vmf |[˃(~)ҦPݯt/}5$Lȏ2l\}%6r:JGN~%@8>.X-z˰f7*sonή?,ʧ?tXFԐ!uxNMg@ϖFy=iK3n3CHxN~MsL`xm6agA8!ZЅ@q.ȧv!@+LkFm2~ϊe- ; , O}]F64]a4M:՛ @G+&IsFROr!_q*;0Z]ǹmUJM3 ΊMQc_SNF%ED"ߎ5+L㖷24jO+9kD 4w| $o"Dž8a#Ӌ؛zg]1<>^|HNTQ|ƽjHp8~D/g;oI*oސ^|bHC)پˡ3+~_: )Ip^ߓ{(Ux4ei zV[b[hwe9&Ӳ_>9.X4VwO&S ؜*> g}YsrN%XA{]c*cYJŏ4_^? AxBCy޷g{(rGBtY!NvV컘WCJ+ܒ7ȵ{1Ŷe4 %)Ԅ1jɰ|~̅o˃qlk]#fCpj7~`d.&sC'-M7-*2tS]mepWץ>D,OWniLT@FFD{kqOm.pf&P4J_M|EtjqAyM⊒UMTj~#.'1HcH,.[(vKl4i$1&DϘ)6< n˛][$g.7̓?>n~`Go*q/͎;*w5We`GuX5Zv("]zN|Hsu8nmrF^ɯs:Μ]~G[qU+ҟy ޥl]5jkܟ5ѻL&ܤҪ2#ygWxyAԶ._W}`2[hV%!Ҥׅx0;m lew|CwVs k1md!2U*f[GyYa;݌:# gD^`V gOl}wX`[^jo L6Zaumu}x_p$t\1x`Wcؓ`ܫ[l<{ySPen~ƀ(=4{ޕnһ6gצ,e9Ijl,_n Onkw^ޥ>Ǔt%G^w~_8?_֢[לT>͒@)5;J?v~ jcSۏ$SLʁJ5@+联Z=]Hxt50ꨢ\_|J>kdsۇEW*e'M}eRt8ݖ)"%W#_G|يVWlW;Q)zcK_ pu ;- D? gKB([;}r mEJ4>sYo0 ݼjl3r m#^lS4)JlٞPxy@c:xFf̽$K *!j eȀIe^+qzo3i);\bG?ӓ o*(>s?@2*1u>M NI6tB:S PBq3EKx_K^抠-/WCI\Ow8׼NK\AV EwMSG'gP;bەQ{m=X~y кDP˲B'XꝮVKZ&=߽'[vody_=0֛i27KUΝٵx/~MUCgiKyD%,, Wk;{ME^${3t\{͌TfKI{4'-Ʒ1Ē!ܳTŎFm`JHfj Ki Sh1z/>ɉ BJ{2 j~: 3WD m{1 ӷ1$桳! cR%0:߯:|^4ĵX: ;hFJMh(f7ɬE_6 鐤=!B(ټ nER 9N6 2_q|=9k^LuЉ#nf&/W6$~ ̣#̢{u=Gb# >=\/. ~esmZ ә[{wZ ~ p[<7?as:YgAh' {!Y/̻|,6nFdjxߨjK)q.יn9o gLvt옇麵j#ҫ3^4"rli ԣ3ˀkbgӃRk-ρu_2)K3&C)!1J66΁~ۅefR%|*\-ռJ՗ #^8UVWsJ`u T>&gb^pj娑dK{ugke"Kmi{ҷP_) EbVY-F] :qto/guxB3hFP%G`t0kˠ -䍝hFWeYOMTq:&[ovt% gu۬!'?gBCՊ.`)(p.iG:I4.#dŽdٖحbԝXpaAybFP,r%[L-x\^-eV吔UfޟIyM>ЪWgC?)$K|FTop\NSܳE}8 > ȅ9J*~|"UMcu%F%\A ]Uo*$Hh$ve{E6UY$erXIX!|?Fyj5`eBEd}Xܭr3Rl[5xZ=J?g^ 1JұI4B.c?3{ʽgìKmϝw#zQ.l[]\Rt|ҍKɭuB!,e>ʒ_%g>2>p |mS |^K-/kUj_[vd~Q36[Id<@ )=)5Vxv׫S(ȪpEHs\`~wdpu-.F>CY~MUq*kw ӚӖdZ,#9 wҎkz o~F_vzP܏X lzh׋LsNsig#:0{~D^ΌUP] Y,gu7]DhUrzb;@}M墄. _sO=yQ$% ewj:ԑ6#ٴ1+˥W|p{7UV^0k'لZNTC.#AlDu,"Gn,p|ωM0fy&)+n㽝pa+`Bե,S}w۷'[э/z!slUj944! JnX*ӝ}IP-GU):=@?[|;bL#Ykv/3|kWDtY h՗NZ!3k&5c:$j &.k@ǽVPfH)~ S#^ݭ*y}G$D B*^t7J5kǪ/q9:F1=P.O`$D,X-\:~⥙_mK BCL1+4:JJ9l7"P~g)8{n2ɞ N⑝4'B6RMT.XJVs09L,ųhnW'qG.Y,Dݟo;B=! &meE4E1RTmw$u[3xtGB<vMS㐟߹R.ѱ$CDE%~zKg?1P endstream endobj 84 0 obj << /Length1 1668 /Length2 9735 /Length3 0 /Length 10805 /Filter /FlateDecode >> stream xڍP.[qB{pw/Z]Cq+ݡh G{3Mf-_{}kτZMU $kuaq88888hi5._R4Zm3*Y&mll(B@.W' @ lPf(CAhRN`+k,>@>? ; P6u=g474  l fjfd%pXހANn v*v?45-]M@gl:?;B-@N %_,] Oyq657s0zVK0PUbspaB-~BMLSg?d%;gs'33Ca/Yj!eog8O2uO?cڻC:[[pu`ׂ]A x-x888#an;~_o{s _% pqrzS X]f +0b_yN`>3ߟ eaxmgZ4rqE*8UZ*]ۿ`w,gƂ ܀ L?.BGehM}e [_ Vy$V\"YP[EZ +t[enh8? 4Rjno{8yxNNh#~F<oZ<0wyv< wB=O^~o`WkxZAϖ#73zʿg޲9ω+>9y9>'r>ur>GkNNϯџ}yֿ-/ڛ w\JNMgd^vtBNa~t)2 g ÅכֿamIw> ofv>O N}h@%gypoVstR+vh(_]U߫}~_>mX:Oo@Ʌ {rb3Q W&g͂Z&s 1 A% Ή-d kW͵/#:)Abvx6DRD$U _|f,'U_=qLCz3^'Ɩ*_j)D*檄-Uuڃ_^2jZ'LIb{3,% }QΗa*1Bfg_PcRz̆,61G4U-m`RSes^sV,#DЗkG-BVNkilI'tˬ#xEDxUN./`$@4;NK_K _ }5XP< (6т Ly7DT[ϕͭն뾹%Ɏey+ <ϙՐu}M"5vQkK(|X0rUOHtWa8 2D*_U $>Zw|#ErDZȁt=h3-{1yc3MWwS>.!9XQU\tbO'OuF*X1hFnĄ:ĕ %U6*t.1j4tVm_FY 韸di%XrF仺xqsiyabSl>bH*؂`9$,ՆӾ?^ciH.}%<~LYf+mߦˋDanP*־}"6SOիT!1iE栱3^҃_@e,f\o|sp{-l?N} |tqYki|]o;\OD4x5^Yo0ؔ8spwI.3sBE'c^Djț_Q!xƔ4H?r^9_w$Ҟgb$ JZvӲ.4w7؎Tv?n rj'<*I Ig|$F 麰"=r@av2dQSP @bT.n.K !BֹՎLQP E+ f$'_o r3*ļiWl $lwc]s5+^?Ê[@n]r[cy~*?݊E 17vG[)Rm^]2 Ɓvv@i҈wx2^눢yfg#[a܏'huvگ<ό++ltKX1c[tcxYゕOl 9{|T(LCϾ~zitl÷˕-3ꦍPitV,ȏ̹D-! oƅ-I(ܕqZLp[vIBYъGu&/m2wH.U:uŚn1!FiTљ+4-!; ${|5"$@ ^QS'[e0/fZNFT*^TN6c'WJ[z6 GۋRD(7sI2^J399:NVSX -9%T ֩,KZv., nC8_}x4IfK-XʣR[ kurƽ+:|R܀1͡ CBQ87L8p9$없J2~9j =Ц5Buy@&"ˊn '_nk:טO<W\C{y4>^n !9F$*{ʝejm6_'[wDŎv42܊bvj,VM4ǘMtvRn[qWϸfn J_AxCٍ%ߩmc|pt[2Q\/=&nxJd v_'HۺY@P*M^'L,% s".4h(Dk1T%A$|&UT*2 $5YB`rfgֱ%@L_L%h5W~rظJ b/ 2-2ͽœfwnsffJ2*'WčyId"al6FVb,+8ްoIo$R.&)T CKGDj?|TVE$#p-ϑDyây)6*%d*(FyJ@i~ؽRo䡲 ub.Z2,ЛÚvK a7majSֶvEv|;f:Dj4s)Tû18߯0a:!~72< B'l\o*`uy]}}b HN(2b ܺ03{Z$LkD5ף۬7+x,8׼'{59>J^#f pU,* ( U=艐DRoV:\?dc!G ;>M ^U^TG84y6#!>,G +]_A Z>2UJKcuPyfCJ/B,}03$ir` :DxDw FBa% #68G^}U:JII;z9H5{W̔Jzԟ_edg dOXc[?Lƻ}*?6}z<sJq :_C Lާ-fm3Xl--EQ3gGR!wpű]ss%яN|QE((:Z~4˅n]׃+Yq}.!^^olo Xr!}\эb1*bw@~ȄtAlRJ|b,n{^'1Iùxfd,iRy op$WLvbfPIM1lW[^AM60T"G}eG[}n?k>SEc f}J,*~6;?FZ6#x-bGU17颁[`z|bb龜\֓Fv\L:WZS[睽N7 uQqno =hEfx ɖكєMyö`8g3Q!a}[`x[ݏ" ~p ֭ 2nb+tx@]S4X h,&170ꠃk~p?.v/`ː8soFc|`Vdd%@|\_p 0%»>2~2^[6V 쬑8]B>y!sbƆ¼|4p؃ۑDyOǾz1NʂfP3m8dS0+E wf%dpsv )pmoT&i( iC/2J15RCj˼5()i#+޶rOo@b+b[]O?{!mM"`1O^C"])΢ n=f],ݩx_T/ၪpD|yOU1R j+E11?2p>hgH {!%[ptX"[L(iN<ިvL7;jqan Fie]Ođ6NɦCjL+{w4Jܧ#.0団H.|^/T~-̝8B~Eqs}+?mEiwp̩%D?B>ah7.\ȪDELO24GH.RHrS])gl>Τ;kRYR Q&Ӊ`b Ձ)Ձ >'Xs$ wY ^3a.mz҃~:S0G륎j7Ir](Gݐ Œ7/5xD%pj^6[\_mOHOpp2J2(GgaqԷz}? 0ItHjqG` dt̸&@qG. 0N>4M~OAPJ/x,>"BaU9 gQ- #ɩ~H!',nEzF o_҅1aJ8Št"5ŕkkc} nu>aig!L󛠭D _ b»B p+Z%3՘s%Ug`U;׮_DTf.zzm*z0+ֆh=\x/|o3xj֫;cy?RCiyv@Q3 `@zYF0 ndS'{u\<z`F`7ބd;9!pg\DavW(^@I{o̼ `x+VE/\7_T!I1vz:|H2P!&BeWK mDtD[G\~X4yWbkhw}Ul&/kUBmӰu3Z= Y>&\^ψ*i^A;mY8|1fiN%+QxSΈ$Rk'=9A5+!-Tt 5 rh!(TBǞbM5eŘ-:F2)kQ 7TJdfuZo*P)PpGɞl-Ȗa,eݯ<58.`qדi+p;WVnmi`˸IR5C<.mMja8Š$YwYG}?k ٧ywkmW8^mTeXPXj1'%`\N(Tߤf=s;Oe9Fw "YpTꌑ\7]gxOTi j\6ErA9 hׅ҆"6U 4-ĢvQ4Mt k6 .b@1b8iVTU9]햎K0SS͝<QvG;Ĵ$l.Jlwڣ#:|xokΦ(֨TSGB'S0r]"SK/"jT;X^H;"HYpB}󊸟 DS>}дQ/+*|cS:C E+AJ/-NT~ADst$Y7p?2 Uq6,uaGA ,d~.Gɓ|f FiaTQ9G'o ^pA.܌8_׿F {Y*6$?nOʰ8х8455ZW^PQauBIppU YaFT.VccqWN*#1ؾɯe%̑2̓4\1|C^̂F3L˜> stream xڍTJ N Kp!C`sw{֬5ӻvUu2bE:!S{c =#7@DN B GFjb Gtrq|D\>Ү6&;77##흸Fn9zLcY(ML\\lN&Fv9# ǎ&F6{KJAkNodLodOE pt(Nn@S_rFÑT-,1؛9KG) 7@EJYZDt+F&&Fvv3K @A\Å`dgG߅ąFř/ 8d1;S{[[3_Z:M>NݓkwgmfigjSW5;KGW<>Lṕ.6FFF.f0`+o/G @_K3  `ji0[ 4ܼ@}-S{;\) 9 UxӱpL,΢hd*3pS)On} 璷X edc4b4Go/5ѯ./g1vUϸM-]m/+b1Bv6=DKgqK?]*;[1U&G?M?o)fgbot1<>>w]>B|fNp';;A/߈ /b0HqTE"d/0 &EY>R`d0ib?fn<,>=>l~~(HWinA/\2qGb)1}Hs~p~D; .2]2q=-# O՘&NB\~8>@neބ'ت.Fϝnol_;So$$-{>]1;UWom J>/q3pX? N `T|^}[Ar]9$<ƿ.+TEEϓg.@P]y ϡeOIEzko3G?-xmT2;~!C!>J^.)\[HHNBĜ^ma_6ŴP[ڌaDYnRb $82W5J_嚭,p'"fOlhr fH_N}y6x~tFo&26aVUl}qⷮG,C1?6z&=_) >~$^p-?cDgR 兕 ju`sK/ ~eWm3E n:]X |xyuo} !SH$L聃̧y5UfsﳡpNt|(Q|pD[ɀ3O1S}3b̩‹;Ur?BQ[랼:w i7]@\} qRSsMΟ M *xf /{ SmyVY]cLp <*7`dDz:b]IȈD+'t)NLF!]j/ `Ŕ?rnDUvP:ՑoX7jųjr\oݯ}C1 1j/{]!_s5W.sΦ.`׭; ‡1{JMVuvRvާz RC>14ޜ؉M1v[9`D21|,OE73i:X~$Y!6 ]-0}p`yVtNI|mp^/J mVj f?rtCi6GUBxJ,MXy t1HkEaܐ)XNitS[L=[R*'>L-72+ l]eqϡݲ%#+u,dI}X/$QB_A#6e, j4&)5JO,@[>fC:lveT0άcAyet4>qBJXYMyV kt0g$c s&j絍@r@=lB;/nz koe?U߁rMRΘZpMF̰Nc`]%6AZ*gɾdÅܔ@P0oSGQ| '; ϕ@FZsGE9/-MSZxC?|­=vMujkxeuЊ A)75)h]CŕN ЛџRi0hvխ?f~Q[DeYuPbЍqJ-z;nu@_2/p[ǭ5k,OT˻l$ ji>#u埚(%rO5bBobor.^C?t:*gF81XN]wD lV O9N_ |`ɡ7H]4CG/i'K H:<5"kU$$Wv77nT$s, bFIp] MQW2`/.ۯ`vG ՒB¾3\׼6 K݈{P|@9 =ؼqd iZ_xs]m#%bdC ˱7%C} a;D::H} l@}{^R%U;N=`tnh*W݆Cż6 b&N\Y`A|BY==WX 8<}E/b"n^Ƞ$/3UBg#ں†@+Md'T>*ﯼ"gE%yi'igM1EUAXZǒ\ayO+L㖄#)R?R뇋%]ixc=>YaXVj<+Uyt00Ĕ68D񸩁303jv Je ?0C0ZzAC:&<m׿fK %(5E g&9K"O#^"):\G 5&b+!`]*( &EC<` Bka%PO R셩1B80UN&߶ Š-ţQdN+=)p$>3.T*Hq\D^N]. +ٛS{2?OlbU$#t0Ə>P 6kTo? Zcq6Py>ǂOB,qR׾l&B s7Neɐl58$dΫ8nq{O'gM>b[gF]e #HUPOC܅b`JPǁcN-vȱU2չjɟo<6.~,K@ޅ. a{!PJ=ȥlZtFmDR𐅑1){ T^is')D#Wt ZZҌO-;#Kg|kp#M"B&X"9)D긿:R8IJA6ZLW#3%>}[ V s6vks ywJ0Bh]Rmyooc?|v B@e[IE׎cnpLm+:\-le#oC yҶAWbeS-;IG0n[I[̯gCGwEK.'@-MWhwfkadcYrBRqW ?1UNFn. Qy,g4ASQv &~f:G6wVb40W!TO0 |iuaȕZ_ h;8Z, :0Wtߍ.<$!UI@_2%C56;(mosbvS!JbFq.,KF6gܭ S kJwBOVjvR2f3Pq&76lW4Xz?<6qy%O’Kcu)EBV*ѷ-rrg'~̔W²A+ bzi;zj Q/P$ e ӣZŶ9 1~7B3oT>R{ixpyBdQivV@oM,xzeHx|2WeھT–&;'ot x kmL2cˆBlEE?۰;OQ>*KO~|j'([)%O Ф@&oGbHB:,cdwWjG$kw^ >G摂)T_oTҠhɑ;tfz25r7 V0/b:lb6DDknPϔP @0~gj4cqzي-74+fTkoZHkWb%>N-_` :y.Qً(Zjf2PR}4/2b@&3) 0#oǭϺS }H~NQjH6}wrd0.hcৃG%!,N7<f%V}Pbj1ő -}층!%פErMZL;7{^;[Mma֠f}*e7VnCpͭ_/L/|=SG7֭oO!Lli݇ki؎]gzzqKblR߲{j ڔvŝ;X;mتtQt%D:@W1!˽wy]k k"usDByk4>Nf$?r\?}"gcӷ/+oS+UIHx7*MzSehFF|s8XrWl+5'Gp*xP WN1ПTMѝ.s0<)60.G]"Gh L[my.fACKdʪ)hVڌ}叱^fR}lx}|wQ^F &u]{%u`!P[~|MQIN)sH*ۚ&#BT^\@p%(Gwmj kШBͥedQ*sб8sL $e[:rj3;C^;r+k݆ӑYbŭ]/ųNrcw o^?驍XS X:eF ]JҞ xw+:߸$wOu]Eō8R(.Og&r֬fw2!Ӿ@%k肘A_e%.ʊtʫ1#ܣFymSbG'aI:SVHs ٽRl@@-mcxb;^"ψ},AS(Es0-ϊ\#\T%h;C MAe 6dVGXYˮ3<48lGI#\rr%5xU0:KJ0.nBj4l>9:RerpCjfk|B0"+ $+ `G$UT`GYbլ1}fJ Ka~;6NNҕq Ɂ<[5d@ {LMcJtCnvPdOi]/ϝV2fp!}p^(Ib.fwi[_zɋ ymAbI6sCXVhyU ߆ HM)_V;ca/Щ.γiMlg?:긼CL [g {hk=al[ f~/a0#7kpO)Aq+2/8KmA[Xnv#P̀_:S}.4(&IPR'H:=;6yo~p…PE)gP7q~- xkSb~>HLsH)Q lh@:qe'Dn , =?P#iywѕ8&8ͫ ߊ/*V$G5U9[6<ޥpB5_U{Q d;J(CBT}^D/6/sdRu{vVH#mvJ[ok>"H6}"1|FD0ԖHlLŽ|'cR׉Q,7,S{:>7]x`tΏݦxLRR7 U߂pin?xOFRRWtMpxz\7Ȭ)lS RGÞ7 ip]'wd-_??Lf͒6q5xoOҩXkt}zًBEL\yV.d1_xrHB`߹иYQ3YX)djq9|jac̬kQ4v9p^k)ԌGe_יa#dVdQ:`&|ϷxMax6TpZkN$mR9 #0Aá`#s6(( +1=+=!s6bPt@ZWf\"|&[1 HoZVt,Y6p}>ML\^ qBzdGS<+wjVCDLo`v~ _/W6aP58D#|쨜|̭~% ̫﯈eD IֻWU*o}ۡ[^@5Rl$ DC2@fPޢ^K)U}0E*'=gKFI%,ItFqkxcڇG FcAngf*1*}6%K{K0pN%^7+Ụ^B.u=<4n>3L\$lvW`m7RH\J absչ@gTĭ[ʄ*`Z#Wo;b{Wॢ|t|cle8Qj['8â-tTx4O%vOB!IOhُڣ(u[F7)xMڛr9ynDØ؋Lt̾f :8p0 ǹzw5'$žG`𘄯Nf |\>l7ɏWhk}AsYEˑ`).1x';ϸv9Zj0IM܃Qi(Vyf(tb=L}'/9r4ʬzD9\(dB5Ө;o_~LF`ڏq bO]|I%I P}ifmGa""-0R`OW_p"a''2PpUrKFTHks.2wMGs`]dx36pҕ;) 1(B$oIGgEJv2V^RDG*^6+WCZ2fmeûvfoviOeRQ/JzT_0U9+<\; ͒ajPI}=+c{b`eP[kٴӱЛ@$y3G!iw] hi6z1d,j2)>eji1N[Ucpo4JÌBH6ORun=9x3V,m̬*2W [ 5/?Cz4E0;˭t}U#3w2[Qt?`|R:ֆZd ^6oXr2Z^x'xEĴp3F{pXӃfetB"߷omu&sgPWUWkJԥ, 4MF}O3SzQV2zA5!թ5$s2AlU{;LsJݡ-oѨ{;O_6:ٲnVTBy>si BHro@0mXvCYm$^Ʊ"CfRƏZ5600Rv *^J.`&`KhkZ+K/>" ht`Aψ\( W-8=&:ĺ/< HϞ; WuQfݷgG+|bOf@[Дb*pKPȢ0Bq+xzS(0ErOhw5C&p\fAȍIfG'nΔ\~*E-SdElT|mFqd0l|9qMokB)H%WɌ%XFQ_*M .liViW$50Ai(|"ɓa 6uTY\vց;̈O}wTx(+&&=c$z&IbFlr2lښ4lny o;}fڞK*ʀIℳ ZD:.CGarS0g[C. ^VkzoUJczLJ5)J0+5 f:o ҳtĬB:2 }Rb/֮ $V^ӌǮsT<Ɠ݆.Al[PnQ2R~Coy81\\BoYg73e,PSU '1mFzKML8&6D?>KBm(NҲ3H{7ˈ[y@S=>(S.~v+]I]z}jۄ%גǝ3y) > stream xڍeT\N.%4$Cp[GwFA\}΀DIA$ag WSSca03123"PPY8[~k(4@Nv؈:o21󛩼-@`eef23Α t03dlANvfo''ژE;@ha A6o'v g Aolqbs4Y8T@N GW ௴ @п1"P-Qڙ:A71x;*-Pc,=?0?hllgc5ZXr_@k'7+hf7y @BX|?:;Z;;1:YX%_a -nk"jgcuvB#L7651+{&u[ Def g333[cA9_y؃V%~` t]@>^*!L,F 3 [ 8Zt߆_osfbgkF3kjKJj;w+3 o %*mkj[?@=o,ϻ3SװǼ_N.[Pe8R_SM?[,2pZigZۚ6#;?b ' wcX)9YuXm׌ޮ[z[=U䯝coCby[N `bs~se0sD&D No `xކ_`~#.oE_ `RXL*;I7zc/y;/ba}S-hmWNV] kbY[Ǟ_qx+lc;^K/ɼ ɿ-5;kko,~grpy[}ؼh[-L ٹ7˷j{؛lxYxZd|K7?η 2Ac}[,۷eCovov~-C:miߚnovkjdbd͛UwNۅl39Va?[M7o?[x?[<{ rk] c"/a>Y~jwcgT}u!fGaQ*gϹNS5ԅrig ƀ ;aWE:`ŋIz(1 uFRvM! :bGxOTWx0OÃ+𧢔2/pe`h LgbfE;ǹ>dIs#|.ގN_B]TWwKrdE\z $OX[o&fi?#Z›K*9眑>1i1#.W!9䡢fR-M'qqOsΛ(Cj2e zDhGHE@SL"ϧ*J!Hǧ:DF"4ՀFӢ+6 Ɨn°H'TL9z6?8͘->~üWcCO{L/? DEcz|rϮ)bjK/ 35TdLGmD2j" zSՁ4 jAᒒr>piaZ`ٽWTP\P]C(jw#ԥN" 5An. - ّ HuzV?.@V귴"wܴ rev)cFOaZw9~]b04ԣ'\tJ6r/6̈e$Oj5|So3Dx݉^v=axEr 0a6F=Eo92ݹuNzojz~z[wx($vDOjwCy5 e}XMx 8p0hf0*|3K9%uRƸ1dXxJ5"MlwV]C\j-i}N1XIqi`(WOƲ\i!i(o x5NmOAr/< G쌧E?yĹFĭw )aakjC1'n3;Y6<)މG߽S?)ӦM͠劶S`UO_pȩ\ݟUؐAs5a {rG" t e(4_pHoj( )hgɎ1&hU(ڢ:;BO>]n! h5m #;`]0/g/[xٿLnO*s'qdky/M ԎRJ5 V/ YI)>?_NtWD ta3-79^(i5xNyf/*NfuddF_ &nH}d<0Q_ R,Q0 Y=lj*$qjexKf qPt$Ո^?J`^qH%ə6cPs**AQ%=/E넙`d_B=n9C1ID`&IzL-Y/Fu $kfJSfw.mU&:_;ܕ&;C2ff#>Y;2Y|lz԰M&>3z"?>͞{}1Aa~MI$yM݊-,^AтXК qz=f\g (Mԉ$C MP#x)CvZzEQwq g]sC=*52$ˎ%?ʔҌJTXo3˺3ىr"tYBp,ʔlQM/*k;#dC ƙrq!hA2 _|7,KaO 09k%-]OdK"5j;-0rK~Ӟ9Qg؀`JnDWSRbʤB>KڡW<ȴ3Iʕ^>^ۍ#x NguVG@|e)A! N.odQ1Кxڝ>J?Ap2!7sfĕbg vݑJ 2q;Ea"ks ?v#OH^ 1>}GPWH0+p"ך:Ml@}<'9aL AeC:Y%- #}'0-A3FK\Vz$'ônv]D!B8DWAniP\m.?jG)wVHod{PЭ#fBrǿHH8sD=;AD e@XxQKݳls0J%|x|1_p=(۠2A^K :;q^Q*TH *d=:m.h7lCYs':70jdY >}AM LA_[5%8tH_#8'TgH).SǞu.Ci[ƝD>ekH,W&3lv wbkHU5EYs[jʋlkwX8jzŖ^6|7 DBTOi[0ʹּ8.7mx]Ơju1]䖺IÎbȅ>uUw a_ƑsaPf<6k;Oe#Nd~-9 bVl4 >,RǰMթh~]vyFp#=!^^B,/6EZ2HDlD'7 (\q-\@D;ٽ X[Cңպq Ur;"s^ Xòz'9` s=iepށ::)c`A{p*s?\s8weЩq>@H×pvI+݈/#irtW: <J ]fUjlr嵊`n!(AlqjcFQ4u2qS ޏB:[YMڑ{/\`CMlSL"Pu1~t;UwȚ$!u60A&8"w̻Z/cȵrmV-tb̋>TgiΙ k`w\?=ˆ֯QK9uZ^r"kDg}Uz`iݜ 3.) vAPT\>{O|5Vhi^Q45" F|R:MWٟ}_SfzeBWy_3L2{ K哗:a!tjZ] ( 49 xnFfuh*Ɍ ]V6Qfjd HL89S{mʖSEㄍ#湰ye, |6XQZ{W60AX]C¦ի\-5f%`8u `[˲ 影n 8|ݹi)O88QBߛ` am C^ALd5I+ar/,/hl+H _t '/WOr; ť|3 j(G @>ЧuF[b4\Q;:z?;U"Yη16d脩j]{fh fyy0Q19rGW]c[e!*91 mTʵ<^ |mGbYY*T\a?3}>̚2.9!!A$!\Q;r qW@g붩$!A`|J3k̋c%&Ujt$ߘb9i9۔,ډA2OO?֒D/Y[0r"ݶׯrpV&:>\~쑸k3G#)nvXEȢMIݥĬӤrŋRJOoz/AIFi&I:&; W0lߠ!}WSLnl/-GWKSP42`oV5 F%]![#&DN֩oi~9HKox&V:ec.7 Ú-Tݍw1KR@ACn+'9b c74#vy&WPPv6Fn#.a7 ->,*8 F |JdQ`|&.[DQu< 5υ`TI@mz#a 6 ysZy<*JגEHS={3N\)˄U :*r^RMo#,i!f;i=8 eN f0X,9cyqieh4cGI5 #u>u2ڋq]Pۄ᳂E3 M虨78fGkD۔I6gPHicY&%́Ub 1Q`5=X9~݇QctDgOq%yB}=%M7Sm$OZ6z\ʹ~' C>ӂ\ 4يT@$Їxhi.\k!Tl"(lVw?cI "<#n%čZK,4bH󗏎(QN;? 8ê$pkS@sPt:Fs|36Z?G{~X' )g:gq {bQĒaRj7dsQr NAbEeU^hY !DxІ(QsA]e4GƵ[Up EM| @,K"-ŕ4fjrÅ_v Z:j)ؕβֻpf "zGv׭z ך'l4؋_.mPZ_,z5EvV[$[ReeG9=MZRq=+3gJ1X9J]7 Vʭ#D9 R3F vG/C)qu)7.9P)x!+SVK/Z#\MyQb3uk\%xc}v0o#[A,R4yKR&',0t=C9͝\ JK ۭH~KVtEA1 붋q. +Vs/p"- w2Eq%CuT+NԑKRɽ&2G *_^s$] F DP#,_"B`ɯԺ:˂HMZD?YCnLep3'PI Q)ԹNt"W y㤚 :(:4b'㦬"OX*p;]ߏ;%g#…p5ѯoa~$F$5kXd8 mBCZH?.CjhS'Of~ٝyk܌$IH4,cYB`ǶΒKʉqYfޖ5q%_ L!N۟8Y4Jsg0) &gK.%CUqPz~\"΃b66zQrɍPa9E!(.wzJ? ԄXz?FuUlީNIAgg,̖<!]G3wx$ru{6_Y6~6!P}lM" 7`8'*_w%}\h RԒFjjXΊs_RfBeU:^gr^+Im HcH'U8Ĭ6np[C6s6bwb4~ <,K/E|mC[ؾ '= 'pAGߊ8nwI]"f1j$^;(.|iOE^ ,_1"K7q6/$iaUci L f!y,~*`@y e:Hb ₈ \ 4<(t&(ujp_A %C=$Y\`y=mee7.8oko11v uB'bA'F]PcN6NٷOw\S 351,\k(fp6BO<.b%))Տ ;1yvNTlI3i?BrjUH'U/EMq;=(MdjOEһEDĶ`~ڗ_Ap\௳p8$Cْ KjHut-t9Nams8e9+ _R< otx L4ȥaL"= !{MdZG۫ʜqc*!eJ>ɌoiCK4YBS$bhz~wp;NʃyP{qjV7βƒphΓUfyWLnӈz91;*G$R%Cy yͦ=d˛M,A)-G/VM*^X#dߑ#Y,}/Li#Qj U$z&EPHJ1_S}ǶN*Ě22xsF,>>8 %hL㣶z[H ssBmfӹVx6n Hdh mTϡ-qJ8.T%=Am0Eg.9o^=}NzLT98*&67=Em0cQohXFxlR$*QT& P˝.y@_qGVk(gaB9-{MF )mKi^lHsǸwTT/ғyJ:C^+"g|{)z0/_ox)m#ӯS{+q󆂽 m &8PxƠPGV!om>jǚCz`3늜Iz74}lQ]cgi6<;c/EYāETM}etgƨ3߭^J!SQ:*0[TkQ!VwA\ڟ/g sM)/ &l8]#T\,Ԣ+NE5> ?4n8M">3c 50~@Gu0}=`I L@~9Odw,t hG{zwPWsн%uL Iݪt_7|I<2N+u*5D"=Ѳbե7bnдҸI\ pu3AZe*Nҹs-f.yM.TFVh^AJ ^ĀN<7dVV5-AݰpNw [ȵK y//rܮdH5o(V 8;Iz /u3GmW!hMx.9}L<v=1вmYL uSrpYAE["z fyV/bz0 Ta3iKb9;2Us 2܅ŻBE0B.lLuXle8C:rfVK|׺.Ҷ(o ={q؋Q鼙`:)Oi4"Da]IAarۚxUF3ѲkOOaCN0Wa!Sw}ɰަ]F\h&YI+94?F!o8 Oo ܎۬?Eohk-X ܛZן0.DSNcjÀ3zV-axb;cvl\y04؏ ; x($݂Dxw U<$J}cYV"u=M.es/d^;Hn~>jyd~)iHwd)YF #j) r5/Q2NtMNkzKx.#evAb aDm'naߪajy ~Lk HY.L}_w#wmFtS<.vү}:sI.fMlMVȦSC(S@[2\c @˙hɾ%GGڈk+F}4]4ow Q}7az+SbݲRvzRX\4[uK<p2\IR,7~I~/>f!vbJ! Oo9 N=KD^[ߘRVz}CmVyw  گ6li  ֽKn>| AͨA=ncd19ƃ0=ZAmK΂}[>POVG1C^LwOkxֿ7Ve9ĻdHDݗ׃uP" d@?l`+sf hGv/p}*k2IF6h]-+?Sl4#nt w5Tڀ5#_΄V wBgU !ވbg–=jQ6D/ "Ġ{೗,E{F9:湜veGGerڥvZi!1Qł#`# 6i/`^32 <;Y㒋HEq/I`R d&2bAgNq`ZڐGp^*]B9Kɱ ?RYboӰl&fY8 ZLAVpA qMjjb&D^h!K!%< 38)5^*4tlm<;|/ͤә̝eyFn=-&*` OKUg{b4*Y@ eYZшdwZ_*WK- x]=#iNK_ cOQXt0ɜr 5WURJR%{2 f=;Fx/SY?x) bH=UC 7nc7OHp+g &I2ZX S&\]3NGuq~ *}_[GSD2|ZEvLycM 51w.D{ v~ߥ_8J+fN #x _ #'hP}?|f;(R6/%#uD[G\`iCfڨ$Dhyun9D 5B=Ve%܆zOi5Q\W ÞjYyOUy E B88oXl|sm:WCcb LLX'fpf0&ZOI"?rĻqBk*zys1J`!`.tϚ9*u7bf'G׌i×O2Ib98k;)}=4wi/~qÜ4za.lBYG]G>{69 qz/ua)N!j^؞*\Cݭ@gVqN+̂21g6gYm:-Z}) 27>&,>V%Pږr[ٰ Z:4S̲wՓq3Cq29,Ҩx=aRP\jl=1T%vwĤ%voEw@腷!@BQx.bL汙^aNpIfyjgJ.bg9f۸s*2n4bt }ao}{`򫅎\D}tKj-!%Ws>s+­nΚRUJ[(W#wIO`'36bQ6rz7+j)̌~ݥm~n;kjq8O*ͨήy"m=تX^0NoP&3QGͱyUW%A 'ckmgf@uEl.zh{p,$['/RJJ 5H&pP<镛҇~ {U~q3z Z]NT)P\Ҁz =.lzi uJ5W_Nʄ(QgQjk+y)LDK㿁 }W923m2h1- qByjt2##Ł 5g}̳B8<}:;mŚE"a/y]mBvGQ\[i 4+xGU͜);>G<՜8h[lZ"麪ub`^+ؕK2hBy3oB'< MZSn de3mIvhM8wa |K;]FO'_[ 5W-q\'!y!БD}#Д39O+t1%jNCO-ϵpEeG4E\Hz{:.gϽ0|wBeOkHj{Ԗr%Xc$D퉱Hs?قbeepR/Q&3GSmN?u1=-s}P}?$;V\q¬R2i<&7|IhUeȰEz,պ'1bkʼk3ǥ~ \#zx'wA@I넂T'%X!#L};vW䕀)Nd RwQͳ ٥_̈́8 _auZm` n-3'E^H2q .͹tl^ǣnd8|c0("L-#}V <|%b=-tϞ]iV9威shS|anjuX8/VlŤ endstream endobj 90 0 obj << /Length1 1370 /Length2 5960 /Length3 0 /Length 6892 /Filter /FlateDecode >> stream xڍwT6R HK7 tw03 ] !-4()%!ݍ}[us]ZD%m(aH.^n @ ~nItma҇!p d `Ma @$7&ȁ=67 A8Lpo7=ߏ5+**;vA0@ 8V;:pk(H'7 wd؀R AC$w񃝡NuGފ@ ~+C )W buwo|+iӿ E(@ 6P_|ˮKiNPDz\ nex@ܒ rYm~ɌOPq@\|yohMcGކp7_w*h2#ۭ~_mͿϿ xAq&ա-gUT\˟0[z"_s}U?q)'Hќ, b92 KVA,qvAhlvS&hQ[$L\ wV\"VE7g脀. +ݺmDǸhdJGfꮫ5w*Cqd۷ޞ|Jp" be(H2(2'c](1G[iuiexE}gmF_CE)"W`|d}hF/jN~0(.5IҪSPbE,f촗oC!vv5!}Yw_,a!o.oqهW؁G[U,JLقdOhBS+B>1| 3^iAK c݇'EB/=${&Q%:(wDq"F4g]L21~by*WH 4:t8|-0B ja)-9'Vuj:0 @{<=- mE ݖJ6rJeCޖ7FcsC;۫MAU-gi@1 ELCӳВe # '%EIP?I{pC2bo7j9>B ]MbeFtsWc ?mO9uJКoD^):4$Fչݣ 9x)&UTǾi1 טmJrHƑH)z!%_B 2~Xrz]Z^|.̣8*oX!YI:4DF:ɢ85鵣v]E+ %r$s۱s(e3C$vol6 Gkч AI9*4Gv;?+$GvoK-$Y-^ayr+!@Yg)ǡ%,gAt\ZM~™ԴzgvQI0l72ʎ_9 LQ`gYS7޴Fwt~n0#7W&DX%/KRTH#P71v,3V\hj$\ۺd`8 XdM:$w*@^EWk'銳#], jL|1܋3iwcݹ7^݈n/Hn>}0Xy'A `?->P*t.WtPD:xX-dL.Z{|J Dr^x@ݻ@Pg ]h9sēSIa/ Id?A9[IP >=~fMk0#(3uVHw BGfo`3ZHڼ)͝۝R*c9kG{?LFOokw-qaKP_з fVd=џoK#3df½̭ eԜC ۂ.pjRUpY˻LXkP~+h;+ӱð<wE&\ǫ8{X͍pNX]ꛃW .s Ke6@FqO 5YH aQCs;N)v x8aN˕SdCЭuop,a2jL@GR+=_v7e2t=3h18P .Q̛dݲ:#cAN([ߦVV=>EN]ZyZL.dk*ƭٗ d:ep9xBr;֋p3V? O&-& |ga0$_/cY##Loz#< a~ɠ?IUD|GֱrwE "Y[7@f|,Lz2͜ߪP dΞ^hBOhggs$t8@6\AubTWj<,Ue_޴ͻ#p_ɂjͥ־3N*C&F:9Տދ:D-XW`/q.R.+DWzJR̾i}.zv:~P/F !-rMN *,P~ ߞ jV_ Yçb4%7h|}Z^O/=+ʊ٫O9XӕnegM^Э2KYTruÛ`T;e U"o6o)cSh4&l&"7%"a wã:mL*yloIkew͚XU@fù))o,].` gmc;uM) _0v! KҜ%G Z\ݯ7GJL|pu+!y]>KR,IyCUrUMӐm3[˲cV-CRJ V>Ԋ Dy>mtU >CH:\wX}s-#5{(^c+)RE;}two$P$$Zڶ膔E0Zq? 2⦓L8uRI1mg21oL)˴R|îrC+`2?,KDIlK-9.hq,ܩ}fjs˨{sS<*{۟:#AZ؏DrZ+nt$% 0Pe+4M+?qbdJѦhi#IXԹ> &CP8vI!Cu3\CVݷ.У&%B]ϓ'>‚^ &sFt':z\͵srKO̺o(J|m=I!Jt.e6 n"V'Gq*OR{8O`̚AYrVD0EW1lL'KVT,IJDlεQNx3etr 8z ;I9kyW++mC\+iy63b6 = ]졯{xlPǽ l+Kz|,G^c ԟ2.j8$hF$\8! d)/de[ o r! mp Ű\2PfŸ4,*8F|Y_WmdL|;+fVll]Wcb$*F/jdZ%̄j,*eHFoTl֙.6ƃ<@;zB~tPV A>/zMY@i.[>wW/ҳ+QȾ: 3𨟿$r bj`Dz0Tq_~0=T$r ޳7 }?@Li eb % :{&22JG{j:&_Q:>/` 5uP]̰q>`}ì֊*Hm#PjV;?M2/&~N6fXHJctFCMʻ,n(ZRD^H3_hI(NY3sa^=nq0FphOLZIL&5Rpv]3S+7a/~Mg%S?Q]);"J^(SJȺT0V HH}<ϗ4Mg@Z/:.{,n5ܘU ?4\0Pb{2# G::6 >[dbAN;zv#&]zU>ص> '^ HDJ~F`7 Ҫ!gC?ʏ׺B7ǭFLZ Go`2*NZ[*&O4J_3֢pؖp]cF+ ajƼcuXameđMAl]5v]2I?T6WTa!+kY7lH "|~1-fv֫̀.b9(&#> stream xڍvTk.t#%H#1C HtJ0 00Ct7H(JH H )"-!9k֚yzzp +jhF,udH\#1F`̤Wb5Qh@OkO/qΥƲC IeRsG"7 %;+4Vރpwo&"5"^p>Ö?v_*C"Pp}k@J }ua)*%UQP4$+ědIc{&1 *Bc!v<Jk7Q_&b{ؚ91~CCo: m8Pd^#kJ4?&~>d+cIן( c:ߒ4QXP~dC HG-H2FecI`ɗro,LU|Ry۲:Rsbb90i]-3܍5MbGJ ' SS]Y;w_jK1IdfHʺ WIP(EHn r}j*co-$5&*<7q:@=‘zpՑ[WTiv]KavnV\8/Dxp:)Shs679_g\ d, +^n: lު:8mѬPw+]r ӸRԨ5\B؏ȤK3])R vnl]eܽQQ+d0f-ٕQ[UŰQbԔMB6 AC ƀOfhyMWRQB@,vcQ>,gjјJ3cOS  ܳ F+Pe*w뺂ju4Hb]&6B_=sp7#ð!Y@ >7{0n|mKq9Y/$Eپ[X}C*N4^ܐCL>M)eh@TRF%Ɍ?dc:/g|ZwtƵbjbƂidreb(\mj9Xʆ0lESzŠ) M #p?0_PnxI|ҋΔY?xf_U0uWFK:h#cݛ'J |Q$W>1Pl,|JNU䅯ԢAoy!+i~0ک0a~%:R*n#s0/ !Y$^Zm%W+fAБ??;~AxT``,I.:7&q`H?{20yMZ0}gj|:,nDž{̕q遂bΟ}y Y1D} }̝E7, kl *.ò&369:Rؑ9mw-SPv">u᎗Kaxhϑ uNCV#ލA⻩;9MT\d%b;_~}ʧ?bb/OHaKeںQd71fO w+7y Wd_銶l 橯dLKaR\w@Z_wfn\[݌걲sa1^gli Z`xqLx$oPgΔcYߐ-!wzlv^jP;hj*jg[M\fe͝4['׽҄V;8JMnp|Z˟S~Jm~AMCԮ(ʰ3'FK?:Q&_^BbRo=fC>4:>'D,!{|w#QY>~bZQE> +7FX[Shl\,erߦ\QH[&/V{7&t# ;#:9:̡JvH/yHr  H&_>W^``@(i:ȡ"$-8)ʤ|ރGF.⢇7TS׆#W;jyFl[ҸZ72loA W_fѽ{%[eXt<.@U henj9d;ܜ;l(oas9- Z5ugBr?ΰr5YYV'Jm6ŶE/w/a-JBau+Jɍ2V9XnQKnM.߬ਸe9,Qlڪ邢É\ L &W^Vd̫ewGNH Ώ@v(^Mw!R1RmEz^VCB:3jZYXFv2^w^bcpJ"F~=B Ɔ&vUYzVDܡEo-P@YMoM4&˜E'wKKt\  -`m4WMervTf9v? ,9O3go>uU-4 q5q\!!1g#b)LJކ< >9 AYebBF9R/yC^voj6Tw6{'!_SìWj8a.[G&qۨ;Uɝ6u?WqkGy.gN_c\ُKI?ܔ7^>5K+354[9׼naM i,6L`\f"y׌i?y|LDƬ!}N|eNoD#YCfo\IK9[3-Sҿ𸘛~5FNǽ'_#St^=g1)]:Y^CD{2f߬ae9DK8GG/z's:YIPUԜjXUčkɾN> ㅢ8 =3\q?jV͓\,\_t?lo~^)BLCZz@(e`grOsK6UO$~ֹ3觿lu3+wrJU ji"1FpꈩH.(ؓeI\oٓ]9D1tE^ -O<)}QRLs1;4_|ᦘLfsBiORzpiIy BRܱ[ :T󹊎>}%2(O522_¸oTT|aZBD6Dk?X==ݥsucђL4c4mNΜS7̦D߅gMo~xrUգ+)!IJsDix$>] +_ \1jB+"?CuJ&:Lȷ+_CgW'ģ}sllHoӯQm{ $A)$dzV @ WdUx}ePN5Bfj9|qGj cX pѭx">k=Ìm-OY7ߎy/Ut0ѨRbߛEϞM|s'Y_t }Tc|YI~:Sɧrjj  aן6Xߊz}1[#kc8zrRl1EɢbEB7`9직e8f˔GY6(_*AK^,U1>5v :N"*z1Iuh*c `cqzp|M!bYpf7(.JRge\C搓'ꓓ-_|3杉U0U-ӲL',5O 剞fhӪnU7}|g{DX.KfI; @#yfNS%YZ?Yp{;Etj,"Ray] ,*;ig0NMZ_մS+0?sXo0חV]["yZ=lX&"8Y1uCF/_XIȕc |;"Sz5kf*z G˯%C|/םس/Kiś+-sIh';SۚIZ7Ό`O;ԏjx8r:2 }棲|UDr ]F.g\ ޭy==!9 &<z=@[v 03z=ܵXr\o5x,WSC= H|^]Wz9rM sLݜG VU2#Wmy%pxie.}~GwC;l}s$E˰ ha| {WNi8JX{}37C^xIA=@U}L#jY.Pn(\4G7U]t/0zMjAd.o6-xAH.&PW3&R8s\;&JF963UV/p>'ϓ -GeCƇ]nZb)hqL>-v+|۠ 鎁,9j']Ԗ..<P7&.0+InY=bGKl܎Zh,5NW5ࡵ)~;|*=l/ЍWJ1E 5 Gϓe"EQ"CXS 1(qRwII Ow!#tǭ?8l>iyiYARïP/.FI}|LNHY endstream endobj 94 0 obj << /Length1 1397 /Length2 6309 /Length3 0 /Length 7271 /Filter /FlateDecode >> stream xڍvT6)%2Ftw( 6`6`#FJww t*R*"-glu_w}p(AQv05#ʺ 8#1c\`a23;B/; a* B<\`qXJ,-@ Qr' PHGu;:apiee0w= Ѕ``\F{ eaʉzyy!4xK@8`h' 0@ H0q(.p{@Ba\r@CCw޿!(+#p@_M H/"Cc9~Z=q{2)M}RREnUYu1ZšuhsɐÚK w_7ۥQ27)oɓso,dL3)OqTmF{P—%_LD<q&>1'Iړ )>0kѧ`QO6NАM\DbRΌI4_iAJxtV6NtWEqRj1#Ypeaiy}oK/iQ.#0]\Uc5NV\0$K5kln5(~!䅞!w{sCfІ_WCUr9/Ƹ(H"Zxef6B9$jjOi#x(._F9. Qж33jξax zS\J>9&{mU PZryH3ʋ7lgw9+&tFyHdV#K+ҥeKWGۉ*ЌcL#(hn­Pw]Yo <"Z4z"c*AŧH)-f^|S40\ Ԍjd[A\$ FȬZzԍLK?hg0g2on<S&Iw ފ dz;),_\£~2a*I[~At.*T6Ϝ$TNP H6N|{YJ,;,Udb)ׅ+c8f2I7 迸ʣKO?E(VZ%D~[+a =4$ԯ1z@rk(gJ`' 뜷v_}PX^nQ+A E05[S2)RrJ|:N2T.9*K5O 9z[rm\>Gz_5gXDQղ>]);.Ve6RZ|Dr@e3tOV ;+6$M{~yJ{t"׳xc>s|c]y39pvmvźp= Lh ",UjlI-9-ȴ}峯%-4 "#cRwL^Mq6FxIMw##RI$yp}ݕV3lj`D̠zb(u0%yN:x13 >(㳩GEyUֆEݯzw **_%ѽy:n5\~o b^=Zh]"+|0/fe3=<롉] U[KIX˛ e 訹xc(}Q{2?,jr(}툸b2"K^O"Vq""S| lrOv#V ģ)k}TcፁU!B"w{7 cLr<5 +Ix^WO?l~ ='29*}Ԯ00<+dUsg6]0P KYdk;q9u cV?#v;vE}@fɘԠ{/)Mxxa?dW D x^,ԟH*'!\]}J %? /Q_+,Cg_v(93X.N6pOrH=)]9ޘ{Xv;SG?k@L˸v/hI9܄EBr|A>Iٴˆz{Ip*<ʄe)˃Zc2 W-Ud#%и6)|Q 5۪{?z-@_7t}N9 xnkm]35繱[7q xU|8Ƽ4V`E{QU~Q1̗@=)ZV% E;7dI6$.&0=ZmWJ>&8u0!j$G ɷQtB̅UO'u̳+eE)59$g.FZۈt<,_^lj}_+Z*pyߏڵ71"O!bOE{M:22?!ǷP}EN20,633Q0$M nscC7h}}UA< –ɏ^KN|W~iB4!EI(RWzVw\0J2sE˳o6rh;iJF0uBlse"}Ѡ/\)NrsZiC^n̙=yiP0nƤ̸N\ǚo@g.6 390 XiAqG;pK'L/>a5O6W[F}| ~Bnhqq@7IX>8)$e ĠUO.C6dR ׍a}RߺRJ_g_|K ':6s}QǷvyTrl>ƚOpnTZDU|Q+ة/S%%O9Ħz-M\Df=]a !lb^fQWoTF}rÇݞgzFݲLޟ;:JY9u\ٓ7U`mĮx2Gnǘ-TH"0SD&gkY\{ϾjGOrz\%usdi)BM"\[N T!ߧ I&g$j:Op*|ߦqT}84͑qW=#O$sS_eUe7Z 5;9.;wa J>mg>dU[i{NE42ޑ% V6DgÊ,o47@% s-U&9o(8PE 74j>VyCB%=hle-PZxȰmoK=?zѼH?!09x?k*M7syE0e9}#~v#>g߭l-fa!6+>n$wmq M=o2=ŽzD\TR$/YbOm,|}GMvcVuW=fㅴ\Y&Q.%,HVӣ{<뾺&!Bh@?#|I2YJ}nC_(NYẤCzB0M2g`uU/ V$Jz+5|r:p$[iI%CfXCX i Y#*dr' ¶ʴYEӦ*z^#CX:DR0L-Ĺ[h f[CCmX|UZApxs VV^v!Krчž) ׋\q>{ՎkY0a~,SB1ASys 'Gw%&>w7M絶PU/'VI:<9^xTVbC >9E_7u cb?~(<&F]y\MW5Nc]-ءm$ڹeJZ7y5kgm7Ikj\X3o5P,1g (F2}Y2׈teM^gGIt` cwlƫ1ﾬk[fh+5޾.kQejdS]\32ymy/EpnAңaFb3<;r#aV?R|.HmE7[=Z+Sʳwz<8|xW3PҾ'PS !~M= J∜2gg>)ri~+}a@%.~"*ȹpx3"ot33֮Qz\ûȍ:QwQO2p»cny˙̼t-gRf氆Xɲx°>5&J"g#xyzXe {|1+9J#qB~D!ɑ fـ!G>h e]Y6Bd]fʍihE 4efɝ-ڦ'pnlXͤ>znN;ROY.pЛuu*oœtIlH IKC$A \}r+*qM&]lB6/_= ƒh ;FIЭQau­2#%ОyS|BMGre$^QWnۏ|E:{{Vo/VGuBrf_qW4y#9as-{8"1dQ 8aUɕ`1K+*jT"dejH%iK;_a CuH1EE*6&ډM>.{Iu![&:;s4yF|tOa=f$6|I7.3d] SnٍHaiW<5giP[uxGs } w^#~_csmωӰTi[Xyѝ0$ZNһUW뫞33c^{Qyy_'Qܦ,Fu T}$?Ha endstream endobj 96 0 obj << /Length1 1398 /Length2 6290 /Length3 0 /Length 7252 /Filter /FlateDecode >> stream xڍuTo6-NPFHK0@6ƈ (t HI -!(Htglx8LET{- /" Ld` .0š0h堎E@L'`@]PLZ^LF rr`POhbGE!2zbrr2¿Á, E xG+" 4P?R+:n^^^ +"^(#C`=pு?<@3Gnq{A pAh! G`@S}Y0@bN7W"w0øA>(4rA oxa  uaPO(jOp9xK% w< r@8˯E!ܲ&quE84PXp>6xPhï!nhBG C"@)DxE7qC6 a܀!(z"x"y(h@Ѐd'?g(o L'[WLR綵ПmSSxD$@9))PFF4FP6A;`r%\ӿ:K3m  Hn_bTc,/wC<\\~3ׁ@Z3Wӻ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 3RC endstream endobj 98 0 obj << /Length1 1613 /Length2 10311 /Length3 0 /Length 11359 /Filter /FlateDecode >> stream xڍP. )%8wZ$P\K C)Gyo2oZ[{&l 9GS aFA끜`G?,A@سL{6Tu\\<.~a.aNN7'п 2@W%@A<6<:,\BB$@`  ـ3Zڎ`B0`Nnnn@(83+ h gW%j@߭tlпڎV073,[ g%PwA2Vˀp\\?N@b ۃr*0w+hu|@g?K$5j vA١`?z#e!Ҏ  G}2`g=8\;_ K'] HQogd S[z[p@ s>^NN6@>`+ ]@>^T7BX-`s5b_wpa{yꊒ,o; <|;wUX9*yN*o0 ̀\?D7x.,#[z ?zog@y kkuUA`*€ ~f4/;'_r0T,lb_r? i8B0^{^2 WL?UＲ G?tvz=3xq=o%O28!gs>+Gg?.!/$7ph =Fa8Bgs@#;> p|Np[p -\?<?_/d6;h!d[t].Iƶ9͋sqRCu[3@Z'+rFmb+fo;΀d;)Rh |'>TŅ{KЌbiMtTvfdʮ(C}U cov HAA fɔR E:雑8JݛAnBVxjyʞם~2eqYLMA̡C"?ON7zW^t'^Ls*nθf"U&GlN'caGQ<*z J4\eoXh|xR`2~4ט`ds4UrO+{b(B7[;>m^67ᐼ80q莣/c␴6q묧K0T>k #{U B6-?$z6vڸƋ!TpE@L(jab0)J!7)9>X?)Rb*&g4}kxAߣe%®* /U*Jhߨf5c$w^rÝdUfU6*YJh쬠VGb7;+Z'kĔ5Q_{C2U9mZadVeX3} .y^2d/_$mVU x ;o&h*6%w0"J:C6F5o5Qi+Mw яqs˾j6%Gfs2%+,O "1'5)p?0 -!x'tM)xkF|!ulY/ϩn'ct2߲֩j%qi.QqYΌZ\C*?.t?cb lFOyCiE(ψZDlg֕YgS# =bMD_=MX )/2eRұ'um鼁6ó˰ bGlDa-.*D+}GLq}=q"'3O/kݾRo"㣖w(!NY>֏c#o/Z_VIqʲin15~Q9fb7)G}fq8Tg fNnFgo\$!=܏mo{&zR/q<p~rI ]7 53@᮰Qy v/ INxԝj`ga#W7aƂiZ۵'6]p3͞r83U;[*#4Ҳn>R[)9< Ng._ݚY S0GU‰*VL*#ҷ$*feh/`~`SLSd@Y#fCLow!~3C> , 76_^=mAz ?J,arlT庉'%5FbZ 91hOskIT5n5i%Qn*pu =@?P4֦#C4N RAdvCJwh̬ȈQJt*eCBAɊ.r|IP˜OX?:wMelT6ں lm))2vׇe޸1UE D5EQW!WhF]3+YSơS|A/T ;JDL.LxՏO-N,C+G"J" Vk~ysݼ\ce~dކ3Sm S|`ݶӳ#g5 fLB*i g?`0?[j~1zH'&d\h~FM9%=2Q/zSos.$iV B!tDzd.ᮙ&ʺ iV7m"VƂ$9<y'싟 #W/\'N yCNIȻ'Vi`Ʈ-<3:>V c_q78(؆sh,2&^ Xu5M&&Kz<zsVԿipD+&[h&dWż#c 4^ ߟ1͗ǍK+@X8&C>lj *=s*C爕N`Lvpp>Zr],hrPPl/y;CTT<7*8;=Ғ6;t=L|B{\X}}_җ'bbKYޕ}Fͦ^ǿ<)QS.ʱooQGzY,pt}2>M; 1+o#Nde]ak,rS 1C3zҍXҾ),. sᘚg0xY̘׉f},VxU0AvX^4B4 zb.B̳q`6iFGpۅ{60+o{06p=Bڼ нZj2:/ЦnCĶC9oks S'ڨ$3ꨊ *m"-j(9+ lq+sԬn*a/SF%NGLThauȉ-1PN ƒg&+MJ4/2SRt%[,EߘT//yTj=Ja3n`NU\պt;X<(iYc8lczїVq~x4S|YdBے>VoxR5_:~y F,TJ oI닖<I Opq׵\Q:}{ &3@Ͷ~r5qy;ttSH}: ELBn}:yFM1w"?x*p0;rO~w=/#nljN#=QZ;oq7s'˕rXmLdJes+覬B퍞5 NE"qQ] v$#>SbL#Q'9Ns#3]GCd8yOѹȊo:KjO$I&}HoìQp$={ Hꨆ]/ƊUzO5>":zuPN CՒkRw ܴh/_ܘjgIC9;kX=s!׬rK3c+5,X$EZWOz#A6d[/^~{ޑ?[HJqD*do>)ks6P x.AZʔ#4PK1Omcq_<0Zn|?߼ۈg!zX쯮B|u^֏|YΊ>A#nAf?aWMiۺ SqC_vر w )dxZݤc =,|no\*EtizR|T#%i_@k8=M]|u!e[# C5;Cck O{hy@[>Z\V0zB]~<.OWoCtKA ?XzaVn=ujCM* / 'ߎ̫f_y(k1Si5maFUU+ꩊHy,D-(.yj?)FĶaw㸸D@bqz0#RUevsĸ̋p^Wv $:IoQvdwZ Qյ{D&| Y^YX$JjT6Ilōdm8}\H =!_.itKDdhaeM ϜJbX˔uH<"Fkɯ? K* zw)єE+P /?WQfFb`K^$M]F`?`drp 23/ ^/ "Sg.L$ =bwy*y9ڻ ^V2ʰ 0 |aM4~U&J$5 OZ- p?Kkj(9!AOϘU&eep:~ik9Q qޝCƺ/ۨ"/kaEҹUVryQ؁ L32/)e fmtw)?r&G-%lgpiIg;qYh~L ƀ+s54dYBJKό~&R,w$DZ[#XI5t4!5WAd n8\Eל j7vTOR0Zf'(勲 y야tSF Jb)C+zSez@bzxS IrܣU=ŷ~9UD׆t&QO~|c&dN"/jm0.ל({l#Oxڴeӱ̃kt.?0#~G > "^6fgD[ ?5BS- &bUl3Z}x#=U21*+! X4B_L{ᨘ\BAlK|Š:*P~G ,}Fpie &U[(yUlrUZz荭<`*23VB/;(J|46ś3Xu?Ex88n=zIPF./;8t{c~lg H}Lzio;ieeڶXt$2," nݴ8FaGuLư.>16iME<8 RD(ú%gM/ w7kd筲OJ#ecoBkEF7 % e6{ ;YX zyWPN%,#RyZշ>%~y=AmRPժ]9lF%jv`_G1.!7̉Wϳɤb"!u>Yq"!ܒ V;\sҧY]U^K[ӖzCBYbs/3JR([ :yZ[ ?b52&$8JlnϦGG.7C=qqKx6[)fJi .KrgJ%fp6< q s0v݌`1${NE$;aYSkJSX ]hAeM(B4rJjxݪe;>7 O XrmWDcGn29ؕN[ |$/hƱ6u$ϑZF.K1|QrpG.Pޤfڴ~'2*9%Feq g4Oe6gX]`ul.>+V+RTVs W!0+(#'{䃜 l)?E[$|FjJdWT0LcT@Srך R2롳ǵv A6^Kc S@ d 9Z.~A+"'ڌT0(R V,.֤w2\SJxLhY7#fKɔ-*N%i-wNkJ}Q9š*ll'.5-YaTyʇR?q@if4q$nGb8[*3s;W gU3~c* t׉ .깿nBx$XYZHX@k*%H͜C7q4OV w8/;N5 A4Cp[@Q$ק }Ye?Ԍz9GxD)lX{41(d7% ! 'ICV%*_rHW+.% 7FGoU('ێ5]p:|mvgD\ǽI>rƙ2 AFyhBR`S7&6HIpֿ"!eyY$/_D-^,N/*] %/LV63j$ %S( 4 kB8/WKF].E9w N 1^r~M Ց쟰.M]o`jók|~qgellatE+ @i.%65ze1BaLJu{o ?Ff>ígjqklz@,0{2b)iS6'PϬLʱdjfInLQI5l*b`DKնwލ5Q~=Ңf&TMjb nlc-3O6-\H[ 7%K|Pb?tʉ5KP,zsw`lE̙6׻8Y:px&ko^C;Q2> +RdB:U>g9{kӻ9jTH;/a>GVLJ'n;C5|R\s+$ 4p\{YY݇IR=ht#q?h[68ľ̓hf>車BؙaN#d`XM_ X]<mmgj0~R@k&q_7*~B2pLnN{)6U^ #;Lm<-sr(?yz0!%,uy ]xi}H>[@>4l#t-r}%'4!(;n/>-܋S3BSkTBԏn ,dۡ{z:{AVƬ+E],$aUux=Ե#1T^[J "#]LцUai 퓑jbF 9bN잯Y>𾂂b }kٿFb]֏m Ĕ@u6cste8hRtͥ:gTڃL[@sdUy-o~\ yW#b\2ҕQ+dbZ oׄ䅪onŘIK[Bes#G yG:ۙvB% Тمt)>e2B8&5$9[KB^ri|vG(_#z\;ɶH9&lT! $ 1:SNi j<at441R<U>ںgEuxvVE47~/#_ɼ_9nvF۸e@ejVl7tʶ$րX M0j(jAmΗp2gjPq r:K19lm0K,QrBa7_ыdLaX pWUQ+Q%i`xL՗r,-½.MwK)QNfCՆo= Ϫ3|K)e_¿SHDK’{/2Lcq۟dmN^C2osMFPl:$GPp"txcy #~۔ۘuUd+܊2PcĚKz ս_R k̯K^ۖ^m-tyܺ=<ƞ‡;lgmtYkP ޼ubwm=1SmZ(=V@'~Nwe v!ócJdi'|J/4W.AGSa]|?n (ֵLCL.Rɞ!V#cJCŦT;vZEb"}iƫK<9#5F;~lq3A9b7樊DQ8Hj$uh,l_1sLJL^|8\? Xo!Gx5A&VoBXB#gs~GWO#],N+*6J&MFRqLP䦮hE bѤ 21$*&k]Q( gjo·,?T)&ɑض@( %(\+RqC/O~ ;'jc+ cR,?-" endstream endobj 100 0 obj << /Length1 2352 /Length2 16417 /Length3 0 /Length 17815 /Filter /FlateDecode >> stream xڌPb;' 3.=Cpw@p|rNr-Y[Vzww Gy%:Ck}==#@HFYB GFljo dgjmGgfֳ H:XXL\L\fFFZzzLdjlb( L, S=+ mE= )((yLm,AƼT'S{"rj g 5z82?%k#{'=f05Zٽ8XAJ9?D_"2;YF`djȉJ; Գ~s3 t=@3ۙZ#_4o2X Y[ZO4x݅5vr2224 C+S[1o&6c= 3h :0 o'_t{϶_|!;$ɲl>!99/*UK?OӅ})%O@ mOGKv<{k-sH2$%Mc9~uTٮG A$?2GG:>riJKa3Z9FI=Zj|zާ*PW#@c$*#ט߫76Dc( #⶷u~|#u|Z=:in sApU9CzS{Yji[ĉ͌R[șLn|22 znJ=PM:-`vQi,,^fj$}ztur¯sȗ`Gk 23>,@J̝*#\6,j= ڿ)~4D%1~8p{5ؐ"{"ΦΰͣQݟ{ '292N.z0w 1l:QCfYUh7bTQַ(yWҼ7[=Z$I3] .΃aAU>š3`husĜ-=Sz7f:YK#DuV{GwNC32 3ΖsX{'+](#7FNwvtn#vIEJYH4_++ءn 9ϖ%鵉xKsC,QRXyX+2rH!Qa4jU1w{f}j7"?JZ ,G Jof(8lY œgX/4OzR2vә[5'զ\'4mP/@z醐Rqf]QELaCߗ ߡ&vd}.MMcEW{fEvl>J><6i2)zXug/2;ݰÏ8̈́ZT[/.=>;F;c5>sg6+C~Vf#KJe=ף)&Co ?}BE})o؂E >[3oA`D91!?ݍxgJht4VsE g]?ud?^RREU 9()S)> ^Lm0Owyފy Zτ7GkCu%igB/RG"˹M&}LUyf[M˕cuu{LQ]me$LyG8rh[Ebb:P̨rv`7 y:d>9xqeˢC9/ꔶ.!X-e| e "o&jȆ,-́["? >9m,p /Q,z[wxWzŅN*6cee[)2U;:NF[z}ʄ;!}Tm?jyg;AQvnhCw#(+GJXZ砶\Ed颭Ic@QHhDDiWɷ,Bwpd'nNLǤ8s:DfYuw#BRzi3 ,(GWmib+>mzc0F0P5/~ex8k Ac}Iۖ܎<İc:F;L8w&"dԍx࠸]jO/P>.1u8fʀ=-E}ϜQ?yz)w過B@mQC]Q-I%/=E>}HץI>Z<-/CsUG]>fCEo/ob%2̻ʻw_s@}K?`r7}&{gM'x$|[a龶SjAC8<b ids?nDDkGpUH۬~"CG<0^a?IV}`mx VT4^9E3g7Y9x7tql|s7="ӌ8~u]; :<;r?$[v67s456~8t/!o$3G}7GzCz0 FYq|յ/+EI4KȬ.bȔS/눅>ݝ!e[Hr:q/{~ Dz߁ x|QC0gik-9UE$+4m ی-tew^@|򞘋u_k~~" .yV}%U"]ٮ6L'TgפS>e>K!SL _[q:,^"/@oLlF M|Q+ Ql8*d> cB3D> b+!#v3cp݅=J O_(#k:);)fǣ*:ٮ3i;k_$K8p`ĵz҃Nvr[ixd>"i +ԏw6ZPe"xKA|$m _jzϯm}̉W&2VϿr7#YoB0W8Ccd1}DmJE'!#k7Qjd<&T'ft'r7Q~Cޛ:ꂖAH'Gh8KM:>LJGJ>쪓RvL~.#U NMkRT\"X?C< k$ >l",ƶ˫WՙvM;f@ n]Xt=Vj/"</=iåA0Z٨ zA}GvOP`oh*.jPߒR&9ݘ1ࣁlk۹Rt rN '~{gsX,I|P+ P}˪}r6uC$ξ3@ҹ&ӏEMznúxDudM,]O_@VDuG/WYe5:pחhjaTsvE2s_C~vmK^IT{ mH")̈́Ň.S;ȇNܗ_0Ѕdd09 m1 ?OfS죴{ul6'nxp:jax+9;t Ń"~2nCGNb'u-JՅ4/mCr}jLmRz6E&.Nӱ~]ތ>gcvUw]+޶LGDePb*{B2G-=qD4PhVs8ʼn]ql5Gil@^a#Ev%jџ^Rf'--CSE*z˔b+$70w#-H7xۀ+%v$ `YWGpoXAuec$(%*,le`̒ #Yٗ |8lf*y$»mY% #EJ?w -dO"͆0 t ?3` ppy]`twI!^*eo֬2 n88e&>[m``RN.>'9o zF)vOt% zY,1p?ZPP%k#3j L\JY@mQٱ>gyJآQsxf:qC1FϓLaM8eQqb8}[L v$ 40ޑ jN^O߂=Vos㲸 DnRYPN,8| K+@Tt Zo)cG=W.~A0@΃9 MA WFm#Ӕ!LB9Ֆ-Zߝ!G_#'37OZmV}Bhb 6q8m먌Q~0Aʻ )R? EXѯ @XN`9;I5+1j^hgX@lΟ!=6iDjkr w1f-%&d:?Z/GPCPnuB[eWl1w u/3=ahSpYo?($;^]/Y#u FEI|%_(*/0 7ǰdx ]|+a&٥+ A|vFxԜ}HDZ&&*A5'qdH&yF, @R3X7nD),\U2 PTwH֗l-sL711gӰ^/̬6 ^?}Z; D*M66҂,ˠk]?ul Y`?A۝[(LKľ=vH *&7u}]I BYCO&:{;enKS;epR%T Xbݣm P/J(%|Y2W6 Yר91 /ǖ[QH! Y& F1 .dqk3V/{B!Bj~u~^DoajKۋa5LSʲ̫2_~l|&=Qoxͬ{Y)}xWI%e`V̒k 'S"$-2H5X#c6H/fàÃHKH/r=+|y˙_4G7hst ID1{ tL=U:ܮ4c_<]& N~_A}!NON"u9,rRM=?=}u2ƋH>W0A@Ch?5D.H1c͡^$v|g3x-7_~ETjF H7@ur\4,m5!t7"".-Zq!c̸cjS=>9\8LyT}Qi/&yl|sc-ڇHϔ#Y\ңy)} r'ðMBH_{f))0<΄C5O'hnHsꥒvM T=*uKPiQYmiX_ >?~FEwQDR+erqWܘZ&A"ȇ`irvJξe[Ej'5qej'ʸp5`LC~ZܶYR%9Q[~э5!+<1(e:wҩ{$gvCa~;V4|$]T0a96}8yDh 9o"*'q!84]dYw2:n@V5s$xS_@u5뒬rx808 tۃlB2,e</ Y/-Wȋ11IoKsZ[D[kv* HZ[5wsP^=ނb_GΞ[5F;^A cөcu$xI.gYS 2QA}.#|=> <Ǡ&ߺK->/r1p׋lɬl*>٦N}f{ճW(SI,~x#5຿co9$j(1hÇ4XkXfQο:b4j,Lǚ~&9k#qB5M.Knm|z-u*  #+^<g_rB#.^*} VOaP} (vWyUbrMOr w58an04ggY5ftx7DH O(~>N'<0%Δy7 g:kC0A;yQ ;| I@LZ~׫w)9UfAn7;JSQFvd</1ifLb+{ 'h^'\#F{G(fYE ӗ '4WY7Ρ!S€j[z$`LJgI@`g iF)0$} bE6clJȷLr_9HⲲE9&,3# {lRvKuR+Q-qG2Tllh7 i0&v%Jj'uq'T)'kEm*+Wɠ:CR/hK;MklK:|Al[KWh4.- 2jy@&%hY!=")b=g6{Its0YyD/64}4'0?{gxo~8Esu>KD&Xõo%$Ac/36]lJjTߦ"CQ3-^¼ =0gfph4Qtê:N#k2^ېkX4@¢6D&К{%b#D M" s?{!ɉ4Rv?1o}B_)} ba[g$[CgGw)ij5_]Ѿ:$5#1_P8sB9[^$C6DTKE҆4~W93mIL!1P怢u[ {;ya6$ $߮>5rzӸ7fgD>rW__/ZSqtMĪcT_t7˼q-`2f(BdF ҋ2o|jVS嬝n&0l($ ԭ1SZ*cE$Vuh,nu۸]{{v!լLϪ>;``[D>(ŭf, Ov %0E7$8we-?z8Fj8/]|!3ǻ .a5N:u G[ t)ٜH׶ 1ёFH<*$h`8a %U& p9*bmP)j#ZSNb2M&fb7is&O~KvPSYN> r4j^^9ˢ:&.sbP{$ܰǼg34@BqθBj`lH}{FV,؏Eڲ۩84 憞AQ иVMM,E_4=Z`.ܲ>ƥ^@[cN?*7hpeFyS7ijf'x@bƉjF^- RjŸ'Y*;+ _D]q%S7yuxiH>dVH_'D wV?ːo2xKUpqZѷ#Eݮ 3:L:]GEsο)OTp4KhϜbvOq ]q/a,QpVsE Ejqt}m'L9!zqap.^Z^8N۪ U0O([v" {r^1q8Da Na%tz -4OLeW.tIY@ڵH hq;b,4!rʱNra &FwS0Qy|A$q{%L@jp\ҿedIڤEfpY9Ŕ<?=GAgY\m\)'ZVc $Z0*(8Io-|Jr8H<|$ItOM:~+ʪt'1lI8CYխ[d'ۗ)>FMeZ,M{hKR^oF}bա<G؂. vz,CVA7'P&:34_*b!gתii%qH>d6vrGjmSe{U?A!#ǒt\ ]ׂ($"I(YT J=#_Ve d^:P}S(9z2b&#_ +;H*XZ*?(]{Hn%, 1E?mH:_ƶBx_+4m/<%RH>1..>ƷM'; 2N{yX.qS8Ww 9 \ᄙ7)a_Dg,iOlQO)]ȍ2t8zR <#CJk4C&Sޅvo0cv # ? ]!}"̀ƕE=J"E&XIe:SnbJ)WGV|%QSgB Mt-yރlݶBAP‡9I}Y ! T"WB$vpܒ9GCc8Qj`{#3ߕO ;G#D&:Uhɪ +\g1W籡:>8S&*Z4|7,YsMuF3_7-Ȃ{c3a5DM֨m;Q)TxON%PIL8qXޟ^:ۅ|mTD桃D.%#WZ^c^^&+kϤ'KsWQ[oGShnF+^U[_D6 A1y'w]{>yf%O 2؛A N!;z"@ K3G n3U D3Z Ii\2lC@.|(-plУ_Rm;1~ze=!lt8~h2R'x-/_gT>>C,L>^iX :$WmruChPF[k=IqpLtC]vsGVM^c g24.%"~ub30w<w!,_ H ƸUoҁ*\1֋&@u_psTt4&w mz z#Ij-ǣU`OE-0kF̂@Z ^φLҵeh‰z$- l5jIƄ餦{#}T&pd|q_)?4Y4 {~z^ mPWK!~;׺\(/^NUt3.|,qH˕_ވca||7"#laRb[3d$h^nqgc4M %*ÕсX"&Ig<>%j5N[U9;{:K{Q+KfVawxL{֏@D}MkR8xm+ۄ`Pxd`L3FH[`%R< 0r'"G q[g53vYU-(JZ2m毜e:)#~a~Yc ^I;9}cr'y1rǿ״?MҘ:G݉tS|HEx@`4<*GF!~~nhx9(D^%0uZOʸ =HCj{D  [1zq²[mU]PV3cq-PyHڿj}I.x8`{NN[g64O+1m7,pX+O}1,H6FJ3N̬ ɜ]ɥ{l(4M#:jA+dH'maI(˯pCؕ) K}DT$PɻVlf~TȎ.UPX(K\?c@-郔:٣,>Y޽4i:y֩.+{tOɏ&oi_LhShQ\ԥ6Ngo7ҭ*#EM(GR]Ho\.W_ظ4ʥ [E P9VlMHFO " tYԄU,o>*0_Z Ȥy,dRH\3S M'lHAaǣGcE uJa_;9#g_+'àh.&w, 7a^\츘6Y2SEth8ѡH]P֌ U&qYű䥢BZ8n[f0>D}SFlF<'x5`v/n/o/vu2 r~sS]Sx'!vN/-J@WБ_7+l fO)w޺Ys=13jRX=0f`7z.@ugtVOV29̭!gch$TN֮3_T*_ZP59S^mUk(ˏ< a[DQ2{2yTZz3j: GkT|oD^еHi(3O0v `98Zj%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 82""/efKd'gHrӘØaEȒ%"r%"%k Rߗy~ggf>|y9hY< 4(9:g$RAIH`t4"C bMKf2` (RQG"y$RBU^D<`&P &G]9pRSS tA*%fX Ò4G龿w=ooo9;MBu֒tT/l c`ƅH@Sto, 4(AƃT:@4,<@WW 5%n+z#(X/ $04e,AĒh(%Nat,`c`D:MF$mHـףd: Q> ⠹".׍L&C"Oh@ؐ 2~؜A:D"U}p.0azx 0H? t* +PN3 2*8~I?W032jSWˢYyE@I^PVS~b%nUyLj_`-C 59-A_Y!7W"C%?֝Hb@eС0@@74uq@'eڄ ǠRbSg }@s}V!oWܵWw185nw|qN!5Km,rqpϤnvn~4,{ͥI)C~Tey2yLuvOh{;%ys]fv-ZUU]la$Xڬ -ީy)'K8tkMT+ : JT,߄̗Ýh 7 ٧ `jɇ'#M9-'1S*aǜF1ݙ-UxMKx3́y 'дOU2iK)>XGS)8".utC;Ĩx~fūꇒ->o9! 3o}NI黏?h]C|W| _ MIc;B`z#xKcu($+LƠa,)zW$; 3;'ĥkx~Z2I30o?eFĊ[E,zԼMv8ϨNMLL`ˊ2䀺R㚱%,cFMkYWCٰѰpzKzzŝÚ x'Qkj;/g-L3]r1pW$ߨ 98_BVp`dQfzy ̏oNSowO 7ܽzܵhz&u.fhj4XbVԁKݞh{/%Mbq"4I%$K@<7"j=P'c/»s$=5W N14()q:aOp"͒l%"H-TE&,3w$4ދ;qzk:wE 4F`>.u߫a!{;I6púǡB;tXXóܠml,b=/{w[ nP^85is/m)XH3}o֧ЖXiìX]/)]3b?͜O ,rŸxZqEޡc TOzmD^j@6N_oo }=șm̝wZPB6VU2}ۼET!rQ;ϖF#zm*S}C2?X:hJK6)U+uwɴ.sx^607FG*o$0/Zl;w;BE.PU\h쓱Kus~\'! J7Y$ _1"v1uiRFpjǫg>xm~{ <3;ip#d%9U/۱MK+0f9bpoi1u4׬ׯ{FI2ff?.=&K1袚3iKީ{0/X7c߲gaѪ=Ȭ-'80Lq!MPuvѣ7hNetO[N[l3}ATFv۾Z p-im d/xbUMUh8ƫ"<,&ES1RVEu)S˅~# 7X^_2C][Z{b!blvvY!"nj=ubXˀ%OdH!_ rqۣMS-0>J9Gt> stream xڍvTk.)0/(RCJK70  3tIHHJHJIKJJ ")H菺9k֚yzzps (ءmahV@X,(iI` ,6B` n F/^! 6h( ,!#,)"`h qGڂsq+]0P^@XZZw:  :/:B!H E^*qSu8 1ۼ`wka@ 0r@ p P"a怡Ck ,(wB~'CP @{j b=e A/!b{=9PU  p !VUUPvJhgg 52^ПuB=P%p.B(+aq0,%* \'AWy#/o.hb /vv,߁[ aa08fǾ| _pOdyA/;4  i)k"DDEq1@BZ w=!dрY/?u7/Z: €PX &UQR!70 pAY zG0;Xȅ PpLjpSExXobq)0_ ]A.n|]UPP/}K _HD\7!A{\l أ1_*- A~XҀoKXX 6`.4-p}ʆ8V4T`X~/?ʽ|?W#wBE[49RHBa*b"Al+I~ޔO_}>"&b"Gy;UG6(IQtKGgG\xã )}R\gѨAʧ+#K9$o6޺"GTist9kT4FmtPe `9t2 AFppY_X\nF`xp]nL Ǿ+ݭKIUm5{-op\WUu"M*s:apui1 e-TCF-k4ד͉fgd'JTUteYQ[bTz1U_k*zPNnƊoW]E~ְƐ`ǣ6h )M—5ܢe v;bټ7bW#j ZxǛ W 1#rv_ooV;ռ OKFKy<'4hi)~KMGAJOӃ6cZE<\1*kXYj;//K$ͱ7ZH"Bt]ȇ~ٷ$֚S~Q\^ihm䇉Ir\?/ u15ᙯp1V:(;>8w"N@#X:l\oKYZִY |a}Ʒ赨mp$`bR27o_3 rSTO~Px͈pOM}vJhsri .|0vQxvuɷ2wkF6qwG+wL) (/,j#Jv:+'̲6̔!>1h;rۗ'|ixTfsfuYL˥7рz-'lulAzLU]VaU>stYR; Pୃ}'=.GYD3tl=5v+= 7{| AG$YOKATiS_#ח?mu}>)01^Ms*^Tn}~)?-o.R/1ciCx͜",ՇQ}^9l]E,ْXT8яޫ.\w=y}v:nGiH)ͧ>(T٣2{ #@F#Ü[a:x@3=`DzE;XԱZ|D>-ԝtè zY0}}\MGqf%mUH)|Ow:𜤏K9\j` k\ozYڇdQј*[Ep!8\ՠ.w?t*bZ@YDIݝm*6;9\1&;ٞ@S=go6VCﴴF ͯG韌yE(4?UW[ x/[O!m՝twħ $sNK05G9ݞU lwD-~d\ ԝPMZLVn|X2q3K-bvy"6v^|Q [>_%FU45֕XLOh8w6bvY'lĞ?$vڱvK|Q<+^rAj+ܹA$^1OBW:jk*v?aܨ zD:/(nNxh\/d*La*_ÁG_Bv`RF`=.ک}_U3 8@G]DlK'|Ǒ_boS:CKy+>-5>ԩ..@hlJ× MZg$e=xK fD>QS{2v~:;q^V4Ёc_z,^𳬰{ݜYoҒ>jJ+Bi*|wXlj$;XLjSz…rDsUaQuy iL?DBG[:":?aϺneC&=~D5]AFOFӖyP?p'&y8̒۶1.Fۂb$bX'wVa)Qc6%g6aԠplV`i၎<te"!{G!Q%A%ݙ3X|;C\^`ulg:eצu=kްbd:WV>9/ápʂT$w`dH~ ڏAF&vy,lL[zȖoIc8.Łɰ.4bk^Iq~M_G;QsYb1˅ Wj =}Z݌­J:bxi.̈́( 'ZC9ܧ :>pxd<޿}:gvX+2⊷\c_ :\ǤBVZl5,^sat1~ވZj΍Ga"UvK- a·qs=ߞ 4NF_ WE2kyEڿ]Q`4s N0I,>޸4ڒTgRgT"!AYW{1V`.8:dr?}Yl WSnLgI౥-'^كG#T=܍V"ZQp˜c~犺2BmoKYz<;7XV৹CV:|*on9u/3n 弟n0uPGvy@r&\wF2`:vА@Q ]־Pizf*i#9b\}Md%8Ke692ml@+K^g`.g=m9/f3J 8[2cn@L;ި#kK`ǣo[ 8)?9<( hZ?/,׫x|+8 Q.@!$誩2@ζ"Kò2`B "ݢsERv U)79eLNboT@ .7B {.諸X`-8C.{A/̪mKh|*ܗ>`S~28pZOȲywɲrOK0WU k:g_)7pq~esZN\op5(eb+ec`5ނ! 3ז ^n}2vd)exɬéӐAmT.ÃU_&׷4ll|ئܻJF z1+\.ȫd}kCDOC {ge,$@ʑ:jn[ !yz%6B+9j;4+p,칩5+wЕoS|X6~rkJjZٸǻJx{_Z>OE$LIftaEKQ:552-r5N*LٝռK?%3Wdp_*~TFzՉ#X'g$rRh?cKM/HGx[Wʙ~*uWyHp93Y}!fgM;?R0Ik;W`a1Zfʟ5K S}GRwI ^d;0E z5dƗL[=DQ6=6ۛ 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.15) /Creator (TeX) /CreationDate (D:20161201004717+01'00') /ModDate (D:20161201004717+01'00') /Trapped /False /PTEX.Fullbanner (This is pdfTeX, Version 3.14159265-2.6-1.40.15 (TeX Live 2015/dev/Debian) kpathsea version 6.2.1dev) >> endobj 21 0 obj << /Type /ObjStm /N 82 /First 679 /Length 4043 /Filter /FlateDecode >> stream x[mS9_1jk=wjdS&_O4fl/[Fjt[GU!PRJBBK*'&1(( `< >Es Zb!̀H,C) TNu sX4 `))> ojh><@jx* mAH*`$I "w!DiP: qIj!^Q 1jX>M'9@U S5(Z  i|z'RR%w,Acx鵄r0 "1AhF=rRN&Pb)xIǴFDc1Sc5e2Mދ`$x/ ?o|3:լM }7(I=1s~}:=^|`!O0?3oc_rCU*b*%U :UTĦNl4뤏T%7" yӑ~R3$pRfr}rPϊO<ϊ ;(MWR=J9o Y#j |wu׺XZ6hhE>!~d@ BvEkEks:Opyi5T1V!"/u~HX)*je:!91J7vTc0D|r(K$✵ !N5BclSCy '0ʞb-CX%t|RmEkS)FC^V 8 X7J`)r >P?ohr }82d-GCTz4aLk΢4*Z-$}H @4.$8Oge ]k#HP,OaGqvWo'rr.n?_ւ2JrvU{"X-=<Aƻ$y+'V`S%ׅt D|S|`,_?1,1 YMu=%SCD<@kŁæ15v+[FfF{%3=t)aew GOλn7gdӔ,cB"".(/sېX._^y[xϒN1\_j]!GXjO!<*F-ٴБQϒ~ hϚܘз)prstAIlgAd.Ay0/(9G6o˯Uy}UrZ'u]u1>G _| CFO`p7Q8]U=]Q K}~dKחz6*y \ $MQZ$[ ^ݽρ]vth 27:zlr._^|]n;(ˣ8YQy+KIyVޜW(/aر׼oo: 'vZ?/Ǒl[{gzή{/X=^{9ɓGttu俐/Z otX{Y6zu[%Ksn_mtX?ά\ñ, t/j϶]}fl羅oO=;CYju֝b>[[Cᝳ\{(k랴:±5jfNw>;_íuS.%k@&BkNedo5rRlt[FIգRJ]OxzLˊSz[,wH9>Ej_7BhVQh7~gr7V?<㛑#g8t4LC endstream endobj 113 0 obj << /Type /XRef /Index [0 114] /Size 114 /W [1 3 1] /Root 111 0 R /Info 112 0 R /ID [ ] /Length 308 /Filter /FlateDecode >> stream x%ͻ/a/ںhҢ(?wEFX bX&1&1,ş`2y9or^_#&d,q2Gd)B2d̐IHfaw@|['A!%Ve#^HEweqTrHNwdT? *RMjHH- ԑz@"4(fI뿭-G+9kA.!ZVp?:ܑVPrkV7 >jZ0VyLKk Lk65 i2{z%K/- endstream endobj startxref 228752 %%EOF car/inst/doc/embedding.Rnw0000644000175100001440000002373013017662407015200 0ustar hornikusers\documentclass{article} \usepackage{url,Sweave} %\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/NAMESPACE0000644000175100001440000002133613016336052012260 0ustar hornikusers# last modified 2016-11-25 by J. Fox importFrom(MASS, cov.trob, polr, rlm) importFrom(nnet, multinom) importFrom(pbkrtest, KRmodcomp, # KRmodcomp.lmerMod, KRmodcomp.mer, vcovAdj) #, vcovAdj.lmerMod, vcovAdj.mer) importFrom(mgcv, gam, s) importFrom(quantreg, rqss, qss, fitted.rqss) importFrom(graphics, abline, arrows, axis, box, boxplot, contour, hist, identify, layout, legend, lines, locator, mtext, pairs, par, plot, points, polygon, rug, segments, strheight, strwidth, text) importFrom(grDevices, boxplot.stats, col2rgb, gray, palette, rgb) importFrom(stats, D, IQR, alias, anova, as.formula, bw.nrd0, coef, coefficients, complete.cases, confint, contrasts, "contrasts<-", cooks.distance, cor, cov, cov.wt, cov2cor, density, deviance, df.residual, dfbeta, dnorm, drop1, family, fitted, fitted.values, fivenum, formula, gaussian, getCall, glm, glm.fit, hatvalues, is.empty.model, lm, lm.fit, loess, loess.control, logLik, lowess, lsfit, make.link, median, model.frame, model.matrix, model.matrix.default, model.response, model.weights, na.omit, na.pass, naresid, optim, optimize, p.adjust, pchisq, pf, pnorm, ppoints, predict, printCoefmat, pt, qchisq, qf, qnorm, qqline, qqnorm, qt, quantile, resid, residuals, rnorm, rstandard, rstudent, sd, setNames, spline, summary.lm, terms, update, var, vcov, weights, optimHess) importFrom(utils, browseURL, head, methods) # importFrom(VGAM, vcovvlm, coefvlm, formulavlm, model.matrixvlm) export( .carEnv, 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, skewPower, 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, makeHypothesis, printHypothesis, Manova, mmp, mmps, marginalModelPlot, marginalModelPlots, ncvTest, outlierTest, vif, avPlot, avPlots, showLabels, residualPlot, residualPlots, bootCase, nextBoot, subsets, compareCoefs, matchCoefs, Boot, gamLine, loessLine, quantregLine, mcPlot, mcPlots, adaptiveKernel, # 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(boxCox, lmerMod) S3method(boxCox, formula) S3method(Anova, aov) S3method(Anova, coxph) S3method(Anova, coxme) 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(print, univaov) S3method(as.data.frame, univaov) S3method(Anova, polr) S3method(Anova, rlm) 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(Boxplot, list) S3method(Boxplot, data.frame) S3method(Boxplot, matrix) 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(powerTransform, lmerMod) 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, rlm) 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(mcPlot, lm) 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(print, summary.skewpowerTransform) S3method(print, skewpowerTransform) S3method(summary, skewpowerTransform) S3method(summary, powerTransform) S3method(plot, powerTransform) S3method(plot, skewpowerTransform) S3method(contour, skewpowerTransform) S3method(contour, skewpowerTransformlmer) S3method(coef, powerTransform) S3method(coef, skewpowerTransform) S3method(vcov, powerTransform) S3method(vcov, skewpowerTransform) S3method(testTransform, powerTransform) S3method(testTransform, skewpowerTransform) 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, default) S3method(symbox, formula) S3method(symbox, default) # added with skewPower # 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) # methods related to Box-Cox Transformations S3method(estimateTransform, default) S3method(estimateTransform, skewPower) S3method(estimateTransform, lmerMod) S3method(estimateTransform, skewPowerlmer) car/NEWS0000644000175100001440000007640413014356422011547 0ustar hornikusersChanges to Version 2.1-4 o The smoother functions loessLine, gamLine and quantregLine used in many car functions now evaluate the smoother at an equally spaced grid of points rather than at the observed values on the horizontal axis of a plot. o spreadLevelPlot.lm now accepts point marking as in most other graphical functions in car. o Bug fixed in one of the skewPower support functions; thans to Balazs Banfai o Added support for lmer objects in power transformations o Added support for skewPower family power transformations for lm and lmer objects o Added list, data.frame, and matrix methods for Boxplot(), suggestion of Michael Friendly o Added adaptiveKernel() density estimator, with option to use it in densityPlot(). Changes to Version 2.1-3 o Corrected documentation for mcPlots o added id.location argument to showLabels to vary location of labels o added fix for compatiblity with Rcmdr with missing data in several plotting functions. o deltaMethod() now reports confidence intervals. o print.summary.Anova.mlm() has new SSP and SSPE arguments to determine whether the corresponding matrices are printed (suggestion of Michael Friendly). o summary() and print() methods for Anova.mlm() can now report univariate ANOVAs (suggestion and some code by Michael Friendly). o added "value" and "vcov" attributes to objects returned by linearHypothesis() (after suggestions by Liviu Andronic and Steven Yen). o compareCoefs() now checks classes of models. o small fixes/changes. Changes to Version 2.1-2 o Modified scatter3d() so that plots can be embedded in HTML. Changes to Version 2.1-1 o influencePlot now returns Cook's distance, not its square root. o Anova() now supports "coxme" objects (produced by coxme() in coxme package) (request of Philipp Sprenger). o Anova() now works via its default method with "vglm" objects produced by functions in the VGAM package; and the default method of linearHypothesis() again works with these objects (problem reported by Michael Friendly). o Fixed Anova.coxph() so that it takes account of method (ties) argument (bug reported by Karl Ove Hufthammer). o Improvements to Anova.default() so that a wider variety of model classes are accommodated (following request of Liviu Andronic.) o dataEllipse() now throws an error if there are too few colors for the number of groups (fixing bug reported by Ottorino Pantani). o spreadLevelPlot.lm() now includes an optional smoother in addition to the fitted straight line (suggestion of Michael Friendly). o No longer import methods (as opposed to generics) directly from pbkrtest. o Added axis.ticks argument to scatter3d() (code contributed by David Winsemius). Changes to Version 2.1-0 o New power family called skewPower has been added that can be used with the Box Cox method with a few negative responses (joint work with Doug Hawkins). Several functions modified to accomodate two-parameter power families. o Fixed bug in Anova() for coxph models with clusters (reported by Jesus Humberto Gomez ), due apparently to a change in coxph(). Changes to Version 2.0-26 o Anova() F-tests for binomial and Poisson GLMs now changes error.estimate="dispersion" to "pearson" as advertized (bug reported by Will Petry). o Improved behavior of above-plot legends in scatterplot(). o Fixed sp() (bug reported by Cesar Rabak). o Conforms to new CRAN requirements for package imports. Changes to Version 2.0-25 o Fixed df check in linearHypothesis.default() (bug report by Pierre Chausse). o Fixed bug when vcov. argument to Anova() is a function (reported by Liviu Andronic). o Now export .carEnv to avoid problem with update() in Boot() (reported by Alan T. Arnholt). Changes to Version 2.0-24 o Fixed broken URLs. o Changed handling of .carEnv environment. o Moved pbkrtest, quantreg, and mgcv from Suggests: to Imports:. Changes to Version 2.0-23 o Modified ScatterplotSmoothers to add an 'offset' to the vertical axis of spread smooths. This is required in the marginal model plot functions. o Fixed labels on mcPlot with overlay=FALSE o Check for 0 residual df and 0 residual deviance (within rounding) in Anova() and linearHypothesis() (problem reported by Jonathan Love). o Fixed model.matrix.lme and model.matrix.gls utility functions, and hence Anova and vif, respectively, to work with models specified with formulas supplied as objects (after problem noted by Gang Chen). o Added Wong data set, used in mixed-models appendix. Changes to Version 2.0-22 o corrected bug in 'terms' argument in residualPlots, and other graphic functions with a 'terms' argument o added residual curvature tests for glm.nb o mcPlot and mcPlots draw 'marginal/conditional' plots for lm objects. The marginal plot is of the centered response versus a centered regressor; the conditional plot is the corresponding added-variable plot. The plots can be overlaid or viewed side-by-side. o added argument marginal.scale to avPlots to scale the added-variable plot for Y on X|Z using the scale from the marginal plot of Y vs X ignoring X. The default is FALSE, corresponding to using scaling to maximize resolution or use xlim and ylim to set user scaling. o Fixed bugs in Anova.survreg() that could affect types II, II tests, both Wald and LR, and one similar bug in linearHypothesis.survreg(). o Replaced calls to require() with requireNamespace() where possible (suggestion of Brian Ripley). o The following functions now produce warnings rather than errors when there are empty groups: scatterplot(), scatterplotMatrix(), scatter3d(), densityPlot(). o Corrected name of "Blackmoor" dataset to "Blackmore". o Added KosteckiDillon migraines dataset (contributed by Georges Monette). o introduced linearHypothesis.rlm() for rlm models (suggestion of Matthieu Stigler). o Small bug fixes/improvements. Changes to Version 2.0-21 o residualPlot error when using 'type="rstudent" has been fixed. o Minor change to "recode" documentation; improved error checking in recode(). o Fixed a bug in gamLine with non-canonical links. (Thanks to Hani Christoph) o Added has.intercept.multinom() to make Anova() work with multinom objects fit to a dichotomous response (after bug report by Kristian Hovde Liland). o Replaced vif.lm() with vif.default() to cover wider variety of models (after question by Laura Rigg about gls models). o Diagonal panels in scatterplotMatrix() (except for histograms) show groups separately when plotted by groups (suggestion by Erich Neuwirth). o Added vcov. argument to Anova.lm(). Changes to Version 2.0-20 o Added new id.method="r" to showLabels for labeling plots of residuals; default id.method changed in residualPlots. o Fixed handling of labels argument to outlierTest() (bug report by Stephane Laurent). o Accommodate numeric variables consisting entirely of NAs in recode() (suggestion of Karl Ove Hufthammer). o Prevent dataEllipse() from opening a graphics device when draw=FALSE (fixing bug reported by Rafael Laboissiere). o The functions makeHypothesis() and printHypothesis(), intended for internal use, are exported so that they can be used in other packages (request of Arne Henningsen). o Small fixes. Changes to Version 2.0-19 o allow a grouping variable for color, symbol and fits in residualPlots o fixed axis labelling probelm in influenceIndexPlot 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() (suggestion 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/0000755000175100001440000000000013017662127011753 5ustar hornikuserscar/data/Cowles.rda0000644000175100001440000000701413017662410013674 0ustar hornikusersBZh91AY&SY3L$ @/'}P TT| 0@|"TQ@T?UU1ꪔLF!=1Gj= 4  jJ?T 44QezQ@2gm)QꪦT #@OK$4|$K!ia, JHQJ!$ ,"BD RA*" QP,$! AQH ( A !D "@"J*" E$$HDH"" T||Y*BDHB E+}߯=WO %A*B BDP""j"V"D!U$ EUDB!H Ab,R!T)EE BP""" )!R@*!hJRB R!JXRDT% P$j]5K߳x"v.9sy⴫r~j }zy7yNcPww|=l .;{5,zz?Ф &L-|a/y)\ CD1s9vX &ޏ`$WXx;PЎ!wWw`D[YT4Ԭo_i'Y/71ݏ\Dco:vQ#5ݩQ2M! GZ?b0zЦ6aP?Fَ.ƣDN&P$xǍ9\YzƔG@ZYy'|d.Qَhy5ӡς׻Û"_Sc9*Ker8( h:PbftThBmKÄG#t 'zZOCfqW(lN&Hr_ 7LO9XOKk9ؗJN-M@9mfAYJ!y9{2XS`pfUZqrsIm37qbƓH?}>K$@STq-G;4r[*!jάRا(ai!'}ڌ #Hޛޙy<(/]= #31wg xVmnfM^W1ZS}Qu(ML %<8͌\6L)-۫[n(倒0dQ8 aiZjnKZH m:ʢ;K[y[_wfv۬2hͫbd4tC9k`KX;ā.RM[j{[xq%h goyj,-{_]ӁM^ f5'w3@q~1%*VogK^Zn;]:aÚ?poߧ@+֏NPѶ"h}\Q]0xj"¿V"b5qkhZcAuW|c9r6aYE-|^.F8>msMiVZm꾛_yKpJa& =<ob6lFDD$sl_D]y(KXQ(Dx ]BCcar/data/Highway1.rda0000644000175100001440000000252613017662410014124 0ustar hornikusersV}PTU]v%%+¹Whَ|ȸ"?WTeaVZ6Na)8S44v߻=7޹s}͟Э-EQEUT ZUQ˰ʊeuɊbHt;Jc¾vqϳ0W{LvZwxEIvt ɻ,ti9ϱS*G S "6r@̦k-4W 82;wEV}M ~;b}t ' hD⍍c)kKzTN/)ȟa8_!wmdF",I؏E9>+\?֡x د ⽦ciدN ) b:gL6ugA/xyqpqps$pdrx qr1C?iQye[1.~_,ƝK 6ḿ7FFa>LL p@琎}xˆW/KZkNodl?Go,p?Δg+nЅY6Ng$mymz.Z{Yls_rҵӥSΤM+^ oV8Fz:\(2?yy m+=jwɒ{[.JN:>coחJ[2igs8f&f&=dӥ#ė{FP!xd0De 9l_yTMlv}b̂Y79f3:MBWy {`OSkL>=3Ȟ~~d")1;yLFo.R =M#'cY^+)j++j'ˁZo@T*Ii,DJ_ER.W\-h'gGʺL"kKWn d car/data/Angell.rda0000644000175100001440000000161013017662407013644 0ustar hornikusersT[n1#H !GKJKI 30}[p].Naܕ]& %_B~ E_y$q +/C5Gr* eC?9ς: ~?yY~Gs*HiׁD}+ to#*ŽX@?BMz'{y > }kW2*zv1|;ea u;WI"m䣸ʏ_#/L̇O`wD/B_@_E}YK꡹=EMA|Hs*o`wvf<̄?\tz5AmᐪԠDlK"ظ֊6_|2aWIxĵ6㫷B般w ysm69&jny#Rt(R4 EaPԣhv'>3h'~ETt8~hȭ('/. |=} 8ďosR"߈SdOG~xcw?3 St>IPݠk?8yA|x94e3C1<ڟ Aأ'zlq cȝnk }3=s8'>0GvfL?a~4S~wc1 NgpO9<>f^WùOQ]π|q7ߴ1Os}L>z[s'3xSp:)̓D|Iy rIg:|Jo|dž h^$xqN5qkcߥ0&O78 }M#^B\i |.8<w ,dG@2^wut^/zC>=+grCs/@zĘ|ǐwtѹ $t?8~c~:I>@"7 g:RCo{?ݻD[8uC}{~"ц[Z]@mkiKNkx, ns. `-\(}Ī}FO -[O?7ȶԽ+E_ɒuٺ9.oj<S=*_l8v<ʿ>4kS)bW~?%ok{{Xop?p*GkwW]:8͘UuKU>ܾozn;{w^߷fxdNWֵ^|;U:}[ *_oS]^_u>ߟ+==8E"p4UxyuC߫g!K,*lb\Mg4I1L PàČTф_b^ 2\(}O٤+}w\(rL2e7u*7NshF Aͳ"ag]WY//W eVV-JTYALS1ścZмA~nN,W,< kDN-4j1 U@1' Y^5 e_9酵`~ʴfJ5W3li9( Sx$ W E5+ť:񶥨Q:+@zw.TabY,\%~*H1C+A". KՂƘx|κ5><فJpELo kjT{6/ӹ/AA@}K';I=*ڲ2Az'z?ʰhypX9|Nu9>jwH/ V:cҭM* ̖uz4BU>o &tY=g>>wUOM-HY%#l8dKBUV4p0 55Xт%~d0l ~8_.t[`6L2F˰imv|W7Dm+78Ə24&ZWWUFnHWHFߊnDG+ս\gh|%e03/d0YMHU{ʯU3U{Gj)a)H<}2iS uǒ +3 &dsq vƌz =)5f) @O%d4&' P& U7(Gv'b?gnh;EZ?r]Ak[ڦ}yf \I&Oى˧c?iL\djipmݵOέ4=5 R6ƢY숏TA\ ]*ԙA=JOzK0j>t)gٴ41bUv o?B3'ih_Z3YͰӴԉP}/Ru(/mn܂x"l9tusP{[0yLD .?L֡2&3ОG] 7.+HteyZ3rzuޒA&*Ϧ8kx-l Ivd 8ӣf`K9&&iM;,n ~hF[kEN6ԑ賽-AT/VݨX]Q[:\CWLŒS[U[׵s ~@CZvXF0豍_`yD ;^a[ZWuH-8ϼv# `~&LyCKeF::' ϵ|. OwYTvI :m4ۄ%H2pa{4I(؛!i..7=kf`O82EYۤ; jQ ˻ ZQRYD7[r]" SS;BEFNdkAthOCy!6kdaի%'Պw',x<~e< AyTghwT#zI ɇ"ɀ"72oB1mKj rI~IӭO&8[қM寋ä.䷔Ѧ!&KiSTyu]i:#)Lb$e+ 7>U#(LZzlְ*NJ91G-˓"`h結~QKAGtcGLO6FW07p E/ײFz`Ѯ~乆ﲞ7M/ L0s0E0N/ŷ$1)ΏAyp㍫kyvš6Qt=(\BJ@a y8xr}arFgT|R܎JmKYUB`nF?-|zlD̾_frѷ?{I'D7ohLcY%Gx&ҡpx`Z0 #RGRDBȟ]u$"Q;N$wPG(sURu`.gS&鏘 ѥS1#Y7 KIoyAo)pP𡵨CկY9؎2(e(XfaD 2U~kzd/'{a&J[ iU~u<GJ%oEZ?K盁GMME땀K) XQ_6N Wc8sgiYJqyпh9WB-ʹ?@>Κ}]( >~q7&@H( r!;5&-S2)W &. tދzSmw;x4w):[ "%㱯oîe \G  F4XmRK`!<mpkZ4¢F,*:o9Gf؟IAH@Hb]Šy1䯅j͊`F)'J{;WJL d6x6}|o*'yI^AZ!}MZqޯ #E{X?֝2fW?OO!fS> _̋JѰF£ɰ,5g ";Qvه<'Č!V۫h@~ Vixk E.%Ҟ#U=)Gv]o^%wo! 3#ՠrÈb!ײG5Ʉ!ބ!"?U*YJu1m5ML8HY_hV H>PIE,БvۏM_ D9'2KSj xg|y =HC&gG5\1p(s@V66H EeÅL\C6_ZOdCX?4Q?-1b$55DDKy ?i3~>y,flH1^T͝(FZp${~'6`-9N,&ek!qHK%%jw|C}1/*[_yzLRK.6Wj=2, WF!/A G]g`J3uIPA t*Fͦg&m׵5B/)= m0*BmZX&~xD18<$@N6ep\/^Q@ߤɭ&$:o Gzr+jf~itDhGM@u-0pP wgi *;ZC27;Xuӻ1OxƲ^/Z'ds</L$ϝwɛ3+J6{5g|-Z7qb;#\'dž:$ &ZvOE[ }SB>,ˤƾeھjU_G.G&Ξ,Iٲg2vR!ޜQ!+0dž7R]%$hsƸBR+'73nI4ۦ% <Ҙ?ړB傪5IEP(MnSe2KOhAKjEgqqb8YE;RAIk ,#ӼbDϻiI]ןwBepNJ45% A /M>c)ʰ,CO Z^!D9 S*e'C-@H{2Wڥc(ToE+$ 7^B}(#"YX%_]Db ~SrBU3"pռUy\5UYLoIMF9 4y_+n}&zJNa\ VMߚ/xִ&_,JLT=ؾgfIJa.EsCJhI ;bvLd oLoE DZ9Gj&wR{Er Q^X3#-A %._hn-TwxdMÓJxc3Xm"4|fǸx!bK1Ir󾺋J+49Uf_N=oQ@%WQESX 7wTh)_a,^- ޽1-PWzhyPc52Ym+&JQ#xw炊C`gmsSIӰd{}rg7wCD]rj:VCp|LvP#HֿA?Ďw}V4NkϤuc8dw ™< Wq c¢P]v2+>Nn3'Wu2N562պ;$mtF`\ICuf,Xw ŘSo7RrP&ncm1@y|X:4" _Af%\LA{a1]--ĔEN]#[ۀ鏷tXkXD5"ʧu֨Kԙ)yzLW^'ܩ;% LB}:C^9b!&[/r3{_.gmqaТ=*~w>|4@#$ G5KQu S**JZwFV?^ҸgCEZnJ rLRBtf5}4OCnYRS0 `Ek3?koJ!GݛE^d+XPMpPJ}Q'Q^ퟭ̫jZSX!S㍘X)QS\$L&pt]Yo8sΗv(zAfLfʩb=p—'D~Wn `gIqS"|_BwU Պ/O\\@qdYϤ ޢD\Bgz7ȮMKG4-51 J_]Jҝ_QsŴ} y"Ǻ&X]tܰH)(WEnN0F@⦑\%pSs?yXءOOr8 UvIdMh\a9v2+-2ҶuFƬ #`$KvP-(#V?f2 bh7.I-os:tw|$n6cw }HpYZgZ4#l\NJ1h}oۊrLiQ׉()؇h/P&Au/1 ~j$sr`nաޛ9(ntȢU^t$炊(u@ёNҷg CؕRloDj%fҏCwd%^ -?k=&5,0_i*g&BNڪvxq8e%XhQcrH4G=DR[}TuR䊂1ً؛XyOkUE9K[czlH) P'"!$~$ -ywr4@Pڛhi禿xM۠H/.{|?\S-pixxߏ0:ʨFWbZD[Wd/m؏s7s*`Ql!npovm$`!9L~q-ɇު..UJe~Nlx|F{ khEM8+?&؆ϟ!C2= ,CX;))x]/k;1Xi}CkC<ۂ}_ ࣅJ"K{)[c*#Obx@n󁱠Mx,vfbdރ#L0h7-y#n/%AY0 aY\X8G00/lD?앯 +s―K?C#戍GEI߁TPD-3EZ&,/+;yCl9~{o-x d5Ra+w4їƾrH--a9bs"EsʂR(i,NMYߟipPMkB[Vd=H;Ǖv!75a9dWfbhf7fsFAbS~n۳Lm@%wv̡OqN`ev˾|C2!t.j%DLvWQhn%Q2D+h{c8YptV"d3}-n~{#Hon@J~ddW!sA8 RI "8m!"ݱh1+{KB~e&K0? 3iL4][KLF 2I'aܠnCLAy2\#rF!S$ =,題a砤s. ,_( =jF_=Z”-&f6Nh`3]rs棃!:lnɧ+uZ5ۧ1|nǴ`o_n'#tu0e & <زz~C;}ôd#_.] ]@~Jۏzע{U]d?T@ukE溙2 N%~^o9OW 7&Ib)[d &qFI.R9fӞatW9B"œqeO|Q+TGy0ݬ+c^*E) ?MSd,3@ v^=!'(X4@!!U_(1ڈHt t3,hMژoesr"fvKIuy ;]9ўdVOv5|9#wx翶T߲ΨZʢQ@(`$Sߠj-&>W/:*yyTϡJIQxfBi{mW֗]Nv[Cbj^ ɸ/ݒ^l(X6&I{eVL\#O%l[#;Al~¼ kS %V%YL܌ShFucL`|m%{@:4?]sW7 Z>|$@S*Xǂ ]P&X5ҳmhP5X<я5;wGa2%r8VKQN)7Z4ߌt }m/?K*j^LS\P`W"CG<;; @E[`e5q'"QMEE (H+Ļ(kSQ1qnʛHBW T\isg\VL vEOЅL:7ô'ʕ<> VgHx n!{f3N=; F*fVM\Ϙ 41KJ.Z nE&ۯ 2ٹS'TY,L㜸aJ)M<8R[z8R5|I+u~ŝLЮтS%m,+8zzl95͗Eu&IךV-cwC^@Tվ'9M++5HaKX;ߨ+?j aI *M0;nU RTu-~KTh:Ah*,͹Ÿ>&t1\lOZ"A4IOVK,?lTo{Ca(RYm1،JFQBiPznoL衅Iŏ4L5}P|O&WA)vac<6!}2;hyF d@gL`Y6J tm_1BG~l8"Lhh6'd)Pk^$ fȠHu tMvѩ&AE/cA}\i.&!,4ke7t4Ot~::g9:9ڀ/}рi#&f3z?RO̬)Ɏ9?6g\#hvL"}/Љ^^Z؅r0JzK.F%Xj #h`C%Au.VA5|MncS6hLKk# 9#0Fhr_aOT Q=h0(nY|OxBb{Ht0vl C&U]+qH0 wݩ){(iC4,CZs2Ÿ`RYsIۀR=qM[z 4LZp8`rƅ7_9kc5sJr2UoRܥX-.B_K3Ai8)y"YQ^۲8zuv>&#v4LM.\Z\I[7@A\|Z$Zm,-_[Xg: Jt9Rl[̈́tq/(Z?ЕϝS,ö7#y+ ?khS^;"cp'hg>e3q;hf?Snɘ;>X$#~nenxGE%O s4]cF|I2s`zeu#X땑 ڧ\m ~8bjUaݖf>?TP&>}U>#<-visCuҍ7qXBJ 9۫n=r.?d`Af yfy:#]S8.Ƽk}{|#XM/x +s}T,8ee7wA`j㦧*/ͫ$254SN]t grz?WԍIw6 bg[0"xA,~.P.Yݷ 6@q O.^Oi(B S+0N,ݸw))A眓B5Vt2Ȧ`%/Up%{Aư|0d\_2[_`ty.=/qќbnȃ1Gc.ZM:7#&ac S8ɜ,h- ( R_3COLL!a',.W+SCΤܙӫ# W6㖭 !X<%9ѮY <}@kAꑭP?Ss 8 >"30S93` q3.22hCхgj#/v 8`e*z{%z!F4ɷi KBPUjJUun )Ƿx\P|g3L-{ZV(t8j'ӂ- &@ D`*]Cۺ79:o}9SX@K{7kԼu՘ް!TZpFNZtٻ+7oO?ݤ L^oӓ*~%.ۏq6*: qsglr@ӹ]-q|c䍳wK/k<`_"6Dk$vA"RߧQ=ӪTw_+脦Jc9I;r:Ɂɺ2TkrJ&S0"k E dЫ):wS LeС,+UC~Rq%[X@2o'ڑVEȦ.7ƘťFd /@>d}9螞AeC[h.]rjh3LWUGj -yQVc~,ˍtf}PϗAa#.fy'ja s*bW@U>DH}͉2U N3l2a4bao %"hI|=6xZUT8d: y|vtN6wWz&{p6m3GTPGOU '6r{4 .d¿T©1ĺP`w66w>j8%%j>N3~Ƙ(ŧٿ=-A=C1dQeO硖>~6m0ܹrA k7b\Zw ^Y1 x>ӧ$u?dYlKU5S_>{:T*)o&6$zP@Sc~6k>kŜ&P dk}? i1טu煣 s4 .,3)P`u9_٠2' 9ESdQ))4Jv1PgR]:4>ǽ1 B+Cr2,kʅ0/,O$hջE`BȈ0H bPVN_yqɧBOmvǹآy6\aKf#6 <~^eRP]#[mZemո%jfK CZ"^4PƞiUr<%sT"#Ya I01 me讪$d; gT=n=>nY\ ζ2څĬ!PqѳoxƌؐeС+ZqaWGj](BpRӘkK-{,#6k{i緢D$k4YmktIaQ),PdqȯJJ1"j9 RP؞|gr~Õ촣ptH,ϘXK(1p: oPR2XUUQW0`uT_x%t_H~wksYl Ecԉ 6 kU5˥>]5i#F;}$pٹT8V:Nب~geU2/鋥#R[f;{%yaie R| T 蠲8la }}ʷ9 5gKe1N;$Wկ" _dZU">*#ti0CjY%dwCɭ\^ft::w϶j [y}"?^_C3?n4ɡEfj~LX 7OrtzYT ȑVv\tl}^3*{lp1 5_ᔲOTKD*y|q$2amdO'F,ӇnaQ6U|TY ElJgax a εڌ?(oHҏ*?E_đ$0 x[,C_ #QfӚ~OoU"YtEn3fZ2j몫jZnoxMv.}/k!ПeQ1d3FH:m&NBQ7`(l%EȞOCi7 LI$+GFg'iMro9TPmS󈀟iry¡U;Ow=M3f2,CΗ@Ue$r^3͌A&c uоG | D(.(f̼h~Q#.T?7fI]>GL& xL|Vi{kPafl2I^Vp$:&G?ݝYr xEMY X  SgZ:_]Yci9?wwґ somqPϬPE sRoc"NNN} īmѰ2AMvi)(θyk~R-e>PXbG*q)][ rq7ìRrrɹ\C"[t +W7tEen5%U wn?rv£plЉm@R/^ƖUwfp劓D, kra+7MSCx`\j==c:klnR1ԡ_!ҚrZMc(At82:+R Y}f={?z.Z[*7n/*f"yt]=YTAԌ<"H"~>Cv̮|zgq2nʫHhxΪ]KRn԰2y(&ìeË`BbJyZT DqMs,v>n!I% , EŸW3$ vҪUdO26:T67oי̕W _MʾM3~`318"F0- >/mԘ@ uT56fӕ]>ΒW`xpOHfSs9GCr\z_VzN}bB `se'#HaخTx+7Cm"Nck0M$1J4F {`9bC&Jΰ`U$UVXVtje#5D%8eMCTI}"0S#W۵?!P?Ǘ)3d}ViV|{q6e40d KY?C\hsD-ͣ)T![L^+f0S4{dXlQ('?S41sN)CalGJpCFsc* Y-+0(*NSfj pDiZ')Zod9Bi`zUKOGmm=JfD:svtGH$LNтTeVa|^Yh+_ʧ Yƍ.Hƫ4㭫 +~}ւtkGrfPʍЁF<B[$!?y{s=,T$L0ɦWHV`  zUR%O󺚌Bɋ\#$4U|2fMjuXv)5FV1ZqJqO&"ƅ=BP{/uXtjTHLc9wŴ5|(CL&ٟ݈mG[:m2@Yc"*6.6sovC UdqECL˫_{KF0f]W߶H65`77aM4!m#R)h2 EW!qkN ڍ$i>ikb^{6_HGiy ,)FBͫ 7x8[ R%7~Bpm ǿaiOlp3Й@Q!:2yPnJ6H,YeL98L;_rqp yYʂpeʁ5<'whYV2LfƬ%9KԟH8l}<9ݿr\i9 ";"PVtBWOJx**8dWgWu[ =i_)( _a܅q1QR|8>\-mj2\ȿz~&bFtJť8?g'lCaw~_ s2< @a! 7۬~=asd [XՠzPDg%] ڍod%#rdLr>0%krdj¹ 7+&gcPbp*3z08rZ0(l՝/)l\6Ҵ46zqHwOp,vOCJ$c)2 & vb;꾒3ѣq JP~P",a mN2d}"P' ],uI@[ڭn9.LQvĺʿ*9vg&oQ殥j҇m|K*l h'C'`V%lص&B.j<]拟d Bhi0N,'`j7WLԵ".%&LKVx T:T:-0e{.Sk>c3dF!y" }| 8en@YGTA,6dEhSf-A5QK_y]ݖ|=(}ÓiG*88qO8/_6owZl/3ߝ'ZWN-D5CŅ7> dkAP`꡹~}wzXN/8INrI"/Gd[4^Tؚ5\bdP=tD4@,2E%$F6κ$ApB}@EE"؍d2kלWs)P" Ώ뱍QnH wV)W'viXt.$)t)U|8XAZI\Veْ vQqbn_C%((?zgH}#%4D9fnk:BMgX>Ը#PCW]E?"_B1hج2;! mRN9}du5R~[kdL;ЀC n~8ʹBu-jtE+=dj[l!laќhG,Prfy6ز;:~h b{nAKuL*'9! 46%/ihag$J!TEfв/d|@̺)0mG jt:, &]}Wf?!Oɍ뿂MdwJ?W|]Ƚ';L,mSzsx U} dD᭙EϏQ[rEq?&pMӊ!}3zH*3\Mn@z6EYlWF;̤TA[ /t1,g̪Bo9bS?UZ u(M󧉦f&#N&FQoťN{\FbPw2//j]OM̘B{(/s hs 2sp ́ 92!&[N ѓ){1[w$A7BL:}ycQuNC|v˚o?8Юg]f ʖnkv;#vymjpW : C`܃ IsEqFH~WQ1CGT'&iJ/wJWwԶ^BsovcKN<#qi1`>jSt]*TWe ~Ds{O)oq- syQ^nDY~sÌP9tH)!zk}L8[fWm2[%+ 2k> L z+_`Ҏ)Js6#,O\sFMI`ղ>xh&\h@3&ϩ 9QYa5ࡴ؊*m2DЇMM6zT4?_8=3H lXGJb?l,M*P0&dG&gF9Yӛ}+[U-p`G4Hq {3d5hj׋^㫤4`=?p|-+F3Y  Q q@.^Ѓx"`)@kgKHX\zV̙R=6篋_~/NcV 9i5N(y/[3m:<k A2P 1&Fm4UIk,#ZO6^?&s6ccv& pK, lt2>]Wۧ3Jbjw\ T_9ՔӶ:4!ѐXTXϯ5Zq T?Jk=n`/b"+orQS Fx.(9|I\i I 4^>8I+*ϥK~mq̍ي%z #mwnJweĪcy(!kC7 S ΀VB$srśR/?wb*b& B`RzA5z€ePI~rXjv"*3NY/B-w>y̠\N55Z 4yXV̏dvR S|gE-PzU0cWd @t˿rh(vbݑ`YT}Q0 EYbSK krKgL7IrGg_*kc>>E+Wf? IMG1Y HvwzGg6Wj,q SJPCg&~J9d访%ؓzms=I iTJ!7]Re;L^Hs8\)Ωwj[Yg{?|FE`ی"D伮:1B|+|CH~x:mz-^-M!sDJａ/V׃? Ҋh.AhQŏ(1ș *תxazjv&|O eb8Ti8:yj$dN^hŰNwPڹ{_pyiHݼt*[5'! q]̓b1nV~nFV|K sxJReaɯQ'I~ G#:XYe NEh_llWYgx{Au9>Ϫͮʜhd5dDz}E'é-1QH\g ;y:9YRN7 ?W5J:sna _AH]YJ; ;#_D=3 {S _٬e[ڐjw ]?ÏJdʈ7 L;%9 pp,BU=r<16ΰ_倊QP]JD1g`W @=/~(Aߣ a79kc.5RDhF+KGw=CE/KO.6Fc,RI8ցPM=[)w17&m$IXS嫴ťJ]uĕTϋ R/_82D#+DYndrba .Xy|K"Sc^27RȅΏ8֘3ėq M"TON 9 FmWW3W?.9#Z{;x>4ȰW\s0z sSLiS&%֬ N>سZhNm'A[YS;bS6`p 5iF,RȮ[hKnT.Qڋ02u9ܰ!@iPzI`d˨{ch IbOe}Z<%; zRp 7 ;;ǭLZϤlXn9 SPICdš#pXbeˆi*ѧvmBsEn "Ϸ(Rzo@*K'r'C]@˔1u~ǫ1xiF %fdYqb[Z_F!O퇬ưfOv?Iࢪg^10W-)~%jגl Z,"Hzan-uB 8XfWSI|@}۽ݛjp;ufEގ`(yۧabN5k#1M`yGD'PFc*b&@Tm+ RΎ2c9tAc0qHKE R~n$(^uJ-?cAW1fxsu)VY8>]0j!]4?k>YЬsjΐéZA m]&}4k >/š*$hte|sn|o-%.KG lVVjJ$Iը8xj tN^.*ʎP^@q~);QClv2 wJ3v]IÐsfP-*f'"d89`ů`+j uϽ)L{FODې{1IY\7[cPπ >  - /ջ yY3+c+PUVȗG5_ҍ/c1RpCkH3A;K hO$56Aj.>_-z5=贌NvaF;nWP&(H}"i)6 )tm?#IyMamwR9s>riC[~3.7$_Y,@w\-|x[-wV ʂ@kOߤ=]:t5ػ5RֺܳCm8h Mz~XL%(rƦ"ԢR 4:*W}9#C n1.K$hԅPWauaKn4x@NK񾉆 ;d4.ǍKi3j @Jim`ωTepvdm9oGp2][+$C 0 xH,dtH|p,F[^&> =}DN,Db2%v=qp!0dЈ1n6LNKom7C˵/0sNwl;LD#GA&nЄy>=̓W&l.G_ǘHik?Ol_W/c6)G2 +DczFWs^594Q xu#ࣈn]&Rp耡*ʗE[$zxz26iKx<8"' :v.M̖'ʦBJȭBM\_Ϯ횰 ZE`駉Z 8{Xp.NZl)ʏȢ뫥#"Coü6/0kBJ\7o`Z 8/\zTn]Q]ЇAqoRmz<5'Vo̻+w̎A𯈜 ܸ*\_IEaO-g'd.a4.蕼̓80n(W2С 2mX Kލ?[2xODlTڷgbs6 U?\9K[U%/ Abn0 YZcar/data/Wool.rda0000644000175100001440000000041213017662414013357 0ustar hornikusers r0b```b`ffb`b2Y# ', b1/K/˜QG@œH SK N b#:v2-U8Aī Xۀѱ 740n gS~M^ H1cZ\%Ȇ2de%W&X 3 &ȕXVM9gQ~~P@05?R@lcar/data/LoBD.rda0000644000175100001440000000165313017662411013224 0ustar hornikusersBZh91AY&SYD^Gڙwc6Bm c4I ( /D!@6M!Wi"c@MhI"@o "c$ʸ_נebX46IJV 4D3P -s[b^^̠ gUK"Z`]HC')-aE9ѻVh/.`?|^U^۷\h&b$ЁJf_vyJdTsҤP%CL^YF3?H  car/data/Chile.rda0000644000175100001440000004754413017662410013500 0ustar hornikusers7zXZi"6!XO&])TW"nRʟt<3n2u* <;7:ǜUh.HB!BX!/ :݅/rE~)B:lYqp D`=u{# :S@AN^iY.EufAo\Rt^$u%RC,^;gi9_^yD&}տ Fjf֌KgTaeq洐\V޴NE Փ3~H "L#)nK^A |Ν؜@>+ĀFzTߡRe,i pgtŻ "2"=;S{W&t4 }WξttvFpN2q}m+cbA~$eGpۘ{-F[rS7d*g^.1zk$5Kgx nÐޡKpҠca'MQo&+|S5x1ISv"e؇H%a C qeLe O_(ƶvpXO G=.ҹUK~X~NgF=u6o.Ϝ.ތelߖ=hP mm.AZ/ZHYsƿa id@qU Oƀbrc6IeiQLe~Y\A3r f>4gi4̙ Av['wrQ}o_xx1BeR>9f4cεv|AX$\I%nRz$aɧJt8c RXTqg!kS )qF(漈/"Ȫ=fo M#5A F<ת[CoT>d|@sVX&Z.8i b)ގ'Z)RuB j %>JeiMZwN\ODWotKW͖?5:p`b2[%̛%gFzӕr׬3x Kzڐb3_y㡼5Gx6*?|MADBg2Go&]>-$t.{Ed)ql}2(+g= ^rY_D7\NѩVl-h6@M.ƣhUx<Olo+a"<( b"g)IGa@¢o/EQ)\qtӻ޴GB#>F.Mn+lx5v*REBQ1,Kzn JnBndj_csH2T:j:U &QZY>psUeYY3/iH\G5stpso4]*OrP}β!?7Q w=v(K]}p ):B?*xzOK42:ƁF D=욐Rܪ(kΛ)zM%%m mL gB\єx.JHzS%MZD1>6H)Z좭d0 g 6<ՐQakiv0,QjO ‹2Ji]TRaj8쏧?Hkτz}fZkP\Kg;3+u ;ZyDtǾJ2L1VVQ#zށQim;L|Ӿ=?_LQMd/Zeu(s& I{yh𳤧Q@,Q&!V4`=; BYF7X0kkُ,cs >)XA 0z}䎇0QaǙۅA*&h2O\cқ`"LSy!j4/oU<鱗|!OfL#D\ףBhہ&!$cXгCO!PD{y:m3%ܳF!Y{ß-n^n;7?A }T>aMhz #>35,|yq)s|zx ʠݨ ל(۱!$|ohR[,l\bŃ^+dƅmD㟝K&0XϾ#q ,zAYjBx[H!qVn`>ͨߺ)>UP|~D[3e{—enVk'^oGTOPE}6I3OzJ`_HKH;/!]TŲ<}GeoQoM*kaׇh]5ǿӈsg#y\aӞu>@*;Z VP8id) <&đX׵0),zQ'Bh7HpfmKf=]OݨiqÃq6Z'$Yt+t,nł W3;Y¼0l~깇H<՞ZVg0\eK;; \#F(FL%nQ0RO"k# 24=frp)/~?&3IeF\?ꂣ;Nfܜ(M{XWYwg7Sԁ -_Sy*&kS}Q'%=i!G0nCkY(:-dJԅqԛz[VTZR~ vC=Ig A`ߕ?} -l ~Z{ݧ|UZAWW4 ~k 9UA4gbf&a>ãN)zC{gZxKgn2;~߫uKCH<{vzG$jins2V_?s<9T"l25hD9F,')(AK[=p.i8lLڽ(Z̶*`@|jɔ|Py%klg,L,=   j:ImB 7#sg3ޙZ53wA],t3fLjB 9u!?r;IM0]3t@2KOP/aWw \J׏d6"J課Npla {.`V)%^;Y\.55tjUDř0B=|; OB$,n!fr7-ю#@QmZ+ ?jӿBj(W^|ěּ3q S Y_t}b$,ZN&/:1Ԑ2dm?;gu?h$U8;W `Y~v_?; a'ҁB1AyáH6B|y]X)\>$Y?y)wjU6s 2$iڸ[Ӳ94opAV_v.#+ąWc鄃 ȪOSt_jym.:-0&=D {x Ľ 8]1m^{&^X41ޒ0:ѾP C=lB8rkudhq>ޑ˦-byE7t?d 1 ׀q棉+oS*fh"|LșLs pA-U^#:f*;EQE p̽18rDeoOu}X޶XEYU<s=GN95&wEe@63G!/Ulx l0v*i}M#o#)۩8q^ő;2Q h{&03Dn0 ?;ã!,z) e<6%۩^Uk0 LkǞSEDdn#Mg"),PaDStٶb0`$jήQk2b1wL8fZ $%]{`˒W|0>rfB0M^jnn;@x>{J֪Bs!יtx֕dނp,[IVO<6[oID/bQf{F)BSV נ] p$4[w)sy1kĒj1c?$O]yHea Ăa@Q 4}IvU hoEuI9ELwFa73SAŸI_FNf5+Fٲa˻m"Kz3:F-Сn*hZ+|F9HP;i#ny(ݮN>`콚0u>_bژ/G7Y7 HMV^j!0\t Mϻ D^L?D4a~{!@8z+mqx*4-' ӲJ|Zh'uzj78XB#6aEYIdIWMj}&R{O'> LXs5{!D%\cL&xp_.f"b~\0l%Z[RQh8EڝJbɺ0#1%GTn1?| p>:_.,H??ޒhQsW$4X5דt:GF#!qzP9>菲 2 z=Z&I%+h IM͘+eNpck4pgt%o?x (i 2}\55wiU gV9], +Fof3:K0*[`%]3R/^c%_:?"nh5VQF؎A c!-p!4*W93(.g?DMsỶt9CE&,F@ImT;4Q>{F꾍C灾&ڳxNX[s]B\H(h*>y5aЭ3z^h;0v E o 2J[~_&te&jdov{ɨ~9mvظ)E8E!BW;mBck3j}^{2iԷ|RZ͆ݪ,41J _Tٿ9~okC жpBn?d}H{pS9c/f&!t?%GVՁx! yE2p;&~%&BMbE'1S(/ tO"0 Ԏ4ťgۜOȡ9oLY9@g@ٙ Q |$~n|DC>*C$m1:E - SclLlc^+D1jVi5}boL〮ȢKC1 'fDs@8)*xsxK\@湪,2xo~&uQŒpIyOdE# DẢAQ?U¹*='b `U.XzR ,)57GhkeעҚ$p/pe47b>C{ZYFb\oxo }wSX+Goxذ Yt /lw^$ap, O ^ +s'ұ3pcX?sT:sU,Ϯ]Ood] ~+C~‚YSxjyis3Y\Gqnï`. ϶q_a[63:Fl'.z .e3w-IuULuay` wPзM-N ( B 'l #C\T3Zͼ9 \CѡSΒᕈ`t⤋&AUkK5*QG vNj[4t&Ϯ26(+~YXSv®#D8]rT {+(@5dAG:D{}GR$6g5O3;rD+'V[)HxNM~ -½6Q?Z4̏03B+$@~lߓoJJȤvVbvhNUcd 7WK4+%kxx˜++Ј.|[䷁H(2X |Q|C6zTyO6=@o3'^.G:ǩ#οȲΡoF )مn>9̰_M..A.ЩEY\T: 0sZ9b4Dţ0Œ.yH?hd1nOʛ$r]mCA4xN~J,eGu\ҝG>4WOYplݪ+x43Z:Vj>12d7W%|\ PW[ +A:rC?rF$ Qc? t.CeG7CP(%`b(Z$5$BPOVa I$jΔQ&*nNa7kE(2(&Mо OC$.2jeKM[ Ƅ?JTwAT}SN`Od jf|!oJW0\O'qhm#T1{TYu38uqM&E9-ggb+cWsb0f%/)Pvt&"tŖe )@naqB. 0*#O#;}:jKVXIj~B xxtaNV3խkY?r28\;ޠ-`ilGC3<}pRn,d/ObG_3˞<9{cU)氪Xhs%"GnxSgMq =*cs ]~7{AAAwtTW^k^O/5u3%zѡՑ|DQX6 %ER@,Ѧ8bRxTJL"-X±[,O>G:!E=H_h6eɌ: ڳvPcNblq_T6̍r*4k]H$ݘ/}ZG H9oNmv̾@@sE3ڀQ=; %q`/Jvq~w.[SjJ~SkԿN a8Yss@]߳8/@5{{;k?V:=X@+ -fPj XAL,4AK:y;zW[$턃6y 4 WVӤ"TZ^dL?3$į9Ca[pa!ecǜG?~D)}3ok7\q4D<,J$n@XwОfJnkvj}'rQ֨ P9/)^n=N"-YsN[(l& SO[!&9mw +wK+ z 7m.3GStS#c guOKM_H7 h-쾡8sz'hXI7GP ʺ\X #þB.thN:8l7Ck#o 4L`TM7e'} G~Q;/ƕjq"GM*/h9pq`V'h]D1Jg #|~l ORy' Mඤ˖?~yێW5G,4N;[_P zҌ@/Ĉ+x{ wUF$kG>ҧ4nț+0伣pVp+^R;<-217m  x9!Du*ȶ 44L6s1.6^YQ5n!. X #'rA W|@UL'W"MW>yΙʼnƜs"Zvn`9X+"x# /_g1dʱ.v֭8>Tt)C,&=|1YHCx@zΓVfx0k?+Ic 1ȹ(oQa1f>RJ3$PK( *O w=]ƚ6dX艶6'Qt!jnzsAcf땪u" -wW` DDI#Z4^wm خ@;Ұ6ж_/=*O⪝c<[ >@ } X߮H8pX#h@-S*#SQ?gh%|\5]Qs~"}rXPg0Zh}xH9uƿh2>A)I/UF-eC`՞ wlCl×f#[rn,a*hʚ2۩5cWptOyՕ՟:S1N|#ȅ: xaRu@z1RD}88٪K :R[CUb*u#}y  'scf_1UJoD E՗87@-^qMӀ=OB==.o<9#䰨U,G\rS-uյH}k>yxbgƮ.{Ã2,Fl#rH2o]4=\S ,vGVN.yLu k08|v|C-d$ =@!7\alUiJHn%3nu yFr8_ʪRZ;.`5l{=,bN0U\G<[J[$=r.VcJ>^p셳} v GBY˧zS' ]$u_)1CͿs [rONU#sB5ry=Yo) 3mguQV`kr"#40{Gɩa?g}ڣ:\jNXW=4~b![?ͼS4弾{<~p8&M2WMmo8YISʼn%s*D{]KN'W\PV"f̲!TGIzD6) ,1zUrKh9}e64smYX] {/D'h7BI|^SGaGxMgTRB oKwD+,Әj1,K%0Ͷdu;wE `Q𪚻me#>j24%o$k1IjbS$VAoᆲ8<<T4aUNM$bē7UGVn|'M+a2;?L=.D&"YB)U~QSVOefW,4AsZ9߬;dڿiP@Z]l1X?rGӇ`۫A*0nȰ68GU(4 <ʺKb3XqK>È$\ Fs~BEh=#&p#C.K=}pu~R{=ϦxJ׎TM;E~EpLiྒjy"SS(%8x*_ ֝ILAމ5#qZZU- %]g?J{v9DΡ@T~TWd| 'JR F _H#XzDG4Lg%[bv9z]z {¡\!`Nas];Y6c>sI_dŒ+c0@\Ƹs@qu2?;J}8\XdM6B.be0#,#-vpqHO7mpI4~؛SJ Y)<ӴQ!&?- s%VeZ%a4K=T}U"ujL_P0 Q顬ʿѓמ޽:0nh\.suw˒YtoePfYv &/a(WuzpY1f:]&o0u*UN?S-l[H\eʝ)*mK}(}g ;k҈눤r|^Htz1$zƪBP9Xvj\Ĝ͍֟"C{e6Uޔ+Nܽ<;gXm3B[wA/_ ɱ}5伋:L?t#ty$!x\mEOJ3r]@Wc[^,E-n. roy5SzUl!쾜E s@m=LJd| J*paBˢ0%ZSɉ'.vls^BAdCV蘸uH<=ƹ5 iȒ(%˳6Da1fMp&S-cbF3Uѱc #D{8&PĴ;(p% >$:W)-Fh4uښ-.Ŝ|ufnz _@qB 觋,dlL›.4ڸlr o3kp;o \ߝ'd6^>Kl'iռdzHq݀1M|kԩ ܵp|vrEy fiB+[t>~B%8meեU`L9o =d>?]9(ͬv0%P8 ߨJ,XNNkcMN3~pZBîtvt(G  YWC",w;KtVF9GNy(VBkn!wz2ӿ.(2C9:i efWqA92ea=!|.įO!c;% S }jbK1N3EeJ9-}=J)3hs!G"a"ǒq7riԻ/[d-]*z ˒ RoҨ>S[eѿ-D )c'@"je,%UN=f E.?Wz?3L]|a||)5 ӟD˜t?S/dgRc 0^ඊ̃Qc+_I Se/:۷Fs3sC$K?\0^~+Fv|ڮS,_aJ^!xP-4j FͫW㞰dʃCWң@l? GaypSV/H`iRME.\\1I8sx'f/p ]pS`gp@B'M>>w]KGT"m2Cw ۋFb玕#7alo3i ]LTīB=ί&vkpBmzQU [<-aM0?w6rFrw d1-S^u@3g~ qZnԪӸ !9S#u~]iC(85pK~c Pݖ(^ X@[PIQ Q؞^{w&bM!pG!h)GՅXie_X!ْ},d\џF!.&U *pe2v5Ε~Uxkv$<b`?Kw)A.=ZiDXhڝeGL/kv 827P_d%~i W15ȅЎaJȑ%ej/ZRɀebΝ0M#VO54 HiOw`*P;qI4T{>/6xn qU/// I u"nX;:_ӥٛ!m](óO^^ h%wVC=jdȰ* r'Nm CV`ځG_0!CI SNaq~E@r?C1 ]J!|S2pPUC_){a7?Gf)s'Y0=.uzJ7IIGfes -ȴĢOI-wezj5=wOtBxM uv-%8/Ps2=<*^V[3df"v,@3җ7P]q CVmV|G*F[MKV! d&o Ѫ,8D0$׭#zkZh^2]D0`)ixB>L;_Yߝ:N/=:Al5+ 14#e=;nG_+XY8iK?jZ.9V!i昖aȁdjܨ -y&S7!5Ǹg1]orB8+;~ ~ȽQ@C;mǵZo 8awf}FP/=^\h^n[˳݃qI0wfՊ>5Cl/R!q"| Xn(T%B8pž~gp XV>0 YZcar/data/Robey.rda0000644000175100001440000000142513017662411013521 0ustar hornikusersTmOA>z}*bL< ėQ( 4P mzݶv;&E&\+&ݙyfvfKÊ89usNc>?#N)^-q8 x40?%Dϸb NDijpKՎ>_$+K孆'x1?O+3˃rr3XV d?B]羧뇵cޛ|/=2iAKO%/PO~xfJ~EcBӴqS")yg*ɣkysc/:xik;4Q\%tBHNm&[tNydsxx#^ +Sksx(]Kty,JHrOUl}\Jb:+} \њSP]jIT[m3*l2ŽPgqWg%C"cD'- W:Jt!`Ӄ |p 2f&sPYЦj.M–=a ZV -] ,QJdDmxhbX'Kt1ulj`qOR2~AM\6@5V6Ms+ksӌV }hkF@p2*o&[-6(n4plBc!LBɦJ5u l; ݳ~ldcQk}LSl&Xpg \_2Ącar/data/Ginzberg.rda0000644000175100001440000000576713017662410014224 0ustar hornikusers T[g K-i##" <ѭRt*"J1g9w\rҢhj4uu5:%PihT;x׮n4HJDt#f(W?&}e)pGR_9xi/'u9zݘC%qxh~=l*T/ vKaC^c~} Ae ]ە3SZV @[/?U'()>k8]]z_ mC5 mSK} -k2GU(FpO:Hƹ|Y;K )+gLZ<0{ <@7`vm.NN @8*\[KK. xt4n.ZlqҵGo*I\.<^bDWͯn(׈QU쑧\-Zp'}<(-Gy~l55*\:V&^9٫ۣЎmls#%Hilh6Q吖M$-'T|URkK z7n?/lߘ8bV$n͒A2hں[wsP[2ؑd\GZe\=4@WsC6 n8ӁۋB94cCKg{zSXwm:Ǯ03v܁N#;A>E6e4(:Oƭg\!wl7}hc-ԝ oзT*CgA[,d -:BgO#AA]`ij5!zhO,{v=N/@Jp&.PT h4n:<:Ƅ\ VڶQ4!PU{.ps>`+S٠&vGz \x$!fW=4W&I~g^j2C__U@IV/IX |5qIߺ5^}[@PȄDo@"+xTаs[kV+q+m2AAC(ъX(aQWkJ@b<1s7 Bb5ա8 OAcR[8}^g=? 8vvLGȔ/]oaQic߀uv\̿߯nS x# ztA׹=w8{ZN x-t=0}΢á+AХ#=<n3tme/3fj%'8 ْ !uPB˪lB3-!剑|1쫠2[Sc\~(|3bT4[r8.5@e)+^DlY?g֤yC'<=ˎԾ̼c35@] Ј[/ ZGA[lS](>~v/4(Kdg84}H &yt 4. {sh69$j#vEY^52esNi67 ̇nyb:Fʹ~!]TEh菌&=YrBmqu{ۘҞC0UH2t:ui؝|:u?]twLʡ7N3:[irT@Fx(ǿvjm[:=FD94NI?ɶ{FZJp_kxM[= WFz|;iz{MvҞQuŞ(Z9b4yJ>y|q˚M'6] •Ե!Ǥ6C+PwUqM*m94hP?nA5j3qq2f")ë 5*Ã*e])8 qP1HRp 8pۤ7и'Ea 5&$e~&yla vXJ.˽_⃊kr!ROks#;˓JAT\Pu~wl]tG+O =ZtUS+τ;-64UTR`ݶ9.OP-'@G]/#lDkAe!k lbn_xE[šK/.X ?(a*wzQZ~^>;xzWם^~b] ׭JퟣQ:5Ge75o/YrnF̉$D`s)Jf(1P2G % (Y 2` 2` 20G92̑a sd#0G92`" &2`" &2`" 2X`! 2X`! 2,a dX Ȱ@2,a 62`# 62`# 62ȰD%2,^Jcar/data/Greene.rda0000644000175100001440000000503113017662410013642 0ustar hornikusersBZh91AY&SYх_AKK&a ## A@|mh !L4jmAC41h6$ST#00&&&LbL F&I(OPɣ@ 24 @ @Ʉ ` H)AM hi 2d6,dh,L1`ƢѨTtEF! .\]%L tkNVttP2XDJDH"ErPm!Α 蔒)4oC&Rr$l5qEaD"BX6Bq Q.Cz.\ \qNq (9LA*!D\`@Ҁ0h9,&Ib(ɋ99A%*fMHtuM s᠁P!bW0cBAN\JtG']i:$9(7}k@"|O'*kz A$:81$N8q7..rIΫ7Qp3#s:!LXBӦZAR E؁'u ;vv導Hٵ.!FR݇veđr34a۶zؕ1۵mqnv}vzCZFu顡# T-{ts94OVD:ۮ9 鷜e7 pݲ-Y5۴E&P:0y<fakCuB n2JV;;D>k3#ljG^()?C0!3^儮*ms! oDs.;o81^D6+ DBzA@m*@ @5(Des+iѫ&v0$STEQ"Aվh;Q1rldH[h@xkc6ϐrMBvj(xȌ.MU3URӽ--{VeLdm]f911FT4CcWRYwU;!dZǷA2YE+ƓfBSW"o"BHŧL8"4L汎\<9؈wڢLqvY>=JyXRaJ Kvr7@ʮ56xS#H 每xM a{aS ѯ$JHIx"dErK~Vԣa0[`5/ƾe\j0歐90A}uj%٭AX$ ,W+6[dARB0QNmxQ891'?&~IBq>Ug`Cd͗̒@jڈ.eoO}Wk{;xB9~A ߩ#5`9Ji8!#<">Ravwm g Izɩ0Qo`y L6+&8D_O+Ol."(%PRX$ZJ[CS~h)@fOI@E$Y.2dvYAɀC;Ͳ7bJ"Dl:ݸEPDۧ.$hkg0F3T @rIAU@RH4T Z5&U=t"(Hh€ɀcar/data/DavisThin.rda0000644000175100001440000000140713017662410014331 0ustar hornikusersBZh91AY&SYB$ ,Ȉ@/gPx7R RSSMQh4hAD4`̤J$FSJ"A@ 4b H0**R2 EB, 0H 01Z$!HV+TF*4),˙r& #R UQHDQ Vη+#rDV j"Բ$)hj4EEVH# B67YTqP![D(D SN"*Q@siwUWU%]_}u]umUwuwww3y˅<âא="3gNF*t!_z SB`ܷF&Dcp[7jk5([Ibw14@e'mA tj$DD( Z{"qÛwH01l:MH1CӘL|] D7?|2e]$ 'Еfj{x|h[A|m8[XSK_q+^9|F>2_5#P8vNqOu>2Rf 6w񽊵|q^-5`QK?oon{Y7~ :P7g_p{0l"8,݅^Eb 4>r=CϠ}+YWgf㷎Ca x L]du".]:BCP,ʓjq{$݀,7<~(.V<wO@eGi1[HȢjXX!SمjGBMn"e հ}k3f$eUѧX ;QX&Q,ٗ T'Tt f,^&bane}x42 '">KlB/Po +pg2WeG#]A&7\R&~xk$ZY+R#A{Fx*8ז֠!!uwRNՐݭMMj+W/6`>(>&i5kHqnD> HāAwʵIjIW6|-&7']5񀺶D짶\c]:+<`d)J*$^hl~?i?z=!1G}w=a!ޯ  bni50>4YcRk,Mc&HKs6&h`AZlqHKͯA:[Y'Q)L딋: ZTTgcs>OVb,;,;jS]fQDsdl/f2}^"t(uw) QōbMɕp;| {[Ha#Z$Znv》1 7 4d64W#E4kՙ`]Cq7WVMO#nGM**Ǣ?X*s {@Ab gF lのZN|P1 V\nxXV^jۇYDָ1D: -0[tHRnQtYa;xZr :Z[tֈ$r*%VquAbGA̞Mn۔'̣/`DhZdߞ-G &ĕi=qhߢ"0³ɆC׶7K-XM4[ 1a[0iǷi2S<Zj,<4g5z4x2--nlr`C‰Rg@lLN0aKf,\t0UsceN_NQqg_iN,!Հ z>S{uK>V۱u#*;.=. 1. Mǁ.煅]8<x;f@_-+4)\Iy=K#<'R/car/data/WeightLoss.rda0000644000175100001440000000071713017662414014537 0ustar hornikusersTAR@vB?Tb3\Ɣ79*)t}T_\T?aZpG-z5yߠÇx<|Ϡ+#|CF""D= DЪX ?k 5#օ5{G$ =sQg <s}n?{H7.DE2>ɉN)v#;(?B^e)F@7(@^NzBzH#(B$]@@ ]7" "*nV;';)g3gwrqBkacc-m֚c%lU aӏHi) $ ۞d1$_DžkK2M!\$_I[I!.+tě$$d* r;+;ar"g$@xDk!ɣB .CCI)߅fID' q;I>I w@$^$_Q>I,'I$9$-$H6 $&)%$GBuRĿ;꾅m!<$\<)|cɳt$ޜH4w) ߃RSGuk7J1]/FE^2լ$qKWVćΉt̍ÍGʃ0{ەN1$紾铬`«^ZpSWG ^\_ո$Z}U^իxZzh5ݏ|[E}*qGrFMַiVۏ=GY<_;ծP]oQ/EL@ A oUZ\<&lF8}&|YTy.;H>Zq[3j1Gӓ&Z}pTæzMΆ3wʿu#3߫ߜO48p|1ά⺛J`Z~Yú@w;힣/)dO}#z;SF? =bӮ( {Gc=c_{x?t"}~͸à}?k1u q0vsln3wַ8bLd'`>󇖘O8x,h7)[g\;q`Jr'NGйܮ *0.Ǹr<)xK1_i Ja 1|?ϳ*=yTO W YI/WXc&aoh=5]Z5"$5{ތM?陚nFiقx:a~*¾ m3mgb<& iob4S qW`s3*_8Έ\ckG<+ۻcp; ́2WnjC{qr#Z&C7Ʌ9侵1ΰ B{>b\dgp|"? us~e:δ1GkkX]׊e:~#X/F͍]/#nF?n/^l\k|3]gMEKEdz{  (M=QV *eMtEץϼ!2SIVd|x(I߮R+ʊy? *un {ޏU t+ɀ;}]xY,~uewmzV4 i2#|SK?:W:&c}Og˒!NoLs@bkH1W[,$Y3]tmM!W7?/Z<^kk͑w~HF{-YrHzGw=!'5?H);Ș׽gLݐ-_ƕ(C?}3HL=~̯Q|a_ #T7p{3vACþϞ- ɋkޗ._-{s/21{ތӧjeT2#~/kf߱-gAo2-v҅2W&,89eRvJywig2dt߶"7רa2E"}ꜷFPwxu=22vc&ՑW=2˹^{ۨ)?8)O&n?MFG/%ʄzģ=eKI3>*G oK2qr;2/L|N|'w~ϜV _oί <8IUvp/|yvUo+e=*+ }|S&/;e?d]QVRKy~|y?tWk"]z|Ż }5OS ~_qZ-3Q[ɕG_/ɰKns͸#/m֡뾯UoO>GeLuU\>/+˅ }lfuvlcυW"9~=p?>aKȕ׎l[[])Xuz{wQץ$ gnX~QR0~IMVɪ0zj<esc4$\W٪$J@+Lbe`^")Ğ2%^<Ňir|I.)𓋘#'|s!|Bcޗ$d ~i0 lƾ\Q{07ی\.Uď9?po%so&xW|B\~+7qUUEʾzպ 5̇8+jܣ5q.j?o䂫I^86ţbO6p">* %[ d!Hr$sk!TOm ;P#ljnBYU wCSmkV YXjE{u 3ʕ%qF&%' fYIdT|$ |(ҲnĪvʢer:DUA^xNVH"U0:/ XIFҸ6eնT]5jˮ5EeKvl6[u5ڸٴf2Ք! MCQGMܜf̚mBT)[̩U]M]HҵJ6eʚhԭ7G\՝ژ=`r "1UEbU1 ?YNӰca$كߓOKYO~N6 UDU P`IӒ*~*tDfގs^ut<`$0uLx|/9%hϨ!VR9&m1G=%ᢍ*C@C$I!T$4 e9ү'Q0OBD* QPHl]rF$d,,,UdQU(Y, $B,fm.ELNѣ Γj͉Y\%j"]pɭ}ÍTpwgIشRҬIbEEHt!M4vsDYeMI]HA6rVBiDQJX *JY72ݘMV n84D5u'HE(E`,EN2(H d<bpxEܑN$Y(car/data/Adler.rda0000644000175100001440000000105213017662407013471 0ustar hornikusersBZh91AY&SY`M //FH)zF= 4f 2m"I=3~M4h4iC MbA"MMh4 㗯5^T*  %TcA &A RHA(.䂭c5/+@#\ ƢC2ʔƿ20 (s>>D (@`:ZzkM4M4F1c%YeyyuOwE&(` ILHЀgI16S7YMd3QbLk~&3QLt^NV^ZU5UH?u Rg4u3:c3k{#^Y]QGs**õw=0Ǹd޳9HOCP]p `u8V(II6m;,:b>u|ܣk-eR+eR+c2+c>ogLϛ[~X|Z-sYy1~};%$Liђj-it>%/ѩh?$[h%hI%8Dr9фǵKxA;p~ʟ{Ҙ.-zo $C~ ~ӡEô0HC_2ٍx$R\j8%+}b_iߵ{Y==,v_roD>W%n+;ۏ>)H| :Ml>x4cgYJKMf2aQ!6xO>:q]CP׼)YNek/2 tD7dR*SSDh#-уߨX?sEӵG6ԏ5s6SWɵ{>q阩_| Ehe5>8Q*U=ل8.Jp^h~CC~7ؿw"]Ty=*_Ep.<O*/%w|z[$\m;aW:/%?/^ÄO~|p.s.jHjkluo%=/AzI$p=+ )ًNJZ!UI?HzIl/T!Z\I %UImK)(lWwtޒ4_^{HT}7ue䃪u)>7jݛU=^ AIC]: n>W6naj40{6xT_ u١IK_+߼{a2'~c4 z2p})î}Ȣ;g~ B\D<96C[ z~s=7Πe!ܐUDq8Kϛq'C`G6c%Ro޾uĽ 熞c \π]n:tps/uУ}sUs+T`j> yW/yv{,Cr/.gp<%\Է Z"O_'I >W/ݘȇyQT5XB4YRn`or>PKkšHs/ !!# ;ɉ(fi!w(.8}̈Cpn-D`KpN܁x KpJ31 j=ĄxVi?}#0۟[kLg) Y:VF^ 7У$ak{Q};XxYD/[l|BNt% hU+A5TԌԍ448.˦تl5:[bj~}V|car/data/Bfox.rda0000644000175100001440000000164113017662407013344 0ustar hornikuserseT]Ha~ߧFY:M,iB?&o 1 %"o !/"~ 7={ss5vR30 FPML,K7ѳw,bj_jUk geΠ8ny{>`ZZtΛ)^<mN}]G㿌h7~#Մxpd^7?X]Xo_5oa dH=H9X!5r2 ~/e3X'hi8R*y{et =ο x[N|M-֦8O'.ǽG:lYOU>}fqNI_:@v I}hrɀ|=QX›3̃aTݕ*Sy[~l+Ue!F}Q?XLgɷ/<ȋ-7P79x(`=$%'Uw4QLkI3Sȇx6Suc7 W|93ͅ泘\JsUvTFq;g _ZVjz^<ճ{̽m>y˙39l&N<9HD"N X&'Fd,A8*fNBvDȮXHH!?@=!;2lh| @>tb|k/AH?إ@ؽ 9諄/׏ ^/@aqr=;ذ ksn<= Op +Ч3/RLlͣ8q*A+E'<9`Pwz;|@݇ttȗ>wE~ܿ{~]usS?~9{ѳ|s|>uSuf=;S}}¥@_iTb GK-<4ǼS[7mXˌFIAlI*ϯSG'Pװzwlf71Wܣ\[l[cU\S1"Ԇc –F̹:gym2mn)Z5LM hZLx\Ӎ+Swt7yfl0/]4;'d Z~5vZ1f:0C-Ԥ.25s6i53˪TYa_;^ӷk`6*Z4,1k2uڒJ*¶+o(8Mm lUduLa[֢K/tcRԚe蓖e3fX3~8= Di6XZlNHӢ&3%%4OkY.j\ʸrcar/data/Prestige.rda0000644000175100001440000000526613017662411014232 0ustar hornikusersWkl\G؎u7q8sC$IDZv.ƻ{׎ ?TT HP^*!UZBR T-*|wԕΙ9|s^3;ytt1VjkkXM-~kcMOYXmU~މ;u]_':ϽӯF}ZuM0rMnܿBY}t}\ҷTJ.XoSη_~O"G[>i:IfӁ%Η&?j\M[)JIv/I<]+Ҟ7o=%|7e|ip&IOⳎ KzO)#2^w7/AyEqꧼKP)\//)gKP7o1XR_`, ƶx=S \¼Nنn67|-k[Þ ckƎ~kՖgx~n6= #ƢX'02Wk~tO?=@H }348~>dX^D1:0V=ޏvr7a{VIj9>(wau_9_MWB_7xA?>s} /-1xO1s}߃G!I;,r_KS(y^ozvwӾ4e'c9Qޟ)s~Eu"ExT;iԳRgr')NIw')Y5'H9d=ᛒӷ$qz1?B]?N&#r\Cr~ä0?BQ:"Go]:6ҳ{w(}$?J]1>½ 1»#J y\;Kcwy0a) (% a${W~Uyt >U:ܯuA{wp@ q6^nj566΃~;:"_ឌb-WqmEuEπx`=7G Aglccୀ;80P18Cq8xׁvvP oNe:q?wo X;pGݱ wzb5h@ {UI`Ka- ?&$*q?)'IURB7IMԇ끯zz~7VҊZ5L+o"]++)ռڒy1/>N$5~9UJz.r÷]WI M˰ B,ZjtԿjj+z iU"3Z*PM).ǑجZ[|V0sW9֬fgQhD<=s2gm/20ͼ&Y6lV󛼢;/+giqyq6{/wN.+ö0[4rU0Wya? ;WnŐqkrKq2 8|iDEAG215E,/u:Y^^y *l-Mk 6sr_[Ee, 7gXɒΝ w <1c<k%2ta!ʖ8U$ ',PR!e۞ % a˙~{9lWO+9NseY3/0$D( np kq i@&me" HŢb*n4SWQ:-_RK45Zb؋dF_hUL4A#Q]"p`RbYYm );_iMH3oeSk3<pb ŋ2CB|ekȢ.1j4q^ {>C;WyR+Av#~e@UD[}qRvA;3v ̌)pkDPRc+筗 _AqˣU[bt g*~PwmrpJW{b!8*i/_p8:.p C+Zq[UVj%FbI =,*g=XxO/2%XyrMk5ۜ)zA#f5/o[^nW'RjSV[Y car/data/Migration.rda0000644000175100001440000000233113017662411014367 0ustar hornikusersŗKh\es3A*(BL+ML4fJC+ȐIdJ%3I Z(uwHE|wוu>`+"ɝ{p{|gNy m[lY2Ȣ3 Vc~o"?o8F^V*P@9COГ7d =%COczʆ̦L-M4m]wwvl =ڎcͱ:{tX'c$|bd_>yh$Y6>8Zr3fR8]l/0aTr*(oJ*6P@Y?N7$@Wi+Z<u>·ڪr4zXUBmcLW3=KfKd|` w?S\c)ϲpmxH_.!< s0 0Xg[v ŽkG+{o7I0_|NŘߣ,}?8FWNҷO&`=+C=z. !mϒǽؓq \rEgr*QjXpXq5ރ(5Cr'<׼HeR !wr==FACgଃp\9V?v sbKdrP9ȦrW_Ayj#}l z` *Z`{OhG -ּbdLM, JsK2дr!kJ0F01acf09acXBLp!egY&p)eba\)%ziE@y@vb4kcar/data/Transact.rda0000644000175100001440000000371013017662412014220 0ustar hornikuserse\U;o{S.lCMH6DPDkI<{/Xv8.۱7D$nD9wWwߞsז|WBHBjZKZȌs/;`1븡unKjpυWxpݭ#:Be/Zn7N}xc>~ChdRneεn'=xk)'2M~߶~H 1 {G O=h||핧6.\TM~3z0#=«`D]yeLTX*eeLgn5xd{#՘ikq䤲>qLΏӱyB{ g|9rypM$1f1vG #_epcȓ#dm!ra~(no`{y> D'՗Y_2ǙL|kD1_ !)t&1/*y\P w:6RjAxLgc (]86X?.g*4dE{rkORn/qC {"/#WfGG4^\6ݸhoyQAoDeꨐ!/؜h+{pg!{M66Ů}Kku 3qL¸xkKG^_ե&NrP5vu_׀yglB,^=)=,ѐ\ |ghyzsS͇ w] ~g_- e]~Ӟ.}a~s:2H7Χzt}D=ijL?lo5XC߬]i̝;AwG)?ސBge$K!'Mh׷ӭP}ѽ 7ڪYqgTD<݅N#fsͺ'VWR jlIEqvG-syVѡwL_m>T#7^b|昺ë|2/>强‡ jg[,AtrYW uU/tC]ư\BzxU__|/'bzr& xtڙj?ru\3V}ӡZl8i }uٳ5/Sjx-Gonw|91bL/W_C=t >zU ˺7qjsJ=L]oSY[qp:PϘOgzjbAʲil=7tٍS ߎc< Lnf}#n|7j,5 Wc{Nro\<þMIiO Oo]%\\RL^O&6NډRWǑ!E}GZid_z@&ͤ8Nyy/t=wc|<-Y{=|a~/lŗ, T8|CW$ car/data/Chirot.rda0000644000175100001440000000137513017662410013674 0ustar hornikuserseTMLQ^ڂR@DPUC6 "\n( m]cċ>kzXŸ;2đkq--:X!x+,vugJ}֍T"۝?nʺE^_bICOQ;xf;5\t_(ޮ~{T{'~OƺZbSV;:5o=bg{zú?]?gBwN{LWow/So.5j#v-imgwr׵CgJgif>Z#xzGUZ[:Һ`^WN-7d}Ub;hwceݝï\I!5n;i8(#wt;O!'%Bק*T꾘T@LJH@~$iTE# '&t% "%$W$}ٲ!A .^K|ބ9 >UfhL퍋7D>KW&~~t8oup4Rĵ?[x1 ?W,¼L*֢HP'"r:[ )O+Oqka=Ob*GX0{DkoHgJ^2z^xFR}%~VVtN|2D{HXu*aO>ZoҷJctL`_&^ B^x$_rdFT!/'i}_MW!V)cDa}(Jؗi6hktJ2QY)U\y2V_',da]h?tLs;gjUYb#W9gGaA>~_/_q8_,D8C.A#]y39Gؕɖ?-OUkd q7gǐ5'}䇏%G>:Ȋ`:;\M | ~}xc?M2~v ώA1aƿ/~oF 5QGB߇ Kr~F[dHaYpdL/F |JZk|uċbqEǵ⏑ #.5N#L`OxFⱨdCـa𓋰. *SiL~vLFX˾.JOtvJfϦ6>5^ޯJ=Y 90R{bϗD8C<9{~fn_dٴ;;б]@ൻؕo@㱻HO9h,l uW!mg?ynհ}.=> nðs߅J){~黰r=nW7–,-/m:d]}?l؃`uGn6lʳ_ž.~+lR ؾ-I37cmSp߇- aif؅?{aEaX퓰WVL};qo[L[oQհ3σ}}U'2~ w˰2%v-fRǒGkOnb2s9?H*`O| x-l!m:䞇F٩^e mgbZ1M'i]>jb~ &6Sge$-ٽq~GOdzy `:]A޶Әf'3a3ObK`s6 #esq>`E҇KV+.A_We3kq2kbms:=~^֛G&_\q5q-b-d3]pz6W^`\<}{kݱd35q%NlNתϮाa>'G v6k;_'{X5ZhUx?F _ɚN?3:ڪc~ͦͬWfy]>eZ:2.ywq\ƺ{~kl~0q*g5$r>ܪ8qm_&qk2||v29x_KdL䝹v^;(.cmz쒻pH|n3'ÚpY\(u7ƣ[7~=9Ϲ܄y;+ %~} {ag}LZdz g\}g0sp4n`?CYu?}AبWnfx.b\Ջ;y~mw-y=AYk<&/MSܖ3h;G묙;[go=綶5?m.f[Y[Xg9~vu0vfǼCo̚ٲqVE4jt'car/data/Florida.rda0000644000175100001440000000424313017662410014021 0ustar hornikusers]V{UﻏnGkGXZB(;{gsg֙{E\[[ZHjVfM5 jCЈ4BS(jDPLG$sЛ|w~wacd\΂g@l< Eԁ? T&ABo򇀽?6} X K` 7i_z\쯣u+obY]IW;fKہz`Gb<1D?{ xb.p` "{5G!DĊ˯7 ^-c/J}a?ā@/.(Pw.^b+p5+!N!!5)y #Xa?Rd=c5z ̻+`w86K!' W?#1_/o^8z3$r N/DYXxW]Q V-%W|µ+ $s=}Qdx"Yi2G}#qrP>FZ ap\c:ϖ&c"( (0Ϲ[-ڞ| -Ǹ/u1.R?d˸{kXj)g)isuORh?CN1L(e2slI׳m7c1s[܎ s|^O\Cq[9E}Xº/G1!}rϗSpo@uQy|qo~>pX%_i&LPeg\]~ƽԫޔrb͖{_ŵ旵G )o'6֏ .\} sknQT\cl#<P8b7jʎئNi}c;u=zfdOyI|zRݖ5._jUvJ@I[s?Uoe;$ UkwQ^GH+ؘǠ-k_˵m>cg8T9dx2z5^7+"ue8WȬu eLWd};wm+M~"q Ə-X fn)#5oڇfdJݪ3VDǶT=ou h;K&7 jlXoTL !΋Se]oUyE;h6gf(VifZzz {u *WnuBZ+ 疎UnM ?BFY}H+45sbm{Jǫ: gPϩ zǜ1SC|_}K\gXQ`b JCeEwO {|/[lC?3Ga3%N?+!Kg ^zv^·̢9'?qߔyUy?Y oێa]v+|Ge[xfANXq_p߽}"-{ɻi ];?W'K+ w9\KLeuX L+9i{,:2 HzhO0J+-f1U{0ցc3qKZ%UQˎ6ɝ$e^*i\X%%k3n7+;0!!im 6miJE56smu%yf XɦfZSj>*e]6i-}cxfFD4+({iԙ2CΣFiJa  d7N44tnyU(OJdW-yA9T.z]:j&|슎g}4X֦Y AYrԋd=ISn= !hAS&l4m*e l˛ռZq&-#ѽ)m;;W|v|Kn㇍3SDjwW 9r UXf.qK|\7iK>_}LhM]x*ab^[z!9?nw7tj\Xp1:7>p7261c1c39$I$d2 q%BA$I  $$HH$IR̖R,)uխkZcfK)JR $$J@$$I&xZ8DDDDDDEI$I$I$9ֵgrI$I$I o nkP+lI$I$YZ]uխkZ}I$I$W;A86$I$I+Ks0 0pI$I$L2 0 0i$I$I&ͳ;?Agm&~jl?]^;AֿMfҖǛs5x9{4wR^yʋ?U.HKC̀RQqM x}`?88 C|N)8}wPTmR=.=G/<E>71;SAZ0W:xcwS4 }xbY=Ӵnep \z>P"XBl{$Hû9M?9qm;Xelm3~Oƽo]x#Y~KaևG$32XܷhC__UopƘu钸yn52m߽[K<9źo>!tm}9/uI雔$I_ yOH]kg5j<1>$ot/>!/Ym-7Y'^0磍s>?)~6Xo 0/x$}y{c~|jMy4筲^1"i)ٟޮM|-v^R:Z/I~u~exy :ιo$~3bGϲ>$u_w3N[3y9;oCd_uq<;}#ns\^}r?IW|b7~3.K]N{y[ey.Lʺ)2^#}ۙO?`f Q 2"}_)yOsUݛ+fP+˚lzxhk\&W5svew0={ST [Ĝs_ ;#7 @/߀@@0JI=2"xR A2444LLLMIPוvz3 P,c}%:5^ؿB hbҍ˿q㑒&v D*}?=zWjli :A<~)ź~NPDTdQ34{uN,c`9!D @"*EGlj F:.bBZeeD:݊_^_id$2Jj"Q "U  JI "6TɫlRYqS}SJKoB'>Juԋ΍cBh‚܄"A2E1nQ$4`!b ,jHk/߀% ]BCcar/data/Sahlins.rda0000644000175100001440000000055113017662412014042 0ustar hornikuserse9OAB-[k lfM1њ55Xx^;/;Ճ `0BeAL7i7E&;.}at( PꏦN AƑH5{~_5&ߢ9yqiD&ǚϏRm웹PWqTFHԁL̫F2o-8l>?c~b[eծAl+9-/oܐUqV:AWs@,_&uC^]yB#>>b|]'4X־x>xkK |po}Ts|TwwѷR /uۥu<47rE3;̄2]pC.sFh&t֭߁G+2aɜG eo- @@'.z8CRR,FiFu3aˈ9,氘b9,氘ƣ^VCUcar/data/Anscombe.rda0000644000175100001440000000151213017662407014172 0ustar hornikusers]YlLQϽ1 Z> HxSiKxUKRSڹ3-"⁈zBb Bb "Bl ĚH$I;gιeQck<51L9$Ժrq1ް`A1\i&?1܀pE|?= ?)<쀫 ~ɷ *l/pBexwWBa~O'9I i^g{>= YcԎMA? y)`1#,GV!!ɑCd(lcE#oⓟ|u>g {J/ F¿n|ŸȬؓ|<Ύv6c;6_noX?I?/oYoee%.[ }t|ّGIn~ҧkt̷q}/W$} >zd?ϤkmVv^|?^ԓk/sDtXoģM yo*5l]=sy[wֹN[qC//7o 2A 7-{#EEؼr8qؼq:y?Z܎Ra'#KTfEkZ&Hic:[}6ìdtI*}#m6R, nPKڼz]- ڊP+|f|Iժ4kP:Ws%BNv_utZJuo0Ojjo\NK;ӹPʟF6jdvڠ5J; Bmn_}4i:W 6k=car/data/Davis.rda0000644000175100001440000000247413017662410013513 0ustar hornikusersBZh91AY&SY y2H@@>E[2 'iЦm&oTT=4Ęhԧ)4@z% 3UQ&1d &1&#3R#=$g42 A2h14 붞K bh@B`  10b#j!b H@1CĄ\M M%ұD ťb''3^~ sPISlN$o({sE٧xq1 wYVy5{"Yr @@d`="*<JPp[8SS0 jɤ{~B6% gQ,s+KB%<<7' ,EքD5 ^-($j|3o90: N3KT1I 볡P;ld總nW@9Wju VmBy r-[7~CKwukzx/kIIqҺ x!NS <J GJ DF$m0$"9D-MNѕBjq嚄LQXaBFY!x̑DS!!vJLB"Rȫf!>ac@9`.>#VZisVgYbMQHj=-8v]'L4Yjf'`tݱ=׆t"ʼnu [WU•)XViDCiNno}Ѐ! p{ф4o!Ol EXV sCfPPoߩ< ÑjݯwOiѽ[LE:UD >w?fklcar/data/Quartet.rda0000644000175100001440000000063613017662411014071 0ustar hornikusers}R9OAE!ʵ1U,l(VQkV[c556Xx![8ɛޛyBTi*Q5 =*!~VoV!D t< ܏<1ix#tY $^ҮdSu2ga_giryƀ@!DlNnjr0Eю{`(>ާr7H޲w#1GtR &ŒvH~DsM}DЕ OkQz0xFmY\#9 ĄWoུ.m E@;ࠢDݒS+yOέEXtnsVҊ4H}E+R]ْ`[ v%ؓV;j/car/data/KosteckiDillon.rda0000644000175100001440000001652413017662411015365 0ustar hornikusers7zXZi"6!X⋊])TW"nRʟt<3n2uhTkxO7I8sTuq /'_)~F1@-dE<5Cf):U2j  S< l^̞]l7:>MU>7o}:,oҁ<^8֫UIU-,qBwQڛڂ3^[fDAkw@X 5+ZXhbjEݭU)ܟ4HcKݿ7i`6Fqo%- biqn{NJgޏ;nMPԫh)L2*\!ZT K};5_Z c]Ä_^E8XΗ{"_TzU7CL0=b**:1\HQGrT \dv Ac#/[zbZ$Nyݝx̩0|AchN:{b#" aFN|jWb 1*pE[.aؼ)E$=5pޣ kZvylF8fT[G^O/ ئn;-OKðnxtQw$B[NJӹGVtOW&Ԍ4!;FvMF'UcpFٓINMp!QeN|n7|ӗI <*b!f{-}G}>"5$RfyƳ5>Tf(lΧ0c9aB`3t/)$2h֌GEJݕR;K}oYwcyz(uj:m BPHM#{o~}m}eݥd\0>#O([>7'KDI&}D,k͆`yw/@@"2r5S7N)GB5w,19l>ࠏ_z8N >i}Ԇ@HWDf5Ĉa3YJe{wQ!'!@k% )4Sr?9@W];5't|קbИFUWTvX4r'Qq| l"K3g!`u|+PJeP4ޥ'i >D9(-I/`Ilq%1?K]\,y-^(;gMGr} ]>~CǬ55~frȕ];#g0!֠ 8y?Jೡ^O2'\Y{M|wf%itT6NU?%!A'FM-lZs^te!kULQwc0(9@ XS4U32u2\6#$w4KxjY6bqN/ ԃ`KE[Ba*$uHпȥ!!tSBjp7ed2/bgi8/3`>|mi{$>VV٧fRŭsbp1xok 499ŅaI j-MBЇhbկ0r}yLu8,\UEGmf}6c?zaG/ /&oqԐMG[Ҟә!/?$pk׽U1w!e'u@oXۏS6F]5_z<ҼD}>rқ𯜲"R 9WK.XQ)4M_#?bG2f=[ M[Y`CI; *>bph1:>,$A=D NVaלLVgڇu ¥ >fY:H3e75Es{VR]beڗ YH@-&Hcp %ڻ~ #Ug$#@ZXny?Z|EPّx:w$ޜFe/6ǽaY*U[- xϯF[nÎyۚk )iL/beY P i,~]lY]jW4GԘc'*ql>D0')\NMĠG(}'SCD>#ٵ3d3 XPXQF;a2!R` LhaH:%]=3&fhhQzBwI 8W7v;#2?Tu/hR1xPj [&8LxvUQR\~?z;i$(_; g*w]c4xٺ}|^¨P{wJДF돛Қi=u_n_E\emmj0_r_S+'uGTeNFNZa;(b %v(uam34r=+ ?C-nW@5F~ϙ(oj&;IґT-Вж=mȫXy\I5p1].#YN`, @Z.\FS 9sБeI&2K+f|PrI6IHMDx`Xi)g!t[ȡtC)mAZ;]GxϱE:‹NW^"gO bzշGQ̑H7}i'fZ 6;Qۓ=@ru#ּ)(=̗O@Uת;Dqi( 6ZV\mO3 @bkW.&QH^ V_Wr+]8~j%)yB/ MZJ&S0yYjق۪U,Gz` {?y0֢݀.lTRWT pzo?yL`" K$$Jj72+=Ժ4PDPZAega>,.`V&{aHpErxT ctu`-Ur?0wfK\'ɟGzpiR|1V 88eLMr|(0Z1<':ἅ 0bmٌa`tCG>R5UӪIp`@B F&,>x$ʚsv( VJ{.4')JWe#ąEVXp} '('Gx=ighjt*{^~˻rԡ,ȜpWM:+pNQ-՞ S^&34,Im^4l MGaD%ZM2qZko)'e['oW"EJЂF8pDE;&V0aSG4 B7&TsS4Ԩ | (Ĺx/zbCsE=:f|T3L#p@ {O]lb$O+!_+^huj%O~6P5%۵-%BC- ߐwndiw' T>  &Gj3JС1|B(d sB8WSٌ}|EQZ{;s 䆱z&l&.J\~{с̷ِ`6dY.TADv;suB;Qw$-/#(R&D/?W`3my EWWzV/j}+nFc"L ș'1!ؖ>||p1?̀}6*Pᣪ5*ff:XOJ 3$Cc_Q5Y+'` BSG|]~#uWм^@f 4j䯰@-Ƣ氨*N9tdmoM$a$Ah7w7P/[ss,}2b_ >Fnj f`y@1r8Ch qt=FIe15aFVz:T3iE}&77b>AڻWA_IB%O84b9 d4 SNC՘ΘZaTkd+sd݂xoNk81 zO;=)=5F/3|ɃxV G6׾K1MfDc숰Vv IV =DT)ZJh[M@> &H3o D c4Tx7|KBmyaMF?ݨӽAH0o|]6MXPsE,^6GL[+,/ѯ~ Z:r(5<Wq/Ki'eoE j/'9QRkN3-04_>=ʱ+VA91WT$)Vu;34k-pMFN %BxkVbS `%al\H,_ y=8\ X|#>q蜍jʭ \$3cyX [8\i|]>^;Tb6Yr{}@_$S?t?!K2h-Ar.B(i9|W,I>UuhoH+@Ѕ_8fG8$巠5UVU|P"bTyL>g&Zf*q% T#WL6Z[TMjd6sG-I֔[_52-G| Yġv-%S|vRwf'@2MD:3;M㲟 cxBZ1x^rg]<֡+뀣ޘ4:ϵU>:<]%o_*\x}N#D7Բo?t1blDo!yzơ3~X"BvGc/\L~3Y sC'E31,Fhf顡.k0SNj&ẞ`J9^d׎mCasBك0􏏋FV-ZRNC*XCN']bw L"b#B(au]Z+Pv"a,dG}3uRbٓ: s93>0 YZcar/data/Duncan.rda0000644000175100001440000000137713017662410013656 0ustar hornikusersOAƏW_%F 17bAB^Ty9:R>ݝ}fvAWVJZ?S^1wZbqyߩ^SBy"JW[sYGB%R)H8c1;Y^7=26:x'7xoi`W02+g, %_X!}]@s9י~ 6Up[:וY\WYo{J>]Y{: 3?o]\s&mmαº[w穞k1u~}'HfOJw)-L| rh64c+8o7Z[=rYrdߚQP>}# !!P;.d +'EfAW їJf4V2N&Iߓڕ-R+-uk{:zHRiA#"$Ah%Fc]Ť?t7$4Z]c)2 A֪6t2 )o|{_rdcxm.lv\[3MFyd#Q7Z8$H9{ŋ@( pY)"g/:)ZP &mc20hG;m*R ~IJMh9/*c*!ToNcar/data/Vocab.rda0000644000175100001440000010736013017662414013503 0ustar hornikusers7zXZi"6!XЎ])TW"nRʟt<3n2u+: 3.m=OQog[LDK(v@jGț6h=Mܻ.є;7C&;Kvifz sv ;`HƇ@zŸtRfhE%֡SBO*$8[72rJmqGg|Jl&+Č8d/hX)I;v R2;)sk4U/ 47pE 3cx'^ i q#yvլSJ=AQ͓!&%T?&DO/9:V_dTZ˟ve fIH3< 0s&M7RHB3k"(=ǂ: "wդ.<ORS[qAh(*fOzH[TBӦ'%Oh4φ+:JVJ7=ŷnr}/~k}8H8TC?Bˮ?o,d"%nhZAZ;s{ېhݥ1B v  N@ F ؂ WS?|alS5<7ЫK?+qV2daȳoAy_vF> 1?4IBHCTKlKB٤^:ڪP&DzcA-D 5wEF>??D.fJZt<7t/' S9r7k y4崋N{0QLf*G~u) BKϫwpB3p3 !vq2JvcTgX\.f[+~ YվR&g&,NY8hܠSdhݪN_MsAfxy0';{aҥ &28tU1?SymKtD-%ԑA/Ka,g"蜀{9ٰqu<KxD3{lݨ()lo఍$S$D[q_z WQpWAEEZm$طYACe8VIM*0ԭz1Zm4u}7Sj΢׿S-bXM[ 9#UXN fu6 :h 0KTl c4BSX7z}ZT q)~B"P8LTuy\d$dԃSgoꧭ|'?L4# S6gY8rYv/vFq`tdry"Bɶ4u7R>+Ź b DTQhbx&+,edrGgxVGӹ޴kM@)-| F:c ^ ѦhHZaS$/ l]bGYC)MV"_zuN6F6IU:\mSF=Iވ# =u0Dq;r*)@9ڰenF d0B)[,?n2xMwibv6)86me/F ljCv_Cdܺ|ex:uEVnn3v^8+ \逕6VʋzXD0jK-lT^۸:2i^zzFIJ=o&7J0od[!ooY0fԬ/3=\sc072[j4~X=]*T?PS.hurN_|+H'e^aNnW*]@4,wI~4𸇭QMA&ij5YΞRnD>W20KoF7T8g 6D:N4'+uW.'rBb^BT 8ۗf uɯjF 4j0^o@ƬW@A(U~J ]:,e0.9BKJ^\T:f~)bk|̺]=#эx;ͨߚ<6S03bdO0UmӖ,G*Qr,<"k?UNFT!F&kk_&44q"۷Ի?> jضnjpQrKvC }L|HkG7H':)^ X,NhC<7f?tjoPENDyUtg\ӧ}7L}p'JREn}$%^'VN9clJ_Kaޞ_Z3=ʄEGK2i} xo5OxFu☀(Ijl06N"N灵ovؕN-[?h/UˀrX}]vޯq6;6w|d'E5cӋ)[M80 <͆))Sѣ{Ե|44kj_(m#q|HPdOeXS$F̆r#1V Q;aFcH[ O4g“~a*2X@oЦ뢓X:Q"2vu&ft.=\㵁_}ЄzP& G9\0p'@@\TB5}Njрb)iltAzs < –J H$ ߽y Oj4ݷf a@ؒ)=$P X3eBɴm;6c"P/Zʻfo.+&ߤ)ś`g$°yzFp +oh"q L%P-d)_HT8@9`;<>g:c+KL4͐f=2# :BmlB6N0+WXDQftƐ=QBxҞ~އaо8o<)ո$f dz]_4$^ITM3hyASr&!:f`CG.lot mے{%>O0!ƈn -&5xVK3-cDtʙi0 AY(ʰ\0 7 `PXozp#,]-DGQ}c6mpX޿@IDža=?QiF6" LH CòN-6A}N;e?osiIwˁl-1w]T2 ݕV)NC:WAEb.fOG'GX΄Ao扣C-S;Y_rc2+&'VRs9em%tKԄ!^[mdUZJ r9>X$F6Jڨ[k yV<1]-O7=P?oGyaZIvpʓxW*~ &?94k|r'SE7͛}m:QLę۫S|ap{x.1B ()1߈9mT2/2W(G5SNh7a(_z[>:zg+kS $r #4*U|kK 6S (œ%yԍ͖e$($Qb(9KpkTZRdTuZ6|j' lo\8|bEu vvqUcia`11~B2Lɣ0^OSw=;LYr9'? 2tfeTdg ;{y#1VÞ/7RnOfYs<[E?gdpk&ڡR^N±BXa?_>:8&>;3֙L^0^-e:A1N]Y!)]ȡ, C -ỠFwoyŖٗ~f\B7Q LبB8:̎*rŸŽ {k:pDb5MYG.̆yyȅJ FA R0QM=RG%<]aQ'jUY*(ak7EC ,iq-.eQXuj{v̜"q9 ~zG-.ey]EDo&_-NcqpI\"J֋+~6$mh Np SANPKu#}3RwOhn#4oW䣠Q 2%R[VRiG=^x!S=c@pL ~b w=li^ڰ ~WhEĐuJpX$Hp?f귫5Uu*ogei[G{Փ2K>͈bnn8AԞe_2Ĝ93MaT皂-SPM9#xl[j /McS~yln> d3XЋ8jU #l6n#t}ns8?)7ם"ZzԪ_\ICʍ}˜x YWOCD4qx@ŌIyjUPdBUln4]'3^B{g{=w[VTԅ# 6JhawdX`f !jp#8EjnkC5e A"rЩhTh6fw՗4WseoF2xObؠ3?L:"%tIaD2^ޝ`RФ&?0A9*vm7q (p$S{3r~xj9& bˠ]H?iGs4nvSW쨀77 Xwfpa&WQ}'EB''롓||=:5 SؐxcH>Xvza^0JKAZIO^Pkuc ܇XɲŠ pB p=~nB- I_qgjEqʺYhJ{@XKk#MKww`/l[zۘjs b޺ Fd J `vasx %=56Y6pLR'ثI4 십Bgx%Q^' u/JC$] b`BDV_ 5۰V ϓAEPKa>[m؁}h! 旽0GS$x%<!$T< 'Y+#1ҏ gʄ(?LGr68sgS[Y\|r4Un}S9;kM2\RDT%ٌzWj8>49Dׅഋڲw ꌟiw- 6OiF49.|JKv&4*Ʀ"+33SВQ &bO f-#@l&[g4jz xhgD0Y5P]F)=u`IfpVW t62Ayi :l"Ld_d#>C}íf6>'#.2Q T;2oC;~?D Vf/I\OȳGh&2֛LG9db`sONb(󢝁V '.w'q%\o4|c7!{wN3ySj\'T&94 %իsj+W<#KQ&aɇ~ŤyGi UP xH \fAis 7V?mHőGeKU}-(M+:xF&Y2ij̆^=LVrZS&b ubX.Z>r'hߜNg⬲b&nRC ,J E24iUL91,RWzærܐAL{/~ψ,̑)T%-Jli(+:k3ɬBTEz 1*)mMC΅} :JȔ5Ȑ",'UYb!geC* W狗&J pl X,ϱ>^W0bBoL \-xEZ = )pvXт-S !7۔s,NQ? ϣ%ukSA!Qp@o6 :4k˖OQA@c#!IM~& heUb@[Ba&4q\ŕ -) Ή0E4 R {6D]= KRlH1q>aHtjc;"%W%(w5y .s:A%$vwYР2Q1R˼H.#+oBNn msFjr3\߀<4Wsйˣ` 3wP%r3L31̨TOĎQ} \M4J +$kY},qgU)V4{RV>d {g74 NH3mӰHnN`'԰rs=L /.Obno׎+K@uʏf кys8mQ[9w./q|>DWqx >yO)Cw[n@1z{ǘ<u22)/4@"%EڢqB(=rm*ϖWez_U=X:pax[r\xsoG;T6x+ a97(8J j| wYl9!5O'܌b5q$7R .vYyHa`ω' YVdOuQm3?5ߵgd 4u۾L&qg< `pg~c:劈 q~hg6Qq}k6V ~!}Uה !?\\kwVcpA2"+/ AP($CE6A_@o &.}x.";TuI~ _YZn$%:fòa錟_kvIUMEVw;S({@񽘳EIE޲h3XX,? ,w݇-t\@NlgA@,j5>l)&aSbTi"325F-Q1 R kRQa?ĵY'LaN۫=añG(+6)jM>,so^殶A/QD`̾GiP_QR谇/o!|sO~  '(>rʛ s0w[[5w9"pZ%۲c#-!dmVoC GQصs Si; pYVZxzW{Ey+-H DBlL0DߔX_׹%T\hH;i^2T!z"F汜Ӳ8]_1y}NH D["rb3y848w*ͤk$c4/#;!~jsoMX @ Ob#܄h> Ed6`o WFDhU)̟_g[:,-֊+=,P{&.Ό@PF5ؕ{E]:wUBQg|=og^tVu_P 9ApnuVP9uCGubV4k^WKm:x[ K7viOPT;37&QlD@[7  ]A槐붐&SjĈ5q#_^ojPe-@s|>H-7+}p]wbDȭf[{Y&?S`F}0~x7NtooZsn%[1א]%C~Zqw~H.*[{|zg>+=}[],1H׌ : ^;^`Er,7Ƞ@CaAGģH(['Mg2Qw>IT7*+u,hBvGm⸿&kb{pkrnz<ەb"~ (/~qȧwa&IeWE*v3*Pnj}L[?3*.pUA 4jG 疬FA1vzL9Z(na1mיȔ}8qUB-#%hUP Ɓ,il@,%#Mvyژ0U(^bWK3jfttn'(A6mfnb^فߺ[ZG.mC] *䞟]z]!!]k R9{j0*y(9# V }NHr)^pzx'᪂1y03 >fmLD2.L1V!M\(wBt~Ȼ1cT[s2CHFe5&ZB`i}*_b hLx&eꃮ \t(JsKkޠ5(hKBMU6}HQ '5$Pk#?~y?E_\H2!TizJcSgܗWn ѯ\d P1zY]hx̲zޡSD8_;E?%;>Sfv]ʸ0\¿Wݼmix|GYX/`4'IjAȧAv,1 ڄѪ./3 ;8me7(cA3&\A{3f 6.&>7vږHS3 Bq)ZgZZJ&RL]M,M0Rt2Nk}NAcvIs:+ڗqC_w{T(yXgzf66EGGX j:I K˽M |UtQ^l1GaH+VX#)Gae YxE/Pa6],1du~b#:ҵ_I5Dwҧ Uscc%03.; ӤϿ8vBgDVt|Md)@c~ڻ/ߓDԵp&+i?s`GO O`P/7RO"ɵIRӶmR_X,]̖(Nkd3|Q/k$px)Me3.ĤL 9zUZ1i,])BqA<0,5dQĔԪ]]30C8]x la㈘w `1"B-/}Ulw! +ټy3Q;zG8[ ?R߀ue\-ѹI]`~gd/09CYt„MX.r s_H?IŻn+^7RJHn&E̓yK3~`J:ޅHPmJx9a3dcc>I9(b]>kQW8mpK|Zkkml?ڮ{ܠyqUq@d|~3^VaʱۑNC3QK=4Fwmʄ%$Yˮ|Z`إƓ5_UZft 9Ӟ?&4 &' =(~:>\^AksLLadCmjl'!6M~ӥ'Y><=R,S:8 4U2KϞihZ2q*}`+AXF&%DD,px>A=vFbet6旹)^EM)75+6*DR#mJmgwy~ȕRIO3q*p )Zpη^ns ~NSa~ jZѱ vD!M?/?j 'SJ%0YHѢ3AdOwTm<˾`+T#}cw̉iݙQ&FF˳nLdr=-\&`]"b 7/)v´D#QySG-,˜ ~;O:QPEMWȱP>?r9-4RM,M!ޜn`Q9jKtJ_W d%Aq)1 p Lm:Rcv{A #@1Fj7y 4^ۅ5Z(B)ql[4#jU7jJ}s~1b|Oy!/$n,N<(DXQ3O,}r]vE) vIQl^I|< 2;/yH\h)E$ӆ2&1#wƆ~%#yfNnՓ Ez:MZVuZHfT\7<Ғ- ԟE8ޢ{.\<^쵺"dzQ(R:0LcS ~7v<Fc8^8)Hitk[Oޓoaxj#т'- {hYq"?hF4,n2h̊DQRZXurv%}I'HJYAP}ϣcL0DܜŌ$}%2 zÝx=` kł{(P&e~k/oVPn٥Gl ?Qzrbc`30^ UB#ui`&EI ǃIdUGt.}mh= p:0[a"y>R6H;Iz@EԊd x~m$ح*h k#lL0N4T2,|Ɏ$NX\FbҦ1Lwt1]A& ְ0e#?ekQR0.&9p~V,_g^'vQ 1io!fL9)j\w*WMDAamϔ ='tCT\h-:lUb88=nwa WU啩h}xde ͔@sM{6CXo79JES(a|'3L;P!:py\ `:;1\ʿ -]vxh!_)Pa~ZPmdkE˺jkd2E5FCI nc=OMCOi˺͠n!]A$|RX9T3}i1b2=Ul=L sCҢ6 5Om Sufi m9 /O;יeCI_)L L:ٙ1FAo= ]h qhJ<ltmN>s8t6ݰ&´jqD+~xXBj NLZhhaa6<"hnkT/83ku+8)1Ɇdj&x!d-Heu%59EM3m3W|h MB{0ylBfzUs -t>x0LeuɄh\9|:CBeVKd][b<(MpU2z`zZR4+"wPG z]4ʻF&efzFmN=ˆ@Z4/s+^jDO|u!SPpM},/e5ץeS B탇zXx}Xngyt +CJJ'4FDG|~&h $4|{9Ә.oM-M_:Ub+dYu ,3 hvAFTd 8u=}2~#Niqa{8z-$(%Y&0@K)*~^+ Ԁ#9>Lޱ[Fx˳EJrQV6mc]$J& ]QgUЧ<h&}HQnI>T(2{MWY:E=佖L>Dk!;4Q"G)yn銺=&cN]nN\fpM"Kr};C]cv5Kt[,+B-nLOh2L7/p\sY }Nuȃ$2ܹP$h 姘70"#qȒv r^v4 W CR1$7E.%t"BrfqG  7E:i(h/݄><'sΧ^ȀD3!XRDk3_jvHJ wCFnQUϫǏ)ğ;˯67ԞQhj[E8T9j {Z- h5z{zȹ3k]*[exsp'!+&!uI*"-Ć愦ً VU.eAﮣ%7b}*B ''DlEW(RxB\vOmE<1Hw3oy. ~>|.H=* l'H 94^#~=^_/PFTWU?c 7 vĜ ԥv*؝׋H& /s3F.0*ulLr H9 5D]\GF4K$ٷAis׬20:b橻Tʿcz.7VNJxg $,p pЍy2 4ք[80- ⻝Bք5KaΌ,vԞNUAϒxad9F $0??e1A\ֽ#X5Q0Jk.`(c!L1@\5r&ݎtY6>w%JSwqWxF:DW&PC="k]2V51x ʜiTNpr홾㥛39~[:Q YJ' 6Xy +4Hs*ݽ(uAs*#+?{mG_uzEzNsIGr8c:ۖWA{:~r(QGGi#>bǻ3HdE/ufLuņXiq`cд_Hl TX6Z`06O̬/.I>7RQy+fAYUzr6z# 38Pz rq]B^+Bt^X\_&r m% %:D3ß(|Hsk#'qP'BF_5dXE ^v"-pc"6'"ǃwOǭ eWkI&P~$xM7IFư dsЕjB +#x!{ZR=r;sGsGRhK{UM, _">)Y>9l_i'8ԈnI{4jXEJj7RH9E/ щU32}NYXùN$ooDe ̭ $70붠ͩO,DP' Χ^sכ2I@BJՖL y) Bz0rH'w*0 Qz& ~ANo3˔"reIqHRgphۥޒXF9T` n2mJ SդtFfy~9=tʂ/ԕD|q^WRj#sHGvrd+ D0!5bbxPyʼn [J7lr>Ӣp.V#`@Ƽ*&יF&MGTL;E6Kഘ,%*2qОN1)CSuQK/qӑ=cOä%y=>=w?p$8+)7eD+^yP[\߆z R>;s|GBMWVSqHcL Åe9RsGGI=h_ c_fpڼĘ/Ji!ŧ?Py~q((&^DUnם|L~odQO85iG*P$?H"P_`e$P$)]K!nn l;=zZ=E@JvbGBb>aӹPO]Q( %W_8>4dV>#"#kũ*2XPBA@њ[Vck<{LcdA)YJ4JGSt*hs+A?XɫOP|Aa}O!9榺XuOgdw xyV֧~qwy.rxV߶|x_ZCRmd 39Jn#R 2+v/.Qb!@3e ^aTEW ?!p!z(^q:|Q}|/ Q\-.t}kf(~(fQs5w)Z).A==>"U)pz9IІ[ӟ4OvrJHVzH "Q37 GRcX@a/*Cdq7VKkEknKq9ft. ^)H˩syU) W\L1*Bh;\ Ku6J:^Slx*-: aqw7-Mo'AGHbWk"!=f̴zKj.taHeuy5=#tk⎂o`OٽdȎdp V&9І0p$Ň"1h8СIVyԼ~:)]-6g`,֍"b}8mUƅTo~ cTQVs/j1d;sѪ2bSݼ 53|V NJ?Y>mDNF|s<=Y9zf'R) @݂2*Hf_4Uɣ [9Ef6Yq Y9mw"_InC g29 vbEiN>9{R{>yeOk{`v?$-{l 4@-Qqzr "УupcH Fvy"6YP!Z5U*Zޱ_V,,"AH{M=w-Dzr7xW\e+ݍ38RhZ_*rU!8N BB(h”5NLdOx:ekVJۂh,Ɇw#u@lj7vfeFE*l F69EdۆaiP]  _#`,vC:*Q㠛&;q$M5_w퓦N<lj`d=\+Ab1<ĕx=OHkd4B +)7oVk h‚Wd ~P8\Se@gݜ+]&hpc!r/VQ\c^Zxկd9~)ڰ0WW25`-LR [vt"`+ LaC^`\nO)〭LHBǣ5XY-{4Jj1}#PǺm #sxt(rZ^}.&)nȂŴJ;hyҪ7v ɑ}54s2ق$Oy^iTUW|nn!^w~bniӯ,FܳfFpԖ{6Hqqҙj,Lx9Co?]{Y0Ĩo\q LJbOП>(3#u6C8fkʶhn ۞Ax+bq-iS+PeGjB^(n_UuTٹ7#'8$Tqch+2'RqZJB\?f5'ܪ^ȑ}ccDYfG]yF L_zVECJ5=viG'P fɾ{a.<XiDr %WReL&w[-^gG>dn rEWO%R,56 %)]88 WA` !11H&mR᫸!B8l~N+*i]PKb竆VOO *f{[ՍA PJn4E "M xv,@ 8ke Ȝ`BnE7WMYtj%>F)7ձGJ4H  .jX6/@.sנK/me.ht[D:UE9\"tgU0(yoӽ 'Dj `^Ѵ$P&Iy7\ߑ5唩qVxI^Z`48М^}J}'~-YHbnwܐ%ٮo)Q5P'$6c݈a5:E`!],Q\Ԅxpcy*:?hMHhf}0q#۸&Z\;{hϰq7$>UXhak++IKDUB Σ 2o zVT}~O jqݽtl^2s}vy*OA[䀑M"rC]JP?| ۮe\)֦g+ Cs ԿE;tL k":cլ߻#no!OķkL]}1rg/dh TpQgyWhoTh ؏1-)N5ZgJ7/uf$V7l>8֚HyC %$7s!mT!.S8$mꕽpαͿ gr$Ib"׏|z78AՃJp(]}袕kR@4Ȳev}凖Lr A:ڬYvBx]fvh`>pV DHMy8no$l폏 0}eBNHBGaegtzPo M)0k~iPŏ⧍Di/6oςlvFW6vY V-Omv(Mga9~i۳1,|LTmsSa5#}~?R! @P>4a6$+$sDd~^H/S)=0;s;g ,^`f^;Vm_ظ Z[Df841q`-jئPOYAe\P-k"alKٲEA[t]39vN{m"RrT84=EveVWD-v5'gI:M+NBS\펐jl#^)"`ͩ@e30}Ry3UxZt7F=#V4Jx(: Nıfi|!JL +1c3O-mqve=vfH3gʪڍ{478tVCo@S> [/tTDYø>?eκW ?Ú\O;Ftkr*w0ɘr7uya j]&R<|m41c , FRJBbfxㅭTn 9?g{g! pj<Ϝ| SdJ~cLjl+(ݖLfMxUm0Q]gET;5CgL ;$.s+}ղvBIf Bh]_m UL'<$;F0Ҡˎ2>,qvG\n{^(sq*_/vdSWj|=L'adǁ?h0}k L#ػ%fܽ S 4 3X Ka7C5pj.蝸i^I Z}s~f.9?tɋnA2´0  .O|߽g.( Wje01_$,5 촓QhٻY-"* .(H*4%Of2wjPc!Q\e 4| 4kB uwۑyDEF6_Z{w,E7|~MɁ+cs6惕:E^ぢ,_$;m؃]8RwN2!xnu s~<uݫrzYnfCJ(YYeLNoLIBY0UK# HJ=mLli[kIFP ʺ' ;{ov-w mA$ev"J>0xL @nӈyixG;ka}Q.:)بXM-G_:lXLy䬤dr Vtn!^D[e/H!O#xSb'27餜UFsgCyݩhK%Pt-+i7\{°m<8k2#"qz$~չ=J*oS5'_n@_r& Lh^BO}72Ah{K6]2h7V=5\'y h6R"faQ Avݪ>-y]LGY PwВ5/1@~E'g,*RF N$8Hܞl~ᾕVr4gUl_lzw5E-,' s o#V v<68bvT\>1(ox̸9}،&a682[oP_.Z ,t!ߪ>ldX'D.sKs`1'A6σ*5i|Xow.Pʨܥ3!fW\6]*n ;vvP/K*#[)ciWhtzKTlo3/&պM0N6FX^Anx<"v0G|?*i_! (@# 2K6In1*nĶsP. Dwy_eеHON؞=DecxZ/Eًp)uj|mgu4'Q5a-CnTDXW NV CT"[cF?Kv*ڋ?r+;rZtue7 ]"8ba Ljx]IW ¥v>#RDY9TjoybryK~YsQ7aj<>OgiM$س/u ?j !CҋD'*w9,LSd+9v1|)Ŷ1rn iK"Ş` M)%14 xF&i'غ+#|JSI E_Qͥ{S;6{Php}9}kvco%$C oǏ緝Dg+ltR"C&> spՙ|#,A}b!:Cj*p1Gj=ZȑF!c7fqkuJFX{I#jMVXCKOovmx1% h&?P:ۥXAQ?L16[ \bJځxUY_['k݀=:WTXR|T.\gt A#R 6l*  &ngRS( d.Ӵ@ÄQS0iS~r\wdZX!4|o8Y^Aw=u ZBIЩt%spo])0$ 2I6[bm0:nl_92 N9uayʂas(SgBSnâpT+9߲ϥU}=JKOH|1.k2_64K/9TcbC.9񳴀yS rl2+O-YlЫTШmb Xh\vAWP\PѠF6g7׷FޫUq&djv!Rܠ<Q@a!`[ b*uVNŚﺩ2]r~t/"P R ^~zN $GȊXۍH9`kKP``ϖw;=a$L?ôȨ%lF_׹YI[1BFuo[bs7T^ /mK0TGО fZpfC-t<$tUaӹӑdFb AI`jH=X^gY1 k*<65/^ôQ=o"0jZxXE/ ?2E}U)Vkz1׼{2%_ԄB10NTSdM +}ڄFh]za7}^):JKaviP9|t՝hPPS:3Z:{Ĩũ]c>GL(J؜̴}RB( Ʃzw]arх/iŌBlI*\:KdNVAT_$,6ǣmȜϯL=E_"G[:]k \X`tS]>7`;;'bwkskFiRQo/~r ?TBFMZp`޳CtqPoG^6)ٛBM\Ýj?cPeyɗ `;z;N-{֩RJh h1Cҥ pKɞdrS}돌B*q}&_pk`85\* *5-(i t'N4AX3dhm'Cyr'\9 s0EfbWjdR;bz`;+Ԧ_{a\E0L] }j3:ߓyQV(i2r֬N(<2Aj )O͡ǥQ<9 >6bz F`I烳^F{9 ڒϫU/+kL2 4*T Ƌ j-e) 'TdIу⺝IH md:-YXu<3d^XԜ 6̉n4WK+AJ[JW(,;y[@M E(k0J94Hy( "j$FRqxBۿL AQ)!sFN,9YTt` xblU5R URHǹb~chE~AZ!ha XJ5T&^N,&u~ 'P!] vL7o'S8yp'Vn1XgF<ނP-fԽ3;՟yIjߜ̈;$ޗ 9?P↤ wVIwp)' A?zхcR0m񻾶ӊv$J2H65Ǧ='h t/Zć :7qZِj^|5~ nC@iY2%bw (.VֈW>mO$Rؚכk40ַĭ5_wxko ~w9b6j&S!Q5g uw@-+?VK!^3"qkҡݛ$ZhaR -;V_c^:I6soBɵLv\LQ۬I?yac'p`j)7%opCXiߟ0mr'?'vo4ĵRĖG9N1~ Uuf⑙{WSbUu<Ֆ<(.018[ij~ꈾ˺aK`7DZUV_$y. Ɵ^ A_<qYjHUq)\M&\ SдxadolrV7haGQ<;,? ΚLi}47Pz`c5m Z{Po߬ vSth[hi8G>q{0qlxt1Y8f[#P0gS8eͦ_C]m"p\̇Fz\OAOL$!s[uy^F$0 T {ey8tM](4iV!I_U6)'LwQ'38 Б[- Qr1;hEf#l1._MveU *suWCvQoC)*S &pvꒃ}=7ijJg˒I,7xoi'4}lY߾(S+ώ!2}ߜ~v&q[gQVr g}mCJӁ$PȍK!ph=҉,ľ^< "i/, ,l;ؗQ3xo+3ěeT)<1{-g<.5`n;ۿhpE r+$bֶz7R!xU}˶ᄃwW?y^{dt݂^\vV m`f6+-BՌūwE([֤ "ո!}X7+Cr6ܘ]%frmZ9aT{xI g~θgjW:E!f!uҧn'>WK)oaݚI*Iԯ*yH-ˉy`,{X"]JwO#LP1|a4? )2 *C7l| hAqܓkֳ-euWm)f{ S7zyB&Ͳыmк#M8i{6`pHv!j5U/X7^" Tퟴ 2:naI# B Zy N%H5 :h"\KD:|kB`0J6/WND++dEՠ<߃}c&2 EDI(Й nT>IwػLT#Yҙ ,'RG}WH߭+3hw>WGrk~R,|`&) ^lɅׁI$ҜokV,XT% |vR1?g-[z(iaݗ0'c7[I;Uq)N 6zMt2T3 f-ϫ@ћ3=+UVe k[nѢ[UHBdy;;G96iچeB0CʙA3u,Kl)ɇ؋6>z16!IYVX{x>lT @UʋYN|1wvo B`B6\)cN;b̰"mYc> TqN@|R fXl GbGLu+3pNU0SQtt}9VMS0K Jus)KQnK)iOJiU3b[d!{?ӓGe@ü}gVh0+a{d13v̴tӃO}TK?ce ۿ#VL7#X4E-8G훠(A4R^Jկ-Edzx Ïq\ިz5,$nL4)j64dBM@nB5/SNߓ)k~XLߕqkZҝ+//VvzN.mYڰ&ㄇ*6Rs`ע+&ӭ*`ud\HIE6A-V4yI 5g5_GM')k_9i/VyC$Bw$(?_[eԑMGc B:ܫDԜAe8ڽS MdmVcfʹJ0HG5| b?jU1T?.WJgt@[r~N8ųy6ṆA\W-\ 4f$%R"Ɵ.PȔAҺ.$ɝb AmSǙRg2@ ~+6bFrKy“V=6=sʻMnb3o[IʿwoקR4ܗ_+Or3V}Mg b,cZd8 ^O%9e.[y~K7fbju&jtVZp y<,\>%$\nP zNr'ķF)$ M~{V?YܨRYdp챰V9FMcNѫ9nu'D_=i߲kL.7Ó۲t?]N3?-;c("<>*QfcA^[N*A* 쮿` |VR'a ȩ- "63HdRS0&t'o=&vŒ<3Z`t`k^Dnj{7a҅@'?t &^H-z,S'Qԯzo:i9_i-`hPc)uǜ 7[6/xꜲd,@b`:Ս}^}n-L2H$")K !7"L 3<ކTbX_gPF1bBE9NlVqGz'W^t+T̕єw:GmKf~L[ߙiBSjv!3LJIL+%"QՂU)- = f[WA(Վ~ǽ$Rw[ժWT:o3Xj*zldRsd `s*ʪP\,)厈؍xOC6ZBz"Bs7me &_sbXnFddgk'].G0uSz=Xr0tϙ/IR|~ `PqCBn j` R(rH%hDq"y&-Izez$ewdŏCP1(#Qd}Ȼ_S.\f!\*fw2\)!Kw89BMqc e'naYFu5(Ѫ'meP\Kt Wwv/r'`e@`q|z6Gdl٥x.< Q0ք/2+yR)lҘ<87CQɕ ,/)ٵ.➆9hS/%88X- k (5'盱q0d-PwǮlVQteI'y9:Q̝ѷ:M>0 YZcar/data/Friendly.rda0000644000175100001440000000046613017662410014220 0ustar hornikusersK@7#AA TI^z 1MP:3Ԝrx߼ݝ ټl!J)JāƏzv[)suاez)OwZO[6H4rm^;ݫmmFy[o:CN2ixLΓo~DݢTȻzC5"ox3Go?FTuu5~ZWYuEYZ;gv  @PABD@ @BHP?J~onyweoz7\ x)}?G8swS䳡M46~q|c'<9 dJ+6[1{&-bQQ|=L Q~sio.avxBܝa?$mȱ_G+Þz-Gfx+֐9d]_Nwb"ЇGWE[SD74B1~ $'= [T|>sؿ%O!O-Ơ;ԪA_'?IBoU|P*F%ƶ8?K卫V4J6 1_No"}yCeM~4wFM᏷L~gI,asScA!.# s]wǡ>c@uA5uxK?%*o"vMy49)kN2@VWAk# *wq-:uSA᏿j9wYI/˞"i!:}ݏ=ڷ2xЍ.X+KM=ZӖtd$?ZXߥ ?l K!!Y nyۛICyY#ʢY EWQ\tmo,EFU\^k S2쎄}Jm7&i.'s:qeUN`]{;ɮjNd7aXgJ4T$E W:.S=QgfwgN73ɴPg)[.kUuYΠ9eekek.uP3N0ǪpWfY6!g3Ŋ.Z4_8M9l%cܤ a@evqV4;wYVޔ ~@ yuB q|Fiˌ=5jh)AGKgb/̌_mȵ 7{rʫ9`{=ܨМ:toYgy+=car/data/Blackmore.rda0000644000175100001440000001163413017662407014350 0ustar hornikusersBZh91AY&SY^eO:A|!>S>:cY QEPh 5OQ1zCOQCziƚ<Ѡ4I@4 щM 2dFL14&T)h4 hhyh CM1hhh44 & i4d2D)FMѦi 1d2PM14h hh@EU@ `&`LiȘ#4#OF#0h hFD=10a4LiAMb)ަ'ɡa4M4hz4ɓe2m 88̑~?= -ʔE?DaEaKl,EؠT=%D&Szp߼]~uP $DDk6G }*@r?Ow@:?a\ե{^a-.omNeFB.`S@(2"`* R!x/ 6Zze\µcZpL݂\rUælSd'VKDӄMjC)3N,6 X؂ƕfO,T%M* } 2XΖF[X[- R}ap.,*\.atn `؟h^/!zoi| _3 a(aƸq L`C(U&]3sGB3nqHΦyC>:D4&:waMBjCTXHb لK v;)?Wx;ߧNpRq'5#-9NtC~HЌƇU:']={A#ӸCzx'sT=X(tv((/y.|( YU^#~~~~}$mrI$I mUUUUkZֵUURUUQ,-vDJRtD]4""4vDDWdvD+k,,(DDE.(N"""PweYe]숈]"5(kZptQEdMNȈIlv)@mP$#mm$ m,Xm$LI U4I$$ IUPrIiYf͔LUmq $Im6 $mI0N6mI$UUUUUUUURI$H$Dm6%UBH$I$I$UUUUUVUUUiUdmUT$m`US$m$YlֵkKq%2~GI)DD@@@ BHB B H /F1r,*6>$AB]A륄jAEJ*B NbAdPȁIYd@$HQAP$P` >,b HIAI 4E;O,YmhSY;f>l2nH@"*&!"f1 012 (4RB),yHH2,4D aVoee\w?6~$$[H0  @$1#'gk{w6k(ejmcH"8@DZbć$PX$R$G=g..\z,λMK*{vR[-P{"RĂit"$A`c:*pY\붻^?Ba0L"""""""*""*&L" "*#rLEiS]wwv-UU`(ت`bl` [uyDQDDDDEUUZUUUUUUUUUUUUUUppqĒGЍ r "B *%b#,XbcbYE (N j]u]uT  *JUTE(!XV%%!@lMBI$܄$H7! ]&j(wު<QUUUUUUUUUUUUUUUUV?FjTcc''<<7! $3rsKYڪ Fso7`9rrs<,0rI# rm'<˽j/G{;DQ(֚Zqu뮽xzuҵZָc;u: ͫoc7$H`&!$Fc7$AZ@Z}a踑<qݱ w(yr rdx7 I$܄I# r]@ksFz2xS}qεD+*QUYsUo}޳ۨ奷tI#1 $F`&@U8 8nBI$܄I#1.@kꪒsȈ"UUUU*nqĒG17!.eՁ{]kY1ߨw: rI$`rI$&I$]~Zs<DDD]iUUUUUUUUUUUUUUUUUUU{88㋻! $IHBI$ck@UsLrcI$ I$ChYrnUI;sDDDDTDDDTDUUUUUUVUUUUUUUUUUWLnﱉI$LbBI$T0HI9 $! $H$I&1!%Uu12K(DDDQ(5ZִI$I*Jlذۡ%P<,V[c !$I HBI$jTֵpp,YrcI$ĄI$ ZݰvZg'ny; )EWp'N^]zׯZpl]}I$I I$$$I$^8hURI I$$I$!%U* ɠW nlNspcQnw%x@5N/H7-^i}0|9DYٵ5KʝpE7_ 5TFRRH3#'&nChLsj(`SYQUF¤Q4أQȌ60ӶV,\Sr /H\PTQeznӂij5j:\J)RsL3+';'<,sjޕ{h\l'JKUVȆK,HI&€'EΉ8HwDMdR&97OL);@w`Q X,е4.&I-)QI@J U7TĨ$8(yQ$ʉ B 0T+ES&cT(4@@ni-,dDS.&_dz9ppE (+*@D V2evwC(whX#BEG?v㕺mY@I_Io8̓* n#78d/, ;^ b=0swU.#/phףQ;nhʥl@lKO崤Oa|X@ =7zi6DMi:ǧk:+ʕFT*sɖ7Bn(=$kwwc|:x͸4OaNFMmL9FjQ!"'G:[Q{20ʗYzkqr1M'GoȞD78~M{^dg$<5vSlحɿsD83hƪx!mc^-0`}0L@p0)f̝&:[6]{c1v◴rogseժ_8^^ cRFv̅ӦvBdˮp05Et@U{Y2<&J`"w|LboG edeW|(F:*/\Vȼ.3)VA 2$eu"9 k|^;n@@H@#ĉm0ۋ"\0˻ NZXqI:2۫+@t4E3H $H@ u[>S 2$% @0"ċivI% Ǿ,vRNDQ`6cM>AVRe$`€;LF\Li\X%4ɖ\fd FF2IH"XX vG5 oFU/rE8P^eOcar/data/States.rda0000644000175100001440000000242713017662412013710 0ustar hornikuserseVmlSe>֭[GK?A1la }1n !ju]EQ N%DMHP1nJD FB"ˢ AI>ܷ.y>=9=޶vT:lD٬b(g" ec %"hم++V;d;3t10l&FCX#&#ͮjI[5c8ƨ/]#L^M؎cэ:&G2R5k$ TQƦ46u ITvdⲤuDO&7`IdBׂ*+(G`{%* B bf ylÈُ(65$*k&r:GsXA4 U^$G yh:r*}lyB#FM]Ehx'Y  >vo;3W[(L?a:직_d:9^׀c && %9KˆxXؓ톅gڍXie %38}\dArS_vz~ʛzUxpkJx2p0'v{ZMy6K_Ieq~x&v1s8k٧s9ƾ#FWxǣ6>=L-@[8̭xg;a\"> I5ߢH"R."SXv瑊⪍Y`dM-Yj5K&ud̼D64V2(5ʈd+ LZU|j*TYTه K RTdU4fyLJ[e$!%{`+dSL.5W6 car/data/Guyer.rda0000644000175100001440000000044613017662410013535 0ustar hornikusersMK@7UHDM R4M (=%B!f%Z|[GO0<BHRA[GsdB}nwA@cuwUs8<Օ qvbMQ䩾|ҹTDžœ?c4RürYP˿f\%/VQUp'dٴ M'nD3PGgc&IIH'H$CJe[glC6t/&91car/data/Baumann.rda0000644000175100001440000000110413017662407014021 0ustar hornikusersBZh91AY&SY4@/߀]`hɨzS)D6Ԩ?TԪi=F@j4P%%1?QM-s؉n!jKԣf-$(iltRtfSF^qKa9DaB:+$TYD%teU%".h9QK˪Z ='"B8+]j,, ^hiWOa:XrV"7bvx-sJ`&z&"Yє͗f+l]*jx@G)=i‰Q>s$4! ] ?yzPIvekZֵkٛ @ #**Z(& ((K"$zzQ ۶tV6|JD d)șQ6m" l?YsS !LpX39'&ȕXV4M9gQ~e0av1­21L` S 01,?car/data/Moore.rda0000644000175100001440000000070113017662411013516 0ustar hornikusersBZh91AY&SYuŎ@/ߠ-, SLM& چ4zS"H4ꩩ6`FL@ "F @" pچ vD蔡iRit1A9cNe2&%vLۯVսT_w1ƺ`YBU'Iˡ[^ruU66{zud,j(Vt}W"c 0{"B'#瓮%ot -˨vDr<$$CCBMSBiG*`0b|汣8#!G##332:'eUUUR"""^ޙ{`.)8>w1X<\ps9|aހbP IښD*K -yy0 ܑN$9]mcar/data/Womenlf.rda0000644000175100001440000000204113017662414014046 0ustar hornikusersBZh91AY&SYUv <?߀| ^:GD="a`1& !LOҪM*J$FAhD4z h ɑV"# ah]LX4TkTdTUQc[m E)@MEP*6(j"j"*V(UdQ!D)[X0Q`R`6 K[ jQni!!QX4W#T12j"ЩLTY!f$XK8@hʒiZ6kwI$.^?.O[cfj ^ѷYIeݩ>C[ыEj 9sS]'u~Μ'*O?[4=oz6.>Tuo+@̚oLʓVMvLZo GU1wk[u/lxvF4i^տVshH_Q<(]V A6Z#H- )JII&ivm~G{-[rv7`qPUY  HD4AB " 'E y\Ǫ,,뮰+TI$I$wkUUxJI%bRIX$TV*I+$Jk&۷kbRIX$TV*I+$R@imXg9UUUoMswwjޚaUݝI$JkDD@TI$I$ZִDDI$I$JkDD@}3|fuֿ87ٷVYlu3dσm/.Nj~;^c:.7Y5q|M#\WV=š6:ʜvE=RoT rE8PUcar/data/USPop.rda0000644000175100001440000000061013017662412013443 0ustar hornikusers r0b```b`ffb`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 &ȕXVacar/data/Mroz.rda0000644000175100001440000002351413017662411013373 0ustar hornikusers7zXZi"6!X'])TW"nRʟt<3n2zP:5⟾7]zJ!>-t kaad]īc>Yp_FM2Z9{V 3yUl%WQ,fqG\ w%Ӧcy=W}W)Nu56lor[1׉j1~8KxVv4CGc5>g ^Rf~:&Xl>zE/(2bW7NPwi jdJZ GŰeyrW*9JaW$Ja*V}rOrY`;)Vf[\UǝAjO˻dq1*YzAyn\C;\o/|,Ł<5-R[P T Asgqo /D^WَDB0&F@(c;j T;3bQ5xxq2kh @=X cI+(Xf),s\㩌?; h'M&ǔIk(I=_Te'&V-_}6E^Z@%wbضÕDO fw7Ppog/ߜV]wmk&h=X*=hoYDKYk\l@ eV Ea \=n~e]YuY?(ucTѲfN{<ٛh ? NF?ZXE&HԳ=8ځJ+Nt$1ʠC^VQfOTPc\M04~Qv56]4g: ix Y vb!?Np?B8 ޾Hx[)ӄi_5]5V# uiBzuIF2,*A娫|wJS䐛ihS͐~9MzAFZE) |a'JFG@;RX(69Ιh9c]'$-.!oީ>L {ˣ{I3 4fjm iH"eu}td `f]vB(95&?*9lV0g^w*$V7s`u 06cNDFfۘWFXHQq;fvIZcӞ@jn2Uf:#yc:0Al)p[?B]2l''ˇ3V (>O+p X#^sib=xdL|h MKɡ .j@'' K8O vv,4'}yXje,:LˋSx2󂛻Hw mȵry>bcr."YK]qiܩE7Θ$HWܼO^nvc$_aL&~-Io =]}+8Y8D1zNI7hF!Y`ɲ%smx @Ҹtyɻa`+w`9f}&{ui0U_Yz7_#0+OMQ0A.8M-Ml0--GԀK5 C^V*!:nId"F#ؔkN\2J$,rZ  TrQ?V*0'75D!Cn}Yk5kAjr3/M/''CT_Ew$enS}Wm0]5wUVC[fH+R]T gwqUݛ򀼙X@̈́ PoBS=a83rk1R,zݍ ڣ ph"aHӾǶP4C}[&# G`U)#>,w>s0H8*I  `ަ5u*Lp*ȣ.gݩ9 xb|Stʾ3@㔭7PJ?E2 Pe!qFBoyr0gBV6ц®y<99jg1c9=ѕYw2b4;&GDY ܱk-9R&#N9bcU%ō%{O!߆7+l$(D+ϧ) ]HN4s3_|Q$wKiʯ-9ّg5f 59bmdo5vGݰ|2v O(RL[7r:u+!-7LNЀE Y[.Y9.Nu}/%3jaS$<!k\XzmrcUByxӹyNXi*\!ѳdJJ1tqBog0 B^wHIyQ0(YCϛ9ɪ0wRxH`-nqY (U)/z Ef_Q߫tGldSxXI w<ڋ;u] uV w0|`rL:xD@ЋmA1lX:CLv|ɹ"pml4j)cS2%4&h`iҸ;kOVƂMist^ Cw d>`^wG"]K kɫ1Tiɶ&T0p,!wO9#6aek7,$Xl Αn@j".4qJy'lY%w`_pX(<̝Hl{mF3P/JZ,W $3=&$;Ug`98(8.؈盩؍ZbW +V݄]E((<+fyLhN}) gىеۭ݃y!k]|UWzDͅgGHpkIP=~9/G3wky^ϯ:Ld80L숎j=ؗhB7rZ%|s"alYk|Xl~ՑŞ/.%X_@y'!486@9per$GϧKNw]O;B'tơR9jd 0EK~zfeb( m|(3 p%KQ,\ojT߈7ԦEXkI)ʽkbң p'q(~ڙgRpNHPPܰšK ' vW7`܇t91ʥՌC#á;y;Ks*TR 3DdVp1[jj îłZ/)5/X *m` d@,=ypMJ>Cj9jpQ+3{'pmh QVVtE`6p\cc a}R^i5ދV̚o*rէc1֑jV 8ѣ_dC l4 IТ#HAS0(HMoڄc$|A63@uI>ʘQ mOVjX;gǀN֝K5K7&AtEe"CQ g+'~ڷtKO]DqQq⭖>E sbqnyfvq fPol@kncTŝwi]wXtx8+V"aPF^qC+[lu?6 > pfNrl7x~ZU8> wIHmac(}wnP6?:aC6-i^tk " )>;IdتAUK^d"EgoK&!Ğ3_xrùRyo-RO2rS0'3;Kj o0WNF]ˌ鿡r%1oӖ{:ʚbD VZ ea:dim(g#EwH2Ff)_xnI G&k8iWIfV^68UZv؊+c++HjPK SYFb)ګݣBX _}l< #DS\R_92쁔7#mwMƈ G0]&$C2yD"CljջmZ)gwp&ZW\ҩ '.!|Yt0ݛEm`hUqaϳdʐiR{6 }v@@.f)ЋEvHKQ>n@D7˚p@)cٓnGdNxVO+w~y'Im J^K.dsSj?^Ij{Su5:~3vf^4pO?T2DxWA$Af aAul~P8CR-ٗRgR㈬{#% 5N!ߋ&ۿmL&Sc{QiimU1_w0(QX.1Cؖ^[ϔV?B؄+j]RFM?'ꕚp&F~3AHG:E7/yYjZ:N,cun/YCAެ(OznΛ|eISs Ո+﷘vD#c^|AP0{ɀHƀV >̖v@ umVW!$*d~9.NKa`Ӝ<8 :<%4*ʢӑ.5@ݤH2rsCyZdH\NK_SWaTxN;gOϨf'[QYGlUطΧnK:3TvpPZZu,/ ~.Pb'JT@UpĬQIT hWs Hl=^iZE,X fm >KY$˖M4pqDO:;.ikcd=,뻙p*l^YScxN/ O Ț%[(GO|<p++0\!z*ZoFsyOES^ŬH)].IV~{[-- R.W~`)_9ά੶:wpҝ[ݘ ++',P%0Fр]*]+8] ܪ)QԿE7~8Bf7RI!!RRg{{?a-̠R}8G5QmHɊү{x95AhQ6ּ=sYF&xJ+,%qb-j<罾)hY҉1 &~"SR8Lj0EP}on0#WVg[: {R+s. ".Gx}wOd"+dҞKmo5Iy_NYegX]H#[3qnOMF:ZYpQCo)Y雷A2+FUbv#;Iߧ,gRZ,ŬN57B囋gg&OZ  ' ӄFn)T"n9 ]^L!=FSNCu $Ht+i%t\K%m|_evHΓ%@ѳKoA&#Wu$uf Z|\1Ìb^qa&8I@` uC_oWtDORo`_S"\2UkItщeyw}zl5{%[.0{ǯ6@,kCǚv ;7_~`> 6j/De"-샽Ԏx=#!*rQ@f7WػbHn@1lQBN .x͞(;c&Pe/׍v_ $=f߉- (;M|BTTm CO"|)ؠ 2鑻0`~7n.H{q_Sa) JEEcp\}T q3ݙPQn,jmSI|T.aj@֒0F0dfrp)A=??'ԝݳ(ŝ *ǥ :{ƁMaC mЂOmDDu~5*CC*N[Ҟ>]hy5\Z*]=zXGE[t,48G84_;b@Vy}6q#?1 /ڙ+؋d USC qS f`2/CFM)׊:^&%l+kjy-jnV*VGd"괶*E '2$B=H~O(n_N̩xvOTE8G] VFGEAx4c7V>.d.L;kryObFV%3? =sB=[V j 䨫Tic@:AzIDuTyVO/6hIsc X槫ܺr}qJ3YMZO F< A9,]|Uzw)Ce2ͳ- oܽ8>KeA//j_T{@mCp/8Qo8}w$2UnM&:E  `*(*vmҙXQDmY RwJ3!L@A-c;h }Mݒ)P}\C)JƝ+|UK~,fxIPPtqct3*]jHBO^1lSMPs%8`ɰN<+LJpd:'=="XTshdvڰP?}ȳ0Yz@Z*pScF]"S#,t%d9a{JxlțXr7hBRS:lMIRSv;CVgՕ W)"fo_V0Hn}7c 2d <^xiDZr'$!InFjú" +C!T#avBDZ+Btq3%j;>_ToeXڛri1`,E@)ðnR։G-+nx(ȁoZDj&l\_gtk(XNk8*k4Ǎ |<(ȍ==_頇]&d~FSMB?5NZ[0(cUbgI\9xjnټWo"Voyz9Q0{ [݅:dוlY>iwBay_Oc;`.kHKh.i Ll@O1K-1ZfW>;F#5'$bH.__~ V]2mui OcIn+poWz,'67PK~9l^v ]L`#]OT>8k~)Ɨ5_6UVeakfF&jbOvZv٘~ ھRL %f*8?ND470oH.iZ9ˏ W>J &A- E/vIu#Q`3/4ļvua V+̕|x: )v‹'kAV16V̰0GV 5Vt$$#-#vGcT/6N'Rf]cـI!OA6W,Nδ#Naљ>0 YZcar/R/0000755000175100001440000000000013017662126011242 5ustar hornikuserscar/R/ceresPlots.R0000644000175100001440000001557012716420325013516 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, id.location=id.location) 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.R0000644000175100001440000000350712252362013013705 0ustar hornikusers#------------------------------------------------------------------------------- # Revision history: # 2009-09-28 by J. Fox (renamed) # 2010-04-14 by J. Fox fixed error in reporting largest abs rstudent # 2012-12-12 by J. Fox fixed handling of labels argument #------------------------------------------------------------------------------- # 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) if (length(rstudent) != length(labels)) stop("Number of labels does not correspond to number of residuals.") else names(rstudent) <- labels 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.R0000644000175100001440000001246412743744310014003 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 lme4. J. Fox # 26 Sept 2014: cleaned up printing of calls. J. Fox # 2016-07-20: added test for model classes. J. Fox compareCoefs <- function (..., se = TRUE, print = TRUE, digits = 3) { splitExpr <- function(expr, width=getOption("width") - 4, at="[ ,=]"){ if (length(grep("\n", expr)) >0 ){ cmds <- strsplit(expr, "\n")[[1]] allcmds <- character(length(cmds)) for (i in 1:length(cmds)) allcmds[i] <- splitExpr(cmds[i], width=width, at=at) return(paste(allcmds, collapse="\n")) } if (nchar(expr) <= width) return(expr) where <- gregexpr(at, expr)[[1]] if (where[1] < 0) return(expr) singleQuotes <- gregexpr("'", expr)[[1]] doubleQuotes <- gregexpr('"', expr)[[1]] comment <- regexpr("#", expr) if (singleQuotes[1] > 0 && (singleQuotes[1] < doubleQuotes[1] || doubleQuotes[1] < 0 ) && (singleQuotes[1] < comment[1] || comment[1] < 0 )){ nquotes <- length(singleQuotes) if (nquotes < 2) stop("unbalanced quotes") for(i in seq(nquotes/2)) where[(where > singleQuotes[2 * i - 1]) & (where < singleQuotes[2 * i])] <- NA where <- na.omit(where) } else if (doubleQuotes[1] > 0 && (doubleQuotes[1] < singleQuotes[1] || singleQuotes[1] < 0) && (doubleQuotes[1] < comment[1] || comment[1] < 0 )){ nquotes <- length(doubleQuotes) if (nquotes < 2) stop("unbalanced quotes") for(i in seq(nquotes/2)) where[(where > doubleQuotes[2 * i - 1]) & (where < doubleQuotes[2 * i])] <- NA where <- na.omit(where) } else if (comment > 0){ where[where > comment] <- NA where <- na.omit(where) } if (length(where) == 0) return(expr) where2 <- where[where <= width] where2 <- if (length(where2) == 0) where[1] else where2[length(where2)] paste(substr(expr, 1, where2), "\n ", Recall(substr(expr, where2 + 1, nchar(expr)), width, at), sep="") } removeExtraQuotes <- function(string) sub("\\\"$", "", sub("^\\\"", "", string)) squeezeMultipleSpaces <- function(string) gsub(" {2,}", " ", string) intersection <- function(...){ args <- list(...) if (length(args) == 2) intersect(args[[1]], args[[2]]) else intersect(args[[1]], do.call(intersection, args[-1])) } models <- list(...) n.models <- length(models) if (n.models < 1) return(NULL) if (n.models > 1){ classes <- lapply(models, class) common.classes <- do.call(intersection, classes) if (length(common.classes) == 0) warning("models to be compared are of different classes") } 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) { paste(deparse(if (isS4(model)) model@call else model$call), collapse="") } 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 <- getcall(model) mod <- if (n.models > 1) paste(i, ": ", sep = "") else "" if (print && calls) cat(splitExpr(squeezeMultipleSpaces(paste("\n", mod, removeExtraQuotes(fout[1]), sep = "")))) if (print && calls && length(fout) > 1) for (f in fout[-1]) cat("\n", splitExpr(squeezeMultipleSpaces(removeExtraQuotes(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 } 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.R0000644000175100001440000001527112716420325013021 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 # 22 Sept 2013 added argument marginal.scale to set xlim and ylim according to xlim and # ylim of marginal plot (S. Weisberg) # 16 May 2016 added argument id.location to set location of labels (S. Weisberg) 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)= 0") hc1 <- function(U, lambda, gamma){ if(abs(gamma) <= 1.e-10 & any(U[!is.na(U)] <= 0)) stop("First argument must be strictly positive if gamma = 0.") s <- sqrt(U^2 + gamma^2) z <- if (abs(lambda) <= 1.e-10) log(.5*(U + s)) else ((.5*(U + s))^lambda - 1)/lambda if (jacobian.adjusted == TRUE) { Jn <- (.5^lambda) * (exp((lambda - 1) * mean(log(U + s), na.rm=TRUE))) * (exp(mean(log(1 + U/s), na.rm=TRUE))) z <- z/Jn} 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] <- hc1(out[, j], lambda[j], gamma[j]) } colnames(out) <- paste(colnames(out), "(",round(lambda, 2), ",",round(gamma, 1),")", sep="") # colnames(out) <- paste(colnames(out), round(lambda, 2), sep="^") out} else hc1(out, lambda, gamma) out} ## Evaluate skew llik at (lambda, gamma)----------------------------------- skewPowerllik <- function(X, Y, weights=NULL, lambda, gamma, xqr=NULL) { Y <- as.matrix(Y) # coerces Y to be a matrix. w <- if(is.null(weights)) 1 else sqrt(weights) xqr <- if(is.null(xqr)){qr(w * as.matrix(X))} else xqr nr <- nrow(Y) f <- -(nr/2)*log(((nr - 1)/nr) * det(as.matrix(var(qr.resid(xqr, w * skewPower(Y, lambda, jacobian.adjusted=TRUE, gamma=gamma)))))) list(lambda=lambda, gamma=gamma, llik=f) } ## maximize skewPowerllik for fixed gamma-------------------------------------- skewPowerllikprofile.lambda <- function(X, Y, weights=NULL, gamma, xqr=NULL){ xqr <- if(is.null(xqr)){ w <- if(is.null(weights)) 1 else sqrt(weights) qr(w * as.matrix(X)) } else xqr fn <- function(lam) skewPowerllik(NULL, Y, weights, lambda=lam, gamma=gamma, xqr=xqr)$llik if(dim(as.matrix(Y))[2] ==1){ f <- optimize(f=fn, interval=c(-3, 3), maximum=TRUE) list(lambda=f$maximum, gamma=gamma, llik=f$objective, invHess=solve(-optimHess(f$maximum, fn))) } else { # get starting values par <- rep(0, length(gamma)) for (j in 1:dim(Y)[2]) par[j] <- skewPowerllikprofile.lambda(NULL, Y[, j, drop=FALSE], weights, gamma=gamma[j], xqr)$lambda # optimize f <- optim(par=par, fn=fn, method="L-BFGS-B", lower=rep(-3, length(gamma)), upper=rep(3, length(gamma)), control=list(fnscale=-1)) list(lambda=f$par, gamma=gamma, llik=f$value, invHess = solve(-optimHess(f$par, fn))) } } ## maximize skewPowerllik for fixed lambda------------------------------------- skewPowerllikprofile.gamma <- function(X, Y, weights=NULL, lambda, xqr=NULL){ xqr <- if(is.null(xqr)){ w <- if(is.null(weights)) 1 else sqrt(weights) qr(w * as.matrix(X)) } else xqr fn <- function(gam) skewPowerllik(NULL, Y, weights, lambda=lambda, gamma=gam, xqr=xqr)$llik if(dim(as.matrix(Y))[2] == 1L){ f <- optimize(f=fn, interval=c(0.01, max(Y)), maximum=TRUE) list(lambda=lambda, gamma=f$maximum, llik=f$objective, invHess=solve(-optimHess(f$maximum, fn))) } else { # get starting values par <- rep(0, length(lambda)) for (j in 1:dim(Y)[2])par[j] <- skewPowerllikprofile.gamma(NULL, Y[, j, drop=FALSE], weights, lambda=lambda[j], xqr)$gamma # optimize f <- optim(par=par, fn=fn, method="L-BFGS-B", lower=rep(.001, length(gamma)), upper=rep(Inf, length(gamma)), control=list(fnscale=-1)) list(lambda=lambda, gamma=f$par, llik=f$value, invHess = solve(-optimHess(f$par, fn))) } } ## ------------------------------------------------------------------------ skewmle <- function(X, Y, weights=NULL, lambda=c(-3, 3), gamma=NULL, control=list(maxit=1000)) { if(!is.null(gamma)) skewmle1d(X, Y, weights, lambda, gamma, control) else skewmle2d(X, Y, weights, lambda, gamma, control) } skewmle2d <- function(X, Y, weights=NULL, lambda=c(-3, 3), gamma=NULL, control=list(maxit=1000)) { # Get a starting value for lambda by removing all negative rows # and doing Box-Cox Power: Y <- as.matrix(Y) sel <- apply(Y, 1, function(x) all(x > 0)) weights <- if(is.null(weights)) rep(1, length(sel)) else weights lambda.start <- estimateTransform(as.matrix(X)[sel, ], Y[sel,], weights[sel])$lambda # Get a starting value for gamma using profiling xqr <- qr(sqrt(weights) * as.matrix(X)) nc <- length(lambda.start) gamma.start <- skewPowerllikprofile.gamma(NULL, Y, weights, lambda.start, xqr=xqr)$gamma # fnscale must be negative to maximize control$fnscale <- if(is.null(control$fnscale)) -1 else -abs(control$fnscale) fn <- function(param){ lam <- param[1:nc] gam <- param[(nc+1):(2*nc)] skewPowerllik(NULL, Y, weights, lam, gam, xqr=xqr)$llik } res <- optim(c(lambda.start, gamma.start), fn, method="L-BFGS-B", lower=c(rep(lambda[1], nc), rep(.01, nc)), upper=c(rep(lambda[2], nc), rep(+Inf, nc)), control=control) res$llik <- res$value if(res$convergence != 0) warning(paste("Convergence failure:", res$message)) invHess <- get.invHess(res$par, fn) res$invHess <- invHess res$ylabs <- if (is.null(colnames(Y))) paste("Y", 1:dim(Y)[2], sep="") else colnames(Y) names(res$par) <- rownames(res$invHess) <- colnames(res$invHess) <- c(paste("lam",res$ylabs, sep="."), paste("gam", res$ylabs, sep=".")) res$xqr <- xqr res$y <- Y res$x <- X res$weights <- weights res$fix.gamma <- NULL res } skewmle1d <- function(X, Y, weights=NULL, lambda=c(-3, 3), gamma, control=list(maxit=1000)) { Y <- as.matrix(Y) nc <- dim(Y)[2] weights <- if(is.null(weights)) rep(1, dim(Y)[1]) else weights xqr <- qr(sqrt(weights) * as.matrix(X)) res <- skewPowerllikprofile.lambda(X, Y, weights, gamma, xqr=xqr) # change size of invHess invHess <- matrix(nrow=2*nc, ncol=2*nc) invHess[1:nc, 1:nc] <- res$invHess res$invHess <- invHess res$ylabs <- if (is.null(colnames(Y))) paste("Y", 1:dim(Y)[2], sep="") else colnames(Y) rownames(res$invHess) <- colnames(res$invHess) <- c(paste("lam",res$ylabs, sep="."), paste("gam", res$ylabs, sep=".")) res$xqr <- xqr res$y <- Y res$x <- X res$par <- c(res$lambda, res$gamma) res$weights <- weights res$fix.gamma <- gamma res } ## Evaluate skew llik at (lambda, gamma)----------------------------------- skewPowerllik <- function(X, Y, weights=NULL, lambda, gamma, xqr=NULL) { Y <- as.matrix(Y) # coerces Y to be a matrix. w <- if(is.null(weights)) 1 else sqrt(weights) xqr <- if(is.null(xqr)){qr(w * as.matrix(X))} else xqr nr <- nrow(Y) f <- -(nr/2)*log(((nr - 1)/nr) * det(as.matrix(var(qr.resid(xqr, w * skewPower(Y, lambda, jacobian.adjusted=TRUE, gamma=gamma)))))) list(lambda=lambda, gamma=gamma, llik=f) } ## convenience function to compute the inverse Hessian, if possible, else return NA get.invHess <- function(...){ hess <- try(optimHess(...)) if(class(hess) == "try-error") NA else solve(-hess) } ## maximize skewPowerllik for fixed gamma-------------------------------------- skewPowerllikprofile.lambda <- function(X, Y, weights=NULL, gamma, xqr=NULL){ xqr <- if(is.null(xqr)){ w <- if(is.null(weights)) 1 else sqrt(weights) qr(w * as.matrix(X)) } else xqr fn <- function(lam) skewPowerllik(NULL, Y, weights, lambda=lam, gamma=gamma, xqr=xqr)$llik if(dim(as.matrix(Y))[2] ==1){ f <- optimize(f=fn, interval=c(-3, 3), maximum=TRUE) invHess <- get.invHess(f$maximum, fn) list(lambda=f$maximum, gamma=gamma, llik=f$objective, invHess=invHess) } else { # get starting values par <- rep(0, length(gamma)) for (j in 1:dim(Y)[2]) par[j] <- skewPowerllikprofile.lambda(NULL, Y[, j, drop=FALSE], weights, gamma=gamma[j], xqr)$lambda # optimize f <- optim(par=par, fn=fn, method="L-BFGS-B", lower=rep(-3, length(gamma)), upper=rep(3, length(gamma)), control=list(fnscale=-1)) invHess <- get.invHess(f$par, fn) list(lambda=f$par, gamma=gamma, llik=f$value, invHess = invHess) } } ## maximize skewPowerllik for fixed lambda------------------------------------- skewPowerllikprofile.gamma <- function(X, Y, weights=NULL, lambda, xqr=NULL){ xqr <- if(is.null(xqr)){ w <- if(is.null(weights)) 1 else sqrt(weights) qr(w * as.matrix(X)) } else xqr fn <- function(gam) skewPowerllik(NULL, Y, weights, lambda=lambda, gamma=gam, xqr=xqr)$llik if(dim(as.matrix(Y))[2] == 1L){ f <- optimize(f=fn, interval=c(0.01, max(Y)), maximum=TRUE) invHess <- get.invHess(f$maximum, fn) list(lambda=lambda, gamma=f$maximum, llik=f$objective, invHess=invHess) } else { # get starting values par <- rep(0, length(lambda)) for (j in 1:dim(Y)[2]) par[j] <- skewPowerllikprofile.gamma(NULL, Y[, j, drop=FALSE], weights, lambda=lambda[j], xqr)$gamma # optimize f <- optim(par=par, fn=fn, method="L-BFGS-B", lower=rep(.Machine$double.eps^0.25, length(gamma)), upper=rep(Inf, length(gamma)), control=list(fnscale=-1)) invHess <- get.invHess(f$par, fn) list(lambda=lambda, gamma=f$par, llik=f$value, invHess = invHess) } } # Generic function is in powerTransform.R estimateTransform.skewPower <- function(X, Y, weights=NULL, lambda=c(-3, 3), gamma=NULL, ...){ res <- skewmle(X, Y, weights, ...) nc <- dim(as.matrix(Y))[2] res$lambda <- res$par[1:nc] res$gamma <- res$par[(nc+1):(2*nc)] roundlam <- res$lambda stderr <- sqrt(diag(res$invHess[1:nc, 1:nc, drop=FALSE])) stderr.gam <- sqrt(diag(res$invHess[(nc+1):(2*nc), (nc+1):(2*nc), drop=FALSE])) 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$family <- "skewpowerTransform" class(res) <- c("skewpowerTransform", "powerTransform") res } # generic is in powerTransform.R testTransform.skewpowerTransform <- function(object, lambda=rep(1, dim(object$y)[2])){ nc <- length(object$lambda) lam <- if(length(lambda)==1) rep(lambda, nc) else lambda val <- skewPowerllikprofile.gamma(NULL, object$y, object$weights, lam, xqr=object$xqr) val <- if(is.null(object$fix.gamma)) skewPowerllikprofile.gamma(NULL, object$y, object$weights, lam, xqr=object$xqr)$llik else{ skewPowerllik(NULL, object$y, object$weights, lam, object$gamma, xqr=object$xqr)$llik } LR <- max(0, -2 * (val - object$llik)) df <- nc 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} # methods for skewpowerTransform objects print.skewpowerTransform<-function(x, ...) { cat("Estimated transformation power, lambda\n") print(x$lambda) cat("Estimated transformation location, gamma\n") print(x$gamma) invisible(x)} summary.skewpowerTransform<-function(object,...){ nc <- length(object$lambda) label <- paste(if(nc==1) "Skew Power transformation to Normality" else "Skew Power Transformations to Multinormality", "\n") lambda <- object$lambda gamma <- object$gamma stderr <- sqrt(diag(object$invHess)) stderr.gamma <- stderr[(nc+1):(2*nc)] stderr <- stderr[1:nc] result <- cbind(lambda, stderr, lambda - 1.96*stderr, lambda + 1.96*stderr) result.gamma <- cbind(gamma, stderr.gamma, pmax(gamma - 1.96*stderr.gamma, 0), gamma + 1.96*stderr.gamma) rownames(result) <- rownames(result.gamma) <- object$ylabs colnames(result) <- colnames(result.gamma) <- c("Est.Power", "Std.Err.", "Wald Lower Bound", "Wald Upper Bound") colnames(result.gamma) <- c("Est.gamma", "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, result.gamma=result.gamma, tests=tests) class(out) <- "summary.skewpowerTransform" out } print.summary.skewpowerTransform <- function(x,digits=4, ...) { cat(x$label) cat("\nEstimated power, lambda\n") print(round(x$result, digits)) cat("\nEstimated location, gamma\n") print(round(x$result.gamma, digits)) cat("\nLikelihood ratio tests about transformation parameters\n") print(x$tests) } coef.skewpowerTransform <- function(object, param=c("both", "lambda", "gamma"), round=FALSE, ...){ param <- match.arg(param) co <- cbind(if(round==TRUE) object$roundlam else object$lambda, object$gamma) dimnames(co) <- list(object$ylabs, c("lambda", "gamma")) switch(param, lambda = co[, 1], gamma=co[, 2], both= co) } vcov.skewpowerTransform <- function(object, param=c("both", "lambda", "gamma"), ...) { param <- match.arg(param) nc <- length(object$lambda) switch(param, lambda=object$invHess[1:nc, 1:nc], gamma=object$invHess[(nc+1):(2*nc), (nc+1):(2*nc)], both=object$invHess) } plot.skewpowerTransform <- function(x, z=NULL, round=TRUE, plot=pairs, ...){ y <- skewPower(x$y, lambda=coef(x, param="lambda"), jacobian.adjusted=FALSE, gamma=coef(x, param="gamma")) 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, ...) } } ## ------------------------------------------------------------------------ contour.skewpowerTransform <- function(x, ksds=4, levels=c(.5, .95, .99, .999), main="Skew Power Log-likelihood", ...){ object <- x if(dim(object$y)[2] != 1L) stop("This function is for univariate Y only") q <- object$value - qchisq(levels, 2)/2 se <- sqrt(diag(object$invHess)) center <- c(object$lambda, object$gamma) x1 <- seq(object$lambda - ksds*se[1], object$lambda + ksds*se[1], length=100) y <- seq(max(.01, object$gamma - ksds*se[2]), object$gamma + ksds*se[2], length=100) z <- matrix(0, nrow=length(x1), ncol=length(y)) for (i in 1:length(x1)){ for (j in 1:length(y)){ z[i,j] <- skewPowerllik(NULL, object$y, object$weights, x1[i], y[j], xqr=object$xqr)$llik } } contour(x1, y, z, xlab=expression(lambda), ylab=expression(gamma), main=main, nlevels=length(levels), levels=q, ...) points(center[1], center[2], pch=16, cex=1.25) text(center[1], center[2], as.character(round(object$value, 2)), pos=4, cex=.75) } car/R/panel.car.R0000644000175100001440000000067711261463162013240 0ustar hornikusers# panel function for use with coplot (J. Fox) # last modified 2 April 2009 panel.car <- function(x, y, col, pch, cex=1, span=.5, lwd=2, reg.line=lm, lowess.line=TRUE,...){ points(x, y, col=col, pch=pch, cex=cex) if (is.function(reg.line)) regLine(reg.line(y ~ x), lty=2, lwd=lwd, col=col, ...) if (lowess.line) lines(lowess(na.omit(as.data.frame(cbind(x, y))), f=span), col=col, lwd=lwd, ...) } car/R/ncvTest.R0000644000175100001440000000441712426762240013022 0ustar hornikusers#------------------------------------------------------------------------------- # Revision history: # 2009-09-28 by J. Fox (renamed) # 2012-07-01 Rewritten by S. Weisberg. The 'data' argument is now gone # 2013-07-09 Works correctly if data arg is not set in the model # works correctly if the formula in 'lm' is an argument # 2014-11-06 Fixed conflicts with objects in base package. J. Fox #------------------------------------------------------------------------------- # score test of nonconstant variance (J. Fox) ncvTest <- function(model, ...){ UseMethod("ncvTest") } ncvTest.lm <- function(model, var.formula, ...) { data <- getCall(model)$data model <- if (!is.null(data)){ data <- eval(data, envir=environment(formula(model))) update(model, formula(model), na.action="na.exclude", data=data) } else update(model, formula(model), na.action="na.exclude") sumry <- summary(model) residuals <- residuals(model, type="pearson") S.sq <- df.residual(model)*(sumry$sigma)^2/sum(!is.na(residuals)) .U <- (residuals^2)/S.sq if (missing(var.formula)) { mod <- lm(.U ~ fitted.values(model)) varnames <- "fitted.values" var.formula <- ~ fitted.values df <- 1 } else { form <- as.formula(paste(".U ~ ", as.character(var.formula)[[2]], sep="")) mod <- if(!is.null(data)){ data$.U <- .U lm(form, data=data) } else lm(form) df <- sum(!is.na(coefficients(mod))) - 1 } SS <- anova(mod)$"Sum Sq" RegSS <- sum(SS) - SS[length(SS)] Chisq <- RegSS/2 result <- list(formula=var.formula, formula.name="Variance", ChiSquare=Chisq, Df=df, p=pchisq(Chisq, df, lower.tail=FALSE), test="Non-constant Variance Score Test") class(result) <- "chisqTest" result } ncvTest.glm <- function(model, ...){ stop("requires lm object") } print.chisqTest <- function(x, ...){ title <- if (!is.null(x$test)) x$test else "Chisquare Test" cat(title,"\n") if (!is.null(x$formula)) cat(x$formula.name, "formula:", as.character(x$formula), "\n") cat("Chisquare =", x$ChiSquare," Df =", x$Df, " p =", x$p, "\n") invisible(x) } car/R/durbinWatsonTest.R0000644000175100001440000000572611272331344014712 0ustar hornikusers#------------------------------------------------------------------------------- # Revision history: # 2009-09-28 by J. Fox (renamed) #------------------------------------------------------------------------------- # generalized Durbin-Watson statistic (J. Fox) durbinWatsonTest <- function(model, ...){ UseMethod("durbinWatsonTest") } durbinWatsonTest.lm <- function(model, max.lag=1, simulate=TRUE, reps=1000, method=c("resample","normal"), alternative=c("two.sided", "positive", "negative"), ...){ method <- match.arg(method) alternative <- if (max.lag == 1) match.arg(alternative) else "two.sided" residuals <- residuals(model) if (any(is.na(residuals))) stop ('residuals include missing values') n <- length(residuals) r <- dw <-rep(0, max.lag) den <- sum(residuals^2) for (lag in 1:max.lag){ dw[lag] <- (sum((residuals[(lag+1):n] - residuals[1:(n-lag)])^2))/den r[lag] <- (sum(residuals[(lag+1):n]*residuals[1:(n-lag)]))/den } if (!simulate){ result <- list(r=r, dw=dw) class(result) <- "durbinWatsonTest" result } else { S <- summary(model)$sigma X <- model.matrix(model) mu <- fitted.values(model) Y <- if (method == "resample") matrix(sample(residuals, n*reps, replace=TRUE), n, reps) + matrix(mu, n, reps) else matrix(rnorm(n*reps, 0, S), n, reps) + matrix(mu, n, reps) E <- residuals(lm(Y ~ X - 1)) DW <- apply(E, 2, durbinWatsonTest, max.lag=max.lag) if (max.lag == 1) DW <- rbind(DW) p <- rep(0, max.lag) if (alternative == 'two.sided'){ for (lag in 1:max.lag) { p[lag] <- (sum(dw[lag] < DW[lag,]))/reps p[lag] <- 2*(min(p[lag], 1 - p[lag])) } } else if (alternative == 'positive'){ for (lag in 1:max.lag) { p[lag] <- (sum(dw[lag] > 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.R0000644000175100001440000002436012716420325015121 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 # 2014-08-07: J. Fox: plot univariate distributions by group (except for histogram) # 2014-08-17: J. Fox: report warning rather than error if not enough points in a group # to compute density # 2014-09-04: J. Fox: empty groups produce warning rather than error 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$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], id.location="lr", 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, legend.pos=NULL, row1attop=TRUE, ...){ if (id.method[1] == "identify") stop("interactive point identification not permitted") legend.pos # evaluate 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])) groups <- x$groups 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(position="topright"){ usr <- par("usr") legend(position, 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, ...){ if (n.groups > 1){ levs <- levels(groups) for (i in 1:n.groups){ xx <- x[levs[i] == groups] dens.x <- try(density(xx, adjust = adjust, na.rm=TRUE), silent=TRUE) if (!inherits(dens.x, "try-error")){ 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)), col=col[i]) } else warning("cannot estimate density for group ", levs[i], "\n", dens.x, "\n") rug(xx, col=col[i]) } } else { 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(position=if (is.null(legend.pos)) "topright" else legend.pos) do.legend <<- FALSE } panel.histogram <- function(x, ...){ par(new=TRUE) h.col <- col[1] if (h.col == "black") h.col <- "gray" hist(x, main="", axes=FALSE, breaks=nclass, col=h.col) if (do.legend) legendPlot(position=if (is.null(legend.pos)) "topright" else legend.pos) do.legend <<- FALSE } panel.boxplot <- function(x, ...){ b.col <- col[1:n.groups] b.col[b.col == "black"] <- "gray" par(new=TRUE) if (n.groups == 1) boxplot(x, axes=FALSE, main="", col=col[1]) else boxplot(x ~ groups, axes=FALSE, main="", col=b.col) if (do.legend) legendPlot(position=if (is.null(legend.pos)) "topright" else legend.pos) 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) if (n.groups == 1) segments(x - delta, x, x + delta, x, col = col[3]) else { segments(x - delta, x, x + delta, x, col = col[as.numeric(groups)]) } if (do.legend) legendPlot(position=if (is.null(legend.pos)) "bottomright" else legend.pos) do.legend <<- FALSE } panel.qqplot <- function(x, ...){ par(new=TRUE) if (n.groups == 1) qqnorm(x, axes=FALSE, xlab="", ylab="", main="", col=col[3]) else qqnorm(x, axes=FALSE, xlab="", ylab="", main="", col=col[as.numeric(groups)]) qqline(x, col=col[1]) if (do.legend) legendPlot(position=if (is.null(legend.pos)) "bottomright" else legend.pos) do.legend <<- FALSE } panel.blank <- function(x, ...){ if (do.legend) legendPlot(if (is.null(legend.pos)) "topright" else legend.pos) 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) counts <- table(groups) if (any(counts == 0)){ levels <- levels(groups) warning("the following groups are empty: ", paste(levels[counts == 0], collapse=", ")) groups <- factor(groups, levels=levels[counts > 0]) } 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, id.location=id.location, 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.location=id.location, id.cex=id.cex) } }, ... ) } spm <- function(x, ...){ scatterplotMatrix(x, ...) } car/R/bootCase.R0000644000175100001440000000512712461744752013141 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 # 2015-01-27 .carEnv now in global environment. John 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=.carEnv) obj.boot <- try(update(object, subset=get(".boot.sample", envir=.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=.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.R0000644000175100001440000001460012773507540013023 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 # 2016-09-30: added list, data.frame, and matrix methods, suggestion of Michael Friendly. J. Fox # 2016-10-01: tweaked data.frame and list methods. 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") } Boxplot.list <- function(y, xlab="", ylab="", ...){ if (is.null(names(y))) names(y) <- 1:length(y) g <- factor(rep(names(y), sapply(y, length)), levels=names(y)) y <- do.call(c, y) Boxplot(y, g, xlab=xlab, ylab=ylab, ...) } Boxplot.data.frame <- function(y, labels=rownames(y), ...){ labels <- rep(labels, ncol(y)) Boxplot(as.list(y), labels=labels, ...) } Boxplot.matrix <- function(y, ...){ Boxplot(as.data.frame(y), ...) } car/R/crPlots.R0000644000175100001440000001273412716420325013020 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, id.location=id.location) } 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, id.location=id.location) } } car/R/scatter3d.R0000644000175100001440000005662412655442646013310 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 # 2014-08-04: changed name of identify3d() to Identify3d(). J. Fox # 2014-08-17: added calls to requireNamespace and :: as needed. J. Fox # 2014-09-04: J. Fox: empty groups produce warning rather than error # 2015-12-12: Added axis.ticks argument and code contributed by David Winsemius to add tick labels to axes. J. Fox # 2016-02-06: Changed call to rgl.clear() to next3d() for compatibility with embedding in HTML. J. Fox scatter3d <- function(x, ...){ if (!requireNamespace("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, axis.ticks=FALSE, 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 (!requireNamespace("rgl")) stop("rgl package missing") if (!requireNamespace("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") counts <- table(groups) if (any(counts == 0)){ levels <- levels(groups) warning("the following groups are empty: ", paste(levels[counts == 0], collapse=", ")) groups <- factor(groups, levels=levels[counts != 0]) } 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::next3d() rgl::rgl.viewpoint(fov=fov) rgl::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 (axis.ticks){ if (axis.scales) { x.labels <- seq(lab.min.x, lab.max.x, by=diff(range(lab.min.x, lab.max.x))/4) x.at <- seq(min.x, max.x, by=nice(diff(range(min.x, max.x))/4)) rgl::rgl.texts(x.at, -0.05, 0, x.labels, col = axis.col[1]) z.labels <- seq(lab.min.z, lab.max.z, by=diff(range(lab.min.z, lab.max.z))/4) z.at <- seq(min.z, max.z, by=diff(range(min.z, max.z))/4) rgl::rgl.texts(0, -0.1, z.at, z.labels, col = axis.col[3]) y.labels <- seq(lab.min.y, lab.max.y, by=diff(range(lab.min.y, lab.max.y))/4) y.at <- seq(min.y, max.y, by=diff(range(min.y, max.y))/4) rgl::rgl.texts(-0.05, y.at, -0.05, y.labels, col = axis.col[2]) } } else { rgl::rgl.texts(min.x, -0.05, 0, lab.min.x, col=axis.col[1]) rgl::rgl.texts(max.x, -0.05, 0, lab.max.x, col=axis.col[1]) rgl::rgl.texts(0, -0.1, min.z, lab.min.z, col=axis.col[3]) rgl::rgl.texts(0, -0.1, max.z, lab.max.z, col=axis.col[3]) rgl::rgl.texts(-0.05, min.y, -0.05, lab.min.y, col=axis.col[2]) rgl::rgl.texts(-0.05, max.y, -0.05, lab.max.y, col=axis.col[2]) } } 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::rgl.spheres(x, y, z, color=point.col, radius=size*radius) else rgl::rgl.points(x, y, z, color=point.col) } else { if (size > threshold) rgl::rgl.spheres(x, y, z, color=surface.col[as.numeric(groups)], radius=size*radius) else rgl::rgl.points(x, y, z, color=surface.col[as.numeric(groups)]) } if (!axis.scales) axis.col[1] <- axis.col[3] <- axis.col[2] rgl::rgl.lines(c(0,1), c(0,0), c(0,0), color=axis.col[1]) rgl::rgl.lines(c(0,0), c(0,1), c(0,0), color=axis.col[2]) rgl::rgl.lines(c(0,0), c(0,0), c(0,1), color=axis.col[3]) rgl::rgl.texts(1, 0, 0, xlab, adj=1, color=axis.col[1]) rgl::rgl.texts(0, 1.05, 0, ylab, adj=1, color=axis.col[2]) rgl::rgl.texts(0, 0, 1, zlab, adj=1, color=axis.col[3]) # if (axis.scales){ # rgl::rgl.texts(min.x, -0.05, 0, lab.min.x, col=axis.col[1]) # rgl::rgl.texts(max.x, -0.05, 0, lab.max.x, col=axis.col[1]) # rgl::rgl.texts(0, -0.1, min.z, lab.min.z, col=axis.col[3]) # rgl::rgl.texts(0, -0.1, max.z, lab.max.z, col=axis.col[3]) # rgl::rgl.texts(-0.05, min.y, -0.05, lab.min.y, col=axis.col[2]) # rgl::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) rgl::shade3d(ellips, col=surface.col[1], alpha=ellipsoid.alpha, lit=FALSE) if (grid) rgl::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) rgl::shade3d(ellips, col=surface.col[j], alpha=ellipsoid.alpha, lit=FALSE) if (grid) rgl::wire3d(ellips, col=surface.col[j], lit=FALSE) coords <- ellips$vb[, which.max(ellips$vb[1,])] if (!surface) rgl::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)) mgcv::gam(y ~ s(x, z)) else mgcv::gam(y ~ s(x, z, fx=TRUE, k=df.smooth)), additive = if (is.null(df.additive)) mgcv::gam(y ~ s(x) + s(z)) else mgcv::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::rgl.surface(vals, vals, yhat, color=surface.col[i], alpha=surface.alpha, lit=FALSE) if(grid) rgl::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::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::rgl.quads(xx, yy, zz, color=square.col, alpha=surface.alpha, lit=FALSE) rgl::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)) mgcv::gam(y ~ s(x, z) + groups) else mgcv::gam(y ~ s(x, z, fx=TRUE, k=df.smooth) + groups), additive = if (is.null(df.additive)) mgcv::gam(y ~ s(x) + s(z) + groups) else mgcv::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::rgl.surface(vals, vals, yhat, color=surface.col[j], alpha=surface.alpha, lit=FALSE) if (grid) rgl::rgl.surface(vals, vals, yhat, color=if (fill) grid.col else surface.col[j], alpha=surface.alpha, lit=FALSE, front="lines", back="lines") rgl::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::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::rgl.quads(xxx, yyy, zzz, color=surface.col[j], alpha=surface.alpha, lit=FALSE) rgl::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)) mgcv::gam(y ~ s(x, z), subset=select.obs) else mgcv::gam(y ~ s(x, z, fx=TRUE, k=df.smooth), subset=select.obs), additive = if (is.null(df.additive)) mgcv::gam(y ~ s(x) + s(z), subset=select.obs) else mgcv::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::rgl.surface(vals, vals, yhat, color=surface.col[j], alpha=surface.alpha, lit=FALSE) if (grid) rgl::rgl.surface(vals, vals, yhat, color=if (fill) grid.col else surface.col[j], alpha=surface.alpha, lit=FALSE, front="lines", back="lines") rgl::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::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::rgl.quads(xxx, yyy, zzz, color=surface.col[j], alpha=surface.alpha, lit=FALSE) rgl::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::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 (...) { if (!requireNamespace("rgl")) stop("rgl package is missing") rgl::.check3d() rect <- rgl::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::rgl.projection() function(x, y, z) { pixel <- rgl::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){ if (!requireNamespace("rgl")) stop("rgl package is missing") if (!is.null(groups)){ counts <- table(groups) if (any(counts == 0)){ levels <- levels(groups) warning("the following groups are empty: ", paste(levels[counts == 0], collapse=", ")) groups <- factor(groups, levels=levels[counts != 0]) } } 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::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::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 (!requireNamespace("rgl")) stop("rgl package is missing") 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::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){ if (!requireNamespace("rgl")) "rgl package is missing" # 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) rgl::qmesh3d(v, i) } car/R/showLabels.R0000644000175100001440000001177212716420325013476 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. # 2014-03-12 added new id.method "r" that labels using order(abs(y), decreasing=TRUE) # 2016-05-16 added argument id.location = c("lr", "ab") for location of point labels showLabels <- function(x, y, labels=NULL, id.method="identify", id.n = length(x), id.cex=1, id.col=palette()[1], id.location="lr", ...) { 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, id.location, ...)) 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], id.location="lr", 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] if (is.null(id.location)) id.location <- "lr" id.location <- match.arg(id.location, c("lr", "ab")) # 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', 'r' idmeth <- pmatch(id.method[1], c("x", "y", "mahal", "identify", "r")) if(!is.na(idmeth)) idmeth <- c("x", "y", "mahal", "identify", "r")[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)), r = if(log.y==TRUE) suppressWarnings(if(all(y) > 0) abs(log(y)) else return(invisible(NULL))) else abs(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, decreasing=TRUE)[1L:min(length(id.var), id.n)] # position, now depends on id.location (as of 5/16/2016) if(id.location %in% c("lr", "l", "r")){ 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)] } else { mid <- mean(if(par("ylog")==TRUE) 10^(par("usr")[3:4]) else par("usr")[3:4]) labpos <- c(3,1)[1+as.numeric(y > 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/mcPlots.R0000644000175100001440000001667312716420325013021 0ustar hornikusers# October 1, 2014 mcPlots, by S. Weisberg and J. Fox # 'mc' stands for Marginal and Conditional: for the specified regressor X in model # The 'marginal' plot is of Y vs X with Y and X both centered # The 'conditional plot is the added-variable plot e(Y|rest) vs e(X|rest) # If 'overlaid=TRUE', the default, both plots are overlayed # If 'overlaid=FALSE', then the plots are side-by-side # The 'overlaid' plot is similar to the initial and final frame of an ARES plot # Cook and Weisberg (1989), "Regression diagnostics with dynamic graphics", Technometrics, 31, 277. # This plot would benefit from animation. mcPlots <- function(model, terms=~., layout=NULL, ask, overlaid=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) if(attr(attr(model.frame(model), "terms"), "intercept") == 0) stop("Error---the 'lm' object must have an intercept") nt <- length(good) if (nt == 0) stop("No plots specified") # if (missing(main)) main <- if (nt == 1) paste("Marginal/Conditional Plot:", good) else # "Marginal/Conditional Plots" if (nt == 0) stop("No plots specified") if(overlaid){ 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, 4), c(1, 2), c(2, 2), c(3, 2), c(4, 2)) } ask <- if(missing(ask) || is.null(ask)) layout[1] < nt else ask op <- par(mfrow=layout, ask=ask, no.readonly=TRUE, oma=c(0, 0, 1.5, 0), mar=c(5, 4, 1, 2) + .1) on.exit(par(op)) } } for (term in good) mcPlot(model, term, new=FALSE, overlaid=overlaid, ...) # mtext(side=3,outer=TRUE,main, cex=1.2) } mcPlot <- function(model, ...) UseMethod("mcPlot") mcPlot.lm <- function(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], id.location="lr", col.marginal="blue", col.conditional="red", col.arrows="gray", pch = c(16,1), lwd = 2, grid=TRUE, ###removed arg main ellipse=FALSE, ellipse.args=list(levels=0.5), overlaid=TRUE, new=TRUE, ...){ variable <- if (is.character(variable) & 1 == length(variable)) variable else deparse(substitute(variable)) if(new && !overlaid) { op <- par(mfrow=c(1,2)) on.exit(par(op)) } if(missing(labels)) labels <- names(residuals(model)[!is.na(residuals(model))]) else deparse(substitute(variable)) if(attr(attr(model.frame(model), "terms"), "intercept") == 0) stop("Error---the 'lm' object must have an intercept") mod.mat <- model.matrix(model) var.names <- colnames(mod.mat) var <- which(variable == var.names) if (0 == length(var)) stop(paste(variable, "is not a column of the model matrix.")) response <- response(model) responseName <- responseName(model) if (is.null(weights(model))) wt <- rep(1, length(response)) else wt <- weights(model) res0 <- lm(cbind(mod.mat[, var], response) ~ 1, weights=wt)$residual res <- lsfit(mod.mat[, -var], cbind(mod.mat[, var], response), wt = wt, intercept = FALSE)$residuals xlab <- paste(var.names[var], "| others") ylab <- paste(responseName, " | others") xlm <- c( min(res0[, 1], res[, 1]), max(res0[, 1], res[, 1])) ylm <- c( min(res0[, 2], res[, 2]), max(res0[, 2], res[, 2])) if(overlaid){ plot(res[, 1], res[, 2], xlab = xlab, ylab = ylab, type="n", main=paste("Marginal/Conditional plot of", var.names[var]), xlim=xlm, ylim=ylm, ...) if(grid){ grid(lty=1, equilogs=FALSE) box()} points(res0[, 1], res0[, 2], pch=pch[1], col=col.marginal) points(res[, 1], res[, 2], col=col.conditional, pch=pch[2], ...) arrows(res0[, 1], res0[, 2], res[, 1], res[, 2], length=0.125, col=col.arrows) abline(lsfit(res0[, 1], res0[, 2], wt = wt), col = col.marginal, lwd = lwd) abline(lsfit(res[, 1], res[, 2], wt = wt), col = col.conditional, lwd = lwd) if (ellipse) { ellipse.args1 <- c(list(res0, add=TRUE, plot.points=FALSE, col=col.marginal), ellipse.args) do.call(dataEllipse, ellipse.args1) ellipse.args1 <- c(list(res, add=TRUE, plot.points=FALSE, col=col.conditional), ellipse.args) do.call(dataEllipse, ellipse.args1) } showLabels(res0[, 1],res0[, 2], labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col, id.location=id.location) colnames(res) <- c(var.names[var], responseName) rownames(res) <- rownames(mod.mat) invisible(res)} else { # side.by.side plots plot(res0[, 1], res0[, 2], type="n", xlab = paste("Centered", var.names[var], sep=" "), ylab = paste("Centered", responseName, sep=" "), main=paste("Marginal plot of", var.names[var]), xlim=xlm, ylim=ylm, ...) if(grid){ grid(lty=1, equilogs=FALSE) box()} points(res0[, 1], res0[, 2], pch=pch[1], col=col.marginal) abline(lsfit(res0[, 1], res0[, 2], wt = wt), col = col.marginal, lwd = lwd) if (ellipse) { ellipse.args1 <- c(list(res0, add=TRUE, plot.points=FALSE, col=col.marginal), ellipse.args) do.call(dataEllipse, ellipse.args1) } showLabels(res0[, 1],res0[, 2], labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col, id.location=id.location) colnames(res) <- c(var.names[var], responseName) rownames(res) <- rownames(mod.mat) plot(res[, 1], res[, 2], xlab = xlab, ylab = ylab, type="n", main=paste("Added-Variable plot of", var.names[var]), xlim=xlm, ylim=ylm, ...) if(grid){ grid(lty=1, equilogs=FALSE) box()} points(res[, 1], res[, 2], col=col.conditional, pch=pch[2], ...) abline(lsfit(res[, 1], res[, 2], wt = wt), col = col.conditional, lwd = lwd) if (ellipse) { ellipse.args1 <- c(list(res, add=TRUE, plot.points=FALSE, col=col.conditional), ellipse.args) do.call(dataEllipse, ellipse.args1) } showLabels(res[, 1],res[, 2], labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col, id.location=id.location) invisible(res)} } 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.R0000644000175100001440000002727712716420325015014 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], id.location="lr", 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 # 11/21/14: SD smooth under the model corrected by adding the 'offset' smoother(u, predict(model), col.line[2], log.x=FALSE, log.y=FALSE, spread=sd, smoother.args=smoother.args, offset=sigmaHat(model)) # 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, id.location=id.location) } 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], id.location="lr", 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, id.location=id.location) } 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.R0000644000175100001440000001224112677222256013626 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 # 2016-03-31: added level argument and report CIs. J. Fox #------------------------------------------------------------------------------- deltaMethod <- function (object, ...) { UseMethod("deltaMethod") } deltaMethod.default <- function (object, g, vcov., func = g, constants, level=0.95, ...) { 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)) result <- data.frame(Estimate = est, SE = se.est, row.names = c(func)) p <- (1 - level)/2 z <- - qnorm(p) lower <- est - z*se.est upper <- est + z*se.est pct <- paste(format(100*c(p, 1 - p), trim=TRUE, scientific=FALSE, digits=3), "%") result <- cbind(result, lower, upper) names(result)[3:4] <- pct result } 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.R0000644000175100001440000001255212716420325012650 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 # 2015-12-12: allow vectorized col, pch, and cex arguments (suggestion of Emmanuel Curis) 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], id.location="lr", grid=TRUE) { line <- match.arg(line) good <- !is.na(x) ord <- order(x[good]) if (length(col) == length(x)) col <- col[good][ord] if (length(pch) == length(x)) pch <- pch[good][ord] if (length(cex) == length(x)) cex <- cex[good][ord] 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, id.location=id.location) } 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], id.location="lr", 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, id.location="lr", ...) 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, id.location=id.location) } 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.R0000644000175100001440000006647512735134230014735 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 # 2014-08-17: added call to requireNamespace() and :: as needed (doesn't work for pbkrtest). J. Fox # 2014-08-18: fixed bug in linearHypothesis.survreg(). J. Fox # 2014-09-23: added linearHypothesis.rlm. J. Fox # 2014-12-18: check that residual df nonzero in Anova.lm() and Anova.default # and residual SS nonzero in Anova.lm(). John # 2015-01-27: KRmodcomp() and methods now imported from pbkrtest. John # 2015-02-03: Check for NULL df before 0 df in default method. John # 2016-06-29: added "value" and "vcov" attributes to returned object, print vcov when verbose. John #---------------------------------------------------------------------------------------------------- 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 if (df == 0) stop("residual df = 0") 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) value.hyp <- L %*% b - rhs vcov.hyp <- L %*% V %*% t(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(value.hyp)) cat("\n") if (length(vcov.hyp) == 1) cat("\nEstimated variance of linear function\n") else cat("\nEstimated variance/covariance matrix for linear function\n") print(drop(vcov.hyp)) cat("\n") } SSH <- as.vector(t(value.hyp) %*% solve(vcov.hyp) %*% value.hyp) 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] result <- structure(as.data.frame(rval), heading = c(title, printHypothesis(L, rhs, names(b)), "", topnote, note), class = c("anova", "data.frame")) attr(result, "value") <- value.hyp attr(result, "vcov") <- vcov.hyp result } 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 (df.residual(model) == 0) stop("residual df = 0") if (deviance(model) < sqrt(.Machine$double.eps)) stop("residual sum of squares is 0 (within rounding error)") 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") attr(rval2, "value") <- attr(rval, "value") attr(rval2, "vcov") <- attr(rval, "vcov") 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 <- which(rownames(vcov.) == "Log(scale)") if (length(p) > 0) 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 (!requireNamespace("lme4")) stop("lme4 package is missing") # if (!require("pbkrtest") || packageVersion("pbkrtest") < "0.3.2") stop("pbkrtest package version >= 0.3.2 required for F-test on linear mixed model") if (!lme4::isREML(model)) stop("F test available only for linear mixed model fit by REML") # res <- pbkrtest::KRmodcomp(model, L)$test 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, ...) ## for rlm df.residual.rlm <- function(object, ...){ p <- length(coef(object)) wt.method <- object$call$wt.method if (!is.null(wt.method) && wt.method == "case") { sum(object$weights) - p } else length(object$wresid) - p } linearHypothesis.rlm <- function(model, ...) linearHypothesis.default(model, test="F", ...) ## 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.R0000644000175100001440000000264112707463276013507 0ustar hornikusers# Last modified 25 Nov 2009 for point marking # 18 January 2012 added robust estimation from Pendergast and Sheather # 25 April 2016 check na.action for compatibility with Rcmdr 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") inverseResponsePlot.lm <- function(model, lambda=c(-1, 0, 1), robust=FALSE, xlab=NULL, labels = names(residuals(model)), ...) { # Added for compatibility with Rcmdr if(class(model$na.action) == "exclude") model <- update(model, na.action=na.omit) # End addition 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.R0000644000175100001440000000474112367772051012642 0ustar hornikusers# recode function (J. Fox) # last modified 2014-08-04 by J. Fox recode <- function(var, recodes, as.factor.result, as.numeric.result=TRUE, levels){ lo <- -Inf hi <- Inf 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 for (term in recode.list){ if (0 < length(grep(":", term))) { range <- strsplit(strsplit(term, "=")[[1]][1],":") low <- try(eval(parse(text=range[[1]][1])), silent=TRUE) if (class(low) == "try-error"){ stop("\n in recode term: ", term, "\n message: ", low) } high <- try(eval(parse(text=range[[1]][2])), silent=TRUE) if (class(high) == "try-error"){ stop("\n in recode term: ", term, "\n message: ", high) } target <- try(eval(parse(text=strsplit(term, "=")[[1]][2])), silent=TRUE) if (class(target) == "try-error"){ stop("\n in recode term: ", term, "\n message: ", target) } result[(var >= low) & (var <= high)] <- target } else if (0 < length(grep("^else=", squeezeBlanks(term)))) { target <- try(eval(parse(text=strsplit(term, "=")[[1]][2])), silent=TRUE) if (class(target) == "try-error"){ stop("\n in recode term: ", term, "\n message: ", target) } result[1:length(var)] <- target } else { set <- try(eval(parse(text=strsplit(term, "=")[[1]][1])), silent=TRUE) if (class(set) == "try-error"){ stop("\n in recode term: ", term, "\n message: ", set) } target <- try(eval(parse(text=strsplit(term, "=")[[1]][2])), silent=TRUE) if (class(target) == "try-error"){ stop("\n in recode term: ", term, "\n message: ", target) } 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.R0000644000175100001440000001254613016336052013706 0ustar hornikusers# checked in 2013-06-05 by J. Fox # 2014-09-04: J. Fox: empty groups produce warning rather than error # 2016-10-16: J. Fox: add option for adaptive kernel. # 2016-11-26: J. Fox: rejig for pure-R adaptive kernel densityPlot <- function(x, ...){ UseMethod("densityPlot") } densityPlot.default <- function (x, g, method=c("kernel", "adaptive"), bw=if (method == "adaptive") bw.nrd0 else "SJ", adjust=1, kernel, xlim, ylim, normalize=FALSE, 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, ...) { norm <- function(x, y){ n <- length(x) x0 <- diff(range(x))/(n - 1) y0 <- (y[1:(n-1)] + y[2:n])/2 exp(log(y) - log(sum(y0*x0))) } method <- match.arg(method) if (method == "kernel"){ kernel <- if (missing(kernel)) "gaussian" else match.arg(kernel, c("gaussian", "epanechnikov", "rectangular", "triangular", "biweight", "cosine", "optcosine")) } else{ if(missing(kernel)) kernel <- dnorm if (!is.function(kernel)) stop("for the adaptive kernel estimator, the kernel argument must be a function") } force(ylab) force(xlab) if (!is.numeric(x)) stop("argument x must be numeric") if (missing(g)) { density <- if (method == "adaptive") adaptiveKernel(x, bw=bw, adjust=adjust, ...) else density(x, bw=bw, adjust=adjust, kernel=kernel, ...) if (normalize) density$y <- norm(density$x, density$y) if (missing(xlim)) xlim <- range(density$x) if (missing(ylim)) ylim <- c(0, max(density$y)) if (show.bw) xlab <- paste(xlab, " (bandwidth = ", format(density$bw), ")", sep="") plot(xlim, ylim, xlab=xlab, ylab=ylab, main="", type="n") if (rug) rug(x) if (grid) grid() lines(density, col=col[1], lwd=lwd, lty=lty[1], xlim=xlim, ylim=ylim) } else { if (!is.factor(g)) stop("argument g must be a factor") counts <- table(g) if (any(counts == 0)){ levels <- levels(g) warning("the following groups are empty: ", paste(levels[counts == 0], collapse=", ")) g <- factor(g, levels=levels[counts != 0]) } legend.title valid <- complete.cases(x, g) x <- x[valid] g <- g[valid] levels <- levels(g) if (is.numeric(bw) && length(bw) == 1) bw <- rep(bw, length(levels)) if (length(adjust) == 1) adjust <- rep(adjust, length(levels)) if (is.numeric(bw) && 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(adjust) <- names(densities) <- levels if (is.numeric(bw)) names(bw) <- levels for (group in levels){ densities[[group]] <- if (method == "adaptive") adaptiveKernel(x[g == group], bw=if (is.numeric(bw)) bw[group] else bw, adjust=adjust[group], ...) else density(x[g == group], bw=if (is.numeric(bw)) bw[group] else bw, adjust=adjust[group], kernel=kernel, ...) if (normalize) densities[[group]]$y <- norm(densities[[group]]$x, densities[[group]]$y) } if (missing(xlim)){ xlim <- range(unlist(lapply(densities, function(den) range(den$x)))) } if (missing(ylim)){ ylim <- c(0, max(sapply(densities, function(den) max(den$y)))) } plot(xlim, ylim, 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(if (missing(g)) density else densities)) } 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.R0000644000175100001440000000517312455313063012155 0ustar hornikusers#------------------------------------------------------------------------------- # Revision history: # 2009-09-28 by J. Fox # 2013-05-21 replaced vif.lm with vif.default and added # model.matrix.gls to make gls models work. J. Fox # 2015-01-13: fixed model.matrix.gls to work with models with formulas as object. 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 # } vif.default <- function(mod, ...) { if (any(is.na(coef(mod)))) stop ("there are aliased coefficients in the model") v <- vcov(mod) assign <- attr(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 } model.matrix.gls <- function(object, ...){ model.matrix(formula(object), data=eval(object$call$data)) } car/R/boxCox.R0000644000175100001440000000767712567656065012666 0ustar hornikusers# 2015-08-26: Modified by S. Weisberg to add support for skew power transformations. boxCox <- function(object,...) UseMethod("boxCox") # New arguments: param, and gamma boxCox.formula <- function (object, lambda = seq(-2, 2, 1/10), plotit=TRUE, ...) { 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, ...) { 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, eps = 1/50, xlab=NULL, ylab=NULL, family="bcPower", param=c("lambda", "gamma"), gamma=NULL, grid=TRUE, ...) { if(class(object)[1] == "mlm") stop("This function is for univariate response only") param <- match.arg(param) ylab <- if(is.null(ylab)){if(family != "skewPower") "log-likelihood" else{ if(param=="gamma") {expression(max(logL[gamma](lambda,gamma)))} else {expression(max[lambda](logL(lambda, gamma)))}}} else ylab xlab <- if(is.null(xlab)){if(param == "lambda") expression(lambda) else expression(gamma)} else xlab 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 <- if(family != "skewPower") as.vector(lambda) else { if(param == "lambda") as.vector(lambda) else { # if argument gamma is non-null, use it for the range for gamma. # if gamma is null then use the range of the mle plus or minus 3 ses if(!is.null(gamma)) as.vector(gamma) else{ p1 <- powerTransform(object, family="skewPower") gam <- p1$gamma se <- sqrt(vcov(p1)[2,2]) seq(max(.01, gam - 3*se), gam + 3*se, length=100) } } } m <- length(xl) if(family != "skewPower"){ for (i in 1L:m) { yt <- fam(y,xl[i],j=TRUE) loglik[i] <- -n/2 * log(sum(qr.resid(xqr, yt)^2)) }} else{ for (i in 1L:m) { loglik[i] <- if(param == "gamma") skewPowerllikprofile.lambda(NULL, y, NULL, xl[i], xqr=xqr)$llik else skewPowerllikprofile.gamma(NULL, y, NULL, xl[i], xqr=xqr)$llik } } 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/powerTransformlmer.R0000644000175100001440000003613013001463225015270 0ustar hornikusers# 2016-07-20: Added support for power transformations in lmerMod objects, S. Weisberg # 2016-08-17: Allowed fixed gamma or estimated gamma. # generic functions in powerTransform.R powerTransform.lmerMod <- function(object, family="bcPower", lambda=c(-3, 3), gamma=NULL, ...) { if(family=="skewPower") estimateTransform.skewPowerlmer(object, lambda=lambda, gamma=gamma, ...) else estimateTransform.lmerMod(object, family=family, lambda=lambda, ...) } ################################################################################# ### estimate transformation methods ################################################################################# # lmerMod estimateTransform.lmerMod <- function(object, family="bcPower", lambda=c(-3, 3), start=NULL, method="L-BFGS-B", ...) { data <- model.frame(object) y <- (object@resp)$y fam <- match.fun(family) llik <- function(lambda){ data$y.lambda <- fam(y, lambda, jacobian.adjusted=TRUE) m.lambda <- update(object, y.lambda ~ ., data=data) logLik(m.lambda) } if (is.null(start)) start <- 1 res<- optimize(f = function(lambda1) llik(lambda1), lower=lambda[1], upper=lambda[2], maximum=TRUE) # optimize does not give the Hessian, so run optimHess res$invHess <- get.invHess(res$maximum, llik, ...) # res$hessian <- optimHess(res$maximum, llik, ...) res$lambda <- res$maximum res$value <- c(res$objective) roundlam <- res$lambda stderr <- sqrt(diag(res$invHess)) 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$model <- object res$roundlam <- roundlam res$family<-family class(res) <- c("lmerModpowerTransform", "powerTransform") res } # skewPowerlmer method estimateTransform.skewPowerlmer <- function(object, lambda=c(-3, +3), gamma=NULL, ...){ res <- skewlmermle(object, lambda=lambda, gamma=gamma, ...) nc <- 1 res$lambda <- res$par[1:nc][] res$gamma <- res$par[(nc+1):(2*nc)] roundlam <- res$lambda stderr <- sqrt(diag(res$invHess[1:nc, 1:nc, drop=FALSE])) stderr.gam <- sqrt(diag(res$invHess[(nc+1):(2*nc), (nc+1):(2*nc), drop=FALSE])) 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$family <- "skewpowerTransform" class(res) <- c("skewpowerTransformlmer", "skewpowerTransform", "powerTransform") res } ################################################################################# # Test Transformation # in testTransform: 'object' is of class lmerModpowerTransform # 'model' will be the lmerMod object ################################################################################# # lmerMod testTransform.lmerModpowerTransform <- function(object, lambda=1){ fam <- match.fun(object$family) model <- object$model y <- (model@resp)$y local.data <- model.frame(model) local.data$y.lambda <- fam(y, lambda, jacobian.adjusted=TRUE) m.lambda <- update(model, y.lambda ~ ., data=local.data) llik <- logLik(m.lambda) LR <- c(2 * (object$value - llik)) df <- 1 pval <- 1-pchisq(LR, df) out <- data.frame(LRT=LR, df=df, pval=pval) rownames(out) <- c(paste("LR test, lambda = (", paste(round(lambda, 2), collapse=" "), ")", sep="")) out} # skewPower testTransform.skewpowerTransformlmer <- function(object, lambda=1){ nc <- 1 lam <- lambda val <- if(is.null(object$fix.gamma)) skewPowerlmerllikprofile.gamma(object$model, lam)$llik else{ skewPowerlmerllik(object$model, lam, object$gamma)$llik } LR <- max(0, -2 * (val - object$llik)) df <- nc 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} ########################################################################### # plot method ########################################################################### # lmerMod plot.lmerModpowerTransform <- function(x, z, round=TRUE, plot=pairs, ...){ cat("plot not supported for mixed models\n") } # skewPower plot.skewpowerTransformlmer <- function(x, z, round=TRUE, plot=pairs, ...){ cat("plot not supported for mixed models\n") } ########################################################################### ## ## skewPower with lmer objects ## ########################################################################### ## Evaluate skew lmer llik at (lambda, gamma)----------------------------------- skewPowerlmerllik <- function(object, lambda, gamma) { local.data <- model.frame(object) Y <- (object@resp)$y local.data$y1 <- skewPower(Y, lambda, jacobian.adjusted = TRUE, gamma) mod <- update(object, y1 ~ ., data=local.data) list(lambda=lambda, gamma=gamma, llik=logLik(mod)) } ## maximize skewPowerlmerllik for fixed gamma-------------------------------------- skewPowerlmerllikprofile.lambda <- function(object, gamma){ object <- object fn <- function(lam) skewPowerlmerllik(object, lam, gamma)$llik f <- optimize(f=fn, interval=c(-3, 3), maximum=TRUE) list(lambda=f$maximum, gamma=gamma, llik=f$objective, invHess=solve(-optimHess(f$maximum, fn))) } ## maximize skewPowerlmerllik for fixed lambda------------------------------------- skewPowerlmerllikprofile.gamma <- function(object, lambda){ object <- object m <- if(min((object@resp)$y) <= 0) .Machine$double.eps^0.3 else 0L fn <- function(gam) skewPowerlmerllik(object, lambda=lambda, gamma=gam)$llik f1 <- optimize(f=fn, interval=c(m, max((object@resp)$y)), maximum=TRUE) if (f1$maximum > 10*.Machine$double.eps^0.3){ hess <- try(optimHess(f1$maximum, fn)) invHess <- if(class(hess) == "try-error") NA else solve(-hess)} else invHess <- NA list(lambda=lambda, gamma=f1$maximum, llik=f1$objective, invHess=invHess, warn=if(is.na(invHess)) "Estimated gamma is too close to zero; invHess set to NA" else "none") } ## skewlmerlme ----------------------------------------------------------- # Use Nelder-Mead simplex to find the mle. This is slow, but it avoids derivatives that # cause problems when the mle of gamma is on or near to the boundary of zero. # method "Nelder-Mead" in optim does not allow box constraints, so I use the 'neldermead' # function in thneldermead implements the method of Box (1965), # M. J. Box, "A new method of constrained optimization and a comparison with other methods," # Computer J. 8 (1), 42-52 (1965); see also # http://ab-initio.mit.edu/wiki/index.php/NLopt_Algorithms#Nelder-Mead_Simplex skewlmermle <- function(object, lambda=c(-3, 3), gamma=NULL) { if(length(gamma) == 1) skewlmermle1d(object, lambda, gamma) else skewlmermle2d(object, lambda, gamma) } skewlmermle2d <- function(object, lambda=c(-3, 3), gamma) { if(!(requireNamespace("nloptr"))) stop("The 'nloptr' package is needed but is missing") # Get a starting value for lambda by removing all negative rows # and doing Box-Cox Power: mx <- if(any( (object@resp)$y <= 0)) .Machine$double.eps^0.3 else 0L data2 <- model.frame(object)[(object@resp)$y > 0, ] if(dim(data2)[2] < 1) stop("Positive responses required to get starting values") mod <- update(object, data = data2 ) lambda.start <- powerTransform(mod, family="bcPower")$lambda # Get a starting value for gamma using profiling gamma.start <- if(mx == 0L) mx else skewPowerlmerllikprofile.gamma(object, lambda.start)$gamma pnames <- c("lambda", "gamma") fn <- function(param){ lam <- param[1] gam <- param[2] skewPowerlmerllik(object, lam, gam)$llik } res <- nloptr::neldermead(c(lambda.start, gamma.start), function(param) -fn(param), lower=c(lambda[1], mx), upper=c(lambda[2], +Inf)) fit <- NULL # check for convergence fit$message <- if(res$convergence==0) "Normal convergence" else paste("Convergence likely at a boundary point, convergence code:", res$convergence) # change sign of res$value fit$par <- res$par names(fit$par) <- pnames fit$llik <- -res$value # Compute the inverse Hessian if possible using optimHess hess <- try(optimHess(res$par, fn), silent=TRUE) if(class(hess) == "try-error"){ fit$warn <- "estimate of gamma is very close to 0 -- Hessian computed for lambda only" fit$invHess <- matrix(NA, nrow=2, ncol=2) fit$invHess[1, 1] <- skewPowerlmerllikprofile.lambda(object, fit$par[2])$invHess} else{ fit$invHess <- solve(-hess) fit$fix.gamma <- NULL fit$warn <- "none" } # add names dimnames(fit$invHess) <- list(pnames, pnames) fit$ylabs <- "Y" fit$model <- object fit } # Skew power with gamma fixed, not estimated skewlmermle1d <- function(object, lambda, gamma) { pnames <- c("lambda", "gamma") res <- skewPowerlmerllikprofile.lambda(object, gamma) fit <- NULL fit$par <- c(lambda=res$lambda, gamma=gamma) fit$llik <- res$llik fit$invHess <- matrix(c(res$invHess, NA, NA, NA), nrow=2, ncol=2, dimnames = list(pnames, pnames)) names(fit$par) <- pnames fit$ylabs <- "Y" fit$model <- object fit$fix.gamma <- gamma fit } # methods for skewpowerTransform objects summary.skewpowerTransformlmer<-function(object,...){ nc <- length(object$lambda) label <- "Skew Power transformation to Normality, lmer fit\n\n" lambda <- object$lambda gamma <- object$gamma stderr <- sqrt(diag(object$invHess)) stderr.gamma <- stderr[(nc+1):(2*nc)] stderr <- stderr[1:nc] result <- cbind(lambda, stderr, lambda - 1.96*stderr, lambda + 1.96*stderr) result.gamma <- cbind(gamma, stderr.gamma, pmax(gamma - 1.96*stderr.gamma, 0), gamma + 1.96*stderr.gamma) rownames(result) <- rownames(result.gamma) <- object$ylabs colnames(result) <- colnames(result.gamma) <- c("Est.Power", "Std.Err.", "Wald Lower Bound", "Wald Upper Bound") colnames(result.gamma) <- c("Est.gamma", "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, result.gamma=result.gamma, tests=tests) class(out) <- "summary.skewpowerTransform" out } ## ------------------------------------------------------------------------ contour.skewpowerTransformlmer <- function(x, ksds=4, levels=c(.5, .95, .99, .999), main="Skew Power Log-likelihood", ...){ object <- x if(dim(object$y)[2] != 1L) stop("This function is for univariate Y only") q <- object$value - qchisq(levels, 2)/2 se <- sqrt(diag(object$invHess)) center <- c(object$lambda, object$gamma) x1 <- seq(object$lambda - ksds*se[1], object$lambda + ksds*se[1], length=100) y <- seq(max(.01, object$gamma - ksds*se[2]), object$gamma + ksds*se[2], length=100) z <- matrix(0, nrow=length(x1), ncol=length(y)) for (i in 1:length(x1)){ for (j in 1:length(y)){ z[i,j] <- skewPowerlmerllik(object, x1[i], y[j])$llik } } contour(x1, y, z, xlab=expression(lambda), ylab=expression(gamma), main=main, nlevels=length(levels), levels=q, ...) points(center[1], center[2], pch=16, cex=1.25) text(center[1], center[2], as.character(round(object$value, 2)), pos=4, cex=.75) } ########################################################################### ### boxCox method ########################################################################### # Note: # boxCox.lm works correctly with the skewPower family, so there is no separate method # lmerMod method also works with skewPower boxCox.lmerMod <- function(object, lambda = seq(-2, 2, 1/10), plotit = TRUE, interp = plotit, eps = 1/50, xlab=NULL, ylab=NULL, family="bcPower", param=c("lambda", "gamma"), gamma=NULL, grid=TRUE, ...) { param <- match.arg(param) ylab <- if(is.null(ylab)){if(family != "skewPower") "log-likelihood" else{ if(param=="gamma") {expression(max(logL[gamma](lambda,gamma)))} else {expression(max[lambda](logL(lambda, gamma)))}}} else ylab xlab <- if(is.null(xlab)){if(param == "lambda") expression(lambda) else expression(gamma)} else xlab fam <- match.fun(family) fdata <- model.frame(object) y <- (object@resp)$y fam <- match.fun(family) xl <- loglik <- if(family != "skewPower") as.vector(lambda) else { if(param == "lambda") as.vector(lambda) else { # if argument gamma is non-null, use it for the range for gamma. # if gamma is null then use the range of the mle plus or minus 3 ses if(!is.null(gamma)) as.vector(gamma) else{ p1 <- powerTransform(object, family="skewPower") gam <- p1$gamma se <- sqrt(vcov(p1)[2,2]) seq(max(.01, gam - 3*se), gam + 3*se, length=100) } } } m <- length(xl) loglik <- rep(0, m) if(family != "skewPower"){ for (i in 1L:m) { fdata$y.lambda <- fam(y, xl[i], jacobian.adjusted=TRUE) m.lambda <- update(object, y.lambda ~ ., data=fdata) loglik[i] <- c(logLik(m.lambda)) }} else{ for (i in 1L:m) { loglik[i] <- if(param == "gamma") skewPowerlmerllikprofile.lambda(object, xl[i])$llik else skewPowerlmerllikprofile.gamma(object, xl[i])$llik } } 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) } } invisible(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.R0000644000175100001440000003206512716420325013735 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 # 2014-09-04: J. Fox: empty groups produce warning rather than error # 2015-07-17: J. Fox: improved above-plot legends. # 2015-08-05: J. Fox: fixed sp() 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) } find.legend.columns <- function(n, target=min(4, n)){ rem <- n %% target if (rem != 0 && rem < target/2) target <- target - 1 target } 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], id.location="lr", 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, legend.columns, 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)){ if (missing(legend.columns)) legend.columns <- find.legend.columns(nlevels(groups)) 4 + ceiling(nlevels(groups))/legend.columns } else mar[3] if (legend.plot && !missing(legend.coords) && missing(legend.columns)){ legend.columns <- 1 } } 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) counts <- table(groups) if (any(counts == 0)){ levels <- levels(groups) warning("the following groups are empty: ", paste(levels[counts == 0], collapse=", ")) } for (i in 1:n.groups){ if (counts[i] == 0) next 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], id.location=id.location, 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], id.location=id.location)) }} 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, id.location=id.location) } 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)[counts > 0], pch=pch[counts > 0], col=col[1:n.groups][counts > 0], pt.cex=cex, cex=cex.lab, title=legend.title, bg="white", ncol=legend.columns) } 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, id.location=id.location) if (is.null(indices)) invisible(indices) else if (is.numeric(indices)) sort(indices) else indices } sp <- function(x, ...) UseMethod("scatterplot", x) car/R/Anova.R0000644000175100001440000022162012733603072012433 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 # 2014-08-17: added calls to requireNamespace() and :: where needed (doesn't work for pbkrtest). J. Fox # 2014-08-18: fixed bugs in Anova.survreg() for types II, III LR tests and Wald tests. J. Fox # 2014-09-23: added Anova.rlm(). J. Fox # 2014-10-10: removed MASS:: from calls to polr(). John # 2014-12-18: check that residual df and SS are nonzero in Anova.lm(). John # 2015-01-27: vcovAdj() and methods now imported from pbkrtest. John # 2015-02-18: force evaluation of vcov. when it's a function. John # 2015-04-30: don't allow error.estimate="dispersion" for F-tests in binomial # and Poission GLMs. John # 2015-08-29: fixed Anova() for coxph models with clusters. John # 2015-09-04: added support for coxme models. John # 2015-09-11: modified Anova.default() to work with vglm objects from VGAM. John # 2015-09-15: fixed Anova.default() so that F-tests work again. John # 2015-11-13: modify Anova.coxph() to take account of method/ties argument. John # 2016-06-03: added SSP and SSPE args to print.summary.Anova.mlm(). John # 2016-06-25: added code to optionally print univariate ANOVAs for a mlm. John #------------------------------------------------------------------------------- # 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"), vcov.=NULL, singular.ok, ...){ if (is.function(vcov.)) vcov. <- vcov.(mod) if (df.residual(mod) == 0) stop("residual df = 0") if (deviance(mod) < sqrt(.Machine$double.eps)) stop("residual sum of squares is 0 (within rounding error)") 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, ...)) } else if (!is.null(vcov.)) return(Anova.default(mod, type=type, vcov.=vcov., 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(terms(mod), "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") && error.estimate == "dispersion"){ warning("dispersion parameter estimated from the Pearson residuals, not taken as 1") error.estimate <- "pearson" } 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)), paste("Error estimate based on", switch(error.estimate, pearson="Pearson residuals", dispersion="estimated dispersion", deviance="deviance"), "\n")) 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(terms(mod), "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") && error.estimate == "dispersion"){ warning("dispersion parameter estimated from the Pearson residuals, not taken as 1") error.estimate <- "pearson" } 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(terms(mod), "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)), paste("Error estimate based on", switch(error.estimate, pearson="Pearson residuals", dispersion="estimated dispersion", deviance="deviance"), "\n")) 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(terms(mod), "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, ...) { if (!requireNamespace("MASS")) stop("MASS package is missing") which.nms <- function(name) which(asgn == which(names == name)) fac <- attr(terms(mod), "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, ...) { if (!requireNamespace("MASS")) stop("MASS package is missing") 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(terms(mod), "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=object$repeated, multivariate=TRUE, p.adjust.method, ...) { 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 } if (!object$repeated && univariate) { SS <- sapply(object$SSP, diag) SSE <- diag(object$SSPE) df <- object$df dfe <- object$error.df F <- (SS/df)/(SSE/dfe) SS <- cbind(SS, residuals=SSE) SS <- rbind(df=c(df, residuals=dfe), SS) p <- pf(F, df, dfe, lower.tail=FALSE) result <- list(SS=t(SS), F=t(F), p=t(p), type=object$type) if (!missing(p.adjust.method)){ if (isTRUE(p.adjust.method)) p.adjust.method <- "holm" p.adj <- apply(p, 2, p.adjust, method=p.adjust.method) result$p.adjust <- t(p.adj) result$p.adjust.method <- p.adjust.method } class(result) = "univaov" summary.object$univaov <- result } class(summary.object) <- "summary.Anova.mlm" summary.object } print.summary.Anova.mlm <- function(x, digits = getOption("digits"), SSP=TRUE, SSPE=SSP, ... ) { if (!is.null(x$multivariate.tests)) { cat(paste("\nType ", x$type, if (x$repeated) " Repeated Measures", " MANOVA Tests:\n", sep = "")) if ((!x$repeated) && SSPE) { 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, SSP=SSP, SSPE=FALSE, ...) } } 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) } } if (!is.null(x$univaov)){ print(x$univaov, ...) } invisible(x) } print.univaov <- function(x, digits = max(getOption("digits") - 2L, 3L), style=c("wide", "long"), by=c("response", "term"), ...){ style <- match.arg(style) if (style == "wide") { cat("\n Type", x$type, "Sums of Squares\n") print(x$SS, digits=digits) cat("\n F-tests\n") F <- x$F print(round(F, 2)) cat("\n p-values\n") p <- format.pval(x$p) p <- matrix(p, nrow=nrow(F)) rownames(p) <- rownames(F) colnames(p) <- colnames(F) print(p, quote=FALSE) if (!is.null(x$p.adjust)){ cat("\n p-values adjusted (by term) for simultaneous inference by", x$p.adjust.method, "method\n") p.adjust <- format.pval(x$p.adjust) p.adjust <- matrix(p.adjust, nrow=nrow(F)) rownames(p.adjust) <- rownames(F) colnames(p.adjust) <- colnames(F) print(p.adjust, quote=FALSE) } } else { x.df <- as.data.frame(x, by=by) x.df$F <- round(x.df$F, 2) x.df$p <- format.pval(x.df$p) if (!is.null(x$p.adjust)) x.df$"adjusted p" <- format.pval(x.df$"adjusted p") cat("\n Type", x$type, "Sums of Squares and F tests\n") print(x.df, quote=FALSE, digits=digits) } invisible(x) } as.data.frame.univaov <- function(x, row.names, optional, by=c("response", "term"), ...) { melt <- function(data, varnames = names(dimnames(data)), value.name = "value") { dn <- dimnames(data) labels <- expand.grid( dn[[1]], dn[[2]]) colnames(labels) <- varnames value_df <- setNames(data.frame(as.vector(data)), value.name) cbind(labels, value_df) } nv <- ncol(x$F) nt <- nrow(x$F) by <- match.arg(by) if (by=="response") { vn <- c("term", "response") df <- matrix(x$SS[1:nt, "df", drop=FALSE], nrow=nt, ncol=nv) SS <- melt(x$SS[1:nt, -1, drop=FALSE], varnames=vn, value.name="SS") F <- melt(x$F, varnames=vn, value.name="F") p <- melt(x$p, varnames=vn, value.name="p") if (!is.null(x$p.adjust)) p.adjust <- melt(x$p.adjust, varnames=vn, value.name="adjusted p") } else { vn <- rev(c("term", "response")) df <- t(matrix(x$SS[1:nt, "df", drop=FALSE], nrow=nt, ncol=nv)) SS <- melt(t(x$SS[1:nt, -1, drop=FALSE]), varnames=vn, value.name="SS") F <- melt(t(x$F), varnames=vn, value.name="F") p <- melt(t(x$p), varnames=vn, value.name="p") if (!is.null(x$p.adjust)) p.adjust <- melt(x$p.adjust, varnames=vn, value.name="adjusted p") } result <- cbind(SS[,c(2,1,3)], df=c(df), F=F[,"F"], p=p[,"p"]) if (!is.null(x$p.adjust)) result <- cbind(result, "adjusted p"=p.adjust[, "adjusted p"]) result } 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, ...){ if (!requireNamespace("survival")) stop("survival package is missing") 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")) method <- mod$method 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 <- survival::coxph(mod$y ~ X[, -exclude.1, drop = FALSE], method=method) loglik.1 <- logLik(mod.1) mod.2 <- if (length(rels) == 0) mod else { exclude.2 <- as.vector(unlist(sapply(rels, which.nms))) survival::coxph(mod$y ~ X[, -exclude.2, drop = FALSE], method=method) } 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, ...){ if (!requireNamespace("survival")) stop("survival package is missing") 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")) method <- mod$method 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 <- survival::coxph(mod$y ~ X[, -which.nms(names[term])], method=method) 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, ...){ if (!requireNamespace("survival")) stop("survival package is missing") dist <- mod$dist scale <- mod$call$scale weights <- model.frame(mod)$"(weights)" arg.list <- list(dist=dist) if (!is.null(scale)) arg.list$scale <- scale if (!is.null(weights)) arg.list$weights <- weights 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))) arg.list$formula <- y ~ X[, -exclude.1, drop = FALSE] mod.1 <- do.call(survival::survreg, arg.list) # mod.1 <- survival::survreg(y ~ X[, -exclude.1, drop = FALSE]) loglik.1 <- logLik(mod.1) mod.2 <- if (length(rels) == 0) mod else { arg.list$formula <- y ~ X[, -exclude.2, drop = FALSE] exclude.2 <- as.vector(unlist(sapply(rels, which.nms))) do.call(survival::survreg, arg.list) # survival::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, ...){ if (!requireNamespace("survival")) stop("survival package is missing") dist <- mod$dist scale <- mod$call$scale weights <- model.frame(mod)$"(weights)" arg.list <- list(dist=dist) if (!is.null(scale)) arg.list$scale <- scale if (!is.null(weights)) arg.list$weights <- weights 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){ arg.list$formula <- y ~ X[, -which.nms(names[term])] mod.0 <- do.call(survival::survreg, arg.list) # mod.0 <- survival::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 <- which(rownames(V) == "Log(scale)") if (length(p) > 0) V <- V[-p, -p] Anova.II.default(mod, V, test="Chisq") } Anova.III.Wald.survreg <- function(mod){ V <- vcov(mod) p <- which(rownames(V) == "Log(scale)") if (length(p) > 0) 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, ...){ if (is.function(vcov.)) vcov. <- vcov.(mod) 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)) } assignVector <- function(model){ m <- model.matrix(model) assign <- attr(m, "assign") if (!is.null(assign)) return (assign) m <- model.matrix(formula(model), data=model.frame(model)) assign <- attr(m, "assign") if (!has.intercept(model)) assign <- assign[assign != 0] assign } Anova.II.default <- function(mod, vcov., test, singular.ok=TRUE, ...){ hyp.term <- function(term){ which.term <- which(term==names) subs.term <- if (is.list(assign)) assign[[which.term]] else which(assign == which.term) relatives <- relatives(term, names, fac) subs.relatives <- NULL for (relative in relatives){ sr <- if (is.list(assign)) assign[[relative]] else which(assign == relative) subs.relatives <- c(subs.relatives, sr) } 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(terms(mod), "factors") intercept <- has.intercept(mod) p <- length(coefficients(mod)) I.p <- diag(p) assign <- assignVector(mod) # attr(model.matrix(mod), "assign") if (!is.list(assign)) assign[!not.aliased] <- NA else if (intercept) assign <- assign[-1] 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] n.terms <- n.terms - length(clusters) } } # if (inherits(mod, "plm")) assign <- assign[assign != 0] 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 <- if (test == "Chisq"){ if (length(df) == n.terms + 1) df <- df[1:n.terms] data.frame(df, teststat[!is.na(teststat)], p[!is.na(teststat)]) } else data.frame(df, teststat, p) if (nrow(result) == length(names) + 1) names <- c(names,"Residuals") row.names(result) <- names 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 <- assignVector(mod) # 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] n.terms <- n.terms - length(clusters) } } # if (inherits(mod, "plm")) assign <- assign[assign != 0] if (intercept) df[1] <- sum(grepl("^\\(Intercept\\)", names(coef(mod)))) 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 <- if (is.list(assign)) assign[[term]] else 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 <- if (test == "Chisq"){ if (length(df) == n.terms + 1) df <- df[1:n.terms] data.frame(df, teststat[!is.na(teststat)], p[!is.na(teststat)]) } else data.frame(df, teststat, p) if (nrow(result) == length(names) + 1) names <- c(names,"Residuals") row.names(result) <- names 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, ...){ if (is.function(vcov.)) vcov. <- vcov.(mod) 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, ...){ if (is.function(vcov.)) vcov. <- vcov.(mod) 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, ...){ if (is.function(vcov.)) vcov. <- vcov.(mod) 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, ...) Anova.rlm <- function(mod, ...) Anova.default(mod, test.statistic="F", ...) Anova.coxme <- function(mod, type=c("II","III", 2, 3), test.statistic=c("Wald", "LR"), ...){ type <- as.character(type) type <- match.arg(type) test.statistic <- match.arg(test.statistic) switch(type, II=switch(test.statistic, LR=Anova.II.LR.coxme(mod, ...), Wald=Anova.default(mod, type="II", test.statistic="Chisq", ...)), III=switch(test.statistic, LR=stop("type-III LR tests not available for coxme models"), Wald=Anova.default(mod, type="III", test.statistic="Chisq", ...)), "2"=switch(test.statistic, LR=Anova.II.LR.coxme(mod, ...), Wald=Anova.default(mod, type="II", test.statistic="Chisq", ...)), "3"=switch(test.statistic, LR=stop("type-III LR tests not available for coxme models"), Wald=Anova.default(mod, type="III", test.statistic="Chisq"))) } Anova.II.LR.coxme <- function(mod, ...){ if (!requireNamespace("coxme")) stop("coxme package is missing") 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) random <- mod$formulaList$random random <- sapply(random, as.character)[2, ] random <- paste(paste0("(", random, ")"), collapse=" + ") fixed <- as.character(mod$formulaList$fixed)[3] for (term in 1:n.terms){ rels <- names[relatives(names[term], names, fac)] formula <- paste0(". ~ . - ", paste(c(names[term], rels), collapse=" - "), " + ", random) mod.1 <- update(mod, as.formula(formula)) loglik.1 <- logLik(mod.1, type="integrated") mod.2 <- if (length(rels) == 0) mod else { formula <- paste0(". ~ . - ", paste(rels, collapse=" - "), " + ", random) update(mod, as.formula(formula)) } loglik.2 <- logLik(mod.2, type="integrated") 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 } car/R/RcppExports.R0000644000175100001440000000035313000763051013646 0ustar hornikusers# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 AdaptiveKernel <- function(x0, x, h) { .Call('car_AdaptiveKernel', PACKAGE = 'car', x0, x, h) } 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.R0000644000175100001440000003077112716420325012770 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 # 2014-02-16: prevent dataEllipse() from opening a graphics device when draw=FALSE (fixing bug reported by Rafael Laboissiere). # 2015-09-04: throw error if there are too few colors for groups (fixing bug reported by Ottorino Pantani). J. Fox 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)), id.location = "lr", ...) { 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) col <- col[!is.na(col)] if (length(col) < length(group.levels)) stop("too few colors for number of 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], id.location=id.location, 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)) if (draw) showLabels(x, y, labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col, id.location = id.location) 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/adaptiveKernel.R0000644000175100001440000000174513016336052014325 0ustar hornikusers# 2016-11-25: J. Fox: use pure-R code, removed compiled code. adaptiveKernel <- function(x, kernel=dnorm, bw=bw.nrd0, adjust=1.0, n=500, from, to, cut=3, na.rm=TRUE){ varname <- deparse(substitute(x)) if (na.rm) x <- na.omit(x) if (!is.numeric(bw)) bw <- bw(x) bw <- adjust*bw if (missing(from)) from <- min(x) - cut*bw if (missing(to)) to <- max(x) + cut*bw x0 <- seq(from, to, length=n) n.1 <- length(x) p <- rep(0, n) initialp.x0 <- rep(0, n) fac <- 1/(n.1*bw) for (i in 1:n) initialp.x0[i] <- fac * sum(kernel((x - x0[i])/bw)) initialp <- rep(0, n.1) for (i in 1:n.1) initialp[i] <- initialp.x0[which.min(abs(x[i] - x0))] pbar <- exp((1/n.1)*sum(log(initialp))) f <- (initialp/pbar)^-0.5 for (i in 1:n) p[i] <- fac * sum((1/f)*kernel((x - x0[i])/(f*bw))) result <- list(x=x0, y=p, n=n, bw=bw*adjust, call=match.call(), data.name=varname, has.na=FALSE) class(result) <- "density" result } 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.R0000644000175100001440000001225513014356422014473 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() # 2015-11-24: added smoother and related args to lm method. John 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, robust.line=TRUE, smoother=loessLine, smoother.args=list(), 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], col.smoother=palette()[3], lwd=2, grid=TRUE, labels, id.method = "mahal", id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], id.location="lr", ...){ 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, ...) if (is.null(smoother.args$lwd)) smoother.args$lwd <- lwd if (is.null(smoother.args$lty)) smoother.args$lty <- 2 if (is.function(smoother)) smoother(fitval, resid, col=col.smoother, log.x=TRUE, log.y=TRUE, smoother.args=smoother.args) p <- 1 - (coefficients(mod))[2] names(p) <- NULL # point identification, added 11/20/2016 if(missing(labels)) labels <- names(na.omit(residuals(x)))[!non.pos] showLabels(fitval, resid, labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col, id.location=id.location) # end addition 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.R0000644000175100001440000003241512575036204015103 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 # 2014-05-16: added .multinom method for has.intercept(). John # 2014-08-19: added package.installed() function, unexported. John # 2014-11-02: termsToMf fixed, Sandy # 2015-01-13: fixed model.matrix.lme() to work with model with formula as object. John # 2015-01-27: .carEnv now lives in the global environment. John # 2015-09-04: added model.matrix.coxme() and alias.coxme(). John # 2015-09-11: added some support for VGAM::vglm objects. John #if (getRversion() >= "2.15.1") globalVariables(c(".boot.sample", ".boot.indices")) .carEnv <- new.env(parent=globalenv()) # 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)") has.intercept.multinom <- function(model, ...) { nms <- names(coef(model)) any(grepl("\\(Intercept\\)", nms)) } 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(formula(object), 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)) } has.response <- length(formula) == 3 rhs <- if(has.response) formula[[3]] else formula[[2]] # either a single variable or '.' on the RHS if (length(rhs) == 1){ return(list(vars=formula, groups=NULL)) } if (length(rhs) != 3) stop("incorrectly formatted 'terms' argument") # check for "|", indicating grouping if(deparse(rhs[[1]] == "|")) { if(length(rhs[[3]]) > 1) stop("Only one conditioning variable is permitted") groups <- as.formula(paste("~", deparse(rhs[[3]]))) rhs <- rhs[[2]] } else groups <- NULL vars <- as.formula(paste("~ ", deparse(rhs))) 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) } # the following function isn't exported, tests for existance of a package: package.installed <- function(package){ package <- as.character(substitute(package)) result <- try(find.package(package), silent=TRUE) !class(result) == "try-error" } # support for coxme objects model.matrix.coxme <- function(object, ...){ if (!requireNamespace("survival")) stop("survival package is missing") class(object) <- "coxph" model.matrix(object) } alias.coxme <- function(model){ if(any(which <- is.na(coef(model)))) return(list(Complete=which)) else list() } # to make linearHypothesis() work again and to make Anova() work with VGAM:"vglm" objects # df.residual.vglm <- function(object, ...) object@df.residual # vcov.vglm <- function(object, ...) vcovvlm(object, ...) # coef.vglm <- function(object, ...) coefvlm(object, ...) has.intercept.vlm <- function(model, ...) any(grepl("^\\(Intercept\\)", names(coef(model)))) # formula.vglm <- function(x, ...) formulavlm(x = x, ...) # model.matrix.vglm <- function(object, ...) model.matrixvlm(object, ...) 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.R0000644000175100001440000000721512716420325014204 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 # 25 April 2016: checks na.action for compatibility with Rcmdr. SW # these functions to be rewritten; simply renamed for now leveragePlots <- function(model, terms= ~ ., layout=NULL, ask, main, ...){ # Added for compatibility with Rcmdr if(class(model$na.action) == "exclude") model <- update(model, na.action=na.omit) # End addition 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.R0000644000175100001440000003104612716420325014221 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 # 11 July 2013: wording changes # 11 July 2013: 'groups' arg for residualPlot and residualPlots. # 19 July 2014: type='rstudent' fixed # 7 October 2014: trapped error resulting from groups= when n<3 # 25 April 2016: checks for na.action=na.exclude and changes it to na.omit for compatibility with Rcmdr. sw residualPlots <- function(model, ...){UseMethod("residualPlots")} residualPlots.default <- function(model, terms= ~ . , layout=NULL, ask, main="", fitted=TRUE, AsIs=TRUE, plot=TRUE, tests=TRUE, groups, ...){ mf <- if(!is.null(terms)) termsToMf(model, terms) else NULL # Added for compatibility with Rcmdr if(class(model$na.action) == "exclude") model <- update(model, na.action=na.omit) # End addition 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] } mf <- mf$mf.vars vform <- update(formula(model), attr(mf, "terms")) if(any(is.na(match(all.vars(vform), all.vars(formula(model)))))) stop("Only regressors 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") & is.null(groups)) | 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 | !is.null(groups)) 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", groups, plot = TRUE, linear = TRUE, quadratic = if(missing(groups)) TRUE else FALSE, smoother=NULL, smoother.args=list(), col.smooth=palette()[3], labels, id.method = "r", id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], id.location="lr", col = palette()[1], col.quad = palette()[2], pch=1, xlab, ylab, lwd = 1, lty = 1, grid=TRUE, key=!missing(groups), ...) { 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)) # Added for compatibility with Rcmdr if(class(model$na.action) == "exclude") model <- update(model, na.action=na.omit) # End addition if(is.na(column) && variable != "fitted") stop(paste(variable, "is not a regressor 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) # are there groups if(!missing(groups)){ if(is.data.frame(groups)){ groups.name <- names(groups)[1] groups <- groups[, 1, drop=TRUE] } else groups.name <- deparse(substitute(groups)) groups <- if(class(groups)[1] == "factor") groups else factor(groups, ordered=FALSE) if(key){ mar3 <- 1.1 + length(levels(groups)) op <- par(mar=c(5.1, 4.1, mar3, 2.1)) on.exit(par(op)) } colors <- if(length(col) >=length(levels(groups))) col else palette() col <- colors[as.numeric(groups)] pchs <- if(length(pch) >= length(levels(groups))) pch else 1:length(levels(groups)) pch <- pchs[as.numeric(groups)] } theResiduals <- switch(type, "rstudent"=rstudent(model), "rstandard"=rstandard(model), residuals(model, type=type)) if(plot==TRUE){ 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(theResiduals, horiz, xlab=lab, ylab=ylab, labels=labels, id.method=idm, id.n=id.n, id.cex=id.cex, id.col=id.col, id.location=id.location, ...) abline(h=0, lty=2) } else { plot(horiz, theResiduals, xlab=lab, ylab=ylab, type="n", ...) if(grid){ grid(lty=1, equilogs=FALSE) box()} points(horiz, theResiduals, col=col, pch=pch, ...) if(linear){ if(missing(groups)){abline(h=0, lty=2, lwd=2)} else { for (g in 1:length(levels(groups))) try(abline(lm(theResiduals ~ horiz, subset=groups==levels(groups)[g]), lty=2, lwd=2, col=colors[g]), silent=TRUE) }} if(quadratic){ new <- seq(min(horiz), max(horiz), length=200) if(missing(groups)){ if(length(unique(horiz)) > 2){ lm2 <- lm(theResiduals ~ poly(horiz, 2)) lines(new, predict(lm2, list(horiz=new)), lty=1, lwd=2, col=col.quad) }} else { for (g in 1:length(levels(groups))){ if(length(unique(horiz)) > 2){ lm2 <- lm(theResiduals~poly(horiz, 2), subset=groups==levels(groups)[g]) lines(new, predict(lm2, list(horiz=new)), lty=1, lwd=1.5, col=colors[g]) }}}} if(is.function(smoother)) if(missing(groups)){ smoother(horiz, theResiduals, col.smooth, log.x=FALSE, log.y=FALSE, spread=FALSE, smoother.args=smoother.args)} else for (g in 1:length(levels(groups))){ sel <- groups == levels(groups)[g] smoother(horiz[sel], theResiduals[sel], colors[g], log.x=FALSE, log.y=FALSE, spread=FALSE, smoother.args=smoother.args)} if(key & !missing(groups)){ items <- paste(groups.name, levels(groups), sep= " = ") plotArrayLegend("top", items=items, col.items=colors, pch=pchs) } showLabels(horiz, theResiduals, labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col, id.location=id.location) } } 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)) }}} residCurvTest.negbin <- 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<-m2$twologlik - model$twologlik, 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.R0000644000175100001440000001071012716420325013642 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], id.location="lr", 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, id.location = id.location) 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.R0000644000175100001440000002361413014356422015637 0ustar hornikusers# Scatterplot Smoothers (J. Fox and S. Weisberg) # Sept 17, 2012 moved from scatterplot.R to scatterplotSmoothers.R # June 18, 2014 Fixed bug in gamLine so the smoother.arg link="linkname" works; thanks to Hani Christoph # 2014-08-19: Make sure that Matrix and MatrixModels packages are available to quantregLine(). # Can't substitute requireNamespace() for require() for gam and quantreg packages. John # 2014-11-21: Added 'offset' argument with default 0: offset= sigmaHat(model) for use with # marginal model plots. Fixed spread smooths as well # 2015-01-27: gam() and s() now imported from mgcv rqss(), qss(), and fitted.rqss() from quantreg. John # 2016-11-19: Added argument in smoother.args called 'evaluation'. The smoother will be evaluated # at evaluation equally spaced points in the range of the horizontal axis, with a default of 50. 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, offset=0) { 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", 2/3) family <- default.arg(smoother.args, "family", "symmetric") degree <- default.arg(smoother.args, "degree", 1) iterations <- default.arg(smoother.args, "iterations", 4) evaluation <- default.arg(smoother.args, "evaluation", 50) 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] x.eval <- seq(min(x), max(x), length=evaluation) 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"){ y.eval <- predict(fit, newdata=data.frame(x=x.eval)) y.eval <- if(log.y) exp(y.eval) else y.eval if(draw)lines(if(log.x) exp(x.eval) else x.eval, y.eval, lwd=lwd, col=col, lty=lty) else out <- list(x=if(log.x) exp(x.eval) else x.eval, y=y.eval) } 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(I(res^2) ~ x, span=span, degree=0, family=family, subset=pos, control=loess.control(iterations=1)), silent=TRUE) neg.fit <- try(loess(I(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 <- y.eval + sqrt(offset^2 + predict(pos.fit, newdata=data.frame(x=x.eval))) y.pos <- if (log.y) exp(y.pos) else y.pos if(draw) {lines(if(log.x) exp(x.eval) else x.eval, y.pos, lwd=lwd.spread, lty=lty.spread, col=col)} else {out$x.pos <- if(log.x) exp(x.eval) else x.eval out$y.pos <- y.pos} } else{ options(warn) warning("could not fit positive part of the spread") } if(class(neg.fit)[1] != "try-error"){ y.neg <- y.eval - sqrt(offset^2 + predict(neg.fit, newdata=data.frame(x=x.eval))) y.neg <- if (log.y) exp(y.neg) else y.neg if(draw) lines(x.eval, y.neg, lwd=lwd.spread, lty=lty.spread, col=col) else {out$x.neg <- if(log.x) exp(x.eval) else x.eval out$y.neg <- y.neg} } else {options(warn) warning("could 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, offset=0) { # 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) fam <- default.arg(smoother.args, "family", gaussian) link <- default.arg(smoother.args, "link", NULL) evaluation <- default.arg(smoother.args, "evaluation", 50) # June 18, 2014 fam <- if(is.character(fam)) eval(parse(text=fam)) else fam link <- if(is.character(link)) make.link(link) else link # end k <- default.arg(smoother.args, "k", -1) bs <- default.arg(smoother.args, "bs", "tp") if (is.character(family)) family <- eval(parse(text=family)) weights <- default.arg(smoother.args, "weights", NULL) spread <- spread && identical(fam, 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] x.eval <- seq(min(x), max(x), length=evaluation) w <-if (is.null(weights)) rep(1, length(y)) else weights[valid][ord] warn <- options(warn=-1) on.exit(options(warn)) # new June 18, 2014 fam1 <- if(is.null(link)) fam else fam(link) fit <- try(gam(y ~ s(x, k=k, bs=bs), weights=w, family=fam1)) # end bug fix. if (class(fit)[1] != "try-error"){ y.eval <- predict(fit, newdata=data.frame(x=x.eval)) y.eval <- if(log.y) exp(y.eval) else y.eval if(draw)lines(if(log.x) exp(x.eval) else x.eval, y.eval, lwd=lwd, col=col, lty=lty) else out <- list(x=if(log.x) exp(x.eval) else x.eval, y=y.eval) } else{ options(warn) warning("could not fit smooth") return()} if(spread) { res <- residuals(fit) pos <- res > 0 pos.fit <- try(gam(I(res^2) ~ s(x, k=k, bs=bs), subset=pos), silent=TRUE) neg.fit <- try(gam(I(res^2) ~ s(x, k=k, bs=bs), subset=!pos), silent=TRUE) if(class(pos.fit)[1] != "try-error"){ y.pos <- y.eval + sqrt(offset^2 + predict(pos.fit, newdata=data.frame(x=x.eval))) y.pos <- if (log.y) exp(y.pos) else y.pos if(draw) {lines(if(log.x) exp(x.eval) else x.eval, y.pos, lwd=lwd.spread, lty=lty.spread, col=col)} else {out$x.pos <- if(log.x) exp(x.eval) else x.eval out$y.pos <- y.pos} } else{ options(warn) warning("could not fit positive part of the spread") } if(class(neg.fit)[1] != "try-error"){ y.neg <- y.eval - sqrt(offset^2 + predict(neg.fit, newdata=data.frame(x=x.eval))) y.neg <- if (log.y) exp(y.neg) else y.neg if(draw) lines(x.eval, y.neg, lwd=lwd.spread, lty=lty.spread, col=col) else {out$x.neg <- if(log.x) exp(x.eval) else x.eval out$y.neg <- y.neg} } else {options(warn) warning("could 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, offset=0) { # if (!require("quantreg")) stop("quantreg package missing") if (!package.installed("Matrix")) stop("the Matrix package is missing") if (!package.installed("MatrixModels")) stop("the MatrixModels package is missing") if (!package.installed("SparseM")) stop("the SparseM package is 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) evaluation <- default.arg(smoother.args, "evaluation", 50) 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] x.eval <- seq(min(x), max(x), length=evaluation) if (!spread){ fit <- rqss(y ~ qss(x, lambda=lambda)) y.eval <- predict(fit, newdata=data.frame(x=x.eval)) y.eval <- if(log.y) exp(y.eval) else y.eval if(draw)lines(if(log.x) exp(x.eval) else x.eval, y.eval, lwd=lwd, col=col, lty=lty) else out <- list(x=if(log.x) exp(x.eval) else x.eval, y=y.eval) } 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) y.eval <- predict(fit, newdata=data.frame(x=x.eval)) y.eval.q1 <- predict(q1fit, newdata=data.frame(x=x.eval)) y.eval.q3 <- predict(q3fit, newdata=data.frame(x=x.eval)) y.eval <- if(log.y) exp(y.eval) else y.eval y.eval.q1 <- if(log.y) exp(y.eval.q1) else y.eval.q1 y.eval.q3 <- if(log.y) exp(y.eval.q3) else y.eval.q3 # 11/22/14: adjust for offset y.eval.q1 <- y.eval - sqrt( (y.eval-y.eval.q1)^2 + offset^2) y.eval.q3 <- y.eval + sqrt( (y.eval-y.eval.q3)^2 + offset^2) if(draw)lines(if(log.x) exp(x.eval) else x.eval, y.eval, lwd=lwd, col=col, lty=lty) else out <- list(x=if(log.x) exp(x.eval) else x.eval, y=y.eval) if(draw) lines(if(log.x) exp(x.eval) else x.eval, y.eval.q1, lwd=lwd.spread, lty=lty.spread, col=col) else {out$x.neg <- if(log.x) exp(x.eval) else x.eval out$y.neg <- y.eval.q1} if(draw) lines(if(log.x) exp(x.eval) else x.eval, y.eval.q3, lwd=lwd.spread, lty=lty.spread, col=col) else {out$x.neg <- x.eval out$y.neg <- y.eval.q3} } if(!draw) return(out) } car/R/dfbetaPlots.R0000644000175100001440000001060612716420325013635 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], id.location="lr", 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, id.location = id.location) if (length(noteworthy > 0)){ result <- data.frame(StudRes=rstud[noteworthy], Hat=hatval[noteworthy], CookD=cook[noteworthy]^2) rownames(result) <- labels[noteworthy] return(result) } else return(invisible(NULL)) } car/R/infIndexPlot.R0000644000175100001440000000523512744757245014012 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 # 15 October 13: Bug-fix on labelling x-axis # 25 April 2016: For compatibility with Rcmdr, change na.action=exclude to na.action=na.omit SW. # 2016-07-23: add ... argument to call to lines(). J. Fox 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], id.location="lr", grid=TRUE, ...) { # Added for compatibility with Rcmdr if(class(model$na.action) == "exclude") model <- update(model, na.action=na.omit) # End addition 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) nplots <- length(what) plotnum <- 0 for (j in what){ plotnum <- plotnum + 1 y <- switch(j, cooks.distance(model), rstudent(model), outlier.t.test, hatvalues(model)) 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(plotnum < nplots, FALSE, TRUE)) showLabels(xaxis, y, labels=labels, id.method=id.method, id.n=id.n, id.cex=id.cex, id.col=id.col, id.location=id.location) } mtext(side=3, outer=TRUE ,main, cex=1.2, line=1) mtext(side=1, outer=TRUE, "Index", line=3) invisible() } car/R/powerTransform.R0000644000175100001440000002246412757040415014426 0ustar hornikusers# revision history # 2009-09-16: added ... argument to print.summary.powerTransform. J. Fox # 2015-02-02: added 'gamma' argument to get transformation of (U + gamma) # 2015-08-10: added estimateTransform as a generic function # 2015-08-24: made 'family' an explicit argument to powerTransformation to clairfy man page. ### Power families: basicPower <- function(U,lambda, gamma=NULL) { if(!is.null(gamma)) basicPower(t(t(as.matrix(U) + gamma)), lambda) else{ bp1 <- function(U,lambda){ if(any(U[!is.na(U)] <= 0)) stop("First argument must be strictly positive.") if (abs(lambda) <= 1.e-6) log(U) else (U^lambda) } 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] <- bp1(out[, j],lambda[j]) colnames(out)[j] <- if(abs(lambda[j]) <= 1.e-6) paste("log(", colnames(out)[j],")", sep="") else paste(colnames(out)[j], round(lambda[j], 2), sep="^")} out} else bp1(out, lambda) out}} bcPower <- function(U, lambda, jacobian.adjusted=FALSE, gamma=NULL) { if(!is.null(gamma)) bcPower(t(t(as.matrix(U) + gamma)), lambda, jacobian.adjusted) else{ bc1 <- function(U, lambda){ if(any(U[!is.na(U)] <= 0)) stop("First argument must be strictly positive.") z <- if (abs(lambda) <= 1.e-6) log(U) else ((U^lambda) - 1)/lambda if (jacobian.adjusted == TRUE) { z * (exp(mean(log(U), 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] <- bc1(out[, j], lambda[j]) } colnames(out) <- paste(colnames(out), round(lambda, 2), sep="^") out} else bc1(out, lambda) out}} yjPower <- function(U, lambda, jacobian.adjusted=FALSE) { yj1 <- function(U, lambda){ nonnegs <- U >= 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, family="bcPower", ...) { 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, family=family, ...) } powerTransform.lm <- function(object, family="bcPower", ...) { 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, family=family, ...) } powerTransform.formula <- function(object, data, subset, weights, na.action, family="bcPower", ...) { 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, family=family, ...) } estimateTransform <- function(X, Y, weights=NULL, family="bcPower", start=NULL, method="L-BFGS-B", ...) { if(family == "skewPower") estimateTransform.skewPower(X, Y, weights, ...) else estimateTransform.default(X, Y, weights, family, start, method, ...) } # estimateTransform.default is renamed 'estimateTransform estimateTransform.default <- 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$invHess <- solve(res$hessian) res$par <- NULL res$family<-family res$xqr <- xqr res$y <- Y res$x <- as.matrix(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, jacobian.adjusted=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") lambda<-object$lambda stderr<-sqrt(diag(object$invHess)) 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 <- object$invHess 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.R0000644000175100001440000000371112461744752013067 0ustar hornikusers# Plot optimal subsets regressions -- output from regsubsets # function in leaps package # last modified 2015-01-27 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="interactive", statistic=c("bic", "cp", "adjr2", "rsq", "rss"), las=par("las"), cex.subsets=1, ...) { 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 (!is.logical(legend)){ legend(if (!is.na(charmatch(legend[1], "interactive"))) locator(1) else if (is.character(legend)) legend else if (is.numeric(legend) && length(legend == 2)) list(x=legend[1], y=legend[2]) else stop("improper legend argument"), 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/0000755000175100001440000000000013017662407013053 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.Rnw0000644000175100001440000002373012221156267015464 0ustar hornikusers\documentclass{article} \usepackage{url,Sweave} %\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/MD50000644000175100001440000002632413020235426011351 0ustar hornikusers71963103741197aac96a7df3d33c83a5 *DESCRIPTION d4ad387237a515eeaa152efb185885c9 *NAMESPACE bf0c127552d55e4e9a96723fb35f2076 *NEWS 87bc11f69ba7e55dd08f3a342e4703fc *R/Anova.R ccd8dc01996740d44efd61f3d22b1591 *R/Boot.R 25d228fd4886740292348e7b0f823f69 *R/Boxplot.R e6e27da69e618a88c9a9cc715059b7d5 *R/Contrasts.R df4b2ab25866c8b137cdd51e09bffc98 *R/Ellipse.R 608c80de9146607007c1e8f6e28fcf70 *R/RcppExports.R ac2f24e690e2aafbb5cd7a0b1454f399 *R/TransformationAxes.R ae72968ee46a9908cab8b222624ff9c1 *R/adaptiveKernel.R 192cd610e711f4b3ef1402987ef0797f *R/avPlots.R 15c155a435c33aa3b8b6d6f9c2c0c06d *R/bootCase.R 4cf1558d17c42bae683d0ac732ab5af2 *R/boxCox.R 9ee884a60458a71168caeaa9c0db0766 *R/boxCoxVariable.R 16f7207a55f8a871635b2d49fea3c422 *R/boxTidwell.R 03db7145a3647f94e1d69fde66eb56aa *R/car-deprecated.R b9e05cea8482d00fa0dd8b97b60db87c *R/carWeb.R 5a360349d8fc5d6e33412927fb923f01 *R/ceresPlots.R 37db26bd5237a5e85836c6931115b2dc *R/compareCoefs.R f78874c94b3ffd97503c323dfc121131 *R/crPlots.R 63e986ef970d63e6abcca7eb6f02115a *R/deltaMethod.R f574011e1a53ab066afe2e14113c7339 *R/densityPlot.R 35cfb4e59a62fddd8b1a1ed86d63bf5b *R/dfbetaPlots.R fc3957367225bd200be9ac6dd23e10b8 *R/durbinWatsonTest.R ffb8def1053d3971e21852803d868749 *R/hccm.R fce334dbb286082cd09a759551213d03 *R/infIndexPlot.R f2245dd1b1300dcc1c8c7bd2e8189f62 *R/influencePlot.R b3497ca1d6f154df24f14f5acfa37222 *R/invResPlot.R d95dc68830fed94a657ec14d61ae608a *R/invTranPlot.R fb408f740d16f05bd4f71144c74d078a *R/leveneTest.R 81ab866ffe3453c54a52c6ea1ae9a9c8 *R/leveragePlots.R f57164d74164cb9af485edc6ce1b45ec *R/linearHypothesis.R 1018d0332b3c63f2ee6731e444dccc61 *R/logit.R 85308af2574c7ef2e833766f288e5d9b *R/marginalModelPlot.R 31112cbf32b586d518963b006b385f3e *R/mcPlots.R 05b86f73eb0578501cba4799099c43ac *R/ncvTest.R c227f0aae0d1371c9976f87b9978faff *R/outlierTest.R fdbf7722fb6f1bfe9da6c5d176cb9cff *R/panel.car.R fc19242e1a54bdff116b1ce0b167e901 *R/powerTransform.R f1b7803e987a814c4f234c3d8961a574 *R/powerTransformlmer.R 146466441023f28d96198261c4685cec *R/qqPlot.R 68bbef9a4540d0b8e3db1e1a63a0dea5 *R/recode.R efcac7db573821da21ee4de56ac5d79e *R/regLine.R be790a137d2893bd4678d36b8e64c3d5 *R/residualPlots.R 99858851ba5c522e2c80efdfd766d48e *R/scatter3d.R 2f11b271c505b0e790da589629215140 *R/scatterplot.R 129af2fddf4fbf34be06ec3190bbe75c *R/scatterplotMatrix.R 8763318c921baf480fd256bc9150356f *R/scatterplotSmoothers.R 3aa7f4a54843bcf0a42b3bd7cd3ead3f *R/showLabels.R 24c3680c3b73eba48976557aab9ade89 *R/sigmaHat.R 0ce2ed94000173f0b36b29a8d66ea8c4 *R/skewPower.R 234146b7470fadb3a9345bf070f86478 *R/some.R 09a19e08d082c2506a50151736e5cb2a *R/spreadLevelPlot.R a849a175478d6b100f5d8402387414b7 *R/subsets.R b384a7c1d38c452095aecd402afaad4e *R/symbox.R 802d6dfac8fbeeceeb819dcd108d133f *R/utility-functions.R 7ae70543be6cf308cd380494566bac96 *R/vif.R d01087a33adaa2fc42d2351250feddc0 *R/wcrossprod.R 48a87c07f1657002a7d3be861a4cb4f0 *R/which.names.R c19ecdf27ef43a89736e2e8d6c245799 *build/vignette.rds 59b3d4f331f9936c528c7e7b2af41b22 *data/AMSsurvey.rda b9ab39fe3e4b738e75f187922ef9c1d4 *data/Adler.rda 6849f38967503ea229595cadb3ff1cd3 *data/Angell.rda 75de51af9d0d6e6a20cdba48774cb4b7 *data/Anscombe.rda f1e2a1ab779385901e2ddeebeb22290b *data/Baumann.rda 6d3e709b4c993e9ec13466853a043ac2 *data/Bfox.rda f66f66eb25b0b9f6faae1a001c98f2f5 *data/Blackmore.rda 34e4214c8e3eddd1510e1219f2ed0e0c *data/Burt.rda 899a40b0e277af8f1fa6cb5b6763abbe *data/CanPop.rda 1413443581dea9fccf87e991e8fa7228 *data/Chile.rda f303e00a464f021c7f77a6bd4e73362f *data/Chirot.rda be2fc5af9902dc40c56f8e53cf59a90e *data/Cowles.rda eabd05d22fa2728eec5aac9c8870d757 *data/Davis.rda 1b8ab9c5cc00ca798e7c93b51b720639 *data/DavisThin.rda bcda1d6ef9dd5050c77db70f971677f9 *data/Depredations.rda 7834db287b9ec90ef63533b6309b06fb *data/Duncan.rda 5069fdd96716acf51028c6f18e34c767 *data/Ericksen.rda 159dd097ce29df22932331f634213309 *data/Florida.rda 00c97c4d9249050409d24fecf06c3949 *data/Freedman.rda de03e6994c97142afb0aa42904c8171c *data/Friendly.rda 3be9617b0d11b781a4395a9517aab408 *data/Ginzberg.rda 9eea0c588c6d5e9fa90a4be167bf80aa *data/Greene.rda 2a13af630366468dd0ef2685f4d47031 *data/Guyer.rda f6a2f44dd3430b97dffdce3e6bf90cc2 *data/Hartnagel.rda ad98738d48bbea5b83a097b0d3b68083 *data/Highway1.rda bdb2a4f845a4925a91f09662f1876a12 *data/KosteckiDillon.rda da95d9abf2ed1035d3a5286daa0e46d7 *data/Leinhardt.rda fe1449d6686d30f628517509559e1974 *data/LoBD.rda 034feeb17d15a54bea137edcc77df25a *data/Mandel.rda bed045abd4a90b2e3e3f00b88f818ec1 *data/Migration.rda 65bb4e35f7d88c17a76bccd59d41eed2 *data/Moore.rda a5204c73ff83e6c3eed397ce183f811a *data/Mroz.rda 9605b3d5846ab4250fa606009a811567 *data/OBrienKaiser.rda f0f00cc387850de2dab47425c7a77740 *data/Ornstein.rda b4e7c32f895a4c7f1f6731428a137573 *data/Pottery.rda 0f96b081726ae075112d262960e59574 *data/Prestige.rda 25ff069035da6ef683b9a10c00e26733 *data/Quartet.rda ccbf14bd62b98bae292c77d759d80983 *data/Robey.rda 762c3d6063f112e9868592a3e8db0657 *data/SLID.rda 2b365e1dc0f30d3a863addcc4aa5a0ec *data/Sahlins.rda 2e1dbb62af4c01351cab9fbef1aaa638 *data/Salaries.rda 5f1bb6de7b5224b561de11c0afe3c1fc *data/Soils.rda b1d83561fb04ca9aee79a2193c12936f *data/States.rda 6b3c3d3c512b152da880b0c4abb04f83 *data/Transact.rda 4c1beafcd5d50dd4158534f5d11c3e3a *data/UN.rda 8bf665e7281c87617f3faeda8c3f05ed *data/USPop.rda 9645425870d61940d6c8ca3d110becc6 *data/Vocab.rda d860f956a92d29389930ff6f2719bd12 *data/WeightLoss.rda 252fcda65071b367b373bae047982367 *data/Womenlf.rda a23fdd9cd43c7b5f411ea34f90053b02 *data/Wong.rda ebf8c1208382e750d1bc3533bd145e2f *data/Wool.rda e58584a26bbb414d417fca2ad22f2489 *inst/CITATION b39a6f4660e0f71abf561f4c327e2646 *inst/doc/embedding.R 3235f4b3623fe042c98df9722172ef27 *inst/doc/embedding.Rnw 0a42594f54acc9e1061bdabf44a19dc4 *inst/doc/embedding.pdf ccb0b9fb2b009ce14c7647639dcd1b86 *man/AMSsurvey.Rd 0121ac092471417593ac2e32b134a883 *man/Adler.Rd 8a3ad189a7bd629bc812b28322acc5b3 *man/Angell.Rd c2e9cce98dd3ad5434dc3178bac85f6a *man/Anova.Rd 771c447ef810aecde56774754ce0c8ad *man/Anscombe.Rd 74a8a2ff389993de7fd3ee2dd155aea1 *man/Baumann.Rd f5edd689536ad670cc6c9d4baa8bc510 *man/Bfox.Rd 442a9a09eac0e177a275874880ddb481 *man/Blackmore.Rd d22e95cfbb9f548bce3d375d30e77dac *man/Boot.Rd 6773d1b64ce759e0c569f660d05cd50e *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 6aa24b0c782519d2094433b84166b3a9 *man/Depredations.Rd c029351f725834c6dd6a9aa64e82559a *man/Duncan.Rd c31631e17f37fa7441bdccdb15b75639 *man/Ellipses.Rd f3ac5e71978effb01e50fdae170a2a0c *man/Ericksen.Rd 9399873fd8d7f5b5c3c7e279fed5206c *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 a5e02f232816f43a871833b573aa2b00 *man/Highway1.Rd f4dde0b1218d7c81152776e331c8d93c *man/KosteckiDillon.Rd 4874901f99af7e039d0c9e9085051465 *man/Leinhardt.Rd 252774313aef19f3135b842d24991525 *man/LoBD.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 54b0290b62e8350d78e7af9132df8f25 *man/ScatterplotSmoothers.Rd f514919cfef794dc9dc8ef1d8e975840 *man/Soils.Rd 6a72f5912f065446466b6176544c906b *man/States.Rd 57ef59ee41f5ca245befab8abe2a248d *man/Transact.Rd ba3d6469fa429dd3c5cc56cf5ccc18bf *man/TransformationAxes.Rd 89f254635ca86b235afa8e5ff1629dd1 *man/UN.Rd c22b7b6c7509558e641260a85779cdab *man/USPop.Rd 6e561abf92e089f316e0c5043ba72ff2 *man/Vocab.Rd 3458e87631e84c9d73949e2630012f3c *man/WeightLoss.Rd 7d86575518c3e51f57109d6b4e26af6d *man/Womenlf.Rd 7d94ba17f2d85d0d47628ef7ea7d8766 *man/Wong.Rd d07c4bb3d21e156bcd28886de92bcd2c *man/Wool.Rd 7d42225c82ee94760ff315574afe2f17 *man/avPlots.Rd 94412d83f7cc7c766a0a3f7b22e7a852 *man/bcPower.Rd 7d394873b4cecd9eada7b5630233c8f2 *man/bootCase.Rd 2c47ab39e1810b984ad841d3fc71a6ec *man/boxCox.Rd 10ed4775b0c83ddc27cf772f9deee75f *man/boxCoxVariable.Rd de4255eb83dc7ff062699b63b8316d03 *man/boxTidwell.Rd ea9540069b63940fd6ffb3634ff4b05d *man/car-deprecated.Rd e636a003e6e0c4009e728c0f57af8e9c *man/car-internal.Rd f478ae3edf99457454327220f91aea8b *man/car-package.Rd 94f2797f81c5989877684857b49e6c02 *man/carWeb.Rd dd17ca3c85d3a0a5e2eca03663c664c4 *man/ceresPlots.Rd 398a2e3f449600419a47d4a994a32aa5 *man/compareCoefs.Rd 38d56a434a4f3d38982c613ab8c96dca *man/crPlots.Rd 3cc4a186a7414be6634529f7296dfbe2 *man/deltaMethod.Rd 686e97dcc4b6753fddd97ad3e683ee73 *man/densityPlot.Rd b04acac2dc07d6aa8a3ad039d305d114 *man/dfbetaPlots.Rd f81d7bb90460ef0ad7d0a773b5fc172a *man/durbinWatsonTest.Rd 740a9e130900639b06d55e6fc79b3a2a *man/hccm.Rd 6b24dda7bb9e6d4895fe24a545afa215 *man/hist.boot.Rd 281916489d212720a33454c163fc142f *man/infIndexPlot.Rd 9f0e6b3e38d36b568239888186453154 *man/influencePlot.Rd 2e0bb236c30c758cdd838b1d678f919a *man/invResPlot.Rd 95ef9b522e93615c7dd729cd88f6c5ea *man/invTranPlot.Rd 5b098563c8b52d0de147596a7348b649 *man/leveneTest.Rd aa2a3917a65b30341ef405b83d855a5f *man/leveragePlots.Rd bd60c9491b67152e80d09ed7d4543b65 *man/linearHypothesis.Rd 7f6774c46aec762888f3ffc7fad4a48a *man/logit.Rd fad7c3e1d3357bd602dda5adce6cf74b *man/marginalModelPlot.Rd 51e62238541f6f121868503d83ac75bf *man/mcPlots.Rd 9e3a7d9b871e183d1d80c3b308afb01d *man/ncvTest.Rd 10e5b7467250764a26484aa0326cc1db *man/outlierTest.Rd 8c6c6b497220550385ebd3a4dbfa5dea *man/panel.car.Rd a53eee6827069e9da95a24bd934fff76 *man/plot.powerTransform.Rd 0326c0284ef0595c72a7568cf6962947 *man/powerTransform.Rd 7ce027b1905aeb47eac0c8a83c7fd51f *man/qqPlot.Rd d8e8f638b17ef59f0e5213897dc0a8fc *man/recode.Rd 28b9888be6dd64f37a2e388a9fdf4a4e *man/regLine.Rd 8bb17e8b5f391d44bc3ff6160af0f505 *man/residualPlots.Rd d0cc25c8632014a55ad358512ed93986 *man/scatter3d.Rd 17219714957d011edd1d4bdc912e25d3 *man/scatterplot.Rd 3a8634896133cc7be89dc6ab042e6e53 *man/scatterplotMatrix.Rd 0af7db901b10cc35b17970703ad5754d *man/showLabels.Rd ecf14f5f34a04bc4360e333508c78588 *man/sigmaHat.Rd 1ee07e538d87825a32d65ece8567486d *man/skewPower.Rd f98d9936887336d48326805f2c201d70 *man/some.Rd 8788adb911ec5f977b8aa59ed1ac9bc0 *man/spreadLevelPlot.Rd a28e98c0a1b8db8d9442da17076b357b *man/subsets.Rd 0f04a7c53fee398f8bf641b5af8ea2e2 *man/symbox.Rd bde461d74c5e99692411a4e48ad06f26 *man/testTransform.Rd a94fa53fa70ee03310e3a41dbcdd0b98 *man/vif.Rd 011d77213781e258f477d119df9a60f9 *man/wcrossprod.Rd 86e4112f8dae970e327228c049eaadf2 *man/which.names.Rd 3235f4b3623fe042c98df9722172ef27 *vignettes/embedding.Rnw 6b07f76684a6bc62752b6afdc196ccf2 *vignettes/embedding.bib car/build/0000755000175100001440000000000013017662407012142 5ustar hornikuserscar/build/vignette.rds0000644000175100001440000000033313017662407014500 0ustar hornikusersuQ0  Q0$&W/|MNVA7\, 6i%RS`o bO p.5eBOX姍LjQH Q0yߵ'#QK,sR,2$FQV{E5rf5PcE"qQԟ =ѐLSm0qС&S.g5 'dcar/DESCRIPTION0000644000175100001440000000477713020235426012557 0ustar hornikusersPackage: car Version: 2.1-4 Date: 2016-11-30 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("David", "Winsemius", role="ctb"), person("Achim", "Zeileis", role = "ctb"), person("R-Core", role="ctb")) Depends: R (>= 3.2.0) Imports: MASS, mgcv, nnet, pbkrtest (>= 0.4-4), quantreg, grDevices, utils, stats, graphics Suggests: alr4, boot, coxme, leaps, lme4, lmtest, Matrix, MatrixModels, nlme, rgl (>= 0.93.960), sandwich, SparseM, survival, survey, nloptr ByteCompile: yes LazyLoad: yes LazyData: yes Description: Functions and Datasets to Accompany 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/, https://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], David Winsemius [ctb], Achim Zeileis [ctb], R-Core [ctb] Maintainer: John Fox Repository: CRAN Repository/R-Forge/Project: car Repository/R-Forge/Revision: 467 Repository/R-Forge/DateTimeStamp: 2016-11-30 23:29:33 Date/Publication: 2016-12-02 10:12:54 NeedsCompilation: no Packaged: 2016-11-30 23:47:19 UTC; rforge car/man/0000755000175100001440000000000013017662127011615 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.Rd0000644000175100001440000002151212716420325015514 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, draw a plot of the response on the vertical axis versus a linear combination \eqn{u} of regressors in the mean function on the horizontal axis. Added to the plot are a smooth for the graph, along with a 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], id.location="lr", 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], id.location="lr", 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 term 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)}. It 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 regressor or predictor while the \code{mmps} function can be used only to get marginal model plots for the first-order regressors 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}, display 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 described 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,id.location}{Arguments for labeling points. The default \code{id.n=0} suppresses labeling, and setting this argument greater than zero will include labeling. 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 regressors) 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 for \code{X2} 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{ Cook, R. D., & Weisberg, S. (1997). Graphics for assessing the adequacy of regression models. \emph{Journal of the American Statistical Association}, 92(438), 490-499. 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 8.4. } \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) # condition on type: mmps(p1, ~. | type) # logisitic regression example # smoothers return warning messages. # 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.Rd0000644000175100001440000000544412757040415014220 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. (2014) \emph{Applied Linear Regression}, Fourth 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.Rd0000644000175100001440000001203012716420325013523 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], id.location="lr", 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,id.location}{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.Rd0000644000175100001440000002431612716420325014741 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, groups, ...) \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", groups, plot = TRUE, linear = TRUE, quadratic = if(missing(groups)) TRUE else FALSE, smoother=NULL, smoother.args=list(), col.smooth=palette()[3], labels, id.method = "r", id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], id.location="lr", col = palette()[1], col.quad = palette()[2], pch=1, xlab, ylab, lwd = 1, lty = 1, grid=TRUE, key=!missing(groups), ...) \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}, 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. A grouping variable can also be specified in the terms, so, for example \code{terms= ~ .|type} would use the factor \code{type} to set a different color and symbol for each level of \code{type}. Any fits in the plots will also be done separately for each level of group. } \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{groups}{A list of group indicators. Points in different groups will be plotted with different colors and symbols. If missing, no grouping. In \code{residualPlots}, the grouping variable can also be set in the \code{terms} argument, as described above. The default is no grouping. } \item{linear}{If \code{TRUE}, adds a horizontal line at zero if no groups. With groups, display the within level of groups ols regression of the residuals as response and the horizontal axis as the regressor. } \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} or if \code{groups} not missing. } \item{smoother}{the name of the smoother to use, selected from the choices described 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 if groups missing, and ignored if groups is set. } \item{id.method,labels,id.n,id.cex,id.col,id.location}{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. If groups is set, col can abe a list at least as long as the number of levels for groups giving the colors for each groups. } \item{col.quad}{ default color for quadratic fit if groups is missing. Ignored if groups are used. } \item{pch}{plotting character. The default is pch=1. If groups are used, pch can be set to a vector at least as long as the number of groups. } \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} \item{key}{Should a key be added to the plot? Default is \code{!is.null(groups)}. } } \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, no curvature test is computed, and grouping is ignored. 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}. If grouping is used curvature tests are not displayed. \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. (2014) \emph{Applied Linear Regression}, Fourth Edition, Wiley, Chapter 8} \author{Sanford Weisberg, \email{sandy@umn.edu}} \seealso{See Also \code{\link{lm}}, \code{\link{identify}}, \code{\link{showLabels}} } \examples{ m1 <- lm(prestige ~ income, data=Prestige) residualPlots(m1) residualPlots(m1, terms= ~ 1 | type) # plot vs. yhat grouping by type } \keyword{ hplot }% at least one, from doc/KEYWORDS \keyword{ regression }% __ONLY ONE__ keyword per line car/man/subsets.Rd0000644000175100001440000000572112461744752013610 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="interactive", 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}{If not \code{FALSE}, in which case the legend is suppressed, the coordinates at which to place a legend of the abbreviated predictor names on the plot, in a form recognized by the \code{\link{legend}} function. If \code{"interactive"}, 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 (require(leaps)){ subsets(regsubsets(undercount ~ ., data=Ericksen), legend=c(3.5, -37)) } } \keyword{hplot} \keyword{regression} car/man/dfbetaPlots.Rd0000644000175100001440000000764312716420325014362 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], id.location="lr", 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], id.location="lr", 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,id.location}{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.Rd0000644000175100001440000000320412757040415016110 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. (2014) \emph{Applied Linear Regression}, Fourth 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, shld, sigs1) ~ 1, Highway1)) with(Highway1, plot(a3, z=rate, col=as.numeric(htype))) } % 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.Rd0000644000175100001440000001317312716420325013366 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], id.location="lr", 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], id.location="lr", 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{id.location}{The default \code{"lr"} identifies to the left or right of the point; the alterative \code{"ab"} identifies above or below the point.} \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. When plotting a vector, the confidence envelope is based on the SEs of the order statistics of an independent random sample from the comparison distribution (see Fox, 2008). Studentized residuals from linear models are plotted against the appropriate t-distribution with a point-wise confidence envelope computed by default by a parametric bootstrap, as described by Atkinson (1985). 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.Rd0000644000175100001440000001110412716420325014356 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], id.location="lr", 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,id.location}{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. (2014) \emph{Applied Linear Regression}, Fourth Edition, Wiley 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.Rd0000644000175100001440000000222412462213521013455 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 \samp{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/KosteckiDillon.Rd0000644000175100001440000000400212411037444015011 0ustar hornikusers\name{KosteckiDillon} \alias{KosteckiDillon} \docType{data} \title{Treatment of Migraine Headaches} \description{ Subset of data on migraine treatments collected by Tammy Kostecki-Dillon. } \usage{KosteckiDillon} \format{ A data frame with 4152 observations on 133 subjects for the following 9 variables. \describe{ \item{\code{id}}{Patient id.} \item{\code{time}}{time in days relative to the onset of treatment, which occurs at time 0.} \item{\code{dos}}{time in days from the start of the study, January 1 of the first year of the study.} \item{\code{hatype}}{a factor with levels \code{Aura} \code{Mixed} \code{No Aura}, the type of migraine experienced by a subject.} \item{\code{age}}{at onset of treatment, in years.} \item{\code{airq}}{a measure of air quality.} \item{\code{medication}}{a factor with levels \code{none} \code{reduced} \code{continuing}, representing subjects who discontinued their medication, who continued but at a reduced dose, or who continued at the previous dose.} \item{\code{headache}}{a factor with levels \code{no} \code{yes}.} \item{\code{sex}}{a factor with levels \code{female} \code{male}.} } } \details{ The data consist of headache logs kept by 133 patients in a treatment program in which bio-feedback was used to attempt to reduce migraine frequency and severity. Patients entered the program at different times over a period of about 3 years. Patients were encouraged to begin their logs four weeks before the onset of treatment and to continue for one month afterwards, but only 55 patients have data preceding the onset of treatment. } \source{ Personal communication from Georges Monette (and adapted from his description of the data). } \references{ Kostecki-Dillon, T., Monette, G., and Wong, P. (1999). Pine trees, comas, and migraines. \emph{York University Institute for Social Research Newsletter}, 14:2. } \examples{ summary(KosteckiDillon) } \keyword{datasets} car/man/ScatterplotSmoothers.Rd0000644000175100001440000001521713014356422016315 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 several other \code{car} functions. The functions are not 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, offset=0) loessLine(x, y, col, log.x, log.y, spread=FALSE, smoother.args, draw=TRUE, offset=0) quantregLine(x, y, col, log.x, log.y, spread=FALSE, smoother.args, draw=TRUE, offset=0) } \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 function. If this argument is TRUE, then a measure of spread is also plotted.} \item{smoother.args}{additional options accepted 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.} \item{offset}{For use when \code{spread=TRUE}, the vertical axis is \code{sqrt(offset^2 + variance smooth)}.} } \details{ The function \code{loessLine} is a re-implementation of the \code{loess} smoother that was used in \code{car} prior to September 2012. The main enhancement is the ability to set more arguments through the \code{smoother.args} argument. The function \code{gamLine} is more general than the \code{loess} fitting because it allows fitting a generalized additive model using splines. You can specify an error distribution and link function. The function \code{quantregLine} fits an additive model using splines with estimation based on L1 regression for the median 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. As of November, 2016, the smoother is evaluated at an equally spaced grid of 50 points in the range of the horizontal variable. With any of the smoothers you can change to say 100 evaluation points by using the argument \code{smoother.args=list(evaluation=100)}. For \code{loessLine} the default value is \code{smoother.args=list(lty=1, lwd=2, lty.spread=2, lwd.spread=1, span=2/3 (prior to 11/2016, span was 1/2), 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=4} 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 four 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. The spread argument is ignored unless family="gaussian" and link=NULL. 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))) y <- rbinom(100, w, p) scatterplot(y/w ~ x, smoother=gamLine, smoother.args=list(family="binomial", weights=w)) scatterplot(y/w ~ x, smoother=gamLine, smoother.args=list(family=binomial, link="probit", weights=w)) scatterplot(y/w ~ x, smoother=gamLine, smoother.args=list(family=binomial, link="probit", weights=w)) scatterplot(y/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/mcPlots.Rd0000644000175100001440000001647212730011120013515 0ustar hornikusers\name{mcPlots} \alias{mcPlots} \alias{mcPlot} \alias{mcPlot.lm} \title{Draw Linear Model Marginal and Conditional Plots in Parallel or Overlaid} \description{ the \code{mcPlot} function draws two plots, or overlay the two graphs on one plot. For a response Y and a regressor X, the first plot is the \emph{m}arginal plot of Y versus X with both variables centered, visualizing the conditional distribution of Y given X ignoring all other regressors. The second plot is an added-variable for X after all other regressors, visualizing the \emph{c}onditional distribution of Y given X after adjusting for all other predictors. The added variable plot by default is drawn using the same xlim and ylim as the centered marginal plot to emphasize that conditioning removes variation in both the regressor and the response.The plot is primarily intended as a pedagogical tool for understanding coefficients in first-order models. } \usage{ mcPlots(model, terms=~., layout=NULL, ask, overlaid=TRUE, ...) mcPlot(model, ...) \method{mcPlot}{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], id.location="lr", col.marginal="blue", col.conditional="red", col.arrows="gray", pch = c(16, 1), lwd = 2, grid=TRUE, ###removed arg main ellipse=FALSE, ellipse.args=list(levels=0.5), overlaid=TRUE, new=TRUE, ...) } \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 numeric predictor and for each basis function used to define a factor. 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{variable}{A quoted string giving the name of a numeric predictor in the model matrix for the horizontal axis. To plot against a factor, you need to specify the full name of one of the indicator variables that define the factor. For example, for a factor called \code{type} with levels \code{A}, \code{B} and {C}, using the usual drop-first level parameterization of the factor, the regressors for \code{type} would be \code{typeB} or \code{typeC}. } \item{layout}{ If set to a value like \code{c(1, 2)} or \code{c(6, 2)}, the layout of the graph will have this many rows and columns. If not set, behavior depends on the value of the \code{overlaid} argument; see the details } \item{ask}{If \code{TRUE}, ask the user before drawing the next plot; if \code{FALSE} don't ask. } \item{\dots}{\code{mcPlots} passes these arguments to \code{mcPlot}. \code{mcPlot} passes arguments to \code{plot}. } \item{id.method,labels,id.n,id.cex,id.col,id.location}{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{overlaid}{If TRUE, the default, overlay the marginal and conditional plots on the same graph; otherwise plot them side-by-side. See the details below} \item{col.marginal, col.conditional}{colors for points, lines, ellipses in the marginal and conditional plots, respectively} \item{col.arrows}{color for the arrows with \code{overlaid=TRUE}} \item{pch}{Plotting character for marginal and conditional plots, respectively.} \item{lwd}{line width; default is \code{2} (see \code{\link[graphics]{par}}).} \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.} \item{new}{if \code{TRUE}, the default, the plot window is reset when \code{overlaid=FALSE} using \code{par{mfrow=c(1, 2)}}. If \code{FALSE}, the layout of the plot window is not reset. Users will ordinarily ignore this argument.} } \details{ With an \code{lm} object, suppose the response is Y, X is a focal numeric predictor of interest, and Z is all the remaining predictors, possibly including interactions and factors. This function produces two graphs. The first graph is the marginal plot of Y versus X, with each variable centered around its mean. The second conditional plot is the added-variable plot of e(Y|Z) versus e(X|Z) where e(a|b) means the Pearson residuals from the regression of a on b. If \code{overlaid=TRUE}, these two plots are overlaid in one graph, with the points in different colors. In addition, each point in the marginal plot is joined to its value in the conditional plot by an arrow. Least squares regression lines fit to the marginal and conditional graphs are also shown; data ellipsoids can also be added. If \code{overlaid=FALSE}, then the two graphs are shown in side-by-side plots as long as the second argument to \code{layout} is equal to \code{2}, or \code{layout} is set by the function. The arrows are omitted if the graphs are not overlaid. These graphs are primarily for teaching, as the marginal plot shows the relationship between Y and X ignoring Z, while the conditional is the relationship between Y and X given X. By keeping the scales the same in both graphs the effect of conditioning on both X and Y can be visualized. This function is intended for first-order models with numeric predictors only. If the focal predictor is a factor, then one (pair) of mcPlots will be produced for each of the basis variables that define the factor, and the resulting plots are not generally meaningful because they depend on parameterization. If the mean function includes interactions, then mcPlots for main effects may violate the hierarchy principle, and may also be of little interest. mcPlots for interactions of numerical predictors, however, can be useful. These graphs are closely related to the ARES plots proposed by Cook and Weisberg (1989). This plot would benefit from animation. } \value{ These functions are used for their side effect of producing plots. } \references{ Cook, R. D. and Weisberg, S. (1989) \emph{Regression diagnostics with dynamic graphics,} Technometrics, 31, 277. Fox, J. (2016) \emph{Applied Regression Analysis and Generalized Linear Models}, Third Edition. Sage. Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Weisberg, S. (2014) \emph{Applied Linear Regression}, Fourth 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{ceresPlots}}, \code{\link{dataEllipse}} } \examples{ m1 <- lm(partic ~ tfr + menwage + womwage + debt + parttime, data = Bfox) mcPlot(m1, "womwage") mcPlot(m1, "womwage", overlaid=FALSE, ellipse=TRUE) } \keyword{hplot} \keyword{regression} car/man/Anova.Rd0000644000175100001440000004402312733603072013151 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 % 2014-08-09: added vcov. argument to Anova.lm(). J. Fox % 2014-09-23: added Anova.rlm(). J. Fox % 2015-02-18: updated info about when Anova.default() works. J. Fox % 2015-09-04: added Anova.coxme(). J. Fox % 2016-06-03: added SSP and SSPE arguments to print.summary.ANova.mlm(). J. Fox % 2016-06-25: provision to print univariate ANOVAs for a mlm. 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{print.univaov} \alias{as.data.frame.univaov} \alias{Anova.coxph} \alias{Anova.svyglm} \alias{Anova.rlm} \alias{Anova.coxme} \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{coxme} (in the \pkg{coxme} pckage), \code{svyglm} (in the \pkg{survey} package), \code{rlm} (in the \pkg{MASS} package), \code{lmer} in the \pkg{lme4} package, \code{lme} in the \pkg{nlme} package, and (by the default method) for most models with a linear predictor and asymptotically normal coefficients (see details below). 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"), vcov.=NULL, 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=object$repeated, multivariate=TRUE, p.adjust.method, ...) \method{print}{summary.Anova.mlm}(x, digits = getOption("digits"), SSP=TRUE, SSPE=SSP, ... ) \method{print}{univaov}(x, digits = max(getOption("digits") - 2L, 3L), style=c("wide", "long"), by=c("response", "term"), ...) \method{as.data.frame}{univaov}(x, row.names, optional, by=c("response", "term"), ...) \method{Anova}{coxph}(mod, type=c("II", "III", 2, 3), test.statistic=c("LR", "Wald"), ...) \method{Anova}{coxme}(mod, type=c("II", "III", 2, 3), test.statistic=c("Wald", "LR"), ...) \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}{rlm}(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{coxme}, \code{lme}, \code{mer}, \code{merMod}, \code{svyglm}, \code{rlm}, 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 or Cox mixed-effects 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"}); or base the dispersion estimate on the residual deviance (\code{"deviance"}). For binomial or Poisson GLMs, where the dispersion is fixed to 1, setting \code{error.estimate="dispersion"} is changed to \code{"pearson"}, with a warning.} \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}{For \code{Anova} for a multivariate linear model, the error sum-of-squares-and-products matrix; if missing, will be computed from the residuals of the model; for the \code{print} method for the \code{summary} of an \code{Anova} of a multivariate linear model, whether or not to print the error SSP matrix (defaults to \code{TRUE}).} \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{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 or multivariate linear model; the default is \code{TRUE} for both for repeated measures and \code{TRUE} for \code{multivariate} for a multivariate linear model.} \item{p.adjust.method}{if given for a multivariate linear model when univariate tests are requested, the univariate tests are corrected for simultaneous inference by term; if specified, should be one of the methods recognized by \code{\link{p.adjust}} or \code{TRUE}, in which case the default (Holm) adjustment is used.} \item{digits}{minimum number of significant digits to print.} \item{style}{for printing univariate tests if requested for a multivariate linear model; one of \code{"wide"}, the default, or \code{"long"}.} \item{by}{if univariate tests are printed in \code{"long"} \code{style}, they can be ordered \code{by} \code{"response"}, the default, or by \code{"term"}.} \item{row.names, optional}{not used.} \item{vcov.}{in the \code{default} method, an optional coefficient-covariance matrix or function to compute a covariance matrix, computed by default by applying the generic \code{vcov} function to the model object. A similar argument may be supplied to the \code{lm} method, and the default (\code{NULL}) is to ignore the argument; if both \code{vcov.} and \code{white.adjust} are supplied to the \code{lm} method, the latter is used.} \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. If univariate tests are requested for the \code{summary} of a multivariate linear model, the object returned contains a \code{univaov} component of \code{"univaov"}; \code{print} and \code{as.data.frame} methods are provided for the \code{"univaov"} class. For the default method to work, the model object must contain a standard \code{terms} element, and must respond to the \code{vcov}, \code{coef}, and \code{model.matrix} functions. If any of these requirements is missing, then it may be possible to supply it reasonably simply (e.g., by writing a missing \code{vcov} method for the class of the model object). } \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) summary(Anova(soils.mod), univariate=TRUE, multivariate=FALSE, p.adjust.method=TRUE) ## 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.Rd0000644000175100001440000000315412475362700014006 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. See \url{http://www.ams.org/profession/data/annual-survey/docsgrtd} for more recent 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.Rd0000644000175100001440000000440612337441764012702 0ustar hornikusers\name{vif} \alias{vif} \alias{vif.default} \title{Variance Inflation Factors} \description{ Calculates variance-inflation and generalized variance-inflation factors for linear and generalized linear models. } \usage{ vif(mod, ...) \method{vif}{default}(mod, ...) } \arguments{ \item{mod}{an object that responds to \code{\link{coef}}, \code{\link{vcov}}, and \code{\link{model.matrix}}, 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. } \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.Rd0000644000175100001440000000150712270214610013654 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. (2014) \emph{Applied Linear Regression}, Fourth 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.Rd0000644000175100001440000001334413014356422015211 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, smoother=loessLine, smoother.args=list(), 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], col.smoother=palette()[3], lwd=2, grid=TRUE, labels, id.method = "mahal", id.n = if(id.method[1]=="identify") Inf else 0, id.cex=1, id.col=palette()[1], id.location="lr", ...) \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{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{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{col.smoother}{color for smooth line; default is third 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{id.method,labels,id.n,id.cex,id.col,id.location}{Arguments for the labelling of points. The default is \code{id.n=0} for labeling no points with the \code{lm} method. See \code{\link{showLabels}} for details of these arguments. } \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). Point labeling was added in November, 2016. 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/Blackmore.Rd0000644000175100001440000000150712402360321013772 0ustar hornikusers\name{Blackmore} \alias{Blackmore} \docType{data} \title{Exercise Histories of Eating-Disordered and Control Subjects} \usage{Blackmore} \description{ The \code{Blackmore} data frame has 945 rows and 4 columns. Blackmore 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 Blackmore and Caroline Davis, York University. } \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.Rd0000644000175100001440000000242413017660335014243 0ustar hornikusers\name{car-package} \alias{car-package} \alias{car} \docType{package} \title{ Companion to Applied Regression } \description{ Functions and Datasets to Accompany J. Fox and S. Weisberg, An R Companion to Applied Regression, Second Edition, Sage, 2011. } \details{ \tabular{ll}{ Package: \tab car\cr Version: \tab 2.1-4\cr Date: \tab 2016-11-30\cr Depends: \tab R (>= 3.2.0)\cr LinkingTo: \tab Rcpp\cr Imports: \tab MASS, mgcv, nnet, pbkrtest (>= 0.3-2), quantreg, grDevices, utils, stats, graphics, Rcpp\cr Suggests: \tab alr4, boot, leaps, lme4, lmtest, Matrix, MatrixModels, mgcv, nlme, rgl (>= 0.93.960), sandwich, SparseM, survival, survey\cr License: \tab GPL (>= 2)\cr URL: \tab \url{https://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.Rd0000644000175100001440000000531512462213521013172 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. Originally from \samp{http://www.stat.lsu.edu/faculty/moser/exst7037/soils.sas} but no longer available there. } \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.Rd0000644000175100001440000000604312757040415014762 0ustar hornikusers\name{testTransform} \alias{testTransform} \alias{testTransform.powerTransform} \alias{testTransform.lmerModpowerTransform} \alias{testTransform.skewpowerTransformlmer} \title{Likelihood-Ratio Tests for Univariate or Multivariate Power Transformations to Normality} \description{ \code{testTransform} computes likelihood ratio tests for particular values of the power parameter based on \code{powerTransform} objects. } \usage{ testTransform(object, lambda) \S3method{testTransform}{powerTransform}(object, lambda=rep(1, dim(object$y)[2])) \S3method{testTransform}{lmerModpowerTransform}(object, lambda=1) \S3method{testTransform}{skewpowerTransformlmer}(object, lambda=1) } \arguments{ \item{object}{An object created by a call to \code{estimateTransform} or \code{powerTransform}.} \item{lambda}{A vector of responses 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-type estimate. For one-parameter families of transformations, namely the Box-Cox power family \code{link{bcPower}} and the Yeo-Johnson power family \code{\link{yjPower}}, this function computes a test based on twice the difference in the log-likelihood between the maximum likelihood-like estimate and the log-likelihood evaluated at the value of \code{lambda} specified. For the skew power family, the test is based on the profile loglikelihood maximizing over the location (or start) parameter \code{gamma}. Thus, the start parameter is treated as a nusiance parameter.} \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. (2014) \emph{Applied Linear Regression}, Fourth Edition, Wiley. } \author{ Sanford Weisberg, } \seealso{\code{\link{powerTransform}} and \code{\link{skewPower}} for examples of the use of this function and other tests that might be of interest in some circumstances. } \examples{ summary(a3 <- powerTransform(cbind(len, adt, trks, sigs1) ~ htype, 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.Rd0000644000175100001440000001201612716420325014224 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], id.location="lr", 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,id.location}{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. (2014) \emph{Applied Linear Regression}, Fourth 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.Rd0000644000175100001440000000777712716420325014737 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], id.location="lr", 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,id.location}{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.Rd0000644000175100001440000001357212757040415013356 0ustar hornikusers\name{boxCox} \alias{boxCox} \alias{boxCox.lm} \alias{boxCox.default} \alias{boxCox.formula} \alias{boxCox.skewpowerTransform} \alias{boxCox.lmerMod} \title{ Box-Cox Transformations for Linear Models } \description{ Computes and optionally plots profile log-likelihoods for the parameter of the Box-Cox power family, the Yeo-Johnson power family, or for either of the parameters in a skew power family. 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, eps = 1/50, xlab=NULL, ylab=NULL, family="bcPower", param=c("lambda", "gamma"), gamma=NULL, grid=TRUE, ...) \method{boxCox}{formula}(object, lambda = seq(-2, 2, 1/10), plotit = TRUE, ...) \method{boxCox}{lm}(object, lambda = seq(-2, 2, 1/10), plotit = TRUE, ...) \method{boxCox}{lmerMod}(object, lambda = seq(-2, 2, 1/10), plotit = TRUE, interp = plotit, eps = 1/50, xlab=NULL, ylab=NULL, family="bcPower", param=c("lambda", "gamma"), gamma=NULL, grid=TRUE, ...) } \arguments{ \item{object}{ a formula or fitted model object of class \code{lm} or \code{aov} or \code{lmerMod}. } \item{lambda}{ vector of values of \eqn{\lambda}{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"} or \code{"gamma"}. } \item{ylab}{ defaults to \code{"log-Likelihood"} or for skewPower family to the appropriate label. } \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. If set to \code{skewPower} the function gives the profile log-likelihood for the parameter selected via \code{param}. } \item{param}{Relevant only to \code{family="skewPower"}, produces a profile log-likelihood for the parameter selected, maximizing over the remaining parameter.} \item{gamma}{ For use when the \code{family="skewPower", param="gamma"}. If this is a vector of positive values, then the profile log-likelihood for the location (or start) parameter in the skew power family is evaluated at these values of gamma. If gamma is \code{NULL}, then evaulation is done at 100 equally spaced points between \code{min(.01, gmax - 3*se)} and \code{gmax + 3*se}, where \code{gmax} is the maximimul likelihood estimate of gamma, and \code{se} is its estimated standard error. See \code{\link{skewPower}} for the definition of \code{gamma}. } \item{grid}{If TRUE, the default, a light-gray background grid is put on the graph. } \item{\dots}{ passes arguments from methods to the default, or from the default to \code{plot}. } } \details{ This routine is an elaboration of the \code{\link{boxcox}} function in the \pkg{MASS} package. The first 7 arguments are the same as in \code{boxcox}, and if the argument \code{family="bcPower"} is used, the result is essentially identical to the function in \pkg{MASS}. Two additional families are the \code{yjPower} and \code{skewPower} families that allow a few values of the response to be non-positive. The skew power family has two parameters: a power \eqn{\lambda}{lambda} and a start or location parameter \eqn{\gamma}{gamma}, and this function can be used to obtain a profile log-likelihood for either parameter with \eqn{\lambda}{lambda} as the default. } \value{ A list of the lambda (or possibly, gamma) 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. Hawkins, D. and Weisberg, S. (2015) Combining the Box-Cox Power and Genralized Log Transformations to Accomodate Negative Responses, submitted for publication. Weisberg, S. (2014) \emph{Applied Linear Regression}, Fourth 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{skewPower}}, \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.Rd0000644000175100001440000004535312735134230015443 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 % 2014-04-23 added aliases for makeHypothesis and printHypothesis % 2014-08-23 added linearHypothesis.rlm. J. Fox % 2016-06-29 noted addition of "value" and "vcov" attributes, added example. 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{linearHypothesis.rlm} \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{makeHypothesis} \alias{printHypothesis} %%\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, generalized linear models fit with \code{svyglm} in the \pkg{survey} package, robust linear models fit with \code{rlm} in the \pkg{MASS} package, 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{linearHypothesis}{rlm}(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. The value of the linear hypothesis and its covariance matrix are returned respectively as \code{"value"} and \code{"vcov"} attributes of the object (but not printed). 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 lh <- linearHypothesis(mod.duncan.2, coefs[grep(":", coefs)]) attr(lh, "value") # value of linear function attr(lh, "vcov") # covariance matrix of linear function ## 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.Rd0000644000175100001440000000621612773507540013545 0ustar hornikusers\name{Boxplot} \alias{Boxplot} \alias{Boxplot.default} \alias{Boxplot.formula} \alias{Boxplot.list} \alias{Boxplot.data.frame} \alias{Boxplot.matrix} \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, ...) \method{Boxplot}{list}(y, xlab="", ylab="", ...) \method{Boxplot}{data.frame}(y, labels=rownames(y), ...) \method{Boxplot}{matrix}(y, ...) } \arguments{ \item{y}{a numeric variable for which the boxplot is to be constructed; a list of numeric variables, each element of which will be treated as a group; a numeric data frame or a numeric matrix, each of whose columns will be treated as a group.} \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, or row names if \code{y} is a data frame or matrix (that has row names).} \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, or, in the case of a list, data frame, or matrix, empty labels.} \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))) Boxplot(scale(Prestige[, 1:4])) } \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.Rd0000644000175100001440000000163512462213521012424 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. Originally from \samp{http://www.un.org/Depts/unsd/social/main.htm} but no longer there. } \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/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.Rd0000644000175100001440000000702212270214610013632 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. Weisberg, S. (2014) \emph{Applied Linear Regression}, Fourth Edition, Wiley 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.Rd0000644000175100001440000003021213016336052015124 0ustar hornikusers\name{powerTransform} \alias{powerTransform} \alias{powerTransform.default} \alias{powerTransform.lm} \alias{powerTransform.formula} \alias{powerTransform.lmerMod} \alias{estimateTransform} \alias{estimateTransform.default} \alias{estimateTransform.lmerMod} \alias{estimateTransform.skewPower} \alias{estimateTransform.skewPowerlmer} \title{Finding Univariate or Multivariate Power Transformations} \description{ \code{powerTransform} uses the maximum likelihood-like approach of Box and Cox (1964) to select a transformatiion of a univariate or multivariate response for normality, linearity and/or constant variance. Available families are the default Box-Cox power family, and the Yeo-Johnson and skew power familes that may be useful when a response is not strictly positive. \code{powerTransform} passes arguments to \code{estimateTransform}, so you may need to include arguments to estimateTransform in a call to powerTransform. } \usage{ powerTransform(object, ...) \S3method{powerTransform}{default}(object, family="bcPower", ...) \S3method{powerTransform}{lm}(object, family="bcPower", ...) \S3method{powerTransform}{formula}(object, data, subset, weights, na.action, family="bcPower", ...) \S3method{powerTransform}{lmerMod}(object, family="bcPower", lambda=c(-3, 3), gamma=NULL, ...) estimateTransform(X, Y, weights=NULL, family="bcPower", start=NULL, method="L-BFGS-B", ...) \method{estimateTransform}{default}(X, Y, weights=NULL, family="bcPower", start=NULL, method="L-BFGS-B", ...) \S3method{estimateTransform}{skewPower}(X, Y, weights=NULL, lambda=c(-3, 3), gamma=NULL, ...) \S3method{estimateTransform}{lmerMod}(object, family="bcPower", lambda=c(-3, 3), start=NULL, method="L-BFGS-B", ...) \S3method{estimateTransform}{skewPowerlmer}(object, lambda=c(-3, +3), gamma=NULL, ...) } \arguments{ \item{object}{This can either be an object of class \code{lm} or \code{lmerMod}, 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{family}{The quoted name of a family of transformations. The available options are \code{"bcPower"} the default for the Box-Cox power family; \code{"yjpower"} for the Yeo-Johnson family, and \code{"skewPower"} for the two-parameter skew power family. The families are documented at \code{\link{bcPower}} and \code{\link{skewPower}}.} \item{lambda}{The range to be considered for the estimate of the power parameter lambda, equal to \code{c(-3, +3)} by default. Values of lambda outside the default range is unlikely to be useful in practice.} \item{gamma}{The skewPower family has two parameters, adding a location parameter gamma to the power parameter lambda present in most other transformation families. If \code{gamma=NULL} then the location parameter will be estimated; if \code{gamma} is set to a numeric value, or a numeric vector of positive values equal in length to the number of responses, \code{gamma} will be fixed and only the power will be estimated.} \item{...}{Additional arguments that are passed to \code{estimateTransform} which does the actual computing, or to the \code{\link{optim}} function, which does the maximization for all the methods except for \code{lmerMod} models with the \code{skewPower} family. For this case, computing is done using the \code{\link[nloptr]{neldermead}} function in the \code{noptr} package is used.} \item{X}{A matrix or data.frame giving the \dQuote{right-side variables}, including a column of ones if the intercept is present.} \item{Y}{A vector or matrix or data.frame giving the \dQuote{left-side variables.}} \item{start}{Starting values for the computations. The default value of NULL is usually adequate.} \item{method}{The computing alogrithm used by \code{\link{optim}} for the maximization. The default \code{"L-BFGS-B"} appears to work well.} } \details{The function \code{powerTransform} is used to estimate normalizing/linearizing/variance stabilizing transformations of a univariate or a multivariate response in a linear regression. For a univariate response, a formula like \code{z~x1+x2+x3} will estimate a transformation for the response \code{z} from a family of transformations indexed by one parameter for Box-Cox and Yeo-Johnson transformations, or two parameters for the skew power family, that makes the residuals from the regression of the transformed \code{z} on the predictors as closed to normally distributed as possible. 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. This is not the same as three univariate transformations becuase the variables transformed are allowed to be correlated. \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 (2014) 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 specification of a mulitvariate linear model \code{powerTransform(cbind(LBM, SSF) ~ 1, ais)}. Three families of power transformations are available. The Box-Cox pwoer family of power transformations, \code{family="bcPower"}, 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}. A scaled version of this transformation is used in computing with all the families to make the Jacobian of the transformation equal to 1. 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. If \code{family="skewPower"} then the skew power family of transformations suggested by Hawkins and Weisberg (2015) is used. This is a two-parameter family that would generally be applied with a response with occasional negative values; see \code{\link{skewPower}} for the details and examples. This family has a power parameter \eqn{\lambda}{lambda} and a non-negative start parameter \eqn{\gamma}{gamma}, with \eqn{\gamma = 0}{gamma=0} equal to the Box-Cox transformation. The same generally methodology can be applied for linear mixed models fit with the \code{\link[lme4]{lmer}} function in the \code{lme4} package. A multivariate response is not permitted. The function \code{\link{testTransform}} is used to obtain likelihood ratio tests for any specified value for the transformation parameter(s). } \value{ An object of class \code{powerTransform} or class \code{skewpowerTransform} if \code{family="skewPower"} that inherits from \code{powerTransfrom} is returned, including the components listed below. Several methods are available for use with \code{powerTransform} objects. 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, if any exist. The \code{vcov} function returns the estimated covariance matrix of the estimated transformation parameters. A \code{print} method is used to print the estimates and \code{summary} method provides more information including likelihood ratio type tests that all power parameters equal one and that all transformation parameters equal zero, for log transformations, and for a convenient rounded value not far from the mle. In the case of the skew power family, these tests are based on the profile log-likelihood obtained by maximizing over the start parameter, thus treating the start as a nusiance parameter of lesser interest than the pwoer parameter. \code{testTransform} can be called directly to test any other value for \eqn{\lambda}{lambda} or for skew power \eqn{\lambda}{lambda} and \eqn{\gamma}{gamma}. There is a \code{\link{plot.powerTransform}} method for plotting the transformed values, and also a \code{\link{contour.skewpowerTransform}} method to obtain a contour plot of the two-dimensional log-likelihood for the skew power parameters when the response in univariate. Finally, the \code{\link{boxCox}} method can be used to plot the univariate log-likleihood for the Box-Cox or Yeo-Johnson power families, or the profile log-likelihood of each of the parameters in the skew power family. The components of the returned object are \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 for the power parameter} \item{gamma}{The ml estimate for the start parameter for the skew power family} \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. Hawkins, D. and Weisberg, S. (2015) Combining the Box-Cox Power and Genralized Log Transformations to Accomodate Negative Responses, submitted for publication. Velilla, S. (1993) A note on the multivariate Box-Cox transformation to normality. \emph{Statistics and Probability Letters}, 17, 259-263. Weisberg, S. (2014) \emph{Applied Linear Regression}, Fourth 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{testTransform}}, \code{\link{optim}}, \code{\link{bcPower}}, \code{\link{skewPower}}, \code{\link{transform}}, \code{\link{boxCox}}. Documentation for \code{\link{skewPower}} includes examples of the use of the skew power family.} \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 uses Highway1 data summary(powerTransform(cbind(len, adt, trks, sigs1) ~ 1, Highway1)) # Multivariate transformation to normality within levels of 'htype' summary(a3 <- powerTransform(cbind(len, adt, trks, sigs1) ~ htype, 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{scatterplotMatrix( ~ transformedY|htype, Highway1) } } \keyword{ regression}% at least one, from doc/KEYWORDS car/man/showLabels.Rd0000644000175100001440000001163312716420325014210 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], id.location="lr", ...) } %- 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{id.location}{ Where should the label be drawn? The default is \code{"lr"} to draw the label to the left of the point for points in the right-half of the graph and to the right for points in the left-half. The other option is \code{"ab"} for above the point for points below the middle of the graph and above the point below the middle. } \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 = "r"} select points according to their value of \code{abs(y)}, as may be appropriate in residual plots, or others with a meaningful origin at 0 \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 = which(abs(residuals(m, type="pearson")) > 2} would label all observations with Pearson residuals greater than 2 in absolute value. 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. (2014) \emph{Applied Linear Regression}, Fourth 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/ncvTest.Rd0000644000175100001440000000422112270214610013517 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. (2014) \emph{Applied Linear Regression}, Fourth 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.Rd0000644000175100001440000001741012716420325015635 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], id.location="lr", 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, legend.pos=NULL, 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,id.location}{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. If plotting by groups, a different univariate display (with the exception of \code{"histogram"}) will be drawn for each group.} \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{legend.pos}{position for the legend, specified as one of the keywords accepted by \code{\link{legend}}. If \code{NULL}, the default, the position will vary by the \code{diagonal} argument --- e.g., \code{"topright"} for \code{diagonal="density"}.} \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.Rd0000644000175100001440000001265012270214610013001 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}. Weisberg, S. (2014) \emph{Applied Linear Regression}, Fourth Edition, Wiley 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.Rd0000644000175100001440000000175612536133372014536 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://dx.doi.org/10.2193/2007-273} } \keyword{datasets} car/man/car-internal.Rd0000644000175100001440000000047612471670625014477 0ustar hornikusers\name{car-internal.Rd} \alias{car-internal.Rd} \alias{.carEnv} \title{ Internal Objects for the \pkg{car} package } \description{ These objects (currently only the \code{.carEnv} environment) are exported for technical reasons and are not for direct use. } \author{John Fox \email{jfox@mcmaster.ca}} \keyword{misc} car/man/densityPlot.Rd0000644000175100001440000001455513016336052014426 0ustar hornikusers\name{densityPlot} \alias{densityPlot} \alias{densityPlot.default} \alias{densityPlot.formula} \alias{adaptiveKernel} \title{ Nonparametric Density Estimates } \description{ \code{densityPlot} contructs and graphs nonparametric density estimates, possibly conditioned on a factor. By default it uses the standard \R{} \code{\link{density}} function or optionally \code{adaptiveKernel}. } \usage{ densityPlot(x, ...) \method{densityPlot}{default}(x, g, method=c("kernel", "adaptive"), bw=if (method == "adaptive") bw.nrd0 else "SJ", adjust=1, kernel, xlim, ylim, normalize=FALSE, 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, ...) adaptiveKernel(x, kernel=dnorm, bw=bw.nrd0, adjust=1.0, n=500, from, to, cut=3, na.rm=TRUE) } \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{method}{either \code{"adaptive"} (the default) for an adaptive-kernel estimate or \code{"kernel"} for a fixed-bandwidth kernel estimate.} \item{bw}{the geometric mean bandwidth for the adaptive-kernel or bandwidth of the kernel density estimate(s). Must be a numerical value or a function to compute the bandwidth (default \code{\link{bw.nrd0}}) for the adaptive kernel estimate; for the kernel estimate, may either the quoted name of a rule to compute the bandwidth, or a numeric value. If plotting by groups, \code{bw} may be a vector of values, one for each group. See \code{\link{density}} and \code{\link{bw.SJ}} for details of the kernel estimator.} \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. The default bandwidth-selection rule tends to give a value that's too large if the distribution is asymmetric or has multiple modes; try setting \code{adjust} < 1, particularly for the adaptive-kernel estimator.} \item{kernel}{for \code{densityPlot} this is the name of the kernel function for the kernel estimator (the default is \code{"gaussian"}, see \code{\link{density}}); or a kernel function for the adaptive-kernel estimator (the default is \code{dnorm}, producing the Gaussian kernel). For \code{adaptivekernel} this is a kernel function, defaulting to \code{dnorm}, which is the Gaussian kernel (standard-normal density).} \item{xlim, ylim}{axis limits; if missing, determined from the range of x-values at which the densities are estimated and the estimated densities.} \item{normalize}{if \code{TRUE} (the default is \code{FALSE}), the estimated densities are rescaled to integrate approximately to 1; particularly useful if the density is estimated over a restricted domain, as when \code{from} or \code{to} are specified.} \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{n}{number of equally spaced points at which the adaptive-kernel estimator is evaluated; the default is \code{500}.} \item{from, to, cut}{the range over which the density estimate is computed; the default, if missing, is \code{min(x) - cut*bw, max(x) + cut*bw}.} \item{na.rm}{remove missing values from \code{x} in computing the adaptive-kernel estimate? The default is \code{TRUE}.} \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 down.} } \value{ \code{densityPlot} invisibly returns the \code{"density"} object computed (or list of \code{"density"} objects) and draws a graph. \code{adaptiveKernel} returns an object of class \code{"density"} (see \code{\link{density})}. } \references{ W. N. Venables and B. D. Ripley (2002) \emph{Modern Applied Statistics with S}. New York: Springer. B.W. Silverman (1986) \emph{Density Estimation for Statistics and Data Analysis}. London: Chapman and Hall. } \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, method="adaptive", show.bw=TRUE, data=Prestige) densityPlot(~ income, method="adaptive", from=0, normalize=TRUE, show.bw=TRUE, data=Prestige) densityPlot(income ~ type, method="adaptive", data=Prestige) plot(adaptiveKernel(UN$infant.mortality, from=0, adjust=0.75), col="magenta") lines(density(na.omit(UN$infant.mortality), from=0, adjust=0.75), col="blue") rug(UN$infant.mortality, col="cyan") legend("topright", col=c("magenta", "blue"), lty=1, legend=c("adaptive kernel", "kernel"), inset=0.02) } \keyword{hplot} car/man/bcPower.Rd0000644000175100001440000000657212567656065013534 0ustar hornikusers\name{bcPower} \alias{bcPower} \alias{yjPower} \alias{basicPower} \title{Box-Cox, Yeo-Johnson and Basic 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, gamma=NULL) yjPower(U, lambda, jacobian.adjusted = FALSE) basicPower(U,lambda, gamma=NULL) } \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}.} \item{gamma}{For bcPower or basicPower, the transformation is of U + gamma, where gamma is a positive number called a start that must be large enough so that U + gamma is strictly positive.} } \details{ The Box-Cox family of \emph{scaled power transformations} equals \eqn{((U + \gamma)^{\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 \eqn{\gamma}{gamma} is not specified, it is set equal to zero. \code{U + gamma} must be strictly positive to use this family. 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. An alternative family to the Yeo-Johnson family is the \code{\link{skewPower}} family that requires estimating both a power and an second parameter. The basic power transformation returns \eqn{U^{\lambda}} if \eqn{\lambda} is not zero, and \eqn{\log(\lambda)} otherwise. 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} for skewPower and yjpower and of \eqn{U + gamma} for bcPower. With this adjustment, the Jacobian of the transformation is always equal to 1. 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. Hawkins, D. and Weisberg, S. (2015) Combining the Box-Cox Power and Genralized Log Transformations to Accomodate Negative Responses, submitted for publication. Weisberg, S. (2014) \emph{Applied Linear Regression}, Fourth Edition, Wiley 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}}, \code{\link{skewPower}}} \examples{ U <- c(NA, (-3:3)) \dontrun{bcPower(U, 0)} # produces an error as U has negative values bcPower(U, 0, gamma=4) bcPower(U, .5, jacobian.adjusted=TRUE, gamma=4) basicPower(U, lambda = 0, gamma=4) yjPower(U, 0) V <- matrix(1:10, ncol=2) bcPower(V, c(0, 2)) basicPower(V, c(0,1)) } \keyword{regression} car/man/scatter3d.Rd0000644000175100001440000002467112633311365014010 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, axis.ticks=FALSE, 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{axis.ticks}{if \code{TRUE}, print interior axis-``tick'' labels; the default is \code{FALSE}. (The code for this option was provided by David Winsemius.)} \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.Rd0000644000175100001440000002351712677222256014354 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, level=0.95, ...) \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{level}{level for confidence interval, default \code{0.95}.} \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. Weisberg, S. (2014) \emph{Applied Linear Regression}, Fourth 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.Rd0000644000175100001440000000372612757040415013575 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{htype}{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{alr4} package only by addition of 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. (2014) \emph{Applied Linear Regression}, Fourth Edition, Wiley, Section 7.2. } \usage{ Highway1 } \keyword{datasets} car/man/infIndexPlot.Rd0000644000175100001440000000472012716420325014507 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], id.location="lr", 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,id.location}{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. (2014) \emph{Applied Linear Regression}, Fourth 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.Rd0000644000175100001440000002133112716420325014445 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], id.location="lr", 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, legend.columns, 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(x, ...) } \arguments{ \item{x}{vector of horizontal coordinates (or first argument of generic function).} \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,id.location}{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; can 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{legend.columns}{number of columns for the legend; if absent will be supplied automatically to prefer horizontal legends when plotted above the graph.} \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/Wong.Rd0000644000175100001440000000264612460470573013031 0ustar hornikusers\name{Wong} \alias{Wong} \docType{data} \title{ Post-Coma Recovery of IQ } \description{ The \code{Wong} data frame has 331 row and 7 columns. The observations are longitudinal data on recovery of IQ after comas of varying duration for 200 subjects. } \usage{Wong} \format{ This data frame contains the following columns: \describe{ \item{\code{id}}{patient ID number.} \item{\code{days}}{number of days post coma at which IQs were measured.} \item{\code{duration}}{duration of the coma in days.} \item{\code{sex}}{a factor with levels \code{Female} and \code{Male}.} \item{\code{age}}{in years at the time of injury.} \item{\code{piq}}{performance (i.e., mathematical) IQ.} \item{\code{viq}}{verbal IQ.} } } \details{ The data are from Wong, Monette, and Weiner (2001) and are for 200 patients who sustained traumatic brain injuries resulting in comas of varying duration. After awakening from their comas, patients were periodically administered a standard IQ test, but the average number of measurements per patient is small (331/200 = 1.7). } \source{ Wong, P. P., Monette, G., and Weiner, N. I. (2001) Mathematical models of cognitive recovery. \emph{Brain Injury}, \bold{15}, 519--530. } \references{ Fox, J. (2016) \emph{Applied Regression Analysis and Generalized Linear Models}, Third Edition. Sage. } \examples{ summary(Wong) } \keyword{datasets} car/man/outlierTest.Rd0000644000175100001440000000507712270214610014426 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. (2014) \emph{Applied Linear Regression}, Fourth 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/LoBD.Rd0000644000175100001440000000540012567656065012700 0ustar hornikusers\name{LoBD} \alias{LoBD} \docType{data} \title{ Cancer drug data use to provide an example of the use of the skew power distributions. } \description{ A portion of an experiment to determine the limit of blank/limit of detection in a biochemical assay. } \usage{LoBD} \format{ A data frame with 84 observations on the following 9 variables. \describe{ \item{\code{pool}}{a factor with levels \code{1} \code{2} \code{3} \code{4} \code{5} \code{6} \code{7} \code{8} \code{9} \code{10} \code{11} \code{12} denoting the 12 pools used in the experiment; each pool had a different level of drug.} \item{\code{I1L1}}{a numeric vector giving the measured concentration in pmol/L of drug in the assay} \item{\code{I1L2}}{a numeric vector giving the measured concentration in pmol/L of drug in the assay} \item{\code{I2L1}}{a numeric vector giving the measured concentration in pmol/L of drug in the assay} \item{\code{I2L2}}{a numeric vector giving the measured concentration in pmol/L of drug in the assay} \item{\code{I3L1}}{a numeric vector giving the measured concentration in pmol/L of drug in the assay} \item{\code{I3L2}}{a numeric vector giving the measured concentration in pmol/L of drug in the assay} \item{\code{I4L1}}{a numeric vector giving the measured concentration in pmol/L of drug in the assay} \item{\code{I4L2}}{a numeric vector giving the measured concentration in pmol/L of drug in the assay} } } \details{ Important characteristics of a clinical chemistry assay are its limit of blank (LoB), and its limit of detection (LoD). The LoB, conceptually the highest reading likely to be obtained from a zero-concentration sample, is defined operationally by the upper 95\% point of readings obtained from samples that do not contain the analyte. The LoD, conceptually the lowest level of analyte that can be reliably determined not to be blank, is defined operationally as true value at which there is a 95\% chance of the reading being above the LoB. These data are from a portion of a LoB/D study of an assay for a drug used to treat certain cancers. Twelve pools were used, four of them blanks of different types, and eight with successively increasing drug levels. The 8 columns of the data set refer to measurements made using different instruments I and reagent lots L. } \source{ Used as an illustrative example for Box-Cox type transformations with negative readings in Hawkins and Weisberg (2015). For examples of its use, see \code{\link{skewPower}}. } \references{ Hawkins, D. and Weisberg, S. (2015) Combining the Box-Cox Power and Generalized Log Transformations to Accommodate Negative Responses, submitted for publication. } \examples{ LoBD } \keyword{datasets} 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.Rd0000644000175100001440000001006712560552551013023 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 % 2015-07-13: removed URL causing note in R CMD check. John % 2015-08-05: fixed typo. 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 matrix. 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. 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.Rd0000644000175100001440000000451612716420325014716 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], id.location="lr", ...) } \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, id.location}{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.Rd0000644000175100001440000000576212360234504013351 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. In addition you may not use \code{:} with the collect operator, so for example \code{c(1, 3, 5:7)} will cause an error.} \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.Rd0000644000175100001440000000210012270214610013003 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. (2014) \emph{Applied Linear Regression}, Fourth 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.Rd0000644000175100001440000002264612724350742013677 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)), id.location="lr", ...) 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,id.location}{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.Rd0000644000175100001440000001463412716420325013541 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], id.location="lr", 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, marginal.scale=FALSE, ...) \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], id.location="lr", 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,id.location}{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.} \item{marginal.scale}{Consider an added-variable plot of Y versus X given Z. If this argument is \code{FALSE} then the limits on the horizontal axis are determined by the range of the residuals from the regression of X on Z and the limits on the vertical axis are determined by the range of the residuals from the regressnio of Y on Z. If the argument is \code{TRUE}, then the limits on the horizontal axis are determined by the range of X minus it mean, and on the vertical axis by the range of Y minus its means; adjustment is made if necessary to include outliers. This scaling allows visualization of the correlations between Y and Z and between X and Z. For example, if the X and Z are highly correlated, then the points will be concentrated on the middle of the plot.} } \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. (2014) \emph{Applied Linear Regression}, Fourth 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)) m1 <- lm(partic ~ tfr + menwage + womwage + debt + parttime, Bfox) par(mfrow=c(1,3)) plot(partic ~ womwage, Bfox) # marginal plot, ignoring other predictors abline(lm(partic ~ womwage, Bfox), col="red", lwd=2) grid() avPlots(m1, ~ womwage) # av Plot, adjusting for others avPlots(m1, ~ womwage, marginal.scale=TRUE) # av Plot, adjusting and scaling as in marginal plot } \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} car/man/skewPower.Rd0000644000175100001440000001240212757040415014071 0ustar hornikusers\name{skewPower} \alias{skewPower} \alias{contour.skewpowerTransform} \alias{contour.skewpowerTransformlmer} \title{Skew Power Transformations} \description{ Transform the elements of a vector using, the skew power transformations. } \usage{ skewPower(U, lambda, jacobian.adjusted=FALSE, gamma) \method{contour}{skewpowerTransform}(x, ksds = 4, levels = c(0.5, 0.95, 0.99, 0.999), main = "Skew Power Log-likelihood", ...) \method{contour}{skewpowerTransformlmer}(x, ksds = 4, levels = c(0.5, 0.95, 0.99, 0.999), main = "Skew Power Log-likelihood", ...) } \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}.} \item{gamma}{The skew power family has two parameters, the power lambda, and the start gamma, which can be any positive value.} \item{x}{ An object created by a call to \code{\link{powerTransform}} using the \code{family="skewPower"} option. } \item{ksds}{ Contour plotting of the log-likelihood surface will cover plus of minus \code{ksds} standard deviations on each axis. } \item{levels}{ Contours will be drawn at the values of levels. For example, \code{levels=c(.5, .99)} would display two contours, at the 50\% level and at the 99\% level. } \item{main}{ Title for the contour plot } \item{\dots}{ Additional arguments passed to the generic contour function. } } \details{ The \code{skewPower} family is a modification of the Box-Cox power family, see \code{\link{bcPower}} that allows the untransformed response to include negative values. Ignoring the Jacobian, correction, the Box-Cox family is defined to be \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}. The \code{skewPower family} is the Box-Cox transformation of \eqn{z = .5 * (U + (U^2 + \gamma^2)^{1/2})}. Zero or negative values for \eqn{U}{\code{U}} are permitted if \eqn{\gamma}{gamma} is positive. If \code{jacobian.adjusted} is \code{TRUE}, then the transformed values are scaled to have Jacobian equal to 1, as suggested by Box and Cox (1964). This simplifies computing the maximum likelihood-like estimates of the transformation parameters. Missing values are permitted, and return \code{NA} where ever \code{U} is equal to \code{NA}. The contour method allows drawing a contour plot for the two-dimensional log-likelihood for the skew power parameters with a univariate response. } \value{ Returns a vector or matrix of transformed values. The contour method is used for the side-effect of drawing a contour plot. } \references{ Fox, J. and Weisberg, S. (2011) \emph{An R Companion to Applied Regression}, Second Edition, Sage. Hawkins, D. and Weisberg, S. (2016) Combining the Box-Cox Power and Generalized Log Transformations to Accomodate Negative Responses In Linear and Mixed-Effects Linear Models, submitted for publication. Weisberg, S. (2014) \emph{Applied Linear Regression}, Fourth Edition, Wiley Wiley, Chapter 7. } \author{ Sanford Weisberg, } \seealso{\code{\link{powerTransform}}, \code{\link{bcPower}}, \code{\link{boxCox}}} \examples{ # Univariate Example, from Hawkins and Weisberg (2016) m1 <- lm(I1L1 ~ pool, LoBD) p1 <- powerTransform(m1, family="skewPower") summary(p1) # summary prints estimate, se and conf.ints for both parameters # helper functions c(p1$lambda, p1$gamma, LogLik=p1$llik) vcov(p1) # Estimated covarinace from inverse Hessian # tests are for lambda, maximizing over gamma (profile log-likelihoods testTransform(p1, lambda=0.5) # Contour plot of the log-likelihood contour(p1, main="", levels=c(.5, .95, .99)) # the boxCox function can provide profile log-likelihoods for each of the two parameters: boxCox(m1, family="skewPower", param="lambda", lambda=seq(0.25, 1.1, length=100)) boxCox(m1, family="skewPower", param="gamma", gamma=seq(3, 80, length=100)) # Fit with fixed gamma, in this case fixed at the estimate from p1 p2 <- powerTransform(m1, family="skewPower", gamma=p1$gamma) # summary gives different tests because gamma is fixed rather than maximized over summary(p2) # Multivariate Response p3 <- powerTransform(update(m1, as.matrix(cbind(LoBD$I1L2, LoBD$I1L1)) ~ .), family="skewPower") summary(p3) # gamma fixed p4 <- powerTransform(update(m1, as.matrix(cbind(LoBD$I1L2, LoBD$I1L1)) ~ .), family="skewPower", gamma=p3$gamma) summary(p4) # mixed models fit with lmer - requires lmer and nloptr packages \dontrun{ data <- reshape(LoBD[1:20,], varying=names(LoBD)[-1], direction="long", v.names="y") names(data) <- c("pool", "assay", "y", "id") data$assay <- factor(data$assay) require(lme4) m2 <- lmer(y ~ pool + (1|assay), data) f1 <- powerTransform(m2, family="skewPower") summary(f1) f2 <- powerTransform(m2, family="skewPower", gamma= 10) summary(f2) } } \keyword{regression}