← Back to branch summary

~ubuntu-branches/ubuntu/wily/r-cran-formula/wily-proposed

« back to all changes in this revision

Viewing changes to tests/Examples/Formula-Ex.Rout.save

  • Committer: Package Import Robot
  • Author(s): Dirk Eddelbuettel
  • Date: 2013-07-13 13:00:23 UTC
  • Revision ID: package-import@ubuntu.com-20130713130023-1pu1cw0oivugt9fs
Tags: upstream-1.1-1
Import upstream version 1.1-1

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/Examples/Formula-Ex.Rout.save
 
1
 
 
2
R version 3.0.0 (2013-04-03) -- "Masked Marvel"
 
3
Copyright (C) 2013 The R Foundation for Statistical Computing
 
4
Platform: x86_64-pc-linux-gnu (64-bit)
 
5
 
 
6
R is free software and comes with ABSOLUTELY NO WARRANTY.
 
7
You are welcome to redistribute it under certain conditions.
 
8
Type 'license()' or 'licence()' for distribution details.
 
9
 
 
10
R is a collaborative project with many contributors.
 
11
Type 'contributors()' for more information and
 
12
'citation()' on how to cite R or R packages in publications.
 
13
 
 
14
Type 'demo()' for some demos, 'help()' for on-line help, or
 
15
'help.start()' for an HTML browser interface to help.
 
16
Type 'q()' to quit R.
 
17
 
 
18
> pkgname <- "Formula"
 
19
> source(file.path(R.home("share"), "R", "examples-header.R"))
 
20
> options(warn = 1)
 
21
> library('Formula')
 
22
> 
 
23
> base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
 
24
> cleanEx()
 
25
> nameEx("Formula")
 
26
> ### * Formula
 
27
> 
 
28
> flush(stderr()); flush(stdout())
 
29
> 
 
30
> ### Name: Formula
 
31
> ### Title: Extended Formulas: Multiple Responses and Multiple Regressor
 
32
> ###   Parts
 
33
> ### Aliases: Formula formula.Formula as.Formula as.Formula.default
 
34
> ###   as.Formula.formula as.Formula.Formula is.Formula print.Formula
 
35
> ###   update.Formula length.Formula all.equal.Formula
 
36
> ### Keywords: classes
 
37
> 
 
38
> ### ** Examples
 
39
> 
 
40
> ## create a simple Formula with one response and two regressor parts
 
41
> f1 <- y ~ x1 + x2 | z1 + z2 + z3
 
42
> F1 <- Formula(f1)
 
43
> class(F1)
 
44
[1] "Formula" "formula"
 
45
> length(F1)
 
46
[1] 1 2
 
47
> 
 
48
> ## switch back to original formula
 
49
> formula(F1)
 
50
y ~ x1 + x2 | z1 + z2 + z3
 
51
> 
 
52
> ## create formula with various transformations
 
53
> formula(F1, rhs = 1)
 
54
y ~ x1 + x2
 
55
> formula(F1, collapse = TRUE)
 
56
y ~ x1 + x2 + (z1 + z2 + z3)
 
57
> formula(F1, lhs = 0, rhs = 2)
 
58
~z1 + z2 + z3
 
59
> 
 
60
> ## put it together from its parts
 
61
> as.Formula(y ~ x1 + x2, ~ z1 + z2 + z3)
 
62
y ~ x1 + x2 | z1 + z2 + z3
 
63
> 
 
64
> ## update the formula
 
65
> update(F1, . ~ . + I(x1^2) | . - z2 - z3)
 
66
y ~ x1 + x2 + I(x1^2) | z1
 
67
> update(F1, . | y2 + y3 ~ .)
 
68
y | y2 + y3 ~ x1 + x2 | z1 + z2 + z3
 
69
> 
 
70
> # create a multi-response multi-part formula
 
71
> f2 <- y1 | y2 + y3 ~ x1 + I(x2^2) | 0 + log(x1) | x3 / x4
 
72
> F2 <- Formula(f2)
 
73
> length(F2)
 
74
[1] 2 3
 
75
> 
 
76
> ## obtain various subsets using standard indexing
 
77
> ## no lhs, first/seconde rhs
 
78
> formula(F2, lhs = 0, rhs = 1:2)
 
79
~x1 + I(x2^2) | 0 + log(x1)
 
80
> formula(F2, lhs = 0, rhs = -3)
 
81
~x1 + I(x2^2) | 0 + log(x1)
 
82
> formula(F2, lhs = 0, rhs = c(TRUE, TRUE, FALSE))
 
83
~x1 + I(x2^2) | 0 + log(x1)
 
84
> ## first lhs, third rhs
 
85
> formula(F2, lhs = c(TRUE, FALSE), rhs = 3)
 
86
y1 ~ x3/x4
 
87
> 
 
88
> 
 
89
> 
 
90
> cleanEx()
 
91
> nameEx("model.frame.Formula")
 
92
> ### * model.frame.Formula
 
93
> 
 
94
> flush(stderr()); flush(stdout())
 
95
> 
 
96
> ### Name: model.frame.Formula
 
97
> ### Title: Model Frame/Matrix/Response Construction for Extended Formulas
 
98
> ### Aliases: terms.Formula model.matrix.Formula model.frame.Formula
 
99
> ###   model.part model.part.formula model.part.Formula
 
100
> ### Keywords: models
 
101
> 
 
102
> ### ** Examples
 
103
> 
 
104
> ## artificial example data
 
105
> set.seed(1090)
 
106
> dat <- as.data.frame(matrix(round(runif(21), digits = 2), ncol = 7))
 
107
> colnames(dat) <- c("y1", "y2", "y3", "x1", "x2", "x3", "x4")
 
108
> for(i in c(2, 6:7)) dat[[i]] <- factor(dat[[i]] > 0.5, labels = c("a", "b"))
 
109
> dat$y2[1] <- NA
 
110
> dat
 
111
    y1   y2   y3   x1   x2 x3 x4
 
112
1 0.82 <NA> 0.27 0.09 0.22  b  a
 
113
2 0.70    b 0.17 0.26 0.46  a  a
 
114
3 0.65    a 0.28 0.03 0.37  b  b
 
115
> 
 
116
> ######################################
 
117
> ## single response and two-part RHS ##
 
118
> ######################################
 
119
> 
 
120
> ## single response with two-part RHS
 
121
> F1 <- Formula(log(y1) ~ x1 + x2 | I(x1^2))
 
122
> length(F1)
 
123
[1] 1 2
 
124
> 
 
125
> ## set up model frame
 
126
> mf1 <- model.frame(F1, data = dat)
 
127
> mf1
 
128
     log(y1)   x1   x2 I(x1^2)
 
129
1 -0.1984509 0.09 0.22  0.0081
 
130
2 -0.3566749 0.26 0.46  0.0676
 
131
3 -0.4307829 0.03 0.37   9e-04
 
132
> 
 
133
> ## extract single response
 
134
> model.part(F1, data = mf1, lhs = 1, drop = TRUE)
 
135
         1          2          3 
 
136
-0.1984509 -0.3566749 -0.4307829 
 
137
> model.response(mf1)
 
138
         1          2          3 
 
139
-0.1984509 -0.3566749 -0.4307829 
 
140
> ## model.response() works as usual
 
141
> 
 
142
> ## extract model matrices
 
143
> model.matrix(F1, data = mf1, rhs = 1)
 
144
  (Intercept)   x1   x2
 
145
1           1 0.09 0.22
 
146
2           1 0.26 0.46
 
147
3           1 0.03 0.37
 
148
attr(,"assign")
 
149
[1] 0 1 2
 
150
> model.matrix(F1, data = mf1, rhs = 2)
 
151
  (Intercept) I(x1^2)
 
152
1           1  0.0081
 
153
2           1  0.0676
 
154
3           1  0.0009
 
155
attr(,"assign")
 
156
[1] 0 1
 
157
> 
 
158
> #########################################
 
159
> ## multiple responses and multiple RHS ##
 
160
> #########################################
 
161
> 
 
162
> ## set up Formula
 
163
> F2 <- Formula(y1 + y2 | log(y3) ~ x1 + I(x2^2) | 0 + log(x1) | x3 / x4)
 
164
> length(F2)
 
165
[1] 2 3
 
166
> 
 
167
> ## set up full model frame
 
168
> mf2 <- model.frame(F2, data = dat)
 
169
> mf2
 
170
    y1 y2   log(y3)   x1 I(x2^2)   log(x1) x3 x4
 
171
2 0.70  b -1.771957 0.26  0.2116 -1.347074  a  a
 
172
3 0.65  a -1.272966 0.03  0.1369 -3.506558  b  b
 
173
> 
 
174
> ## extract responses
 
175
> model.part(F2, data = mf2, lhs = 1)
 
176
    y1 y2
 
177
2 0.70  b
 
178
3 0.65  a
 
179
> model.part(F2, data = mf2, lhs = 2)
 
180
    log(y3)
 
181
2 -1.771957
 
182
3 -1.272966
 
183
> ## model.response(mf2) does not give correct results!
 
184
> 
 
185
> ## extract model matrices
 
186
> model.matrix(F2, data = mf2, rhs = 1)
 
187
  (Intercept)   x1 I(x2^2)
 
188
2           1 0.26  0.2116
 
189
3           1 0.03  0.1369
 
190
attr(,"assign")
 
191
[1] 0 1 2
 
192
> model.matrix(F2, data = mf2, rhs = 2)
 
193
    log(x1)
 
194
2 -1.347074
 
195
3 -3.506558
 
196
attr(,"assign")
 
197
[1] 1
 
198
> model.matrix(F2, data = mf2, rhs = 3)
 
199
  (Intercept) x3b x3a:x4b x3b:x4b
 
200
2           1   0       0       0
 
201
3           1   1       0       1
 
202
attr(,"assign")
 
203
[1] 0 1 2 2
 
204
attr(,"contrasts")
 
205
attr(,"contrasts")$x3
 
206
[1] "contr.treatment"
 
207
 
 
208
attr(,"contrasts")$x4
 
209
[1] "contr.treatment"
 
210
 
 
211
> 
 
212
> #######################
 
213
> ## Formulas with '.' ##
 
214
> #######################
 
215
> 
 
216
> ## set up Formula
 
217
> F3 <- Formula(y1 | y2 ~ .)
 
218
> mf3 <- model.frame(F3, data = dat)
 
219
> ## without y1 or y2
 
220
> model.matrix(F3, data = mf3)
 
221
  (Intercept)   y3   x1   x2 x3b x4b
 
222
2           1 0.17 0.26 0.46   0   0
 
223
3           1 0.28 0.03 0.37   1   1
 
224
attr(,"assign")
 
225
[1] 0 1 2 3 4 5
 
226
attr(,"contrasts")
 
227
attr(,"contrasts")$x3
 
228
[1] "contr.treatment"
 
229
 
 
230
attr(,"contrasts")$x4
 
231
[1] "contr.treatment"
 
232
 
 
233
> ## without y1 but with y2
 
234
> model.matrix(F3, data = mf3, lhs = 1)
 
235
  (Intercept) y2b   y3   x1   x2 x3b x4b
 
236
2           1   1 0.17 0.26 0.46   0   0
 
237
3           1   0 0.28 0.03 0.37   1   1
 
238
attr(,"assign")
 
239
[1] 0 1 2 3 4 5 6
 
240
attr(,"contrasts")
 
241
attr(,"contrasts")$y2
 
242
[1] "contr.treatment"
 
243
 
 
244
attr(,"contrasts")$x3
 
245
[1] "contr.treatment"
 
246
 
 
247
attr(,"contrasts")$x4
 
248
[1] "contr.treatment"
 
249
 
 
250
> ## without y2 but with y1
 
251
> model.matrix(F3, data = mf3, lhs = 2)
 
252
  (Intercept)   y1   y3   x1   x2 x3b x4b
 
253
2           1 0.70 0.17 0.26 0.46   0   0
 
254
3           1 0.65 0.28 0.03 0.37   1   1
 
255
attr(,"assign")
 
256
[1] 0 1 2 3 4 5 6
 
257
attr(,"contrasts")
 
258
attr(,"contrasts")$x3
 
259
[1] "contr.treatment"
 
260
 
 
261
attr(,"contrasts")$x4
 
262
[1] "contr.treatment"
 
263
 
 
264
> 
 
265
> ##############################
 
266
> ## Process multiple offsets ##
 
267
> ##############################
 
268
> 
 
269
> ## set up Formula
 
270
> F4 <- Formula(y1 ~ x3 + offset(x1) | x4 + offset(log(x2)))
 
271
> mf4 <- model.frame(F4, data = dat)
 
272
> ## model.part can be applied as above and includes offset!
 
273
> model.part(F4, data = mf4, rhs = 1)
 
274
  x3 offset(x1)
 
275
1  b       0.09
 
276
2  a       0.26
 
277
3  b       0.03
 
278
> ## additionally, the corresponding corresponding terms can be included
 
279
> model.part(F4, data = mf4, rhs = 1, terms = TRUE)
 
280
  x3 offset(x1)
 
281
1  b       0.09
 
282
2  a       0.26
 
283
3  b       0.03
 
284
> ## hence model.offset() can be applied to extract offsets
 
285
> model.offset(model.part(F4, data = mf4, rhs = 1, terms = TRUE))
 
286
[1] 0.09 0.26 0.03
 
287
> model.offset(model.part(F4, data = mf4, rhs = 2, terms = TRUE))
 
288
[1] -1.5141277 -0.7765288 -0.9942523
 
289
> 
 
290
> 
 
291
> 
 
292
> ### * <FOOTER>
 
293
> ###
 
294
> base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
 
295
Time elapsed:  0.452 0.02 0.514 0 0 
 
296
> grDevices::dev.off()
 
297
null device 
 
298
          1 
 
299
> ###
 
300
> ### Local variables: ***
 
301
> ### mode: outline-minor ***
 
302
> ### outline-regexp: "\\(> \\)?### [*]+" ***
 
303
> ### End: ***
 
304
> quit('no')