R : Copyright 2005, The R Foundation for Statistical Computing
Version 2.1.1  (2005-06-20), ISBN 3-900051-07-0

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for a HTML browser interface to help.
Type 'q()' to quit R.

> ### * <HEADER>
> ###
> attach(NULL, name = "CheckExEnv")
> assign(".CheckExEnv", as.environment(2), pos = length(search())) # base
> ## add some hooks to label plot pages for base and grid graphics
> setHook("plot.new", ".newplot.hook")
> setHook("persp", ".newplot.hook")
> setHook("grid.newpage", ".gridplot.hook")
> 
> assign("cleanEx",
+        function(env = .GlobalEnv) {
+ 	   rm(list = ls(envir = env, all.names = TRUE), envir = env)
+            RNGkind("default", "default")
+ 	   set.seed(1)
+    	   options(warn = 1)
+ 	   delayedAssign("T", stop("T used instead of TRUE"),
+ 		  assign.env = .CheckExEnv)
+ 	   delayedAssign("F", stop("F used instead of FALSE"),
+ 		  assign.env = .CheckExEnv)
+ 	   sch <- search()
+ 	   newitems <- sch[! sch %in% .oldSearch]
+ 	   for(item in rev(newitems))
+                eval(substitute(detach(item), list(item=item)))
+ 	   missitems <- .oldSearch[! .oldSearch %in% sch]
+ 	   if(length(missitems))
+ 	       warning("items ", paste(missitems, collapse=", "),
+ 		       " have been removed from the search path")
+        },
+        env = .CheckExEnv)
> assign("..nameEx", "__{must remake R-ex/*.R}__", env = .CheckExEnv) # for now
> assign("ptime", proc.time(), env = .CheckExEnv)
> grDevices::postscript("modeltools-Examples.ps")
> assign("par.postscript", graphics::par(no.readonly = TRUE), env = .CheckExEnv)
> options(contrasts = c(unordered = "contr.treatment", ordered = "contr.poly"))
> options(warn = 1)    
> library('modeltools')
> 
> assign(".oldSearch", search(), env = .CheckExEnv)
> assign(".oldNS", loadedNamespaces(), env = .CheckExEnv)
> cleanEx(); ..nameEx <- "ModelEnv-class"
> 
> ### * ModelEnv-class
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: ModelEnv-class
> ### Title: Class "ModelEnv"
> ### Aliases: ModelEnv-class clone,ModelEnv-method clone
> ###   dimension,ModelEnv,character-method dimension
> ###   has,ModelEnv,character-method has initialize,ModelEnv-method
> ###   show,ModelEnv-method subset,ModelEnv-method subset
> ###   na.pass,ModelEnv-method na.pass na.fail,ModelEnv-method na.fail
> ###   na.omit,ModelEnv-method na.omit
> ### Keywords: classes
> 
> ### ** Examples
> 
> 
> ### a new object
> me <- new("ModelEnv")
> 
> ### define a bivariate response variable
> me@set("response", data.frame(y = rnorm(10), x = runif(10)))
> me

A ModelEnv with 

  response variable(s):   y x 
  number of observations: 10 

> 
> ### check if a response is available
> has(me, "response")
[1] TRUE
> 
> ### the dimensions
> dimension(me, "response")
[1] 10  2
> 
> ### extract the data
> me@get("response")
            y          x
1  -0.6264538 0.93470523
2   0.1836433 0.21214252
3  -0.8356286 0.65167377
4   1.5952808 0.12555510
5   0.3295078 0.26722067
6  -0.8204684 0.38611409
7   0.4874291 0.01339033
8   0.7383247 0.38238796
9   0.5757814 0.86969085
10 -0.3053884 0.34034900
> 
> ### NA handling
> df <- data.frame(x = rnorm(10), y = rnorm(10))
> df$x[1] <- NA
> mf <- ModelEnvFormula(x ~ y, data = df, na.action = na.pass)
> mf

A ModelEnvFormula with 

  response variable(s):   x 
  input variable(s):      y 
  number of observations: 10 

> na.omit(mf)

A ModelEnvFormula with 

  response variable(s):   x 
  input variable(s):      y 
  number of observations: 9 

> 
> 
> 
> 
> cleanEx(); ..nameEx <- "ModelEnvFormula"
> 
> ### * ModelEnvFormula
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: ModelEnvFormula
> ### Title: Generate a model environment from a classical formula based
> ###   interface.
> ### Aliases: ModelEnvFormula
> ### Keywords: misc
> 
> ### ** Examples
> 
> 
> ### the `usual' interface
> data(iris)
> mf <- ModelEnvFormula(Species ~ ., data = iris)
> mf

A ModelEnvFormula with 

  response variable(s):   Species 
  input variable(s):      Sepal.Length Sepal.Width Petal.Length Petal.Width 
  number of observations: 150 

> 
> ### extract data from the ModelEnv object
> summary(mf@get("response"))
       Species  
 setosa    :50  
 versicolor:50  
 virginica :50  
> summary(mf@get("input"))
  Sepal.Length    Sepal.Width     Petal.Length    Petal.Width   
 Min.   :4.300   Min.   :2.000   Min.   :1.000   Min.   :0.100  
 1st Qu.:5.100   1st Qu.:2.800   1st Qu.:1.600   1st Qu.:0.300  
 Median :5.800   Median :3.000   Median :4.350   Median :1.300  
 Mean   :5.843   Mean   :3.057   Mean   :3.758   Mean   :1.199  
 3rd Qu.:6.400   3rd Qu.:3.300   3rd Qu.:5.100   3rd Qu.:1.800  
 Max.   :7.900   Max.   :4.400   Max.   :6.900   Max.   :2.500  
> dim(mf@get("designMatrix"))
[1] 150   5
> 
> ### contrasts
> mf <- ModelEnvFormula(Petal.Width ~ Species, data = iris, 
+                       contrasts.arg = list(Species = contr.treatment))
Warning in model.matrix.default(mt, data = MF, ...) : 
	 variable 'Species' is absent, its contrast will be ignored
> attr(mf@get("designMatrix"), "contrasts")
$Species
           2 3
setosa     0 0
versicolor 1 0
virginica  0 1

> mf <- ModelEnvFormula(Petal.Width ~ Species, data = iris, 
+                       contrasts.arg = list(Species = contr.sum))
Warning in model.matrix.default(mt, data = MF, ...) : 
	 variable 'Species' is absent, its contrast will be ignored
> attr(mf@get("designMatrix"), "contrasts")
$Species
           [,1] [,2]
setosa        1    0
versicolor    0    1
virginica    -1   -1

> 
> ### additional formulae
> mf <- ModelEnvFormula(Petal.Width ~ Species, data = iris, 
+                       other = list(pl = ~ Petal.Length))
> ls(mf@env)
[1] "designMatrix"   "input"          "pl"             "response"      
[5] "responseMatrix"
> identical(mf@get("pl")[[1]], iris[["Petal.Length"]])
[1] TRUE
> 
> 
> 
> 
> cleanEx(); ..nameEx <- "Predict"
> 
> ### * Predict
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: Predict
> ### Title: Model Predictions
> ### Aliases: Predict
> ### Keywords: misc
> 
> ### ** Examples
> 
> 
> df <- data.frame(x = runif(10), y = rnorm(10))
> mf <- dpp(linearModel, y ~ x, data = df)
> Predict(fit(linearModel, mf))
          1           2           3           4           5           6 
-0.02888824  0.01417367  0.09524834  0.23069807 -0.05466788  0.22673253 
          7           8           9          10 
 0.24542729  0.13076912  0.11797205 -0.11117176 
> 
> 
> 
> 
> cleanEx(); ..nameEx <- "StatModel-class"
> 
> ### * StatModel-class
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: StatModel-class
> ### Title: Class "StatModel"
> ### Aliases: StatModel-class linearModel fit,StatModel,ModelEnv-method fit
> ###   dpp,StatModel-method dpp
> ### Keywords: classes
> 
> ### ** Examples
> 
> 
>   ### linear model example
>   df <- data.frame(x = runif(10), y = rnorm(10))
>   mf <- dpp(linearModel, y ~ x, data = df)
>   mylm <- fit(linearModel, mf)
> 
>   ### the same
>   print(mylm)

Call:
NULL

Coefficients:
(Intercept)            x  
    -0.1361       0.4039  

>   lm(y ~ x, data = df)

Call:
lm(formula = y ~ x, data = df)

Coefficients:
(Intercept)            x  
    -0.1361       0.4039  

> 
>   ### predictions
>   Predict(mylm, newdata =  data.frame(x = runif(10)))
          1           2           3           4           5           6 
 0.05858501  0.10603751  0.06321419 -0.06091392  0.19804901  0.13386661 
          7           8           9          10 
 0.18466640 -0.09252880  0.15617975  0.02998658 
> 
> 
> 
> 
> ### * <FOOTER>
> ###
> cat("Time elapsed: ", proc.time() - get("ptime", env = .CheckExEnv),"\n")
Time elapsed:  0.66 0.02 0.7 0 0 
> grDevices::dev.off()
null device 
          1 
> ###
> ### Local variables: ***
> ### mode: outline-minor ***
> ### outline-regexp: "\\(> \\)?### [*]+" ***
> ### End: ***
> quit('no')