car/0000755000176200001440000000000013204337411011015 5ustar liggesuserscar/inst/0000755000176200001440000000000013202607636012001 5ustar liggesuserscar/inst/CITATION0000644000176200001440000000124213150571277013140 0ustar liggesuserscitHeader("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/0000755000176200001440000000000013202607636012546 5ustar liggesuserscar/inst/doc/embedding.R0000644000176200001440000001420613202607636014612 0ustar liggesusers### 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.pdf0000644000176200001440000070033013202607635015161 0ustar liggesusers%PDF-1.5 % 3 0 obj << /Length 2345 /Filter /FlateDecode >> stream xڽێ}BWΕd<Ԩ&SFFmz!/!^̗LZ[@ռ[|%)`(zCt"i;rkqB-,.#]g}`|djXx!.?)r>昖2q`%'>薇g'"/cƮ9h$iFdsrԓN1 021u􍦍RojPsK88/917B"&cI!@[󖃃># qJ->rOŢ0&罔X b13>qrwב2C8b.8-jޢϑt-a1ڕuftgJ0j|!5@,v'XĮ!:FBẻN;k7%@ߙLCCNƩ*[B 4Yzl|GH4qG"X8K* ѪyT ]WC|݃(,{t_xbX`!{a`E2 ((A?6֭纏i fma(srU/Hvm.+~q7%V61 nyrI c^NьM;ߑu"׉&yLd Ȏ};dV GGkiFt\yc R [!~W?n12M؋N_῍˃ggSOe1MdCӞyBv8{JIS'+;y5p~UtQqBf~>],BWeZ?w Hua>6?\y5s}t#/2V11.t 0ѝw:$iOY&洞?*p VFTUUvhfhܤkrY\z1Gz0i)'eraAS~~p(͜=T_?^k2gv;)If[LEmc斓p9ح Ӽ{Frh?*S8U.sҼȬ̌yF|7 e^/%1S[8oBO>P+p7\( I2>RiQYS._(>#Fg^7}_9MP:7B]Wn~Bo3ikUJxt>\}Cm`E٪ P^)?^ǷHݮf-ceUex?H?$߬6392wgH}s5]~4jFv&^S>;qOd򊩀R-QH 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 2182 /Filter /FlateDecode >> stream xڥn6}(E8)AvGIqJf~)ʖ}EQs7~jQEofU el^ga5{/P]Լv000`l`tjjKicebKӻ緸yw6/&,{HjwzX";Z{ܿŸap3Ҿ+xPq FB-)¢ZFǻ/*k gtgI*ؐΎpPO7%4, U3FGVMYh'T<[Y3 j8er[ hej7\ǢPs-ʘAm) z3_Tl|E6wLV v^lH0#?=r&+_q Q!<!v{F<糒Wif_SBV2SgXtigGEv+׋/۞\75|G'OF_:?#{gyLpj.ZOOea_x"#"hXRBT('9;t. S@0plS #;oBw+؞:Go@:<@t?( yIa/b4}S,~-#S$AyW39}>6F~S6[^J`ͧ+P.y̧vP0FanX9uC\]#eeG#%t- B=6hHa-ϵ&1`8XxѳȅTD<ܣ̍]~G)R$F8nbX5z$׸kj?" 0b1N`O(}*փ@vkOIzjEy \HA:6]poKNZUu6-R($ˡQnP0, jYk仕T^|vGqFۋ%H JkYeh!bD=\$Lc3՞bĜ`D-+гD?E2Ew ^ؙDE8|9Hs.=s^5 op"9Mc]iߜ(N$^O"& FL7|To_5Jwlwsʏ쾞|^9DGAlǥ6E xf;ry_iU>_D<Xr1q|πH#![Wh4NTSw[L9쭤`t[E gە^" o*Z:a^2GI T4,@R"RbZekH1_37&'?q:MUR|8 $6=CKPV3"@IZBu,=".򌗼LgXcKw*:7g.jjDr:Kͫk^+ dc{ V-m,n;0|nB{[bRH6u:Ζ=5ӆjM񒈏'Ƣ^Aٶ97Z+G9$YIb~rtc*!ϐ9="O_y4`;KrIa cKaS6v|T5fr-qU츱r(Zץd=q Z<&t={F]+wN0O}ȇ>GI?⿱r3w@;@eT!3_y4{Q_/VUۊ+R 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 lW33Ojp)( 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 1765 /Length2 11006 /Length3 0 /Length 12134 /Filter /FlateDecode >> stream xڍP-apw' @`p` ]$Hp[xdwUT1s]SkhKY: Pv.0@F y8@n4zzm[/1. "/Y&k}Su\<.~a.a   E knk P(;Ah2N^.64 ``p rZAfPsF 3-_!DmPgaNN3GW'kqf6-] vƁFжuSd0s`볇xNRR;!im\\w [fNf/[5 PWzBf߆fNfffTn=7W{.PWW[-rrK'GG0>Y[{q9Y{/`e ݄3XI/g?2k0x7 ^?\8;9Z|\ߊFh\\K[ (lm A'l'~'=._t8xc|9U Yo'~E**ABJ)3̀LZ0Gq wspC6sung:=oM*JP=X;`K [͟dS{l!` 'WWy,/3#PSA,,o7? L$n>>*Z=0}v<rrA=Q SO T 8F<NSo$F<~f$ FGg]hNK)h3Hh(,x?=g.r'Xcx} ָcoyksvґP_N2H(~#[w|佭q?3af"%'Pzڪ:7ҙ@+z퓺@]h.{V%dC\G ͭc(ܶ|!n4h2B,e*GaUM=94s=᾿@"ikgґ6!Xl59WQ]6ەP 9"Y mrVF^ Okt̪~:ORUyYEqMpcnD _ׅeㅯ+G>2U|>mAVO c")YXe5/Eל@d>3ӥH&Z{s̅|3gz)#t,*W Kf֓l2 QVSR\dl8k36c9l+˦ch7C-'PuM }MQ8Z@ .INS&C"JN%UgF)MR] /Sv1ciΔ s&g_XĻQ\Y\Y `ƸxSy Ϙu>0dH!w払}YS63Eѽ~:c_OTCB.9a.Ipgrk"GghL+nA8E&؝rfsV5SMOY1jOdW/>lwL(K gԵ|rϝb!GfTr6OW [ўW&1yR}þ h`9C #֪엵ķ%K4= +5+E)V(7!3O:Qe> Y4AQAfocjVnh2_E(6[h tKw 3$ReAq{u*NJݏ8{cUI<?R=f~YN<\a eιq4((R0c%WAi#%{)|,r|5:6w+]Bm䯙aogHGe23(pXGUcQ/jKTwZȘ~fV 򕿒bgOR@g ?-6s]7{[eTukNX,gM, @ن~2^Tuӹ|䶂|,;kI{8Y'<0ҡI3d U8M~=ZDszXRuhC6R7k.@tKO%F&[Ҕ1|cBGw%a:ԩzy[>9U@E. 4Ժ՜"Sxt\E`)cUw9 +GSP7ry?2M@N>e h!!YJLe7\CPu_EAȷ-k_8F%>u5-r"0w+4j4DuNX+mp5/1{(=U㕺L:.* ,ebL5's ykK#{ǯf S7dp[+} /Y[3GpIj9[J# Yr5$Qa'R.&Dl'vg96ʄT#@Yݳ$S˽U }UQLEO2 1Q;aAN{d+ p𠟚j#qp-J+AG|if)Zt= my\:rNY$ͪ [zςqXLȨh%04wbّNS{~JDw;|sوU@ApT.~ EdĬrVG?w+@vH;@/Ro0 aRp: A|[oNKn{"b@ö;G \埤B.d18n}Ե|tdu%::#"~K%͸7QCd(#X)T֭Ȉ:NſrYqh4Jt``DA W#ˣ߷/o{r4dB_s/$g8C(%"+Dw5z8[PHWO2sZܱI_Ebf!<— v R>.e^YH53y 3)(`tj} d<mբ_JIE][Um܆p.l;/0F3jrXݑ>{oٲ4e"vRwZ WX5SjkĿdj췽)3 bM ܱW9)ѭEVd><I1!Zg?喙UQH`IU,'W vq;(bBWEeRl!<2~t4mms槉Olq,9[0g1C1q/nz޾ڣJUV, G-v+MDS@|c,۪q)\0l% fP>!l)ڠ3#oGdc@0!rH; I]55+T&y&";13+#5# (t.QH-cgtAI"o5W]=1@|Pĥ<^%f듊azS_+伿{ ~h&d n<[2`M:"n&"K]fqϓĢ[g CT ǎwYf2҆"6!lX~]Rhj}p~9gXvӒWQ{u!- 1rxuP+¨XL&9aQ5a3o 9A虀Ly^Gbee&_$$]c_as[ʘ>NײI`.e'>k#.̚0.v.4qC_7L1~xc 4:[9<:>э%ґ07yhfꣾo6#-󿯏OҭHjj e p\w w"(Q@o4VW`nGnVmAK-R{r-d#a>RW:vPg!vB\$'I].}&݀kzQZbIr)ǾL ^L߷*YyzNsͽZwa&t|Mxٰ53?o\S l3L&|Ҩfר kFkPsHV Kjy a%CO% ClNtp ]w_ a뇈=S80o^D禲$m7,6n(F'^.6p),^+zFmn׮*ugu֊F*둩{# /$ @2MxJxjr찮iӚ>P칥2ŷ^Ԯ쑂'Ŭp#SoV=ͥ5,E6Mb٦{ݿm;Σ+S'԰Vpj }Sӧ0\IqXl]&p`O˒Sl~ޥ!!.rWo;iqVV6o%cJ;6|E7:9}XuGvO ]U~TK:\2J0YnkE=)&; ͔t( "g>µmxO.Ak[-p a$=Xoa<-ӟt gz?.9-?; yQ:D,ɀ`7iܝmO]yЬhiFwFޓq>>ݞ9A+܂I#k 'Lpљoi҄>ofVF dڑ%4O;mmRұf&dH!wϢ\vFS0bd+me)oĦDO^r@Y#+)~wuҥLreeJ24\lC@)GDJ=J=* Eq`iYCI*ѩҸwU4vaPם[ʭ0E= Fpwq ^k&fpGzLҸoMAPS6 PeLEtv(5ո3{]%{!_p;i*ecXd+7Yfd s,އuS,ض7ֿ4=]lRś [bLknq{zT{r.;+*TE%e0ҫ/2ىd|6F荛8XFzL{Ȅyc(hQ\Y4*Q@7 ߙ=};FL>=BoX,\B~8[v~~7^<5pfZ`Nޔ.xkq..q=B,4Xֆ6ԅ"qz-'%QBlͽJ9iwY7 tMY<`yFb;*hYZ|MC*ץ 5B7aid4MW_074 y0*8k_>H`E2vgmx=fS-)K~R,TҵvTPVz_fk 5ߢ@,FgM!>i{fu;'y.{rէ|SLFtCFOUA} *ѩ&N{ jOc( AFx |)ODZjN-{ʝe֠cZ[ a}voQ]wǍ< M(A+`:Lnx ߼w1vr~O±8BҎlEcw_7>N(!n:@K)?ՐؾP'*K6pGg%mСlO׽\gEsOUDҍOp(.w|)(F\:-96trQx^n &{]ySp 1L7]cXbcEiBR z>_Xa ԸSxӋ7BvL^%띝򖽎ϥ:6^WNnJ6iBSq/Zos_4{h]j'Y: %|~^sTu-l8fï|6AK`$L7s5ZW-[6I]QK'"`z^W4rLbG=MЌVFW l2a%fҽԭ|^:Al]DW+<}rǞ.@'o䈞r`['m3PwEOu?է 3vC/I=Y/ #s.8[ia9V#`T'e;m*Ⱥ-H5g. |5܀aW%=c'/6{7:|C"DUj75 X9#Z~]@a `NƎ>ea>}[omK"~BIм'FW$䛋MnRC;5wav+TZՒ;?uVMV~ 4,;ihr]kXqZ 6bI6oQ1 [\qfz;~˪lwnݽ Rw9v,;uw:Yzk=#8dϞWR/&u*+&8o. INo.`D IB{pKqdP6Cs#}Y+ħQzdA!gyz@ͱ\rOXF3ۖ`RFjU1r>3A;ѿ) GZ!GKOh)} yx Z9"/rޙ #mI~eL]*A C'z߳Ew0! \_GJ1ȗ[)UK!Ȍ* arq`1n׽ |*o`󚩆.ܵ7 >i;kT-:aM\  6y>/>*v]NC񕓛A]OѺ]Pkbʞkwc!|"Juvk:aBzШzi5%/1hdD±8$Y'&6kz~%y0k'#jru᩵pXǬwHJy6Sʼ4@􊖲"%/.rgsfA"ӹq(ש9iM5 ]ȲŖ%l{&~ÝX)ںɾ" }47QAf=i/)C,n,̵^*&e3ZQOgcĠ6O^1 ^#Q5JĉbMݻwL놆t4E4sndS-t?WطaaQiÊ \0p>Y{V"o)GMfx_D,v͜ث"X>;BQ ">|Ah>8#<^"tV,Rc7a^Gޥ5"~u4dW2aӣn{\'NC!NGqXA{3qTR"]v&w:@2rjbH 9'GI9O~j$E @ "DS kˏtdpr7m#U)).ZL> 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?UR 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:20171114164533+01'00') /ModDate (D:20171114164533+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 4050 /Filter /FlateDecode >> stream x[mS9_1jkѻTuU yB|p`&_O4fl/[Fju閺[[U!PRJBBK}A, :_FЧBJFA8O c & 2XC'n!2% Ģj:@EXW80(l(ä1ePML9Wx[U@!ZYSA3P +tif* 64v@, Dp "%EJRgz3A:KP"pMAJ5@GA-V%j'Ƨy*Dl ZB8I$2[q?x/ `R*P5tQQ l `H4 ;I0M`j Yˠ<.7zPnglZ(w]=NN)37gSy ?0|q$n/槩ӏUh6U,T MFMUCQ5u2fSdX'{#7uVwF#f7B9E#j H;EyTwQ"z&s`9 #vct@UK3Lnl,peiU+&&m5]ҧ95篗zh}I|Ф{}nj:>OFyi W a6y0WEL`:F+݆D8.Q8K8>֝ VnFBi IZԐ1 y '0ʞb-C,.]WIAM)P }!Bo `HѠu2K/-鰢Y2 6`'$E֡3'M*a%<IzkɺI$!սQb\.Va" .fȡHY]AŮEmYI=D>h,"K5{#X璌.j}iHw=ٰv mQ!ʚ 4RQYiS$\*#Ml&74VG6.֧m<:ң l;Vv4 ,<l*-yb[ӀŌ=[^.\&1l,Z6'v#R(5%r-qK-^zvta52N!%&+c]Áݲ)yNhb{?TŽw"cr|?JrxfneE-Rݝje[w?& -qpH,"ZOi)N"SMܑ Du&o_\Fbf>qK$*<$ 9Bݥ2 {yASseQW-9hqu$}H @4.'cuBڑ{iݐ&s5,[J{h7Dϧ]T ֹ󁎖cd_P#e. 2ἕ+HABH:F"NWyu0|t ,'1c"]bf&zJG<@kŁæ15v+[FfF{d%3=t)aew  飿'i mśX3HB]iJAˠIk:Nj J$%tt "7՘% CV*xJ9Q$ZシCm,%|:.Y;\ED|Q].s)Q^憉!\|[xϒN1=\\j]AoGXjO!<&F-<$.-{0.c &p=k%L/.AG_xˊ漉J񵅝?[۵aI1~mFXN 4vN#tc}urEB_%%tJSFI!G;ACp f9˦ QH0jK dy`(.YWnts46*8'csLC7tOtC9{}B/:f6W9͟}i#3~Qϒ@/q<(76|Pn o^ԣ #'_d'}< Fz1n p2VAwT{ V``,t 9/lXN/Ӌ(  ݍI4I y  {/ɻ>誱NelY>+r|Qu<*˓"OǗkWWW Iy^^\,aGرc޷7 obmBs*oh|V\N?xOQ:t-|y[~+U~/,]OZUr'Gl/t\ilazmI+(e:>#zo=bݎ0t zYJ~׿%ڳٔK4h:PkhŨ\+U[+G=dy#+ȝo a@w"A2a'۝s|{e⪧Ac{9<:B{!}LyBGsI);4<0 =GE9D=yh4]ըΠfq-*׳y3걣Ɨ Sq;,輪ëܻve=/ES ƖMZ*{2aAmʐBM ?[ρڞ<Cדa02Vӟ7{j8(φm%{{Wq=W?qk[;~8yypG'36;nhr~GmAa%Շ『aGE(ͣC:Q KkHr>X^>?8bv_GkS0pJb5'9m(#\@[J~`}Ҋ1ޓIJ~rwO;GYJE?PL!jyj˱ȷxNG4h%7D "BT=pt|R}Zcgӗ?sLˌpZ×H[:PwF&]hX0=u2:]L7[wZ>ᝫ˶l'ig\U^0vp\ fuٝ{h$9jܬsu\̀ewn:-k(sԖZ-d5 ޺V1@m۷*K+ w[.}ufen#~yl5wαmaiܷC𩝣gGzh[.sX^ZloaY#=T]cuOZQlX{i _wu[]KͶ ů:9vWz %\/ܖEuzh(~zT_Ji 0~xKgOH9:Cju(/ ea*Vq{>Zh#ʌ?"eй) 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 306 /Filter /FlateDecode >> stream x%I/QK5UEkjo555T>@ckaKNbcaaH$<979WD׈8 2d̑52EY!dl%2M Y% gzyXb meRN W} HVu%ȋI$~cԒH^wdz@IqH4 i!!JH;  !V<\>i GZVp\Q(h -xJ8Z0V&[JhaJI!G0X(lSk ='{$[6/i endstream endobj startxref 229030 %%EOF car/inst/doc/embedding.Rnw0000644000176200001440000002373013150571277015164 0ustar liggesusers\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/NAMESPACE0000644000176200001440000002023013150571277012243 0ustar liggesusers# last modified 2016-11-25 by J. Fox # modified 2017-05-06 by S. Weisberg 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, bcnPower, boxCox, boxCox2d, boxCoxVariable, boxTidwell, ceresPlot, ceresPlots, crPlot, crPlots, crp, deltaMethod, dfbetaPlots, dfbetasPlots, dwt, durbinWatsonTest, 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, 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(vcov, boot) 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.bcnPowerTransform) S3method(print, bcnPowerTransform) S3method(summary, bcnPowerTransform) S3method(summary, powerTransform) S3method(plot, powerTransform) S3method(plot, bcnPowerTransform) S3method(coef, powerTransform) S3method(coef, bcnPowerTransform) S3method(vcov, powerTransform) S3method(vcov, bcnPowerTransform) S3method(testTransform, powerTransform) S3method(testTransform, bcnPowerTransform) 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 bcnPower # methods related to Boot S3method(Boot, default) S3method(Boot, lm) S3method(Boot, glm) S3method(Boot, nls) S3method(hist, boot) S3method(confint, boot) S3method(summary, boot) S3method(print, summary.boot) S3method(print, confint.boot) car/NEWS0000644000176200001440000007755513201112047011530 0ustar liggesusersChanges to Version 2.1-6 o Made several functions compatible with vcov() in R-devel (3.5.0). Changes to Version 2.1-5 o Fixed bug in boot.hist, and made Boot.default more general. Added a vcov method for boot objects o Fixed bug in gamLine with non-dentity links. o Removed the skewPower transformation functions, and added bcnPower transformation family. Same transformation, new name, new computational algorithms, improved documentation. o Fixed bug (reported by Bruno Hebling Vieira) in print.summary.Anova.mlm() that could cause adjusted p-values to be incorrectly ordered. Changes 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/0000755000176200001440000000000013202607505011730 5ustar liggesuserscar/data/Cowles.rda0000644000176200001440000000676613202607636013700 0ustar liggesusersBZh91AY&SYL$ @/'}(Q@HQ=@1!|b"U?ThUUP@JP5h @4)(JT4Md4@D JQ{Th|>Il$IdBX ! IK$RBH"" a*($X)  D " HTD"*(XHBA"I$"!"AJP,Ab(A!BI  D EJ"TD@ HHDDAi`UBJ%H"W_/{|Jb5|B PB BT$ZDEUE"IHUQHRXDU! QQEB""DE*HTJA Z*RD @*BBBADTR"A"(Ie0`Iϧ]֋nvk.DD[sF9μZUԹS5[j>zYWK`z=ȌChRG]&0t!Q"`LϹny}G0K+yOOhGq;0Z"G-*nxjV7b崓ї혁Ǯ"Sb1j;(Ԩ}g&#E1 wѽqhSmNP0nɩhezI_&P$xǍ9\YzƔG@ZYy'|d.Qَhy5ӡς׻Û"_Sc9*Ker8( h:PbftThBmKÄG#t 'zZOCfqW(lN&Hr_ 7LO9XOKk9ؗJN-M@9mfAYJ!y9{2XS`pffjsua:0%[mLI7vKN#`,ThOIPvĴlmnfl9:KbGj2bLz~h0#znzfw$av{|{,t'Bs\Δn~s#+5/ŸomEiMnX^&jzRka&LԊYf.{bmխtGrI_2(Vsm4n-W57%ݭs QJKQ6ߍeQ /5Oi4 =MihY oGtXV0A~ K(x"_Pl36r% m[p/e}*~UjDXmueYJmd) \AY ^d,ՌyIXsMn{FD[#NӎؘG.F"]^ny 4`ڪY뺘|-LPZI-{PAitEhVòoyDnS~oZ> E;!¾b{*:.!/W*Z2E^ȬDkQѵ/lǞq}]Zt6ơfK82aPk1T+Mbax*{/'g(ʮC|iC_W&dS[Gjl%KH@#,-W!TcXCgh1HlUBz,yI3n*#}Wm՗Ĝ#.G|0QH1)8FvXo*ω%8̛7D"{ڠ?}QK#EƁ/a/k OGuDl"x"~2GkBxXkS%gJد8?DbY ^zEl*9 c8pq8rϳgZG~9B'r94VKqg0@O'sslMQg3S/9c!c#}Uˇ/{Z>5Q \3%Eju%taּM?;Ya/ :IsWo'K6~:nOSi[^ϧ=gnx]rsuem::P`Q$ޞc}m/wc[DG^tv0Wܵtt3cӊש`c[7Nѩ?m=LOt:C F{]d;VN:XEn96 lmZbz3a|:}7@÷<XHCb<̽F/i3IwA&)c!Qdn".ܰ]Qħ? <22SE}rM>+Gi>/DS zhEEC*30sҜ[p y3;||e/A_"%|[.E̱!ma<ab>?^}r}di.7w!M!6WsxA>S8$>s3~{xra=Kv@P.!-B`vX+R~MɄY_i& ڌ )#j*HO͵YĖ;;ջy2UIIG@8!5ք|' WҢ}# ӥa4c]aD`DpE,h[Z҂QDd}̓QڄiY_)ԾM6XЬ޵@H*fzŞSV"YKTNv[NW=prEԹݠ-XJ *ud쿍I?gf<Lyl};*GCmYi9'glGx3@.?ޡrj};Jk {U"{ZPt}vݏeh'VD,5_car/data/Ericksen.rda0000644000176200001440000000376413202607636014202 0ustar liggesusersXKpSƶdpļAWʽdP3ٜHҩqイ1d36,ɆUĴdi2ti)-Sڄ`2$|,ر_|l@Rܲ&jjV_5VS}R=jޤ֑lq'|Gg\qĜ^ョoEg:R8끷moZn߅go,ςۮoBzm4; W wor~ ͐-yxgFY"nG8#7 ު^vEs谢UԫhT|D EMEÊv!E)D+?GQ$(1E;v{PQ yEFM\Ѣ_*:H?]j+) ؗ4W{= }>@snÞ7@x9;i~no y'xtbMsp:' }~';/o~q8Cۏ>Q9=Osaǰָw7=׉{>23k{̾/)s~wk?p8 ~?^po>G5S} pPްsb4kVi޷]z.8GkNc$po A}=8IĜ w!N8;6@qq>Y9NR=ƹKaM8 nQ4M"_@^˫i |.<>w ,dG@2_w:.3=>=+grC.@zՏ5/.oA{9wm4tN'{xACT/ ~?'yՋ|$AHyÏ{ǼM#q>COrC`{}UVOּwKoZڒ2 B9eX.̪ʍ>/ޢhuE uuu_ɒu߳u߻b_<_S*_r8v<ʿ>4C%~US>~J;}{Op?*_E_wW]:8͈gת*_inޓgvƬ}/bgGQ:ӭ-W _A|U~~ `yԗ-fsu9e G]][d=ۂ[Ϋ _g٬[NG:1ؽnfou:5o< YbW7TRqaeyFZ%f2Pi9{%f&-]鳼ĺ#-=B+d.[b[Vy :ɥ_&)e+5|:ϊv]"0c^^0N˴\2H'o?[Ε㱓,șB0͛aмA~eFݺ,W,< kgDNm4j9Ձ@1# j^A ˾0^m3 kɴu;z/2ӲS|)10mGrd_9Y/,b"|zK:4J2ZO钫v6H}^,~V:g2AX<'/7st_ahEȊyPJP_ds^!4 w]Ah0(u.Ցme9_;±qb^MhA -]9VV|kж })()u[԰:1 OqR1]N"5}+L̖뮛3E+Mcar/data/SLID.rda0000644000176200001440000006401013202607637013162 0ustar liggesusers7zXZi"6!X䅚g])TW"nRʟx8Ogrh,ш*?Y MMBFFLWd39{>*"j:9a$m2  -e,`NBթ$=c)= Եe=sclqA'Y9U3XoS^ (g0'Y/b?(*Uh8D ۨ0;wu!F&Cr )Hdtg";* /t̩> 3!7?k/QkjqG-o/(3 /9b؞N=jDbv,IxևlP1(z}. N\) n/vFFyfq2 rs?-CH\fH'yFMκ;1e3@o$$z!f_o  B,YR OwTq9)7`䃲\^n? $Vŏ.ʄ"zRHˮ[Lt7'g{B!?wW(W[3m;7g F {0@J"_A 'Yݓa!1>_Y,T5vD,`59 li]? yӀ@Vn~#b{<j܋Nx?.0|Q`@A;f_㣵n*I:+.X]FN^ ٔ}vΕ-߆ʍN,"[[p+#a-y YqD %oV R&a+&n`\1pcXf6ɦuJb2N|)y.+!R~#Pw^9rp R&sY?xCO[.F׻;O>|j K;Mؙ I51ӾJ=^/tBw7|[胠Is •OKAMDC4sܶXKeܚ #QVq1/ l$/"k+K\ip[7MU$wq]W|`qAmOѕGCV} ?7 ܊PC/WTjs:|݂*e;ͤvS`5+c^Lc"F]Ahsq(` 5 k-31kL5DґKP*Y1h&iա|@O%Ƞ+/-/}k I>CQ`A.RPBlbm_L ?mC;·PMV*Q[5%4s kjҜ{gkEu" ,ɈlxÀYd68_9yA ˼f]sDr6ɧF:GwLi^w.l%dC@F~;Lwߜ/ mCR |fhK3^Qn3:j qjEASF@ǭ 9dcJ>-02'B_,&H1S2n^jM9ӃI?IOWJ>B!O(N\) Pd{eʥeXur0KA3Z잀Q}TAORAe ~yʊG:u YL0ODQ^\,rXB RR|#xWT绌d Y8 ϕ(OYH(H e.}u.'b.BqU7/,%̌N0j8t>HMz35w,r*/ J~J"U'4vvf5 s`*  (~8 # bL=ZL+P\q8"!+s9^gDZIt[t F#3Xac9ia%A٫x߯;!S`Hkz635N_xC3hqY'dv^&aݣYpP7xdS!]0}t-ar 12yG!fEӁ_Y;!fs&1goaĆBҁGQ]Y(V=m4XgTUzCQ0sO @&ޱ)McM7*{$XZ?ryjrD֒=Ea<HT~xw㫖(ӫ( z@Hɻ#PylC/7-{ԂjRC/a$hkD}+vk1t_ߥE[+>Ho B pGFGSa}n:J~S? evdM]\^^paz7JyE^ 5;\Ū`1 Sgb=̰Kw-8B:2oa9%<}kmXy6AP[.r _^ВQF ;G,T D"G`ܔPxPZAޥ4+5L? $U51)7NMB f 6kZ'7K>g=F~XSqgxo%d: ۮI! җPn;\]Nԫdjp۶FWRgoc)ē =DV[E׈ {?>VBݙ> u i/KR~U^Q)bf-6'gWeIzpa;ALzl.yJwRM}'ṝȉwIe[mɝ))3f09N̨,'qe4jGh*OP"?$'eLpGApcKn$ 3ݞX] j!tPygI($ڑ)$&m~-uY$~\~cSɭ[bׇUqXQKkjH~W]APͣePTnٿ' nعxoL)+lH hm(@sppZ 8Td{P4"#wSFY}ѤcCN.]oc0S m/|?{;ۡ҇(i+]j%rkHSEb |Ū`A0 RVsj?B;qE.}z"mƂ_;V-}PS]T퓳@¡[^11?Gʭ,Sm?7Nt2:uh^ Kof= Z"d{ e.\'}pZ!cPe`1ˆȨ%MNhN%-Bħ$rm{ps_g >Ԅ 0EvhU)X.㖛 q4o/,.Pf g&uS:֘\7hGq琜'Ɋ% +Gf=^+`h7?|Qj{7CF=_ےf${)u ipg_dػ"uPi}YŖIso^.sk7'žfJXkR*U1WnB ?')|l-.[ɤv(1bmhp40[1yv^.DPojr{RC9B6͐I <ֽ}yK*1՘\gYV+3BU7 ХHr$FvXA|_Q8dgT 8%Lm;Vbc!(G|~:‘ y|>ӤpPDu]dkBc Iqޑ(E΂#K\-hURh0p3g;WVv6"znGi_qzw ޏ1a<ֽI$sJ9 TzIt%"Gw ce.9V'jeZ$ } v$ w }i)G&P vZ2\k^;n])9CD5C-x4c*V7DQd~2h\֏4;ށ=rV bìc^qQ_C w=9耄Aɷ6eYx O= /zN$=fJ lsrh7u7mĭcPԬ"֦c"KRcSNQHo?s F3O2g.r%46JJet KeT V27Dv[\H{f-^A硧)`a4ͲbeϺm$T^Hf/69D.(PF,Rg 監xH`GEg0MVNGjc׎ ~L}׶qA-I*1CQD^D&9Q~$T||ԺAo)ߖds?41)p6!tq ,O/aYh( %nNWq'͗:E[XfpK9+ :Ԛ|?v9.Mܟ6^(S/Owo3cܪZfB)^ =QNe TOEahIn- SݱeqſS|CCBz}OAǍYɏ!z?㮅TuH]Z~le񺒰ʮCpSFdle+$a2Z.☧Bq!˥h+"qb"oZ?)=76=N:8@HEJ *F[@%WbGQw)h{gAiJY?iH.pBа.{8%%,*FKKo`3($?㶿=7b?PK& ##$]by}:X2BqǞH]-Rϊ@m^ZXp16huɖ>f.9 s 3K5+L͐<AR2O$[Ak p?ԣ3 h8Ʋ7aH<̀2A3C_/0ϬHH5:Թ1Yċsv.[^\61ol" ^vaq "Q]-Sr{m\KR[/G/QxŃC-aS kqugRr8}c Q2X;aFB:ȀT.V:~)tP Ugŷ>pFbi,GA=}]>r+A=< B`KoBTf^N3r!lV(#%MJƔMǖۤ_1.F$[(?@DuDAǡq=BB }@:0G490 V({:&zOJ9z~II:fڟxtVuLp 0j~OMb25d?y`lDz=I֮.2(oS 0_gx $W!Lj!?}q3 <'*[%[3UQ^Μ'bXp$Ƣ&H 4NIhOz>I5z(HN&Nd*^Eg ( 93?RwGzkp$m[0 Ď}\+1JNxeg}j!,ѤO伽}C,22,CPyӣ}!嚌@^B5u߇W-EEΒ&!K1RSbH[sgtqT'q)ƈcGzM G= _ Y+mS]Eu&mΆ V6Hۡ- V9bǜqxS s@ /8#GNQj`M)wkCTqcwɤMvU[YxKbjQ;`fYSA9#_8WC !IJFJ ̘9ޥh `JoJp)c\֦N3݊,fVӣ5VU>$TD \7`l,*Շ37(ޜ@&.}vA6@li B {kpXzNy&JbVE:Wǐ;;`/t.Ri+PDsv֒V lo4, kFַJeL7G ϺmUcqw< idPir]<ꑚzoO?j4st*0fRN2'kB]p-*%Eܟ:z5yv %/H[Q4b/ʗֳlgf#HMESt}a&wr2TkB.L+{*'ub 9XB Nɇ5VzH|NIm$ +&sìhΥJmuYSڄPȌQ WxŲyY0zZj~DsT=<|Pl^Gx+|CcT v]O9ZG^Q3LC',([a3icS0|U@D}vVρR`=삻sիB. <4CS׭Rg-$ kONc EcJSr䑓&@l50nr%~6S)c'r\fP/"2 UJl6Ք䌜78`q7~.NXkH930Zä!=X* fԲ7D^*GS8q1f/xEN2v!x<β qV7}v$6hj֟p$3Μ򁈾j@~✌n^umīgB'd@V  ⣗Jt1n kȡh|A)RmBsLG̥! x\A}JmmJM`2K{andzx=ͫANKd$%fKҴtI3/(2q(kSa&DGCbJގOmxXeOJ5mgV(*/ՀѭІ]B W82CIo w7y'Y ,Ky/י3;y邝[qcVnbUV Y[%[%M]H+8@#³C#I:uZ{Գ >w-i4j ߃{7WMH J?VQ!EǑRA?R҅Zai$dQ:Rw', c)TGw!qSwU[siX[%dpȯQ&ō}tG&yyZ⣫ZL_PQi?DKL",rL Τkv6BeId>i %G83'@dS. &sj6b`ʐ+qF|)?X-6w4 J|T+HWI3=]`ܤTvUqR8HE5oь(Ƭqh/ӄ.}Ssn] {RDbT7o1@RnY;h U׵C'Ҭyv6]z('l+zv݁N~( ,rf򟣔^kƚ$UVhtT4, e|^̐CO) wB uʕu1aZe3}F*6 ئ{r##vE%QEY yHQv%fB$2έ~ 2Vdwެtt._ 1[0K=)O_Z^q=9':%m03|8%]YC}Um:S-y9 yN>0d63|3UUU`5^gaxhe5쑯d?"䄀rl'_x.o ߿赅=9AS@k%N?oOuvc)jsuM%Ng*%;dcN}vRg|b7*ja*< 48mز2"B]wK^{`Bھ6M4*z,Tc-Z'~YA a#hRvXYIJKpԧZOSW/DˍȂFn5^.Os悰qqY1iHƐbD2*(T:uVtʷJ\I'E(s.3:yF/ )8ır%ݚ= t.gZHUhleT"zZq&% 7mNӒwy:[eg32X`c+@.2RjPGHOTp)t@b;S4L*Pńs#Ϛc3<dhݚu=1~MU[}H}6wZ粛CPBNm ;! #W}! !A`幂l'u0cO7[tԅ$>Xm&}݋1ף1fLn/Ч1):5`J/mfK`;I.VC݋{v{,w3SO;c̫7*[Md̰BꢫUxTW1lȨxVT;PH3?X~rR m%94IDE>UU 45 ƾSBfơɾ̠AQ#$) p6A)@Yڗguv濽$ 0Ak// Z*jd1?-irpz3lKԫIEZv BcLj,9RI3Vi01m<{ZuL{Fdz)<۸X/DWMfx+Q(b6z72Lt\;OY"}G&gQhdz,+ϊ٠28Q姌%ѡ*(׻gO?s}I\b|٨Af['5D}4Sz wO{+5B|L]ۣ1n!rs_IW"fFȴe/tB3<l8Zw)Iψl+fm|~TPK6{YL5 jvlfu:ʜ{t*Ŗğ 0ɳ*D Ǚ?;|~p:mށ&p*dzs]-Q 6Bƴ_>F>e&Ko78>f uJ|tnz~NQh-HER>7 ]Lm/Xc[Iٴe@|<;4Uc* `@hW|p=EnFM5;,d|ggaaN;}WI.z 8hswum ObCwMѣG3#s[W|8j6v_,T⯍=" N%QR]~UZ6c:.Mo 3r,}%BfWUnGK~9;[莶cִ״-sԢ$pŨ?䲦NWg[o DFG%U<>;w+Tq-]S헅0PEۨZ?t,&GI|/Rې=a4ؽ5l0Rۢ!7;4dIy TJC!eoV rhψgq)E,w/sׂ| >\`OFyGC/x@d 7ApI3Goy(9LyH9goKh}Ejd%C;EIFI//AԛG#̐Xo} n1at &/;ӄ='DXb(s=, Б'xw4>KTfЎnphK\-\XtqNQzH7n$;-zK @(᧋5BlZQzm%e0Wc!8rb*wjaķ;5jFLc(Pṙf@@!l[PΡ%1kF72$gR+?w T ԛp!aY z]3*o)@ U6w@~|GϒXmxA ؁XqnlO-cҰtY_8FozefT.!rf0$9̒"KEy P aǦ)TDYp=+V1ix2h٢qڋ 'K ?M-o\(A Yv6.60,:6$ӛ8qAcF-Eu ;S쵱OD;ZE' 85t*N{a<#h2[wz'ˎz5Ss”D# Yhj~LRhc@2IBxˢ[j%5PmCGU#3( !EG>]-6:!#if= _`K\kah#:S* 9H 3~q!N61*MZ(ڂp5? TtSDc]E53:W7b ]eOL]O(G3l;Qr2,cx^G|*LLū;R=0jϖ88 [\"I"k^K IAԹ *y[OY2YQ.lB8 Om>T!{K2Q%H$)*bbρDJZ2a4v[ ?SyeA16"N|ð-]K4Qb6/ Sc%4#`iCSJ*;D8פN-sT1$#{^nVSYLW)z1* A:}{d8 #g0BGLKZJ:hM7Hd<_Ym.+}3UHтgn:ˉMIcjY%̭`mljoOF÷C83FIܤU7,C]A;Qe;#.?NP4vbih`\choW3G>ffN!W!NBu뜋-bI)E@DcU ?!p&W6#t%yQRͤNœq{-j u?#:y< `r2xF+n5w:iȞZ) aD:aCh!V) ̈́>p(!&.Z؞};?m4C/Lq) mkr]ifse<5Ֆ5X1Zlq_mkn(Zf+ CԀ )37P?Uq4pOrz[ fq=eצ649\ Z?Ԗ!:^t4l9un*i 1KBhkt0{9P÷~9gu髡"eI\|>mydM-VryC[:6"stML} e>:'&s ԂSk~B\x%_j[6HB8@XƺHtCxw.˓vح{'P ⹎ #phDr@#|B EPD?'+R, %k%Zc4 jsI-~ TJna?fNXv` 2U _T373C*a_ ,@;F{ym*-`D<ԇkxt)B%G+e\ =}$E'(q#FT Wx [9ΑW1A կd6x$B"āv[<6hQwT&A 6h59浅y2;bf #S(F@jt_l 16՘BJR죔+u}CNX .c5!f#V/Aʢ&1Γ2>jɸVA5 {1XƁ ]D',pc{8BHow%`>?6]bS$fePP2!D;q2_>*8h@arEs76Z9jL toݿAXBS2խt\OjE $bjv a < #aC5[tǹ c8KzDnM `nTL̰Tr 1 xT뗮R/ %`OՈQD#f;iznp_LX&@T]hD ޭkV+0Dq<屢"NyN [{~Dcg~UjO0vnVߵ4ؽj&BJ:Bxߊ^u٩qy <fml+Q%$4Afh2sƋhw5+K/>H$fE,ed\ry"B7~Z<1"v" ?2rBBWU;,16)*V2o-"Xg6~6aT\1HtA'XJgrCGV/*v[:raAO;b%J3YVeR-.ґ٪s;C 9*Y~Sp=$tI!N#iȢNdnZ$U`]M(>;T]m3í D\@_*IiB?1VDY<țH)#BJ7\mL,Ѻ:]Pi^Nwm5}YF:@vG6T|H!B?s*7▴.h`Ż !vJqpdG^#2G9MRF1 ^;(|•߄s)@jc iF B&WIm0fRLu9KVRNO>Ȃzj~n1 ~k+<.KgZW8>8 P*h<@$R`0 }p 46K3aL1pښn@3SlPXU)GQ6+~g2c&D-$Swud3LZAmoM J,nE `M1`gˏhB(ҡW3},yqUQU#Y:==~pM|U,H&6."vZ79 g\d#\Dv"ܑJRl)՝n Ͳm 65#V S<~gczp@߽s]Lyx߆޹0oGU(FpOv_X>q*`c#J@":mi eY̹ XzlIFK KQq;Fd w0= =;z7^g*oq#vhqGב$8ˋh7,E voݗk6;QvJ/̂cqkye&'M(?qG".-JzUi%3т+,ǁ*(1,.WgE[VYO`r6qw !n[gK"v#-j'$tD˾s 4DA3HSAWRdWѣP1q'Esj|ǹ;m$΃V6Io -r*>$kUz{q>!b :9~5R >7}$Gz<ǒIɲUbXyɾY@ c#bɅU3}l33Ryw*yv AcPy+]޶`V;תCe-ҟ hӲJ>e}9xQ_3R6e5AwSq>=p J`8.};6c# yR .SGCDj(%*6.(Wc3$?Xe~MF/s7<m_P./ƲNz *IuN P߰shwzM6'd?Ns'"U^]³\\K-N <:Nz\ %~#z73HCd|/] Ʃ:LTc^Ix5c'PLj9X׍>;{it]!%R\F^hߍ_;"Zj5KJ,}ƟqɬtNDnfAD9ER^TC&C$ce k2Q$n/5`;;1bpg I>h{۞w~[RyǨ%L$`G\}j pm\tF wmnTA"G=bӯ{ ~` |\a]">z8餤e.6ԃ>mkgtmR.򉇳yd\AdMWj}M : 2Ft>FsVR#q}33Uh4 B!az0U}=gpT]81Em# SWz'cD*~Q׻yشe Ƭ85F/kcD!vb+.*`&&j3gl= 5E' .0Ҏ=u?BҡZe ƶɤb=TᾣJMM42:-)ޫW_OO<}Kod,,XĴp٠r%z0 yޢ1ԉG&z=MqY/ᆋ^ ia*]դ0 Jَ911N{X!ֱ8{uv~LgvN䨳nCJ!H/nnԭ ~T8nvJ 1 /'s 23,R|{B¨]~*yQxѮ2s*<|7*KD:͒RP8ÂO&Gcsb@~ 2D(\"svfλS $Pc$|$5fXTUsƼhAaQ(M$l?A~ulݢdcTH機—O+>=JC &5~檜/?Ё}!%LJ5n2^d.lf dotq{ǬM䍜&q( OOGQɎ1SO zhp.&M!.Jk W(Ua>46;9޵%w{14e^h1+؞E 5XmM!i57:Û#7f  ~ 6Q!Եrv`'/PrϷt:2rVk k$C7*&)gb)  ͏H޲Fd i iT&- |N[x J""c rtHfOdp lxBE*AM)?_CHavَR_bs$h5^zT/#uR\S m.4Ukhp-B4$L( N8z>CCDD |%(W 3V$m7#+Ѓ'Ks)Enj0#듫!5#1ֹʭeTU|Be k}qI"2\ƶB?5" ️J#_S5RJpMK(}p;-JHU7 h+y+teҖ\sKBhǑ;&ڬ%S?[vV"f+/ڔU >}7v ioE0YRLsk_ KLxϜX l2iȓHيLmBHkΞpdszCܰa^EG|^L(fۢi'(5Ū +KUy Iq3L<" PZ,̳WҖvEWG6YSV[`Mjs4ķkֆx>6,"5v PS^Hf<Ύ%#R1AsAW +xj!Xv¾ Ln$ O`u ZV6O3)L OtjҁjTb{o)7`˜C])Ef_Cb=5|6VBmHo ت` &Q#Uu'p!)L;W.6!<9DHEAU\gbl6|'Q묍]N`ۂy>~ o) [Mn "n[ĆfeDzNhƒnҥq3|[sr,>ϼ>17rs[9n t_0.8e99S)TPBzPJ*xL6[M/C$sqt*bT}ܱ>tFMjm> {4nCU5Q 6_eZe]*}Xu:㿏2 OūAu&ḭLDaP{<|Z&"xrfv۬G؜FT#})k 'x!8EçuGGzo铔[:s#HUȹ+'=`[z&q5{<,SH&`tWK=q(ώl~YRc ;]idDrWW5e0bWC:J4 wU)A:A&ʯr!)J5Se斻\֘+ıgKEIVnxrOab{s^u5zClEs@y&wywi7MVw\d@uAS5l3-yۑB;-f- 4'3LQ:r/*K/JǙl8f<^!ȁ\OMF&%AiU\sb=Dh^34W9v\.yh-0e2IMX< ^5rsz^Efկ, 7Vӆ9M a (>3i.yexբ;eUqKx )Nd l+tO*0)eKcl{\3i}]MeqUjOp{ NrU.Bُ5hC[/IPzz86H"/` `ӻtu)Zct'ʋǡ$^!ntE6A!a&2;v5&O܍QBL;&'9&+1_L6 S)2yWW);|פ3!ޫ+2,dKy=`mDq<ׯ fd2~ v y`cEV{,\uwvct^WN\ata^vq]P\ˌg# 8ow#EUF0|8`Hi,Ś.T,y %qYAS0@䃝Ad-q}C37;7Cv .xuLpfMӔuI1dXi] }$/Q%B0Q(Gys@Up]#_DT; d/Mi.`h5Ybl=9]n¯e ogv}jlJ%N:<6EP㛊[?1p]sRAW;y|:o - ]yF PTu! 3kzp==,@uPXsy G~+43AgyyG4 o_H2Nĥ_I"ޅo0#^L8e"\ak}x.md60C|T(͹/zH-X_6ӤzGr4ȅY:ǟz9ϳqoցȷho=(Lq\6C穩x: O8IlTFdQ ?bj$A [>\~z$P':tL2\)l`(Vwl?nAcu]f}r"Þ)'g`lM^IXnZR&{YN*Ǔ.Ϳ\vs.Q-]14"K~xT"B:U]mveohOioYPoKv;: vW"u-I=93 bT֐:tJgcU#BԶWR8a+nQ 5Ȥ*5jICYw1!τdEp|cE1h1٤[WPEJ([|&K3! yZC.L7i‡FjOD⊘qDNt/#8opf tKXQhEo`l?}0C; k{I-{6f;!5 ft쇚S~ A& ?H~gƵf~l*Rk~Y[T+s\k0yhɳ_xO'g-͙fšZؐ*M15"*D%]!6V䇩sgyieܤ9f߶#l.X H4PE¤s7au4&oKN]HJM»c#=lc_F{LMpӲP\c I;|1\uxz'/54\.SZ JJWu- D UMˣ>ȆG^i>!7E&&H yL՝Ҷowirp[@_x94ſ;SLO_q<#! ;NCЍig`gw&/RxOS Z7_PPi:[+.ŐL}Uބ,e)+8\rkRwWO?%UQꑎz!2Vh!b=(%!0 JBD 7.K4ܳNᴛΏ͂ˀؚos7SwyN|gl3*q.s%#vLAW=8ElT0VVثH ZvR9w&LB^Tk^2>3ǔ[:@N2QfjC1 a@5* B<^~F+=Yv@]QRx+ɯb;iR,bE%G DutXK+%Pgb震n҆aNJpmo:n);_dhDN#MFQՔztTkml8,]1J<BFHѯt@TIAĞ:73|  =E1{T<2Mw)qݔ-*ȟ1~-=K%u`vrXI6J fPQ"`?P1AJ[ZnvyXZjଯp0tˆi*_9(M"Ikk-'m˲<\"-mPd8&77CZ3y8)@!3G//S9Q)%s"xX<$>}h%4/RҞJ o֖ {XDbvƑ'nZ.9jCb@/Go49pQlp#p[X4_DU5`2߾e)y6Pw]\{{ӥH%:U)A|ht䤵 `M}ޥ|# 8] کYWS<4s s6~EN̾AMr[_b^vZr?"MI^ױ^Qz?K~u͖HefT(bEj+Q1apbx-"3 4ZwdכA-Wz2 95!/rl EMDNfy B %oÔ &wȀhD`z).e*`Wo!,Tvg u  ˔cL5|z_'чSC7uj*Zz椆ABxvcNbtB9&Nś E¾]3gmģRXikp{i'+\6:jbV#8c*ChOq9Y^!L'6 LNS:Pͥ&/(ECN:QR\P\e+@ G(|pV.WAPm'O0wDaPbNS7k#s ˢb4995 8 O;nTj?ЍW.YI֓`C] fu ?O1\e *5'H7Ǿbdcei{O1(~?PhsnG糥k[ŰL Su/+.KE>e8W"K}NIyBmgu$k'}'jD|FFLc<>0 YZcar/data/Wool.rda0000644000176200001440000000041213202607637013343 0ustar liggesusers r0b```b`fab`b24# ', b1/K/˜QG@œH SK N b#:v2-U8Aī Xۀѱ 740n gS~M^ H1cZ\%Ȇ2de%W&X 3 &ȕXVM9gQ~~P@05?R@car/data/LoBD.rda0000644000176200001440000000165413202607636013213 0ustar liggesusersBZh91AY&SY\Mf Euc 6m86Nˆˍw#X};1ě6{1" , F4|أ! mi  $Hh 1 m $OLD!^D$8!$ʺ_1]`VZ#*T@@ ' Y//dL gN.%dE= fRͅ-6s29:\@4#TqL"E9}fFj!^1kV3*bͪ1)rE8P\Mfcar/data/Chile.rda0000644000176200001440000004762013202607636013462 0ustar liggesusers7zXZi"6!XOR])TW"nRʟx8Og0]d; hHAͫՐw ]W OӋA/Np]CӲ€Թ,T igׂ r"?+:P@Y')ynoZӓ5&U y<}g38Iz쉵|( $]zrkB.(w\'Ɣ<ۆ0ףY@>I-ߌ`+(ϾXnhV

x`> q'-lb>.ht6iNܹ 62@na~Q! zlQbbHsC?16{q@XcZ70' ?T#cV,B 7g_[M\24b1PS: qqkg"7>/|܅b]wB/>jIie ͝ȡܺ_k쿔gj[/aOfqD躩Y (A\qaõcNG̯3x]L wU%=ravy+cƾvk@&4!uxWPp ![-|/_Bcury4 dE~; =HLcV;࿻AWg"ح]}BMh%Blw׀~M!ʢP<3( Fi- =CUK}iȐL0 d"9GL]`oO4Kd*? ^NǶzG ;vPhq#[hKʶ@G Ƴ؏!Q?BۇFQU^c0dVȜ"`0b$g+ৃY!4 +ynHt;ā_hi~EJȯ_0o Ѿ$ îQK|%M6a>WnO73ki 97!SQJrkl঳gxDEª5C [KӥF Yv!.L\Rz=U Kg 0w‚UVPauM~^m0c\7g?Fo`|!?%u/:at* Eޚ4CtY!Vu)os[qGۋ^*#қ[iq'2ڢAcdw2X7g% hd[\UV X4&,sotS(N'iooD)!YR<#1dƒ1#8iH2}Q E>p Hˉv{Qi)qIbn$cQMؠT+WRu \(nHvk26RS\!oZQ-4/lsʫ[w[ ;HVaPr:c\Q*%a#QHFR Pnb9 O:vrIQNr׬++HJD$g$4IэHz^ɂ5&kJ\RAfzŕ)\讉Q9vs6C xf)+rW5CphK[Ƅޣ~?w$19GHkxc*Wjt?7ť`4k"lutųru$_j6uB zA.)~>=s)\*Y~i"i7H+,ɡEiU$86CC 1Y5]uH! KKJlg--7U4 m4TLeNd,X§|8mOLŜuzl77J2JWepҡ,0K # D}m>#Ʃ`rۇ}?YZX>'V/ S+fK~kLmeB괻Ȁ16gd_.`;+,DVR)rW /=|PN5Q&=5>UM5T/ $?V̛1sW*LdU#>7>;ti'? %(u܄FySBwD0/ _PrT\86;6mժ+:m1O-4|hU^(!ybw1[YzUc-8<9X.)#((sX8R{b VUg~,T'EۻFb'㋁Tq[`?&bJxF;\m`.s6 9,=sQƝt ҐG퉠 gcVLk| S*ə^q83 |[}RaYJ/-81Ems3hj߮ ֐˘Gr}#UmkYX3d@MӾ'빑 q!=L KY[T'{!@Wbrg4-` ᱗H){9}8(%t SJKʄ$?b}>-rǃ0M聊H[WĻoVmp|-{Eߞ]i<~ĆetyH%ұ^ ʬ2No>0 JVE$ӈFn'?} <ۆB>-|BXifGaw[O@B,8H[79R8YG`,vB]o0j٠Lݳ}^fOO-l>ϚQ 'vzi ӧ k8sePy^[C/X,]8ɹw@aqL,oK0*qm6;aRQ(:,b&gZoTlfF-6*L0un0! <D4L1dByv(A>OPT\Oou<[NT`CX$t}0YcCvT`_3teZCJ/ۭ6x;j$yBJ~vG^x4"*I# $ؒĚ{\:_8՜u[//Xہxo_K" VGD/ Sfs˸fܗ "eރ1`b\8Wl2FD\vJβ^))4P1+Kq29!mǰ*-sLSJ_Jʿ9n?ԏi8,i[3˰z7K&3<a!5;ء#NzimI=à J# Wrz\Fzڏ%T @uw;`;jiy@b`d ,v;WoʼnUX&뭝R1̼xp /v Qˀ,Bz}ԂR浢:B)"3 ܽ$XndIݾߜާbtP ~ HXe.|[XK\Qd!ga?LN$\n][-,"ZmLB)<7JW*؋7Tcx)9GT|ɚCW#qqVETf@4]ʛg9CrNlR]ָq;K5CLsJĮ=,V {riqGK[ϋ57ze!q\mn$mY)8eQ?]OaG˖N<:5(Š2nj BfG5~ $k}pɼ+ڮnPlW9K `z1W2zrv}Ӝ 3ڼs&k:P㮞XAy|9bWGY\WoeW~;SSeFUF;zFKnLJEҵaq ײQz$juwnQ疤9:u:' l4dEhЖ3_JW~'sGbzaʐAVvwMIɀ#hijL۶eĘKn["RgJԂ 8Ul|u IxL'{bD&#WAٛ!Gf).v^ON_7ocuhs!X_d9J-1[/E2|r?hL^Y,\$e mu?'TWqz)W̛za!{*ѯq-)]L/k <rRʅ& /-tj=u#N+-݌"^vӁú! Z\^Ս8Qq):s^A9]`yt7/f$`ktmx>P}S}Vq}*GHBA' tf_yBXFR>_~˧mշR/kG31{5t*FGΡ< 3`98ui&⸘SwL_Q5I>ۺӻ :zoSBFV,c=͛kEG8q%("3|V2(~4G_GI7yg(SRHT:CMWOg#HF!!<1#L+*YU!CCG!ū:7WFgKEUI3lgoՊ5e00Q"Eu3+Lh~9PP0_AE(!}7G@V"um` ٰUpaK{*3?gt%"޻Dq"_˹6K#6_IUۅ <>Ռ15Tq?LkW{o5EfXJ(bFK bR]#8BX-c# uageḶh>y^-7P t;0|/[98pFP?KGHq#Hῧ*BL5[ԐܢvU-+ wm-ֿvenW>`h _P)ʼn;}b Vio\}KB6nJb2+5\1s5j &n ݻ-%Ig;FW3tUA}f4Ng"yyWPR5g*sz窤1㕏ۜK GCLF.v}(yɧG:!-Q̃n)Ԁۘys!,٨q2.o:3XkZK%@n!w1s"1=3+ש4,uc8PU0'eʚ{=C\YdsԲ Ua汣uo9#'l'n =[y >&o ϶;]F~VҚ*+ɖXu騕d_m6w=⎈S m&[P:qu ޺d};|/J%}"M(Vߧsr!^{{i&n{:xM]E'(Bλv|*Ӫz*Em}f\\VJ‚q'fCqQ% l^H} (戗F(rNևieȪȲZ1>ƘۻU~uno+HkRە.ۑ!rݶTw q%Ce.R(AYsRG_{ͱ+(a9W[;vDl* l uȠ8]N}.8.yUdԈ* Ӄ+9YyxHjv,#QK릶_+7O)XCLH.ò4ƏAZLӂ ~݅xl5? 2/V]vr] XSzIe~WFe>O>,p2{՟r:K/:o"N/5XKINlmEmiuצ}W'@Ӑd"N%OGf+ ~B%[F!+J^`j#2]}lU^VGdcKt$k5&j 9ߡ]FZ=_JXa.ܫRX,BQ:cAd d' aILIdf%o3:% ruޢvD&U8ChuL35:^v ġjJnn?uSlߩ;[K'Z-X@FZy:LC\'6D9CU1n"jܒ#!c@$ϞKV^ۿ0^z0H5p$-tEO﷤T`D³w1 j?WJa6͛8҉3 䛮`D2wG"/#lDDLe3')+э}z{[Kk,V8pFS$ 5sۻ'_ʡe B'8?{`QێXj9f)  {$#@ƍ1:D=P˃k&@Qb,yVwvX>`qԕ2 @_U)uh%V[R!#7&1DCe9Gi"a3X9dx r|[ib>͟ !B! 6ݥ/,su5kx^B,KFN֐P7ϣ6D A#Ǧ.IjP&(."Z/RM; vyedjXih[GppĆ?*:}A5_ ~mODIwM& $WZEY 8[h+^(fॉPJ\`@" 0a uy5Iț7-'%B JZy`-biGX$1q馝{߱W[Q&>w~jYF  \=~ҡ+˭q!㺪^ +׉^(|U<_<7=l6T( z*0ZԞ/'WO~gkGekN!ƴv NpC\.@Sȶ3P`{p43irnx];uS @8C2t9B0h;O+j$ #/o#:5>j{^3Ɛr 7ҁtF))Z;D*op~; ˺wʕfq6sF)lmr/iD32-2t^=8]ϡg׶6!v)0 wLFH@a5_gTUdXbo !^ ~^{|)A^-v۰̇p8ܓWК}Nb_6 e矄*_.Sh.3F0%Pbmm3C{ߕ\+g ~Pq;6C͂v[b|iӦ! 7oQNix]!4v6B?iz)5x>lCMbĠ`hdMPh^p9DZK7#ɪ[㮓\lFZz9eJE$om|jeId>uSm+fLԋ!ۊn" rlu#j A@'bd` N;ϥa-?]S܆ZĊcǷ<6m,>:DûyErJ~QYjDg?ŶX.Fi?UY\ܹ,= ꛓm_>XyQdpEFl6|{WtDžB=rۘV9`F?}U!9ָ8ٗʉOl^C]a͓Rm~L~Կ3^p( zmJ|0@i IqO̚a$SOw8v+( !`Sͷ =(Bke/۪vr3ᩏxJe n5ĘBtPf4C!Ԕ"]Y"-IDlOpH2NB߳FN}u/ioZп0 HRh"=øE5ރV adEHP󦋵d˥C1 (Zx琽LKF'Skֆ"_skhP<=kҹwD}3P+4(WjFpi~>Cϲ~U쮟jA]Qg$,f΂zK||ݾn&c ǧa݆Q+TENt4R^[-w`maX+ 1}c)Nd$.ɰw#Vr2dr!(˥12/GkjAX&:#Oy٠H]qsSv;oRIėp@Cnʞ.޷P473X+mI.Lw'vγYItsk~nE]}(Wv^nm`G+EWSzݜ Ǥg_2ۡPA:^,=}5*{-r 1fʩ4oVHL}_ՈhyvZ"9 4BC3SX]J*ÒcQ2-Wmu5e@%feHAfuIXcV|9^i׷Jk--D*9ia$6m,kbKx.T^s=kl1RD%!"Y8b.Of;5YjΊ }%i$z}u3ܕbΘ.@Bv<4U(P/v/{t *QށdZ*B]^1b//TsHC!(3 kc{_0|fn[L/]FE 3>}>@9* ;m;: -ہڴHۉ{t:ShMO*p+#9O-aXFLפ-󦦁t ]3l\逍$|+e$$DogA0۔6"Sl03%h* a XtBv Z;Ϋ(9g\(a'LKg/6e-l:70i0;B3K/w϶v,\?!O)j+b:Tz0NR5r3 yTd IdJ)aaY -EJ.#l|8,vz4#q.vEMcci!5 !>?w_|S$6թijBZ"3׳]KA!)VgQ}PՆґX(&[W2TS 3ʥ#fn9Q'8Wwb|.D 0YĦkIyl3oΊxBviQ*(iyІngK)qQxG/ӟ u@cqzѠt %kغ)YMj:s1r2_"2۱(l z77ԞMHv|R0&]8xEƾE6l Ѝ$w=h]^}ovz*!a aZLSUی<@L>IKl 2ܴrTO- J;yN/@ATur\$Tb-BmJ%!q_E_s ],U0DR./Bdb)6gS6(K<7`\^[aE2ڍv:Ca?NoNoQq0%d Oeي7rzwgxs| x(8G&2ϨOTdl~Cm9h"щM@-v 5G}fVo t~{)?lqͿPftj_ygxK4ܸ%2KH ).4 KgϞ6s_GVA0[E0rҹVhT9 >́%Q,g<%+tHhpq۪+O-v$:S;p˘?xwSV.ÿ\}z֘H8aB-f-,Zhk? ; ʱ?ybz3ua8f0Ru^'9mp I"Xߦ/uKt*{=tM1k4t͖'v=zBu"b7>XDTrbߕp2! TZ 8Lm9oUjO!͑ˊ58y S;ҮM9x$,a+>K9{bKIk.deh%?5oj!QHW~C-yqKpm;Ōir1å"dJk]P7(w/6}$M8!~>4lZ669PRWLFyFA9ݟm$dSM[l xZnC` IFENDTڰpK,T>a%{q-" X3[Lq96i4>Mt5:9[`f:8Y3a'vߢ"dyJ.!65FIy1UUoE'[/nqc~3#r'sy}el8ODʥՁ.J{q$uCZL#KNX}&8@) xA[73d?rpC? oty)0bm&N|JǨI$+#AN"e}s3 U+PG|[9j*Ե$p 94{xͨrnʙz @5n>a vd8Kr$d"ܗ6VpfL/(~|_B=B%"DB_K8\O&~%E]uy[EсIA$^.F:Br7G>{?xqZOdYZVS43hp}n+Lx;%UCD4Y EGw' J x~֢{,z+݆Ŧ0W[w- uzݖDqj䞪U/R0рmQ¨ 3iR䰾Z]&R{} 1PKCSyUI'ݓSsM>!Z2=.ZٙV·8R,J|r2#8IF#K;?uD)/s  ƭכ~G ]bCXf5%u !לL '>UЇ9f1 onq[Sz[]Ȼ}+5aB;t߰D5n+ʢ`&as1%ȵվ ƊRKPW^ִ҆,'D+ ,H7eae#3:f٪T,,1-aF}"bS'BvC>p E6jgYkgGuGrfEt7\tJ3MސE>  p]@YCCx뜙kr! T .)G"*CqP 8آh dzjq_=N;33ߟ@Na2X] Χ*~nrIݻZSK% FdZ] 5!~vP[!Z z7lT 'UD47o3* q{Z1c2g5ֲFj Ͼlh/m]H<]A3<pS_ٌ;~(0L^.'7 qb`33= NvGľKu^yi 鋲 ?=Q[s"z2%Hhd 5xO36/0aM)LX@*8,UK#eigu78G9bJl̒I=`4|MQ _ES;.V:ւ/`kн隮B)HcvXǠݷ2 =½6ŽC-E~6Vh3u뵨  KC"sBē|M7΋/U# Vqy[-,H 3y#,j{֞QK0VUΎ`!D]`VH\:gĈFYs4iV%Dss}Utq>@>31 fT#5{Oڻ,բHK5Eq$:Oq/2S7=XC/82A a~T-V4 S2Hm NO-x \lēe.FnE#*;y`[p7LM+|Dұـ\v/ iOf \* 6Aj^U€r IZ+Unih(ͳo lw\̎jpWy[r}<rLe.,0hJ18qVYu%( j,$C롈=^: NceSÔ UxT]K!^pLPFU{SWI2C;99EJƂpֿ[t}b_XkRY+KhX+pJ*˼ *.f:?I^#B;x?8b(x1L5Q!@G 0z`Lzz&a T_VOsrOI ߈Kt=Х^r.1K$qYƑyǫ|L"nL߿߬1DOE&E \yOZpEd_dmsEv K1Pƥ;0lސ9'w%!}S{c2Nft{}tY90q ,ޛ5S\>(FimbxHMĺ/*U w5Hd黂\t4IPv.,tU vl?:St@}߹]ܫ`µ(p9I~EϪ5C4ߠ<懈.kR MM!|sEOO$ ??] bYjë_bwx"v0QԠ)tQ5 eAUqQqOv,n8ozS/@nC ULЎ<72MyDG@z7<š"Ϳ߶/䚷YpuotD6Me.257u/F9FB8õvJD,荌wq9I]+Gk5DjӐ2vSq2| {aJq(dIKg*Kx{,Gl[eTlRaSVK9w.rNg7BV"YkX鰠DKnh:'ܨ2{Fu*{i$-W\Ԟ2w_N[SyBO1-RA`rŽExZy9Q!æ $.7%.%wB8sw6 Bva1of>$(m:mSIБ 3M @3Ȑ"B$g{հ*PPQ 9,`pϹa4Zp șIl@!$˚ upr]*ȤdkW"EXO(`Z\ k ?;Wܷ9r#ʤXP~p]oiT) Fx %TjG>0 YZcar/data/Robey.rda0000644000176200001440000000142313202607636013505 0ustar liggesusersTmOA>R^L~1&K(J6n w&E&\+&ɓٙyfvg6+Gq2N6q2Yܢt1'QtK9NvC᭓}[ Fxx9r@/O)OR# x},2ciDWjEZ6tOxZE<ǩ /C]iCn dehe:(t@wU&Vmc(K}B=~:drܾ϶8Tl\P(]6pΥMPҤM'cZ֯t,߭C[=λޓ=?RFE+pDNЀFFOߗh/c功e|幰mҾ<5j&y4#׭k=H $-_zLܗM=tTފ!a;@P_g }θo abO5T m[`ۙ#f&b]TfdڞB36'3?@(9rcar/data/Ginzberg.rda0000644000176200001440000000576613202607636014212 0ustar liggesusers T[-"9WP;i0d y**!Rʘ$C""ã!e*"I<-o[ֺg>s;2h4M}MMF4v]\|

P?h͘Q4"ZL8pR|1b44t0c ]FUSҩP085ZDmxu+e"dELW htiiJs=Ko=xVѫ(ԗh|vU%lɿ W+M8N86S7Uhmi e,-&3hs'GPC`y.߷()&N/qZQ :0_^r#=vkt"S<=zV!O咞W)H6kIAG]hfbB+"=ެA*03XI&v߶ tM-Ԛ}K2W K"ͬͯO÷֑fjF{r;1,WS!*v X>]_2:1%oܜѪ &e`a3jRGL"%H?i=O:O5~_5UWSKu"G |Fοo:i?SqUyu ^/6nNJd!'j~=Gxb`+C٠B'vGz \x$>UfW4:Q~\j2Co_"U@MR/_ |5qI.ߺ}{^}~y[@PDo@"KxT Pc[kV#q7Tq\j照8oxͺFdY: nڳ.;Rr3N"܎I/<ƏveAFz ה0 *eSBy-{^X ˀO< CEM7+0W[W%XC˶nְőaWԙs+s [67f?p}ә{5hNQȸlғ-'1f 7YZ']+ _'A׮:BSs-WG K!\zc=C:& mQ-g0Hm:|kǭV UoѣEKsO_:v$5R_ckBU~o!8d-ѧ]l= fOkZ |8+vG$CB濆V—ϋPbY7+̹Ytbu \I]PQtJ3R![eޤhfMzSMn(T{\V<+k&B=jw۽P1 P+'A9ʇ< RnkzuF!48_Pٛw{OTF?u"5\hy >i |`فԵ RG1<[M*WP_6m>[h gWD}g $TGTqO/$A4 Mq9A|PqM.Vi~nD'ybq#*"b A\qͅ(E dQ*j{Ś jC v:w eBӠ */#exh-ȿ,d{d-m372A({tEE G0T{}./7_JS{OY׋XluqܽK٣ub@s Jҷt%t:rS1?vP͈ 9D`M,0G)d%s(PbA%d0@ d0@ d0@92̑a sd#0G92̑DLd0DLd0D,dB ,dB ,dFldFldFdpAdpAdpa dX0ccar/data/Greene.rda0000644000176200001440000000503213202607636013632 0ustar liggesusersBZh91AY&SY|# 7_AKK&a ## A@|mM 4L54iz@hڀ #h0 3"0!d`р2a0d& ```R 4#@Ɉ 4 L0 0&L)A2!M16,dh,L1`ƢѨTtEF! .\]%L tkNVttP2XDJDH"ErPm!Α 蔒)4oʇLɴIdلj#4 $E%"m$&\\&:.˕Ú㜜$"AQsk@-TCk<(d`(:ss"0XL QE2ss΃J,T̛%2!4]9˝뺛-A..Bţaƅ0 $#)NtHsQtց;P7g'ʷx}!>U[րh A p@ÉtpUrHu\W..u\ 2dX"6:(=^)۴Ct-rFͨ)wԑ 2F?/^ #;C@ Oo7^;v1/~Я@hkYε=44{vE"ӥnf"wOQⱭ>B˥5 ښ,KM3C"0=5TV<UKNl[Cѕ2钙w1LˉR3U]KeekTSSk|eNQY M^(cXdӽ2=QAlg9 ZϘzCl,wjl%EKM *jVRҕ&i_p!"$QaH@TRޤHnb +E\tjbO@ u;|9pM{ytt~^\')„pcar/data/UN.rda0000644000176200001440000000466013202607637012756 0ustar liggesusers]WY#Gn{|ϱHBp- KP ʫ{gtz\[{_OMax6ߌ)2nr\Waq7X|(q8>6s[A2yq@?q>x^*ka -Q/p È+by7ߛ&im9^ǩtl}6{9LU-盎*o;G 8X|C~sڿkЁ: =83a{w9`.,W#?DnG3|@]y7f87u {Hg`"+#wAұ*ʇ`QT,#a\gX=Dt⑘{/ >rmO^@B$TKŪ 1l .Tp=mps()[}[1')[>JhE@r5b;\l:K5c2D+Kw+$ģ@ x\>Y΀e~zkX[>;vyd*-8 2aᒐ2}6x<}]#\ 3S՞a Ku nuom:T[ڀxńF!y5IqX8_DO}w#IE$ P%Nb-0WK:xk68VO@|ύԵ (0 b?}$\ %K)WRY%Qv\ME@+e0NmG 9r ~UXXls M Z_\cl5A^5AC bFZj~t ։:LaR\\MשH8֢ڤ"8y2L䰒c1 odQr2"#c<0K<[G|߭ԸKIRL(nFhJ mu-DB  "Su\],Ng$CɅJ)X=_XC3ujZ}Y=t3E?j*UYOFV9Rk XlP<3^`#t6Xzu` ziTrŃz*A4&iPP*J쓨G,4&MˁgFj xX+Ȯ'Ԭ$zˉt^WhY '`tu4yHRS@>,xϒ'ƍA& ')nߢCvv ֒+gњߢ#F#)W) b8 blr'h ݦ|=`x#W@ô" o?Zt0!4H끈C;M6⸶ָYjoJ|߂N;M恅vEC6&ح8.5I=UdPMA6I)F@7(@^NzBzH#(B$]@@ ]7" "*nV;';)g3gwrqBkack-m葴VV8A~}]6َęRH "9@I|@% !nz\$IEOn! џd8I IBOHIbIHIP,B&!Bx!KrX}I4A!<*B8 8d"O]Hn&(aO$}2HPP}gQK uYJ3d rŸDCBdLlRN}$_+@S[HIœxΧ<6u_x# GndAk^@,#*ϩZAz'zUj5O|HNGQܨ?} q^K1n<']IiCrN>.&^Ω8uu4 U;OoNW:>QY%ȩV3ɗZ]T٧7y$g^pyܔj}ݯFnUH>s4UzzS] x\\z9[4t:T$KZUcjfgECZ8s4<=YarحG5lkܤol=q[QZ7O?j͹'$K؍| P1*6E;o )?*~m9_zBrJ73eqá,1횎q41C'BK؇ZX Ќ;: Gxc^g7o7v8,pa}#ƘϔNz8hT:΂vs{a>q~nw#9N^|39y<3q^Oi7b1:<>ˆqǹ}9ua>.}1bGc\%%.za|"1<=,3vc1.qo1t)KOhZ/ϳ^g{R z%T+}|y^z]+r+ϳa򩀮0#< G%`<z};5Oĸ;z῎5ko W_AO`܅]#L] Ǹ ͈ۄOVh-7~o_+۰ކ8iz&SoxG5B{G^ \kܱ>[ӏi *xj_$t84>Qӛ1']48lV;~EMuM.B۝>$QvVt|DdVXs0yyk;?˱ 6&\ȅ}i*^1k̜³%^uk{^ou&y39¯U3{ #=k ;p>y?ZP/us=wxe&+>0z.vfǼp؛pL9.s}B`<_\C[ aWߞ+3+F`̵d ؾy4~>.e@ɂHIR.͟5s EF4rucP2ޛay痏dע%7pz~U;/G?>ߺp"YzO^~c.yv2j鎍=eM䬓xnlSL뼻eߪfϪvqlL͝K2ʹpa2Oة{dȁygߓ?,rr .^23;y{} rQLx(+[N/ wgY[>|r[-ߣ"7e[CF-u`!ę>C|-2ݥW\'|^T>9#9537I߫Ro\mپH>{;hHe5gg}o}X&sD n~kiXՃe|nrZߧS { }tCX+ZoBG2r?4! n_eo\G|өϝ΅O㻾^n'(q5ߢSwg6x=^g9PQ3{5g3;C\I|KuK_ K=׌;rfoOΞ9]〉_I{^4PWE̕ Bz/\ǖYk-\g7xζ9\y* wܓ|~_sَ?\zv՝һ_a~w7}5|]O2~|V?G)5sؙ$$l( s-'sQ61FCO5`.qAxt T *V,B)ZU_a.!Q|F!q.G:g?9x2?W*t9}IO?&C rɆh˅7 s#/J)|+XŞ&{P{11LNW9 >a2G!7i&Wɾ a}0ٮ3z8܋ZP|؎ϱn6= k\ &F.쥈l`SQ@by3v=ܢ+-g1V5bRV=ɨW9ʂʚ@EF0! m,8Ji5 d)2m0R˔fV+&rvԕLy.{%xG٩Ҭhl8jodUۨV YXjE~OB>wR(ԤĵТJڣ[jj*=T6]5 Qqd݉T-D)s(r "*B;yZ1Zj*{㧵}&LIFynjZk.Jiv]cXa^qZ*Ӎjʙe! LqOjf= DaՍPc.HdlQ4SM+{lyHNҀUX$ BX*&j)*2|[&VWF_>͟Oߘ蠂ڊUDU P4w[zMdf1SS%)Qe7ںKӵX*(T"@/՜ǀsdIcqiU,vvw8'2sU9! xU~ Xa =*CAwU^=6f hHAVª* 7MMKGA'DiȢȪ((AbXAVAEY"R`0ilxr<۶@WPyŒȠʚ01iz){XJ֍j qӉbL*$[H8BcYeLܹ!9 V;O"TX*iTRV*/kpջ0@qhR'n<*!tP 4PD @ IQH )4@d"-B C+ (2kUrE8PqEcar/data/Adler.rda0000644000176200001440000000104413202607636013453 0ustar liggesusersBZh91AY&SY7M //2Fjdh0ƀ4!iD"I=O~@1L40dѠ 4*h$Azz Pz4M]vn{QPEBaBFiT1Yb~-Z2SRҦ|wGW_#{6l:_p&(]}znOGi@ggw@#1)JR y((7,w4soMJP:P"AP$P[0\ArbB "d}}L!`)JW%h$I%d I+t3$I$AAI; J ټujU<.MS 8t@_T}06XL@ 0@$M(.(d$@im0dۻɎӅbl$  gyJ0FyxKuEėPR7u>&:,gSȻ)„(y car/data/Soils.rda0000644000176200001440000000357213202607637013526 0ustar liggesusersXilTUN ]fmd:3!5%"QehPN C$.A"%b5Y(`F,AHKK[{;'c{{{3p/vnbZ#kb DXbdY\TUk NCd5$&0IIL2$&1II2/ɨ'*,- ƬzOu Pgu 3:3k{Wb痕kd {`^おy*i[#pd[X] *1/ e8Y|nNc~kL#y\J1C/h}4q- 1Jx#=;'zOK@iBkv=ґZ/7lHqc=h]b$%*`¼ulU~I͋k-(]~oD#>W%vl9ۏ>ɋ{ "El9r"cbćeRbClv7=:e]PU)U8`/ x\dR:ħbم֊qFGlD\#Q1ALب{|Xg#΃ۤO{aVbהg|Am3Ŀ렯VFbJlBVz)Fz>\P*awQ@^T.z߃q]Xnu:^U8U'NU2TrK_/`RѣZt.!v؝UKSΗRW/a§<ɾ8W9PR$yMK$e.gJy2[E6)*)/IURʤTIY e iS2) ?!5 ;~,Rv_)^}N(ʘUJQz.OmlpO xx\Gի6. j4;a=YtW/U=i}Es@/ ~ґw*Ʈ3!/%!ʓ!7` v>:faRW& 쳑Q cҐ*SC&xWQF\.oFÞG8)TCu8<ߎ{Xnzu'pyr9Ex[@uߍ>U{+dy6z䀯r_:+(h_gX/7pS \(ď,x- yZQmׁxR~@>CO ݸ?rw*cYBeK*w8zXTa0hZ.X_Cs]ZDZSqh:}͢ +k}7z3 z4&dcjO1z-}(_ب_11|c c>11|Xg ?c~31`c#0F1/euec kSZYycar/data/Burt.rda0000644000176200001440000000052713202607636013345 0ustar liggesusers[KQFs4RkOA!E"1~M5={3FW9"H=D)JS68XF1ځ'[  tA0CK<}p .9=p ܃wW, N)$;|4A \p?aų*Lx?_c2OUN3gEf {Gfl?3Vf5 9dzwBMaaF=TъRRRRRRwŊbZ$VUjbu1ihihihihihihihi'sZ¶car/data/Bfox.rda0000644000176200001440000000164013202607636013324 0ustar liggesuserseT]HTQ>RH uݽ޻zv]W-6PDK?XЋK(ѓD=iESA%ݙ]Ova83sΙo曹[%X3XTXƌ,[7|ѳv,;;k_jUk;feΠ8.wy7?`:Z=tΓ)^=<mN^G}㻌h7~Ռxpd^7?X]Xo_:5o[` dHHX 5r2~/0X'i8R*ykyt ο xSA|M/צ8 .=Go:d^OM>ͽf;q.I_:Hv I}hv9 iWzܿ'd΃Bza \7Hڌqkhm^"?2ݓo_y1 ޫ}v̏ۿ!?[S.)=]AꨟÃy-[Osy5ڰ.7'[/a!mk `XWـNwI{?a}[z71nĎs:@NQB{XJOịt lxn1̯(s& g *wLska=4Կ7s-45Z轲ճ{̽m>y˙3w93OB$x@ $:0˸hPe{$vum /-B~DHB4 ~>DM?tb|k/AH?`?{ds@ W I_ja[{O_;7r{#vb}a@ xЉ{>z )Of_<LGp.2 8f "M`(;pC:J_nUn{qE~ߋ{Q]usS(?~9{ѳ(y|:ץOy3@O] ER@ yd}q1(GPY8Qoƛs~B}ʻ:ہ~k>#W1G<7{p6Gקv%W{0<~ľv 6Ә?GzW)uZ#}дRՙ0Wt ndґ`^0: aivN& kkbu`ڇZ4I#]pe:jmkfU0-];^ӷk` F\kBj:mIJ[a7LwU̦}*J:b YT>D5ץ0e)bf\:<fpߔ4M0RvK_I*Sg=265*Kն8&ޗ`gay52QTTzG|juԴυ1ʖ `x*)t;4(Ȋ֘du3ڨ:ZPt$?8NEݡ6s:Ƹa} G\I<x_3|=Ackp kSQ=5f0779K`:uaMa7$p<;oαyR!lZbn;|,8SZ }ҲlF,k&V'[b3H"ܦPCS xzk{L k5Ӛa)e$Wg=rcar/data/Prestige.rda0000644000176200001440000000526513202607636014217 0ustar liggesusersWklW?xmo<ݵqgB$$ib;wݙ̬~O[* @PT BQ #$* %*rSsl!~l&~Q=H;_|iŸ:/ӯǥ!үē>|Bݗki:g5Cz߼+O^u'II61o$]4pA'N%uES&½'/z⦌o7O$IRR|y`~xOcc퇠CvEzl܃h'[go{ֻ[eI߄Nq(u8ǀR߂.c?!=|2C,43FN~&o1?H]T_'Rp</+?Wou{6EPK뿣|}~+|>u/De_+R?N).庙>;Ay{9sN>,\^l4'9{t/=]9=%si)w$$}gi~yUoq!OO)9?}K8##a1+)wΥ?$Ght?6 cS  oq'86u] TBo䛥oNϝ[lm؈^҅;=I s= $%Oo$*)`O&@UÌW=U`=ě ZyiEV2JH׊*j {{D5ᄊyDJ'ܚA_ukgw^i乧*m_[ zb6}ӶivA(|FGWM[ ayEOa!M Td\˺Pɵ00uY{^32=82py^+pϊ2]|n]#=Ӛl4*(@GܢgaNƴláQ漙ׄ5kZ<j~Wtb,3./|)eaؖFxF *6Lgv* yҕ73.wMn)Κy[fDGz" m((Z<ÝN5 ]<`3AŢe^i-~vRzz"AL+Y5ֹSqanӡ fL`];B0]?,@=Rٲpw*W\eVJ*9cssB8D$L5{9o/'i> `@p;kRVp[# !c-$MXȄ- Bİ:Vt2rXB>R-2<aj**VB#+RjFK,x{1{8b @Z &rVC7+`Sb Uj>S b4k"k :ca"@+ im٢l3vmsg.}^ dCx[fHB,v YE:U&~P 6agxh*/_~%(ڎwޯ h/.A.>rby.A1nj^ٻ|aO*2[o5u/;WcĿIg=~Gυ!9cqY{y:AC<K([TN5J 1b;{aHd}9ޣAj!9cNָGك(5CrnHz {=HR0$xΜ[CǙ=(5gq,XEK6g(y$Grx$Grxsx#LojSm1i/.LN:SVc.?*/V37ڜ.? wUzU^`-̟XL8I&~$ed$`W8ЯрFFFFFFFFp(Q G2e8p(U W2\ep*U O2gଃp\9V?v sbKdrP9ȦrW_Ayj#}l z` *Z`{OhG -ּbdLM, JsK2дr!kJ0F01acf09acXBLp!egY&p)eba\)%ziE@y@0^ kcar/data/Transact.rda0000644000176200001440000000370713202607637014214 0ustar liggesuserse\Uw[׈! KH^PDgIc/``oÌ]]+7D$NF9gܵ%ߕP%!CZȌ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/?Goy;W>LٖѬv½{n~xE>0?oo{KK*>|¡1=$ car/data/Chirot.rda0000644000176200001440000000137413202607636013662 0ustar liggesuserseTOHarPv!@oK )UY<"MBZm8j=EMZn:BYj^V=''{06_qH[<2h8X]V8ݷ+AI3x}Nr݇G\f}@~%}:fW]5OG, ØuyGzl˼\!&h?{َ:ibh.3A_A~$p/ABo'@.#WB{'' D1U4Ҩgg?Q]Ye?|2ϼ|7Fw"-?F11bo(E#~ ߑD6#)a7!o=x3G y:Hp-:rpmϼ &[c˻5:֌O~X]إs,uc=ú\ u>nwUh]eKh .Q*68r6_rwP8:Uũ,E{);< 3=Kv'e"USv-vLћP,{8^$(: 3H2H݂ ]P^A}%%J>kzXŸ0đ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!mgc }ռj>7aعd%ܔa]؋[؞`]7aKÖ6 W2 ?6wua7My6YX/aϿ6Llߖ$1 6{pSaÖއⅰX3M=\큰oqI`+X.1^ [ ~ d"1jam= r<N<;,ȗo+5{c\+porz l 8WQ7-jؙ>>쪓po;e?Ja;_3)c#C'R7JߟM$U' {{|6 wJ{rC߃ }?wݲpw31^.l51?`ϩ3ڲmww^fzz#'2 azY~G k oi{3ܓ'1%9~98"C%peҕW+ݲ8n5pVe^d}XONHyMأS/.1w kN^k.zce|L=+/0}ۏXVfǚy'6'pkgywpR_p0`y#ӀO·];C=mÚ`-*cgV#V{ϯdMV'sԟs{m1ffJ+e3.cOײOO,\uKv9Ա$kX#Ɩ6{pA d-~K8.c=5yXcm~z?8^m9nU6Я{EI]KSmy>q|;{Ny&ZYRĆ3wKx>3 Ϲo8{}}7ψuKK!:[s>] lԫp73K{<~ E؝<6r<w`˞,sq5M?6SC-sh5svg!sֶ3l8kvl;Ϯ-L1Fo?P.?۷oaflY8"{/t'car/data/Florida.rda0000644000176200001440000000424213202607636014007 0ustar liggesusers]V{UﻏnGkGXZB(;{gsg֙{E\[[ZHjVfM5 jCЈ4BS(jDPLG$sI|sw~Ι6&NVX-X9RyTK#;vٶy㰋CL@7'\{ l~roᅩ +'8^8%VDYQ׀CX3e@k=yB#1 w"O~{ xb.p` "{5G!DĊ˯7 ^-s/J{a?ā@/.(v.^b+p5z{u_<ۿ buo`ww2W o㚏~O~W`= ;mrwԥw󊘯7/ vw=F^ߙQxVlV,_q󿁫.p(pq}C>yڕ>oʉ(Rs>^Hvڵ|HaQ}-5kX3^XFYg[cmPX\|a'߂c1.Kq+ryK>̻'иrr>Wq$e>ÔR&SN?GNƻMŘ Ԝ'o'Xi{S?q e\E?l` ƌ =_"NבGiQ@^5ǹ4}1}WW_YK bOy1ʸθ.{iW5)ĺ{_ŵ旽GꅔG1T_\ك 5W}5sqgT^=XlFC\t_<9^ϩ>`=P?ީ9Wc7:o}܈1JNo~x&>E;h̻EĽ0'M=j?'KC}_.պqRsz=SJz#XYߕ@^Z}_ߋ.:JO"}Vh1A[ֱk|pjVdpjnW6ϗ!Ezpb:YxAޕ|3u_1d6Y7ܛ8ʷs5|xּ ƧkjnkSVjμ]R RY2,Mm*Է:cپR92.^O헵:vIбUٚ=0Zg{h_ 'xy{6y^9ZZ9ۅW-UnM ?BFY}H+4Zu9p=UykgPϩ 鹮zǜ1x:8z ʏ.2>̇2?yYk~Ԉ5_>1#MI?q6߳%3S/zv=ݼ;»̢9'?q_9W!g'n;u٭(yyo5 b ;O!X ye ދ+22'7 xտkz"uicyu"Gk#}ɾlءka0i%G6m5EGQU)?Ri\ұe,5渞B{ߴczoa^W?ͷnJO֝4akr4I+WSIlX̰.='*d.v0Tc׽dR=` 2V5 n\pNv2K)xkMUjF԰M׫;,`ۀozovɑ-k7$iaBc즆_qܦ`w&jAtN"Zݮp?I2 >%*;<9"y7l's>skvN-pfܒQ;ӗQ$;`TzAUQۮ;A-fͤn^>&pf_vQ0]s}dR5q:m_g8~{zeHm9Hˑ %2-=uZ΄4SJQr%'d2r\,<gcar/data/Ornstein.rda0000644000176200001440000000355413202607636014235 0ustar liggesusersBZh91AY&SYolY AwJ|3E\u`z@2L=2M FM=#4zM=& @mL =@(#jxdUOҞUUOPh4@4dhh  ɦ @hɓѡh4a L#@h45 wX7//W2l&8y&rU $O\rh7Zޟ{۲)OrXԨ3zbL>舀X;@33U+g?V*9$Qs!;jhheBTqadV&$C0Tuֿg0~y "X2y7@B?¯@P'YmY*AP^ޯ&-SOgYzHoihu*"*Zde>Q)揬  _^j@;Gޢhנ=Yvv Ӳd 8ӴR0`IhVY̮s5ft/$^K=q^J5RBI& ii Q0 "j l`A,D^(#bQM&P%$ H#r"&XVI3I\mm(AJlƓ6lC`A a]5rn DuL󞬱dqKо$uMA2 *5kZֵkZI$J풔˾6+m̖RbAăm $lH6ؐm2YJRdVjnv7],)K2 $n@6I$Jy[r˖kZֵk\ $I$I$I+%9ֵZֵkZֵI$I$Ir+nkP+lI$I$YZ]uխkZ}I$I$W;A86$I$I+Ks0 0pI$I$L2 0 0i$I$I&ͳ;?Agm&I\QiYVqa a Up^-\6em.3e_jh۽(\|1rFnaY-ꓵ~%ZÚk3Fz?jUFS71BcI },XahrK.\pـ$5hLC"G[Եa8÷IK@o w>jRumwCeTvĄGUk )1F^)Gy~\(HG:;Ql#ls"(H7,car/data/Hartnagel.rda0000644000176200001440000000213213202607636014330 0ustar liggesusers_lSum&$ i{ۮ p 6:]- Ą%,cn(( "dbB_X !!A`3>x9{4wR^*.RU.HKC̀RQq&- n.x`> | c8 |N/I%8uwPTmR.='/A>[71;Su l zU A<ϱW}xb9=Ӵnp\z>PbXBl{$Hû9M?Yvy,{2M{k'^R7.e\hs?0C\#Yz@ܷhC_+Nል1?> yk%qܒed{u͗xruI쳁=$/}\NۢJ^꺓7)I9/^򞙑W*y:8o'c| ŏJZz9_z\_d]׳[nvN=Ba 3GrƟr>WYb-¼G_iW3G7!ќ:/Vԗ%>6*:c'ez;7{dJ=xNk%>X&]`ߛ_~H%zXGRWO=U8َ8n9(swކ.|祾uq<;}#ns\}r?KW}b7~H]N{y[dy.Lʺ)2^-}ۘO?`f3EQ 3"}_)yOsUݛ+fP+˚lzxhK\&W5svew0f={ST [Ĝs_ ;#7 @/߀@@0:u $iSOI4! d 4$*yiѵ 4bh2iMvT'8a$9a5- 0@2D !mܺ/qE#v)Y,* aKA| *S/Nf@Yls*4[ {~!!'Q<.+&(a@TsSFJӆ\PhpNLX bno<ջlK$EFEë#??GMֵ {d7dB ) !hrE&%[&Cۮ$?Ey`tdQPThH2TT# B H^;Wރ؄.7TPO4W>ASb&#JYƀi TJjL,d ٲuhH8`8I%Y]` p5H  Wcar/data/Sahlins.rda0000644000176200001440000000055013202607637014027 0ustar liggesuserseOp_uŅ@9 & KMjLtfYgff<x(~Asj#͐)38Oڧiq{9;O-aF3];ʽLҗzby3 T]CQ@?eR4uJ2Dcg161!.roGP >Kb-3bLE0Dڹ]ddž-ql7z B7C]α'[뺖z\<  Y 9 y  E H:e(m31537T0T4dfx)car/data/Pottery.rda0000644000176200001440000000132113202607636014070 0ustar liggesusersT=LSQ~P hkJAAʟ`IHu``yilm4*33.41.1u`Q1}ɛܜ{sM3ca0F:`.taTFk\ΗJva0]7}yy{cߴn:,N9LʺG:wr2ى| ~bѱN 9ʨv)|5U$ &&J]]|>?.2>0}-< ad졖%l?rW!ϩWd;\Q&\OP[ZVŖ&yFZ Y/poCw3t5a\^SXcYD?E.7<#py1tb7㛡E%o摟|u2>]LqKŽC+/4Ow'^o[ ?;3ڙ|]Q?[(2*LH\@aeH(=K^ӾƥZH#_-<>VuڧYqC|^kԓ ~;w;97 Q(^||h 삽=sy[wֹN[q@/7ܝxdn~o[F_.歸`L捻y;R5Mm(v1ܴkLWda0MALGZ^kC250kcs-,F'I+Z)8=ڒo#EVDY-@.M,Vm^-ЈMb.RBrFh C6ѻ?k ws`Tj2cfR205^Y7Ű-NT4%H/yo&S3yp̱/Kjɑc:~uiik0O 0א]؀a FB`=y97|>l EXV }MfPPoߩ< ӑjݯwOiѵp[LE:D >w?*5Kcar/data/Quartet.rda0000644000176200001440000000063613202607636014057 0ustar liggesusers}R9OA]5*(."WAbLfXy `Dil6ZXQSc556Xx![8ɛޛyVjyfBTyTjҕxٮ 41OOg<4X; /`? DDeM `= (J:3ʕ/4KF<2` PfNnjqEю`:ISQoY;߀(#1vt IV }F~!F;y$tVq?,9?pjzo-o"|@0zNQx/zEEQ Pr; QԊnޓs%ye8vI%]}ͫ" (R_TW$ؖ`G] ܦrte+/car/data/KosteckiDillon.rda0000644000176200001440000001654413202607636015355 0ustar liggesusers7zXZi"6!X⋊'])TW"nRʟx8Og0 ~:g^hw q~>B% 6vmөW'z_09VR_0J]cս˃Id _`:G_r>(I5sy܊" )&0㕛/ц}2~eVܣ֯RЃ.h%!Mk0d8Nј9,Bj@N'ۉC1ޏtGБg?k.vz;uO\޽˂YH˶uz2`a9>U/iJacY}]H8 lb}6u(&B}яtawy2ަX^ `` q%$3n7r-칚4VP+rO`BG~kf)*j-`37B[_@/2 tOœ'ca91O*X|ϟW(76xE@$6Ǝ7 b\3{ׁ\=yf"[8n)Ŵ\{x"Cd~iQƶ`>Nt4 hHSwl;(7Lz't/!WqY8&9hJVlYI+ŜhF+243όo$ &9$8MQ&ܮruv3k {J':Z~_d1Rc9 <@]cUvd p@J~/3Uk6&VCm!z{]PʏuyK+O& Djnl<'jDR+$ޣ~Η2SHg28RqiC`at2  XBe7rdi3pDy.l/Tyo}5iyk oD $qDrh&=V9 #|Q ͮyd)?0L5hwos@3qEcFnG&,A-ΑX܃_ZBaPJB^Wط+QN哽O9Ft_P(Y%-C%XL*&M09e2vJ&ܤV/ERN8Sf^v _gp GMH7۝VQV0LIF6nn&Mi\dnla`,͘hUG Md6L[ WM dCi545kG`AF jXV 5Õ³S_M,a? ـjp)ѳRC&S a]ҕ X~yeTy͈oAp2B ӞU˓A։5=F_paI-e|V*Qj6Ъ+eU$hpjÝ Dw/æuE;vUcK{ٞGVNc& Xe1dIqs8rd*5/Sem0XusB^;8gu _^0\*D䀨0x 5ls1)LkXy"ǯOp$iB:jy],M4Cl(q7zRUJC%kq=.Mb2 Ǻ(uya^3uJx,VT&đQliۗ2Ʊ:ɼw^#I:#=:ާhZ|6Yz ZG/Qzav"2 9P'D3aVAVhb_\Y -!(ކgCשR$G[A.V7}x8ˎk>~ȳd?:BN>6FJ& 9j_LZ9+ʜ:`nyyubir8$cCoD'O3W tLW۳ ˁ m$W?*+~42A5NBǍ&N49V-E4;fAGe}a3J7"}I(oYgisz%[X)$d 2??휐Vud Czn2ACEʌ<6GB.xﺃW*Yђ iswoÈ ȗ):#njv. RU؞*LV9'Z[h>8k0u fрHϿޙdvRV#A엺k Æ4uN:-btW4N'# Z6Z?ymT{} pҔr W=fÂs #;<;QLo't#jG ݾ^tel+eE<s0/M@sԅ^ͨˏVYKQ`_-dK^|kY-45-wN.dO@4䏘iܳ8I-({M"8&@տ%QؼN1^^;.|4H6U& :iSዪ c]eũBQC.8CitGW*[Jy/mxܨi|9C\FsˣyaglQVBn1lRC^]]k*o$#a.% l 75BcV{jB'w߻[\y6j'Zuٓ9Rğ">n_YYC ] 7AaJxM_4lv4M2@5l(dFӼsF'o ڜ'&0Ͳ(-1si\W\4$D%ؓІj? 7,}T/06&nk$X,K,d!k81`C )de>H:C20[{%|Ƈsw`oܱXEg};|t*\캿|l;P3.pBwɫʚ :V4ɴW^74WV`@o_ 3œ=ڊT9\@h&ɞqknib(pr wq#wKk2;Bc a'Ac[{㻒P!dYԲk]E#UcZybI5ƴ  {m[u{.@R24)qK7EEkw&K!Y[XW"~clgbזFEmSl*f B ~kC9镢 -z=Gh6\zDt> [+51ڳ 54q(ɐg75DɥJy g{62?;SRK5Ĉ>u֔5Jd{aTt 8 $3 x+/eu0mjY:"!$eyBMKnN9/ĎS/{709$O ;,Ə 0"D"8 8D;s\X}p8 AoYo4v;RQ~ :%WPM(49"}J8湉DV`l Ʋp5\өnǐOP9S rG+Eb7==)N8\ymPKU*חɪw ` Bj5tXA?k=L9Ǧw~ޥ 0"n 41>֌E3Q xcz ;2V^.zx~1 B`U/l4{m4GPi!m5NNCt5yQx*\k q#a 4uFS/+*V.IٚBpX+9eX&<|m 15vz !vQOPb/D6ɂKz<|'[I7u?Cgr<N 08L`t/"m.]Y5<)?}9VneeǒjCpjNn$d-UA78g" Lj0y3fdg+IB,S?'^ t[3"}W!;t|"k&Ȩ=\Di5q+^tN@1hjG}vpFY8ԿMMDz=|- SxA~p²ywR[gmvH`@/\ê*uvTѱߟP'm0t[Ir(*y1`cD_ywǻI֞k-5cwժSCkTuVե͟7.7vƛM/"G4Gg"n>u|s|AJO>Wj:hŭYCq7L9&%w̞ dق 蟞M@RHcRzG+5mYƈ#SV(Dz6wY>Vu01TGZ?AqHBE杌%k  9E?{9JúeŨKZ-{~\-&W!"$qsTZ,FO+GnzFJ{hZP{AdO{dJU`9:4{qȩ^K7ByOj(OqT: o8&l* q TK }"ff '~w7p5>R|$*ʔ)Et9#ŝ9TVcPB" dߗ*_9:\i'˘J7pxi\2 =HbTfE틳 Od+eR,-]2i[[uP^狡`pCȴyFS{XlR O23I0EY裡ݩ 2O9u'fuyS߾26܀4FaGI$r3ߵѯBFב)~c.N&G;4-04og"!mfNv qElb 2N" ^✙d !_پ@,a3o0ZgaY' Xu^0҃2ҪI/ZY?DjDF*ו1{wiZ3Igj8a,M ]Q٤-vyZQ9T_~A^Ne,Y8#N5y@|7u'eœ1T#/jti[ȄSR>b{:$ә':eh>J0ubqw*\3`xN+i݊7)5|V9%4ݽ{wk10.ʳxeYM58rJ<R̾yJaաN5k_0$ځ@n6GO(d7Vcgi ܾC|ss(}w:k9@f%: >0 YZcar/data/Duncan.rda0000644000176200001440000000137713202607636013645 0ustar liggesusersOAZ^˫/iƘ@1Rvkv/{[jy9:R>ݝ}fvڻ[æy^:MW0yS^1vZRqyߩ^SBy*Y58ŅK"$ SpbvFo{ ^?޿ O n6\>`9gV90w4Jڿ#ןl{:x;Js1M̞X5{n)-L|rh64b+N8o7Z]r[rdߚaP>}3 !!@;.d )'EfAWuѓJF4V2N&Iߕڕ-R(-us:ZHQ)o((kPde04;IG Xj,,~fdBPtqRcL/e[f"Ra ZN2oP~.l <%C܅-j }#{~Y_pk&@I( Q'9'ux6w8+ 2P]l9UE maPh-XR򓞑A+I <.M41$'zVq~lB%d_J=ߟ{V(Ncar/data/Vocab.rda0000644000176200001440000010707013202607637013465 0ustar liggesusers7zXZi"6!XЍ])TW"nRʟx8Og0_]W?PSEVC-^fÞ?Iؐ*LcI ML;( XQ h+,y\Fq(Md`r)mHpFX*lt#kzKRZ)u =-c jva]Dpő4V4xJܹ %t_uA9𦖫/)~yi|ec-}#Dx7^5[h{ !0_:X`ƱV7Gk-g]7 16~☸wgj վnr"^RG:ơL "apHܺ0ܳgn; A*5$4#'!J'Ҁx$":Ow\tѥ'A݌y5F$4kŸI!t߁xaAJ,oVd"$zO N0a^AÿyHW՛(cؤDQZ)E7=C)C|G:ʛ0%:co CJ_/q`CB, ܕf#M(GA1hDuO4 tSv-#%KUZNMdd~V=r<فPq*Rrz[11v80@.W!d\O& & R> vxnHaY-,M(J9Se]Fj~BLNPt1ic=׽HougIm~_^S$~Ofjp4^Shzi1 AZe*,A@Co_; zbl Q4-lw?:YhQ(f-)@H`ze;J.̯g]tp4b}"fmơTzJmPtX`65sM_U$X=6b\*&E:sίdR4y؉8V;B|$hũ>_I܇]\A@b 6.7ou/"8N8#=.^Ȫ,.Jzo` vpb S;|Hw13!,Qw|PS5yĐ:I薠W#o謹c)pM`}3ؕXp b"M2޵1%BL9zNF).NbzCb:q#HAOV 25`w`C?n1g/b?t-A6xK4(3m,zyjyt[h^otKڵuR ~7 b=> cV?X+s} N145YYQt`V3![_1|1BZxim9*}>S+ʋD ;/ɖ%?2`P|iJNc%ڜrTmʼn;:Jl0q? lH3p;c4ݑ]̱FS;9[5/QܧGdrE]~L+dpEg$wp9\Asʭ$x1ʹtg)h? ;|?JOWiFk c*/#"FB/ep166[iM/&G1K jŧĴ&g%N=g+\ ՟RO}!JwF|w\8(YqjQJgeVmo?{rT-FkC>8۱c_"G-]t+M0jJg$e=0Z kyec# ΐ q8 5KF 9[;J]y1svаR,nJdxudQK UVGɁ3ݕoQl:5e?T6>B^l?ʶDM1*3뫩]4ꏛF!X73hr䎫\A޷e};7ŊZS0o;#ͱG/0sox | QrUEk6nwN ;X7` J} :ESLڜ^ܴcM̙wY RKx$ԊkB"luY4c3OpN8ݙ1n\k?r7$S~quI[LVaDA{Ms59md|[=ʌ~9oԘM/Je55Uj.Q>a3Ga D[r)aJGlg7ߖ,%Ʃ'kG-ض<|ys.\ !Ҥ(od(BF9KLW$zPfz0Z7MmJH璈녬2= X1U3:cv Gov~58f%uyvu.CSd<د=C&z܍m8-{ڋY5N@^"ZDmʒu\I\c ~OQ w#6|pEUP SǕ,Ft+iouvZdSbS}^ qQco |j@yq ( n0;Lksk!ܠXHݙ\%F4LGaJ4eް,|հWJ(ҽu;@b6vx+LХu ?%0M-ԲlYXȆ򸨜eR4V`2j@t;uoxLd$w:D08%4f)4Z+U%v E F a5^>Otpo 4{dgAm̱]Ri}Z;yQImj$٫oЈd)I 8<M+=|fT?y-7"mA+c}VLpxbMv.[0ȧf()! o(4=:x oX!hD9&21|% d>YeX4jZy>acWRx z̦ Su 8_@ Os0߮/Q/*zoJI/(d^^-|r>}'kSs>}.|̲<''glEܽX,MbDpnrbXp dN )-8[CNEZt^~sxsAH֌G|i 'kZp'TL!`2kB{Cx!1_SI|Ŷs΢l5Ն/z IumeRg}{nӐbl$[kq+ /1$NQ4O@#?Esitam JԵֳ.+ԪUhuS+ 2sQN8CGTs`,H ߒ.fHU[pI%) t#8J ˋ8Ϡ¢E% 5~"ΆDw VoKrKPpߗ~'̒{Yi.]i}ZpWii\8hhҎ6!f{=vՄ>ֿy4x=[h$';POhޖ0NU{Vm%֖5%wyvZyWnߴz)Ѳ)[sNu9|c[ўBWuԧqƊ L*A{P k+Hdz(^xg\E _lIIMLP*bͬ[N s3cPe&O3j!Y Y>&,b&dF!9B.swwb5Ye/kt(d25B_CkŋcgtgŤ.`^e]nF2N:!a @+2^,ԖcPe, *uF"8 q9-{)%M%0WAp94dgy 8Oi=7O_%kfy#`:jX ̾£dO ,SG-ok?GuWi(-:q#߲Ia X$-I߉bS1ޣMz`3ZiȰ*L{oeOtBSZfǿNt(B'dHj+}carκc"/#<7o` SCæpnBbi:p)r0ÂquLrkp<2Ht}aʲҀ,-Β7;FɖQkenBx-֬s\dG-N%sS#sf;}<DG݅k JIZTG ٕA0gmM.l^#&=[xa%OzB|9G= 4uvjJה Rh1'-PYuOn?[ūDh#/Iȗ{#~hn V07Ov2k uS`a Iv K% ;=dJ£i/$17N-﹖!|wM]_=t+H kEM+%vrl,tBLi&X2 sn$MP$"RCZ?]/hܑe k`(kCjֱۢezõsDt}&' 'ct{z!dMA$٥ }J/pӥiVU|8 =Џ+==Xl:YrkTToL8 FlH$i:L aZc,X|)ܥR)VlC['lHs ۲,?e}U 9s!N!#~)/78' q ZGG`CZZUԱ³_G\e^/R>O;IfLgl$]5c]qa)Q00p{d7Sy3lVXNSj $AYTjjJg*T`hH\KC1Hהp5jϙv;o t VjKBBbA?D0&-p'~.tfGEN6g0;MVzg]].;I|]dдEر"'fW ?k) |bƒ LIe$R}cV33Ћ݋l*ԛNG2pj&gLizv(+bD]dh,]'a9m>>pN%a=4%4Ձfm0Ys}_ۄr~Q%E~;3;˺&qqվ"HPN]q?"K.mjmz (f2**K"|+^eb'X8a1?Y6(FpXQMK!a obpC;}֯e]jG41Wsr*ϗC=CLԸu<Ӥ@7*p¶;| G<fnwhk60=3A0~wul4d-_fC}tMz"<,v(7g~ZU2Ig,≚c9P6> KGQ-++T;7> eˁH[W0Ȗ-}2Ȝn,&x~Yu4!|1WsMTW5HI-J.ee͆(NƌmʟJecg.-TM:;Nc`EDM҂L<^;<lܰ]yl2[7ݶf^[nE3XYn;]Q պu  O ܇—^z6OB}4!E)mMMk CF0)<0?Efc~3ږsDc,`R)\6,V7C,7v3 Y( @n?zo{N#[xO(4uG72ݜ1?λ'6l Ed%;+,{Ą~ɄЗ7.3xB|yDݽAW[[a"\|z}AKA~7#Fy In)|Xf@ҏExQ/cd\2cd\M1֭`#P7j7eL6֖@ېxLRN,.S2P;{Z\P!qzc2eUzb*3i"!n GyNrO9O[;R ds!e3<,!~e~>}(}Ӻr/ 3{~ˉ9+V, #f$X5uj07/9!ařFS3~DQ?~#L6"$o#6)QǸ5 Huua7N6P}TqM MW$2,hyOl>H/M긇Ҫ|X+rsWHx`e9X ewAPzU1)o=쑘|p-QHeL ?* T@Sh0/R.%rb(7Ѻx2ڙ=˷{}F[d ;RQ5)aO3==L?I00jbW=VVyϳ !b&[}NNwL|Y37KU^tC<D%iv~V@*dlpPÛW 7壕=P.} )!R;c#DAun18O;lgzIL' MzC1)gߘ2g\$=*Pe_zACdP=:);qrjتvb !WY ]'ÊVjNe .C`!Ty 9PZ,/6* p|)񠶇K>OGv~a#Z&/3*E[JA ,I@˭FwҵHyl+~ Va/|-gUˊm9e zXsWOSq_qi:NQ]DG5'O""K}9B#PBT* gς7Ses݂0p/g l~SЕڇݎ-b+^Modl`}zkhQ+?|MُF .Ovx\r&tMi $/g5gr;#1;u^ 3,y0`e K*M*.~븛I*ctb\/RP+EDeWSLnLjà@FabZCVP>0Z ^9. hͰmx0?*)1 MLe8[{6q/薢Toxc7u%e.A̕f1~1 ~)}C%Pvn8Ϋ :RI5HqfN!kmwaZh[*f[#aKFn]`ς:)׎\c 9$!ɂx =Hk7d6hШI0Pw=Lʯf0'{77e%^֟7|͈`?}!Y%7 QzJZD"|_6Ubdm:-Nw#|VY8Z$JVT 7^Y_Bac\&C2/| j sv=lΧ—`0AG bh N$ǐGD7 RTQ:к7JtA:"*~RFƯ龎#$t+ir4J;4źQ. 2!d1N̳]GYćTn9yQ #VJS}nC`^WL)_ D\#4=$+u|s]U:EB2ehϴv5鏌˭aw_?O_E9(^;<&Oeۈax01_0E$˘;`U u-[2EfE4.~@42;A¾Z,97-hgz#M$3ٷor@"]޶TD(" r|9 IDpmiiU'ȋshct}75鰴G6H6,8AkwGXO1ب;X0}0hR>}G=|-?]Ctd p[^S3 lM_Xp& jDM'&6zM,Ð0MzP ʻ5곁 퀪y鉒f6'L)HwiCM₅CŒ-IՄg@Cy +#bN#G1H0 Ѭ2ҍ´uang+Eʴ6Tjvሂ,Ygb 1f\Y+zz=b'I=.^61~oc;@|&AQ`A7G=p[c@''I'ޱd!}߽2in+rOxM뤈;w{6gf@: %|l2"cn)8ucg.ʵ܉eum1*PRfgY{縶ri5oO9{ޗ9|mq ncN _h"_V;="7|TGJ9:=D(oiZO86.:$rCdj@Uxuɱ0fU 8]6O H,_ezՉ=YZt (/8m Qkd~LFߐ%O%#E'b$}28=gI Y"tĐ"n_]GrD{F&qauc/ڪM=9mY$l y.ZdXR9"k#螟b H˨۰~$ǰsF8pO[DqSk9rc'+Z*{tlH=v-Q8K|P<  Ȑxn{p$/psKrr:|^9NeAٱhfT#CtsP? kjZ=ADkF6CIS) b_ V}WA鬺º|ٶl'e ar@D8Su1AF]l LDN2E7ҽ./qգ'cnFkt(Ќ6 `͡zi:CeqZ.FHg Pc p0 6,v27HQMR>N1zb[OdV7m*#TN FO/YG聗ϵfܥwDSxwi;OLHN$ܥ[0߾4tI`Yc4 ]`J@"a"02}2Y{]ll{=>Qs3An0Q(8.qc\A@vAuBY{[ ?!Hu)toM@6q-dPUsvE|^H*<>ʼ+_NV.2]#tI5}XiËV9|zIݞUs\{,"Nx)0W`XtIRIXIGwvlk4[6\Ou+- MCrF!KwQI,iIIַy&R72azG h:Lv9A 0m^_qLA;J=G[-3߅^Vd_IMLϗۿԯh`B;Xi[A;^8ܞA,dev;2݆C$aeW疢[E$Q4Pށl!jJPڸL@I!F6&Xj|}y43` Ő)_.0<,&Ӎ+z.0΅q])( C+ 2̆fùS7/i4?|gsagtl?V&RێmHrL2eAM&f6Qbuszks' B%(dG]$Öѝs<:㼗YXn<1B%,M?O [5e tI``/#'-*]FCZ@CL5|ffyX2b$<|{luze-z Dxd?+6:bHy_XdEkJ]k^Wbn-brdWCS~>[N(45WMgg,p60~o,jNRkU[0=@S*-u?Svvީح!̷Iv])kFH%n<'0ỏLX]<g<4`,[(_3t}ۺXs7'ⶔ;ORE'Ω;=r y5+b+.j`b&)nr]%ea-GzO5M bJ)BWϾQ/rKot*=PBq%s0*ҫ>Qo~t[wooSza8ޮTw|ݙUkM̌8*\D2;EV\U =V⤱ E bͅ]W7KqB[P iiLqWJ-Z B ֽKT\?t+Ki%)f/\O.hw{_ɘu{tD([0WGRۨ-DuuaD+g؇)Xߠ|, kGY{/&!riL[,KQVN,.OZ܂f){b9q)C2*` 3>=}YO7q_ίA-vLJo<|VhVQ.|xЈ`<?|AB'ԕ`N^ Ssn,s~09Ghs(8|2%Io1Scb #n4NgOM|m\~+C$XaP\ۑWςPF؇{i7 :R>42ߖ۰M0d{ʓ!<&'zIL~v!9@Y$frxjڜ~kdhrh̡,ĭzAn,Rk>é]BhT$be ?2vPkI+-DçG|qC k Ps/ DH6Hgs:W@_(dMWQf˰1'o9z#4Ǥ5s"=J1':2@;](Uyf?~>-!&PGX~EB6cc[Xl為4 lA96G\Pqm˧]ˤsԫoj_\#Yf )d-0=HRNOжύC83/;oM^ʖ#P0n70Ŭӝ$U::{j[*0ӆH0"xzxry};kS*Go[}i!Bvƀc6jB0m;=mHo#*AI;o.orNKl<:ܩS3$hnlF('nC&tUGG3|Vgl)LwRRw "6+D*#hX1)pȞ~%-<Jf 3i,QB5r)oHk UPv̝|[w:۹& !A!Cj"դks>6U)ZJTgN `FdFGC, "=Ɯ?jSmzW1~}Xi+\yU>q%"L^ȥp+gf~r:5gvh3A\b VqCT 8 +b'ebwrOLcpV1^ *t9'˖rGg=Hm\߷O%dl)PpT9i+V:`Dq} :*t7zFH=l7b.TP[37YO<0 a [GDz`#Ѷnk_]a>p=3CYm$+W)*{va$q7Gߵ<V syX͗Y{cٛ\BaO[qmGq 麦M$nz];\KDyC3=x]L=-q.WHCk_y,_ FV2_Ce}Ѵ]cK7aCCXn/dy_WNWjًhn7p&I0qChy^BIfP1Ϛ Guޑ1iEoػhk= r5mm9=&?=).cb 9@M; :w<'@KjgEΩ7VȻ՜@rA'uai%8|G!x<%&|Xa(~s1BI}'veN֏ xJG'rbMKKHA.}r1V Lk#zB^J{MT<[H.zCPhzI ͗55eEiZg~Q!*V,)\^S:;/Qb;\˲USB>xVèKH g$nGB~4c^ grcX6a!|/l5M D7Nݣ/V{XhYsA. ⛜Aw2b_wdeE˜ Q`PWCfΏF-ɔ Dfկ*"+r8>I(^7A<+"'>.8#9.xOͰ@~Zb@AgITbhdfp67,5kp,,]ب2%,*kH7(ú^w3O$шgj/=i]\hRy* qngwh[ORɹ 3q8ʈPA2Uuqq-Ơ9-8SdtwnS V-"]~zVE_S/aFa6U/ [WD2>+W1 uk0zQiZ2AU2.ˡ9X`ljImihrO$bnJ8sVpAf:0[.(qUw "&7cGDg VJp8hC3o8Kw9t2bw㼜UF }OνL)rL?K&{DKOB{=l˔0^&ȷjm>`Jm-QP%Ɂ:3OvUddqƀ9amvOvl Br_Bm~=_1U::q.ĵtލ`*ƻ?C!B8k& Vu?^{{<ADMdI3Qn RTUzhnVW:;i0Mc{N2kjWj/֮%@z X}<"cj+6\:Y.v2Mڙ̖l!Y/*h&0"C٫A-RMņ aA !YۇfڡWU +b=go6go#)7̡ -eM Vt Ke( )S!qsɫ`u#ul OHIT1p'31ҝ~< ]]HgsH1C>nR6\[r}9jCYF:2mC4ց֞ygʳ:°܃`T7jf'k@(1[owνH˷XW#:wR_ؑYW6`nPN) d<# o5(U>ј@6рwe-4ΰyYTjDXfA=юKTM2~!8Մ +&޴.\x[\[lԽ#𢒒WDoeDXt$B~R1Jqا Z<9"}*쪐wB^/P>c#@0hs)KS MCfm#s;M`< d61Lnk NϞ3~T!G{:`@hAYۼk:iɄ/,2Y3(0,j('n&0GT:KEz wer ݡU"<uz@&B!$* W]c9 !HM2A4 XuJ/vx/ZM1u8w_b9 8k޸܎z+RYY&J/./9CNld\tQvK'hhc߅<=696TUt >"l֋_{uN}S+'*%iYߘ엇򊃜8wK2ԎAʬ7V:M`@8yR^& #7=0^T@哎&GlC!4cAGȜ~$\}`iF]49)+&z:ƾSOqM{aS|ur~(]1o=R`"hܱK=&Fhc:tZ^nIHs eWGٿ|\÷7Wu13Ԧ*4rQd)G;q6gJH\_ff.,q+LzHuJ2`mbP)sz$ G@ R_B\yOP󆼸5z8'd#A=&.u 厮,pldO.fSTXx~٥e K B gd=UOb0^#Iv)6 Ƣ>YNJw7=Ʌwd-ρ\v9>p{,İ I5%]fmG.,XmCErs GMԩg6C{"X0x>Ęk[[t"i9?Qèo} >OwO88 31A+5k: 'qL'Zզci{J9ETA&cc9apN♖. aKz RWoesl~wZb~YECa& ?U;繫rj3`kXdb҄\vyw3Vr0P$*A>L2g k4( 8{V]{xA5K,]_'&CDQX=oppyޮ2O`1IRPH |̍S_OyӯGJ{2]6nKHBϘ-""/Zl&0RwKґ2G^`|} %`*%p*Cs+;;hs*khm*W6շ]#_|kRcIQX=E^VъM^8( V16Ok!4Uw "藯>UZ-t}~GjF8EsIn%F$Sz\CizK3]5X>d2ƧVCĄ35P_ H/Bbso$D Ǻ0rlG eޝ+e6y ˺esֆwbk"ȳw[?/Y_5LCZ}잰;7*YE8bUbză@"+nW v@ZbP]ĘQ!/w!$@w8W*# ;yH6WΪD ]o4z uW vMEr4MaIwF\EQhEW}кp/~3 9_ٺ8Kf]|뻢 l5TlxhyW]$( `im5s'DD/PvSX&@JnGrOK.m)8TOST9azwf|/\k{r,28{ #Das8?E?ԗH@ }`QXɸ}+oZ;hh[ ϡ~T 5^(gq>Okd gV'j&(1lk_Re:n /ma_⑹Qa)YOzV|߂eϕAFDg<FSbY]b %8 Zzx 2ҼPR|Hy1-}Fud0Rn[lE&#w_GP`Fn%~=jPsDұnuH !}2lrk]g7>+E m$^ c$` i ջv x/M@ܡ MDN88\9FrZZҍN]}YytEFvP?#&ws9է0a9P;l/tKHFD6,:L]m ^H砓rX R !Y@}݁(1B򏼀CFxGoYd |v(]$1"Z)-L:*⩗sdukd11@D .O 4N!m\mZۑzzJprXH`cr j2tU/nj ? nbAǚF\refr CaKֱ?FV156t.M#5 66hn2FbbxK⽔Y|P~"i4)m>bgx?\-8s:s˗kZ$^ݚ#i oǴSK(3yj*bk)!BzE XI<Z& ?^3T͈?g]'~dƤo^ޔ| ;HF6%#?HL g3FKw<5ţ`|UD:;wG~KajڄK_hoq-¹QP}p|hk6_k&|nq^-&C;H Yl,r#  `Q<̺0s9 &Rwu$+vmV'1v3T6V5ms+WF@SoMo ʀq`Rn1pQ=Dy_}\ht!#htEWyc|=o^7` 'Qamep{ŪaD5M dƵP17i̒1m᷎lR)ᴳ'8Fuˑ㭁_'Y(xn^OF]0^^QC$@D9 D*j |npSZOQΝk3y`Adn8 g:t]l|`r1X|l2USo ]헹W6NQaX+٘uc죡?UYЩuvj9eCz>5 u \)p(B2̠JL:wHrYMi޴ZEmAL2҂tDuF^}W Μ99/op2oDTה[%3o=T|}1?䨞R@]/ǣw.[$[*ˌa[*^U 31DWkĈ:oBY2XF@ 7i/AodO>puS2Df贙`%9B;XϕT٘K*HQeYś\~..K֩wFϻ|イ;I2CsLPNR.놰cťʠ0a#i4BL̵ i$5e%ڭm?v(BV#d;R2_O+uac1I żOj5>ohZlevޅ@Eliq_pU*#3rNw8U,Q4:bwm;Q+ǵs NɡńR/ OÞ; ".P<fL^ϬEى"y`1#>GHfPGfuŽcYRaM|/};=uܔ" J`ugB4Uu B绳wfg130ù;C⋀5"Fkm'y}oevOk4QMȷYhc2RzРh/#-6}tS 22kG[5X3Dݛ)cA Z$ǜ jȽ]؀D#lbxrT_ى;~\rNYwnH纏zI.'^al: :4~;]@ 41" &=xȽ=^}|·M]qނi2PM)>(%"|8\F̂J*Uh}0 :lXmK~&J}v!n_[›whyz*_ST>3 39@~k F 2bx|KnD药ɍ#|O šXD"tIc@xŋ(3"->ϪkE (m@٭شk]K|=+.4)> Z$h4 0'nz:)V(=lpC(gJu3}ηlɤyvwnG/>³K*'Y+a;]c.>PjV8W> z S&W>%g)1x*-xP#_FwKiXw"u( {Zbt$G7#\ 2rK&*O!N$kh%C^  NKh,e1RL݌p`y\[2ʚD}9'[Med#^ ̱;~eA7/) пJ"'e!C%+A9M QdE*% h._IpPI/>AN(goʙN}TAPu|NIC Bp0J`4GfA,p0Ocjai1kܥ4CxG$iTJ -ـi1AY[L,Lg 0F+l-X|NM!8!<]" 0h  FK7b^6#Dc#q{Mp rJ_xIhX[V%$mCV ^s?%8M`@?Z gpf1ˡR Jwj Mgh; [ӱRtJ^Ti/=Vwڗ>@c:B Wп 8 ۰ ~`Zb #&\*rCYsuo*PEgZ9}5,t|1DU~k`RLeP@0O pb†VN[hY>VKX&FCҜ̅Xda-t0c Z#L R-hxePPK"g39A_˜QHZW,(nm-zOXIiI6b]/U՜r%% Wf<[843] o#ʖ;YZdoQDIRd|q#ia,*cR]g?']q\[(GqذvVG7H[rWj%~y$<j -A:{ng*2!YPAYBoH?D1)睗7gےû H߂ϣSx7t/'jr+4nBEz.o)f]8E[;XkoK%@HpdVj]{:S"~ MMV(ԉ($ qG D<0`lUPT C1SI]Xl &m{~6""  XYib%0?NSq#5Jly7͹/5Ҹ/'oUEKGc+hxUƝ(W~^voA+/0LMu)&rf9=^ЩRbr]D7$xTֹB|0zEe+,ak'Ue+j@_-Bo͑$o]BFēXgRx\rv{`T<y#m SVX_LF4V\>EyQ}c]9BGL`m󔇛_d+LiI5XNQ?NgR()ݾ7jɧ'hR*G۸F\fv_I.`x[_QnW*`II ߚ2w@Ή?쇞y8U>2I}S4ҺRVp%_`\ ^1ҊBLCQb/|FF oAƷix}WU[A"U"ऀGYTjv˼ e ZnyUV ;7>[.ZE#D0Y]Aw_"y6%YυU@Y"JL!3 g;#\~LA]~Mb fOU1'0mn;>YQtV6P8~k6r("%:+]0Vs~LGȆ/`_at VLM;SX%ZCtG8&D|=KbL"nWAح!M7a2%+5q:aI6Sl=M[8[ q XToAйn.߈^pXݚlC:VSP-mH&R ;d }TsNF̰JAmv m`g|/Mp)B%PODDwWd/?%+nm7T2~)c9L| i-a {?%U׼/j ۞bu=3$I:.Fo✈vlL$HI*q^z^ҥT1Qǯ|ݫÃ7s<2:գOѻP`CRs [csB`EìtI2w (Y{=B=RnzIV;GQ)%JWOzdKg6e3r Ft+!g Yi=G1|3{5Wu`:PUKKr#'0껲Q駱.ƿg E(z_Ӓʶq;H 1먜ZS!/yb\ɺ2:./FrۀvSnc6Ho9Jq&T#23HsgB2ʰbh2 OH#HM{Y)޺#D<-n %נ?=?D3賩^%+&K͈/mf!A)Wt~4JP\l՘%tUD.KP¥ ,7#dd}IwׇGЩa>5ݧ:]ߞoaݢ:8̞h$DIx9E?&_i4SN|`C:(#ǶC0ZҙX+)5H@pKkih=7j="`i\+i"f'_T=mj0ɨ:Hu#&ck0[+0K: V6BvnP!PW|yh J 2WH)!H6ȷ_ D긡Q%ԍj'Vӥ /94nM/<48] XǛ描 ݄w<4mh%C@:i, ޥe[- H 4z#SY:#\ d@Q<$M,]a(֓ax( ?4ڂ6l ٳ{jpό.c6;2NzЏ9*\"DzraerPqIŤGrQ.DDl3abGDnrI`k|sz|y:7y0nC,1Lkon(Gѷ!>0 YZcar/data/Friendly.rda0000644000176200001440000000046513202607636014206 0ustar liggesusersK@7#AA TI^z 1MP:3ԜrxnB6/[RJ+3JDt<5P>o2!SwZO[6H4>ۼvWۼی*te 'i[;E wM~C1jDi_ӽ}@u򺚚~ZWYuEvΦ Kd;krҁ1C0c3, +'M"!fBsRh%$          ~/(UZRcar/data/Freedman.rda0000644000176200001440000000410613202607636014147 0ustar liggesuserseiGk#vn'LN<$v1k{cˮWLN=]>vm@"܇ " #A $@BApHzgƬݯ{jxI]GW SS½ *aaw5_EP5?C) !?N$JI?7]hYzCSObT>}#;S?ӍTn+ cicךN\ew|4NjM 4򦡅k|8|e?>7 ߞ45si3yT}FSFo&nƷyڸ7-76=7W_Rq#u|W=wsg||M^ѳwgi?6~Fnks#;ѻ۸^  =߁#2+>[C|9]*$w%~2KeY`|l_o@#[W>&s0;O|:S?WeN!DN06؉/#aO٣s3k~3 ɮ/;1~}#M#O+"ǭ)bdc|!ro_S-*07o@*}+lobCS1jOR[=_gg;Զ2}g myOaRty+: BLMt7Oc =ޕ: ޏ_N59֨i1 Uޜ,>S~ՙ1|"qj<(e\4xWko8g7ȱyDM_/08W}V? Ɖ$s Կy s^*>{~#utZ4ņwv*({F|ט/5%_)ؓ}v׍+ntzinO]кL##\.lY"oM6n*?V`x#m-*3*'HZrSẫ0+*3̺FW,+8A/eS>:eUQTSIyLCCzAiƣ4d4M d M 12 T)h4 hhyh CM1hhh44 & i4d2$ i6FL@4 @EU@ `&`LiȘ#4#OF#0h hFD=10a4LAڏSb2iM6zL b4@hz4ɓe8VÉLddfHs +_73Z"RlDak:6"TU5=V&IEU"ۀ~V?DC|@$"1cN?*8=BQwt?W6_7R 1-.omΙeFB.հ80O`Fqp 7]JH [%k]5-3 f"㗚%5b'u8ݲZ'2hCPmS48Dl,-,iVjaHAeJTҪ [J}%,h0m!jO Rۂ -'¥ Fv }!/ C8 †0q.(1aLkO>ȹ$Ɇ2 \e04~D!6 g3MtIM"i]3&?4&5Au p~46) D@ڻgn]ùbnw p8o(E'8y)yiNbsR1"ӜD:A'41huSuHR=;t;Gm8 0noaRU @QTA+1Xbŋ#(U!EPEPURqVjիVZ  ,ʲٮ@0 @ ±2@ @n͛6lY@lMBI$܄$H7! ]&j(wު<QUUUUUUUUUUUUUUUUV?FjTcc''<<7! $3rsKYڪ Fso7`9rrs<,0rI# rm'<˽j/G{;DQ(֚Zqu뮽xzuҵZָc;u: ͫoc7$H`&!$Fc7$ܵ4@ބWralfo zzS/ڞ΁M|3QB\w1T)OQRC19rf㶄>ƯFj,ZobC v:3r?,(m7 fɴ1<&ĴI23OaLr(ho_8k/o-0w1Z@Duyͱ+Q#p_p~N#7\sxfm[M97a58r=rDOQK*tx$q(ZN=?)lɱ@d<]appX촖,ELO$*Na;.cnmm; pסZ2/!&aY= 57XB5dˍHd$̵̗rۭSZ"`NK0w8A(u @(A=#:B+[MHǿi%޺f[FR4ޒAE@or'}.<״!{Fp[OF񭃸zgWb&bU5qBC:[Rc^-0`=0L@p0ԔhN/jM^mpmb/g(fc8۫UpWf:ArwA LɗYvya֭[GK?A1la }1n !ju]EQ N%DMHP1nJD FB"ˢ AI>ܷ6y9=޶vT:lD٢bDƚJD>" WVv xp ;Y s4«%mf͜9sZttmǢ1tLdk H3d06ն36ddHF*XX E:=qX7N$J!%z06]"1@$ #g?r D#șA#hRT^$G yh:r*}|PuB#r&Yq"4y<Փ,p ZM;7K+-`@o{G0ch/z2?rk1ixx x f}>IQx2kMC܃{ ?+ (^ӷiXL0 a%(oc12=.ٻV]{ke9u~Ǟ_1zJ>X *i&{I3yx}?66 ; UWQ:\rY+'uf|օsGJߞ73gp׼T5koK=syߍZе3Dc =ñ&(\JO_opgm:>pn_=cۅ#Wבbhז[> k-Ԙ㜃^=M9tٹJkb|`REҖ iBD %5')P;dq}!=nXx &;ML+I$a3劰% ;O}!W7S֘?x2p0'v{ZMy6K.} >ƻx-+bMdb/q"sL (k}wG|ʏGm|(z{zٴm4[ewFڞX,"tZ-q$"aG*U2i5IniVM@ZҒ:idD64Vcd\(3BZiXˤWMUYO}m+TZ*_@ J-2Yn:<XB>K2`\V"5Z`g-ַYXZ=n1car/data/Baumann.rda0000644000176200001440000000110513202607636014003 0ustar liggesusersBZh91AY&SY]~4@/߀]`hɨzS)D6Ԩ=?Ԫi=CC@4h #E"TS4FUhn\] ZmܪH-W$(iltRtfSF^qKa9DaB:+$TYD%teU%".h9QK˪Z ='"B8+]j,, ^hiWOa:XrV"7bvx-sJ`&z&"Yє͗f+l]*jx@G)=i‰Q>s$4! ] q~@0U$Eݽc憟~)JR)LY01ۨT*1!H"1""^R 2(J$ՖYi%[m̫TBUʢəmڢ)eDDE) ۪Rro6׵HҊwᒴކA 1lRg.CL kl?YsS !LpX39'&ȕXV4M9gQ~e0av1­21L` S 01,?]Scar/data/Moore.rda0000644000176200001440000000070313202607636013506 0ustar liggesusersBZh91AY&SY2IŎ@/ߠ-, SLM& چ4zS"J?Jd22 2&DQGh4448c6c-(pA(ênv6& j'Fv,"%DgTq3n![7VQ} c`~7c5g V̝'.myʡWSxڬuՒxvm[iӽ@_/,3*ZHn齗tF=vD_yHII41!RЄRHeLl@yZЕtW\UY(fffrB dfffGD쪪DDDDD@k/v?߶ڥ<'&3 Z#8^.q/#^QJ!;S@zHIae0c4fAO)„Lcar/data/Womenlf.rda0000644000176200001440000000204413202607637014035 0ustar liggesusersBZh91AY&SY/ʉv <?߀| ^:GD1= A 4iC0L@0 hh`bb%SSꪟ& h@Q3&D[lUZRX )]w0cRŭQQTF Dm[T1c4i@( -lXVTb[EYDFBڰRlbhE*KB6Z#1-l*jF6\뙽5Geb\hJS,ehBY1Pd!a/ ;{aͣk*Kjlٯ$úzh=nُ <1{FޛMe&՗{v@nN.᪘*N4yζUMwpl {O:tj䜪g9>pڳuػR֚~7ř42*LSUY6-d\xUlz=-Z۩|f3õ]UXҽ~3'R%[RaQ<(]^ Vlٱ$ғ4FήO{m[r}v_훼 HI$QU"BDEn@UZ*T$Dz1T$?Ҕ)J[I$I$Z;ֵ{ UQ]@3\~H9|$Ѷvx28|pڷڷ(c XSѻCgR`. @(h}JەwA&70 j/ N%X20B U~{0" #mh}, aE(.pXif&;#kisQ/ шh. ypUriq̶>y㪠; hՇ{' ۰y#zz\{ #tX0Af⧂ lnx3R[n,9r,=9&jެloO"BݡKhئZ#O&Gwn*?]cc*nTS;cY!]f+Ot{rKVqLdI6I%/'n5Db k%](^HNf*lE_6•Fe" Ճ TqIRDzsa)`lIЯU5?e#j_&YTjh2|8P9-s=ݑ^|g,QX~#nn%<"mr' eWtS.v2}.pAΫ`: VWـ|Ʊe0)6>d$A!/x6% \ETrFMEN0QrZ ikHwy!<+,3ϐ=Rg_yb_{K ^#ĵ$'[4?!H^X"5Y]JZhE 7W38@)P| 3d3Ks_N#dclLcY2U 3qg:{o6+VFx=m5r;؊S`/iy& \'>׊ÎES! v2?Z%mIH|0T>Ό1k`\}l:v>}(&_Tbw > ?+0\Rkf8DOT<@ʍYţxI5y?9wV*UT ܥ0ܲ|4Itőm3n>L-E 93/UQso\kD 'cW< .ʃ=ٲwR"~ـ=SrҴeZ0b7.SU$M,O>TDD@lGɮl =hX+fl@!*JnAH2z4硹Cn`ݮŽl|]tb42,z_iXՎ:bjB:%TLw7G/bdm-'Ke]#ђ0)j^كxb,~qR4#6)_+ Z0i%z\i-& APX BU`ZSQ}j>utfŃ)`WjJW`hOƚR(U hd_p2L #";wJ3騬kR{-B6WS!q xֶ-9ӯΟo얖q,ib3XHc $;2t!PPa$=j YMW~ Xv|&U *#4/79dkmCWd*W 6+7t%B(OC;PrW?' HE\C*;'aSY5~hlK?5 'oW{Cs`F5{?Iہ6ar3gJ "TEWG&016UgvSzco3SE!s$bl(>y!PY7N4$3S#3tԢ@O}VwY@MlmjtUn 6q)#GbJDX$e8!C$PdC7B^,-DZ +n~6I=d;Vo-4A6JC˫?ӂxFEG,I5T1 m-yUɂv,ZnĴcZo0JGU\u7żpfT1BIP?I=mIrq'zpcjK93;R2hou.Sg!pc^:j|)֣-6 MXqt.U'^SCBَ*{m\`-np '{,t[XyW Nkq ϛGRt\A>z;syU ܌ӿ zT$&V$}U&RIum!礢$Evy^!&n}Z!pwIvGM9&G.YJQ>pj׽S&¯SQ5Ԯq^@!1`)F prYTTAyĤt,R1 ^sL/pwtŅgŽ7;v0Ī+&^.ڴծkﻸpsi"O\ 2hqLΟHq NONT% a-ʠorvVxihĔ?xœn; N5zd2r!Hnԗ8vʡ}`Fz~Vȧ@#A֤G$*Iko]\_ic/94Q *O%.$l%B)׸B5O_5G|[`wх UT'F.MHĥH$}K H_]AhlѷJ%`~;$ JCYȂ0)jC`%,%"A /ŭVŨ([o+&vS5uayՕ\O Z>;F245bn>DS4T!Ph]RR;) {w{BAZZm lŽ,s/Ln[&UKtبvgSBK, qr9CEe6Ye~YuP˔# ;ڄyL:9 @$!; , Jߦ#n&3:H{,+6L]BJ"e J`}KkF,6KfP4? [5Ǖe!9jA~\:l̥EB2!2s2d9s}N,^jUW nd][|24b238W$8gtm{"sc=i8y`<ՑvS ԇs.:M +ɸJ*iL}ޘ2_A_ˀ,dfS=7J}tIe:C4䬱v85 DG4wW+K#}VlteTryI j=ۄ}ƶր$*4R*x>X  av64b='yi<"Pde#KhIzM,F(hi?-Y!>2 -5WHrypTQM5G\ŕ.S:"JBڲ'9Y󡍣!m7.lߛka^FAJ`\pq^GKDi=gHR5+Pjeؼ`z($GWDA\lWdoNh-""\=VYHgFjo7 drFf ?,-Q9vKr%GGaΔ#v^ lΒ')tced" }$e3Ƀ4FOA+}h Yi|'K҈b3tT)zn#J@> s-d9`q˹Y1%/# M1imW\5$_m#k蘿q g(v!5f]} yl\۩YdGi#P,́>($Kssx;K4I :O(+ Py8f2<ƾY-%={;MjӇ[D0R Urʶ'r] J'+&_vπ3f`BR3!pϫs0֑2*QX>ޫ% M1 $:}B u`/Y83M~o$(1{aALRo(<^\&Cfe ںEGJrJ:*@PnDk^ [L`Eej=wbFEWDtLsMQ6B{(с/wM>)P1&P]϶"7&!_E+ !gY;l&Tx77*ك0JfCۖ=e+Yx0 gюY$+hf)=U $~^Z7aD~S*3_KH k`5.~޵y,7V*3uL 3& Td !)1 #/H nfwQ*E+ir I|lfQfu 1`+F_M~-H&pW*9x[\W_*W.S:V1㛗'%<6} /h*u /BSJ6k:˗3ۉOًSpZ4Su)<#Vp_p~ _>6iRku3=>{3҂$>ڙKχi'+צiEJݩ}QdIeC K>wOjg2òq&h^Q0udUC= vO*9nrr]s#́.ZNP|g< Ր29VDr6l$q,zX-FJ 45٦NXv48!`l<^IXFLc5&x]@$H'[~}2fͻ+Eڅ#?f)`GcX217_nSYN]'Mڴu MA+`TG̝h񤷞TVS$ R_ m1 Pǜ_*C'أbnؓ4x=]ŖY+33}#Vmv,DWR?>N{!p!tA%A?vԄiE$?$w; ۶骰NPKȶϓ݉GmXXźd9`eJz;p2GH9%Z.0/^ 7DհޑAt0EKf& _xY|Z8Wü: )6p'Oyb6`A5,X_S a'] 꼅u eNFˬ ɣwzA۹ӿy"դC-Ί\ 9P8/%{3 /HY@L\tQL =`n"%Wj,!Bk[,U>eQr31Li>JX[ ,iZG#2|+}Hp!9tTN'(r܏䆩ѕnּD^M3Wl0 P=T !DG7%Y_VtE{uc,iF67ofI͈f#: xXKXApf,;< n 2p:'nO|} j- |zx'n~X^^~\}Bwu׉ɢF- E~|;zj4jk DMQÁ*f8Seߡ.Z} MφUPH$Ky`߸"Kiň5mԻMR h$H6;شqv"q<)go%؇yvVG2=}1Y؍4Dh'bQ3I6LՒ9;$V&YRɧK鯆H*l_0 lt?zPïo'7A^)~a*MMӱk)#_*J]rV(wr ? w hbu"Ѯl'ncj3V"q(TQ;Ő* V0Ț8켪栤Y^va?.oU@n1I_|ZS|tj7=+A +uJ g㈚*si}= u%JhN]E.ne 2>^Kม0Q&|ē]A}Oߙ:M2v!ݮE?N]'j  üe$N̩M+zY4Vc#79l P/g*Q̣VP[JjK)=V8^NZ+HMX,do{9(ֱrK tH Q8(7u9)o?,8t_N>0 YZcar/R/0000755000176200001440000000000013202607505011220 5ustar liggesuserscar/R/ceresPlots.R0000644000176200001440000001557013150571277013506 0ustar liggesusers# 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.R0000644000176200001440000000350713150571277013703 0ustar liggesusers#------------------------------------------------------------------------------- # 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.R0000644000176200001440000000573613150571277013503 0ustar liggesusers#------------------------------------------------------------------------------- # 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.R0000644000176200001440000001262213201112047013743 0ustar liggesusers# 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 # 2017-11-09: make compatible with vcov() in R 2.5.0. 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, complete=FALSE)) else vcov(model, complete=FALSE) } 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.R0000644000176200001440000001527113150571277013011 0ustar liggesusers# 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) 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/bcnPower.R0000644000176200001440000004007513150571277013140 0ustar liggesusers# 05-02-2017: bcnPower family, replacing skewPower. S. Weisberg # 2017-05-18: Changed summary.powerTransform; deleted invalid test; added roundlam to output bcnPower <- function(U, lambda, jacobian.adjusted=FALSE, gamma) { if(is.matrix(U)){ if(dim(U)[2] != length(lambda) | dim(U)[2] != length(gamma)) stop("gamma and lambda must have length equal to number of columns in U") } else { if(length(gamma) != 1 | length(lambda) != 1) stop("gamma and lambda must be length 1") } if(any(gamma < 0)) stop("gamma must be >= 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} ############################################################################### # estimateTransform and methods # bcn.sv <- function(X, Y, weights, itmax=100, conv=.0001, verbose=FALSE, start=TRUE){ Y <- as.matrix(Y) d <- dim(Y)[2] if(d > 1) stop("bcn.sv requires univariate response") lambda.1d <- function(Y, weights, lambda, gamma, xqr){ fn <- function(lam) bcnPowerllik(NULL, Y, weights, lambda=lam, gamma=gamma, xqr=xqr)$llik f <- optimize(f=fn, interval=c(-3, 3), maximum=TRUE) list(lambda=f$maximum, gamma=gamma, llik=f$objective) } gamma.1d <- function(Y, weights, lambda, gamma, xqr){ fn <- function(gam) bcnPowerllik(NULL, Y, weights, lambda=lambda, gamma=gam, xqr=xqr)$llik f <- optimize(f=fn, interval=c(0.01, max(Y)), maximum=TRUE) list(lambda=lambda, gamma=f$maximum, llik=f$objective) } # get qr decomposition w <- if(is.null(weights)) 1 else sqrt(weights) xqr <- qr(w * as.matrix(X)) # get starting value for gamma gamma <- if(min(Y) <= 0) min(Y[Y>0]) else 0 res <- lambda.1d(Y, weights, lambda=1, gamma=gamma, xqr) # set iteration counter i <- 0 crit <- 1 while( (crit > conv) & (i < itmax)) { i <- i+1 last.value <- res res <- gamma.1d(Y, weights, res$lambda, res$gamma, xqr) res <- lambda.1d(Y, weights, res$lambda, res$gamma, xqr) crit <- (res$llik - last.value$llik)/abs(res$llik) if(verbose) print(paste("Iter:", i, "llik=", res$llik, "Crit:", crit, collapse=" ")) } if(i==itmax & conv > crit) warning(paste("No convergence in", itmax, "iterations, criterion =", crit, collapse=" ")) if(start == TRUE) return(res) else { # compute the Hessian fn <- function(param){ lam <- param[1] gam <- param[2] bcnPowerllik(NULL, Y, weights, lam, gam, xqr=xqr)$llik } hess <- try(optimHess(c(res$lambda, res$gamma), fn)) if(class(hess) == "try-error"){ res$invHess <- NULL} else { res$invHess <- solve(-hess) rownames(res$invHess) <- colnames(res$invHess) <- c("lambda", "gamma") } roundlam <- res$lambda stderr <- sqrt(diag(res$invHess[1, 1, drop=FALSE])) stderr.gam <- sqrt(diag(res$invHess[2, 2, 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$ylabs <- if (is.null(colnames(Y))) paste("Y", 1:dim(as.matrix(Y))[2], sep="") else colnames(Y) res$xqr <- xqr res$y <- as.matrix(Y) res$x <- as.matrix(X) res$weights <- weights res$fix.gamma <- NULL res$family <- "bcnPowerTransform" res$y class(res) <- c("bcnPowerTransform", "powerTransform") res} } estimateTransform.bcnPower <- function(X, Y, weights, itmax=100, conv=.0001, verbose=FALSE){ d <- dim(as.matrix(Y))[2] skf.lambda <- function(Y, weights, lambda, gamma, xqr){ fn <- function(lam) bcnPowerllik(NULL, Y, weights, lambda=lam, gamma=gamma, xqr=xqr)$llik f <- optim(par=lambda, fn=fn, method="L-BFGS-B", lower=rep(-3, d), upper=rep(3, d), control=list(fnscale=-1)) list(lambda=f$par, gamma=gamma, llik=f$value, conv=f$convergence, message=f$message) } skf.gamma <- function(Y, weights, lambda, gamma, xqr){ fn <- function(gam) bcnPowerllik(NULL, Y, weights, lambda=lambda, gamma=gam, xqr=xqr)$llik f <- optim(par=gamma, fn=fn, method="L-BFGS-B", lower=rep(.Machine$double.eps^0.25, d), upper=rep(Inf, d), control=list(fnscale=-1)) list(lambda=lambda, gamma=f$par, llik=f$value, conv=f$convergence, message=f$message) } # get qr decomposition once w <- if(is.null(weights)) 1 else sqrt(weights) xqr <- qr(w * as.matrix(X)) # if d = 1 call bcn.sv and return, else call bcn.sv to get starting values. if(d == 1) bcn.sv(X, Y, weights, start=FALSE) else{ # get starting values for gamma sv <- apply(Y, 2, function(y) unlist(bcn.sv(X, y, weights, start=TRUE))) res <- as.list(as.data.frame(t(sv))) # output to a list res$llik <- -Inf # set iteration counter i <- 0 crit <- 1 # iterate while( (crit > conv) & (i < itmax)) { i <- i+1 last.value <- res res <- skf.gamma (Y, weights, res$lambda, res$gamma, xqr) res <- skf.lambda(Y, weights, res$lambda, res$gamma, xqr) crit <- (res$llik - last.value$llik)/abs(res$llik) if(verbose) print(paste("Iter:", i, "llik=", res$llik, "Crit:", crit, collapse=" ")) } if(itmax == 1) warning("One iteration only, results assume responses are uncorrelated") if(i==itmax & conv > crit) warning(paste("No convergence in", itmax, "iterations, criterion =", crit, collapse=" ")) # compute the Hessian fn <- function(param){ lam <- param[1:d] gam <- param[(d+1):(2*d)] bcnPowerllik(NULL, Y, weights, lam, gam, xqr=xqr)$llik } hess <- try(optimHess(c(res$lambda, res$gamma), fn)) res$invHess <- if(class(hess) == "try-error") NA else solve(-hess) roundlam <- res$lambda stderr <- sqrt(diag(res$invHess[1:d, 1:d, drop=FALSE])) stderr.gam <- sqrt(diag(res$invHess[(d+1):(2*d), (d+1):(2*d), 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$ylabs <- if (is.null(colnames(Y))) paste("Y", 1:d, sep="") else colnames(Y) invHesslabels <- c(paste(res$ylabs, "lambda", sep=":"), paste(res$ylabs, "gamma", sep=":")) if(class(hess) != "try-error") rownames(res$invHess) <- colnames(res$invHess) <- invHesslabels res$xqr <- xqr res$y <- as.matrix(Y) res$x <- as.matrix(X) res$weights <- weights res$fix.gamma <- NULL res$family <- "bcnPowerTransform" res$y class(res) <- c("bcnPowerTransform", "powerTransform") res }} ############################################################################# ## The log-likelihood function assuming a normal target ## Evaluate bcnPower llik at (lambda, gamma)----------------------------------- bcnPowerllik <- 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 * bcnPower(Y, lambda, jacobian.adjusted=TRUE, gamma=gamma)))))) list(lambda=lambda, gamma=gamma, llik=f) } ############################################################################### # testTransform testTransform.bcnPowerTransform <- function(object, lambda=rep(1, dim(object$y)[2])){ d <- length(object$lambda) lam <- if(length(lambda)==1) rep(lambda, d) else lambda skf.gamma <- function(Y, weights, lambda, gamma, xqr){ fn <- function(gam) bcnPowerllik(NULL, Y, weights, lambda=lam, gamma=gamma, xqr=xqr)$llik f <- optim(par=gamma, fn=fn, method="L-BFGS-B", lower=rep(.Machine$double.eps^0.25, d), upper=rep(Inf, d), control=list(fnscale=-1)) list(lambda=lambda, gamma=f$par, llik=f$value, conv=f$convergence, message=f$message) } val <- skf.gamma(object$y, object$weights, lam, gamma=object$gamma, xqr=object$xqr)$llik LR <- max(0, -2 * (val - object$llik)) df <- d 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.bcnPowerTransform<-function(x, ...) { cat("Estimated transformation power, lambda\n") print(x$lambda) cat("Estimated transformation location, gamma\n") print(x$gamma) invisible(x)} summary.bcnPowerTransform <- 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 roundlam <- round(object$roundlam, 3) gamma <- object$gamma stderr <- sqrt(diag(object$invHess)) stderr.gamma <- stderr[(nc+1):(2*nc)] stderr <- stderr[1:nc] result <- cbind(lambda, roundlam, 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) <- c("Est Power", "Rounded Pwr", "Wald Lwr Bnd", "Wald Upr Bnd") 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 | all(object$roundlam == object$lambda))) # tests <- rbind(tests, testTransform(object, object$roundlam)) out <- list(label=label, result=result, result.gamma=result.gamma, tests=tests) class(out) <- "summary.bcnPowerTransform" out } print.summary.bcnPowerTransform <- 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) if(any(x$result.gamma[,1] < 1.e-5)) warning( "When gamma is zero, transformation family is the Box-Cox Power family") } coef.bcnPowerTransform <- 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.bcnPowerTransform <- 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.bcnPowerTransform <- function(x, z=NULL, round=TRUE, plot=pairs, ...){ y <- bcnPower(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, ...) } } ########################################################################################## # bcnPower for lmer models # estimateTransform.bcnPowerlmer <- function(object, verbose=FALSE, conv=.001, itmax=100, ...) { data <- model.frame(object) y <- (object@resp)$y lambda.1d <- function(lambda, gamma){ fn <- function(lam){ data$y1 <- bcnPower(y, lambda=lam, jacobian.adjusted=TRUE, gamma) logLik(update(object, y1 ~ ., data=data))} f <- optimize(f=fn, interval=c(-3, 3), maximum=TRUE) list(lambda=f$maximum, gamma=gamma, llik=f$objective) } gamma.1d <- function(lambda=lambda, gamma=gamma){ fn <- function(gam){ data$y1 <- bcnPower(y, lambda, jacobian.adjusted=TRUE, gamma=gam) logLik(update(object, y1 ~ ., data=data))} f <- optimize(f=fn, interval=c(1.e-5, max(y)), maximum=TRUE) list(lambda=lambda, gamma=f$maximum, llik=f$objective) } # starting values for lambda, gamma lambda <- gamma <- 1 res <- lambda.1d(lambda, gamma) # set iteration counter i <- 0 crit <- 1 while( (crit > conv) & (i < itmax)) { i <- i+1 last.value <- res res <- gamma.1d(res$lambda, res$gamma) res <- lambda.1d(res$lambda, res$gamma) crit <- (res$llik - last.value$llik)/abs(res$llik) if(verbose) print(paste("Iter:", i, "llik=", res$llik, "Crit:", crit, collapse=" ")) } if(i==itmax & conv > crit) warning(paste("No convergence in", itmax, "iterations, criterion =", crit, collapse=" ")) # optimize does not give the Hessian, so run optimHess llikfn <- function(par){ data$y1 <- bcnPower(y, par[1], jacobian.adjusted=TRUE, par[2]) mf <- update(object, y1 ~ ., data=data) logLik(mf) } res$invHess <- solve(-optimHess(unlist(res[1:2]), llikfn)) roundlam <- res$lambda stderr <- sqrt(res$invHess[1,1]) 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("bcnPowerTransformlmer", "bcnPowerTransform") res } testTransform.bcnPowerTransformlmer <- function(object, lambda=1){ nc <- 1 lam <- lambda mod <- object$model data <- model.frame(mod) data$.y <- mod@resp$y gamma.1d <- function(mod, lambda=lambda, gamma=gamma){ fn <- function(gam){ data$.y1 <- bcnPower(data$.y, lambda, jacobian.adjusted=TRUE, gamma=gam) logLik(update(mod, .y1 ~ ., data=data))} f <- optimize(f=fn, interval=c(1.e-5, max(data$.y)), maximum=TRUE) list(lambda=lambda, gamma=f$maximum, llik=f$objective) } val <- gamma.1d(object$model, lambda, 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} summary.bcnPowerTransformlmer<-function(object,...){ nc <- length(object$lambda) label <- "bcn - Box-Cox Power transformation to Normality\nallowing for negative values, 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.bcnPowerTransform" out } plot.bcnPowerTransformlmer <- function(x, z, round=TRUE, plot=pairs, ...){ cat("plot not supported for mixed models\n") } car/R/some.R0000644000176200001440000000101113150571277012307 0ustar liggesusers# 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.R0000644000176200001440000000135013150571277012470 0ustar liggesusers# 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.R0000644000176200001440000002436013150571277015111 0ustar liggesusers# 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.R0000644000176200001440000000512713150571277013117 0ustar liggesusers# 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.R0000644000176200001440000000155613150571277013567 0ustar liggesusers# 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.R0000644000176200001440000000073513150571277013564 0ustar liggesusers# 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.R0000644000176200001440000001460013150571277013003 0ustar liggesusers# 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.R0000644000176200001440000001273413150571277013010 0ustar liggesusers# 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.R0000644000176200001440000005662413150571277013264 0ustar liggesusers# 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.R0000644000176200001440000001177213150571277013466 0ustar liggesusers# 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.R0000644000176200001440000001667313150571277013011 0ustar liggesusers# 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.R0000644000176200001440000001234613150571277015210 0ustar liggesusers# 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.R0000644000176200001440000002727713150571277015004 0ustar liggesusers############################################# # 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.R0000644000176200001440000001314313202333260013571 0ustar liggesusers#------------------------------------------------------------------------------- # 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 # 2017-11-09: make compatible with vcov() in R 3.5.0. J. Fox # 2017-11-13: further fixes for vcov(). 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, complete=FALSE) 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(object, complete=FALSE), 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(object, complete=FALSE),...){ 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(object, complete=FALSE), parameterNames = names(coef(object)), ...) { deltaMethod.lm(object, g, vcov., parameterNames , ...) } # method for coxph objects. deltaMethod.coxph <- function(object, g, vcov. = vcov(object, complete=FALSE), parameterNames = names(coef(object)), ...) { deltaMethod.lm(object, g, vcov., parameterNames, ...) } # lmer deltaMethod.merMod <- function(object, g, vcov. = vcov(object, complete=FALSE), parameterNames = names(fixef(object)), ...) { deltaMethod.mer(object=object, g=g, vcov.=vcov, parameterNames=parameterNames, ...) } deltaMethod.mer <- function(object, g, vcov. = vcov(object, complete=FALSE), 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(object, complete=FALSE), 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.R0000644000176200001440000001255213150571277012640 0ustar liggesusers# 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.R0000644000176200001440000006700213202333260014674 0ustar liggesusers#--------------------------------------------------------------------------------------- # 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 # 2017-11-09: make compatible with vcov() in R 3.5.0. J. Fox # 2017-11-13: further fixes for vcov(). J. Fox #---------------------------------------------------------------------------------------------------- vcov.default <- function(object, ...){ stop(paste("there is no vcov() method for models of class", paste(class(object), collapse=", "))) } has.intercept.matrix <- function (model, ...) { "(Intercept)" %in% colnames(model) } makeHypothesis <- function(cnames, hypothesis, rhs = NULL){ parseTerms <- function(terms){ component <- gsub("^[-\\ 0-9\\.]+", "", terms) component <- gsub(" ", "", component, fixed=TRUE) component } stripchars <- function(x) { x <- gsub("\\n", " ", x) x <- gsub("\\t", " ", x) x <- gsub(" ", "", x, fixed = TRUE) x <- gsub("*", "", x, fixed = TRUE) x <- gsub("-", "+-", x, fixed = TRUE) x <- strsplit(x, "+", fixed = TRUE)[[1]] x <- x[x!=""] x } char2num <- function(x) { x[x == ""] <- "1" x[x == "-"] <- "-1" as.numeric(x) } constants <- function(x, y) { with.coef <- unique(unlist(sapply(y, function(z) which(z == parseTerms(x))))) if (length(with.coef) > 0) x <- x[-with.coef] x <- if (is.null(x)) 0 else sum(as.numeric(x)) if (any(is.na(x))) stop('The hypothesis "', hypothesis, '" is not well formed: contains bad coefficient/variable names.') x } coefvector <- function(x, y) { rv <- gsub(" ", "", x, fixed=TRUE) == parseTerms(y) if (!any(rv)) return(0) if (sum(rv) > 1) stop('The hypothesis "', hypothesis, '" is not well formed.') rv <- sum(char2num(unlist(strsplit(y[rv], x, fixed=TRUE)))) if (is.na(rv)) stop('The hypothesis "', hypothesis, '" is not well formed: contains non-numeric coefficients.') rv } if (!is.null(rhs)) rhs <- rep(rhs, length.out = length(hypothesis)) if (length(hypothesis) > 1) return(rbind(Recall(cnames, hypothesis[1], rhs[1]), Recall(cnames, hypothesis[-1], rhs[-1]))) cnames_symb <- sapply(c("@", "#", "~"), function(x) length(grep(x, cnames)) < 1) if(any(cnames_symb)) { cnames_symb <- head(c("@", "#", "~")[cnames_symb], 1) cnames_symb <- paste(cnames_symb, seq_along(cnames), cnames_symb, sep = "") hypothesis_symb <- hypothesis for(i in order(nchar(cnames), decreasing = TRUE)) hypothesis_symb <- gsub(cnames[i], cnames_symb[i], hypothesis_symb, fixed = TRUE) } else { stop('The hypothesis "', hypothesis, '" is not well formed: contains non-standard coefficient names.') } lhs <- strsplit(hypothesis_symb, "=", fixed=TRUE)[[1]] if (is.null(rhs)) { if (length(lhs) < 2) rhs <- "0" else if (length(lhs) == 2) { rhs <- lhs[2] lhs <- lhs[1] } else stop('The hypothesis "', hypothesis, '" is not well formed: contains more than one = sign.') } else { if (length(lhs) < 2) as.character(rhs) else stop('The hypothesis "', hypothesis, '" is not well formed: contains a = sign although rhs was specified.') } lhs <- stripchars(lhs) rhs <- stripchars(rhs) rval <- sapply(cnames_symb, coefvector, y = lhs) - sapply(cnames_symb, coefvector, y = rhs) rval <- c(rval, constants(rhs, cnames_symb) - constants(lhs, cnames_symb)) names(rval) <- c(cnames, "*rhs*") rval } printHypothesis <- function(L, rhs, cnames){ hyp <- rep("", nrow(L)) for (i in 1:nrow(L)){ sel <- L[i,] != 0 h <- L[i, sel] h <- ifelse(h < 0, as.character(h), paste("+", h, sep="")) nms <- cnames[sel] h <- paste(h, nms) h <- gsub("-", " - ", h) h <- gsub("+", " + ", h, fixed=TRUE) h <- paste(h, collapse="") h <- gsub(" ", " ", h, fixed=TRUE) h <- sub("^\\ \\+", "", h) h <- sub("^\\ ", "", h) h <- sub("^-\\ ", "-", h) h <- paste(" ", h, sep="") h <- paste(h, "=", rhs[i]) h <- gsub(" 1([^[:alnum:]_.]+)[ *]*", "", gsub("-1([^[:alnum:]_.]+)[ *]*", "-", gsub("- +1 +", "-1 ", h))) h <- sub("Intercept)", "(Intercept)", h) h <- gsub("-", " - ", h) h <- gsub("+", " + ", h, fixed=TRUE) h <- gsub(" ", " ", h, fixed=TRUE) h <- sub("^ *", "", h) hyp[i] <- h } hyp } linearHypothesis <- function (model, ...) UseMethod("linearHypothesis") lht <- function (model, ...) UseMethod("linearHypothesis") linearHypothesis.nlsList <- function(model, ..., vcov., coef.){ vcov.nlsList <- function(object, ...) { vlist <- lapply(object, vcov) ng <- length(vlist) nv <- dim(vlist[[1]])[1] v <- matrix(0, nrow=ng*nv, ncol=ng*nv) for (j in 1:ng){ cells <- ((j-1)*nv + 1):(j*nv) v[cells, cells] <- vlist[[j]] } v } linearHypothesis.default(model, vcov.=vcov.nlsList(model), coef.=unlist(lapply(model, coef)), ...)} linearHypothesis.default <- function(model, hypothesis.matrix, rhs=NULL, test=c("Chisq", "F"), vcov.=NULL, singular.ok=FALSE, verbose=FALSE, coef. = coef(model), ...){ df <- df.residual(model) if (is.null(df)) df <- Inf ## if no residual df available if (df == 0) stop("residual df = 0") V <- if (is.null(vcov.)) vcov(model, complete=FALSE) 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, complete=FALSE) 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, complete=FALSE)[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, complete=FALSE) 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, complete=FALSE) 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.R0000644000176200001440000000105713150571277012743 0ustar liggesusers# 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.R0000644000176200001440000000264113150571277013463 0ustar liggesusers# 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.R0000644000176200001440000000474113150571277012622 0ustar liggesusers# 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.R0000644000176200001440000001254613150571277013701 0ustar liggesusers# 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.R0000644000176200001440000000205013150571277012553 0ustar liggesuserscarWeb <- 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.R0000644000176200001440000000517313150571277012145 0ustar liggesusers#------------------------------------------------------------------------------- # 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.R0000644000176200001440000001303513150571277012617 0ustar liggesusers# 2015-08-26: Modified by S. Weisberg to add support for bcn power transformations. # 2017-05-11: Added boxCox2d, renamed verssion of contour.powerTransform # 2017-05-11: Bug fixes in boxCox.formula with arugment passing to other methods boxCox <- function(object,...) UseMethod("boxCox") # New arguments: param, and gamma boxCox.formula <- function (object, lambda = seq(-2, 2, 1/10), plotit=TRUE, family="bcPower", param=c("lambda", "gamma"), gamma=NULL, grid=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 != "bcnPower") "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 != "bcnPower") 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="bcnPower") gam <- p1$gamma se <- sd(y) # arbitrary scaling factor seq(max(.01, gam - 3*se), gam + 3*se, length=100) } } } m <- length(xl) if(family != "bcnPower"){ for (i in 1L:m) { yt <- fam(y,xl[i],j=TRUE) loglik[i] <- -n/2 * log(sum(qr.resid(xqr, yt)^2)) }} else{ lambda.1d <- function(gamma){ fn <- function(lam) bcnPowerllik(NULL, y, NULL, lambda=lam, gamma=gamma, xqr=xqr)$llik f <- optimize(f=fn, interval=c(-3, 3), maximum=TRUE) f$objective } gamma.1d <- function(lambda){ fn <- function(gam) bcnPowerllik(NULL, y, NULL, lambda=lambda, gamma=gam, xqr=xqr)$llik f <- optimize(f=fn, interval=c(0.01, max(y)), maximum=TRUE) f$objective } for (i in 1L:m) { loglik[i] <- if(param == "lambda") gamma.1d(loglik[i]) else lambda.1d(loglik[i]) } } 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) } ########## boxCox2d <- function(x, ksds=4, levels=c(.5, .95, .99, .999), main="bcnPower Log-likelihood", grid=TRUE, ...){ if(class(x)[1] != "bcnPowerTransform") stop("Error--first argument must be a bcnPower transformation") object <- x if(dim(object$y)[2] != 1L) stop("This function is for univariate Y only") q <- object$llik - 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] <- bcnPowerllik(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$llik, 2)), pos=4, cex=.75) if(grid){ grid(lty=1, equilogs=FALSE) box()} } car/R/powerTransformlmer.R0000644000176200001440000000554713150571277015276 0ustar liggesusers# 2016-07-20: Added support for power transformations in lmerMod objects, S. Weisberg # 2016-05-02: Moved (working) cosde for bncPower family to bcnPower.R # generic functions in powerTransform.R powerTransform.lmerMod <- function(object, family="bcPower", ...) { if(family=="bcnPower") estimateTransform.bcnPowerlmer(object, ...) else estimateTransform.lmerMod(object, family=family, ...) } ################################################################################# ### 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$hessian <- optimHess(res$maximum, llik, ...) res$invHess <- solve(-res$hessian) 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 } ################################################################################# # 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} ########################################################################### # plot method ########################################################################### # lmerMod plot.lmerModpowerTransform <- function(x, z, round=TRUE, plot=pairs, ...){ cat("plot not supported for mixed models\n") } car/R/boxCoxVariable.R0000644000176200001440000000060513150571277014264 0ustar liggesusers#------------------------------------------------------------------------------- # 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.R0000644000176200001440000003206513150571277013725 0ustar liggesusers# 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.R0000644000176200001440000022270113202607137012414 0ustar liggesusers#------------------------------------------------------------------------------- # 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 # 2017-03-08: fixed bug in print.summary.Anova.mlm(). John # 2017-11-09: made compatible with vcov() in R 3.5.0. John # 2017-11-13,14: further fixes for vcov() 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, complete=FALSE))) 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"), vcov.=NULL, 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) if (!is.null(vcov.)) return(Anova.default(mod, type=type, vcov.=vcov., singular.ok=singular.ok, ...)) 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(t(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, complete=FALSE))), III=switch(test.statistic, LR=Anova.III.LR.coxph(mod), Wald=Anova.default(mod, type="III", test.statistic="Chisq", vcov.=vcov(mod, complete=FALSE))), "2"=switch(test.statistic, LR=Anova.II.LR.coxph(mod), Wald=Anova.default(mod, type="II", test.statistic="Chisq", vcov.=vcov(mod, complete=FALSE))), "3"=switch(test.statistic, LR=Anova.III.LR.coxph(mod), Wald=Anova.default(mod, type="III", test.statistic="Chisq", vcov.=vcov(mod, complete=FALSE)))) } 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, complete=FALSE)) < 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, complete=FALSE) 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, complete=FALSE) 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, complete=FALSE), 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, complete=FALSE), 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, complete=FALSE), 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, complete=FALSE) } 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, complete=FALSE) } 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, complete=FALSE), 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.R0000644000176200001440000000035313150571277013645 0ustar liggesusers# 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.R0000644000176200001440000000462713150571277014227 0ustar liggesusers# 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.R0000644000176200001440000003077113150571277012760 0ustar liggesusers# 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.R0000644000176200001440000000174513150571277014320 0ustar liggesusers# 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.R0000644000176200001440000000621213150571277013334 0ustar liggesusers# 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.R0000644000176200001440000001225513150571277014465 0ustar liggesusers# 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.R0000644000176200001440000003241513150571277015071 0ustar liggesusers # 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.R0000644000176200001440000000065613150571277013117 0ustar liggesusers#------------------------------------------------------------------------------- # 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.R0000644000176200001440000000733313201112047014154 0ustar liggesusers# 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 # 2017-11-09: make compatible with vcov() in R 2.5.0. J. Fox # 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, type=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) } vcov.boot <- function(object, ...){cov(object$t)} car/R/residualPlots.R0000644000176200001440000003104613150571277014211 0ustar liggesusers# 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.R0000644000176200001440000000235613150571277012702 0ustar liggesusers# 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.R0000644000176200001440000000321313150571277013470 0ustar liggesusers# 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.R0000644000176200001440000000435613150571277012275 0ustar liggesusers#------------------------------------------------------------------------------- # 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.R0000644000176200001440000001071013150571277013632 0ustar liggesusers# 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.R0000644000176200001440000002365313150571277015634 0ustar liggesusers# 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. # 2017-06-13: Fixed bug in gamLine to use predict(m, data.frame, type="response") 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), type="response") 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), type="response")) 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), type="response")) 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.R0000644000176200001440000001072413201112047013605 0ustar liggesusers# 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 # 2017-11-09: make compatible with vcov() in R 2.5.0. J. Fox 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.R0000644000176200001440000000523513150571277013763 0ustar liggesusers# 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.R0000644000176200001440000002303213150571277014403 0ustar liggesusers #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. # 2017-01-28: bug-fix in yjPower # 2017-05-02: function updates to accomodate bcnPower family. S. Weisberg # 2017-05-19: Changed summary.powerTransform; deleted invalid test; added roundlam to output ### 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, revised 5/2/2017 #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 <- function(X, Y, weights=NULL, family="bcPower", ...) { Y <- as.matrix(Y) switch(family, bcnPower = estimateTransform.bcnPower(X, Y, weights, ...), estimateTransform.default(X, Y, weights, family, ...) ) } # 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$llik <- res$value 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 roundlam <- round(object$roundlam, 2) stderr<-sqrt(diag(object$invHess)) df<-length(lambda) # result <- cbind(lambda, roundlam, stderr, lambda - 1.96*stderr, lambda + 1.96*stderr) result <- cbind(lambda, roundlam, lambda - 1.96*stderr, lambda + 1.96*stderr) rownames(result)<-names(object$lambda) # colnames(result)<-c("Est Power", "Rnd Pwr", "Std Err", "Lwr bnd", "Upr Bnd") colnames(result)<-c("Est Power", "Rounded Pwr", "Wald Lwr bnd", "Wald Upr Bnd") 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.R0000644000176200001440000000371113150571277013045 0ustar liggesusers# 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/0000755000176200001440000000000013202607636013034 5ustar liggesuserscar/vignettes/embedding.bib0000644000176200001440000000121213150571277015427 0ustar liggesusers@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.Rnw0000644000176200001440000002373013150571277015452 0ustar liggesusers\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/MD50000644000176200001440000002624013204337411011331 0ustar liggesusers6ab77418e7251afb93ba019a9f9700a7 *DESCRIPTION 21e31a74e10264e43d0b04222c1dfe06 *NAMESPACE 412b1b31acf5d6537023bc4cd3e6227e *NEWS b10f6ab6c2e95becdf4ef0ea1d1c71c7 *R/Anova.R 863311b6b0409f31e7c0f825a0f092f8 *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 92d5ccc2ae3f367b37a2f0bd1a8eacac *R/bcnPower.R 15c155a435c33aa3b8b6d6f9c2c0c06d *R/bootCase.R 481eb51ca00d36227afc2935f94e90da *R/boxCox.R 9ee884a60458a71168caeaa9c0db0766 *R/boxCoxVariable.R 16f7207a55f8a871635b2d49fea3c422 *R/boxTidwell.R 03db7145a3647f94e1d69fde66eb56aa *R/car-deprecated.R b9e05cea8482d00fa0dd8b97b60db87c *R/carWeb.R 5a360349d8fc5d6e33412927fb923f01 *R/ceresPlots.R a093ea454baab79c0c3a0a66383f94fd *R/compareCoefs.R f78874c94b3ffd97503c323dfc121131 *R/crPlots.R 50b9b05ca092b0ec79928270071181d0 *R/deltaMethod.R f574011e1a53ab066afe2e14113c7339 *R/densityPlot.R fba16462a3e5c5ac45adc196bb44d16a *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 89e40313dc56a678616e352c0defb9a8 *R/leveragePlots.R 3f41989e0dda16895b8e8ae1c54749fc *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 150ae3a2e5388894497b320302d50c44 *R/powerTransform.R c1e2e516fb367a11b7e4e76c04a31352 *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 981ae71b513f5c35a2c65f573cb9fc4a *R/scatterplotSmoothers.R 3aa7f4a54843bcf0a42b3bd7cd3ead3f *R/showLabels.R 24c3680c3b73eba48976557aab9ade89 *R/sigmaHat.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 275df6dc37e262dde83d3060dbea2d37 *build/vignette.rds 9efb547acf8f494729a48f97a6554111 *data/AMSsurvey.rda 2357736c7dbb74e7f1cf3f4342c1fd63 *data/Adler.rda 11cafab214627dc67e91adea1dc9fd32 *data/Angell.rda 29e9ec1cc648438f934d023b3593d0a4 *data/Anscombe.rda f7a166c66858c9a3f3d5e3c8363203ed *data/Baumann.rda 0d6794ee17d23a985ac5a09a726c7593 *data/Bfox.rda a3e2af430570d87fec4e2f7eae15b498 *data/Blackmore.rda 074870e7befa93bf094ca5325d49480e *data/Burt.rda 0c35fd43a824a30e90c2310f4d504a14 *data/CanPop.rda 0f007b5c7ef2b97a2a9d6ca95cd0ee4a *data/Chile.rda 707d42e141ae4dbcfb515673f3461a3c *data/Chirot.rda 62958afbeb109196ed1fafeb93179c2d *data/Cowles.rda 4ed7f353ac1fca52b82016150a20c493 *data/Davis.rda 263dd8980a7607d79c078b57fe3a2d0c *data/DavisThin.rda 51dd932c50fad2169b35775903a6394c *data/Depredations.rda e74334f323d51c6d6055807c8186d0e5 *data/Duncan.rda 8ada129145ea1f03fbbc7dd3ebebdd7f *data/Ericksen.rda 3e789842b887e18db552f91e96f282a4 *data/Florida.rda 1156977424da96202ed511923d545e89 *data/Freedman.rda c29ddd92ccff25b4056c15df8257f63b *data/Friendly.rda d95ba54a6381d1271cdac825e4331c7b *data/Ginzberg.rda ea601b15dde29978fc7b0a405d588170 *data/Greene.rda 417380ec2014223dc35c3663cd46f4d6 *data/Guyer.rda 3665173533dc9b836241e09f1d0c0e7c *data/Hartnagel.rda fee7365279dc53939db5240694eab63a *data/Highway1.rda a2dc4bb290b66da6ba71ad0be9ca27c4 *data/KosteckiDillon.rda 6f9f9fe4be511090907264e0d57c39df *data/Leinhardt.rda 70cf146e065390623fe2c21bc00befe9 *data/LoBD.rda 913ca4c0d79df0b8c7093436c906b927 *data/Mandel.rda 1e8a4c5ead084cc3bb54aa1399dbc6e6 *data/Migration.rda 681e809508ca856e5399ce0b370676ac *data/Moore.rda 79f62bba1083117bf46c615c0942ffa7 *data/Mroz.rda b10acdb1697a6ae51dbfdd7f48071d88 *data/OBrienKaiser.rda d272392f627e3d57e7cf1f80d40ad702 *data/Ornstein.rda a7283574e4152781525d97af005cb431 *data/Pottery.rda a40f8639fdf1b6b4356c307cf402c0ab *data/Prestige.rda a862af7e6c2e06be5641273e3e4f6977 *data/Quartet.rda ec83ffbe5d8ccec4790b78276046bc4c *data/Robey.rda 11352ff23de243bc02f84b40453552f5 *data/SLID.rda bb98889db0520056fba28fdfd51d870c *data/Sahlins.rda 57590c66b74692e7db2ead4aa196b0f1 *data/Salaries.rda eece1410eb795ea6592f7b9d2dbb557c *data/Soils.rda 5ee8b5d0c6815e227cfb79ce1b3083c1 *data/States.rda d836cfa6049826bc071796294ea75159 *data/Transact.rda 9d412ec6db5d687b6a8f43eb23fc3f60 *data/UN.rda 84e8ecb6ab7a508fa14553821397f2b6 *data/USPop.rda e808b0c2f9272c3f45302998a44f0d99 *data/Vocab.rda 6764f14b858fdbca6975247a0f3ac6d7 *data/WeightLoss.rda 6ba5f8cedd5ff3b76b6809bbae5a4e40 *data/Womenlf.rda 3054080cca24559a9acd5c04191231f9 *data/Wong.rda c810edaeef925c50472f91e7e594aa42 *data/Wool.rda e58584a26bbb414d417fca2ad22f2489 *inst/CITATION b39a6f4660e0f71abf561f4c327e2646 *inst/doc/embedding.R 3235f4b3623fe042c98df9722172ef27 *inst/doc/embedding.Rnw 30db488ccbbabc234a4253554fd77d4d *inst/doc/embedding.pdf ccb0b9fb2b009ce14c7647639dcd1b86 *man/AMSsurvey.Rd 0121ac092471417593ac2e32b134a883 *man/Adler.Rd 8a3ad189a7bd629bc812b28322acc5b3 *man/Angell.Rd 1ca0d6aaa4151ecb870df2c34f954a60 *man/Anova.Rd 771c447ef810aecde56774754ce0c8ad *man/Anscombe.Rd 74a8a2ff389993de7fd3ee2dd155aea1 *man/Baumann.Rd f5edd689536ad670cc6c9d4baa8bc510 *man/Bfox.Rd 442a9a09eac0e177a275874880ddb481 *man/Blackmore.Rd 9b00eabcc106a95750d8aabe88f804ac *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 65af4491e8edfeb948c67a377bf3cacb *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 76ce253f31b87f64ea161418560a8fc5 *man/bcPower.Rd 7d394873b4cecd9eada7b5630233c8f2 *man/bootCase.Rd 51c79ec1f2c2cf51c160932dd43b217e *man/boxCox.Rd 10ed4775b0c83ddc27cf772f9deee75f *man/boxCoxVariable.Rd de4255eb83dc7ff062699b63b8316d03 *man/boxTidwell.Rd ea9540069b63940fd6ffb3634ff4b05d *man/car-deprecated.Rd e636a003e6e0c4009e728c0f57af8e9c *man/car-internal.Rd dd3719c1f22495140debfcc5cf4de5b9 *man/car-package.Rd 94f2797f81c5989877684857b49e6c02 *man/carWeb.Rd dd17ca3c85d3a0a5e2eca03663c664c4 *man/ceresPlots.Rd 398a2e3f449600419a47d4a994a32aa5 *man/compareCoefs.Rd 38d56a434a4f3d38982c613ab8c96dca *man/crPlots.Rd f9f1e6ad2ced020afdca0d6f165ae14e *man/deltaMethod.Rd 686e97dcc4b6753fddd97ad3e683ee73 *man/densityPlot.Rd b04acac2dc07d6aa8a3ad039d305d114 *man/dfbetaPlots.Rd f81d7bb90460ef0ad7d0a773b5fc172a *man/durbinWatsonTest.Rd 740a9e130900639b06d55e6fc79b3a2a *man/hccm.Rd eba29f464fd17e1f4605414f4a18c8c6 *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 410e2f9b534ce146c4aff777f1696903 *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 f98d9936887336d48326805f2c201d70 *man/some.Rd 8788adb911ec5f977b8aa59ed1ac9bc0 *man/spreadLevelPlot.Rd a28e98c0a1b8db8d9442da17076b357b *man/subsets.Rd 0f04a7c53fee398f8bf641b5af8ea2e2 *man/symbox.Rd 5f32cf0e109816fc9378e770e1769b1c *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/0000755000176200001440000000000013202607636012123 5ustar liggesuserscar/build/vignette.rds0000644000176200001440000000033413202607636014462 0ustar liggesusersuQ0 ?`HLx^x ŋ!x%0o>X6i~N!D'0XtӅ qq b*(Zi#B\Ho$L^w-YH= ~ AsP/C(A^딒mQ535p̈g0=}1a4Zj?oWE;w0thIFhM^vcar/DESCRIPTION0000644000176200001440000000476313204337411012535 0ustar liggesusersPackage: car Version: 2.1-6 Date: 2017-11-14 Title: Companion to Applied Regression Authors@R: c(person("John", "Fox", role = c("aut", "cre"), email = "jfox@mcmaster.ca"), person("Sanford", "Weisberg", role = "aut", email = "sandy@umn.edu"), person("Daniel", "Adler", role="ctb"), person("Douglas", "Bates", role = "ctb"), person("Gabriel", "Baud-Bovy", role = "ctb"), person("Steve", "Ellison", role="ctb"), person("David", "Firth", role = "ctb"), person("Michael", "Friendly", role = "ctb"), person("Gregor", "Gorjanc", role = "ctb"), person("Spencer", "Graves", role = "ctb"), person("Richard", "Heiberger", role = "ctb"), person("Rafael", "Laboissiere", role = "ctb"), person("Georges", "Monette", role = "ctb"), person("Duncan", "Murdoch", role="ctb"), person("Henric", "Nilsson", role = "ctb"), person("Derek", "Ogle", role = "ctb"), person("Brian", "Ripley", role = "ctb"), person("William", "Venables", role = "ctb"), person("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 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: 486 Repository/R-Forge/DateTimeStamp: 2017-11-14 15:40:15 Date/Publication: 2017-11-19 17:27:37 UTC NeedsCompilation: no Packaged: 2017-11-14 15:45:34 UTC; rforge car/man/0000755000176200001440000000000013202607505011572 5ustar liggesuserscar/man/Contrasts.Rd0000644000176200001440000001162413150571277014055 0ustar liggesusers\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.Rd0000644000176200001440000000155413150571277014302 0ustar liggesusers\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.Rd0000644000176200001440000002151213150571277015504 0ustar liggesusers\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.Rd0000644000176200001440000000300513150571277014274 0ustar liggesusers\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.Rd0000644000176200001440000000171113150571277013005 0ustar liggesusers\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.Rd0000644000176200001440000000544413150571277014205 0ustar liggesusers\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.Rd0000644000176200001440000001203013150571277013513 0ustar liggesusers\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.Rd0000644000176200001440000000163013150571277013251 0ustar liggesusers\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.Rd0000644000176200001440000000403713150571277015414 0ustar liggesusers\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.Rd0000644000176200001440000002431613150571277014731 0ustar liggesusers\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.Rd0000644000176200001440000000572113150571277013566 0ustar liggesusers\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.Rd0000644000176200001440000000764313150571277014352 0ustar liggesusers\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.Rd0000644000176200001440000000320413150571277016075 0ustar liggesusers\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.Rd0000644000176200001440000001317313150571277013356 0ustar liggesusers\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.Rd0000644000176200001440000000236313150571277013143 0ustar liggesusers\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.Rd0000644000176200001440000001110413150571277014346 0ustar liggesusers\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.Rd0000644000176200001440000000222413150571277013451 0ustar liggesusers\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.Rd0000644000176200001440000000255613150571277012777 0ustar liggesusers\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.Rd0000644000176200001440000000251113150571277013163 0ustar liggesusers\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.Rd0000644000176200001440000000215613150571277013640 0ustar liggesusers\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.Rd0000644000176200001440000000214113150571277014157 0ustar liggesusers\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.Rd0000644000176200001440000000400213150571277015003 0ustar liggesusers\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.Rd0000644000176200001440000001521713150571277016307 0ustar liggesusers\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.Rd0000644000176200001440000001647213150571277013524 0ustar liggesusers\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.Rd0000644000176200001440000004423513202607137013136 0ustar liggesusers%------------------------------------------------------------------------------------- % 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 % 2017-11-09,13: update vcov. args. 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"), vcov.=NULL, 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, complete=FALSE), singular.ok, ...) \method{Anova}{mer}(mod, type=c("II", "III", 2, 3), test.statistic=c("Chisq", "F"), vcov.=vcov(mod, complete=FALSE), singular.ok, ...) \method{Anova}{merMod}(mod, type=c("II", "III", 2, 3), test.statistic=c("Chisq", "F"), vcov.=vcov(mod, complete=FALSE), 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, complete=FALSE), 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} and \code{glm} methods, 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.Rd0000644000176200001440000000315413150571277013772 0ustar liggesusers\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.Rd0000644000176200001440000000440613150571277012661 0ustar liggesusers\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.Rd0000644000176200001440000000333113150571277014477 0ustar liggesusers\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.Rd0000644000176200001440000000150713150571277013653 0ustar liggesusers\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.Rd0000644000176200001440000000301313150571277013147 0ustar liggesusers\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.Rd0000644000176200001440000001334413150571277015203 0ustar liggesusers\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.Rd0000644000176200001440000000231713150571277013650 0ustar liggesusers\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.Rd0000644000176200001440000000306513150571277014007 0ustar liggesusers\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.Rd0000644000176200001440000000150713150571277013773 0ustar liggesusers\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.Rd0000644000176200001440000000377713150571277013430 0ustar liggesusers\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.Rd0000644000176200001440000000364513150571277015011 0ustar liggesusers\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.Rd0000644000176200001440000000242713202607137014225 0ustar liggesusers\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-6\cr Date: \tab 2017-11-14\cr Depends: \tab R (>= 3.2.0)\cr LinkingTo: \tab Rcpp\cr Imports: \tab MASS, mgcv, nnet, pbkrtest (>= 0.4-4), quantreg, grDevices, utils, stats, graphics\cr Suggests: \tab alr4, boot, coxme, leaps, lme4, lmtest, Matrix, MatrixModels, nlme, rgl (>= 0.93.960), sandwich, SparseM, survival, survey, nloptr\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.Rd0000644000176200001440000000531513150571277013166 0ustar liggesusers\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.Rd0000644000176200001440000000232413150571277013735 0ustar liggesusers\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.Rd0000644000176200001440000001453113150571277014006 0ustar liggesusers\name{hist.boot} \alias{hist.boot} \alias{summary.boot} \alias{confint.boot} \alias{vcov.boot} \title{ Methods Functions to Support \code{boot} Objects } \description{ The \code{Boot} function in the \pkg{car} package uses the \code{\link{boot}} function from the \pkg{boot} package to do a straightforward case or residual bootstrap for a least-squares regression object. These are method functions for standard generics 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", "perc"), 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"), ...) \method{vcov}{boot}(object, ...) } \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="perc"}. 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, in which case a warning is issued and \code{ci="perc"} is substituted. } \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. The \code{vcov} returns the sample covariance of the bootstrap sample estimates. } \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} car/man/testTransform.Rd0000644000176200001440000000612013150571277014743 0ustar liggesusers\name{testTransform} \alias{testTransform} \alias{testTransform.powerTransform} \alias{testTransform.lmerModpowerTransform} \alias{testTransform.bcnPowerTransformlmer} \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}{bcnPowerTransformlmer}(object, lambda=1) } \arguments{ \item{object}{An object created by a call to \code{powerTransform}.} \item{lambda}{A vector of powers of length equal to the number of variables 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 \code{\link{bcnPower}} Box-Cox power with negatives allowed, the test is based on the profile loglikelihood maximizing over the location (or \code{gamma}) parameter(s). Thus, \code{gamma} 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{bcnPower}} 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)) summary(q1 <- powerTransform(lm(cbind(LoBD$I1L2, LoBD$I1L1) ~ pool, LoBD), family="bcnPower")) testTransform(q1, c(.3, .8)) } \keyword{ regression}% at least one, from doc/KEYWORDS car/man/Vocab.Rd0000644000176200001440000000204113150571277013120 0ustar liggesusers\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.Rd0000644000176200001440000001201613150571277014214 0ustar liggesusers\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.Rd0000644000176200001440000000336413150571277013026 0ustar liggesusers\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.Rd0000644000176200001440000000301113150571277013646 0ustar liggesusers\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.Rd0000644000176200001440000000777713150571277014727 0ustar liggesusers\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.Rd0000644000176200001440000000506013150571277014023 0ustar liggesusers\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.Rd0000644000176200001440000001474213150571277013343 0ustar liggesusers\name{boxCox} \alias{boxCox} \alias{boxCox2d} \alias{boxCox.lm} \alias{boxCox.default} \alias{boxCox.formula} \alias{boxCox.bcnPowerTransform} \title{ Graph the profile log-likelihood for Box-Cox transformations in 1D or in 2D with the bcnPower family. } \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, family = "bcPower", param = c("lambda", "gamma"), gamma = NULL, grid = TRUE, ...) \method{boxCox}{lm}(object, lambda = seq(-2, 2, 1/10), plotit = TRUE, ...) boxCox2d(x, ksds = 4, levels = c(0.5, 0.95, 0.99, 0.999), main = "bcnPower Log-likelihood", grid=TRUE, ...) } \arguments{ \item{object}{ a formula or fitted model object of class \code{lm} or \code{aov}. } \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 bcnPower 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{bcnPower} the function gives the profile log-likelihood for the parameter selected via \code{param}. } \item{param}{Relevant only to \code{family="bcnPower"}, produces a profile log-likelihood for the parameter selected, maximizing over the remaining parameter.} \item{gamma}{ For use when the \code{family="bcnPower", param="gamma"}. If this is a vector of positive values, then the profile log-likelihood for the location (or start) parameter in the \code{bcnPower} 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*sd)} and \code{gmax + 3*sd}, where \code{gmax} is the maximimum likelihood estimate of gamma, and \code{sd} is the sd of the response. See \code{\link{bcnPower}} for the definition of \code{gamma}. } \item{grid}{If TRUE, the default, a light-gray background grid is put on the graph. } \item{\dots}{ additional arguments passed to the \code{lm} method with \code{boxCox.formula} or passed to \code{contour} with \code{boxCox2d}. } \item{x}{ An object created by a call to \code{\link{powerTransform}} using \code{family="bcnPower"}. } \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 } } \details{ The \code{boxCox} function 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{bcnPower} families that allow a few values of the response to be non-positive. The bcnPower family has two parameters: a power \eqn{\lambda}{lambda} and a start or location parameter \eqn{\gamma}{gamma}, and the \code{boxCox} function can be used to obtain a profile log-likelihood for either parameter with \eqn{\lambda}{lambda} as the default. Alternatively, the \code{boxCox2d} function can be used to get a contour plot of the profile log-likelihood. } \value{ Both functions ae designed for their side effects of drawing a graph. The \code{boxCox} functin returns 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{bcnPower}}, \code{\link{powerTransform}}, \code{\link{contour}} } \examples{ with(trees, boxCox(Volume ~ log(Height) + log(Girth), data = trees, lambda = seq(-0.25, 0.25, length = 10))) data("quine", package = "MASS") with(quine, boxCox(Days ~ Eth*Sex*Age*Lrn, data = quine, lambda = seq(-0.05, 0.45, len = 20), family="yjPower")) } \keyword{ regression} car/man/OBrienKaiser.Rd0000644000176200001440000000370513150571277014413 0ustar liggesusers\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.Rd0000644000176200001440000004535313150571277015435 0ustar liggesusers%------------------------------------------------------------------------------- % 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.Rd0000644000176200001440000000305013150571277013116 0ustar liggesusers\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.Rd0000644000176200001440000000334013150571277013776 0ustar liggesusers\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.Rd0000644000176200001440000000311713150571277013460 0ustar liggesusers\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.Rd0000644000176200001440000000621613150571277013525 0ustar liggesusers\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.Rd0000644000176200001440000000133113150571277013267 0ustar liggesusers\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.Rd0000644000176200001440000000163513150571277012420 0ustar liggesusers\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.Rd0000644000176200001440000000172013150571277013321 0ustar liggesusers\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.Rd0000644000176200001440000000426113150571277014212 0ustar liggesusers\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.Rd0000644000176200001440000000311013150571277013202 0ustar liggesusers\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.Rd0000644000176200001440000000540313150571277014210 0ustar liggesusers\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.Rd0000644000176200001440000000423313150571277013300 0ustar liggesusers\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.Rd0000644000176200001440000000610013150571277014731 0ustar liggesusers\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.Rd0000644000176200001440000000222113150571277013635 0ustar liggesusers\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.Rd0000644000176200001440000000235713150571277013461 0ustar liggesusers\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.Rd0000644000176200001440000000702213150571277013631 0ustar liggesusers\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.Rd0000644000176200001440000002602013150571277015121 0ustar liggesusers\name{powerTransform} \alias{powerTransform} \alias{powerTransform.default} \alias{powerTransform.lm} \alias{powerTransform.formula} \alias{powerTransform.lmerMod} \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 of transformations are the default Box-Cox power family and two additioal families that are modifications of the Box-Cox family that allow for (a few) negative responses. The summary method automatically computes two or three likelihood ratio type tests concerning the transformation powers. } \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", ...) } \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{family}{The quoted name of a family of transformations. The available options are \code{"bcPower"} for the default for the Box-Cox power family; \code{"bcnPower"} for a two-parameter modification of the Box-Cox family that allows negative responses (Hawkins and Weisberg (2017)), and the \code{"yjPower"} family (Yeo and Johnson(2000)), another modifiation of the Box-Cox family that allows a few negative values. All three families are documented at \code{\link{bcPower}}. } \item{data}{A data frame or environment, as in \sQuote{\link{lm}}.} \item{subset}{Case indices to be used, as in \sQuote{\link{lm}}.} \item{weights}{Weights as in \sQuote{\link{lm}}.} \item{na.action}{Missing value action, as in \sQuote{lm}.} \item{...}{Additional arguments that used in the interative algorithm; defaults are generally adequate.} } \details{This function implements the Box and Cox (1964) method of selecting a power transformation of a variable toward normality, and its generalization by Velilla (1993) to a multivariate response. Cook and Weisberg (1999) and Weisberg (2014) suggest the usefulness of transforming a set of predictors \code{z1, z2, z3} for multivariate normality. It also includes two additional families that allow for negative values. If the \sQuote{object} argument is of class \sQuote{lm} or \sQuote{lmerMod}, the Box-Cox procedure is applied to the conditional distribution of the response given the predictors. For \sQuote{lm} objects, the respose may be multivariate, and each column will have its own transformation. With \sQuote{lmerMod} the response must be univariate. The \sQuote{object} argument may also be a formula. For example, \code{z ~ x1 + x2 + x3} will estimate a transformation for the response \code{z} from a family after fitting a linear model with the given formula. \code{cbind(y1, y2, y3) ~ 1} specifies transformations to multivariate normality with no predictors. A vector value for \sQuote{object}, 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 default Box-Cox power family (\code{family="bcPower"}) of power transformations effectively replaces a vector by that vector raised to a power, generally in the range from -3 to 3. For powers close to zero, the log-transformtion is suggested. In practical situations, after estimating a power using the \code{powerTransform} function, a variable would be replaced by a simple power transformation of it, for example, if \eqn{\lambda\approx 0.5}{lamba is about 0.5}, then the correspoding variable would be replaced by its square root; if \eqn{\lambda}{\lambda} is close enough to zero, the the variable would be replaced by its natural logarithm. The Box-Cox family requires the responses to be strictly positive. The \code{family="bcnPower"}, or Box-Cox with negatives, family proposed by Hawkins and Weisberg (2017) allows for (a few) non-positive values, while allowing for the transformed data to be interpreted similarly to the interpretation of Box-Cox transformed values. This family is the Box-Cox transformation of \eqn{z = .5 * (y + (y^2 + \gamma^2)^{1/2})} that depends on a location parameter \eqn{\gamma}{gamma}. The quantity \eqn{z} is positive for all values of \eqn{y}. If \eqn{\gamma = 0}{gamma=0} and \eqn{y} is strictly positive, then the Box-Cox and the bcnPower transformations are identical. When fitting the Box-Cox with negatives family, \code{lambda} is restricted to the range [-3, 3], and gamma is restricted to the range from .01 to the largest positive value of the variable, since values outside these ranges are unreasonable in practice. The final family \code{family="yjPower"} uses the Yeo-Johnson transformation, which 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 and thus it provides a family for fitting when (a few) observations are negative. Because of the unusual constraints on the powers for positive and negative data, this transformation is not used very often, as results are difficult to interpret. In practical problems, a variable would be replaced by its Yeo-Johnson transformation computed using the \code{\link{yjPower}} function. The function \code{\link{testTransform}} is used to obtain likelihood ratio tests for any specified value for the transformation parameter(s). Computations maimize the likelihood-like functions described by Box and Cox (1964) and by Velilla (2000). For univariate responses, the computations are very stable and problems are unlikely, although for \sQuote{lmer} models computations may be very slow because the model is refit many times. For multivariate responses with the \code{bcnPower} family, the computing algorithm may fail. In this case we recommend adding the argument \code{itmax = 1} to the call to \code{powerTransform}. This will return the starting value estimates of the transformation parameters, fitting a d-dimensional response as if all the d responses were independent. } \value{ An object of class \code{powerTransform} or class \code{bcnPowerTransform} if \code{family="bcnPower"} that inherits from \code{powerTransform} is returned, including the components listed below. A \code{summary} method presents estimated values for the transformation power \sQuote{lambda} and for the \sQuote{bcnPower} family the location paramter \sQuote{gamma} as well. Standard errors and Wald 95\% confidence intervals based on the standard errors are computed from the inverse of the sample Hessian matrix evaluted at the estimates. The interval estimates for the \sQuote{gamma} parameters will generally be very wide, reflecting little information available about the location parameter. Likelihood ratio type tests are also provided. For the \sQuote{bcnPower} family these are based on the profile loglikelihood for \sQuote{lambda} alone; that is, we treat \sQuote{gamma} as a nusiance parameter and average over it. The components of the returned object includes \item{lambda}{Estimated transformation parameter} \item{roundlam}{Convenient rounded values for the estimates. These rounded values will usually be the desired transformations.} \item{gamma}{Estimated location parameters for \code{bcnPower}, \code{NULL} otherwise} \item{invHess}{Estimated covariance matrix of the estimated parameters} \item{llik}{Value of the log-likelihood at the estimates} The \code{summary} method for \code{powerTransform} returns an array with columns labeled "Est Power" for the value of \code{lambda} that maximizes the likelihood; "Rounded Pwr" for \code{roundlam}, and columns "Wald Lwr Bnd" and "Wald Ur Bnd" for a 95 percent Wald normal theory confidence interval for \code{lambda} computed as the estimate plus or minus 1.96 times the standard error. } \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. (2017) Combining the Box-Cox Power and Generalized Log Transformations to Accomodate Negative Responses In Linear and Mixed-Effects Linear Models, 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{bcPower}}, \code{\link{bcnPower}}, \code{\link{transform}}, \code{\link{optim}}, \code{\link{boxCox}}. } \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) } # With negative responses, use the bcnPower family m2 <- lm(I1L1 ~ pool, LoBD) summary(p2 <- powerTransform(m2, family="bcnPower")) testTransform(p2, .5) summary(powerTransform(update(m2, cbind(LoBD$I1L2, LoBD$I1L1) ~ .), family="bcnPower")) # multivariate bcnPower, with 8 responses summary(powerTransform(update(m2, as.matrix(LoBD[, -1]) ~ .), family="bcnPower")) # multivariate bcnPower, fit with one iteration using starting values as estimates summary(powerTransform(update(m2, as.matrix(LoBD[, -1]) ~ .), family="bcnPower", itmax=1)) # mixed effects model \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) summary(l2 <- powerTransform(m2, family="bcnPower", verbose=TRUE)) } } \keyword{ regression}% at least one, from doc/KEYWORDS car/man/showLabels.Rd0000644000176200001440000001163313150571277014200 0ustar liggesusers\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.Rd0000644000176200001440000000142313150571277013516 0ustar liggesusers\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.Rd0000644000176200001440000000252313150571277013303 0ustar liggesusers\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.Rd0000644000176200001440000000133113150571277013075 0ustar liggesusers\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.Rd0000644000176200001440000000422113150571277013516 0ustar liggesusers\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.Rd0000644000176200001440000000221713150571277012626 0ustar liggesusers\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.Rd0000644000176200001440000001741013150571277015625 0ustar liggesusers\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.Rd0000644000176200001440000000162513150571277013543 0ustar liggesusers\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.Rd0000644000176200001440000000260413150571277013502 0ustar liggesusers\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.Rd0000644000176200001440000001417113150571277013000 0ustar liggesusers\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{ Boot(object, f=coef, labels=names(f(object)), R=999, method=c("case", "residual"), \dots) \S3method{Boot}{default}(object, f=coef, labels=names(f(object)), R=999, method=c("case", "residual"), start = FALSE, \dots) \S3method{Boot}{lm}(object, f=coef, labels=names(f(object)), R=999, method=c("case", "residual"), \dots) \S3method{Boot}{glm}(object, f=coef, labels=names(f(object)), R=999, method=c("case", "residual"), \dots) \S3method{Boot}{nls}(object, f=coef, labels=names(f(object)), R=999, method=c("case", "residual"), \dots) } \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.} \item{\dots}{Arguments passed to methods. The default method passes these on to the \code{boot} function.} \item{start}{Should the \code{f} paramters be passed as \code{start} values to the \code{update} in each bootstrap iteration? Alternatively, \code{start} can also be a numeric vector that is passed to the \code{update}.} } \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}. For the default object to work with other types of regression model, the model must have methods for the the following generic functions: \code{residuals(object, type="pearson")} must return Pearson residuals; \code{fitted(object)} must return fitted values; \code{hatvalues(object)} should return the leverages, or perhaps the value 1. 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 \code{\link{summary}}, \code{\link{vcov.boot}}, \code{\link{confint.boot}} and \code{\link{hist.boot}} that work 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.Rd0000644000176200001440000000221713150571277013275 0ustar liggesusers\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.Rd0000644000176200001440000000175613150571277014523 0ustar liggesusers\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.Rd0000644000176200001440000000047613150571277014457 0ustar liggesusers\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.Rd0000644000176200001440000001455513150571277014421 0ustar liggesusers\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.Rd0000644000176200001440000000771213150571277013501 0ustar liggesusers\name{bcPower} \alias{bcPower} \alias{bcnPower} \alias{yjPower} \alias{basicPower} \title{Box-Cox, Box-Cox with Negatives Allowed, Yeo-Johnson and Basic Power Transformations} \description{ Transform the elements of a vector or columns of a matrix using, the Box-Cox, Box-Cox with negatives allowed, Yeo-Johnson, or simple power transformations. } \usage{ bcPower(U, lambda, jacobian.adjusted=FALSE, gamma=NULL) bcnPower(U, lambda, jacobian.adjusted = FALSE, gamma) 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}{Power transformation parameter with one element for eacul column of U, usuallly in the range from \eqn{-2} to \eqn{2}, or if \code{U}} \item{jacobian.adjusted}{If \code{TRUE}, the transformation is normalized to have Jacobian equal to one. The default \code{FALSE} is almost always appropriate} \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. For the bcnPower, Box-cox power with negatives allowed, see the details below.} } \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. The Box-Cox family with negatives allowed was proposed by Hawkins and Weisberg (2017). It is the Box-Cox power transformation of \eqn{z = .5 * (y + (y^2 + \gamma^2)^{1/2})}, where \eqn{\gamma}{gamma} is strictly positive if \eqn{y}{y} includes negative values and non-negative otherwise. The value of \eqn{z}{z} is always positive. The bcnPower transformations behave very similarly to the bcPower transformations, including much less bias than is introduced by setting the parameter \eqn{\gamma}{gamma} to be non-zero in the Box-Cox 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. The basic power transformation returns \eqn{U^{\lambda}} if \eqn{\lambda} is not zero, and \eqn{\log(\lambda)} otherwise for \eqn{U}{U} strictly positive. 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 \code{skewPower} and \code{yjPower} and of \eqn{U + gamma} for \code{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. (2017) 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. 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{testTransform}}} \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.Rd0000644000176200001440000002467113150571277013777 0ustar liggesusers\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.Rd0000644000176200001440000000166613150571277013623 0ustar liggesusers\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.Rd0000644000176200001440000000206113150571277013150 0ustar liggesusers\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.Rd0000644000176200001440000000151513150571277013327 0ustar liggesusers\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.Rd0000644000176200001440000002432213202333260014310 0ustar liggesusers\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(object, complete=FALSE), parameterNames=names(coef(object)), ...) \method{deltaMethod}{nls}(object, g, vcov.=vcov(object, complete=FALSE), ...) \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(object, complete=FALSE), parameterNames = names(coef(object)), ...) \method{deltaMethod}{coxph} (object, g, vcov. = vcov(object, complete=FALSE), parameterNames = names(coef(object)), ...) \method{deltaMethod}{mer} (object, g, vcov. = vcov(object, complete=FALSE), parameterNames = names(fixef(object)), ...) \method{deltaMethod}{merMod} (object, g, vcov. = vcov(object, complete=FALSE), parameterNames = names(fixef(object)), ...) \method{deltaMethod}{lme} (object, g, vcov. = vcov(object, complete=FALSE), 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.Rd0000644000176200001440000000372613150571277013562 0ustar liggesusers\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.Rd0000644000176200001440000000472013150571277014477 0ustar liggesusers\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.Rd0000644000176200001440000002133113150571277014435 0ustar liggesusers\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.Rd0000644000176200001440000000264613150571277013013 0ustar liggesusers\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.Rd0000644000176200001440000000507713150571277014425 0ustar liggesusers\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.Rd0000644000176200001440000000530413150571277012653 0ustar liggesusers\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{bcnPower}}. } \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.Rd0000644000176200001440000000336313150571277013341 0ustar liggesusers\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.Rd0000644000176200001440000001006713150571277013007 0ustar liggesusers%------------------------------------------------------------------------------- % 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.Rd0000644000176200001440000000316713150571277013303 0ustar liggesusers\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.Rd0000644000176200001440000000267513150571277013127 0ustar liggesusers\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.Rd0000644000176200001440000000144013150571277013471 0ustar liggesusers\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.Rd0000644000176200001440000000451613150571277014706 0ustar liggesusers\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.Rd0000644000176200001440000000576213150571277013344 0ustar liggesusers\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.Rd0000644000176200001440000000204313150571277013033 0ustar liggesusers\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.Rd0000644000176200001440000001252313150571277015723 0ustar liggesusers\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.Rd0000644000176200001440000000346213150571277013677 0ustar liggesusers\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.Rd0000644000176200001440000000162213150571277013621 0ustar liggesusers\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.Rd0000644000176200001440000000210013150571277013002 0ustar liggesusers\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.Rd0000644000176200001440000000327713150571277013645 0ustar liggesusers\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.Rd0000644000176200001440000002264613150571277013663 0ustar liggesusers\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.Rd0000644000176200001440000000156313150571277013633 0ustar liggesusers\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.Rd0000644000176200001440000001463413150571277013531 0ustar liggesusers\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.Rd0000644000176200001440000000224513150571277013765 0ustar liggesusers\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}