modelr/ 0000755 0001762 0000144 00000000000 13624321012 011526 5 ustar ligges users modelr/NAMESPACE 0000644 0001762 0000144 00000002530 13623761313 012760 0 ustar ligges users # Generated by roxygen2: do not edit by hand
S3method(as.data.frame,permutation)
S3method(as.data.frame,resample)
S3method(as.integer,permutation)
S3method(as.integer,resample)
S3method(dim,permutation)
S3method(dim,resample)
S3method(obj_sum,resample)
S3method(predictor_vars,default)
S3method(print,permutation)
S3method(print,resample)
S3method(response_var,default)
S3method(typical,character)
S3method(typical,factor)
S3method(typical,integer)
S3method(typical,logical)
S3method(typical,numeric)
S3method(typical,ordered)
export("%>%")
export(add_predictions)
export(add_predictors)
export(add_residuals)
export(bootstrap)
export(crossv_kfold)
export(crossv_loo)
export(crossv_mc)
export(data_grid)
export(fit_with)
export(formulae)
export(formulas)
export(gather_predictions)
export(gather_residuals)
export(geom_ref_line)
export(mae)
export(mape)
export(model_matrix)
export(mse)
export(na.warn)
export(permute)
export(permute_)
export(qae)
export(resample)
export(resample_bootstrap)
export(resample_partition)
export(resample_permutation)
export(rmse)
export(rsae)
export(rsquare)
export(seq_range)
export(spread_predictions)
export(spread_residuals)
export(typical)
import(rlang)
importFrom(broom,tidy)
importFrom(magrittr,"%>%")
importFrom(purrr,compact)
importFrom(purrr,map)
importFrom(purrr,reduce)
importFrom(stats,quantile)
importFrom(tibble,obj_sum)
modelr/README.md 0000644 0001762 0000144 00000014366 13523017355 013031 0 ustar ligges users
# modelr 
[](https://www.tidyverse.org/lifecycle/#stable)
[](https://travis-ci.org/tidyverse/modelr)
[](https://codecov.io/gh/tidyverse/modelr?branch=master)
## Overview
The modelr package provides functions that help you create elegant
pipelines when modelling. It is designed primarily to support teaching
the basics of modelling within the tidyverse, particularly in [R for
Data Science](http://r4ds.had.co.nz/model-basics.html).
## Installation
``` r
# The easiest way to get modelr is to install the whole tidyverse:
install.packages("tidyverse")
# Alternatively, install just modelr:
install.packages("modelr")
# Or the development version from GitHub:
# install.packages("devtools")
devtools::install_github("tidyverse/modelr")
```
## Status
modelr is stable: it has achieved its goal of making it easier to teach
modelling within the tidyverse. For more general modelling tasks, check
out the family of “tidymodel” packages like
[recipes](https://topepo.github.io/recipes/),
[rsample](https://topepo.github.io/rsample/),
[parsnip](https://topepo.github.io/parsnip/), and
[tidyposterior](https://topepo.github.io/tidyposterior/).
## Getting started
``` r
library(modelr)
```
### Partitioning and sampling
The `resample` class stores a “reference” to the original dataset and a
vector of row indices. A resample can be turned into a dataframe by
calling `as.data.frame()`. The indices can be extracted using
`as.integer()`:
``` r
# a subsample of the first ten rows in the data frame
rs <- resample(mtcars, 1:10)
as.data.frame(rs)
#> mpg cyl disp hp drat wt qsec vs am gear carb
#> Mazda RX4 21.0 6 160.0 110 3.90 2.620 16.46 0 1 4 4
#> Mazda RX4 Wag 21.0 6 160.0 110 3.90 2.875 17.02 0 1 4 4
#> Datsun 710 22.8 4 108.0 93 3.85 2.320 18.61 1 1 4 1
#> Hornet 4 Drive 21.4 6 258.0 110 3.08 3.215 19.44 1 0 3 1
#> Hornet Sportabout 18.7 8 360.0 175 3.15 3.440 17.02 0 0 3 2
#> Valiant 18.1 6 225.0 105 2.76 3.460 20.22 1 0 3 1
#> Duster 360 14.3 8 360.0 245 3.21 3.570 15.84 0 0 3 4
#> Merc 240D 24.4 4 146.7 62 3.69 3.190 20.00 1 0 4 2
#> Merc 230 22.8 4 140.8 95 3.92 3.150 22.90 1 0 4 2
#> Merc 280 19.2 6 167.6 123 3.92 3.440 18.30 1 0 4 4
as.integer(rs)
#> [1] 1 2 3 4 5 6 7 8 9 10
```
The class can be utilized in generating an exclusive partitioning of a
data frame:
``` r
# generate a 30% testing partition and a 70% training partition
ex <- resample_partition(mtcars, c(test = 0.3, train = 0.7))
lapply(ex, dim)
#> $test
#> [1] 9 11
#>
#> $train
#> [1] 23 11
```
modelr offers several resampling methods that result in a list of
`resample` objects (organized in a data frame):
``` r
# bootstrap
boot <- bootstrap(mtcars, 100)
# k-fold cross-validation
cv1 <- crossv_kfold(mtcars, 5)
# Monte Carlo cross-validation
cv2 <- crossv_mc(mtcars, 100)
dim(boot$strap[[1]])
#> [1] 32 11
dim(cv1$train[[1]])
#> [1] 25 11
dim(cv1$test[[1]])
#> [1] 7 11
dim(cv2$train[[1]])
#> [1] 25 11
dim(cv2$test[[1]])
#> [1] 7 11
```
### Model quality metrics
modelr includes several often-used model quality metrics:
``` r
mod <- lm(mpg ~ wt, data = mtcars)
rmse(mod, mtcars)
#> [1] 2.949163
rsquare(mod, mtcars)
#> [1] 0.7528328
mae(mod, mtcars)
#> [1] 2.340642
qae(mod, mtcars)
#> 5% 25% 50% 75% 95%
#> 0.1784985 1.0005640 2.0946199 3.2696108 6.1794815
```
### Interacting with models
A set of functions let you seamlessly add predictions and residuals as
additional columns to an existing data frame:
``` r
set.seed(1014)
df <- tibble::data_frame(
x = sort(runif(100)),
y = 5 * x + 0.5 * x ^ 2 + 3 + rnorm(length(x))
)
#> Warning: `data_frame()` is deprecated, use `tibble()`.
#> This warning is displayed once per session.
mod <- lm(y ~ x, data = df)
df %>% add_predictions(mod)
#> # A tibble: 100 x 3
#> x y pred
#>
#> 1 0.00740 3.90 3.08
#> 2 0.0201 2.86 3.15
#> 3 0.0280 2.93 3.19
#> 4 0.0281 3.16 3.19
#> 5 0.0312 3.19 3.21
#> 6 0.0342 3.72 3.23
#> 7 0.0514 0.984 3.32
#> 8 0.0586 5.98 3.36
#> 9 0.0637 2.96 3.39
#> 10 0.0652 3.54 3.40
#> # … with 90 more rows
df %>% add_residuals(mod)
#> # A tibble: 100 x 3
#> x y resid
#>
#> 1 0.00740 3.90 0.822
#> 2 0.0201 2.86 -0.290
#> 3 0.0280 2.93 -0.256
#> 4 0.0281 3.16 -0.0312
#> 5 0.0312 3.19 -0.0223
#> 6 0.0342 3.72 0.496
#> 7 0.0514 0.984 -2.34
#> 8 0.0586 5.98 2.62
#> 9 0.0637 2.96 -0.428
#> 10 0.0652 3.54 0.146
#> # … with 90 more rows
```
For visualization purposes it is often useful to use an evenly spaced
grid of points from the data:
``` r
data_grid(mtcars, wt = seq_range(wt, 10), cyl, vs)
#> # A tibble: 60 x 3
#> wt cyl vs
#>
#> 1 1.51 4 0
#> 2 1.51 4 1
#> 3 1.51 6 0
#> 4 1.51 6 1
#> 5 1.51 8 0
#> 6 1.51 8 1
#> 7 1.95 4 0
#> 8 1.95 4 1
#> 9 1.95 6 0
#> 10 1.95 6 1
#> # … with 50 more rows
# For continuous variables, seq_range is useful
mtcars_mod <- lm(mpg ~ wt + cyl + vs, data = mtcars)
data_grid(mtcars, wt = seq_range(wt, 10), cyl, vs) %>% add_predictions(mtcars_mod)
#> # A tibble: 60 x 4
#> wt cyl vs pred
#>
#> 1 1.51 4 0 28.4
#> 2 1.51 4 1 28.9
#> 3 1.51 6 0 25.6
#> 4 1.51 6 1 26.2
#> 5 1.51 8 0 22.9
#> 6 1.51 8 1 23.4
#> 7 1.95 4 0 27.0
#> 8 1.95 4 1 27.5
#> 9 1.95 6 0 24.2
#> 10 1.95 6 1 24.8
#> # … with 50 more rows
```
## Code of conduct
Please note that this project is released with a [Contributor Code of
Conduct](https://modelr.tidyverse.org/CODE_OF_CONDUCT.html). By
participating in this project you agree to abide by its terms.
modelr/data/ 0000755 0001762 0000144 00000000000 12743765777 012476 5 ustar ligges users modelr/data/sim1.rda 0000644 0001762 0000144 00000000771 12743765777 014044 0 ustar ligges users BZh91AY&SYD
g]:V^f U=>O0ᵰ8@T) hځOPAh 4i=&ѣG&cH1D diF&F&4 #F L0
5%6@ @.YJf QtGTX]em|p AP_Uج
}f 6D @EA>BYFLT8ȇ !IbU IOZ]j{
tJpy8- 2 = #vpO6+}NjUD-a1 \p I,٪O E .`mpBR WprZt#T | 05ۄܸB ɘ6{4#Zo7Sg;Sˣ[!VTb^mQF4X*1 H:A8F=dH+')&h modelr/data/heights.rda 0000644 0001762 0000144 00000147160 12734266502 014610 0 ustar ligges users BZh91AY&SY_a (
U |R } @ @ @P (PP
K
_>P( EP QT*
$QI M $ *TTT$QJ>D>IN z lPǣlSϷ iӡ @ | P Sl[(m2PF5 ] u= @֭ݍ}O
jS*Uo xrJ P v:KyWک]{ܹ}4eϳRDϯ K쮈uqWmz3]}3:nӦ" ɉ F@ A
LhdbT2f210 6=O&D& S #2d dxdIi<@S5
4Ȇj< ~jAM! 2l4P M0z0&FCa=M i ?ҞOSD1Ph h£ JB4hhѠAh
@dC@ 4@h
Iꔕ 2A0zhSMF D0L4dz4&F`!01206j1 $I4` a 2a40ژ i&iL'ɦL=jz4< <_kE>~& fŏunӏ45 TWTbǧcpv*+5 4زy$ Æ]Їշĵ Kd.SjfC%cg^@"ց?U=qL7ծ_UWFIc
ZK*A!UB. 3c(1(n9..gb:%eHA,lURDg$\jAow\CQb)G'*H"(2 Rj+JlB($
f,K Ē
XiDG%jDlbjrXeVbj!&R Qf,PQarG"$ QaYƆVRYpXe*I'%VIŖE!&Q%EĬƖV* *'ribQrh,pXa!rrRӖ N]tq
+KV6(IEB+ X)+T%-HIJ!#MRE#XNV N
#1%DE3P
LM4ЮI% ⨸TCc5 $
#RdMec!QTMD8AXU"E K) RK
+UTE-L39Len㛵đBT$J,*1.114, *L *Ib
Ղ$DIPČ2#4D(9!Kd*L5Jʉ%c!A$9* .BcA8*#µIL,ɌYQ0IR Q'vKrl&ara"%Y% Yfj J%K\sr ˮts2UIYl\@; tw8%P24.CLda0*ȃd4.4L ʶd*JT*N,L
N$H.KP͑RȨ9(
,14KDʪD3"ʈ #Rʍ`3rr ݗ ]s!rZej$Ebq*fTVȨ*R',Rjqf(XF*E A(fBU**E
UƑ j!jAU\JF
e&+))2,ZIUbrQ(j"ĜB*',ArE\IjaaZ"D++ ĨZYV%d ejZ Vq`bɦTG*&rFJl\K j YYZ$jQJ$R2qɔkhV%h*VGK*'ZKU4T
)"
RL5Bň5TNTC0BMNRMbQbP.H4B-MEBN(.MA-5M "D9eX%H%
XJX6ʰ('kE%(qP Ami{uGV @8ҙK:\MJdHk79d+%>["7%|SlRQ1j7VrZT
٩٬WQ)]z'gmЬ.eR ƦM&Y @6`t?h i|Nsn|JV73tw;qR_ĩz_J%ٛθ^pO#|TQ0L"~7 Z"eUQeL jj#'Q
JU]*Mb_Z<6swˮciGQ=S#HHP4uCxce oY!zDw%aylR LY 4(^JwtPjYHP#b)I8J0=Q8Qh^i\j^z&vzH@hqR1YQFԌ:倭
EIEOUf a
E ?X0:Q:2@Ddf`;F7*t@G8?u+m3t4e<#{ =R',)ˉ^: ݩX`:; ѡ;ύߣtѣs,-YuaTć>};K+d6,8|Ŗ}Ƴ-HZWIrTb҆oVM' r̵I:uvH$J_B2M1ol9O6k /ʣ*9:H!#D;5O+.g>2l1t85B06LH7U!&{lq3Kgy"[o\
( 3}UUqGzU
v/HF \j xǨ͝.?X4&(
\#s&kJ_ۀ
(!m"0IbS qt c+v%D)]bRRaH`Ca%(F#!f$f!%y2B01S&L@Bb }Cv 3a&@M
!%띻14%a244L @L (ɥ!J:=yםy瞺$E)9@@#2h$JY2HDhiEHaa DFXZ2feH 299s00 ,DaEY$I3M(lA.A)J/YH1JeTiMwQ$ DD))5ۯivX[a[)5䧉ݗ;#
ID)B@DF I
I*&izq"1d!%SK#z[3J&C1Q
@HF$7)rh1#"2a@$Hd B
2&CȘ`و)wv"$
Qi Q lQQ
L
KWֽ\ۮWoq9D "$d!FP IJ9QLbd fC1pR2t&i!$fI% םq#$ġ ,Mח;! DI40Dd(34nz^ bO;rd! 8FH2dlnILb;2 w\0DfqU6UTAj'VFQB؇9;^gt 5 \q-z7IڔpRW1 ܇mrB-в6ArIRɺIUy8c(q(bmԓR]wwUAM`Rz7Kf
W\+wFwK6\S c%96t6RGcu]TShM[w
Mu]\Nw\4Z{쓾.o7mm{
Zwde%46cI4 d"F,"oh] i"$d@A0ކR$0bI$7w sBS2M@4Ɍ.\4
M$J$M ut"$Llإ,SD&1$&Dh)c c*㘢*
STUdvPU4D$$cbɀH1#II$SH0b0ɐ`BRL)&& #
9;kl*",@b"cF2 A
3&c$ d&H@d@[E$!b0HEF)dFHH۴Ȃc
#00+:VK۶R4vv扨H]vq
ZD)ΛPGn魨ʼnF4#D 2NI2:C0K41.BqfC$M1,D 9a& LR7v!M" ) YIdFd) L.a 5ם˺ruQLd1 3e@ם(6?2/:f0(det 3RDFI
Qd@&)@+!&hLlb˜&$"cBA\ Ą)MډQn^
GJ9DAef4DHfP̆HXBe(J1bi0B0+kЍOUĠçx;UjN ۞§D;L -!q
8WJnH&j1MkNXtM\zd ήFGm<@ p(MC`EQXCFD7lf(0ʩ# ɦK/ B)
2wfh~_ 7<1Z/'uL(h/> pOIPx jM Ls>i
H@:` #T;.ߍ.B)8[DWEb5A!q>
H =;;X:g(\oMo !1jt:i cMe՜)2-A$*z]q]1i[iY"EG mѯb FD]ˁӓӞSi\]6qׇg* ;ũ
$JBi"~x2 I {ME vlXd]xoj<[$xm\lջ#ԲAf|S:Zò$sd3FW-!W ]=YSl#&(\P`]!(9cjvZGb E%PMQe_fR:F1PMͧ;4슪uMl806dG\R+ݐGy "CZ dBkS닜GhDx6QѴ#OeC :RSif-Q:'DRӾ>s.pNނ vwJh4#
ݓ6()0#|FB>%1 ,I 5@莏d3fOE֪ sݲHQc7zY0XaD) u n썑h)wytuѣ֓:r.! $UWA "FlegHN~}k63ÂФ j$A@4)EmʤNM>NF=dYdT 蜨X&c,R$L6LzBu&։uX :"1 =ypGF/\0~z.+
_PPٟ{Ece ڃ(k|ͥ]7( <8@E7WH\t+7@m
BZxyp+
n\VQDQ2;B @+k BpK4RlV<ʋ+h1VJʗ `yLJ/ ,eYnJE\ǒZzWFTiSMAK+yu{5!B!y *&3suB "T)x,")BIvuj^Wݡ7FqѕQ%-,r8S9ޭ3h[E (@5 Ҧ{p8Yuo*Vg&8ȎфS,rW [I[vo++p7wh (+W 6윍Zgu̙r l°~9qf&2pazC*ِ Nge*.%'nXj,؎@o2_M0@cNqDj\&nS^U".a<7ls0JDղy%A Uǁ, LTET4VVyݠrsxl]ZkJn#7g{`^,*^*
DqЬnoM2^`,od98/(E
7;S[Bb2CT3Z( ʸnŴM5TJ4խ];K6(fS* QE3CgX\?ks&xn~.9_s_)'N҅MQ
{ Cߓh } &eCt %q0&OeʁZRjx;sd]ܐuCM)γҩϥu^j!X_NuR#D iYٴtV._Og{Uz:z
jxt9,hxl> OAq-l"d m=K19.;Ax+*=eg۴eh[VaIH2wb&Mj*u|6[\3.1ey|7
ѽ&\Wêf{}V=J_ƢͶ _wzQ҆VNrr5
y[C_5g:* ( MUSF#pVO.BWa^)Wq k9h a/L,m/yPFֽ2 ߞb^UΕ+6W֜EvkK d LɌ ld{}-]f{g8^L-X+UI(=S7˒".at{h3ӒT]:ĺ~vݲĭl/ GZwïUf뵲 yYUF\ a#j}Vrc1X}XN| wN7aU}t/&ea:|7'y{o,gENȭуuhrqMCEf_ՉVukse.dܔ=j?i-ss]w2v^a,X $1X\ča eڈmw94#Zy#yXk(qКuŝ{o0v8D_mw$L+;MZh7Go; fssp&C+o%:?+?dW|Cyl6Nb9-OZ9w{G`dSw/Q8ʝܯԳ)_(JJ܆ u=~/À;݂AwҎ\~\ 'әS$l| .^l5Q^BnPQ%ΚKt./ iiBJ^i' 'koW)|p$DZ*zv/InJ0u:kgWdKYorq\ߥ&̳Ưbʭp+KK;WЈNn?[j V1F\EWHYk>ǣcSxr%pK1Iydܱ caܕfbI1u'yw<g[ȳ.bU?_ikaNJJ _s9YE
dcY+f/zkc5<+( ^ֿWp-LʭL:Mt[=&ݻƜ
!YD }Zf*,: ^͋Ore*^TȮ]2AY[GsY[p
ڲA $ 1y|E+m_yP]ey ԭT S]Ycr+iGYt;se Y1+-$ af%:38'ҹj&<}7]\.6'һ34fN' _^1>=sۿ.+mg S
\ ߬ \1/1a/
q1{Ňew[)g WvJ>Vrzs~zY]{7]K _O<-4|&"R ӊ'oikM\8ɲdOk.`#UnO RZ*6Lt,?, -"^R>+5kipW-ߚ*oyQ jVfzG3baq
>9Fxd ݯbKֳBLl\9r =6la8g&*_ωa.Etu'ykBIaO~`Glv~voe%W5m}WGɚ]+U75y26GVWڻ_~珦ݧ}d~0UNC6+PثK_=e!q$ ^l1
vczc{l]
ӿW̱^-js]pnf[1/>3*䲩4Luk }vI7'jUtmUrPy1ߩv HwMW|bdcȗC/q:
L!pRw-c Ȇft}Y ңl +q?? F.R mɮ@~ŮeshDɼsr;T~?:D >.(ʂ5TsI?K:1 GN@zݟŞ]mѼ6EDzEohȬ^ ݊xZ[sN#2R@o^UUΓ墕=*55ka [c"*g6H)e︶1k0@%C d(z?JЍ.lYMs6Zݗu܉_* !p?([j5-nDnd MQ[""k^ B>&5hsdiaw%vzuql{<\>F%?n6).K]o4Aܫn$GYAC.(I`.&i`>[N=hو<; *)v y0 TnQWg_y\KtwkK"ӳĄ]]HWIB"劺l51ɇ]v--B?zNoaG
-&\qu2籈͊u(i h1Dh|+23[MbnI#Tsdr[
lN FKe75bV9܋'F^ C%ܼ9(I%b7D:Qv#,Yٮq}`/oSODϹ
m˫ƋȞ˧c6_ЇC,v'r [}s-ʀR*;( Pp)͈2a3Q! uꗛ`\WYW^&ʾ1mþVd/:E~@Eo,`~zQ'q~ -w֧8VZ*݆!ljU=Q浓iÍ-rS 0oIbZIݯH}>sѦ>c}
B˕M@n =6ֹs =laOZl^(].n
yzyG1yנK+r(%E ~*MۂX ?djQre9: UaԷ`(]!cKǰd+s"ժ4 &Y Dm**eӠZP\ײƛHhVTG h uq- A JyygnM`7\+gbϑ=!䛙cg
j;Vֽ+ l;. "K_M .^O屻ΧSuW.emX& 1 ;/{j KWS?L:5/f\[Grj,N]W j ڿ)ֳX[c F4,0^ 0;v'od6WcS]#9az2Nn9mz5G^w F,5f.c>9ūz|%SW:D3NU>GKpXƃt"ᯇ >·Xn3/t->J2U>| H\EbF52n/!;B6HVW5Kގ1X.ʼn:
c Ŗ6kև?k"%[c<+I$;f80J|LbF;R V\KlZspV)IƁ J yCq?KD@rj:ȼ7%ڨ}B-Y;>/! p/PLIGSXcڹ<z.%
٤G+&qCKX`-8I7^ ϵvz<""TmCZ8vwC#$dchɸ Q$A~sJ羬dmx/sm~.{(dGL)WY̻z
nnλv2k(yXeYV+#v-wϒ.X/v2v^>
i^>l-\DXsITsj{ aT/#\ ~vIRw/R̡yŦ5c 6>-a0n(d0u+3o]ϟhR.[QWm%RJ {^h` nGm 1nc{Ku"J{C
cm@/\ܡ,YFxO 4OF
&/vKBѫiX"^㬣*۵ b&^*,KKduӝW1T/}aԑmf+ ;ƿmc a췝$Asn zwrw .l5wjMLpug?[fc'|[Sk|0>+Mcvk3`]7%Đ ; ]ZHHH+r_@%rMBWZb
cKā @FqcT`^۔CG{*U$ x4jؐ
UqM.a OӃ?i!D$F.UZ ̭Mn6%,bտȹ2 Yn!$?ou:^T-]kTb\61*}U!!!QV@! %tUo1bO֪JL#U Iя^۸ئb(c
(
+qf5=+] 4Oȏ,&~4۬hU] v6 _eVT8;q[KkMb".E m])y&Mu-9U\^Ui tSMfHd!G4.F놌r9-gdڳ^M@s%YAE OA2*7$VW,l犁&äQ- \ {KDBX1F ךj|,'qv %k=*! \0I T]ԫreʥ{0yky
?HVi
:[|r)3&Ik< >UlblGmڶ$#FZY[rȦ 5 )Y)3㭫&(8(,]v\,$TX E
>?'Tq} KRyTsL| ȯ_ -s Uh-U4^r)Œjc6Y=sZfTnj#SJ V̞5DrEYcW~+uW cxn:kݝ5LQqB
EI^ }W&[T䔐<uxF#e RӒ
bh.U"Cs5UX%e2צSabW)¹ ( dZ[O4e a'Dewu#ࡈж*-Mzl[WXu)7' S
;ku՟i8$#c4y+0/f&Pʼf_SM+%5)3q
@
c (
{5)bLVZ E z
3+P A@PFUzU KFFk] b
4j"t )YLH۟*Z4:+.SRJyd%ŖK%Wm IZȺ%Ƙ5{߳E Fq >B҄ e7t]eҖ6F<+
SC+N=b1tؒ,%cf *q* ̊u[Eݿ۲%K o&mk[ܖmT<4iO i+, ꭓQnX#
v @v|## b#O]m'*:;U>ON` ED(>Xˣ* 7~\`_Z
1ov.XEk3Ht304! U|jVhVk,. Vkc `2NՅv
&'^CB
$7a>B(AL Dc s4*UTƾs KV"B`Y
u0kb;ͫ{s}hK< $/2@H#aV^GX@;kC8vX \ Uʮ5*([W`<p31r1'9m>b
(
(1 34M3+kJa2.kD6IVMYJu
7R- O#NVֲ2V'+#r*C R`Y ):R2xX ((20 T@;OLֲ[#A!h-nl0 . :w+8wdۊX$6RV;/21JY $)Vȫkz#XUk8 ؘU`H㨕 v S0@
*SC_T%YL2,vګjbȵ.4 vV%I\rC\ZIU PLRZ &i\JN P5вU`PNAD-\ 6e̚ cratலVk@QLZm8֔@( PZC !a?MC& %"K5of7NJYf``̱lpa-fVW6, H]Tgy *J?B@vY
"-d,0
5][|BA9zٝ
'Z&\L%,&mY R3c5LTi?2y =ׁҠ VMWEăwN@:2tҮaXTJ! UcZ1D
%Uux0MJcz0Jl*6Q>z->fU5-uB _!!ioh'mЩݡfoNAv"VF AY+4 nx TC!Pb$+l 5_
`szrه8.z
(#**w-b{zV?fW6P %x+ .i=ȫ`ń"z,V_[MhDАXƄZ} YwWUQhrdgλ`
[ *,'|W9a箼
3XC +HY
4?~ȼ 1 BHs/>]YNo,K? Vg3yVrWDW,s !*Ol_'
rCFĩX{Fk+vs ZY3J
sQgckZM#Dje,mm [I [VZ_}*F @6^W $@M[[^ݶUVݵʡ m$GGgy)шCl@$C@j@ $@ 4& `$rrhl'|_}tZcor^Z5[-$71뺼s@r,WԵ#Fck'r \t
9*f{ Tu7+W66屢r-{fWG5wu{ (bETit[tZŭV*oKoץZ-mi6rի&wKצ5_<|[oTŋ/+{8znwW6/e^
]髚5bѵ順pwz iT+lJ &6{Q`B
.>{0~Tra81_[kocθW<@h "B"N҆!N0=7իs~,J8%]O:y{o[WK+=G i %7L nF>SWo~{oqU^7^6ڶ\jWr F$״lmSs&Eħh
~U$NЊmj
'5y `^Ҷmome6ҷ6ƽsQm𪹫}kV*1,?ErVfd~%n 6$vM>t\2l8˝
$h 6ϾC q۔;'eGכħQ=os꿻߿حa0ͦim666%nh>GfmN) E@6g3p E[wqEXlI`mKem6{ @y2pJhDnw{ut=&/Ҁ
yD71o2; gx +!`6 66G`f
pzwgiT Ri)4س~&iax %HvA:Yu$K @*<34&fW<of xR'%(K9Ni
}Va!$(J s;qhZ\߇mi2=}ʾ槪{*W>U[,J3pKqHc
U6hWG6;΅ZB$$Sny{Ruo z T\0ӽ'1`kH@ {G/1;JJ5-Ug\ָ߶iEX%{ G$fGL{>i K.,#RbIIm4vu,U%ٛ'0-TiC ~X;TUؒB6 _ji,T$DHu ~_#`7ziPTO74VU/bꥨ^@xf^>>tGGF6oA{ {ŤpHC>K _Ek8ks}`=L]E Q BЁ | K3kJ_|~̗bO{R3u]} u?s}<$ cw- -%p!Z߽(!sdJ0Ѳu7~b;@.[/kfuS{MyX} @DA#iƗY40g1lyq'";xKkUy.ͱ{Ig9kZD??R<aNH]mhXBgg<_C|_OWc}a?U}p],}fz@"fGCªMi߽Ou!2t990[ErЁRJ qi~K
EWj%[_Hw 6"\&'HceRP~D:Z^{rݹuK+xߎm?2l~i C2s x~ZH8ؽw],,OڸZHOޛSm> ܫ4 GiU!p>V_q(!,\op7ojaζ hԓW\92)*Fc'Hxϯ/
JRvV~]jc͕jX{Z"-Y$$+.]#;dϴt9s{m?o ]u=
ܶmUJU']C<%rYʨL,<=Y4S i>|R|wJIE ID4 (d6S`/,\PBt1ȅӃjsF_ }{}h >z<|:+Ҭ0!0OޭE( $ 穣2a`*r])HM$ΪJf1Zwpje},MuAz+,ՉKN oEOSw<߅w>(I~JjDPUbKr?!Kr?]+ R=F~ߝTo C$Ova' QHCҪG!#?( Y't2 P@Q4tjDo ^&]#k:L5<[kr`B:+R o6 6)%Ub[_?{~7'ukD;{#TBG/xNM4ToY QJ#R'ijʕօkYtkӅMN
.S qwy=DB`[iPMsHA J.*|څjqW`ؖNwE\Um\yx! ]0/O.!2-Wmf4p~Vir4@d {3 њ:ws<~wvլ b Ig#c4k X(x* .5 M]WG
XSnlTBk9}A! }OqL7k: MN;7=I=F5J#߃sRU-BY05a͒8C` ,l++ F#-4f5@97WԜ..+[YkkzP֤0|f
$XaoDY kw_'˯;Hy((H C|ȡQuQWTB/Ŋj0Ǯ2jgA͵:xe#z̽%UOBjVbG4q$a$mA|H&sO9> .WNձ)K=ɠK~_ٹ$
ӵ _~ߨoWxw
4Dlm)h;VDicMtʰ*5
ems m<'
>i+r|#Q~ V94Į@.>>tfn R18<L0 }pHSKudu;$}GQdדO4;4|VU/x&{m(H6yPu@.eL MaՊQ$wZ?xsRC qqYOji j %$.>r;y7+I@:H.f00"CC %
9d6z4V 1Zzx ZurrF ,(}_7_O- I`J,$F֬WP.v&kVuG|(Hpwۇ-MiynF+
F=9P?al[r'&@7cixC} yy1;IOC*3fT܊<.v,ki&ڠ0f1ڒ)TB8Ӵe2
=pt<-S03aƢA> VtVb;ib &4CB & ;_ޒIs-o^_>JI]]b}rGuN,M?-:);ֺ6i]R$d$Ŵ5( _?!L ]/AI~}ֵ 'jc}FfjFS{ ɉ\wTC/to]ƌwr6;^xD.`ҞT\#Xhz SX ZAu]HH.Ƥѹ/z{ ~@[?9ЕT7ߙ>Gl~/Ę go}v \֪wf{t}ۙIZFn< 0=͉Rв1ѣHIha8`[rKPŻhB4]F♕TW fVHj J UZllS!$a
<H ~oyQDM"Ni?䏵*)KxT?훢s UNe.qn* XhBZ쳼uhV[$_gj7pt'mgv'˝.q!Y?U0J%ĒlsG#˟tK}Քy ]2纯lxZoo [Ա-CRzY2F/Ώi81k\b5j [EG { s(+IHHjr6 !J"ad_[Dع7ՒK7 =[TXHb|))ƈaY#d5{?έ
G@ KfVU~/m{6.kθo{w! ?h~)`ݎ/x%$! $%{?7qj?fRssfs]f85E2/Zo U݊XXv!Ô,
gI ezjX{s\Mmn6|ޒiIu+n]RݘH6ذI B7
M
qt Ny~W>//|s9t+Y[?@#ih4brK>Ý?aR0vpp W#fmu̾iCNL0&(^IM@tM+Ƅa]aH $yN Z-!(Aٰ!^ o?rZ*r O'0$~ҥNZ2ۯ?Ã%uwm #
g3/ ={m k< S5mHJ;c!_ak=OS)8 `|o#˯>Ϧ뉿h5(Ӎ~ⴳ̸Oxz߯&?hhB~9FOj=q K*rk4? 4ݣa~GS^X$9ǥ{W ~~Yn&+476]:obӯ0TIn
Iy{c nPXMd AJf!Qh!Tlh',EH]Z'hաfıpQͲ `$PŬbBXQwqs]rGnG.v:pa"9J%8;[#@ JM cRm.j
kk HP Bع6"83
,wr! TTʱXqԜGD
MBR&qI*rh©%Zhe՟wiAɪlĨ*!&ileQ5ݷ" 5 d
'eYGv4r%rj' aݍR"qbdv&HVBKXDFa6'\Uu!dO ;m̶ٰ̓j on|k>u5NW(cld4,JR=Bj08z.RFm~D4X{;,T=ga)P4v[N҆v
۴y/guJ .RƓ}qVLǤ0lvJ=0t(RSHwcFOMk1_9')\ nc(zQ˛^|5*ȮjBwTAoEZ y[ULv v3n.x;ݗCM
*qUjtm ց O[j2H.Dy/ *ބ_5"rHSjȆkؙxpXԌ;h $us ?/B;T
]uoZժ9Z_vXwj˲sq{a Qh{WٸԜ¦V d(#x";,z0*p&TnH(;Q fV|456> \כٷ[pChOiU5<[+ܬ]W\qHف`B3!XFH$i/Q=Qd, NuN<e)#Yy[tᛱ6 zK~٫v4VmG&46[ O HD*kQiM{։vJpP{jc}k17Z-϶0W(ϯЭ#->#Y{7˟Kgg\=trVaQߥ[c^zeT"|۹4fmr;(4iV[a ݶ
.jbIm5i]3~^@ʎľƪT'Ccdg;78p<&$lG9W6y,^ߔ ntU`oBz1
i5
ג1 Bᬖ
Ot}c.Gt8wx4Ƅ41i\Ni ilb,t]}͓,Mx
upcg1
^YmV)sS~>
;zĒN^+wO`skiqiqߙ,M-tm&Zkzf^Y^rbSg;Gv
7Dh\ GqxkB·qs fO wZA߃F2Y-L >L}l[JVКgɮß
ed2. 0}#v, pɖ2m#
cEt۟.)iweVf>)SU&Z&QR$
ˌ pMq>[^FvאsXTւˠ{HtW>U8$qysY>ץ-%UՔssMzbꯋactS-Mfhn-Ly^; pUf*6xڙS#R]w!I2 5K \'dagZ>6-_mfp㩹;alYscbĈb&x⸹16!5h8}
4ŝyu bX i+i_ ӷUJHP7ϖ X87^G[h9o%e
{Mq̗Ͽ{Sw#{Ӎ7aIZqHnDTj֥(t>lW+ig#$dZk@pu
N)O k͡| xD yHWcՎif k&gRE#&ś.WWR1Cmx,cW'{z+Z86pa,s/W!NtOLY{_Z7B.$ޠ .tzlulQ\{M뛷0kueS
2ЁL"Y aƊ.DDZܳWf= Ϗ3wޑ#F$Ҍe
HjE %bٙ ؤ"1&J,S
6
)C0cHH$E,ȕ&̤f*1Y0F3M$Q0hMcmcSs='zdϩŝqV:W-Rh[gt=~+Jz?` )d1f`f`fDb XhDE1AEX$PDذ!b5$ 1EDI),D@LD@ѱ*L6ƛLmט 9t:zgK`ky~? ]q{k{/=g@e0m6666llْY5 IXL1LD,S33
A(b0Dh#E0J cL"LXKD %H3@FC̴6@JD-~ }]WEI+2&. Tx 3r`e䮅c/m
%& E Q" @Li"
)MdD4ILYRMlk #E&M&
3
&E&B+s XSs"t )_tI^96c+As?O1'> Y`@ b
LI$DQEd6a$eb16#L
(H1d0hM
EشQ|~;>?|r'Xƕ{WM `
ӭ#&ލV{
V@ F*a
%-TS @&,ȣ
!RABF"P & d l2I!i Io}~u 8I {: *#ō)]9rTgs)r ?>O{ LDB
a16SAdS#P h,̚1LIAda11ƒC EIbԚ&llAh 0 e'Rɕ9'Tah5G#\E'ؾk>+go?d A(1%)!A$
R d4
QLX53"!4b1 )XTȒ4ciy[}Ҍ7wϹwkK^}nosۚ[Q6`$#`ԘŐ41c$b̢-i* 0_:N]\s%ް:e,W1#qgNA83iE6$ 4̃XT mm17|lxgX7OiNuzLͷEbu ^Y`64c4i6؛Bm _= (=v%mgkun?U`tz ĩtm
0bc/Z8g. XAc&%84ȿ{.&.SZSTkn-.7jD:CU]IMßxsc_a0ϿqYtfbjh$yy-!"pLs&?}wŹ>jVT5r4灾I6鱿=T!ξg/b[j(MW4cC:YQrNvMk&^^eҴCN'v~5UsFOF.^ Mc6oٮ %-lqOj VRmY9N6)KʅŶ mdM3?j; \#+3ݓg9\ 8&9} l d;ϫuwESys\^MפѧI ;ͭ)NjC*w͒ס[_ղilLܽ ۥUxxd [Ye}rV
]8b NMGܨtM
9U^
'œBCwaoibn=nꮦUݘLۍY4]T߸cvc9 K7w7Ŀc
z\nu{Iִ >aCF dt.sɌV/dX[_Ϻ.`h3s&dg\}9< =vNt0S>3jyk)Pi(o;Q5WVq K`Bu Hb)` ;;[{f+, `%f%oX"H75!KAR osW-"֪+*#h*5?R4T`wwX?'~ e~{9M07EDkDS~7'Qjի<ՋVO# M}fY
%/}iR79Ą,~w(blZ|H=.Q'[UiUd1[ m(=#KKhiXm*@-?yrU:\kyn͔TnubE =qsZO|$f%дYN@kW&)$h4!`ۈB>sCF֤ vzaia,hT4`#Z` Ko>dݖj%O;RI%~ ڂӺi X ᚮgK98!i-/;|ލ6 !:ϑߥi9;K \JHif ғ |=< wK)A!qs?J=u$$0$~&rK{Y4M"$_ ']
IQ/l5 (,!%|Bh7gQ#Py
Z&hz6`ny$ѭ%i uZ[y
!䀝O9ᤲ:I/ck;_}p4*<4,ylOA5P@YЖ$e5zxn4g@Yދs*Al
0 Ӊa"5$
_
AklL©אsH?M%͆u}? #QYVaG?8#2dV)^j+( # 4lHL {$5wv6CP6( M]준`$gK
H 7K./SFOU#BI`
YjڽdsFd,}Vt|)|ыq0I_q=}Ms5~ߜN6_jD=~ngoY XbzpL2Y92n`9Ϋ~&T8p#.|7/#Lǝ09?B8_O7 n$BT V0=34K%r41!m W
`%@$ ud$/ؕ]S[%tVk@$4лf%If` %tV}GQ~}A1=h/8S8+߆tβދxC %IuCzg0R%u _Н"i cnc$2f5
$@il״-BZV 5{[uX@
@,&$s[;}Bc,b'^r1$_/F) QLK)}<kw_){.!Ƈ! yޭ7HQGu |/0l>
'ye}I (jZYm۩V +${iz 9rVDş#U7/\\%Nr'g; Y-&S _bE /xwG䝟=O ׄ3 T~Wۯ4P!m^mm -q,/[Q|Zv3xv^v.{HZiD
LHvW){
*a! ]+?o=4%VMIc# ei;KnkAK`ڊlp(v3 Q&D{cBS i
VcvHhV[i! GZ2 c lds?jMhLj49 Ex n]/$+,]=e6u<_z,*ob>g`">G 䫶PwE@)mn6?6- ;[.-'C`D"IHPa|_a E=go { y٬!Of4,Zdo]Dު2qŜXP P56v !KE4"s\2 I
\_WvT[j0e{`~|L#KIO%wF8KY(_/xZwBMd_Է$Q?XCXl<#:$ عu"s]cͶ~w}GW54 ]RUAJ|% vZ=Z@Wqܽ]_'M
%Sm)A*Ae*!5MIL:J?n«U#.ӁDF RTH"2TF 0dfLnIgWeSfONS{_fϫzM =>' daci
7QnDkHU%RQ뼼o9^v{v7{Ut{ۮ<ۇme5r; zX|tge붊"[42ʊKDT
]^ƊK57J<ݵw)$.3d
TQ#Qiƚ)iMb"MU]{Nwq||(AFUA0T*! 5Mj*w19˴sN쳻NiI3Q IVUHRD$V{ȞgM5K*,<ӎ<˦K]"UL#hm٣h&X`HaO/ <wGN|#|^;- x& ;iީK4J%: \Mq=]nۻuW=۽GFvúIǛ%7iPn
yiw48s ^y(Ӆ#bF hQb%mǤ`* $,zsWNE҇ǫn&n7(IL C$&ֵݼ[t)[g{m< \\m]o(J7 ]; N:|YwVj U <{7W
^/7UBm;{Th '>:<#!yF#B!# v7zs ]\ Sǭ
w& Gģ[}Q )ǻW\Bƅݡ Z` ʕj,2kM[I _>Sd&B>N}f}G[W[B_-pwdHEzU1|⬨6[VwmdGFQ&+b6 ӓ Z[n %¨ B ~IP&\l <(R4iy$ؤMۑd9k@-/x0|=; W^P(w1yH3|
{ $@ru EZқ4HXZlǡ /ofzm=r]vo0ƊxdZK 6A٫ .;l /߀ 'c:a+QپU(}~h 7fdBI ͮZʹͦR+Mufz&HKFHp0v[Tϧq~sxtsA7
ۿ`"ϸGll:?Qtz")^wY
X ^Nհ4
!v܂ޖW7"D!blk:jSO4_q Q.YcOO
ŘS) _IC{Ya TU L(w*fӋ- "Jbb \W
ڲ v J낓 lY? y:l=?enz_tUjOm'52@-Oa-գ^72U5@ E M}Oit=%I{t)P
A :S"'{x&:y%b?42"@(} `X2)2rNRq*W;4P!@(C} m:o3cUTI
mʐsW_O[rƹ/>#ŞRD ?h%-}Mf1X)QOHUvQA.D=G)*ss-( UB_! ɻ21}~_Whr#I)& ~'L?f&mF LBIOd| > :^3]t]~[~WטŌW^_qX;igf{ Z16Pg&yp2uĹB?'(}1}WO:S*??w/>g=}@ k:|?_!f@$C`cƚ hAUkܥΧO:k) ֮|J5ܣd|^c{J PDՋ,b @迧>ocr9
%A)~ɝbj2T-Yj q)kYua$ }gϛk7S+۬Ǽa
wU S
JK**7W'u=z@ F_\ɡhTU BǓur?GW}ow >x5 *ot!1
@m^U%=U &r}Q%UjiY,F[َVhPF3\ɬ6]e$5,-?^a[/L {Jc/ sLF+XS_;=)d @XZvl\֙3?W!c`vۭ֚ClU\_>QjشZ#z4zAq.'rx TS{? _G`O#8Cn[lh~!oz*alXe6 ID/g}NvSe"O`f"~2"$}D??.S<=A(
>j@f~u ё+Ay7L$w eez6,lTQ6,U+FdT[1Ɠbm!667PũJn[;] % 12ڍ }YD\l^CW=msp'9 ;t9
e}4=_* զÈ7U =Z/,xh|7{ jxdDG'v*4rg2 UW|6z" LfS\ \uF&E5z/U.ú_I w^d /#M394}YZmr=ժ!vlIm o P#h
Z@Q~Yqw ?U(~ͽg?od~[g_L_+^z!z@9deN>nw;=ok.v]^*In9-V)>Ťu03l)ۿ?[Q@#=LP0Ҁ <ÿXb20 &B
l8g Ovuݤ$56: 9Kw[Kz(
n yr I@CA
f$~Q
pxԟjR<|9V!o|4U7ޙDlL\gZ$R[ģ& bP# Y~r?1CK< BXG_bsA Ѡ7 S\w$Q'fQ1\cp-4Й}T }NQn.5]3e/2}Mm}yd#<=YG_#k';|2 ; ec̦A`
K"R.Te !. OcЬ0l@MlI&đ#u@%yJDϾJ}2d>ܾ0K鰟u/ק<}#` 6 b"-Sj ߵA 骩B
1@1]|R8B[ G= ?7iα {C C ̻^ė5o |{]_6koրvIgaz[b6?5 ,ؗBLJy X+ڝ&,7Cƭ_~/{ "p[ _x{CB Kjzn~G$7 M.; p#Wȩ줐X̐p꽛hE D %)ggW'|0
6M.u .56Pw㳉BB^%8?[gǫj/%;<x5#ODw<{ڛmY?yXx\G Ѣ # `\(X <` ͎ iF
oKČD57 Y`˾%a^}Oy7r_[2+7{w|oc/7X` # $9
J-! g@o d4
i}W['1aq!i l
yۤ.uJ]ۣ!Hw[-λ&i!IG0afD@H"d&MRē;Jb,Gtq.8
눇7 K
ܝۢ&Œ+G ']; G*ۀw+$
N*6 #QY4JbCD$I,ԎtN'%wts3"&%L%"sNI
0V5##4 Bfݝ\WQΗiD('Z #
nۨnL' R~ m.DSoGk@!}/y7 +ct؆0;wG4/YTa LT:,MRx1=5,K:,6}x?OzMױ҈/
sUo
'kzr ΘN5 II~iV
'C]Qxg1'X×c٧,XnŚ2e[_=> mUe$jJ1C=iMci#ioL8 d_WuʭunT1 ~ ܍#_%A?>'c{D?/Td^GSʨ'^__Wvxր M[tw.(\4ӈ@0ywϙ`xT@ `L]MS[}9l쿧'~|/E}~LϛϾ瞧}_zܫZFO/fhXp}Vo-$Rl-$J}6|]˖۱q𬳵!D8\c Mci{*[6Q8Im?C+'f3clzoe -7wWϗ.Q!%*>Eħ%4;QS?^gfb ݶ$Op ' XEفJ !OCC7/^ !Wh8]+b!5.wB Hͭ f{X̦hՃ MSʊUZz^[HZ<\! {>3&A'
Su%챵>,kNi'pz͝A
cqV#Yb> Ql/_/Y8\{^ڽ
LWٮBIH.Rkn@8^~ONljeN#^M6 Ѱ
666L`G]kCxY%NM3d|$wglm[nswRϨj}$pLבK|~
`hhFHkc`1CG5WY jdz5NoO[έl^kX'lj6P(aYD]/ %De F3lJDA4IW'Yb͵=}, _k'/<+ ;'3g LU*nz}PIWlM(HK2;>Vpxw?i!&Bu[g5n&&Ɔm V9e}GgsnP,PH4Ţl3 d`!9fR~F !Dw D^d}E(8Bi=
薩MNUrn%u?8@! @-2T$ydkC
Te %`HUOvj[UW5H!H
Ƨ >z5ڰ>^qgGuYץMypf{Qcw^DuRipͶm1jlĨ H W<}FϟoC~WܯdW3̾gG㿴R*8 ]WA%Sa4?s$,"I[:owB_'x*9sYĖ'2sd !k)}V46d汏 @C6fW)ƐbQ=O2E4۶pI%
X 柑S*vRXjf!^C19&_jy }5o]C3 U
6ڎC&績k_s \Ē^M)<d uVi:qD\2I*8 CN}O>7O '*:8&/WTa4ugBqLoI!Xk@wIst]ˌ%\iVńbl1x{~
Ψ[HQ=Gsnt^^<9|W!)ɠbZW}JIS^~[# $&2=̼xփO_&zW,?x{~*x^_
@@ (d tŁ
8270 ӈ?Uzܧ5<`jp$L8 4 ROk]- kX&mL8@!ץ>4.~O9`b2XL eAu&(
( :3+RL 6qV*q~?@Hc% Im\sR< Iܘ@cΡ?FywD}8PKyN4EѤI*HZBGɾ/"e'@'iW -ӎbI
]L][ ~qqvc._`{gKY5n /
Y55?[ }:EZ'LBOvZO 3I @)H_:D , 3vϫRLd(zf5hEs+x0]u]ʬZ$z.$]rq n|Wvh{ih _|G?^QBArټ'hg̵ {n66xV+_06j:F|oN^z{_O6N
xuT"K3fuzx~ O3ͣ|vc jA`H+2 *Jp pVbao)IY@,>yn" b&X,SX X
"mB]48
^#X$Qx<_L=/}_ A$ffe{dh]qk@?2
fn^#!ڽN^sj1*)-hglw)Ly*H5xt{QD#h`- ʐB9?Cc╘wƲ\" W{ UpIo3/KN/̸C x:~u {ȏǸV@ZsMy $ѹ#SwMq_7ӽ _tD p XY3 ON[ EExgG헬 A T8@ u+?$`^2o!ăU ,
ˁ--2t\[N^(>cj7[ {>SaE%YtHvUZESGH 4G햜"ԕQ^-O2~bv 7 >!̵;8iBR7~" D3q'ƻOÓl8 e9f"D;[s@
\@v lh{a{GS>\_ E$j}cm lpcR"kjm5=a|\첂]]Q\/muJϓxV@Ia0l H. ~OS Ւ4;S9$2g7=m8p-6ET.p!W3 modelr/data/sim2.rda 0000644 0001762 0000144 00000001152 12743765777 014037 0 ustar ligges users BZh91AY&SYK <;Tys{V\_{װx@dhh @h 4 @ h4ɑ4 =Gdhi b&M@ɡCA@1 h1C# ɦ11
)hj` 0F z @4bi`Li`B XQjԙe8a5N;-+[ M T1H -1(${]Iq- 0 �@@ [@7D
`ذKC%j4_6j ?ܘ'_I 9ݔ ߃3J[q8U
W]ԗ#Mrf2W+ ^hDe4ʓn42O%k) @,J@ P^=]&2K̭!jmn#s( ,\ RK =*6NRo^
+C@c{fwdV6q4h{\Txr
\oм-q?CNOHOJ5Q:?GLNt _hm 'Gр2]Y=)j;U
%~@x)u2X modelr/data/sim3.rda 0000644 0001762 0000144 00000003053 12743765777 014042 0 ustar ligges users BZh91AY&SYom /w yx2By5FC'z&ML! aшz 'OM hڛQ=F#jh=M=4j?HѠ2h#i䍵Pd16O"z
5
53Q &&4ѡ6Lj3H h @FCL#MB04OS ɚ&zLLI3Q0fɈ4`4#14& !L!da1M#& F&FLL 0 d20шf
L
& & ѦfiS$zj4
h4
hѣM2 #hh F @ F&h W 4"5BrIB@%0!{VP$!9֩Vt4n
G[Nܖ",ڦ!Sq!Q+ X*[lҢbGN N"%
&X +@""16ݤ*Z@* ݪ$'k[dV Bs*dIddH _8)߸LZYUJ)+n/r,Do3o߽ 8TA 0# 02"l@\q9'r@1j-ǾdrD \Y.;J w߂]9,P/z&~K£Ҷ쒯,!,?,'qiIfS:8! a .S'/ y!١<\pP$ N.+r)QdB!szɕdE ^ S19)2[ꚁY
uM(!`DΐeVHya>q:ЬئP?O܂h7 g]Mlu|HzON͌ v; a]B LnddV'lJ ' 6Ͼ;:WwxLWEE]gv'PJ && ch;! ֽ~L k]y` g,O|c
Ȣ Fc&jFҪD~UTI+3Gp )
P&xr
|ߍ= ` B~dgI-Zsj.S䙾s{VjfA. r 7zM@_{]$/TaL
9uk4",9{U-j-7cO>}e
!;*j#_M>7Qj\(QA 9
Ge q$W`N Jch.)UBD! d:*1+`FZ i.͈y0
dTGGF-˛Ôߙ
pFaHVRk "{$
ŕ<4(hh哸A.4#'U;% )5
dT( X֜37<`HSRQ1P[ O)Mh modelr/data/sim4.rda 0000644 0001762 0000144 00000006207 12743765777 014047 0 ustar ligges users BZh91AY&SYU ϣ>/O4NyGJz#5 hC5dѡ4 OS
C=OH1 h=GLm4M6A5=F0ODFڏPچSFl&d4A=OI F
AAA10Ѩ6Qhd=M64 d=@yMzj=DG=M=C4ji442i M SOQi4fCD2
4M2cDƓ`4M'6SM14
K5 KDKJJWzKY
S,nLkY\|ͬ
;_6-mtߏtYKݼK'߇ ]; JޠXH J/6 *6@3 źYAK/X`1W`)= I
Uy.A;ײo5 R #[,!#
*\.O*8+ƦNVt12ffb2x$?含* 9|7 .4-&;}N6R`P#f]!x~E"*:dND8kے@HɘNաF]93U#cy֒O,`8X4ЬWf%X9鈴Y1BxB&uK8}tM ;. >UŅXRT映e`juYśmpITτй6@/|+9\ CR}u]sHcC%G@22xR ~bDMLiTW&9{El] FF+=*Y| uuxܽdQԶWw6ŹTsn6)ic BB
AnG#{eU5s} G8{UuD0I@An.N9 Ķ<\HKsG)
p:`&YQB܆q<G`eo{d$ R vULS]\j/d霵'{a뻾veL
ץ]z#qRd e05ټ_ݥ
M!~ogI"BmmnK?W H KY.$Rd/s b!7ǚκ$c6+}4K > ..YV۸t(`f_ DN?҆G8d+M3yݸ ų!8t(R ˵t{M3x(Rٕ 8[lsFMXQ]Q$p (`w
h9 !p N?u0`I?;>C4ʯ,K
nz%SOVOo$ oDJe5'츔1o
)f* h S7J
! #e6EtЎSK`}U0Pô1b*(kmCTɃLP*kh&f&XG*V͏X6{W];ߤ}ݪ/)g`cgOIIdm֏~$$H\% add_predictions(m1)
m2 <- lm(y ~ poly(x, 2), data = df)
grid \%>\% spread_predictions(m1, m2)
grid \%>\% gather_predictions(m1, m2)
}
modelr/man/add_predictors.Rd 0000644 0001762 0000144 00000001362 13134626747 015603 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/formulas.R
\name{add_predictors}
\alias{add_predictors}
\title{Add predictors to a formula}
\usage{
add_predictors(f, ..., fun = "+")
}
\arguments{
\item{f}{A formula.}
\item{...}{Formulas whose right-hand sides will be merged to
\code{f}.}
\item{fun}{A function name indicating how to merge the right-hand
sides.}
}
\description{
This merges a one- or two-sided formula \code{f} with the
right-hand sides of all formulas supplied in \code{...}.
}
\examples{
f <- lhs ~ rhs
add_predictors(f, ~var1, ~var2)
# Left-hand sides are ignored:
add_predictors(f, lhs1 ~ var1, lhs2 ~ var2)
# fun can also be set to a function like "*":
add_predictors(f, ~var1, ~var2, fun = "*")
}
modelr/man/resample_permutation.Rd 0000644 0001762 0000144 00000001061 13134631647 017043 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/permute.R
\name{resample_permutation}
\alias{resample_permutation}
\title{Create a resampled permutation of a data frame}
\usage{
resample_permutation(data, columns, idx = NULL)
}
\arguments{
\item{data}{A data frame}
\item{columns}{Columns to be permuted}
\item{idx}{Indices to permute by. If not given, generates them randomly}
}
\value{
A permutation object; use as.data.frame to convert to a permuted
data frame
}
\description{
Create a resampled permutation of a data frame
}
modelr/man/bootstrap.Rd 0000644 0001762 0000144 00000001652 13623760427 014631 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/bootstrap.R
\name{bootstrap}
\alias{bootstrap}
\title{Generate \code{n} bootstrap replicates.}
\usage{
bootstrap(data, n, id = ".id")
}
\arguments{
\item{data}{A data frame}
\item{n}{Number of bootstrap replicates to generate}
\item{id}{Name of variable that gives each model a unique integer id.}
}
\value{
A data frame with \code{n} rows and one column: \code{strap}
}
\description{
Generate \code{n} bootstrap replicates.
}
\examples{
library(purrr)
boot <- bootstrap(mtcars, 100)
models <- map(boot$strap, ~ lm(mpg ~ wt, data = .))
tidied <- map_df(models, broom::tidy, .id = "id")
hist(subset(tidied, term == "wt")$estimate)
hist(subset(tidied, term == "(Intercept)")$estimate)
}
\seealso{
Other resampling techniques:
\code{\link{resample_bootstrap}()},
\code{\link{resample_partition}()},
\code{\link{resample}()}
}
\concept{resampling techniques}
modelr/man/permute.Rd 0000644 0001762 0000144 00000002646 13275046710 014274 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/permute.R
\name{permute}
\alias{permute}
\alias{permute_}
\title{Generate \code{n} permutation replicates.}
\usage{
permute(data, n, ..., .id = ".id")
permute_(data, n, columns, .id = ".id")
}
\arguments{
\item{data}{A data frame}
\item{n}{Number of permutations to generate.}
\item{...}{Columns to permute. This supports bare column names or dplyr
\link[dplyr:select_helpers]{dplyr::select_helpers}}
\item{.id}{Name of variable that gives each model a unique integer id.}
\item{columns}{In \code{permute_}, vector of column names to permute.}
}
\value{
A data frame with \code{n} rows and one column: \code{perm}
}
\description{
A permutation test involves permuting one or more variables in a data set
before performing the test, in order to break any existing relationships
and simulate the null hypothesis. One can then compare the true statistic
to the generated distribution of null statistics.
}
\examples{
library(purrr)
perms <- permute(mtcars, 1000, mpg)
models <- map(perms$perm, ~ lm(mpg ~ wt, data = .))
glanced <- map_df(models, broom::glance, .id = "id")
# distribution of null permutation statistics
hist(glanced$statistic)
# confirm these are roughly uniform p-values
hist(glanced$p.value)
# test against the unpermuted model to get a permutation p-value
mod <- lm(mpg ~ wt, mtcars)
mean(glanced$statistic > broom::glance(mod)$statistic)
}
modelr/man/resample_bootstrap.Rd 0000644 0001762 0000144 00000001177 13623760427 016523 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/bootstrap.R
\name{resample_bootstrap}
\alias{resample_bootstrap}
\title{Generate a boostrap replicate}
\usage{
resample_bootstrap(data)
}
\arguments{
\item{data}{A data frame}
}
\description{
Generate a boostrap replicate
}
\examples{
coef(lm(mpg ~ wt, data = resample_bootstrap(mtcars)))
coef(lm(mpg ~ wt, data = resample_bootstrap(mtcars)))
coef(lm(mpg ~ wt, data = resample_bootstrap(mtcars)))
}
\seealso{
Other resampling techniques:
\code{\link{bootstrap}()},
\code{\link{resample_partition}()},
\code{\link{resample}()}
}
\concept{resampling techniques}
modelr/man/add_residuals.Rd 0000644 0001762 0000144 00000002604 13275046542 015413 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/residuals.R
\name{add_residuals}
\alias{add_residuals}
\alias{spread_residuals}
\alias{gather_residuals}
\title{Add residuals to a data frame}
\usage{
add_residuals(data, model, var = "resid")
spread_residuals(data, ...)
gather_residuals(data, ..., .resid = "resid", .model = "model")
}
\arguments{
\item{data}{A data frame used to generate the residuals}
\item{model, var}{\code{add_residuals} takes a single \code{model}; the
output column will be called \code{resid}}
\item{...}{\code{gather_residuals} and \code{spread_residuals} take
multiple models. The name will be taken from either the argument
name of the name of the model.}
\item{.resid, .model}{The variable names used by \code{gather_residuals}.}
}
\value{
A data frame. \code{add_residuals} adds a single new column,
\code{.resid}, to the input \code{data}. \code{spread_residuals} adds
one column for each model. \code{gather_predictions} adds two columns
\code{.model} and \code{.resid}, and repeats the input rows for
each model.
}
\description{
Add residuals to a data frame
}
\examples{
df <- tibble::data_frame(
x = sort(runif(100)),
y = 5 * x + 0.5 * x ^ 2 + 3 + rnorm(length(x))
)
plot(df)
m1 <- lm(y ~ x, data = df)
df \%>\% add_residuals(m1)
m2 <- lm(y ~ poly(x, 2), data = df)
df \%>\% spread_residuals(m1, m2)
df \%>\% gather_residuals(m1, m2)
}
modelr/man/crossv_mc.Rd 0000644 0001762 0000144 00000003032 13426133222 014570 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/cross-validation.R
\name{crossv_mc}
\alias{crossv_mc}
\alias{crossv_kfold}
\alias{crossv_loo}
\title{Generate test-training pairs for cross-validation}
\usage{
crossv_mc(data, n, test = 0.2, id = ".id")
crossv_kfold(data, k = 5, id = ".id")
crossv_loo(data, id = ".id")
}
\arguments{
\item{data}{A data frame}
\item{n}{Number of test-training pairs to generate (an integer).}
\item{test}{Proportion of observations that should be held out for testing
(a double).}
\item{id}{Name of variable that gives each model a unique integer id.}
\item{k}{Number of folds (an integer).}
}
\value{
A data frame with columns \code{test}, \code{train}, and \code{.id}.
\code{test} and \code{train} are list-columns containing \code{\link[=resample]{resample()}} objects.
The number of rows is \code{n} for \code{crossv_mc()}, \code{k} for \code{crossv_kfold()}
and \code{nrow(data)} for \code{crossv_loo()}.
}
\description{
\code{crossv_kfold} splits the data into \code{k} exclusive partitions,
and uses each partition for a test-training split. \code{crossv_mc}
generates \code{n} random partitions, holding out \code{test} of the
data for training. \code{crossv_loo} performs leave-one-out
cross-validation, i.e., \code{n = nrow(data)} training partitions containing
\code{n - 1} rows each.
}
\examples{
cv1 <- crossv_kfold(mtcars, 5)
cv1
library(purrr)
cv2 <- crossv_mc(mtcars, 100)
models <- map(cv2$train, ~ lm(mpg ~ wt, data = .))
errs <- map2_dbl(models, cv2$test, rmse)
hist(errs)
}
modelr/man/na.warn.Rd 0000644 0001762 0000144 00000001507 13623760455 014160 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/na-warn.R
\name{na.warn}
\alias{na.warn}
\title{Handle missing values with a warning}
\usage{
na.warn(object)
}
\arguments{
\item{object}{A data frame}
}
\description{
This NA handler ensures that those models that support the
\code{na.action} parameter do not silently drop missing values. It
wraps around \code{\link[stats:na.exclude]{stats::na.exclude()}} so that there is one
prediction/residual for input row. To apply it globally, run
\code{options(na.action = na.warn)}.
}
\examples{
df <- tibble::tibble(
x = 1:10,
y = c(5.1, 9.7, NA, 17.4, 21.2, 26.6, 27.9, NA, 36.3, 40.4)
)
# Default behaviour is to silently drop
m1 <- lm(y ~ x, data = df)
resid(m1)
# Use na.action = na.warn to warn
m2 <- lm(y ~ x, data = df, na.action = na.warn)
resid(m2)
}
modelr/man/heights.Rd 0000644 0001762 0000144 00000001662 13275046542 014246 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/data.R
\docType{data}
\name{heights}
\alias{heights}
\title{Height and income data.}
\format{\describe{
\item{income}{Yearly income. The top two percent of values were averaged
and that average was used to replace all values in the top range. }
\item{height}{Height, in feet}
\item{weight}{Weight, in pounds}
\item{age}{Age, in years, between 47 and 56.}
\item{marital}{Marital status}
\item{sex}{Sex}
\item{education}{Years of education}
\item{afqt}{Percentile score on Armed Forces Qualification Test.}
}}
\usage{
heights
}
\description{
You might have heard that taller people earn more. Is it true? You can
try and answer the question by exploring this dataset extracted from the
\href{https://www.nlsinfo.org}{National Longitudinal Study}, which is
sponsored by the U.S. Bureau of Labor Statistics.
}
\details{
This contains data as at 2012.
}
\keyword{datasets}
modelr/man/formulas.Rd 0000644 0001762 0000144 00000001646 13134626747 014452 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/formulas.R
\name{formulas}
\alias{formulas}
\alias{formulae}
\title{Create a list of formulas}
\usage{
formulas(.response, ...)
formulae(.response, ...)
}
\arguments{
\item{.response}{A one-sided formula used as the left-hand side of
all resulting formulas.}
\item{...}{List of formulas whose right-hand sides will be merged
to \code{.response}.}
}
\description{
\code{formulas()} creates a list of two-sided formulas by merging a
unique left-hand side to a list of right-hand sides.
}
\examples{
# Provide named arguments to create a named list of formulas:
models <- formulas(~lhs,
additive = ~var1 + var2,
interaction = ~var1 * var2
)
models$additive
# The formulas are created sequentially, so that you can refer to
# previously created formulas:
formulas(~lhs,
linear = ~var1 + var2,
hierarchical = add_predictors(linear, ~(1 | group))
)
}
modelr/man/figures/ 0000755 0001762 0000144 00000000000 13275106354 013761 5 ustar ligges users modelr/man/figures/logo.png 0000644 0001762 0000144 00000076034 13275106354 015441 0 ustar ligges users PNG
IHDR x b]e sRGB pHYs iTXtXML:com.adobe.xmp
Adobe ImageReady
1
).= @ IDATxܝ\U7 B Q"E@TPlJ
-@*H/lgϝY';3{9k] sL 1c=D~_}Yg%Ho71:ڵk4:-'%%+[
R7ר~7: baSNI*}- fX ȁh4j wr^xa.cPk ,VK ` ~`ND" Eb +}νIv ] M $A\?@)Q0}%d/- N'gO<둳~(3j1@c pPh̝QG/ ēWrH A6n諫suGyzO(Z||OcGII>Y[kutZrr$ض@X}P%Փ~iyyy~iiUVu!k8%?
/,Y⨓I?@ P.( wȁ *>G}Vk{m eڒA>q@ظ/Qkl{>/ 9"'m%4-0{;8)N߁Jrrk,P zzmplEř v#I3/b R^עm/Q+o`MfB]pal y(, |$Yph(bmm=PcC3*㬨
`E U 1Ү(
3, E MQdzP y7^|ō [E^Ĝ.d2 9
0}VWi=]ÎSCvч֭;u- R- n®V\n9iZmQ*`>駟Sw~ya|rN&J.Kr'%loִ[MUtfV567S_
6>h/x̊ʬz:{̲a 9
gw v8#dIPc1 Ғ |2@.)g }7L69~Ș|
` @Xw8!Grk"=9R7hM]X89grhh ̸YfEm@yk bJ8xK
,8v//jmgpr2#taqq_A][a+b ?&Fzx
2NfdmP`fewCC ';o.9P-')odC:>vwo4,Uji>48e${1 &$YR6PLkii{ͷ%˰600H
}+ZUĉ²0a¦ F\a1{a9̞˘oڊam0e"J:[ 2*r358Ss: fM-|YY蹇) .jpu YYzҜ+]!WϊK-77B!O K.Ky5]?r
Ncɪjg0#fOwwT{fƟSSCVSnvgy釭 ;@%C +QX<)ȣ5oޤv$IgĪ*Q[h f1 rV${(Mx{'g;l+U~ncPN
tIP(^WmEfcJg`hkVۗhF;4yw/v\k'|X mK3faLՃemN>D_s 'iWshՙ| ({/HX2A ?Zh?l\L4GLV6\ȭ0{Q
Xwo-^mXkrоj,1}Dݾ^@)~d`1xї
@W1>PDP)8:z= ^㸤*BhJX# v% 2SɶPD}а̎ Ŭ`~mghT뤊I B ި Jzz/J }
Dlm jg'gdlū h F wZY jM-VPB*VP 4Y q"]̹k6^R
Gu7 .*;8v 4vj|}`m(LSf(`t g)GXrYF̝,#5$%n`1
l1;밀 3#h?g
z,,@q
-YdXtЏaATu_o+Gy F'̗6c5riJӝ g5"(
>nGUDa v|p =
sw@.܋{ڭ`aΘDP:cO٢!r 4 &Fkc!I&\I :&7%Hd|%u->kuXX&;gkvE0bEyŖ^` ]N ;Ѳ,xq0d~
EGM[d|E8 =ó0tCm7(NgD}lwW6+!
ń~\ӧFQf`sODaҁZ @X0Տ{ae
ilLprsx5vD
[` O!Q<05ei=mVW`_@-W6Gl@zaK #!!s >3+εW^]GLY3N-d[ru5`M =PqV 1luvu_C t5,49غ/ ji~aA-N ]X29~pp w^hkM{{8;vّG Y P땒 V9;̞A(ErzrV;'$Rmed;Q $'P͚9G%~l5Z} _sh]$nyaKϳ s[;
ع}* `?tp0;hWG &ȶhX5"S |1Y'-Vg{4m va,B|&IItn \U<@\)Pk
`isbe X `GYιvDuv92{Q (繰v> %|wɀj ^aҠ@QHuv{|-
yVl2~ (SLP u mi 8z-$輰;0lbAd@܌iDž
fez*-kv.;>` >4~de
FY.Rݢ"_,s{JC ȉQEcΓs@oA>
nO.c~ntًb94_bOܽXMf&2^tdM#/AF/|pC|;Cv {pA
Q (LN,o7^e2~+
m 9( ;LP
EN"w#:W%,J +lXQ2Qka:,h5;mN E晬A=啃%3ۓJ;5/,// m+ӹ=
MxGmI6Qر&ν3{1^G ˃Pa!J2FpS FWVJV϶믌@6J?&} 6nfbP;e5ѥs2-҂}SUZ|ȇ-8*+mwe=< {$BV0A@G}+_;[d&Fn0AJOъ4e YRO! ý<ˆR G}U $}^kI2X
]nO]Z5v衇f|WCaq !g յ( & cMBzA&ItE(>+KA9VOM%ؐ": M ÌɶeKt&]G1!
\o,"*|u<\%t{3>|]s͗쥗^>2@
}a-MO vGw~7=vf NNA
Bz⭈ Bc灬AܡGM}lvd 3p(5YTJ`"=gş¿C>'!_"xGsBU?hci. k{a+hPh6t1P?SXO]&y.}PPE:'3P0¸,'?y~H0*`Aww)d[lUL~`.ul>`), Eʵ=KY G)f d G
畓L_iA7m~#xeqS츚r5_Zw&;6s]Y**`$<8]\^^ 2eʪ^z
E˞)M|v =2bݹ9x(G.Llm
]
V[؆sP4;cgF0h ob.jv-}1[a< B ;4_mh=h;ik`5M<'B& 2Rl{ pKnD:o4
/y
G,BclA̽ (iqHvCn5DH~ M}pGd-3<
s &.S|]XAMcA[0{X!VOi|*m*]$ǵ"X URVEZ`~
vi5KM`-=5Ygܵ[ VY5Z 289B3Dg]$[vżBIO ċs.Z' Ωϰٵ_hᛯtucE+TLU1a
?᳥[
d7,Zv[ISn1:T8 KQ$
+ǟy4ܞd؎-[v9e nxXrؓmש_eTQrvwAF<1=(^&T ԒɖC^ 1YmtUd4q **B]|$P YI$lj7gzt#OkXF?kpKkh(Rnݜ ݯ2^ЋbH
c9 ĈjaTYta5Y4
@FN,^Pzn1>"j]S@P9oZ+lAc&hUVvqn0 ԬEp} @L-ϵF^4AAKƵB& 1uxkh, b7_k ۊW!$ NO/A*ɧYZW r 'RH.<ug9P
QA +.c6U_
zdVזJX Nz>-ZT߯~ 6}D{XIa8ls#SlGmك58qi^{a.=$tЗħ[WfxL_{zqA:3]VtCsW> Æ&a A}yhG1ۉ"K u`Aad-XG8RSuܕYp}[7$cs\j 8e[HkmI f۴qQgE20)
J`CcYG
W<1GSƟNJ
q=_^-y)ֲl8 ӧrи쟂[lbxhT0 mV]isBիWL]-"ؑ \cOkVyY^[ |9=:"7Фk@:4wQtBQ*0wNS{L@U I9 r5M!o{T`MkPb< A6j V)Jfix232p(5'=g굈?X}d]ṽg;+.
*ܥR
|u_ұ3-if
TZ'
յUx+?w}E'1hđ`/7P&L 'v) eG*۹S1`! _<Z 3;Uc湵n{T<\@MC, w+ B
O D) $ʳDm}}D~CF 0$C ?0y4i) gYy8b̵o) !3MԸ5^y Ą%)(r=KѺa>%4|%K(|>+\"jSCyu!/˼\|0ҧ 0<3+/y= b| zK?gP&_j&]@pzpy!F+ ZX>M#}[d&Md+ (dmx
_ wzpIu`\q=0 JvQo w ~!VZZb7m!cǮ\ʎk5m 6h5 ..23$(u49!r#ϊTq Ŕf L+> j7Ф&Y<DMDCvLIx% MIƌ)M rѢ#Mڃɵ p
h- !IHu8*v@ 4Ot땾{,4 QDkn9luÝ} +F;)tdaڔ"{qu8ye I#
?KnRYN'+Q@Xycsj
ta f]TW\A%WxFp
"}vW %DkqN+DV\Uu,>eS5Hl_ >m߈ڞoW:p fZ=QxP ;,= `oy .F: RRyҒ':X'ۼe
s2 0lP +,, Z{-*J %yF~xƑI]6i$|_[6~vmƼc2*t" <.ÕH(7ڜR~ _ eB4Fܟ+u /رr/,k=ں?l)\kGovl
&\m*c@E
I&I<^̜"iDC"}Zz>H*`B!I= ]b.䀩Jo }_ Wf(Fq:]C
U `!Ddȩ%Y8324* _z[yA.9IhÎ A-S ? K˒mf
|
d Ur lSEdm: E ug}۷X$G= o}YϜ:2 oXi'd*&rSL.7 G9Ŵ 7 6BjbD23f 5Q~7{ >3Cv̔ULp#HOw>|^lznrdJhO= 9` ٙ99YiABxś<[5+)- Mlٴ? s+H~,f;A Q/ }Y`m)a7Y,\ ¾q4-v}; CI:X5E]='bM;,;-#rl#Z#oᩎ'{ K+AV, Aw4p?e%ttl˺j)pju'>FM ғ,U@ L AICPl ۶, P"R7P^3= 7d)=C?`+ 7xsEU;W926 :-^|
Ʈk$ jiXsKz;9+xKж0q03-|wiΖ,y7qÍ@XI;V2}wGdֿtvq|e\oi+ K,H _Hnu]*b-6$6 huR?mcsF%-̰1G86d AۊoA{d Fc|->:qOM-cRx[H9Q&DNβ<(H +2}~eFP23&[ExFTUkN#:;ɮ$)Fr5g 曗e6Ժ:E{SS[C`#-- 5q.j8 = >('-&e4J['}kP澵
oĀܡ(@eS58vTRcVQQU
Cg6gK{p bjB=ljU `uRd>Q^vKg@]v'inL@['Ãduss OOKG.\;o ^
e @TţV>!r *jI5&l)6ur*CPO. ٔ)ɬ@=i[MѶ=^\_տ|^s(C|:"f]@
D\rݶs
nKmN?̛3:6PrZ S6W Ħ5,Ň5
Ŕw+NQd/|P Dk ]Z1櫦k] O s 1N1z~ ꉢ~%
R0o1bbo.5264c` A l"AWXdaqhiq ttGܵ*"y{|-`EH<KHM6 뚾^ٶn]ޒH,̈= lE ϔ/ևb"?T_
i$ Kj`砣 Dv3(Es
a*l{,kk$*)wMfBԌP~{pUUS*%ot3L$]E`p9 \9ܕ*ҪSf-.>?>,̀ f@ Y`?\n|f/!A+n e4 }o v"$g+®t [Hy&yzŚR\j&
lq 8G D OX >8 0+ǻm2_ qv:NJww?O!k;֛N8 V;:ر
G&MpDCR yI w1t_%'"0jA 9w,~jukMf%%*y" +E*9㕘͞sSCZn ;u
wphR4MEC糄Or>, Jb߄piӀ E%)S?af)uN>zdÇ kYgZ^3Pl3l X
cB Jg>|N*3?u=(: Ӎcv >(NS4?_+6l+;dY3 %JNPzDiw?E(tW7wSC*lU(y~=2ެ{Nr]e J&ٹo+( =XE*6.vT0Hd:f w8A{x9}{wQp32Ǫ?nu(;D~Ϙ>Dκ iTr|#N>i_1JNxذ L @Ynᇖ[C ' ~>a,#_hhҡ&g3rş&DC@~97z{G'tk v@I?y㍷,6ð_ Z3fNXt)+.]40R`ڰgU _)tn8Tov4sdqIRNI"G^T <;+Wl RjOѽ35AN~BPfF" ,⺐J\ /d@Y(fELnoa!4Nn&:ɇkX ˒EK^Th'^b g3XdKrpP4 ͱ/w>G)8i9ulZi\| t~TKg#Eh_jCLuh k^p vK6
[ L`]j>D~jAHLHYP;h'a#٥l"$(cQǜg8ܶ40;Pkd
Xl% 8r2-d*6hB^8U$ACxТSq} QpܹQTNvm2ԭH͜dCglMyGBkmݘz?ƣfOz登\֮{"v-}iw Qu y3mjHp
Jlih1fD?yev`le혧l
EDѽ(LB,civ%B).]᜶-kjTꨑߊ(7iBM?E^q"Ut
˘P3;㍜
3FT^ `_D!&
Bb?KebgG<<̵s`_hmoXuأd WzO۬Y3웋FwM8
X6?+vЦ~5Qe(A=y>m>߿ />dz} `]g2t-ݡ<_9%{u֒J6c%} :@4/JV()N2D@'] 9i*g l2c[Pobε WP=bW8gQ=ل;Ų~_S
?S^h k"\ozv?L%;T/暁k_u6`L1olR'?Oxg4M]b_eKiE))s/n)^ S'QJijN#@> /@]vIo
ah
%k醊 (q~g `Ճ(wߋ5MYRVFY-& gO%Iϑ'~ԔrإSUg?s&pۓO-Ou{%ȹ$Rp Wl оTQa nMZWq0/goFɯ:jDlS@+< yߐJ ^L<{7ˉ.NZ E`({8KXke;G:kj ;Gξ3P6|'Dw /i!y"s 6,Nĺ cTV %']go͛U>ȸdc4,:&^G" >+l yaZ z1V!>lA>ϾO *82}8{zEFyA fbGbkV[d2 MEkSC22rLĹ %ra7K'P&
tvw+IS ߙ iR8cdsZ/%$Q<} }a3Vˤ= ɦ BKvƍ?li! mC@Mys{sYϭ/V\躐[ʤI:H_2 kI^,&7vVp؞ȓ`7mZ|6 c.;nO_v]p%v kaSgLI%v\꼶`6n-y\"i yCܐun_^=A9^Lj Mڎc{{(}!'8Dti5#X{کo]y&&G֍~
3}gt?p-} |%qL@U.EY ַ 0
y Sij66jhi^Y|"CkY'|ͿegcO. iLC 9IDATD0mBKFk ~el*SKDYRbRn_iIڍx|V
!H"j+_}=ΪAKh =/T䐖sMEٴEkARXj{0o
|nX:6nک0) q ;rYHN[a1FV^W.pvdIaKgrr@4ѢXE.;)k|i; tM9 >اR㗞ߪ+dJ ݭ Ղ, !
뻖W05)a=dp(?t5Dɰ<zטF:ذaZ -+@T8/O`-KH# whM HbP;=vfW4QGQ'fnӪL:1[Ŭ* a'*Ilc)2IML?)8CPj-@B9cƔW! 9t^ `L|&IW=*IPP3!xsB4UJZvm;{
ݦ*1[Ɛ"{\
K=8rYη,hU!UJ2Y00=Fj
wA)@%zO. xske!EVw"MD s$vo#$ }I*_o?
Oa\U1ժ(A&w,i4/(F fub#Ct9 $
`) [ڼBZ/
"1VZXΉMBc'| ez&c۴٪%$5Ȫ ?ulgE[.*M-Kl n+֎p KW)ī2JHfʻ dݭ=~rvN[̽C9 nû;5LMWM !C@fI,g~ <īgzaV$w'PVK$#kźȲ1|-Ung.:gHAb/L8C=j?g K R4[oTwẆN}泟0BX7̓nbZ~=6?`' ZjՕm)>_nu)}Ȗj[iZju`3%ZcH+Ad0?gZ$^[~?D:9M\/w] `,rtZ%g`g+8\ 7'RWjÐz%
]h^j'.=CG- ĀM W[dʑ.k]aݡ?EMcؕW^[Ub.)M^ ?@'EESS^"CTsNt Ù쒃] UuBy =D5DaW!kE)TBHPJn@L\Y {,,(+:$5ϴnH΄+`n%٪Չ/{GUnSa].d?@'uǕ`N9)~[ɮ2sV=)\d~bV#,HO~L3G{[̦WV ͼhͭS*ܯt 9 h,G';RKSyKǒ&fD^~ib$Wwuuɒlݚ7>ֶJb 2:Y~A0ʦ熜YExTKDAβu&`D",lJ?CZyk2ܛt%`:Q4(>-ⶢOOju~$D%vևr= %P5|KNF<]p¥-LNyϤH&H.wuzN2_jѧ4IѝaMlzaۼmV)R ՙ " ݏ`.b {aS:(m e P7ݶ>r#+SN>5a_H2YNvXo6l1Dga!(, ݭnI(B)d u' &}q t,8&>Vjg' G | %+p#]0m v1)nQZ Psd`6sg$Ӂ )c;%7Ȅ4rɍQƟAUȚ% ` 5m3,|m^]TkzwY=1IsVlKSA( h{N˛$wL~~+EU(d}8md8,}e]o
gb'S#yc//]|.4lvUWZh}4ʜ >辇m ~a+%u#%7=3YgM%_V ` f)/s Gqa/UNj\tZBF,s6$B
>
jVn0_nX: &m8 L#|,mPRNe\p9 mwvK 9^vÍ6"⸘i@û=Jy<_ÍG:$~"a-ĦC&ї8/ g͈{[a? ~`z-߰2lFH?+DTW $5(TXSD"-Pg,!D04cհ
!AjE${0w4 T+Sdcٟܖ-] Hd֬35u;ْY몬$ qQNe@2sp j]w>4^do '\),O>v=̮tنqYODIvugn1.7많c ȫmhZ/SMhpY=KSrP:MCDvXS[bVVHXiz\ bD|lO@ʼn*`|x
1NzM vN0$$GYm -w߱hx?O9J7
T39̻yCLV˸I>(bNu5?zNKklwl6e&_^1! ήT-eoƽWjOȑ` UB% iz^H*.LD!<hd?,2 ev
(9{d:__Yx7ܧX2fp {@h*[Ss1>ǻ>& }@4܉y1 YCWh'j _8=uL!M
;HiVؼ2LX㮪
In+C5[لE&ل
&2$Pf2n!%5 `SCuvx/Z]n2Q<#Y"_;{`lPCB4?=_%q#Y~K;˲lH8 <
/7[5AqG\&.2^ Ґ>ĝ? `ڞ_]bGoҧE &F{κ[-i!6T2gIBgiQ0ϡX= sDi&( sg}]{ P/uk~'aU}e :lȾvG@կ~` |w hW\iDǡ&$
qsz:04WqCҖv~7]^M߾ 6?Մ$Q]w$5w Aoo+ϟ"+7уwx `UwYK9
[7RwdIev}|&g~s#eOxEm4k
'(
{GJ _A"L ֮f C^ p |!\3,qR F ȗIW=8}(%TB
@<Rܹ^Q%U
r9tc&;䐃\T7/dBlظ̼6Tr N|OeuY)ܨq NEI|߫ORE ʎ'{C^Сs+/i麜9pS皝W
T>쿮ȣ d'N@ۇ9/?TյhYyy9n,#rrv1G'5ԷcSpߧL'}@EQE>{j"sB~}ҊI &֓GԈK.p>nmFieWj#)f{IA!ģ(,uď3|
od9v [( G3yܱ :O mM;ԫlT|rvܱw@; o~:_裏zb}
v2ZOKDzǩs˝-IG a;Xײ fSw ֬% b JgpFQ5%RJWfv}d V̱~v`? ݩ@j5,o<{wLug,:QWHa4
z_`4pu`EuP;|Ffpn4!z}w[*-1 mSt {X٥@'aFDTI;x1gIun;ԙc
n 2{1u#%? bU=o~>tlO>T\ /I3c´?cڥQjJZ,_G:,$ąV̈7 ]7=Mc=:mk[]؎: k790 3F
0_Eox߇(< =C 80F:3»'e:nưڣJR$J8TV$ 6HXuۦ Č
XׄmbĽO 55&q~
E8LCXJ Tm]
U3w,e'q^q^3ICɍo9e~E46wQLjd 'e_!w@~(s2 =x7` j{cX 1ny!t 9ql Gcq3: ̆"]XP+
N,MFǖ&ɒGy͍Y}Ł&3Osm`]K 3!R)ܶܦd S/9pKWk-nmݮ@iJ y4+ǫn'^ӸLdz1t7v^RRVmyS
BRo3)h2=*XIgJ6/u rhuiSr[)}@H$l+p]iɄ: q#2 їm {*C1̶gn.Q8m纂cGR>e'_hʒ,d()p9ݮ.# =vd?E)f±I;zRl/|VVXN^8e. \v[trQ`M3á=?
rΔL
O? ITu_dx櫊K cuwa!"6u8ÝҹXhxгBxbɨ @.~ jĎrXI#kygF!=>Cg%~Qfr&VQl6Zj pjɺ3B7%ӁZ2mc6(=u /N%ksuC*']9$܋КvoЈZY*2D'Woyab%ab6ƥ{; VW o×z/.9m4RQ|5TSWp
5"%
Id4Wͩ .H#@58V
f,B0r5jnppbdXXmXp "x
PY זEp80x'LtV%$:]ӜZLt p MF1c%єg.#Q=# :jq<;S)dS Cit TK@1\5|3%UrOԯǍ If[9s#bls/ 駐/Z2
k =H,=L7cքh9L6ޖЖ06' ֮]#ƿOr4 \ +Ac^>|!;Sws| ,㏳p,^3KÜSJ"o:
>tx{|-+ϘYf)<{B&zyr<# z9YIʗTr tnʟ/;q\UopjZժbCT Rk8|
L94JTĮ
SZ0D=#7i0P>I0qa3}:oiאo'̓O l2/=!^70uUۓq]̫*({`?
S<y>sJj@4js$ < $Za=~
2b3 1ݐݝH r XRUHlo!>sL?eg!JvLtÂG.R-,7/1V8'ҧ1synmE6:'"ƤR{ V6y Z5Җ W=gu^Y=>*"dK8 ,|2? hyIp፸K-4z4FHG#͞a 6N+ܕQYP6 p`iΡΐy͒0PL
ߧA]D!Q2$d9|$:[*qAC+G6 /en ڇ R؉u={pu WHEt Ϡ6ըm}̋ӂO gl[
ؤ| %KxG^*qN_3}I>ZFpMժM`~%:&B m&r: ]S>j:F&O~B 6 (82qjǹ*Ɣ8 Xw!;~m|@]-m2-t=ʩg_ %Hl:tg۲IX5l L˙y (z v9&
w.i+T*qV'<l}4{.iZ%@&T A2h6 &.2-aL /\ E\P&T<$腧
m ; P Lb'E1&[%+V w~yx`pjM̋tIڣj7
zyǍkQ6lK]GT"F(V~f2fm, 9=wß[5{DX
hf߄wu J~Qdb%\ypG+Ȫ]Z0l8 RQ,iƘ!
$ZCEaAe1"+< s {#?JԞ?IRX 9YUN/m^ ۏ_-Z[-ZT 6Fg?P%Cvh7IJVpu4M[bH 7Dd2U Գ
J0Vj`s&M>6vB
M)MgsedzkjX߅4\g6R)/4:4/3IW~~y 2_ǭңTaY]8> _V1?nfϦٳ kt$zZpc:P]Tɬ 2Mp
9virEW+NojmڶFb(8 ۉ>ps+;=a{0@el n^|sK1T/xU^. K @"l_E?
OQd`%ۦV4oV-5Ik&ѡ½3`+[-{py+ U?B5D#$i
k`mi:1faEoR~FHk1v X_)ռs7 3_ܰa3/rq+/+VgyN$ϒp~]
*:M~sժR_N"]l1eK̙lg]DJa:XGf[5d*gAYc~\ ,8+ ۛ 6GQ
&Zl>*{r{X袋f00a 8%}ɶ|XWX=;o˟]S8Zh=͵!I ك3!, orq8ܳYd 3i{z >C P $]{ˀ;}?K!@ɟu{ޞܑbc0I39ŗ.YOwxtJJC`ý7ю>k{|U=' l7 J ^4qN-M7 9 V&ƻ 8NƞYY>>1ɔ$k,|GoTI
tF=3 >
$fOLtU|tvb g ?G :š! 1&[JP̋Y}}S?9 ')b-'k$dm\.}9$,hZٳ/ٍBYN,&xL ݻ;ganx>?;tf%J͋ k~kx;덍U{hCtcJw2"0x aĭ #XbJ̞$76=*B,Q1𫢢 ͮ&Q4/JsO ZH)sJp W|y%@,X77͞9YJ}-ˉ3.
A8=<5< 2/ ?X &) -\
, ''Z,
hWzOyц pv P y ^jU6 ^:a#~d1/ /Zϟ
1 N13yq5/ղ͛7g^ϟO
qG
D :.,SeK̗ȴs|q+B_# XxX %_y $'}? h IENDB` modelr/man/sim.Rd 0000644 0001762 0000144 00000000723 13134626747 013405 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/data.R
\docType{data}
\name{sim}
\alias{sim}
\alias{sim1}
\alias{sim2}
\alias{sim3}
\alias{sim4}
\title{Simple simulated datasets}
\format{An object of class \code{tbl_df} (inherits from \code{tbl}, \code{data.frame}) with 30 rows and 2 columns.}
\usage{
sim1
sim2
sim3
sim4
}
\description{
These simple simulated datasets are useful for teaching modelling
basics.
}
\keyword{datasets}
modelr/man/pipe.Rd 0000644 0001762 0000144 00000000320 13134626747 013543 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils.R
\name{\%>\%}
\alias{\%>\%}
\title{Pipe operator}
\usage{
lhs \%>\% rhs
}
\description{
Pipe operator
}
\keyword{internal}
modelr/man/fit_with.Rd 0000644 0001762 0000144 00000002660 13523022714 014416 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/formulas.R
\name{fit_with}
\alias{fit_with}
\title{Fit a list of formulas}
\usage{
fit_with(data, .f, .formulas, ...)
}
\arguments{
\item{data}{A dataset used to fit the models.}
\item{.f}{A fitting function such as \code{\link[stats:lm]{stats::lm()}},
\code{\link[lme4:lmer]{lme4::lmer()}} or \code{\link[rstanarm:stan_glmer]{rstanarm::stan_glmer()}}.}
\item{.formulas}{A list of formulas specifying a model.}
\item{...}{Additional arguments passed on to \code{.f}}
}
\description{
\code{fit_with()} is a pipe-friendly tool that applies a list of
formulas to a fitting function such as \code{\link[stats:lm]{stats::lm()}}.
The list of formulas is typically created with \code{\link[=formulas]{formulas()}}.
}
\details{
Assumes that \code{.f} takes the formula either as first argument
or as second argument if the first argument is \code{data}. Most
fitting functions should fit these requirements.
}
\examples{
# fit_with() is typically used with formulas().
disp_fits <- mtcars \%>\% fit_with(lm, formulas(~disp,
additive = ~drat + cyl,
interaction = ~drat * cyl,
full = add_predictors(interaction, ~am, ~vs)
))
# The list of fitted models is named after the names of the list of
# formulas:
disp_fits$full
# Additional arguments are passed on to .f
mtcars \%>\% fit_with(glm, list(am ~ disp), family = binomial)
}
\seealso{
\code{\link[=formulas]{formulas()}}
}
modelr/man/data_grid.Rd 0000644 0001762 0000144 00000002227 13473322117 014522 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/data-grid.R
\name{data_grid}
\alias{data_grid}
\title{Generate a data grid.}
\usage{
data_grid(data, ..., .model = NULL)
}
\arguments{
\item{data}{A data frame}
\item{...}{Variables passed on to \code{\link[tidyr:expand]{tidyr::expand()}}}
\item{.model}{A model. If supplied, any predictors needed for the model
not present in \code{...} will be filled in with "\link{typical}" values.}
}
\description{
To visualise a model, it is very useful to be able to generate an
evenly spaced grid of points from the data. \code{data_grid} helps you
do this by wrapping around \code{\link[tidyr:expand]{tidyr::expand()}}.
}
\examples{
data_grid(mtcars, vs, am)
# For continuous variables, seq_range is useful
data_grid(mtcars, mpg = mpg)
data_grid(mtcars, mpg = seq_range(mpg, 10))
# If you supply a model, missing predictors will be filled in with
# typical values
mod <- lm(mpg ~ wt + cyl + vs, data = mtcars)
data_grid(mtcars, .model = mod)
data_grid(mtcars, cyl = seq_range(cyl, 9), .model = mod)
}
\seealso{
\code{\link[=seq_range]{seq_range()}} for generating ranges from continuous
variables.
}
modelr/man/seq_range.Rd 0000644 0001762 0000144 00000002624 13623760332 014553 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/seq_range.R
\name{seq_range}
\alias{seq_range}
\title{Generate a sequence over the range of a vector}
\usage{
seq_range(x, n, by, trim = NULL, expand = NULL, pretty = FALSE)
}
\arguments{
\item{x}{A numeric vector}
\item{n, by}{Specify the output sequence either by supplying the
length of the sequence with \code{n}, or the spacing between value
with \code{by}. Specifying both is an error.
I recommend that you name these arguments in order to make it clear to
the reader.}
\item{trim}{Optionally, trim values off the tails.
\code{trim / 2 * length(x)} values are removed from each tail.}
\item{expand}{Optionally, expand the range by \verb{expand * (1 + range(x)}
(computed after trimming).}
\item{pretty}{If \code{TRUE}, will generate a pretty sequence. If \code{n}
is supplied, this will use \code{\link[=pretty]{pretty()}} instead of
\code{\link[=seq]{seq()}}. If \code{by} is supplied, it will round the first
value to a multiple of \code{by}.}
}
\description{
Generate a sequence over the range of a vector
}
\examples{
x <- rcauchy(100)
seq_range(x, n = 10)
seq_range(x, n = 10, trim = 0.1)
seq_range(x, by = 1, trim = 0.1)
# Make pretty sequences
y <- runif(100)
seq_range(y, n = 10)
seq_range(y, n = 10, pretty = TRUE)
seq_range(y, n = 10, expand = 0.5, pretty = TRUE)
seq_range(y, by = 0.1)
seq_range(y, by = 0.1, pretty = TRUE)
}
modelr/man/resample.Rd 0000644 0001762 0000144 00000002274 13623760427 014425 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/resample.R
\name{resample}
\alias{resample}
\title{A "lazy" resample.}
\usage{
resample(data, idx)
}
\arguments{
\item{data}{The data frame}
\item{idx}{A vector of integer indexes indicating which rows have
been selected. These values should lie between 1 and \code{nrow(data)}
but they are not checked by this function in the interests of performance.}
}
\description{
Often you will resample a dataset hundreds or thousands of times. Storing
the complete resample each time would be very inefficient so this class
instead stores a "pointer" to the original dataset, and a vector of row
indexes. To turn this into a regular data frame, call \code{as.data.frame},
to extract the indices, use \code{as.integer}.
}
\examples{
resample(mtcars, 1:10)
b <- resample_bootstrap(mtcars)
b
as.integer(b)
as.data.frame(b)
# Many modelling functions will do the coercion for you, so you can
# use a resample object directly in the data argument
lm(mpg ~ wt, data = b)
}
\seealso{
Other resampling techniques:
\code{\link{bootstrap}()},
\code{\link{resample_bootstrap}()},
\code{\link{resample_partition}()}
}
\concept{resampling techniques}
modelr/man/typical.Rd 0000644 0001762 0000144 00000001623 13275046524 014255 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/typical.R
\name{typical}
\alias{typical}
\title{Find the typical value}
\usage{
typical(x, ...)
}
\arguments{
\item{x}{A vector}
\item{...}{Arguments used by methods}
}
\description{
For numeric, integer, and ordered factor vectors, it returns the median.
For factors, characters, and logical vectors, it returns the most
frequent value. If multiple values are tied for most frequent, it returns
them all. \code{NA} missing values are always silently dropped.
}
\examples{
# median of numeric vector
typical(rpois(100, lambda = 10))
# most frequent value of character or factor
x <- sample(c("a", "b", "c"), 100, prob = c(0.6, 0.2, 0.2), replace = TRUE)
typical(x)
typical(factor(x))
# if tied, returns them all
x <- c("a", "a", "b", "b", "c")
typical(x)
# median of an ordered factor
typical(ordered(c("a", "a", "b", "c", "d")))
}
modelr/man/modelr-package.Rd 0000644 0001762 0000144 00000001461 13623760332 015460 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/modelr.R
\docType{package}
\name{modelr-package}
\alias{modelr}
\alias{modelr-package}
\title{modelr: Modelling Functions that Work with the Pipe}
\description{
\if{html}{\figure{logo.png}{options: align='right' alt='logo' width='120'}}
Functions for modelling that help you seamlessly
integrate modelling into a pipeline of data manipulation and
visualisation.
}
\seealso{
Useful links:
\itemize{
\item \url{https://modelr.tidyverse.org}
\item \url{https://github.com/tidyverse/modelr}
\item Report bugs at \url{https://github.com/tidyverse/modelr/issues}
}
}
\author{
\strong{Maintainer}: Hadley Wickham \email{hadley@rstudio.com}
Other contributors:
\itemize{
\item RStudio [copyright holder]
}
}
\keyword{internal}
modelr/DESCRIPTION 0000644 0001762 0000144 00000002013 13624321012 013230 0 ustar ligges users Package: modelr
Title: Modelling Functions that Work with the Pipe
Version: 0.1.6
Authors@R:
c(person(given = "Hadley",
family = "Wickham",
role = c("aut", "cre"),
email = "hadley@rstudio.com"),
person(given = "RStudio",
role = "cph"))
Description: Functions for modelling that help you seamlessly
integrate modelling into a pipeline of data manipulation and
visualisation.
License: GPL-3
URL: https://modelr.tidyverse.org, https://github.com/tidyverse/modelr
BugReports: https://github.com/tidyverse/modelr/issues
Depends: R (>= 3.2)
Imports: broom, dplyr, magrittr, purrr (>= 0.2.2), rlang (>= 0.2.0),
tibble, tidyr (>= 0.8.0), tidyselect
Suggests: compiler, covr, ggplot2, testthat
Encoding: UTF-8
LazyData: true
RoxygenNote: 7.0.2
NeedsCompilation: no
Packaged: 2020-02-22 20:38:43 UTC; hadley
Author: Hadley Wickham [aut, cre],
RStudio [cph]
Maintainer: Hadley Wickham
Repository: CRAN
Date/Publication: 2020-02-22 21:50:02 UTC
modelr/tests/ 0000755 0001762 0000144 00000000000 12727615525 012712 5 ustar ligges users modelr/tests/testthat/ 0000755 0001762 0000144 00000000000 13624321012 014530 5 ustar ligges users modelr/tests/testthat/test-predictions.R 0000644 0001762 0000144 00000001471 13623760751 020176 0 ustar ligges users context("predictions")
test_that("always uses na.action = na.exclude", {
df <- tibble::tibble(x = c(1, 2, NA), y = c(1.5, 2, 3.5))
mod <- lm(y ~ x, data = df)
out <- add_predictions(df, mod)
expect_equal(2 * 2, 4)
})
test_that("*_predictions() return expected shapes", {
df <- tibble::tibble(x = 1:5, y = c(1, 4, 3, 2, 5))
mod <- lm(y ~ x, data = df)
out <- add_predictions(df, mod)
expect_s3_class(out, "tbl_df")
expect_named(out, c("x", "y", "pred"))
out <- spread_predictions(df, m1 = mod, m2 = mod)
expect_s3_class(out, "tbl_df")
expect_named(out, c("x", "y", "m1", "m2"))
expect_equal(nrow(out), nrow(df))
out <- gather_predictions(df, m1 = mod, m2 = mod)
expect_s3_class(out, "tbl_df")
expect_named(out, c("model", "x", "y", "pred"))
expect_equal(nrow(out), nrow(df) * 2)
})
modelr/tests/testthat/test-data-grid.R 0000644 0001762 0000144 00000000773 13432533345 017506 0 ustar ligges users context("test-data-grid.R")
test_that("can generate typical values", {
df <- tibble::tibble(
x = rep(c("a", "b"), each = 5),
y = rep(c("a", "b"), 5),
z = rnorm(10)
)
mod <- lm(z ~ x + y, data = df)
out <- data_grid(df, .model = mod)
expect_equal(out$x, c("a", "a", "b", "b"))
expect_equal(out$y, c("a", "b", "a", "b"))
})
test_that("data_grid() returns a tibble", {
mod <- lm(mpg ~ wt, data = mtcars)
out <- data_grid(mtcars, .model = mod)
expect_s3_class(out, "tbl_df")
})
modelr/tests/testthat/test-model-matrix.R 0000644 0001762 0000144 00000000240 13432533345 020241 0 ustar ligges users context("model-matrix")
test_that("model_matrix() returns a tibble", {
out <- model_matrix(iris, Sepal.Length ~ Species)
expect_s3_class(out, "tbl_df")
})
modelr/tests/testthat/test-residuals.R 0000644 0001762 0000144 00000001155 13432533345 017640 0 ustar ligges users context("residuals")
test_that("*_residuals() return expected shapes", {
df <- tibble::tibble(x = 1:5, y = c(1, 4, 3, 2, 5))
m1 <- lm(y ~ x, data = df)
m2 <- lm(y ~ poly(x, 2), data = df)
out <- spread_residuals(df, m1, m2)
expect_s3_class(out, "tbl_df")
expect_named(out, c("x", "y", "m1", "m2"))
expect_equal(nrow(out), nrow(df))
out <- gather_residuals(df, m1, m2)
expect_s3_class(out, "tbl_df")
expect_named(out, c("model", "x", "y", "resid"))
expect_equal(nrow(out), nrow(df) * 2)
out <- add_residuals(df, m1)
expect_s3_class(out, "tbl_df")
expect_named(out, c("x", "y", "resid"))
})
modelr/tests/testthat/test-cross-validate.R 0000644 0001762 0000144 00000001376 13432533345 020572 0 ustar ligges users context("test-cross-validate")
test_that("number of crossfolds is a single integer", {
expect_error(crossv_kfold(mtcars, k = "0"), "single integer")
expect_error(crossv_kfold(mtcars, k = c(1, 2)), "single integer")
})
test_that("% of observations held out for testing is between 0 and 1", {
expect_error(crossv_mc(mtcars, n = 100, test = 2), "value between")
})
test_that("number of training pairs to generate is a single integer", {
expect_error(crossv_mc(mtcars, n = c(1,2)), "single integer")
expect_error(crossv_mc(mtcars, n = "0"), "single integer")
})
test_that("crossv_kfold() and crossv_mc() return tibbles", {
out <- crossv_kfold(mtcars, 5)
expect_s3_class(out, "tbl_df")
out <- crossv_mc(mtcars, 5)
expect_s3_class(out, "tbl_df")
})
modelr/tests/testthat/test-na-warn.R 0000644 0001762 0000144 00000000424 13432533345 017206 0 ustar ligges users context("test-na-warn")
test_that("na.warn warns when dropping", {
df <- data.frame(x = 1:5, y = c(1, NA, 3, NA, 5))
expect_warning(mod <- lm(y ~ x, data = df, na.action = na.warn), "Dropping 2")
pred <- unname(predict(mod))
expect_equal(is.na(pred), is.na(df$y))
})
modelr/tests/testthat/test-response_var.R 0000644 0001762 0000144 00000000474 12730547514 020361 0 ustar ligges users context("response_var")
test_that("can extract response from linear model", {
mod <- lm(mpg ~ wt, data = mtcars)
expect_identical(response_var(mod), quote(mpg))
})
test_that("can extract response from loess model", {
mod <- loess(mpg ~ wt, data = mtcars)
expect_identical(response_var(mod), quote(mpg))
})
modelr/tests/testthat/test-geom-ref-line.R 0000644 0001762 0000144 00000000212 13432533345 020264 0 ustar ligges users context("geom-ref-line")
test_that("at least one ref line position argument is supplied", {
expect_error(geom_ref_line(), "one of")
})
modelr/tests/testthat/test-seq-range.R 0000644 0001762 0000144 00000000676 13432533345 017536 0 ustar ligges users context("seq-range")
test_that("seq_range() can generate error messages and typical values", {
x <- 1:4
expect_error(
seq_range(x, by = 0.1, n = 10, expand = 0.5, pretty = TRUE),
"one of"
)
expect_equal(seq_range(x, n = 4), c(1, 2, 3, 4))
out <- seq_range(x, n = 3, expand = 0.5, pretty = TRUE)
expect_equal(out, c(0, 2, 4, 6))
out <- seq_range(x, by = 150, expand = 0.5, pretty = TRUE)
expect_equal(out, c(0, 150))
})
modelr/tests/testthat/test-resample-partition.R 0000644 0001762 0000144 00000001162 13432533345 021462 0 ustar ligges users context("resample-partition")
test_that("resample_partition() generates error messages & warnings", {
expect_error(
resample_partition(mtcars, c(test = "0.8", train = 0.7)),
"numeric vector"
)
expect_error(
resample_partition(mtcars, c(train = 0.7)),
"numeric vector"
)
expect_error(
resample_partition(mtcars, c(0.3, 0.7)),
"numeric vector"
)
expect_message(
resample_partition(mtcars, c(test = 0.8, train = 0.7)),
"sum to"
)
})
test_that("resample_partition() returns a list", {
out <- resample_partition(mtcars, c(test = 0.3, train = 0.7))
expect_true(is.list(out))
})
modelr/tests/testthat/test-typical.R 0000644 0001762 0000144 00000002612 13424144743 017312 0 ustar ligges users context("typical")
test_that("typical.numeric works as expected", {
x <- c(1, 2, 5)
expect_equal(typical(x), median(x))
expect_equal(typical(c(x, NA)), median(x))
})
test_that("typical.character works as exepected", {
expect_equal(typical(c("a", "a", "b")), "a")
expect_equal(typical(c("a", "a", "b", "b", NA_character_)), c("a", "b"))
expect_equal(typical(c("a", "a", "b", "b")), c("a", "b"))
})
test_that("NA values are considered typical", {
x <- c(NA, NA, NA, "x")
expect_equal(typical(x), NA_character_)
f <- factor(x, exclude = NULL)
expect_equal(typical(f), NA_character_)
})
test_that("typical.factor works as exepected", {
expect_equal(typical(factor(c("a", "a", "b"))), "a")
expect_equal(typical(factor(c("a", "a", "b", NA))), "a")
expect_equal(typical(factor(c("a", "a", "b", "b"))), c("a", "b"))
})
test_that("typical.logical works as exepected", {
expect_equal(typical(c(TRUE, FALSE, TRUE)), TRUE)
expect_equal(typical(c(TRUE, TRUE, FALSE, FALSE)), TRUE)
expect_equal(typical(c(TRUE, FALSE, TRUE, NA)), TRUE)
})
test_that("typical.ordered works as expected", {
expect_identical(typical(ordered(c("d", "d", "a", "b"))), "b")
expect_identical(typical(ordered(c("d", "d", "a", "b", NA))), "b")
})
test_that("typical.integer works as expected", {
expect_identical(typical(c(1L, 2L, 3L, 8L)), 2L)
expect_identical(typical(c(1L, 2L, 3L, 8L, NA_integer_)), 2L)
})
modelr/tests/testthat/test-formulas.R 0000644 0001762 0000144 00000003364 13275066444 017507 0 ustar ligges users
context("formulas")
test_that("add_predictors() combines predictors", {
expect_identical(add_predictors(~1, ~2, ~3), ~1 + 2 + 3)
})
test_that("add_predictors() combines with fun", {
expect_identical(add_predictors(~1, ~2, ~3, fun = "*"), ~1 * 2 * 3)
})
test_that("add_predictors() handles lhss", {
expect_identical(add_predictors(lhs ~ 1, ~2), lhs ~ 1 + 2)
expect_identical(add_predictors(lhs1 ~ 1, lhs2 ~ 2), lhs1 ~ 1 + 2)
})
test_that("merge_formula() handles lhss", {
expect_identical(merge_formulas(lhs ~ rhs, lhs ~ rhs), lhs ~ rhs + rhs)
expect_error(merge_formulas(lhs ~ rhs, other_lhs ~ rhs), "must be identical")
})
test_that("merging formulas fail when scope conflicts within symbols", {
env <- new.env(parent = emptyenv())
env$object <- list()
object <- list()
f_conflict <- new_formula(NULL, quote(object), env = env)
expect_error(merge_envs(~object, f_conflict), "conflict for the symbol 'object'")
})
test_that("merging formulas fail when scope conflicts between symbols", {
env1 <- new.env(parent = emptyenv())
env1$object <- list()
env2 <- new.env(parent = emptyenv())
env2$other_object <- list()
f1 <- new_formula(NULL, quote(list(object)), env = env1)
f2 <- new_formula(NULL, quote(list(other_object)), env = env2)
expect_error(merge_envs(f1, f2), "conflict across symbols")
})
test_that("formulas() fails when supplied non-formula objects", {
expect_error(formulas(~lhs, NULL), "must contain only formulas")
})
test_that("formulas() combines the lhs", {
expect_equal(formulas(~lhs, a = ~1, b = other ~ 2), list(a = lhs ~ 1, b = lhs ~ 2))
})
test_that("bytecoded fit_with() works", {
bc_fit_with <- compiler::cmpfun(fit_with)
fit <- bc_fit_with(mtcars, lm, list(disp ~ drat))
expect_is(fit[[1]], "lm")
})
modelr/tests/testthat/test-resampling.R 0000644 0001762 0000144 00000004330 13432533345 020004 0 ustar ligges users context("resampling")
suppressPackageStartupMessages(library(dplyr))
suppressPackageStartupMessages(library(purrr))
d <- mtcars %>%
head(30) %>%
mutate(row = row_number())
test_that("Can perform cross validation", {
cross <- crossv_kfold(d, k = 5)
expect_equal(nrow(cross), 5)
trains <- map(cross$train, as.data.frame)
expect_true(all(map_dbl(trains, nrow) == 24))
tests <- map(cross$test, as.data.frame)
expect_true(all(map_dbl(tests, nrow) == 6))
overlaps <- map2(map(trains, "row"), map(tests, "row"), intersect)
expect_true(all(lengths(overlaps) == 0))
})
test_that("Can perform leave-one-out cross validation", {
cross <- crossv_loo(d)
expect_equal(nrow(cross), 30)
trains <- map(cross$train, as.data.frame)
expect_true(all(map_dbl(trains, nrow) == 29))
tests <- map(cross$test, as.data.frame)
expect_true(all(map_dbl(tests, nrow) == 1))
overlaps <- map2(map(trains, "row"), map(tests, "row"), intersect)
expect_true(all(lengths(overlaps) == 0))
expect_true(cross[nrow(cross),]$.id==nrow(cross))
expect_true(cross[1,]$.id==1)
})
test_that("Can perform bootstrapping", {
boot <- mtcars %>%
bootstrap(5)
expect_equal(nrow(boot), 5)
for (b in boot$strap) {
bd <- as.data.frame(b)
expect_equal(nrow(bd), nrow(mtcars))
expect_true(all(bd$mpg %in% mtcars$mpg))
expect_false(all(bd$mpg == mtcars$mpg))
}
})
test_that("Can perform permutation", {
perm <- mtcars %>%
permute(5, mpg)
expect_equal(nrow(perm), 5)
for (p in perm$perm) {
pd <- as.data.frame(p)
expect_equal(mtcars$cyl, pd$cyl)
expect_equal(mtcars$hp, pd$hp)
expect_equal(sort(mtcars$mpg), sort(pd$mpg))
# chance of permutation being the same is basically nil
expect_false(all(mtcars$mpg == pd$mpg))
}
})
test_that("appropriate args are supplied to resample_*()", {
expect_error(resample("mtcars", 1:10), "data frame")
expect_error(resample(mtcars, 10), "integer vector")
expect_error(
resample_permutation(mtcars, c("mpg", "cyl"), idx = 2),
"same length"
)
expect_error(
resample_permutation("mtcars", c("mpg", "cyl"), idx = 1:32),
"data frame"
)
expect_error(
resample_permutation(mtcars, c("mpg", "iris"), idx = 1:32),
"vector"
)
})
modelr/tests/testthat.R 0000644 0001762 0000144 00000000070 12727615525 014672 0 ustar ligges users library(testthat)
library(modelr)
test_check("modelr")
modelr/R/ 0000755 0001762 0000144 00000000000 13432533345 011742 5 ustar ligges users modelr/R/residuals.R 0000644 0001762 0000144 00000003256 13275046533 014071 0 ustar ligges users #' Add residuals to a data frame
#'
#' @param data A data frame used to generate the residuals
#' @param model,var `add_residuals` takes a single `model`; the
#' output column will be called `resid`
#' @param ... `gather_residuals` and `spread_residuals` take
#' multiple models. The name will be taken from either the argument
#' name of the name of the model.
#' @param .resid,.model The variable names used by `gather_residuals`.
#' @return A data frame. `add_residuals` adds a single new column,
#' `.resid`, to the input `data`. `spread_residuals` adds
#' one column for each model. `gather_predictions` adds two columns
#' `.model` and `.resid`, and repeats the input rows for
#' each model.
#' @export
#' @examples
#' df <- tibble::data_frame(
#' x = sort(runif(100)),
#' y = 5 * x + 0.5 * x ^ 2 + 3 + rnorm(length(x))
#' )
#' plot(df)
#'
#' m1 <- lm(y ~ x, data = df)
#' df %>% add_residuals(m1)
#'
#' m2 <- lm(y ~ poly(x, 2), data = df)
#' df %>% spread_residuals(m1, m2)
#' df %>% gather_residuals(m1, m2)
add_residuals <- function(data, model, var = "resid") {
data[[var]] <- residuals(model, data)
data
}
#' @rdname add_residuals
#' @export
spread_residuals <- function(data, ...) {
models <- tibble::lst(...)
for (nm in names(models)) {
data[[nm]] <- residuals(models[[nm]], data)
}
data
}
#' @rdname add_residuals
#' @export
gather_residuals <- function(data, ..., .resid = "resid", .model = "model") {
models <- tibble::lst(...)
df <- purrr::map2(models, .resid, add_residuals, data = data)
names(df) <- names(models)
dplyr::bind_rows(df, .id = .model)
}
residuals <- function(model, data) {
response(model, data) - stats::predict(model, data)
}
modelr/R/partition.R 0000644 0001762 0000144 00000001655 13623760426 014111 0 ustar ligges users #' Generate an exclusive partitioning of a data frame
#'
#' @param data A data frame
#' @param p A named numeric vector giving where the value is the probability
#' that an observation will be assigned to that group.
#' @family resampling techniques
#' @export
#' @examples
#' ex <- resample_partition(mtcars, c(test = 0.3, train = 0.7))
#' mod <- lm(mpg ~ wt, data = ex$train)
#' rmse(mod, ex$test)
#' rmse(mod, ex$train)
resample_partition <- function(data, p) {
if (!is.numeric(p) || length(p) < 2 || !all(has_name(p))) {
stop("`p` must be a named numeric vector with at least two values.")
}
if (abs(sum(p) - 1) > 1e-6) {
message("Rescaling `p` to sum to 1.")
}
# Always rescale so sums exactly to 1
p <- p / sum(p)
n <- nrow(data)
g <- findInterval(seq_len(n) / n, c(0, cumsum(p)), rightmost.closed = TRUE)
idx <- split(seq_len(n), sample(g))
names(idx) <- names(p)
map(idx, resample, data = data)
}
modelr/R/utils.R 0000644 0001762 0000144 00000001332 13275066477 013240 0 ustar ligges users #' Pipe operator
#'
#' @name %>%
#' @rdname pipe
#' @keywords internal
#' @export
#' @importFrom magrittr %>%
#' @usage lhs \%>\% rhs
NULL
reduce_common <- function(x, msg = "Objects must be identical",
operator = identical) {
reduce(x, function(.x, .y) {
if (!operator(.x, .y)) {
stop(msg, call. = FALSE)
}
.y
})
}
has_name <- function(x) {
nms <- names(x)
if (is.null(nms)) {
rep(FALSE, length(x))
} else {
!(is.na(nms) | nms == "")
}
}
big_mark <- function(x, ...) {
mark <- if (identical(getOption("OutDec"), ",")) "." else ","
formatC(x, big.mark = mark, ...)
}
id <- function(n) {
width <- nchar(n)
sprintf(paste0("%0", width, "d"), seq_len(n))
}
modelr/R/model_matrix.R 0000644 0001762 0000144 00000001267 13275046533 014562 0 ustar ligges users #' Construct a design matrix
#'
#' This is a thin wrapper around [stats::model.matrix()] which
#' returns a tibble. Use it to determine how your modelling formula is
#' translated into a matrix, an thence into an equation.
#'
#' @param data A data frame
#' @param formula A modelling formula
#' @param ... Other arguments passed onto [stats::model.matrix()]
#' @return A tibble.
#' @export
#' @examples
#' model_matrix(mtcars, mpg ~ cyl)
#' model_matrix(iris, Sepal.Length ~ Species)
#' model_matrix(iris, Sepal.Length ~ Species - 1)
model_matrix <- function(data, formula, ...) {
out <- stats::model.matrix(formula, data = data, ...)
mostattributes(out) <- NULL
tibble::as_tibble(out)
}
modelr/R/geom_ref_line.R 0000644 0001762 0000144 00000000756 12730570074 014667 0 ustar ligges users #' Add a reference line (ggplot2).
#'
#' @param h,v Position of horizontal or vertical reference line
#' @param size Line size
#' @param colour Line colour
#' @export
geom_ref_line <- function(h, v, size = 2, colour = "white") {
if (!missing(h)) {
ggplot2::geom_hline(yintercept = h, size = size, colour = colour)
} else if (!missing(v)) {
ggplot2::geom_vline(xintercept = v, size = size, colour = colour)
} else {
stop("Must supply one of `h` and `v`.", call. = FALSE)
}
}
modelr/R/cross-validation.R 0000644 0001762 0000144 00000005110 13426133222 015334 0 ustar ligges users #' Generate test-training pairs for cross-validation
#'
#' `crossv_kfold` splits the data into `k` exclusive partitions,
#' and uses each partition for a test-training split. `crossv_mc`
#' generates `n` random partitions, holding out `test` of the
#' data for training. `crossv_loo` performs leave-one-out
#' cross-validation, i.e., `n = nrow(data)` training partitions containing
#' `n - 1` rows each.
#'
#' @inheritParams resample_partition
#' @param n Number of test-training pairs to generate (an integer).
#' @param test Proportion of observations that should be held out for testing
#' (a double).
#' @param id Name of variable that gives each model a unique integer id.
#' @return A data frame with columns `test`, `train`, and `.id`.
#' `test` and `train` are list-columns containing [resample()] objects.
#' The number of rows is `n` for `crossv_mc()`, `k` for `crossv_kfold()`
#' and `nrow(data)` for `crossv_loo()`.
#' @export
#' @examples
#' cv1 <- crossv_kfold(mtcars, 5)
#' cv1
#'
#' library(purrr)
#' cv2 <- crossv_mc(mtcars, 100)
#' models <- map(cv2$train, ~ lm(mpg ~ wt, data = .))
#' errs <- map2_dbl(models, cv2$test, rmse)
#' hist(errs)
crossv_mc <- function(data, n, test = 0.2, id = ".id") {
if (!is.numeric(n) || length(n) != 1) {
stop("`n` must be a single integer.", call. = FALSE)
}
if (!is.numeric(test) || length(test) != 1 || test <= 0 || test >= 1) {
stop("`test` must be a value between 0 and 1.", call. = FALSE)
}
p <- c(train = 1 - test, test = test)
runs <- purrr::rerun(n, resample_partition(data, p))
cols <- purrr::transpose(runs)
cols[[id]] <- id(n)
tibble::as_data_frame(cols)
}
#' @export
#' @param k Number of folds (an integer).
#' @rdname crossv_mc
crossv_kfold <- function(data, k = 5, id = ".id") {
if (!is.numeric(k) || length(k) != 1) {
stop("`k` must be a single integer.", call. = FALSE)
}
n <- nrow(data)
folds <- sample(rep(1:k, length.out = n))
idx <- seq_len(n)
fold_idx <- split(idx, folds)
fold <- function(test) {
list(
train = resample(data, setdiff(idx, test)),
test = resample(data, test)
)
}
cols <- purrr::transpose(purrr::map(fold_idx, fold))
cols[[id]] <- id(k)
tibble::as_data_frame(cols)
}
#' @export
#' @rdname crossv_mc
crossv_loo <- function(data, id = ".id") {
n <- nrow(data)
idx <- seq_len(n)
fold_idx <- split(idx, idx)
fold <- function(test) {
list(
train = resample(data, setdiff(idx, test)),
test = resample(data, test)
)
}
cols <- purrr::transpose(purrr::map(fold_idx, fold))
cols[[id]] <- 1:n
tibble::as_data_frame(cols)
}
modelr/R/predictions.R 0000644 0001762 0000144 00000004120 13432533345 014405 0 ustar ligges users #' Add predictions to a data frame
#'
#' @param data A data frame used to generate the predictions.
#' @param model `add_predictions` takes a single `model`;
#' @param var The name of the output column, default value is `pred`
#' @param type Prediction type, passed on to `stats::predict()`. Consult
#' `predict()` documentation for given `model` to determine valid values.
#' @param ... `gather_predictions` and `spread_predictions` take
#' multiple models. The name will be taken from either the argument
#' name of the name of the model.
#' @param .pred,.model The variable names used by `gather_predictions`.
#' @return A data frame. `add_prediction` adds a single new column,
#' with default name `pred`, to the input `data`.
#' `spread_predictions` adds one column for each model. `gather_predictions`
#' adds two columns `.model` and `.pred`, and repeats the input rows for each
#' model.
#' @export
#' @examples
#' df <- tibble::data_frame(
#' x = sort(runif(100)),
#' y = 5 * x + 0.5 * x ^ 2 + 3 + rnorm(length(x))
#' )
#' plot(df)
#'
#' m1 <- lm(y ~ x, data = df)
#' grid <- data.frame(x = seq(0, 1, length = 10))
#' grid %>% add_predictions(m1)
#'
#' m2 <- lm(y ~ poly(x, 2), data = df)
#' grid %>% spread_predictions(m1, m2)
#' grid %>% gather_predictions(m1, m2)
add_predictions <- function(data, model, var = "pred", type = NULL) {
data[[var]] <- predict2(model, data, type = type)
data
}
#' @rdname add_predictions
#' @export
spread_predictions <- function(data, ..., type = NULL) {
models <- tibble::lst(...)
for (nm in names(models)) {
data[[nm]] <- predict2(models[[nm]], data, type = type)
}
data
}
#' @rdname add_predictions
#' @export
gather_predictions <- function(data, ..., .pred = "pred", .model = "model", type = NULL) {
models <- tibble::lst(...)
df <- purrr::map2(models, .pred, add_predictions, data = data, type = type)
names(df) <- names(models)
dplyr::bind_rows(df, .id = .model)
}
predict2 <- function(model, data, type = NULL) {
if (is.null(type)) {
stats::predict(model, data)
} else {
stats::predict(model, data, type = type)
}
}
modelr/R/data.R 0000644 0001762 0000144 00000002031 12743766052 013001 0 ustar ligges users #' Height and income data.
#'
#' You might have heard that taller people earn more. Is it true? You can
#' try and answer the question by exploring this dataset extracted from the
#' \href{https://www.nlsinfo.org}{National Longitudinal Study}, which is
#' sponsored by the U.S. Bureau of Labor Statistics.
#'
#' This contains data as at 2012.
#' @format
#' \describe{
#' \item{income}{Yearly income. The top two percent of values were averaged
#' and that average was used to replace all values in the top range. }
#' \item{height}{Height, in feet}
#' \item{weight}{Weight, in pounds}
#' \item{age}{Age, in years, between 47 and 56.}
#' \item{marital}{Marital status}
#' \item{sex}{Sex}
#' \item{education}{Years of education}
#' \item{afqt}{Percentile score on Armed Forces Qualification Test.}
#' }
"heights"
#' Simple simulated datasets
#'
#' These simple simulated datasets are useful for teaching modelling
#' basics.
#'
#' @name sim
NULL
#' @rdname sim
"sim1"
#' @rdname sim
"sim2"
#' @rdname sim
"sim3"
#' @rdname sim
"sim4"
modelr/R/permute.R 0000644 0001762 0000144 00000006537 13623760745 013571 0 ustar ligges users #' Generate `n` permutation replicates.
#'
#' A permutation test involves permuting one or more variables in a data set
#' before performing the test, in order to break any existing relationships
#' and simulate the null hypothesis. One can then compare the true statistic
#' to the generated distribution of null statistics.
#'
#' @inheritParams resample_partition
#' @param n Number of permutations to generate.
#' @param ... Columns to permute. This supports bare column names or dplyr
#' [dplyr::select_helpers]
#' @param columns In `permute_`, vector of column names to permute.
#' @param .id Name of variable that gives each model a unique integer id.
#'
#' @return A data frame with `n` rows and one column: `perm`
#' @export
#' @examples
#'
#' library(purrr)
#' perms <- permute(mtcars, 1000, mpg)
#'
#' models <- map(perms$perm, ~ lm(mpg ~ wt, data = .))
#' glanced <- map_df(models, broom::glance, .id = "id")
#'
#' # distribution of null permutation statistics
#' hist(glanced$statistic)
#' # confirm these are roughly uniform p-values
#' hist(glanced$p.value)
#'
#' # test against the unpermuted model to get a permutation p-value
#' mod <- lm(mpg ~ wt, mtcars)
#' mean(glanced$statistic > broom::glance(mod)$statistic)
#'
#' @export
permute <- function(data, n, ..., .id = ".id") {
columns <- tidyselect::vars_select(colnames(data), ...)
permute_(data, n, columns, .id = .id)
}
#' @rdname permute
#' @export
permute_ <- function(data, n, columns, .id = ".id") {
perm <- purrr::rerun(n, resample_permutation(data, columns))
df <- tibble::data_frame(perm = perm)
df[[.id]] <- id(n)
df
}
#' Create a resampled permutation of a data frame
#'
#' @param data A data frame
#' @param columns Columns to be permuted
#' @param idx Indices to permute by. If not given, generates them randomly
#'
#' @return A permutation object; use as.data.frame to convert to a permuted
#' data frame
#'
#' @export
resample_permutation <- function(data, columns, idx = NULL) {
if (is.null(idx)) {
idx <- sample.int(nrow(data))
}
if (!is.data.frame(data)) {
stop("`data` must be a data frame.", call. = FALSE)
}
if (!is.character(columns) ||
!(all(columns %in% colnames(data)))) {
stop("`columns` must be a vector of column names in `data`", call. = FALSE)
}
if (!is.integer(idx) || length(idx) != nrow(data)) {
stop("`idx` must be an integer vector with the same length as there are ",
"rows in `data`",
call. = FALSE
)
}
structure(
list(
data = data,
columns = columns,
idx = idx
),
class = "permutation"
)
}
#' @export
print.permutation <- function(x, ...) {
n <- length(x$idx)
if (n > 10) {
id10 <- c(x$idx[1:10], "...")
} else {
id10 <- x$idx
}
cat("<", obj_sum.permutation(x), "> ", paste(id10, collapse = ", "), "\n",
sep = ""
)
}
#' @export
as.integer.permutation <- function(x, ...) {
x$idx
}
#' @export
as.data.frame.permutation <- function(x, ...) {
ret <- x$data
indices <- x$idx
for (col in x$columns) {
ret[[col]] <- ret[[col]][indices]
}
ret
}
#' @export
dim.permutation <- function(x, ...) {
c(length(x$idx), ncol(x$data))
}
#' @importFrom tibble obj_sum
#' @method obj_sum resample
#' @export
obj_sum.permutation <- function(x, ...) {
paste0(
"permutation (", paste0(x$columns, collapse = ", "), ") [",
big_mark(nrow(x)), " x ", big_mark(ncol(x)), "]"
)
}
modelr/R/data-grid.R 0000644 0001762 0000144 00000003040 13473321473 013720 0 ustar ligges users #' Generate a data grid.
#'
#' To visualise a model, it is very useful to be able to generate an
#' evenly spaced grid of points from the data. `data_grid` helps you
#' do this by wrapping around [tidyr::expand()].
#'
#' @param data A data frame
#' @param ... Variables passed on to [tidyr::expand()]
#' @param .model A model. If supplied, any predictors needed for the model
#' not present in `...` will be filled in with "\link{typical}" values.
#' @export
#' @seealso [seq_range()] for generating ranges from continuous
#' variables.
#' @examples
#' data_grid(mtcars, vs, am)
#'
#' # For continuous variables, seq_range is useful
#' data_grid(mtcars, mpg = mpg)
#' data_grid(mtcars, mpg = seq_range(mpg, 10))
#'
#' # If you supply a model, missing predictors will be filled in with
#' # typical values
#' mod <- lm(mpg ~ wt + cyl + vs, data = mtcars)
#' data_grid(mtcars, .model = mod)
#' data_grid(mtcars, cyl = seq_range(cyl, 9), .model = mod)
data_grid <- function(data, ..., .model = NULL) {
if (missing(...) && missing(.model)) {
abort("Must supply at least one of `...` and `.model`")
}
if (missing(...)) {
expanded <- NULL
} else {
expanded <- tidyr::expand(data, ...)
}
if (is.null(.model)) {
return(expanded)
}
# Generate grid of typical values
needed <- setdiff(predictor_vars(.model), names(expanded))
if (length(needed) > 0) {
typical_vals <- lapply(data[needed], typical)
typical_df <- tidyr::crossing(!!!typical_vals)
} else {
typical_df <- NULL
}
tidyr::crossing(expanded, typical_df)
}
modelr/R/response.R 0000644 0001762 0000144 00000000641 12745501265 013726 0 ustar ligges users response_var <- function(model) {
UseMethod("response_var")
}
#' @export
response_var.default <- function(model, data) {
stats::formula(model)[[2L]]
}
predictor_vars <- function(model) {
UseMethod("predictor_vars")
}
#' @export
predictor_vars.default <- function(model, data) {
all.vars(stats::formula(model)[[3L]])
}
response <- function(model, data) {
eval(response_var(model), as.data.frame(data))
}
modelr/R/resample.R 0000644 0001762 0000144 00000003601 13623760404 013675 0 ustar ligges users #' A "lazy" resample.
#'
#' Often you will resample a dataset hundreds or thousands of times. Storing
#' the complete resample each time would be very inefficient so this class
#' instead stores a "pointer" to the original dataset, and a vector of row
#' indexes. To turn this into a regular data frame, call `as.data.frame`,
#' to extract the indices, use `as.integer`.
#'
#' @param data The data frame
#' @param idx A vector of integer indexes indicating which rows have
#' been selected. These values should lie between 1 and `nrow(data)`
#' but they are not checked by this function in the interests of performance.
#' @family resampling techniques
#' @export
#' @examples
#' resample(mtcars, 1:10)
#'
#' b <- resample_bootstrap(mtcars)
#' b
#' as.integer(b)
#' as.data.frame(b)
#'
#' # Many modelling functions will do the coercion for you, so you can
#' # use a resample object directly in the data argument
#' lm(mpg ~ wt, data = b)
resample <- function(data, idx) {
if (!is.data.frame(data)) {
stop("`data` must be a data frame.", call. = FALSE)
}
if (!is.integer(idx)) {
stop("`idx` must be an integer vector.", call. = FALSE)
}
structure(
list(
data = data,
idx = idx
),
class = "resample"
)
}
#' @export
print.resample <- function(x, ...) {
n <- length(x$idx)
if (n > 10) {
id10 <- c(x$idx[1:10], "...")
} else {
id10 <- x$idx
}
cat("<", obj_sum.resample(x), "> ", paste(id10, collapse = ", "), "\n",
sep = ""
)
}
#' @export
as.integer.resample <- function(x, ...) {
x$idx
}
#' @export
as.data.frame.resample <- function(x, ...) {
x$data[x$idx, , drop = FALSE]
}
#' @export
dim.resample <- function(x, ...) {
c(length(x$idx), ncol(x$data))
}
#' @importFrom tibble obj_sum
#' @method obj_sum resample
#' @export
obj_sum.resample <- function(x, ...) {
paste0("resample [", big_mark(nrow(x)), " x ", big_mark(ncol(x)), "]")
}
modelr/R/typical.R 0000644 0001762 0000144 00000002777 13424144743 013550 0 ustar ligges users #' Find the typical value
#'
#' For numeric, integer, and ordered factor vectors, it returns the median.
#' For factors, characters, and logical vectors, it returns the most
#' frequent value. If multiple values are tied for most frequent, it returns
#' them all. `NA` missing values are always silently dropped.
#'
#' @param x A vector
#' @param ... Arguments used by methods
#' @export
#' @importFrom stats quantile
#' @examples
#' # median of numeric vector
#' typical(rpois(100, lambda = 10))
#'
#' # most frequent value of character or factor
#' x <- sample(c("a", "b", "c"), 100, prob = c(0.6, 0.2, 0.2), replace = TRUE)
#' typical(x)
#' typical(factor(x))
#'
#' # if tied, returns them all
#' x <- c("a", "a", "b", "b", "c")
#' typical(x)
#'
#' # median of an ordered factor
#' typical(ordered(c("a", "a", "b", "c", "d")))
#'
typical <- function(x, ...) {
UseMethod("typical")
}
#' @export
typical.numeric <- function(x, ...) {
stats::median(x, na.rm = TRUE)
}
#' @export
typical.factor <- function(x, ...) {
counts <- table(x, exclude = NULL)
levels(x)[max(counts) == counts]
}
#' @export
typical.character <- function(x, ...) {
counts <- table(x, exclude = NULL)
names(counts)[max(counts) == counts]
}
#' @export
typical.logical <- function(x, ...) {
mean(x, na.rm = TRUE) >= 0.5
}
#' @export
typical.integer <- function(x, ...) {
unname(stats::quantile(x, 0.5, type = 1, na.rm = TRUE))
}
#' @export
typical.ordered <- function(x, ...) {
as.character(stats::quantile(x, 0.5, type = 1, na.rm = TRUE))
}
modelr/R/na-warn.R 0000644 0001762 0000144 00000001602 13623760453 013433 0 ustar ligges users #' Handle missing values with a warning
#'
#' This NA handler ensures that those models that support the
#' `na.action` parameter do not silently drop missing values. It
#' wraps around [stats::na.exclude()] so that there is one
#' prediction/residual for input row. To apply it globally, run
#' `options(na.action = na.warn)`.
#'
#' @param object A data frame
#' @export
#' @examples
#' df <- tibble::tibble(
#' x = 1:10,
#' y = c(5.1, 9.7, NA, 17.4, 21.2, 26.6, 27.9, NA, 36.3, 40.4)
#' )
#' # Default behaviour is to silently drop
#' m1 <- lm(y ~ x, data = df)
#' resid(m1)
#'
#' # Use na.action = na.warn to warn
#' m2 <- lm(y ~ x, data = df, na.action = na.warn)
#' resid(m2)
na.warn <- function(object) {
missing <- sum(!stats::complete.cases(object))
if (missing > 0) {
warning("Dropping ", missing, " rows with missing values", call. = FALSE)
}
stats::na.exclude(object)
}
modelr/R/formulas.R 0000644 0001762 0000144 00000012764 13523022712 013717 0 ustar ligges users #' Fit a list of formulas
#'
#' `fit_with()` is a pipe-friendly tool that applies a list of
#' formulas to a fitting function such as [stats::lm()].
#' The list of formulas is typically created with [formulas()].
#'
#' Assumes that `.f` takes the formula either as first argument
#' or as second argument if the first argument is `data`. Most
#' fitting functions should fit these requirements.
#' @param data A dataset used to fit the models.
#' @param .f A fitting function such as [stats::lm()],
#' [lme4::lmer()] or [rstanarm::stan_glmer()].
#' @param .formulas A list of formulas specifying a model.
#' @param ... Additional arguments passed on to `.f`
#' @seealso [formulas()]
#' @export
#' @examples
#' # fit_with() is typically used with formulas().
#' disp_fits <- mtcars %>% fit_with(lm, formulas(~disp,
#' additive = ~drat + cyl,
#' interaction = ~drat * cyl,
#' full = add_predictors(interaction, ~am, ~vs)
#' ))
#'
#' # The list of fitted models is named after the names of the list of
#' # formulas:
#' disp_fits$full
#'
#' # Additional arguments are passed on to .f
#' mtcars %>% fit_with(glm, list(am ~ disp), family = binomial)
fit_with <- function(data, .f, .formulas, ...) {
args <- list(...)
# Quoting data to avoid getting the whole raw SEXP structure in the
# calls captured by the fitting function (which gets displayed in
# print methods)
args$data <- quote(data)
# Supply .f quoted, otherwise the whole fitting function is inlined
# in the call recorded in the fit objects
map(.formulas, function(formula) {
purrr::invoke(".f", args, formula = formula, .env = environment())
})
}
#' Create a list of formulas
#'
#' `formulas()` creates a list of two-sided formulas by merging a
#' unique left-hand side to a list of right-hand sides.
#' @param .response A one-sided formula used as the left-hand side of
#' all resulting formulas.
#' @param ... List of formulas whose right-hand sides will be merged
#' to `.response`.
#' @export
#' @examples
#' # Provide named arguments to create a named list of formulas:
#' models <- formulas(~lhs,
#' additive = ~var1 + var2,
#' interaction = ~var1 * var2
#' )
#' models$additive
#'
#' # The formulas are created sequentially, so that you can refer to
#' # previously created formulas:
#' formulas(~lhs,
#' linear = ~var1 + var2,
#' hierarchical = add_predictors(linear, ~(1 | group))
#' )
formulas <- function(.response, ...) {
formulas <- tibble::lst(...)
validate_formulas(.response, formulas)
map(formulas, set_lhs, .response)
}
#' @rdname formulas
#' @export
formulae <- formulas
validate_formulas <- function(response, formulas) {
if (!is_formula(response) || length(response) != 2) {
stop(".response must be a one-sided formula", call. = FALSE)
}
if (!length(formulas)) {
stop("No formula provided", call. = FALSE)
}
purrr::walk(formulas, function(f) {
if (!is_formula(f)) {
stop("'...' must contain only formulas", call. = FALSE)
}
})
}
set_lhs <- function(f, lhs) {
env <- merge_envs(lhs, f)
new_formula(f_rhs(lhs), f_rhs(f), env)
}
#' Add predictors to a formula
#'
#' This merges a one- or two-sided formula `f` with the
#' right-hand sides of all formulas supplied in `...`.
#' @param f A formula.
#' @param ... Formulas whose right-hand sides will be merged to
#' `f`.
#' @param fun A function name indicating how to merge the right-hand
#' sides.
#' @export
#' @examples
#' f <- lhs ~ rhs
#' add_predictors(f, ~var1, ~var2)
#'
#' # Left-hand sides are ignored:
#' add_predictors(f, lhs1 ~ var1, lhs2 ~ var2)
#'
#' # fun can also be set to a function like "*":
#' add_predictors(f, ~var1, ~var2, fun = "*")
add_predictors <- function(f, ..., fun = "+") {
rhss <- map(list(f, ...), f_zap_lhs)
rhs <- reduce(rhss, merge_formulas, fun = fun)
env <- merge_envs(f, rhs)
new_formula(f_lhs(f), f_rhs(rhs), env)
}
merge_formulas <- function(f1, f2, fun = "+") {
rhs <- call(fun, f_rhs(f1), f_rhs(f2))
lhss <- compact(map(list(f1, f2), f_lhs))
if (length(lhss) == 0) {
lhs <- NULL
} else {
lhs <- reduce_common(lhss, "Left-hand sides must be identical")
}
env <- merge_envs(f1, f2)
new_formula(lhs, rhs, env)
}
merge_envs <- function(f1, f2) {
symbols_f1 <- find_symbols(f1)
symbols_f2 <- find_symbols(f2)
conflicts <- intersect(symbols_f1, symbols_f2)
conflicts_envs <- compact(map(conflicts, find_env_conflicts, f1, f2))
all_symbols <- union(symbols_f1, symbols_f2)
nonconflicts <- setdiff(all_symbols, conflicts)
nonconflicts_envs <- compact(map(nonconflicts, find_env_nonconflicts, f1, f2))
all_envs <- c(conflicts_envs, nonconflicts_envs)
if (length(all_envs) == 0) {
environment(f1)
} else {
reduce_common(
all_envs,
"Cannot merge formulas as their scopes conflict across symbols"
)
}
}
find_env_conflicts <- function(symbol, f1, f2) {
env1 <- find_binding_env(symbol, environment(f1))
env2 <- find_binding_env(symbol, environment(f2))
if (is.null(env1) || is.null(env2)) {
return(env1 %||% env2)
}
if (!identical(env1, env2)) {
stop("Cannot merge formulas as their scopes conflict for the symbol '",
symbol, "'",
call. = FALSE
)
}
env1
}
find_env_nonconflicts <- function(symbol, f1, f2) {
env1 <- find_binding_env(symbol, environment(f1))
env2 <- find_binding_env(symbol, environment(f2))
env1 %||% env2
}
find_binding_env <- function(symbol, env) {
if (exists(symbol, envir = env)) {
env
} else if (!identical(env, emptyenv())) {
find_binding_env(symbol, parent.env(env))
} else {
NULL
}
}
modelr/R/utils-lang.R 0000644 0001762 0000144 00000001132 13275066351 014144 0 ustar ligges users
find_symbols <- function(lang) {
if (is.call(lang)) {
find_symbols_call(lang)
} else if (is.symbol(lang)) {
as.character(lang)
} else {
character(0)
}
}
find_symbols_call <- function(lang) {
fun_name <- as.character(lang[[1]])
if (fun_name %in% c("$", "@")) {
as.character(lang[[2]])
} else if (fun_name %in% c("::", ":::")) {
character(0)
} else {
res <- map(as.list(lang[-1]), find_symbols)
purrr::flatten_chr(res)
}
}
f_zap_lhs <- function(f) {
new_formula(NULL, f_rhs(f), env = f_env(f))
}
is_formula <- function(f) {
inherits(f, "formula")
}
modelr/R/seq_range.R 0000644 0001762 0000144 00000003520 13275064740 014034 0 ustar ligges users #' Generate a sequence over the range of a vector
#'
#' @param x A numeric vector
#' @param n,by Specify the output sequence either by supplying the
#' length of the sequence with `n`, or the spacing between value
#' with `by`. Specifying both is an error.
#'
#' I recommend that you name these arguments in order to make it clear to
#' the reader.
#' @param pretty If `TRUE`, will generate a pretty sequence. If `n`
#' is supplied, this will use [pretty()] instead of
#' [seq()]. If `by` is supplied, it will round the first
#' value to a multiple of `by`.
#' @param trim Optionally, trim values off the tails.
#' `trim / 2 * length(x)` values are removed from each tail.
#' @param expand Optionally, expand the range by `expand * (1 + range(x)`
#' (computed after trimming).
#' @export
#' @examples
#' x <- rcauchy(100)
#' seq_range(x, n = 10)
#' seq_range(x, n = 10, trim = 0.1)
#' seq_range(x, by = 1, trim = 0.1)
#'
#' # Make pretty sequences
#' y <- runif(100)
#' seq_range(y, n = 10)
#' seq_range(y, n = 10, pretty = TRUE)
#' seq_range(y, n = 10, expand = 0.5, pretty = TRUE)
#'
#' seq_range(y, by = 0.1)
#' seq_range(y, by = 0.1, pretty = TRUE)
seq_range <- function(x, n, by, trim = NULL, expand = NULL, pretty = FALSE) {
if (!missing(n) && !missing(by)) {
stop("May only specify one of `n` and `by`", call. = FALSE)
}
if (!is.null(trim)) {
rng <- stats::quantile(x, c(trim / 2, 1 - trim / 2), na.rm = TRUE)
} else {
rng <- range(x, na.rm = TRUE)
}
if (!is.null(expand)) {
rng <- rng + c(-expand / 2, expand / 2) * (rng[2] - rng[1])
}
if (missing(by)) {
if (pretty) {
pretty(rng, n)
} else {
seq(rng[1], rng[2], length.out = n)
}
} else {
if (pretty) {
rng[1] <- floor(rng[1] / by) * by
rng[2] <- ceiling(rng[2] / by) * by
}
seq(rng[1], rng[2], by = by)
}
}
modelr/R/quality.R 0000644 0001762 0000144 00000004002 13275064735 013560 0 ustar ligges users #' Compute model quality for a given dataset
#'
#' @description
#' Three summaries are immediately interpretible on the scale of the response
#' variable:
#' * `rmse()` is the root-mean-squared-error
#' * `mae()` is the mean absolute error
#' * `qae()` is quantiles of absolute error.
#'
#' Other summaries have varying scales and interpretations:
#' * `mape()` mean absolute percentage error.
#' * `rsae()` is the relative sum of absolute errors.
#' * `mse()` is the mean-squared-error.
#' * `rsquare()` is the variance of the predictions divided by the
#' variance of the response.
#' @param model A model
#' @param data The dataset
#' @name model-quality
#' @examples
#' mod <- lm(mpg ~ wt, data = mtcars)
#' mse(mod, mtcars)
#' rmse(mod, mtcars)
#' rsquare(mod, mtcars)
#' mae(mod, mtcars)
#' qae(mod, mtcars)
#' mape(mod, mtcars)
#' rsae(mod, mtcars)
NULL
#' @export
#' @rdname model-quality
mse <- function(model, data) {
x <- residuals(model, data)
mean(x^2, na.rm = TRUE)
}
#' @export
#' @rdname model-quality
rmse <- function(model, data) {
x <- residuals(model, data)
sqrt(mean(x^2, na.rm = TRUE))
}
#' @export
#' @rdname model-quality
mae <- function(model, data) {
x <- residuals(model, data)
mean(abs(x), na.rm = TRUE)
}
#' @export
#' @rdname model-quality
rsquare <- function(model, data) {
x <- residuals(model, data)
y <- response(model, data)
1 - stats::var(x, na.rm = TRUE) / stats::var(y, na.rm = TRUE)
}
#' @export
#' @rdname model-quality
#' @param probs Numeric vector of probabilities
qae <- function(model, data, probs = c(0.05, 0.25, 0.5, 0.75, 0.95)) {
x <- residuals(model, data)
stats::quantile(abs(x), probs, na.rm = TRUE)
}
#' @export
#' @rdname model-quality
mape <- function(model, data) {
x <- residuals(model, data)
y <- response(model, data)
mean(abs(x / y), na.rm = TRUE)
}
#' @export
#' @rdname model-quality
rsae <- function(model, data) {
x <- residuals(model, data)
y <- response(model, data)
miss <- is.na(x) | is.na(y)
sum(abs(x[!miss])) / sum(abs(y[!miss]))
}
modelr/R/bootstrap.R 0000644 0001762 0000144 00000002245 13623760426 014111 0 ustar ligges users #' @importFrom broom tidy
NULL
#' Generate `n` bootstrap replicates.
#'
#' @inheritParams resample_partition
#' @family resampling techniques
#' @param n Number of bootstrap replicates to generate
#' @param id Name of variable that gives each model a unique integer id.
#' @return A data frame with `n` rows and one column: `strap`
#' @export
#' @examples
#' library(purrr)
#' boot <- bootstrap(mtcars, 100)
#'
#' models <- map(boot$strap, ~ lm(mpg ~ wt, data = .))
#' tidied <- map_df(models, broom::tidy, .id = "id")
#'
#' hist(subset(tidied, term == "wt")$estimate)
#' hist(subset(tidied, term == "(Intercept)")$estimate)
bootstrap <- function(data, n, id = ".id") {
bootstrap <- purrr::rerun(n, resample_bootstrap(data))
df <- tibble::data_frame(strap = bootstrap)
df[[id]] <- id(n)
df
}
#' Generate a boostrap replicate
#'
#' @param data A data frame
#' @family resampling techniques
#' @export
#' @examples
#' coef(lm(mpg ~ wt, data = resample_bootstrap(mtcars)))
#' coef(lm(mpg ~ wt, data = resample_bootstrap(mtcars)))
#' coef(lm(mpg ~ wt, data = resample_bootstrap(mtcars)))
resample_bootstrap <- function(data) {
resample(data, sample(nrow(data), replace = TRUE))
}
modelr/R/modelr.R 0000644 0001762 0000144 00000000132 13275066562 013352 0 ustar ligges users #' @keywords internal
#' @import rlang
#' @importFrom purrr map reduce compact
"_PACKAGE"
modelr/NEWS.md 0000644 0001762 0000144 00000002477 13624310507 012645 0 ustar ligges users # modelr 0.1.6
* R CMD check documentation fix
# modelr 0.1.5
* Fix to `data_grid()` to work with dev tidyr.
# modelr 0.1.4
* `add_predictions()`, `gather_predictions()`, and `spread_predictions()`
more carefully pass along `type` parameter in order to avoid problems with
predict methods that don't deal with `type = NULL` (#92).
# modelr 0.1.3
* `add_predictions()`, `gather_predictions()`, and `spread_predictions()`
gain a `type` parameter which is passed through to `stats::predict()`
(#34, @pmenzel)
* New `crossv_loo()` which implements leave-one-out cross validation (@pmenzel)
* `typical()` no longer ignores missing values in character and factor vectors
(#80).
# modelr 0.1.2
* `data_grid()` no longer fails with modern tidyr (#58).
* New `mape()` and `rsae()` model quality statistics (@paulponcet, #33).
* `rsquare()` use more robust calculation 1 - SS_res / SS_tot rather
than SS_reg / SS_tot (#37).
* `typical()` gains `ordered` and `integer` methods (@jrnold, #44),
and `...` argument (@jrnold, #42).
# modelr 0.1.1
* Added a `NEWS.md` file to track changes to the package.
* Fixed R CMD CHECK note
* Updated usage of `reduce()` for upcoming purrr release
* More general `permute()` function
* Add `mse()` function to calculate mean squared error. Written by @bensoltoff, pull request #57
modelr/MD5 0000644 0001762 0000144 00000006762 13624321012 012051 0 ustar ligges users 5c9099322eefe8e571f74cf414bb9133 *DESCRIPTION
0f89eda47110df4df47fd1dba96164b7 *NAMESPACE
1e92b91d791731c21987f152928c638e *NEWS.md
1131eef92f7f84719bdd1051449db010 *R/bootstrap.R
a3c0de9d45faae18434474076cc71fe6 *R/cross-validation.R
4048ae38f05339d6e9bfe2a6800164de *R/data-grid.R
9f831f87851514705fcc85de24203d15 *R/data.R
420b53e0ef033149b6528a73ece7e86c *R/formulas.R
860d3015670806ae1ca2bb0126cb4f30 *R/geom_ref_line.R
c295edea21a5d0ad9398c8d3024aa28e *R/model_matrix.R
80caf47b8eaeedd005159869d4b059ca *R/modelr.R
e512f3182937a44cdf5e3c5ceba515c2 *R/na-warn.R
3ab1b184d634a571c5e035d1d9037dfb *R/partition.R
52088ac1ed7748b86df840ef6d705ea1 *R/permute.R
806cf26bac215551d75dec6250821da9 *R/predictions.R
5484a5498231d7334bcfd45702caf9d7 *R/quality.R
f3814bc88ea1b450a8f1aa9e02c8b791 *R/resample.R
eedbff0f41f7ac012a579dd40e6bd63f *R/residuals.R
59cabddf9b6c6fd5d35861c3e3e87965 *R/response.R
13fd320516289e9a497c96e615f146ab *R/seq_range.R
843e132e24b903ccc1803cdbfb76eb26 *R/typical.R
84a5593d723a4755bb953a2265a2d0ea *R/utils-lang.R
54df7e2f3bf9867e796647bc64fd0689 *R/utils.R
0a4a79f747bd3ea6fee61b7d3a9d3992 *README.md
c040b7762c2934fcc667a3495ad57efe *data/heights.rda
ffd5f438ae67195a4c2fa23dd922a910 *data/sim1.rda
c155c78849583d02713d189068309762 *data/sim2.rda
59dd96e016540fff1dfcf80e8e272f6d *data/sim3.rda
d23f65ae7f994af283efe25552834512 *data/sim4.rda
8f8706cd31549cba2505518e4239385c *man/add_predictions.Rd
7e97d3e5d60052d420f3eda09b4d4458 *man/add_predictors.Rd
f890c98a68b419cd0a41a6a19fad21c3 *man/add_residuals.Rd
2fde57e43c3955214fa7194f1f3e6b15 *man/bootstrap.Rd
6a068f157dea6ef502387e29b56d4ee9 *man/crossv_mc.Rd
76328b06d97f86b454394a79823dd360 *man/data_grid.Rd
b8e4e18572591ce4e1940f99c014c169 *man/figures/logo.png
e68f8d24aac345896821924195bcd88f *man/fit_with.Rd
5e759a1d727767ad088b12760366cb73 *man/formulas.Rd
e659fadd7e9db15c3c6d901e7792f8bc *man/geom_ref_line.Rd
8d281cffe0bb4e27f927a670ebfd0704 *man/heights.Rd
8954d829b720ddf45c08ed0be8346e88 *man/model-quality.Rd
2df8c25cd25bcb4aa0f15689cd7d2894 *man/model_matrix.Rd
7b97e8e1f3c0958a0d7b5602a90f8857 *man/modelr-package.Rd
d6194cd16732fde87e095b8ce42bec2a *man/na.warn.Rd
843bd305d0057e9b88a2a764f082f518 *man/permute.Rd
a64a7ea44fcaa33c2d3ad0f7909cbc3e *man/pipe.Rd
133bf62781d8778baccbca1377307199 *man/resample.Rd
10df1fda7a9940500f8ce931af501c8a *man/resample_bootstrap.Rd
0d11d9a8e08c8b00003309cdf6603733 *man/resample_partition.Rd
018ffd02efe6cbf3ec2543204055e4e6 *man/resample_permutation.Rd
c490d6cefdb2acf4aeb882a29e9280a1 *man/seq_range.Rd
2f1c1034dd00234c971b4399ccf3306e *man/sim.Rd
b0df1ae92c7d48be1e445b2100a0587e *man/typical.Rd
daad45bf0c55617791ef8c4e34ffa1ac *tests/testthat.R
d6390d64b8f2d2186c557d9933ae9022 *tests/testthat/test-cross-validate.R
96da272add6d9cb6ace6c9d732ff1656 *tests/testthat/test-data-grid.R
0723f1e80ab9bca4202f8c2ce9f0241a *tests/testthat/test-formulas.R
08082a2003ce4ec51583f0a92f73cc17 *tests/testthat/test-geom-ref-line.R
d9fda079bc21f8b33faec5de059a94ad *tests/testthat/test-model-matrix.R
11e11a68bfd2544ad244365d12f8690a *tests/testthat/test-na-warn.R
4ace4ced4e16ef74e28841e6bb4b285f *tests/testthat/test-predictions.R
f43c5155ffcb4f0b9e74947aa9125cc3 *tests/testthat/test-resample-partition.R
9affdb3f9bd8d7757649e4beb0f321a7 *tests/testthat/test-resampling.R
cb1c6aa89432e65ab203ccc6c1bccabb *tests/testthat/test-residuals.R
a02473ea3b8b81c79ebf27d65eed3b93 *tests/testthat/test-response_var.R
b53aa97e7b04d0f9208813665cdba81b *tests/testthat/test-seq-range.R
0304fd73e3278a25ca1f382f1680539d *tests/testthat/test-typical.R