fRegression/0000755000176000001440000000000012261241424012566 5ustar ripleyusersfRegression/inst/0000755000176000001440000000000012251673344013554 5ustar ripleyusersfRegression/inst/COPYRIGHT.html0000644000176000001440000002041111370220736016002 0ustar ripleyusers Rmetrics::COPYRIGHT

Rmetrics Copyrights

2005-12-18 Built 221.10065 

  
________________________________________________________________________________
Copyrights (C) for 

    R:  
      see R's copyright and license file
      
    Version R 2.0.0 claims:
    - The stub packages from 1.9.x have been removed.
    - All the datasets formerly in packages 'base' and 'stats' have
      been moved to a new package 'datasets'. 
    - Package 'graphics' has been split into 'grDevices' (the graphics
      devices shared between base and grid graphics) and 'graphics'
      (base graphics). 
    - Packages must have been re-installed for this version, and
      library() will enforce this.
    - Package names must now be given exactly in library() and
      require(), regardless of whether the underlying file system is
      case-sensitive or not.    

________________________________________________________________________________
for 
    
    Rmetrics:
      (C) 1999-2005, Diethelm Wuertz, GPL
      Diethelm Wuertz 
      www.rmetrics.org
      info@rmetrics.org
 
________________________________________________________________________________
for non default loaded basic packages part of R's basic distribution

    MASS:    
      Main Package of Venables and Ripley's MASS.
      We assume that MASS is available. 
      Package 'lqs' has been returned to 'MASS'.  
      S original by Venables & Ripley.
      R port by Brian Ripley .
      Earlier work by Kurt Hornik and Albrecht Gebhardt.
    methods: 
      Formally defined methods and classes for R objects, plus other 
      programming tools, as described in the reference "Programming 
      with Data" (1998), John M. Chambers, Springer NY. 
      R Development Core Team.
    mgcv:   
      Routines for GAMs and other generalized ridge regression
      with multiple smoothing parameter selection by GCV or UBRE.
      Also GAMMs by REML or PQL. Includes a gam() function.
      Simon Wood 
    nnet: 
      Feed-forward Neural Networks and Multinomial Log-Linear Models
      Original by Venables & Ripley. 
      R port by Brian Ripley .
      Earlier work by Kurt Hornik and Albrecht Gebhardt.
      
________________________________________________________________________________
for the code partly included as builtin functions from other R ports:

    fBasics:CDHSC.F
      GRASS program for distributional testing.
      By James Darrell McCauley 
      Original Fortran Source by Paul Johnson EZ006244@ALCOR.UCDAVIS.EDU>
    fBasics:nortest
      Five omnibus tests for the composite hypothesis of normality
      R-port by Juergen Gross 
    fBasics:SYMSTB.F
      Fast numerical approximation to the Symmetric Stable distribution 
      and density functions.  
      By Hu McCulloch 
    fBasics:tseries
      Functions for time series analysis and computational finance.
      Compiled by Adrian Trapletti 
         
    fCalendar:date     
      The tiny C program from Terry Therneau  is used
      R port by Th. Lumley ,
      K. Halvorsen , and 
      Kurt Hornik 
    fCalendar:holidays
      The holiday information was collected from the internet and 
      governmental sources obtained from a few dozens of websites
    fCalendar:libical
      Libical is an Open Source implementation of the IETF's 
      iCalendar Calendaring and Scheduling protocols. (RFC 2445, 2446, 
      and 2447). It parses iCal components and provides a C API for 
      manipulating the component properties, parameters, and subcomponents.
    fCalendar:vtimezone
      Olsen's VTIMEZONE database consists of data files are released under 
      the GNU General Public License, in keeping with the license options of 
      libical. 
     
    fSeries:bdstest.c
      C Program to compute the BDS Test.
      Blake LeBaron
    fSeries:fracdiff  
      R functions, help pages and the Fortran Code for the 'fracdiff' 
      function are included. 
      S original by Chris Fraley 
      R-port by Fritz Leisch 
      since 2003-12: Martin Maechler
    fSeries:lmtest
      R functions and help pages for the linear modelling tests are included .
      Compiled by Torsten Hothorn ,
      Achim Zeileis , and
      David Mitchell
    fSeries:mda    
      R functions, help pages and the Fortran Code for the 'mars' function
      are implemeted.
      S original by Trevor Hastie & Robert Tibshirani,
      R port by Friedrich Leisch, Kurt Hornik and Brian D. Ripley 
    fSeries:modreg
      Brian Ripley and the R Core Team
    fSeries:polspline   
      R functions, help pages and the C/Fortran Code for the 'polymars' 
      function are implemented
      Charles Kooperberg 
    fSeries:systemfit
      Simultaneous Equation Estimation Package.
      R port by Jeff D. Hamann  and 
      Arne Henningsen 
    fSeries:tseries
      Functions for time series analysis and computational finance.
      Compiled by Adrian Trapletti 
    fSeries:UnitrootDistribution:
      The program uses the Fortran routine and the tables 
      from J.G. McKinnon. 
    fSeries:urca
      Unit root and cointegration tests for time series data.
      R port by Bernhard Pfaff .
     
    fExtremes:evd
      Functions for extreme value distributions.
      R port by Alec Stephenson 
      Function 'fbvpot' by Chris Ferro.
    fExtremes:evir
      Extreme Values in R
      Original S functions (EVIS) by Alexander McNeil 
      R port by Alec Stephenson   
    fExtremes:ismev
      An Introduction to Statistical Modeling of Extreme Values
      Original S functions by Stuart Coles 
      R port/documentation by Alec Stephenson 
      
    fOptions
      Option Pricing formulas are implemented along the book and 
      the Excel spreadsheets of E.G. Haug, "The Complete Guide to Option 
      Pricing"; documentation is partly taken from www.derivicom.com which 
      implements a C Library based on Haug. For non-academic and commercial 
      use we recommend the professional software from "www.derivicom.com".  
    fOptions:SOBOL.F
      ACM Algorithm 659 by P. Bratley and B.L. Fox
      Extension on Algorithm 659 by S. Joe and F.Y. Kuo
    fOptions:CGAMA.F
      Complex gamma and related functions.
      Fortran routines by Jianming Jin.
    fOptions:CONHYP.F
      Confluenet Hypergeometric and related functions.
      ACM Algorithm 707 by mark Nardin, W.F. Perger, A. Bhalla
             
    fPortfolio:mvtnorm
      Multivariate Normal and T Distribution.
      Alan Genz , 
      Frank Bretz 
      R port by Torsten Hothorn 
    fPortfolio:quadprog
      Functions to solve Quadratic Programming Problems.
      S original by Berwin A. Turlach  
      R port by Andreas Weingessel 
    fPortfolio:sn
      The skew-normal and skew-t distributions.
      R port by Adelchi Azzalini 
    fPortfolio:tseries
      Functions for time series analysis and computational finance.
      Compiled by Adrian Trapletti
fRegression/inst/unitTests/0000755000176000001440000000000012256322055015551 5ustar ripleyusersfRegression/inst/unitTests/Makefile0000644000176000001440000000042311370220736017207 0ustar ripleyusersPKG=fRegression TOP=../.. SUITE=doRUnit.R R=R all: inst test inst: # Install package -- but where ?? -- will that be in R_LIBS ? cd ${TOP}/..;\ ${R} CMD INSTALL ${PKG} test: # Run unit tests export RCMDCHECK=FALSE;\ cd ${TOP}/tests;\ ${R} --vanilla --slave < ${SUITE}fRegression/inst/unitTests/runit.regFit.R0000644000176000001440000001316411370220736020260 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTION: REGRESSION MODELLING DESCRIPTION: # regFit Wrapper Function for Regression Models ################################################################################ test.lmFit <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Fit Parameters: lmfit = regFit(Y ~ X1 + X2 + X3, data = x, use = "lm") print(lmfit) summary(lmfit) # plot(lmfit) fitted(lmfit) slot(lmfit, "fitted") residuals(lmfit) slot(lmfit, "residuals") coef(lmfit) formula(lmfit) predict(lmfit) # Return Value: return() } # ------------------------------------------------------------------------------ test.rlmFit <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Fit Parameters: rlmfit = regFit(Y ~ X1 + X2 + X3, data = x, use = "rlm") print(rlmfit) summary(rlmfit) # plot(rlmfit) fitted(rlmfit) slot(rlmfit, "fitted") residuals(rlmfit) slot(rlmfit, "residuals") coef(rlmfit) formula(rlmfit) predict(rlmfit) head(rlmfit@fit$model) # Return Value: return() } # ------------------------------------------------------------------------------ test.glmFit <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Fit Parameters: glmfit = regFit(Y ~ X1 + X2 + X3, data = x, use = "glm") print(glmfit) summary(glmfit) # plot(glmfit) print(glmfit@fit) summary(glmfit@fit) fitted(glmfit) slot(glmfit, "fitted") residuals(glmfit) slot(glmfit, "residuals") coef(glmfit) formula(glmfit) predict(glmfit) # Return Value: return() } # ------------------------------------------------------------------------------ test.gamFit <- function() { # Simulate Artificial LM: x = regSim(model = "GAM3", n = 50) # Fit Parameters: gamfit = regFit(Y ~ s(X1) + s(X2) + X3, data = x, use = "gam") print(gamfit) summary(gamfit) # plot(gamfit) print(gamfit@fit) summary(gamfit@fit) fitted(gamfit) slot(gamfit, "fitted") residuals(gamfit) slot(gamfit, "residuals") coef(gamfit) formula(gamfit) predict(gamfit) gamfit@fit$terms # Return Value: return() } # ------------------------------------------------------------------------------ test.pprFit <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Fit Parameters: pprfit = regFit(Y ~ X1 + X2 + X3, data = x, use = "ppr") ppr = ppr(Y ~ X1 + X2 + X3, data = x, nterms = 2) print(pprfit) summary(pprfit) # plot(pprfit) print(pprfit@fit) summary(pprfit@fit) fitted(pprfit) slot(pprfit, "fitted") residuals(pprfit) slot(pprfit, "residuals") coef(pprfit) formula(pprfit) predict(pprfit) pprfit@fit$terms # Return Value: return() } # ------------------------------------------------------------------------------ test.nnetFit <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Fit Parameters: nnetfit = regFit(Y ~ X1 + X2 + X3, data = x, use = "nnet") print(nnetfit) summary(nnetfit) # plot(nnetfit) print(nnetfit@fit) summary(nnetfit@fit) fitted(nnetfit) slot(nnetfit, "fitted") residuals(nnetfit) slot(nnetfit, "residuals") coef(nnetfit) formula(nnetfit) predict(nnetfit) nnetfit@fit$terms # Return Value: return() } # ------------------------------------------------------------------------------ test.polymarsFit <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Fit Parameters: polymarsfit = regFit(Y ~ X1 + X2 + X3, data = x, use = "polymars") print(polymarsfit) summary(polymarsfit) fitted(polymarsfit) slot(polymarsfit, "fitted") residuals(polymarsfit) slot(polymarsfit, "residuals") coef(polymarsfit) formula(polymarsfit) predict(polymarsfit) polymarsfit@fit$terms # Return Value: return() } ################################################################################ fRegression/inst/unitTests/runit.RegressionModelling.R0000644000176000001440000002751412256322055023020 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTION: REGRESSION MODELLING DESCRIPTION: # 'fREG' S4 Class Representation # regSim Returns a regression example data set # S3-METHODS: DESCRIPTION: # print.fREG Prints results from a regression model fit # plot.fREG Plots fit and diagnostics for a regression model # summary.fREG Summarizes fit and diagnostics for a regression model # S3-METHODS: DESCRIPTION: # predict.fREG Predicts values from a fitted regression model # coefficients.fREG Returns coefficients from a fitted regression model # fitted.fREG Returns fitted values from a fitted regression model # residulals.fREG Returns residuals from a fitted regression model # vcov.fREG Returns variance-covariance matrix from a fitted model ################################################################################ test.regSim <- function() { # Plot Parameters: par(ask = FALSE) par(mfrow = c(3, 1)) # Simulate Artificial LM: X = regSim(model = "LM3", n = 365) head(X) plot(X[, "Y"], type = "l", main = "LM3", xlab = "1970", ylab = "Y") # Simulate Artificial LOGIT: X = regSim(model = "LOGIT3", n = 365) head(X) plot(X[, "Y"], type = "l", main = "LOGIT3", xlab = "1970", ylab = "Y") # Simulate Artificial GAM: X = regSim(model = "GAM3", n = 365) head(X) plot(X[, "Y"], type = "l", main = "GAM3", xlab = "1970", ylab = "Y") # Return Value: return() } # ------------------------------------------------------------------------------ test.regFit.dataframe <- function() { # Working with timeSeries Objects ... DATA = regSim(model = "GAM3", n = 100) head(DATA) class(DATA) # Regression Fit: LM = regFit(Y ~ X1 + X2, data = DATA, use = "lm") RLM = regFit(Y ~ X1 + X2, data = DATA, use = "rlm") AM = regFit(Y ~ X1 + X2, data = DATA, use = "gam") PPR = regFit(Y ~ X1 + X2, data = DATA, use = "ppr") POLYMARS = regFit(Y ~ X1 + X2, data = DATA, use = "polymars") NNET = regFit(Y ~ X1 + X2, data = DATA, use = "nnet") # ... a note on AM the smoothing functions are added by default! # this is different to gam() # Print Method: print(LM) print(RLM) print(AM) print(PPR) print(POLYMARS) print(NNET) # Plot Method: par(ask = FALSE) par(mfrow = c(1, 1)) # plot(LM, which = "all") # CHECK which !!! # plot(RLM, which = "all") # plot(AM, which = "all") # plot(PPR, which = "all") # plot(POLYMARS, which = "all") # plot(NNET, which = "all") # Summary Method: summary(LM) summary(RLM) summary(AM) summary(PPR) summary(POLYMARS) summary(NNET) # Return Value: return() } # ------------------------------------------------------------------------------ test.regFit.valueSlots <- function() { # Working with timeSeries Objects ... DATA = regSim(model = "GAM3", n = 100) head(DATA) class(DATA) # Modelling: LM = regFit(Y ~ X1 + X2, data = DATA, use = "lm") RLM = regFit(Y ~ X1 + X2, data = DATA, use = "rlm") AM = regFit(Y ~ s(X1) + s(X2), DATA, use = "gam") PPR = regFit(Y ~ X1 + X2, data = DATA, use = "ppr") POLYMARS = regFit(Y ~ X1 + X2, data = DATA, use = "polymars") NNET = regFit(Y ~ X1 + X2, data = DATA, use = "nnet") # Extract: # call = "call" # formula = "formula" # family = "character" # method = "character" # data = "data.frame" # fit = "list" # residuals = "timeSeries" # fitted.values = "timeSeries" # title = "character" # description = "character" LM@call RLM@call AM@call PPR@call POLYMARS@call NNET@call LM@formula RLM@formula AM@formula # CHECK !!! PPR@formula POLYMARS@formula NNET@formula LM@family[1:2] RLM@family[1:2] AM@family[1:2] PPR@family[1:2] POLYMARS@family[1:2] NNET@family[1:2] LM@method RLM@method AM@method PPR@method POLYMARS@method NNET@method # Note the residuals are time tmeSeries objects! print(LM@residuals[c(1,100)]) print(RLM@residuals[c(1,100)]) print(AM@residuals[c(1,100)]) print(PPR@residuals[c(1,100)]) print(POLYMARS@residuals[c(1,100)]) print(NNET@residuals[c(1,100)]) # Note the fitted values are time tmeSeries objects! print(LM@fitted[c(1,100)]) print(RLM@fitted[c(1,100)]) print(AM@fitted[c(1,100)]) print(PPR@fitted[c(1,100)]) print(POLYMARS@fitted[c(1,100)]) print(NNET@fitted[c(1,100)]) # Returns a Title, by default the name of the algorithm applied: LM@title RLM@title AM@title PPR@title POLYMARS@title NNET@title # Returns a Description, by default Date/Time and user: LM@description RLM@description AM@description PPR@description POLYMARS@description NNET@description # Return Value: return() } # ------------------------------------------------------------------------------ test.predict.fREG <- function() { # Working with timeSeries Objects ... DATA = regSim(model = "GAM3", n = 100) head(DATA) class(DATA) # Regression Fit: LM = regFit(Y ~ X1 + X2, data = DATA, use = "lm") RLM = regFit(Y ~ X1 + X2, data = DATA, use = "rlm") AM = regFit(Y ~ s(X1) + s(X2), DATA, use = "gam") PPR = regFit(Y ~ X1 + X2, data = DATA, use = "ppr") POLYMARS = regFit(Y ~ X1 + X2, data = DATA, use = "polymars") NNET = regFit(Y ~ X1 + X2, data = DATA, use = "nnet") # Just to rmember - Predict: # predict.fREG(object, newdata, se.fit = FALSE, type = "response", ...) # Selext some rows to predict: set.seed(4711) N = round(runif(5, 1, 100), 0) N # Predict Response: predict(LM, DATA[N, ]) predict(RLM, DATA[N, ]) predict(AM, DATA[N, ]) predict(PPR, DATA[N, ]) predict(POLYMARS, DATA[N, ]) predict(NNET, DATA[N, ]) # Predict Response: predict(LM, DATA[N, ], type = "response") predict(RLM, DATA[N, ], type = "response") predict(AM, DATA[N, ], type = "response") predict(PPR, DATA[N, ], type = "response") predict(POLYMARS, DATA[N, ], type = "response") predict(NNET, DATA[N, ], type = "response") # Predict Response with Standard Errors: predict(LM, DATA[N, ], se.fit = TRUE) predict(RLM, DATA[N, ], se.fit = TRUE) predict(AM, DATA[N, ], se.fit = TRUE) predict(PPR, DATA[N, ], se.fit = TRUE) predict(POLYMARS, DATA[N, ], se.fit = TRUE) predict(NNET, DATA[N, ], se.fit = TRUE) # Return Value: return() } # ------------------------------------------------------------------------------ test.regFit.nonDefaults <- function() { # Simulate Data - a data frame: DATA = regSim(model = "GAM3", n = 100) head(DATA) class(DATA) # Simulate Data - a timeSeries object: DATA = as.timeSeries(DATA) head(DATA) class(DATA) # LM: LM1 = regFit(Y ~ X1 + X2, DATA, use = "lm") print(LM1) LM2 = regFit(Y ~ 1 + X1 + X2, DATA) print(LM2) LM3 = regFit(Y ~ -1 + X1 + X2, DATA) print(LM3) LM4 = regFit(Y ~ X1 + log(X2), DATA) print(LM4) # AM: AM1 = regFit(Y ~ s(X1) + s(X2), data = DATA, use = "gam") print(AM1) # AM2 = regFit(Y ~ s(X1) + s(X2), DATA, "gam", # method = gam.method(pearson = TRUE)) # print(AM2) # PPR: par(ask = FALSE) par(mfrow = c(1, 1)) PPR1 = regFit(Y ~ sin(X1) + exp(X2), DATA, "ppr", nterms = 4, sm.method = "supsmu", use = "ppr") PPR2 = regFit(Y ~ sin(X1) + exp(X2), DATA, "ppr", nterms = 4, sm.method = "spline", use = "ppr") PPR3 = regFit(Y ~ sin(X1) + exp(X2), DATA, "ppr", nterms = 3, sm.method = "gcvspline", use = "ppr") ## termPlot(PPR1) ## termPlot(PPR2) ## termPlot(PPR3) # POLYMARS: POLYMARS = regFit(Y ~ X1 + X2 + X3, DATA, use = "polymars") POLYMARS = regFit(Y ~ X1*X2 + X2*X3 + X3*X1, DATA, use = "polymars") # NNET # todo ... # Return Value: return() } # ------------------------------------------------------------------------------ test.generalizedModels <- function() { # Generalized * Models: M1 = matrix(c( 1, 0.80, 0.83, 0.66, 1.9, 1.100, 0.996, 1, 0.90, 0.36, 0.32, 1.4, 0.740, 0.992, 0, 0.80, 0.88, 0.70, 0.8, 0.176, 0.982, 0, 1.00, 0.87, 0.87, 0.7, 1.053, 0.986, 1, 0.90, 0.75, 0.68, 1.3, 0.519, 0.980, 0, 1.00, 0.65, 0.65, 0.6, 0.519, 0.982, 1, 0.95, 0.97, 0.92, 1.0, 1.230, 0.992, 0, 0.95, 0.87, 0.83, 1.9, 1.354, 1.020, 0, 1.00, 0.45, 0.45, 0.8, 0.322, 0.999, 0, 0.95, 0.36, 0.34, 0.5, 0.000, 1.038, 0, 0.85, 0.39, 0.33, 0.7, 0.279, 0.988, 0, 0.70, 0.76, 0.53, 1.2, 0.146, 0.982, 0, 0.80, 0.46, 0.37, 0.4, 0.380, 1.006, 0, 0.20, 0.39, 0.08, 0.8, 0.114, 0.990, 0, 1.00, 0.90, 0.90, 1.1, 1.037, 0.990, 1, 1.00, 0.84, 0.84, 1.9, 2.064, 1.020, 0, 0.65, 0.42, 0.27, 0.5, 0.114, 1.014, 0, 1.00, 0.75, 0.75, 1.0, 1.322, 1.004, 0, 0.50, 0.44, 0.22, 0.6, 0.114, 0.990, 1, 1.00, 0.63, 0.63, 1.1, 1.072, 0.986, 0, 1.00, 0.33, 0.33, 0.4, 0.176, 1.010, 0, 0.90, 0.93, 0.84, 0.6, 1.591, 1.020, 1, 1.00, 0.58, 0.58, 1.0, 0.531, 1.002, 0, 0.95, 0.32, 0.30, 1.6, 0.886, 0.988, 1, 1.00, 0.60, 0.60, 1.7, 0.964, 0.990, 1, 1.00, 0.69, 0.69, 0.9, 0.398, 0.986, 0, 1.00, 0.73, 0.73, 0.7, 0.398, 0.986), byrow = TRUE, ncol = 7) colnames(M1) = c("Y", "X1", "X2", "X3", "X4", "X5", "X6") D1 = data.frame(M1) D1 # fit.glm = glm(Y ~ X1 + X2 + X3 + X4 + X5 + X6, data = D1, # family = binomial("logit")) # fit.gam = gam(Y ~ s(X1) + s(X2) + s(X3) + s(X4) + s(X5) + s(X6), # data = D1, family = binomial("logit")) M2 = matrix(c( 0,29,62, 0,30,83, 0,31,74, 0,31,88, 0,32,68, 1,29,41, 1,30,44, 1,31,21, 1,32,50, 1,33,33), byrow = TRUE, ncol = 3) colnames(M2) = c("Y", "X1", "X2") D2 = data.frame(M2) D2 plot (D2[1:5, "X1"], D2[1:5, "X2"], xlim = range(D2[, "X1"]), ylim = range(D2[, "X2"]), pch = 19, col = "blue") points(D2[6:10,"X1"], D2[6:10,"X2"], pch = 19, col = "red") U = range(D2[, "X1"]) V = 2*U - 6 lines(U, V, lty = 3, col = "grey") fit.glm = glm(Y ~ X1 + X2, data = D2, family = binomial("logit")) print(fit.glm) # Return Value: return() } ################################################################################ fRegression/inst/unitTests/runit.LPP2005.R0000644000176000001440000000306611370220736020002 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ test.Fit <- function() { # Simulate Artificial LM: x = as.timeSeries(data(LPP2005REC)) # Fit Parameters: lmfit = regFit(LPP40 ~ 0 + SPI + SBI + SII + LMI + MPI + ALT, data = x, use = "lm") # print(lmfit) # Return Value: return() } ################################################################################ fRegression/inst/unitTests/runit.polymars.R0000644000176000001440000001366011370220736020707 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTION: REGRESSION MODELLING DESCRIPTION: # polymars Polymars Regression # .polymars Polymars regress from package polspline # .polymarsDefault Internal Function # .polymarsVormula Internal Function # .predict.polymars Internal Function ################################################################################ test.polymars <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Original Polymars: fit = polspline::polymars(responses = x[,1], predictors = x[,2:4]) # Model Fitting: fit$fitting # Model Produced: fit$model fit$coef # Summary: # Note print.polymars = summary.polymars polspline::summary.polymars(fit) # Predict: ans = polspline::predict.polymars(object = fit, x = x[,-1]) as.vector(ans) as.vector(fit$fitted) # Return Value: return() } # ------------------------------------------------------------------------------ test.polymarsDefault <- function() { # Simulate Artificial LM: set.seed(4711) x = regSim(model = "LM3", n = 50) # Polymars Wrapper: fit1 = .polymarsDefault(responses = x[,1], predictors = x[, 2:4]) class(fit1) names(fit1) # Note, this fails: # fit1 = .polymars(responses = x[,1], predictors = x[,2:4]) # Model Fitting: fit1$fitting # Model Produced: # fit1$model reserved for model series, use ... fit1$coef # Summary: print(fit1) # Print: summary(fit1) # Predict: ans = polspline::predict.polymars(object = fit1, x = x[,-1]) as.vector(ans) as.vector(fit1$fitted) # Check: fit1$ranges.and.medians # Return Value: return() } # ------------------------------------------------------------------------------ test.polymarsFormula <- function() { # Simulate Artificial LM: set.seed(4711) x = regSim(model = "LM3", n = 50) # Polymars Formula Wrapper: fit2 = .polymarsFormula(formula = Y ~ X1 + X2 + X3, data = x) fit2 = .polymars(formula = Y ~ X1 + X2 + X3, data = x) class(fit2) names(fit2) # Model Fitting: fit2$fitting # Model Produced: # fit$model reserved for model series, use ... fit2$coef # Summary: print(fit2) # Print: summary(fit2) # Predict: fit2$model = fit2$coef ans = polspline::predict.polymars(object = fit2, x = x[,-1]) as.vector(ans) as.vector(fit2$fitted) # Check: fit2$ranges.and.medians # Return Value: return() } # ------------------------------------------------------------------------------ test.regFit.polymars <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Polymars Formula Wrapper: fit = regFit(formula = Y ~ X1 + X2 + X3, data = x, use = "polymars") class(fit) # Model Fitting: fit@fit$fitting # Model Produced: # fit$model reserved for model series, use ... fit@fit$coef # Summary: print(fit) # Print: summary(fit) # Return Value: return() } # ------------------------------------------------------------------------------ test.regFit.polymars.methods <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 20) # Polymars Formula Wrapper: polymarsfit = regFit(formula = Y ~ X1 + X2 + X3, data = x, use = "polymars") # Print: print(polymarsfit) # Summary: summary(polymarsfit) # Fitted Values: fitted(polymarsfit) slot(polymarsfit, "fitted") # Residuals: residuals(polymarsfit) slot(polymarsfit, "residuals") # Coefficients: coef(polymarsfit) # Formula formula(polymarsfit) # Return Value: return() } # ------------------------------------------------------------------------------ test.regFit.polymars.predict <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # regFit / Polymars Formula Wrapper: fit = regFit(formula = Y ~ X1 + X2 + X3, data = x, use = "polymars") class(fit) fit@fit$cmd # Predict from predict.polymars: object = fit@fit class(object) = "polymars" object object$model = object$coef ans = polspline::predict.polymars(object = object, x = x[,-1]) as.vector(ans) as.vector(fit@fitted) # Predict from predict.fREG: ans = predict(object = fit, newdata = x) as.vector(ans) as.vector(fit@fitted) # Return Value: return() } ################################################################################ fRegression/inst/unitTests/runTests.R0000644000176000001440000000453311370220736017527 0ustar ripleyuserspkg <- "fRegression" if(require("RUnit", quietly = TRUE)) { library(package=pkg, character.only = TRUE) if(!(exists("path") && file.exists(path))) path <- system.file("unitTests", package = pkg) ## --- Testing --- ## Define tests testSuite <- defineTestSuite(name = paste(pkg, "unit testing"), dirs = path) if(interactive()) { cat("Now have RUnit Test Suite 'testSuite' for package '", pkg, "' :\n", sep='') str(testSuite) cat('', "Consider doing", "\t tests <- runTestSuite(testSuite)", "\nand later", "\t printTextProtocol(tests)", '', sep = "\n") } else { ## run from shell / Rscript / R CMD Batch / ... ## Run tests <- runTestSuite(testSuite) if(file.access(path, 02) != 0) { ## cannot write to path -> use writable one tdir <- tempfile(paste(pkg, "unitTests", sep="_")) dir.create(tdir) pathReport <- file.path(tdir, "report") cat("RUnit reports are written into ", tdir, "/report.(txt|html)", sep = "") } else { pathReport <- file.path(path, "report") } ## Print Results: printTextProtocol(tests, showDetails = FALSE) printTextProtocol(tests, showDetails = FALSE, fileName = paste(pathReport, "Summary.txt", sep = "")) printTextProtocol(tests, showDetails = TRUE, fileName = paste(pathReport, ".txt", sep = "")) ## Print HTML Version to a File: ## printHTMLProtocol has problems on Mac OS X if (Sys.info()["sysname"] != "Darwin") printHTMLProtocol(tests, fileName = paste(pathReport, ".html", sep = "")) ## stop() if there are any failures i.e. FALSE to unit test. ## This will cause R CMD check to return error and stop tmp <- getErrors(tests) if(tmp$nFail > 0 | tmp$nErr > 0) { stop(paste("\n\nunit testing failed (#test failures: ", tmp$nFail, ", R errors: ", tmp$nErr, ")\n\n", sep="")) } } } else { cat("R package 'RUnit' cannot be loaded -- no unit tests run\n", "for package", pkg,"\n") } ################################################################################ fRegression/inst/unitTests/runit.TimeSeries.R0000644000176000001440000001163511370220736021112 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ test.lmCoef <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Convert to a timeSeries Object with Dummy Dates x = as.timeSeries(x) # Fit Parameters: fit = regFit(Y ~ X1 + X2 + X3, data = x, use = "lm") fit # Extract Fitted values: head(slot(fit, "fitted")) val = fitted(fit) head(val) class(val) # Extract Residuals: head(slot(fit, "residuals")) val = residuals(fit) head(val) class(val) # Return Value: return() } # ------------------------------------------------------------------------------ test.rlmCoef <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Convert to a timeSeries Object with Dummy Dates x = as.timeSeries(x) # Fit Parameters: fit = regFit(Y ~ X1 + X2 + X3, data = x, use = "rlm") fit # Extract Fitted values: head(slot(fit, "fitted")) val = fitted(fit) head(val) class(val) # Extract Residuals: head(slot(fit, "residuals")) val = residuals(fit) head(val) class(val) # Return Value: return() } # ------------------------------------------------------------------------------ test.amCoef <- function() { # Simulate Artificial LM: x = regSim(model = "GAM3", n = 50) # Convert to a timeSeries Object with Dummy Dates x = as.timeSeries(x) # Fit Parameters: fit = regFit(Y ~ X1 + X2 + X3, data = x, use = "gam") fit # Extract Fitted values: head(slot(fit, "fitted")) val = fitted(fit) head(val) class(val) # Extract Residuals: head(slot(fit, "residuals")) val = residuals(fit) head(val) class(val) # Return Value: return() } # ------------------------------------------------------------------------------ test.pprCoef <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Convert to a timeSeries Object with Dummy Dates x = as.timeSeries(x) # Fit Parameters: fit = regFit(Y ~ X1 + X2 + X3, data = x, use = "ppr") fit # Extract Fitted values: head(slot(fit, "fitted")) val = fitted(fit) head(val) class(val) # Extract Residuals: head(slot(fit, "residuals")) val = residuals(fit) head(val) class(val) # Return Value: return() } # ------------------------------------------------------------------------------ test.nnetCoef <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Convert to a timeSeries Object with Dummy Dates x = as.timeSeries(x) # Fit Parameters: fit = regFit(Y ~ X1 + X2 + X3, data = x, use = "nnet") fit # Extract Fitted values: head(slot(fit, "fitted")) val = fitted(fit) head(val) class(val) # Extract Residuals: head(slot(fit, "residuals")) val = residuals(fit) head(val) class(val) # Return Value: return() } # ------------------------------------------------------------------------------ test.polymarsCoef <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Convert to a timeSeries Object with Dummy Dates x = as.timeSeries(x) # Fit Parameters: fit = regFit(Y ~ X1 + X2 + X3, data = x, use = "polymars") fit # Extract Fitted values: head(slot(fit, "fitted")) val = fitted(fit) head(val) class(val) # Extract Residuals: head(slot(fit, "residuals")) val = residuals(fit) head(val) class(val) # Return Value: return() } ################################################################################ fRegression/inst/unitTests/runit.terms.R0000644000176000001440000001052411370220736020167 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTION: REGRESSION MODELLING DESCRIPTION: # regFit Wrapper Function for Regression Models ################################################################################ test.lmFit <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Fit Parameters: lmfit = regFit(Y ~ X1 + X2 + X3, data = x, use = "lm") lm = lm(Y ~ X1 + X2 + X3, data = x) # Terms: terms(lmfit@fit) terms(lm) # Return Value: return() } # ------------------------------------------------------------------------------ test.rlmFit <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Fit Parameters: rlmfit = regFit(Y ~ X1 + X2 + X3, data = x, use = "rlm") rlm = rlm(Y ~ X1 + X2 + X3, data = x) # Terms: terms(rlmfit@fit) terms(rlm) # Return Value: return() } # ------------------------------------------------------------------------------ test.glmFit <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Fit Parameters: glmfit = regFit(Y ~ X1 + X2 + X3, data = x, use = "glm") glm = glm(Y ~ X1 + X2 + X3, data = x) # Terms: terms(glmfit@fit) terms(glm) # Return Value: return() } # ------------------------------------------------------------------------------ test.gamFit <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Fit Parameters: gamfit = regFit(Y ~ s(X1) + s(X2) + X3, data = x, use = "gam") gam = gam(Y ~ X1 + X2 + X3, data = x) # Terms: terms(gamfit@fit) terms(gam) # Return Value: return() } # ------------------------------------------------------------------------------ test.pprFit <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Fit Parameters: pprfit = regFit(Y ~ X1 + X2 + X3, data = x, use = "ppr") ppr = ppr(Y ~ X1 + X2 + X3, data = x, nterms = 2) # Terms: terms(pprfit@fit) terms(ppr) # Return Value: return() } # ------------------------------------------------------------------------------ test.nnetFit <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Fit Parameters: nnetfit = regFit(Y ~ X1 + X2 + X3, data = x, use = "nnet") nnet = nnet(Y ~ X1 + X2 + X3, data = x, trace = FALSE, size = 2, linout = TRUE) # Terms: terms(nnetfit@fit) terms(nnet) # Return Value: return() } # ------------------------------------------------------------------------------ test.polymarsFit <- function() { # Simulate Artificial LM: x = regSim(model = "LM3", n = 50) # Fit Parameters: polymarsfit = regFit(Y ~ X1 + X2 + X3, data = x, use = "polymars") polymars = .polymars(Y ~ X1 + X2 + X3, data = x) # Terms: terms(polymarsfit@fit) terms(polymars) # Return Value: return() } ################################################################################ fRegression/inst/unitTests/runit.TermPlots.R0000644000176000001440000001540012256320251020761 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTION: REGRESSION TERM PLOTS # termPlot Line Plot # termPersp Perspective Plot # termContour Contour Plot ################################################################################ test.termPlot <- function() { x = regSim(model = "LM3", n = 100) lmfit = regFit(Y ~ X1 + X2 + X3, data = x, use = "lm") # Simulate Data - a data frame: DATA = regSim(model = "GAM3", n = 100) head(DATA) class(DATA) # Convert to a timeSeries object: DATATS = as.timeSeries(DATA) head(DATATS) class(DATATS) # Fit: LM = regFit(Y ~ 1 + X1 + X2 + X3, data = DATATS, use = "lm") RLM = regFit(Y ~ 1 + X1 + X2 + X3, data = DATATS, use = "rlm") AM = regFit(Y ~ 1 + X1 + X2 + X3, DATATS, use = "gam") PPR = regFit(Y ~ X1 + X2 + X3, data = DATATS, use = "ppr") PPR4 = regFit(Y ~ X1 + X2 + X3, data = DATATS, use = "ppr", nterms = 4) POLYMARS = regFit(Y ~ X1 + X2 + X3, data = DATATS, use = "polymars") NNET = regFit(Y ~ X1 + X2 + X3, data = DATATS, use = "nnet") NNET6 = regFit(Y ~ X1 + X2 + X3, data = DATATS, use = "nnet", size = 6) ## TODO: Term Plot: ## par(ask = FALSE) ## par(mfrow = c(1, 1)) ## termPlot(LM) ## termPlot(RLM) ## termPlot(AM) ## termPlot(PPR) ## termPlot(POLYMARS) ## termPlot(NNET) ## TODO: ## par(ask = FALSE) ## par(mfrow = c(1, 1)) ## termPlot(LM, terms = "X1") ## termPlot(RLM, terms = "X1") ## termPlot(AM, terms = "X1") ## termPlot(PPR, terms = "X1") ## termPlot(PPR4, terms = "X1") ## termPlot(POLYMARS, terms = "X1") ## termPlot(NNET, terms = "X1") ## termPlot(NNET6, terms = "X1") # Return Value: return() } # ------------------------------------------------------------------------------ test.termPersp <- function() { # Simulate Data - a data frame: DATA = regSim(model = "GAM3", n = 100) head(DATA) class(DATA) # Convert to a timeSeries object: DATATS = as.timeSeries(DATA) head(DATATS) class(DATATS) # Fit: LM = regFit(Y ~ 1 + X1 + X2 + X3, data = DATATS, use = "lm") RLM = regFit(Y ~ 1 + X1 + X2 + X3, data = DATATS, use = "rlm") AM = regFit(Y ~ 1 + s(X1)+s(X2)+s(X3), DATATS, use = "gam") PPR = regFit(Y ~ X1 + X2 + X3, data = DATATS, use = "ppr") PPR4 = regFit(Y ~ X1 + X2 + X3, data = DATATS, use = "ppr", nterms = 4) POLYMARS = regFit(Y ~ X1 + X2 + X3, data = DATATS, use = "polymars") NNET = regFit(Y ~ X1 + X2 + X3, data = DATATS, use = "nnet") NNET6 = regFit(Y ~ X1 + X2 + X3, data = DATATS, use = "nnet", size = 6) ## TODO: Bivariate Perspective Term Plot: ## par(ask = FALSE) ## par(mfrow = c(1, 1)) ## termPersp(LM, terms = c("X1", "X2")) ## termPersp(RLM, terms = c("X1", "X2")) ## termPersp(AM, terms = c("X1", "X2")) ## termPersp(PPR, terms = c("X1", "X2")) ## termPersp(PPR4, terms = c("X1", "X2")) ## termPersp(POLYMARS, terms = c("X1", "X2")) ## termPersp(NNET, terms = c("X1", "X2")) ## termPersp(NNET6, terms = c("X1", "X2")) # Return Value: return() } # ------------------------------------------------------------------------------ test.termContour <- function() { # Simulate Data - a data frame: DATA = regSim(model = "GAM3", n = 100) head(DATA) class(DATA) # Convert to a timeSeries object: DATATS = as.timeSeries(DATA) head(DATATS) class(DATATS) # Fit: LM = regFit(Y ~ 1 + X1 + X2 + X3, data = DATATS, use = "lm") RLM = regFit(Y ~ 1 + X1 + X2 + X3, data = DATATS, use = "rlm") AM = regFit(Y ~ 1 + s(X1)+s(X2)+s(X3), DATATS, use = "gam") PPR = regFit(Y ~ X1 + X2 + X3, data = DATATS, use = "ppr") PPR4 = regFit(Y ~ X1 + X2 + X3, data = DATATS, use = "ppr", nterms = 4) POLYMARS = regFit(Y ~ X1 + X2 + X3, data = DATATS, use = "polymars") NNET = regFit(Y ~ X1 + X2 + X3, data = DATATS, use = "nnet") NNET6 = regFit(Y ~ X1 + X2 + X3, data = DATATS, use = "nnet", size = 6) ## TODO: Bivariate Contour Term Plot: ## par(ask = FALSE) ## par(mfrow = c(1, 1)) ## termContour(LM, terms = c("X1", "X2")) ## termContour(RLM, terms = c("X1", "X2")) ## termContour(AM, terms = c("X1", "X2")) ## termContour(PPR, terms = c("X1", "X2")) ## termContour(PPR4, terms = c("X1", "X2")) ## termContour(POLYMARS, terms = c("X1", "X2")) ## termContour(NNET, terms = c("X1", "X2")) ## termContour(NNET6, terms = c("X1", "X2")) # Return Value: return() } # ------------------------------------------------------------------------------ test.termComparison <- function() { # Simulate Data - a data frame: DATA = regSim(model = "GAM3", n = 100) head(DATA) class(DATA) # Convert to a timeSeries object: DATATS = as.timeSeries(DATA) head(DATATS) class(DATATS) ## TODO: if (FALSE) { # Comparison: par(ask = FALSE) par(mfrow = c(1, 1)) LM = regFit(Y ~ 1 + X1 + X2 + X3, data = DATATS, use = "lm") termPlot(LM) AM = regFit(Y ~ 1 + s(X1)+s(X2)+s(X3), data = DATATS, use = "gam") termPlot(AM) am = gam(formula = Y ~ s(X1) + s(X2) + s(X3), data = DATA) for (s in 1:3) { plot(am, residuals = residuals(am), se = TRUE, main = "AM", cex = 0.7, select = s, pch = 19); grid() } } # Return Value: return() } ################################################################################ fRegression/tests/0000755000176000001440000000000012256336614013742 5ustar ripleyusersfRegression/tests/Rplots.pdf0000644000176000001440000002762312256336623015732 0ustar ripleyusers%PDF-1.4 %ρ\r 1 0 obj << /CreationDate (D:20131224175956) /ModDate (D:20131224175956) /Title (R Graphics Output) /Producer (R 3.1.0) /Creator (R) >> endobj 2 0 obj << /Type /Catalog /Pages 3 0 R >> endobj 7 0 obj << /Type /Page /Parent 3 0 R /Contents 8 0 R /Resources 4 0 R >> endobj 8 0 obj << /Length 606 /Filter /FlateDecode >> stream xVMo0Wz \x-H@z*pXHc;.vrX+o_b}G (f`d Ge v?Ο~N+5ЗzsYt7Gp-mq|. e5/ vӃCVEU(Sk7If艱.zVFNVs_[O޳blC9rNQbΰ$ a卣ϰ{˙VWh\ZꚖWERHC’\ꣻS\jQ"'6t1I\xX{ l@l8Հ Ӽ>?}@ U ':Æq<PO| |ʅ'Xyca3l^+4Oyov:qY&{*ӧlMb$)3|$}P:j^&Zr®P)4~TjcwB$lXT{rXbhS],Uكef,/.Ut8g 6-} 6R_DE8ҘӝSN@r'p+乩KzAO'vǭ+*g[S̸Ŗ teendstream endobj 9 0 obj << /Type /Page /Parent 3 0 R /Contents 10 0 R /Resources 4 0 R >> endobj 10 0 obj << /Length 7182 /Filter /FlateDecode >> stream xM-UWCpDtK!FQ 2㵞:uovnWm_}OF<^G8?ï~o>mm>;k;??ͧ]|ͧ|1?RϏ>~Og{(*Wo_*טuYv=u*W9滍wzh4xx~׫ klxMx5u6ۆ·xQZ}qv4}6G{Qzk>_g11-NzDsN|x+O >ʬ|WqrSpM&q52|}5 Esi̖˜P55m+wrWf.M,ט<*zqtM]W'G{Ujسؽ wOj׵ϧڷiëCڷ]rU0zݓosr54\d*}}|{u]*ط9>|Pm>gB/jOwBr y>;^h6Z<_i)M&e>Vݿr z/(F͸s9.wnN{fvx|uD;l`)#iQU3mlYh0;OE=Gg@>{ݟQy ڞUjP{ 9磡e]?~dTbiGO4zQ_d;DK?>ΈxkzhZTr.m?qiJ=Q>{=Cz:UVw:):ZӔzhf{5wzZ] =IF~COs|GOS6^ 78oGOӱn=Sأv.kܳ~P's|1o=QFOs=GTqxOuL2zn ޹L[oqَJ_ԣ'I2\>!ըGOSYOZ~d>˻Cc-۷SOz+{Yii8oCSOLώ~=Tח8!FO%zRГ gvg<U:͈=h5U9Ӝfr9-]jq);Ӵ?]υjoNώ˅ |tDW3i_cG槡'Ɍ2zz?~<9q=QzRlO{2ڹ>JGOn'^pԾvd:xx)۱g=Mck?}?mn=z[=MYFx+o7F=^Sݢ;۞uۈo/_Ӝd2zw@ԟqk>2zR{=]u_w 3dw4i}4 Ęoķgݭ:rv{48Wݳ?EUg?q|_HۧXOjj-iķiAF9f~=S|KXI=z֓磧NH9/C zJBNGO%A tŷ_9/F?>H$^u{%z*G9ow2[GؑQy=-Q0*$~EO;-93Y?}8V:/9“8tt\qE_&^=h9o=m7Z'ϟ>;xNd?'zk߉__oo40'z*q}OO9:(`9^{Dž .ڻX_b!(K"x͗82>9U~?(~bO|w/O ׿__ǧ?|?\<-Pm_=~mo>nTiǫ/Mx|\g?-wyfz-/V}PzpS|ӡݿCW\np?4ZxrI;sdeu:WKc,;k}^b%:꾄}`*ٷWeS_M?gznjFYК֛oT࡟*[0)>܋6%SY5P( >DwL, J{)Fכ*)Er6.Ⴥʈlo>w*|P>Tvb{A%|/>l|P#8򂮅C*K3T|2=4(T[9|P-{':J_y߅Vქd%Tj1|гo PQ3>Ҕ?`NWJ9~rҢxdҜUO>Ң t Ҍ 4P{y/*Ejc`YALJZT /4(o>?.Oy6|P+>ɇp/mR|Pi a@>3A^? x"$|i\οu?GdTZ&ArWhIiKxaĴx*|P'gȹoჲ_z:l婙ڳ z[|A}_b]f{|g!LM1<=Wxy;<=(,* I =%I|AGOʷ󯚯 3ϐzA' tg!3_Aw=VKAo;@_|x ?${ʿh5 GƳj)GOo>/>|P=3Gyc~>({=^"|P Uz: O-:ϛgh=-kG0T=A??Aj~w詅Ҹ7z^AMDO:Z7gh<Ă>{|A;%k 6z:AEf>3_Agz.;1AwCORA3YɄ:9eτ>a|PˎjYzJ7,} zAO gj}z Դ^𻜤W>eπڞB4߇ȯeix~9|m =?Z|{ Ty'y=eس?ǤჲSFO=ZF|P/ " avѓΟz,gA- ~=i`|CGOWxxwx?& COO>|Póކo>zf}4gt5|C=zۂ'3 y؈oO>}`Y y3P1i.=şA}\ >(·_-z:8߄:uo=~W|PK{AmB }5?IH}e=5~t<Ot󤟇:UFOM\p?A~7A|= ?DOo' Oz?/|P|>h=Ҿ`{A_ߡ5|PAzWZO¦oy;sCԎDO/|P;x"C_jAՇz5z'z:>}}v|PW_|P?>hqe;|Pa$za|{A);$o2|~._A~"|/tz{za|~)>]W4EzF^?X d)-]I߾,0. |ba/dlںc}{s1,XL= UxؕKbZwܬ8Z"͔3i=8H4kFoO3mυVR?5psmëkv])+mc uߋDn3 j5MKnHZ$dՒaj-V#{ +Ъ9~`J ؔzUT {̺E'$é6`džR%7',`Tc!+i+Jq7&çSڼ(L|é\wh45m!SX7eMTop)XH;-6g׏< !d%Hj!R yiǺf\wsiШVe-dX2pZH2m]D)Z%Cن`('W7P=Z qGMSrj+!PHZ~{'|/4U3O>Ȓ52wh"Gm51c'#4WVZ toDqʦ4$ZyG4 M-0:I5u $N-e?F<޵Ǫ]7ZJZGno⣞~%>ur}\}Eɜ}S/#? Ys\~}5Oc}:*80endstream endobj 3 0 obj << /Type /Pages /Kids [ 7 0 R 9 0 R ] /Count 2 /MediaBox [0 0 504 504] >> endobj 4 0 obj << /ProcSet [/PDF /Text] /Font << /F1 12 0 R /F2 13 0 R /F3 14 0 R >> /ExtGState << >> /ColorSpace << /sRGB 5 0 R >> >> endobj 5 0 obj [/ICCBased 6 0 R] endobj 6 0 obj << /Alternate /DeviceRGB /N 3 /Length 2596 /Filter /FlateDecode >> stream xwTSϽ7PkhRH H.*1 J"6DTpDQ2(C"QDqpId߼y͛~kg}ֺLX Xňg` lpBF|،l *?Y"1P\8=W%Oɘ4M0J"Y2Vs,[|e92<se'9`2&ctI@o|N6(.sSdl-c(2-yH_/XZ.$&\SM07#1ؙYrfYym";8980m-m(]v^DW~ emi]P`/u}q|^R,g+\Kk)/C_|Rax8t1C^7nfzDp 柇u$/ED˦L L[B@ٹЖX!@~(* {d+} G͋љς}WL$cGD2QZ4 E@@A(q`1D `'u46ptc48.`R0) @Rt CXCP%CBH@Rf[(t CQhz#0 Zl`O828.p|O×X ?:0FBx$ !i@ڐH[EE1PL ⢖V6QP>U(j MFkt,:.FW8c1L&ӎ9ƌaX: rbl1 {{{;}#tp8_\8"Ey.,X%%Gщ1-9ҀKl.oo/O$&'=JvMޞxǥ{=Vs\x ‰N柜>ucKz=s/ol|ϝ?y ^d]ps~:;/;]7|WpQoH!ɻVsnYs}ҽ~4] =>=:`;cܱ'?e~!ańD#G&}'/?^xI֓?+\wx20;5\ӯ_etWf^Qs-mw3+?~O~endstream endobj 11 0 obj << /Type /Encoding /BaseEncoding /WinAnsiEncoding /Differences [ 45/minus 96/quoteleft 144/dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron /space] >> endobj 12 0 obj << /Type /Font /Subtype /Type1 /Name /F1 /BaseFont /ZapfDingbats >> endobj 13 0 obj << /Type /Font /Subtype /Type1 /Name /F2 /BaseFont /Helvetica /Encoding 11 0 R >> endobj 14 0 obj << /Type /Font /Subtype /Type1 /Name /F3 /BaseFont /Helvetica-Bold /Encoding 11 0 R >> endobj xref 0 15 0000000000 65535 f 0000000021 00000 n 0000000163 00000 n 0000008305 00000 n 0000008394 00000 n 0000008529 00000 n 0000008562 00000 n 0000000212 00000 n 0000000292 00000 n 0000000969 00000 n 0000001050 00000 n 0000011257 00000 n 0000011515 00000 n 0000011599 00000 n 0000011697 00000 n trailer << /Size 15 /Info 1 0 R /Root 2 0 R >> startxref 11800 %%EOF fRegression/tests/doRUnit.R0000644000176000001440000000151611370220736015445 0ustar ripleyusers#### doRUnit.R --- Run RUnit tests ####------------------------------------------------------------------------ ### Origianlly follows Gregor Gojanc's example in CRAN package 'gdata' ### and the corresponding section in the R Wiki: ### http://wiki.r-project.org/rwiki/doku.php?id=developers:runit ### MM: Vastly changed: This should also be "runnable" for *installed* ## package which has no ./tests/ ## ----> put the bulk of the code e.g. in ../inst/unitTests/runTests.R : if(require("RUnit", quietly = TRUE)) { ## --- Setup --- wd <- getwd() pkg <- sub("\\.Rcheck$", '', basename(dirname(wd))) library(package=pkg, character.only = TRUE) path <- system.file("unitTests", package = pkg) stopifnot(file.exists(path), file.info(path.expand(path))$isdir) source(file.path(path, "runTests.R"), echo = TRUE) } fRegression/src/0000755000176000001440000000000012261240014013347 5ustar ripleyusersfRegression/src/Makevars0000644000176000001440000000005612161635724015063 0ustar ripleyusersPKG_LIBS=$(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) fRegression/src/MarsModelling.f0000644000176000001440000005151712261240014016264 0ustar ripleyusers C ############################################################################## C MARS-dcalcvar subroutine calcvar(nx,n,px,qr,qrank,qpivot,cov,tmpcov,work) implicit double precision (a-h,o-z) integer n,px,qrank,qpivot(px) double precision qr(nx,px),cov(px,px), tmpcov(px,px),work(1) double precision dsum integer i,j,km do 23000 i=1,qrank do 23002 j=1,qrank tmpcov(i,j)=0d0 cov(i,j)=qr(i,j) 23002 continue tmpcov(i,i)=1e0 23000 continue info=0 c R version has different args c call dbksl(cov,px,qrank,tmpcov,px,info) do 20 j = 1, qrank 20 call dtrsl(cov, px, qrank, tmpcov(1,j), 01, info) do 23004 i=1,qrank do 23006 j=i,qrank dsum=0e0 km=max(i,j) k=km 23008 if(.not.(k.le.qrank))goto 23010 dsum=dsum+tmpcov(i,k)*tmpcov(j,k) k=k+1 goto 23008 23010 continue tmpcov(i,j)=dsum tmpcov(j,i)=dsum 23006 continue 23004 continue do 23011 i=1,qrank do 23013 j=1,qrank cov(i,j)=tmpcov(i,j) 23013 continue 23011 continue return end C ############################################################################## C MARS-dmarss subroutine marss(nx,n,p,nclass,y,x,w,tagx,maxorder,mmax,penalty, & thresh,forwstep,interms,prune,bx,fullin,lenb, bestgcv, bestin, & flag,cut,dir,res,alpha,beta,scrat,iscrat,trace) implicit double precision (a-h,o-z) integer nx, n,p,nclass,tagx(nx,p),maxorder,mmax,bestin(mmax), & flag(mmax,p),fullin(mmax) double precision y(n,nclass),x(nx,p),w(n),bx(nx,mmax),bestgcv, & cut(mmax,p),dir(mmax,p),res(nx,nclass),alpha(nclass), & beta(mmax,nclass) double precision scrat(*) integer iscrat(*) logical forwstep, prune, trace, tracec common tracec tracec=trace len1=n*mmax len2=mmax len3=mmax*mmax len4=mmax*nclass len5=nclass len6=mmax len7=mmax len8=nclass len9=n len10=n*mmax len11=mmax*mmax len12=mmax*nclass len13=mmax*mmax len14=mmax*mmax n1=1 n2=n1+len1 n3=n2+len2 n4=n3+len3 n5=n4+len4 n6=n5+len5 n7=n6+len6 n8=n7+len7 n9=n8+len8 n10=n9+len9 n11=n10+len10 n12=n11+len11 n13=n12+len12 n14=n13+len13 n15=n14+len14 call marsnew1(nx, n, p, nclass, y, x, w, tagx, maxorder, mmax, & bx, bestgcv, bestin, fullin, lenb, flag, cut, dir, res, & alpha, beta, penalty, thresh, forwstep, interms, prune, & scrat, scrat(n2), scrat(n3), scrat(n4), scrat(n5), scrat(n6), & scrat(n7), scrat(n8), scrat(n9), scrat(n10), scrat(n11), & scrat(n12), scrat(n13), scrat(n14), scrat(n15), iscrat, & iscrat(1+mmax), iscrat(1+2*mmax), iscrat(1+3*mmax)) return end subroutine marsnew1(nx, n, p, nclass, y, x, w, tagx, maxorder, & mmax, bx, bestgcv, bestin, fullin, lenb, flag, cut, dir, & res, alpha, beta, penalty, thresh, forwstep, interms, & prune, bxorth, bxorthm, cov, covsy, ybar, scr1, scr5, scr6, & temp, bxsc, r, betasc, varsc, var, work, termlen, in, & tempin, qpivot) implicit double precision (a-h,o-z) integer n,nterms2,p,mmax,flag(mmax,p),tagx(nx,p),termlen(mmax), & nclass,fullin(mmax) double precision cov(mmax,mmax),covsy(mmax,nclass),critmax, & x(nx,p),bx(nx,mmax),bxorth(n,mmax),bxorthm(mmax), & y(n,nclass),ybar(nclass),scr1(mmax),scr5(mmax),scr6(nclass) double precision temp(n),w(n), cut(mmax,p),dir(mmax,p), & alpha(nclass),beta(mmax,nclass), bxsc(n,mmax), r(mmax,mmax), & dofit, res(nx,nclass),betasc(mmax,nclass), varsc(mmax,mmax), & var(mmax,mmax), stopfac, work(*) integer tempin(mmax), bestin(mmax),qrank, qpivot(mmax) logical forwstep,go, prune, newform, cvar, trace common trace double precision rtemp(4) integer itemp(4) tolbx=.01 stopfac=10.0 prevcrit=10e9 if(.not.(interms.eq.1))goto 23000 dofit=0 goto 23001 23000 continue dofit=0 do 23002 j=2,lenb dofit=dofit+fullin(j) 23002 continue nterms=interms 23001 continue if(.not.(forwstep))goto 23004 fullin(1)=1 do 23006 i=2,mmax fullin(i)=0 23006 continue do 23008 i=1,n w(i)=1 23008 continue do 23010 i=1, mmax termlen(i)=0 do 23012 j=1, p flag(i,j)=0 cut(i,j)=0 23012 continue 23010 continue nterms=1 nterms2=2 do 23014 i=1,n bx(i,1)=1 bxorth(i,1)=1.0/dsqrt(dfloat(n)) 23014 continue bxorthm(1)=1/dsqrt(dfloat(n)) do 23016 i=1,n do 23018 j=1, mmax bx(i,j)=0.0 23018 continue 23016 continue do 23020 i=1,n bx(i,1)=1 23020 continue do 23022 k=1, nclass ybar(k)=0.0 do 23024 i=1,n ybar(k)=ybar(k)+y(i,k)/n 23024 continue 23022 continue if(.not.(interms.eq.1))goto 23026 rssnull=0.0 do 23028 k=1, nclass do 23030 i=1,n rssnull=rssnull+(y(i,k)-ybar(k))**2 23030 continue 23028 continue goto 23027 23026 continue rssnull=0.0 do 23032 k=1, nclass do 23034 i=1,n rssnull=rssnull+res(i,k)**2 23034 continue 23032 continue 23027 continue rss=rssnull cmm= (1+dofit) + penalty*(.5*dofit) gcvnull=(rssnull/n)/(1.0-cmm/n)**2 if(.not.(trace))goto 23036 call dblepr("initial rss=",11,rssnull,1) 23036 continue if(.not.(trace))goto 23038 call dblepr("initial gcv=",11,gcvnull,1) 23038 continue lenb=1 ii=interms-1 go=.true. 23040 if(.not.( (ii.lt.(mmax-1)).and.((rss/rssnull).gt.thresh).and.go)) & goto 23041 ii=ii+2 do 23042 i1=1, nterms do 23044 i2=1, nterms cov(i1,i2)=0 23044 continue 23042 continue do 23046 j=1, nterms cov(j,j)=0.0 do 23048 i=1,n cov(j,j) = cov(j,j) + % (bxorth(i,j)-bxorthm(j)) * (bxorth(i,j)-bxorthm(j)) 23048 continue 23046 continue do 23050 k=1,nclass do 23052 j=1, nterms covsy(j,k)=0.0 do 23054 i=1,n covsy(j,k)=covsy(j,k)+(y(i,k)-ybar(k))*bxorth(i,j) 23054 continue 23052 continue 23050 continue do 23056 ik=1,mmax tempin(ik)=fullin(ik) 23056 continue call addtrm(nx,bx,tempin,bxorth,bxorthm,p,n,nclass,rss,prevcrit, & cov,covsy,y,ybar,x,tagx,w,termlen,mmax,tolbx, nterms,flag, & maxorder,scr1,scr5,scr6,imax,jmax,kmax,critmax, newform, & bxsc, r, betasc, temp) doftemp=dofit doftemp=doftemp+1 if(.not.((imax.gt.1).and.(newform)))goto 23058 doftemp=doftemp+1 23058 continue temprss=rss-critmax cmm= (1+doftemp) + penalty*(.5*doftemp) gcv=(temprss/n)/(1.0-cmm/n)**2 go=.false. if (.not.(((critmax/rss).gt.thresh).and. & ((gcv/gcvnull).lt.stopfac))) goto 23060 go=.true. dofit=doftemp rss=rss-critmax kk=tagx(imax,jmax) 256 format(" ","adding term"," jmax=",i3, " imax=",i3 ," kmax=",i3, & " critmax= ",f8.2," cutp=", f9.5," rss=",f8.2, " gcv=",f8.2, & " dofit=",f9.3) itemp(1)=jmax itemp(2)=imax itemp(3)=kmax rtemp(1)=critmax rtemp(2)=x(kk,jmax) rtemp(3)=rss rtemp(4)=gcv if(.not.(trace))goto 23062 call intpr("adding term ",12,ii,1) 23062 continue if(.not.(trace))goto 23064 call intpr("var, sp index, parent",21,itemp,3) 23064 continue if(.not.(trace))goto 23066 call dblepr("critmax cut rss gcv",19,rtemp,4) 23066 continue prevcrit=critmax do 23068 j=1,p flag(ii,j)=flag(kmax,j) flag(ii+1,j)=flag(kmax,j) cut(ii,j)=cut(kmax,j) cut(ii+1,j)=cut(kmax,j) dir(ii,j)=dir(kmax,j) dir(ii+1,j)=dir(kmax,j) 23068 continue termlen(ii)=termlen(kmax)+1 termlen(ii+1)=termlen(kmax)+1 do 23070 i=1,n temp(i)=x(tagx(i,jmax),jmax) 23070 continue temp1=temp(imax) fullin(ii)=1 if(.not.((imax.gt.1).and.(newform)))goto 23072 fullin(ii+1)=1 23072 continue flag(ii,jmax)=1 flag(ii+1,jmax)=1 cut(ii,jmax)=temp1 cut(ii+1,jmax)=temp1 dir(ii,jmax)=1 dir(ii+1,jmax)=-1 if(.not.(fullin(ii+1).eq.0))goto 23074 termlen(ii+1)=maxorder+1 23074 continue do 23076 i=1,n if(.not.( (x(i,jmax)-temp1).gt.0))goto 23078 bx(i,ii)=bx(i,kmax)*(x(i,jmax)-temp1) 23078 continue if(.not.((temp1-x(i,jmax)).ge.0))goto 23080 bx(i,ii+1)=bx(i,kmax)*(temp1-x(i,jmax)) 23080 continue 23076 continue if(.not.(nterms.eq.1))goto 23082 temp1=0.0 do 23084 i=1,n temp1=temp1+bx(i,2)/n 23084 continue do 23086 i=1,n bxorth(i,2)=bx(i,2)-temp1 23086 continue goto 23083 23082 continue call orthreg(n,n,nterms,bxorth,fullin, bx(1,ii),bxorth(1,nterms2)) 23083 continue if(.not.(fullin(ii+1).eq.1))goto 23088 call orthreg(n,n,nterms+1,bxorth,fullin, bx(1,ii+1), & bxorth(1,nterms2+1)) goto 23089 23088 continue do 23090 i=1,n bxorth(i,nterms2+1)=0 23090 continue 23089 continue bxorthm(nterms2)=0.0 bxorthm(nterms2+1)=0.0 do 23092 i=1,n bxorthm(nterms2)=bxorthm(nterms2)+bxorth(i,nterms2)/n bxorthm(nterms2+1)=bxorthm(nterms2+1)+bxorth(i,nterms2+1)/n 23092 continue temp1=0.0 temp2=0.0 do 23094 i=1,n temp1=temp1+bxorth(i,nterms2)**2 temp2=temp2+bxorth(i,nterms2+1)**2 23094 continue if(.not.(temp1.gt.0.0))goto 23096 do 23098 i=1,n bxorth(i,nterms2) =bxorth(i,nterms2)/dsqrt(temp1) 23098 continue 23096 continue if(.not.(temp2.gt.0.0))goto 23100 do 23102 i=1,n bxorth(i,nterms2+1)=bxorth(i,nterms2+1)/dsqrt(temp2) 23102 continue 23100 continue lenb=lenb+2 nterms=nterms+2 nterms2=nterms2+2 23060 continue goto 23040 23041 continue rtemp(1)=rss/rssnull rtemp(2)=critmax/rss rtemp(3)=gcv/gcvnull if(.not.(trace))goto 23104 call dblepr("stopping forw step; rss crit and gcv ratios",43, & rtemp,3) 23104 continue if(.not.(trace))goto 23106 if(.not.((rss/rssnull).le.thresh))goto 23108 call dblepr("rss ratio=",10,rss/rssnull,1) 23108 continue if(.not.((critmax/rss).le.thresh))goto 23110 call dblepr ("crit ratio=",11,critmax/rss,1) 23110 continue call dblepr("critmax",7,critmax,1) call dblepr("rss",3,rss,1) if(.not.((gcv/gcvnull).gt.stopfac))goto 23112 call dblepr("gcv ratio=",10,gcv/gcvnull,1) 23112 continue 23106 continue 23004 continue dofit= -1 do 23114 i=1,nterms bestin(i)=fullin(i) dofit=dofit+fullin(i) 23114 continue if(.not.(trace))goto 23116 call intpr("aft forw step",13,nterms,1) 23116 continue call qrreg(nx,n,mmax,lenb,nclass,bx,bxsc,bestin,y,qpivot,qrank, & beta,res,rss,cvar,var,varsc,scr1, work) nt=dofit+1 if(.not.(qrank.lt. nt))goto 23118 do 23120 i=qrank+1,nt bestin(qpivot(i))=0 fullin(qpivot(i))=0 dofit=dofit-1 23120 continue 23118 continue cvar=.true. rssfull=rss cmm= (1+dofit) + penalty*(.5*dofit) bestgcv=(rss/n)/(1.0-cmm/n)**2 rtemp(1)=bestgcv rtemp(2)=rssfull rtemp(3)=dofit if(.not.(trace))goto 23122 call dblepr("full model: gcv rss dofit",25,rtemp,3) 23122 continue if(.not.(trace))goto 23124 call intpr("terms",5,fullin,lenb) 23124 continue if(.not.(prune))goto 23126 c Need var calculated to do drop-one calculations from t values. cvar=.true. call qrreg(nx,n,mmax,lenb,nclass,bx,bxsc,tempin,y,qpivot,qrank, & beta,res,rss,cvar,var,varsc,scr1,work) do 23128 i=1,mmax tempin(i)=bestin(i) 23128 continue 23130 if(.not.(dofit.gt.0 ))goto 23131 jo=1 rsstemp=10d99 minterm=0 do 23132 ii=2, lenb if(.not.(tempin(ii).eq.1))goto 23134 jo=jo+1 temp7=0.0 do 23136 kc=1,nclass temp7=temp7+beta(jo,kc)**2/var(jo,jo) 23136 continue if(.not.(temp7 .lt. rsstemp))goto 23138 minterm=ii rsstemp=temp7 23138 continue 23134 continue 23132 continue rss=rss+rsstemp dofit=dofit-1 cmm= (1.0+dofit) + penalty*(.5*dofit) gcv=(rss/n)/(1.0-cmm/n)**2 tempin(minterm)=0 100 format(" ","pruning, minterm= ",i4, " gcv=",f9.3,2x, " rss=",f9.3, & 2x," dof=",f9.3," model= ",60(i1,1x)) if(.not.(gcv.lt. bestgcv))goto 23140 bestgcv=gcv do 23142 i=1,mmax bestin(i)=tempin(i) 23142 continue 23140 continue if(.not.(dofit .gt. 0))goto 23144 cvar=.true. call qrreg(nx,n,mmax,lenb,nclass,bx,bxsc,tempin,y,qpivot,qrank, & beta,res,rss,cvar,var,varsc,scr1,work) 23144 continue goto 23130 23131 continue call qrreg(nx,n,mmax,lenb,nclass,bx,bxsc,bestin,y,qpivot,qrank, & beta,res,rss,cvar,var,varsc,scr1, work) 101 format(" ","best model gcv=",f9.3," rss=",f9.3,2x,"model= ", & 60(i1,1x)) if(.not.(trace))goto 23146 call intpr("best model",10,bestin,lenb) 23146 continue if(.not.(trace))goto 23148 call dblepr(" gcv=",4,bestgcv,1) 23148 continue 23126 continue return end subroutine addtrm(nx,bx,tempin,bxorth,bxorthm,p,n,nclass,rss, & prevcrit,cov,covsy,y,ybar,x,tagx,w,termlen,mmax,tolbx, & nterms,flag, maxorder,scr1,scr5,scr6,imax,jmax,kmax, & critmax, newform,bxsc,r, betasc, scrat) implicit double precision (a-h,o-z) integer n,nterms,nterms2,p,mmax,flag(mmax,p),v,tagx(nx,p), & termlen(mmax), nclass, tempin(mmax), minspan, iendspan double precision cov(mmax,mmax),covsy(mmax,nclass),critmax, & x(nx,p),bx(nx,mmax),bxorth(n,mmax),bxorthm(mmax), & y(n,nclass),ybar(nclass),scr1(mmax),scr5(mmax),scr6(nclass), & bxsc(n,mmax), r(mmax,mmax),betasc(mmax,nclass), scrat(n), & w(n) double precision temp1, temp2, scr2,sumb, sumbx, su, st, tem logical newform, tnewform, trace common trace critmax=0 jmax=0 imax=0 kmax=0 do 23150 m=1,nterms nm=0 do 23152 jjj=1,n if(.not.(bx(jjj,m).gt.0))goto 23154 nm=nm+1 23154 continue 23152 continue tem=-(1d0/(n*nm))*dlog(1d0 - 5d-2) minspan= -1d0*(dlog(tem)/dlog(2d0))/2.5 tem=(5d-2)/n iendspan=3d0-dlog(tem)/dlog(2d0) if(.not.(termlen(m).lt. maxorder))goto 23156 do 23158 v=1,p if(.not.(flag(m,v).eq.0))goto 23160 tnewform=.true. mm=1 23162 if(.not.((mm.le.nterms).and.tnewform))goto 23163 mm=mm+1 if(.not.(tempin(mm).eq.1))goto 23164 tnewform=.false. if(.not.(flag(mm,v).ne.1))goto 23166 tnewform=.true. go to 9911 23166 continue do 23168 j=1,p if(.not.(j.ne.v))goto 23170 if(.not.(flag(mm,j).ne.flag(m,j)))goto 23172 tnewform=.true. go to 9911 23172 continue 23170 continue 23168 continue 23164 continue 9911 continue goto 23162 23163 continue if(.not.(tnewform))goto 23174 nterms2=nterms+1 do 23176 i=1,n scrat(i)=x(i,v)*bx(i,m) 23176 continue if(.not.(nterms.gt.1))goto 23178 call orthreg(n,n,nterms,bxorth,tempin, scrat,bxorth(1,nterms2)) goto 23179 23178 continue tem=0 do 23180 i=1,n tem=tem+scrat(i)/n 23180 continue do 23182 i=1,n bxorth(i,2)=scrat(i)-tem 23182 continue 23179 continue bxorthm(nterms2)=0.0 do 23184 i=1,n bxorthm(nterms2)=bxorthm(nterms2)+bxorth(i,nterms2)/n 23184 continue temp1=0.0 do 23186 i=1,n temp1=temp1+bxorth(i,nterms2)**2 23186 continue if(.not.(temp1.gt.tolbx))goto 23188 do 23190 i=1,n bxorth(i,nterms2)=bxorth(i,nterms2)/dsqrt(temp1) 23190 continue goto 23189 23188 continue do 23192 i=1,n bxorth(i,nterms2)=0 23192 continue tnewform=.false. 23189 continue do 23194 i1=1, nterms2 cov(i1,nterms2)=0.0 cov(nterms2, i1)=0.0 23194 continue cov(nterms2,nterms2)=1 do 23196 kc=1,nclass covsy(nterms2,kc)=0.0 do 23198 i=1,n covsy(nterms2,kc) = covsy(nterms2,kc)+(y(i,kc)-ybar(kc)) * & bxorth(i,nterms2) 23198 continue 23196 continue critnew=0.0 do 23200 kc=1,nclass temp1=0 do 23202 i=1,n temp1=temp1+y(i,kc)*bxorth(i,nterms2) 23202 continue critnew=critnew+temp1**2 23200 continue if(.not.(critnew.gt.critmax))goto 23204 jmax=v critmax=critnew imax=1 kmax=m 23204 continue 23174 continue if(.not.(tnewform))goto 23206 nterms2=nterms+1 nterms21=nterms+2 goto 23207 23206 continue nterms2=nterms nterms21=nterms+1 critnew=0.0 23207 continue do 23208 kc=1, nclass covsy(nterms21,kc)=0 23208 continue do 23210 ii=1,nterms21 cov(ii,nterms21)=0 cov(nterms21,ii)=0 23210 continue do 23212 kc=1,nclass scr6(kc)=0 23212 continue do 23214 ii=1,nterms21 scr1(ii)=0 23214 continue scr2=0 su=0 st=0 sumbx2=0 sumb=0.0 sumbx=0.0 k=n-1 23216 if(.not.(k.gt.0))goto 23218 do 23219 i=1,nterms2 kk=tagx(k,v) kk1=tagx(k+1,v) scr1(i)=scr1(i)+(bxorth(kk1,i)-bxorthm(i))*bx(kk1,m) cov(i,nterms21)=cov(i,nterms21)+ (x(kk1,v)-x(kk,v))*scr1(i) cov(nterms21,i)=cov(i,nterms21) 23219 continue scr2=scr2+(bx(kk1,m)**2)*x(kk1,v) sumbx2=sumbx2+bx(kk1,m)**2 sumb=sumb+bx(kk1,m) sumbx=sumbx+bx(kk1,m)*x(kk1,v) su=st st=sumbx-sumb*x(kk,v) cov(nterms21,nterms21)= cov(nterms21,nterms21)+ (x(kk1,v)-x(kk,v)) & *(2*scr2-sumbx2*(x(kk,v)+x(kk1,v)))+ ( (su*su)-(st*st) )/n crittemp=critnew do 23221 kc=1, nclass scr6(kc)=scr6(kc)+(y(kk1,kc)-ybar(kc))*bx(kk1,m) covsy(nterms21,kc)=covsy(nterms21,kc )+(x(kk1,v)-x(kk,v))*scr6(kc) temp1=covsy(nterms21,kc) temp2=cov(nterms21,nterms21) do 23223 jk=1,nterms2 temp1=temp1-covsy(jk,kc)*cov(jk,nterms21) temp2=temp2-cov(jk,nterms21)*cov(jk,nterms21) 23223 continue if(.not.(cov(nterms21,nterms21).gt.0))goto 23225 if(.not.((temp2/cov(nterms21,nterms21)) .gt. tolbx))goto 23227 critadd=(temp1*temp1)/temp2 goto 23228 23227 continue critadd=0.0 23228 continue goto 23226 23225 continue critadd=0 23226 continue crittemp=crittemp+critadd if(.not.(crittemp.gt.(1.01*rss)))goto 23229 crittemp=0.0 23229 continue if(.not.(crittemp.gt.(2*prevcrit)))goto 23231 crittemp=0.0 23231 continue 23221 continue if(.not.(k.gt.1))goto 23233 k0=tagx(k-1,v) 23233 continue if(.not.((crittemp.gt.critmax) .and. & (mod(k,minspan).eq.0) .and. & (k.ge.iendspan) .and. & (k.le.(n-iendspan)) .and. & (bx(kk1,m).gt.0) .and. & (.not.( (k.gt.1) .and. (x(kk,v).eq.x(k0,v))) ))) goto 23235 jmax=v critmax=crittemp imax=k kmax=m newform=tnewform 23235 continue k=k-1 goto 23216 23218 continue 23160 continue 9999 continue 23158 continue 23156 continue 23150 continue return end C ############################################################################## C MARS-dorthreg subroutine orthreg(nx,n,p,x,in, y,res) implicit double precision (a-h,o-z) integer n,nx,p, in(p) double precision x(nx,p),y(n),res(n) do 23000 i=1,n res(i)=y(i) 23000 continue do 23002 j=1,p if(.not.(in(j).eq.1))goto 23004 temp1=0 temp2=0 do 23006 i=1,n temp1=temp1+res(i)*x(i,j) temp2=temp2+x(i,j)*x(i,j) 23006 continue beta=temp1/temp2 do 23008 i=1,n res(i)=res(i)-beta*x(i,j) 23008 continue 23004 continue 23002 continue return end C ############################################################################## C MARS-dqrreg subroutine qrreg(nx,n,px,p,nclass,x,xsc,in,y,qpivot,qrank,beta, & res,rss,cvar,var,varsc,scr1,work) implicit double precision (a-h,o-z) integer nx,n,p,px, qpivot(p),qrank,nclass,in(p) double precision x(nx,p), xsc(n,p), y(n,nclass),res(nx,nclass), & beta(px,nclass),work(*),scr1(p),var(px,p),varsc(px,p) logical cvar ii=0 do 23000 j=1,p if(.not.(in(j).eq.1))goto 23002 ii=ii+1 do 23004 i=1,n xsc(i,ii)=x(i,j) 23004 continue 23002 continue 23000 continue nt=ii ijob=101 info=1 temp3=1d-2 do 23006 i=1,p qpivot(i)=i 23006 continue call dqrdc2(xsc,n,n,nt,temp3,qrank,scr1,qpivot,work) rss=0.0 do 23008 k=1,nclass call dqrsl(xsc,n,n,qrank,scr1,y(1,k),work(1),work(1),beta(1,k), & work(1),res(1,k),ijob,info) do 23010 i=1,n res(i,k)=y(i,k)-res(i,k) rss=rss+res(i,k)*res(i,k) 23010 continue 23008 continue if(.not.(cvar))goto 23012 call calcvar(nx,n,px,xsc,qrank,qpivot,var,varsc,work) 23012 continue return end fRegression/src/LmTests.f0000644000176000001440000001106312261240014015112 0ustar ripleyusers C Regression Test: lm C Subroutine pan.f SUBROUTINE PAN(A, M, C, N, RESULT) C C TRANSLATION OF AMENDED VERSION OF APPLIED STATISTICS ALGORITHM C AS 153 (AS R52), VOL. 33, 363-366, 1984. C BY R.W. FAREBROTHER (ORIGINALLY NAMED GRADSOL OR PAN) C C GRADSOL EVALUATES THE PROBABILITY THAT A WEIGHTED SUM OF C SQUARED STANDARD NORMAL VARIATES DIVIDED BY X TIMES THE UNWEIGHTED C SUM IS LESS THAN A GIVEN CONSTANT, I.E. THAT C A1.U1**2 + A2.U2**2 + ... + AM.UM**2 < C X*(U1**2 + U2**2 + ... + UM**2) + C C WHERE THE U'S ARE STANDARD NORMAL VARIABLES. C FOR THE DURBIN-WATSON STATISTIC, X = DW, C = 0, AND C A ARE THE NON-ZERO EIGENVALUES OF THE "M*A" MATRIX. C C THE ELEMENTS A(I) MUST BE ORDERED. A(0) = X C N = THE NUMBER OF TERMS IN THE SERIES. THIS DETERMINES THE C ACCURACY AND ALSO THE SPEED. NORMALLY N SHOULD BE ABOUT 10-15. C -------------- C ORIGINALLY FROM STATLIB. REVISED 5/3/1996 BY CLINT CUMMINS: C 1. DIMENSION A STARTING FROM 0 (FORTRAN 77) C IF THE USER DOES NOT INITIALIZE A(0) = X, C THERE WOULD BE UNPREDICTABLE RESULTS, SINCE A(0) IS ACCESSED C WHEN J2=0 FOR THE FINAL DO 60 LOOP. C 2. USE X VARIABLE TO AGREE WITH PUBLISHED CODE C 3. FIX BUG 2 LINES BELOW DO 60 L2 = J2, NU, D C PROD = A(J2) --> PROD = A(L2) C (PRIOR TO THIS FIX, ONLY THE TESTS WITH M=3 WORKED CORRECTLY) C 4. TRANSLATE TO UPPERCASE AND REMOVE TABS C TESTED SUCCESSFULLY ON THE FOLLOWING BENCHMARKS: C 1. FAREBROTHER 1984 TABLE (X=0): C A C PROBABILITY C 1,3,6 1 .0542 C 1,3,6 7 .4936 C 1,3,6 20 .8760 C 1,3,5,7,9 5 .0544 C 1,3,5,7,9 20 .4853 C 1,3,5,7,9 50 .9069 C 3,4,5,6,7 5 .0405 C 3,4,5,6,7 20 .4603 C 3,4,5,6,7 50 .9200 C 2. DURBIN-WATSON 1951/71 SPIRITS DATASET, FOR X=.2,.3,...,3.8, C=0 C COMPARED WITH BETA APPROXIMATION (M=66), A SORTED IN REVERSE ORDER C 3. JUDGE, ET AL 2ND ED. P.399 DATASET, FOR X=.2,.3,...,3.8, C=0 C COMPARED WITH BETA APPROXIMATION (M=8), A SORTED IN EITHER ORDER C INTEGER M, N DOUBLE PRECISION A(0:M), C, X, RESULT C C LOCAL VARIABLES C INTEGER D, H, I, J1, J2, J3, J4, K, L1, L2, NU, N2 DOUBLE PRECISION NUM, PIN, PROD, SGN, SUM, SUM1, U, V, Y DOUBLE PRECISION ZERO, ONE, HALF, TWO DATA ZERO/0.D0/, ONE/1.D0/, HALF/0.5D0/, TWO/2.D0/ C C SET NU = INDEX OF 1ST A(I) >= X. C ALLOW FOR THE A'S BEING IN REVERSE ORDER. C IF (A(1) .GT. A(M)) THEN H = M K = -1 I = 1 ELSE H = 1 K = 1 I = M ENDIF X = A(0) DO 10 NU = H, I, K IF (A(NU) .GE. X) GO TO 20 10 CONTINUE C C IF ALL A'S ARE -VE AND C >= 0, THEN PROBABILITY = 1. C IF (C .GE. ZERO) THEN RESULT = ONE RETURN ENDIF C C SIMILARLY IF ALL THE A'S ARE +VE AND C <= 0, THEN PROBABILITY = 0. C 20 IF (NU .EQ. H .AND. C .LE. ZERO) THEN RESULT = ZERO RETURN ENDIF C IF (K .EQ. 1) NU = NU - 1 H = M - NU IF (C .EQ. ZERO) THEN Y = H - NU ELSE Y = C * (A(1) - A(M)) ENDIF C IF (Y .GE. ZERO) THEN D = 2 H = NU K = -K J1 = 0 J2 = 2 J3 = 3 J4 = 1 ELSE D = -2 NU = NU + 1 J1 = M - 2 J2 = M - 1 J3 = M + 1 J4 = M ENDIF PIN = TWO * DATAN(ONE) / N SUM = HALF * (K + 1) SGN = K / DBLE(N) N2 = N + N - 1 C C FIRST INTEGRALS C DO 70 L1 = H-2*(H/2), 0, -1 DO 60 L2 = J2, NU, D SUM1 = A(J4) C FIX BY CLINT CUMMINS 5/3/96 C PROD = A(J2) PROD = A(L2) U = HALF * (SUM1 + PROD) V = HALF * (SUM1 - PROD) SUM1 = ZERO DO 50 I = 1, N2, 2 Y = U - V * DCOS(DBLE(I)*PIN) NUM = Y - X PROD = DEXP(-C/NUM) DO 30 K = 1, J1 PROD = PROD * NUM / (Y - A(K)) 30 CONTINUE DO 40 K = J3, M PROD = PROD * NUM / (Y - A(K)) 40 CONTINUE SUM1 = SUM1 + DSQRT(DABS(PROD)) 50 CONTINUE SGN = -SGN SUM = SUM + SGN * SUM1 J1 = J1 + D J3 = J3 + D J4 = J4 + D 60 CONTINUE C C SECOND INTEGRAL. C IF (D .EQ. 2) THEN J3 = J3 - 1 ELSE J1 = J1 + 1 ENDIF J2 = 0 NU = 0 70 CONTINUE C RESULT = SUM RETURN END fRegression/NAMESPACE0000644000176000001440000000471712256320453014022 0ustar ripleyusers ################################################ ## Note this file has been automatically ## generated --- Do not edit it. ################################################ ################################################ ## import name space ################################################ import("methods") import("mgcv") import("nnet") import("polspline") import("lmtest") import("MASS") # import("timeDate") # import("timeSeries") import("fBasics") import("fTrading") import("fMultivar") ################################################ ## useDynLib ################################################ useDynLib("fRegression") ################################################ ## S4 classes ################################################ exportClasses("fREG" ) exportMethods("$", "$<-", "+", "-", "[", "[<-", "coef", "cummax", "cummin", "cumprod", "cumsum", "dim", "dim<-", "dimnames", "dimnames<-", "fitted", "formula", "is.na", "names", "names<-", "plot", "predict", "residuals", "show", "summary", "terms", "vcov" ) ################################################ ## S3 classes ################################################ S3method("termPlot", "fREG") ################################################ ## functions ################################################ export( ".fittedContour", ".fittedPersp", ".fittedPlot", ".gam", ".glm", ".interactiveRegPlot", ".lm", ".multRegPlot", ".nnet", ".plot.1", ".plot.2", ".plot.3", ".plot.4", ".plot.5", ".plot.6", ".plot.7", ".plot.8", ".plot.common", ".plot.gam", ".plot.glm", ".plot.lm", ".plot.nnet", ".plot.polymars", ".plot.ppr", ".plot.rlm", ".polymars", ".polymarsDefault", ".polymarsFormula", ".ppr", ".predict.gam", ".predict.glm", ".predict.lm", ".predict.nnet", ".predict.polymars", ".predict.ppr", ".predict.rlm", ".rlm", "GAM3", "LM3", "LOGIT3", "bgTest", "bpTest", "dwTest", "gqTest", "harvTest", "hmcTest", "lmTest", "rainTest", "regFit", "regSim", "resetTest" ) fRegression/R/0000755000176000001440000000000012256315715013000 5ustar ripleyusersfRegression/R/show-methods.R0000644000176000001440000001171611370220736015544 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # S3-METHODS: PRINT METHOD: # show.fREG Prints results from a regression model fit ################################################################################ setMethod(f = "show", signature(object = "fREG"), definition = function(object) { # A function implemented by Diethelm Wuertz # Description: # Print method for Regression Modelling, an object of class "fREG" # FUNCTION: # Title: cat("\nTitle:\n ") cat(as.character(object@title), "\n") # Call: # cat("\nCall:\n") # cat(paste(deparse(object@call), sep = "\n", collapse = "\n"), # "\n", sep = "") # Formula: cat("\nFormula:\n ") # cat(as.character(object@formula), "\n") print(object@formula) # Family: if (object@family[1] != "" && object@family[2] != "") { cat("\nFamily:\n ") cat(as.character(object@family[1:2]), "\n") } # Digits: digits = max(4, getOption("digits") - 4) # Model Parameters: cat("\nModel Parameters:\n") # Regression Model LM / RLM: if (object@method == "lm" | object@method == "rlm") { print.default(format(object@fit$coef, digits = digits), print.gap = 2, quote = FALSE) } # Regression Model GLM: if (object@method == "glm") { if (length(object@fit$coef)) { # if (is.character(co = object@fit$contrasts)) co = object@fit$contrasts if (is.character(co)) cat(" [contrasts: ", apply(cbind(names(co), co), 1, paste, collapse = "="), "]") # cat(":\n") print.default(format(object@fit$coefficients, digits = digits), print.gap = 2, quote = FALSE) } else { cat("No coefficients\n\n") } } # Regression Model GAM: if (object@method == "gam" | object@method == "am") { print.default(format(object@fit$coef, digits = digits), print.gap = 2, quote = FALSE) } # Regression Model PPR: if (object@method == "ppr") { cat("-- Projection Direction Vectors --\n") print(object@fit$alpha) cat("-- Coefficients of Ridge Terms --\n") print(object@fit$beta) } # Regression Model POLYMARS: if (object@method == "polymars") { print(object@fit$coef) } # Regression Model NNET: if (object@method == "nnet") { cat(" a ",object@fit$n[1], "-", object@fit$n[2], "-", object@fit$n[3], " network", " with ", length(object@fit$wts), " weights\n", sep="") cat(" options were -") tconn = diff(object@fit$nconn) if (tconn[length(tconn)] > object@fit$n[2]+1) cat(" skip-layer connections ") if (object@fit$nunits > object@fit$nsunits && !object@fit$softmax) cat(" linear output units ") if (object@fit$entropy) cat(" entropy fitting ") if (object@fit$softmax) cat(" softmax modelling ") if (object@fit$decay[1] > 0) cat(" decay=", object@fit$decay[1], sep="") cat("\n") Weights = object@fit$wts print(Weights) } # Residual Variance: # cat("\nResidual Variance:\n", var(object@fit$residuals)) cat("\n") # Return Value: invisible() }) ################################################################################ fRegression/R/fitted-methods.R0000644000176000001440000000431511370220736016040 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUMCTION: DESCRIPTION REGRESSION METHODS: # fitted.fREG Fitted values method for an object of class fREG ################################################################################ setMethod(f = "fitted", signature(object = "fREG"), definition = function(object) { # A function implemented by Diethelm Wuertz # Description: # Fitted values method for an object of class fREG # FUNCTION: # Fitted Values: fitted = object@fitted # Get original time series class: data = slot(object, "data")$data dataClass = class(data)[1] # Transform: if (dataClass == "timeSeries") { ans = data data.mat = matrix(fitted) rownames(data.mat) = rownames(data) colnames(data.mat) = object@data$unit series(ans) = data.mat colnames(ans) = as.character(object@formula[2]) } else { ans = data } # Return Value: ans }) ################################################################################ fRegression/R/regSim.R0000644000176000001440000000611511370220736014346 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTION: SIMULATION: # regSim Returns a regression example data set ################################################################################ LM3 <- function(n = 100, seed = 4711) { # A function implemented by Diethelm Wuertz # FUNCTION: # LM - Example Data: set.seed(seed) x1 = rnorm(n) x2 = rnorm(n) x3 = rnorm(n) y = 0.75 * x1 + 0.25 * x2 - 0.5 * x3 eps = 0.1 * rnorm(n) y = y + eps data.frame(Y = y, X1 = x1, X2 = x2, X3 = x3) } # ------------------------------------------------------------------------------ LOGIT3 <- function(n = 100, seed = 4711) { # A function implemented by Diethelm Wuertz # FUNCTION: # GLM / BINOMIAL / LOGIT - Example Data: set.seed(seed) x1 = rnorm(n) x2 = rnorm(n) x3 = rnorm(n) eps = 0.1 * rnorm(n) y = 0.75 * x1 + 0.25 * x2 - 0.5 * x3 + eps p = 1 / ( 1 + exp(-y) ) data.frame(Y = p, X1 = x1, X2 = x2, X3 = x3) } # ------------------------------------------------------------------------------ GAM3 <- function(n = 100, seed = 4711) { # A function implemented by Diethelm Wuertz # FUNCTION: # GAM - Example Data: set.seed(seed) x1 = runif(n) x2 = runif(n) x3 = runif(n) y1 = scale(sin(2 * pi * x1)) y2 = scale(exp(x2)) y3 = scale(x3) y = scale(y1 + y2 + y3) eps = 0.1 * rnorm(n, sd = sd(y)) y = y + eps data.frame(Y = y, X1 = x1, X2 = x2, X3 = x3) } # ------------------------------------------------------------------------------ regSim = function(model = "LM3", n = 100, ...) { # A function implemented by Diethelm Wuertz # FUNCTION: # Simulate: funSim = match.fun(model) ans = funSim(n = n, ...) # Return Value: ans } ################################################################################ fRegression/R/formula-methods.R0000644000176000001440000000361411370220736016227 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTION: DESCRIPTION REGRESSION METHODS: # formula.fREG Returns formula from a fitted regression model ################################################################################ setMethod(f = "formula", signature(x = "fREG"), definition = function(x) { # A function implemented by Diethelm Wuertz # Description: # Extracts 'fREG' Model Formula # Arguments: # object - an object of class fREG as returned by the function # regFit # FUNCTION: # Formula: ans = slot(x, "formula") # Return Value: ans }) ################################################################################ fRegression/R/residuals-methods.R0000644000176000001440000000432411370220736016554 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTION: DESCRIPTION REGRESSION METHODS: # residuals.fREG Residuals method for an object of class 'fREG' ################################################################################ setMethod(f = "residuals", signature(object = "fREG"), definition = function(object) { # A function implemented by Diethelm Wuertz # Description: # residuals values method for an object of class fREG # FUNCTION: # residuals Values: residuals = object@residuals # Get original time series class: data = object@data$data dataClass = class(data)[1] # Transform: if (dataClass == "timeSeries") { ans = data data.mat = matrix(residuals) rownames(data.mat) = rownames(data) colnames(data.mat) = object@data$unit series(ans) = data.mat colnames(ans) = as.character(object@formula[2]) } else { ans = data } # Return Value: ans }) ################################################################################ fRegression/R/polymars.R0000644000176000001440000001472212256315715014777 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # INTERFACE: FROM POLSPLINE - POLYMARS DESCRIPTION: # .polymars Polymars regress from package polspline # .polymars.default Default wrapper for polymars() # .predict.polymars Formula wrapper for polymars() # .predict.polymars Predict from a polymars model ################################################################################ # Note: # Introduce no .polymars = function() UseMethod() # this fails regFit(..., use = "polymars) # ------------------------------------------------------------------------------ .polymarsFormula <- function(formula, data, ...) { # A function implemented by Diethelm Wuertz # FUNCTION: # Extract Model Data: mf = match.call(expand.dots = FALSE) m = match(c("formula", "data"), names(mf), 0L) mf = mf[c(1L, m)] mf$drop.unused.levels <- TRUE mf[[1L]] <- quote(stats::model.frame) mf = eval(mf, parent.frame()) mt <- attr(mf, "terms") y <- model.response(mf, "numeric") x <- model.matrix(mt, mf) # Rempove Intercept from x if exists ... M = which(colnames(x) == "(Intercept)") if (length(M) > 0) X = x[ ,-M] # Fit: fit = .polymarsDefault(responses = y, predictors = X, ...) # Add to fit: # ... '$coef' keeps model fit$model = mf fit$terms = mt # Class: class(fit) = "polymars" # Return Value: fit } # ------------------------------------------------------------------------------ .polymarsDefault <- function(responses, predictors, maxsize, gcv = 4, additive = FALSE, startmodel, weights, no.interact, knots, knot.space = 3, ts.resp, ts.pred, ts.weights, classify, factors, tolerance = 1e-06, verbose = FALSE) { # A function implemented by Diethelm Wuertz # Arguments: # responses - a vector (or matrix) of responses. (Can be a a vector of # characters for classification) # predictors - a matrix of predictors with same number of cases as # response. Columns are predictors. # Optional Arguments: # maxsize - maximum number of basis function the model can contain # gcv - parameter for overall best model seletion # additive - boolean, is the model to be additive # startmodel - either a matrix (m*4 or m*5) or a polymars object from # a previous call to polymars # an initial model the procedure should start with in model # selection # weights - a vector of length equal to the number of cases # no.interact - a 2*l matrix of columns numbers of the predictor # matrix (each row pair cannot have interaction terms) # knots - a vector specifying many knots per predictor are # wanted (with -1 for categorical variables) # ncol(predictors)==length(knots), or a matrix with # ncol(predictors) == ncol(knots) with actual knot # specified and filled out with NA's. # Can also be a single number - "knots" number of knots # per predictor # knot.space - minimum number of order statistics between knots # ts.resp - testset reponses, same format as responses # ts.pred - testset predictors, same format as predictors # ts.weights - testset weights, same format as weights # classify - whether classification is to be done, set = TRUE if the # response vector is integer, if # if character classify is automatically true # factors - a vector of column numbers of the predictor matrix of # categorical variables # tolerance - a numerical parameter which may need to be made smaller # if the program crashes store the call to the polymars # function # FUNCTION: # require(polspline) print(head(responses)) print(head(predictors)) # Fit: .Call <- match.call() .Call[[1]] <- quote(polspline::polymars) ans = eval(.Call, parent.frame()) # Add Coefficients Parameters: ans$coef = ans$model ans$parameters = ans$coef ans$fitted.values = ans$fitted # Return Value: ans } # ------------------------------------------------------------------------------ .predict.polymars <- function(object, newdata, se.fit = FALSE, type = "response", ...) { # Note: # newdata is a predictor data.frame, if missing the fitted # vector will be returned. # Example: # x=LM3(); object1 = regFit(Y ~ X1+X2+X3, data = x, use = "polymars")@fit # .predict.polymars(object, newdata = x[, -1]) # FUNCTION: # Restore Object Model: object$model = object$coef class(object) = "polymars" # Polymars requires 1-column matrices: object$residuals = matrix(object$residuals) object$fitted = matrix(object$fitted) # Here, object is expected to be the slot @fit of an object of class 'fREG' if (missing(newdata)) { y = as.vector(object$fitted) } else { tt = object$terms Terms = delete.response(tt) modelFrame = model.frame(Terms, newdata) X = model.matrix(Terms, modelFrame)[, -1] Y = polspline::predict.polymars(object, x = X, ...) } # Add optionally standard errors - NA's not available yet ... if (se.fit) Y = list(fit = Y, se.fit = NA*Y) # Return Value: Y } ################################################################################ fRegression/R/regFit.R0000644000176000001440000001374411370220736014346 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTION: PARAMETER ESTIMATION: # regFit Wrapper Function for Regression Models # .lmFit Linear Regression Model # .rlmFit Robust Linear Regression Model # .glmFit Generalized Linear Model # .gamFit Generalized Additive Model # .pprFit Projection Pursuit Regression Model # .nnetFit Feedforward Neural Network Model # .polymarsFit Polytochomous MARS Model ################################################################################ ################################################################################ # MODEL: PACKAGE print plot summary print predict # persp summary # lm stats x x x x x # rlm MASS # glm stats x - x x x # gam mgcv x x x x x # ppr modreg x x x x x # nnet nnet x - x x x # polymars* polspline - xx x - x ################################################################################ regFit <- function (formula, data, family = gaussian, use = c("lm", "rlm", "glm", "gam", "ppr", "nnet", "polymars"), title = NULL, description = NULL, ...) { # A function implemented by Diethelm Wuertz # Description: # Common function call for several selected regression models. # Details: # This is a wrapper function for the following regrssion models: # LM Linear Regression Modelling # RLM Robust Linear Regression Modelling # GLM Generalized Linear Modelling # GAM Generalized Additive Modelling # PPR Projection Pursuit Regression # NNET Feedforward Neural Net # POLYMARS Polytochomous MARS Modeling # Notes: # Available Methods are # "print", "plot", "summary", "predict" # "coef", "formula", "residuals" "fitted", "vcov" # Example: # regFit(Y ~ X1 + X2 + X3, regSim()) # FUNCTION: # Match Arguments: use = match.arg(use) # Transform data into a dataframe Data <- if (inherits(data, "timeSeries")) data else as.timeSeries(data) data = as.data.frame(data) # Function to be called: fun = paste(".", match.arg(use), sep = "") # Title: if (is.null(title)) { if (use == "lm") title = "Linear Regression Modeling" if (use == "rlm") title = "Robust Linear Regression Modeling" if (use == "glm") title = "Generalized Linear Modeling" if (use == "gam") title = "Generalized Additive Modeling" if (use == "ppr") title = "Projection Pursuit Regression" if (use == "nnet") title = "Feedforward Neural Network Modeling" if (use == "polymars") title = "Polytochomous MARS Modeling" } # Description: if (is.null(description)) { description = description() } # Compose Command to be Called: cmd = match.call() if (!is.null(cmd$use)) cmd = cmd[-match("use", names(cmd), 0)] cmd[[1]] <- as.name(fun) # Ensure that data is a data.frame if (!is.null(cmd$data)) cmd$data <- call("as.data.frame", cmd$data) # Fit Regression Model: fit <- eval(cmd, parent.frame()) # Add "cmd" to Fit: fit$cmd = cmd # Add "xlevels" to Fit (if missing): if (is.null(fit$xlevels)) fit$xlevels = list() # Add "residuals" and "fitted" to Fit (to be sure ...): fit$residuals = as.vector(fit$residuals) fit$fitted.values = as.vector(fit$fitted.values) # Add "parameters" as Alternative: fit$parameters = fit$coef # Extend to class "list": class(fit) = c("list", class(fit)) if (!inherits(fit, "lm")) class(fit) = c(class(fit), "lm") # Return Value: new("fREG", call = as.call(match.call()), formula = as.formula(formula), family = as.character(gaussian()), method = use, # data is data.frame, Data original input: data = list(data = data, Data = Data), fit = fit, residuals = fit$residuals, fitted = fit$fitted.values, title = as.character(title), description = as.character(description) ) } # ------------------------------------------------------------------------------ .lm <- stats::lm .rlm <- MASS::rlm .glm <- stats::glm .gam <- mgcv::gam .ppr <- function(..., nterms = 2) stats::ppr(..., nterms = nterms) .nnet <- function(..., trace = FALSE, size = 2, linout = TRUE) nnet::nnet(..., trace = trace, size = size, linout = linout) .polymars <- .polymarsFormula ################################################################################ fRegression/R/vcov-methods.R0000644000176000001440000000364311370220736015541 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTION: DESCRIPTION REGRESSION METHODS: # vcov.fREG Returns Covariance from a fitted regression model ################################################################################ setMethod(f = "vcov", signature(object = "fREG"), definition = function(object) { # A function implemented by Diethelm Wuertz # Description: # Extracts 'fREG' Model Covariance # Arguments: # object - an object of class fREG as returned by the function regFit # FUNCTION: # Numeric vector of fitted values: ans = vcov(object@fit) # Return Value: ans }) ################################################################################ fRegression/R/summary-methods.R0000644000176000001440000002741312157313037016263 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTION: DESCRIPTION: # summary Summary method for an object of class 'fREG' ################################################################################ setMethod(f = "summary", signature(object = "fREG"), definition = function(object, ...) { # A function implemented by Diethelm Wuertz # Description: # Summary method for Regression Modelling, an object of class "fREG" # FUNCTION: # Digits: digits = max(4, getOption("digits") - 4) # Print all from print Method: print(object) # Add Residual Variance: cat("Residual Variance:\n", var(object@fit$residuals)) cat("\n\n") # Internal Function: fResiduals fResiduals = function(x, digits) { cat("Non-Weighted Residuals:\n") names = c("Min", "1Q", "Median", "3Q", "Max") rq = structure(quantile(x), names = names) print(rq, digits = digits) names = c("Variance", "StDev", "Skewness", "Kurtosis") skewness = sum((x - mean(x))^3/sqrt(var(x))^3)/length(x) kurtosis = sum((x - mean(x))^4/var(x)^2)/length(x) - 3 rq = structure(c(var(x), sqrt(var(x)), skewness, kurtosis), names = names) print(rq, digits = digits) print("done") cat("\n") invisible() } # Internal Function: print.summary.LM print.summary.LM = function (x, ...) { digits = max(4, getOption("digits") - 4) symbolic.cor = x$symbolic.cor signif.stars = getOption("show.signif.stars") # cat("\nCall:\n") # cat(paste(deparse(x$call), sep = "\n", collapse = "\n"), # "\n\n", sep = "") aliased = x$aliased resid = x$residuals df = x$df rdf = df[2] cat(if (!is.null(x$w) && diff(range(x$w))) "Weighted ", "Residuals:\n", sep = "") if (rdf > 5) { nam = c("Min", "1Q", "Median", "3Q", "Max") rq = if (length(dim(resid)) == 2) structure(apply(t(resid), 1, quantile), dimnames = list(nam, dimnames(resid)[[2]])) else structure(quantile(resid), names = nam) print(rq, digits = digits, ...) } else if (rdf > 0) { print(resid, digits = digits, ...) } else { cat("ALL", df[1], "residuals are 0: no residual ", "degrees of freedom!\n") } if (length(aliased) == 0) { cat("\nNo Coefficients\n") } else { if (nsingular<-df[3] - df[1]) { cat("\nCoefficients: (", nsingular, " not defined ", "because of singularities)\n", sep = "") } else { cat("\nCoefficients:\n") } coefs = x$coefficients if (!is.null(aliased) && any(aliased)) { cn = names(aliased) coefs = matrix(NA, length(aliased), 4, dimnames = list(cn, colnames(coefs))) coefs[!aliased, ] = x$coefficients } printCoefmat(coefs, digits = digits, signif.stars = signif.stars, na.print = "NA", ...) } cat("\nResidual standard error:", format(signif(x$sigma, digits)), "on", rdf, "degrees of freedom\n") if (!is.null(x$fstatistic)) { cat("Multiple R-Squared:", formatC(x$r.squared, digits = digits)) cat(", Adjusted R-squared:", formatC(x$adj.r.squared, digits = digits), "\nF-statistic:", formatC(x$fstatistic[1], digits = digits), "on", x$fstatistic[2], "and", x$fstatistic[3], "DF, p-value:", format.pval(pf(x$fstatistic[1], x$fstatistic[2], x$fstatistic[3], lower.tail = FALSE), digits = digits), "\n") } correl = x$correlation if (!is.null(correl)) { p = NCOL(correl) if (p > 1) { cat("\nCorrelation of Coefficients:\n") if (is.logical(symbolic.cor) && symbolic.cor) { print(symnum(correl, abbr.colnames = NULL)) } else { correl = format(round(correl, 2), nsmall = 2, digits = digits) correl[!lower.tri(correl)] = "" print(correl[-1, -p, drop = FALSE], quote = FALSE) }} } cat("\n") invisible() } # Internal Function: print.summary.GLM print.summary.GLM = function (x, ...) { digits = max(4, getOption("digits") - 4) symbolic.cor = x$symbolic.cor signif.stars = getOption("show.signif.stars") aliased = x$aliased df = x$df #cat("\nCall:\n") #cat(paste(deparse(x$call), sep = "\n", collapse = "\n"), # "\n\n", sep = "") cat("Deviance Residuals: \n") if (x$df.residual > 5) { x$deviance.resid = quantile(x$deviance.resid, na.rm = TRUE) names(x$deviance.resid) = c("Min", "1Q", "Median", "3Q", "Max") } print.default(x$deviance.resid, digits = digits, na.print = "", print.gap = 2) if (length(aliased) == 0) { cat("\nNo Coefficients\n") } else { if (!is.null(df) && (nsingular = df[3] - df[1])) cat("\nCoefficients: (", nsingular, " not defined ", "because of singularities)\n", sep = "") else cat("\nCoefficients:\n") coefs = x$coefficients if (!is.null(aliased) && any(aliased)) { cn = names(aliased) coefs = matrix(NA, length(aliased), 4, dimnames = list(cn, colnames(coefs))) coefs[!aliased, ] = x$coefficients } printCoefmat(coefs, digits = digits, signif.stars = signif.stars, na.print = "NA", ...) } cat("\n(Dispersion parameter for ", x$family$family, " family taken to be ", format(x$dispersion), ")\n\n", apply(cbind(paste(format(c("Null", "Residual"), width = 8, flag = ""), "deviance:"), format(unlist(x[c("null.deviance", "deviance")]), digits = max(5, digits + 1)), " on", format(unlist(x[c("df.null", "df.residual")])), " degrees of freedom\n"), 1, paste, collapse = " "), "AIC: ", format(x$aic, digits = max(4, digits + 1)), "\n\n", "Number of Fisher Scoring iterations: ", x$iter, "\n", sep = "") correl = x$correlation if (!is.null(correl)) { p = NCOL(correl) if (p > 1) { cat("\nCorrelation of Coefficients:\n") if (is.logical(symbolic.cor) && symbolic.cor) { print(symnum(correl, abbr.colnames = NULL)) } else { correl = format(round(correl, 2), nsmall = 2, digits = digits) correl[!lower.tri(correl)] = "" print(correl[-1, -p, drop = FALSE], quote = FALSE) }}} cat("\n") invisible() } # Internal Function: print.summary.GAM print.summary.GAM = function(x, ...) { if (length(x$p.coeff) > 0) { cat("Parametric coefficients:\n") width = max(nchar(names(x$p.coeff))) cat(rep(" ",width), " Estimate std. err. t ratio", " Pr(>|t|)\n", sep = "") for (i in 1:length(x$p.coeff)) cat(formatC(names(x$p.coeff)[i], width = width), " ", formatC(x$p.coeff[i], width=10, digits=5), " ", formatC(x$se[i], width = 10, digits = 4), " ", formatC(x$p.t[i], width = 10, digits = 4), " ", format.pval(x$p.pv[i]), "\n", sep="") } cat("\n") if (x$m > 0) { cat("Approximate significance of smooth terms:\n") width = max(nchar(names(x$chi.sq))) cat(rep(" ",width), " edf chi.sq ", "p-value\n", sep = "") for (i in 1:x$m) cat(formatC(names(x$chi.sq)[i], width = width), " ", formatC(x$edf[i], width = 10, digits = 4), " ", formatC(x$chi.sq[i], width = 10, digits = 5), " ", format.pval(x$s.pv[i]), "\n", sep = "") } cat("\nR-sq.(adj) = ", formatC(x$r.sq, digits = 3, width = 5), " Deviance explained = ", formatC(x$dev.expl*100, digits = 3, width = 4), "%", sep = "") if (is.null(x$ubre)) { cat("\nGCV score = ", formatC(x$gcv, digits = 5), " ", sep = "") } else { cat("\nUBRE score = ", formatC(x$ubre, digits = 5), sep = "") } cat(" Scale est. = ", formatC(x$scale, digits = 5, width = 8, flag = "-"), " n = ", x$n, "\n", sep = "") invisible() } # Fit: fit = object@fit # Regression Model: LM if (object@method == "lm") { class(fit) = "lm" ans = summary.lm(object = fit, ...) print.summary.LM(x = ans, ...) } # Regression Model: GLM if (object@method == "glm") { class(fit) = c("glm", "lm") ans = summary.glm(object = fit, ...) print.summary.GLM(x = ans, ...) } # Regression Model: GAM if (object@method == "gam") { class(fit) = "gam" ans = summary.gam(object = fit, ...) print.summary.GAM(x = ans, ...) } # Regression Model: PPR if (object@method == "ppr") { # This is what print.ppr produces. mu = fit$mu; ml = fit$ml cat("Goodness of fit:\n") gof = fit$gofn; names(gof) = paste(1:ml, "terms") print(format(gof[mu:ml], ...), quote = FALSE) # This is what summary.ppr produces. if (any(fit$edf > 0)) { cat("\nEquivalent df for ridge terms:\n") edf = fit$edf names(edf) = paste("term", 1:fit$mu) print(round(edf, 2), ...)} } # Regression Model: POLYMARS if (object@method == "polymars") { class(fit) = "polymars" # This is what summary.polymars produces. # There is no print.summary.polymars. cat("Model Fitting:\n") print(fit$fitting) if(fit$responses != 1) cat("\nResponses:", fit$responses, "\n") if(!is.null(fit$Rsquared)) cat("\nRsquared:",round(fit$Rsquared, 4),"\n") cat("\n") } # Regression Model: NNET if (object@method == "nnet") { # Use the print Method } # Return Value: invisible() }) ################################################################################ fRegression/R/plot-methods.R0000644000176000001440000001721011370220736015535 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # S3-METHODS: PLOT METHOD: # plot.fREG Plots fit and diagnostics for a regression model # .plot.lm Linear Regression Model internal plot # .plot.rlm Robust Linear Regression Model internal plot # .plot.glm Generalized Linear Model internal plot # .plot.gam Generalized Additive Model internal plot # .plot.ppr Projection Pursuit Regression Model internal plot # .plot.polymars Polytochomous MARS Model internal plot # .plot.nnet Feedforward Neural Network Model internal plot # PLOTS: DESCRIPTION: # .interactiveRegPlot # .multRegPlot ################################################################################ setMethod(f = "plot", signature(x = "fREG", y = "missing"), definition = function(x, which = "ask", ...) { # A function implemented by Diethelm Wuertz # Description: # Plot method for an object of class 'fGARCH' # Note: # This method can also be used for plotting graphs fitted by # the function 'garch' from the contributed R package 'tseries'. # FUNCTION: # Plot: .plot(x@fit, which = which, ...) # Return Value: invisible(x) }) # ------------------------------------------------------------------------------ .plot.common <- function(x, which = "ask", ...) { # A function implemented by Diethelm Wuertz # Notes: # 1. Responses + Fitted Values Plot: # 2. Residuals Plot: # 3. Quantile Plot: # 4. Fitted Values vs. Residuals Plot: # FUNCTION: # Plot: .interactiveRegPlot( x, choices = c( "Responses + Fitted Values", "Residuals", "Normal Q-Q", "Residuals vs Fitted", "ACF of Residuals", "PACF of Residuals", "Positive Mean Excess Plot", "Negative Mean Excess Plot"), plotFUN = paste(".plot.", 1:8, sep = ""), which = which) # Return Value: invisible(x) } # ------------------------------------------------------------------------------ .plot.1 <- function(x, ...) .responsesPlot(residuals(x)+fitted(x),fitted(x)) .plot.2 <- function(x, ...) .residualsPlot(residuals(x)) .plot.3 <- function(x, ...) qqnormPlot(residuals(x)) .plot.4 <- function(x, ...) .firePlot(fitted(x), residuals(x)) .plot.5 <- function(x, ...) .acfPlot(residuals(x)) .plot.6 <- function(x, ...) .pacfPlot(residuals(x)) .plot.7 <- function(x, ...) .mrlPlot(residuals(x)) .plot.8 <- function(x, ...) .mrlPlot(-residuals(x)) # ------------------------------------------------------------------------------ .plot.lm <- .plot.common .plot.rlm <- .plot.common .plot.glm <- .plot.common .plot.gam <- .plot.common .plot.ppr <- .plot.common .plot.nnet <- .plot.common .plot.polymars <- .plot.common # ------------------------------------------------------------------------------ .interactiveRegPlot <- function(x, choices = paste("Plot", 1:19), plotFUN = paste("plot.", 1:19, sep = ""), which = "all", ...) { # A function implemented by Diethelm Wuertz # Description: # Interactive plot method. # Arguments: # x - an object to be plotted # choices - the character string for the choice menu # plotFUN - the names of the plot functions # which - plot selection, which graph should be # displayed. If a character string named "ask" the # user is interactively asked which to plot, if # a logical vector of length N, those plots which # are set "TRUE" are displayed, if a character string # named "all" all plots are displayed. # Note: # At maximum 19 plots are supported. # FUNCTION: # Some cecks: if (length(choices) != length(plotFUN)) stop("Arguments choices and plotFUN must be of same length.") if (length(which) > length(choices)) stop("Arguments which has incorrect length.") if (length(which) > length(plotFUN)) stop("Arguments which has incorrect length.") if (length(choices) > 19) stop("Sorry, only 19 plots at max are supported.") # Plot: if (is.numeric(which)) { Which = rep(FALSE, times = length(choices)) Which[which] = TRUE which = Which } if (which[1] == "all") { which = rep(TRUE, times = length(choices)) } if (which[1] == "ask") { .multRegPlot(x, choices, plotFUN = plotFUN, ...) } else { for ( i in 1:length(which) ) { FUN = match.fun(plotFUN[i]) if (which[i]) FUN(x) } } # Return Value: invisible(x) } # ------------------------------------------------------------------------------ .multRegPlot <- function (x, choices, plotFUN, ...) { # A function implemented by Diethelm Wuertz # Description: # Arguments: # FUNCTION: # Match Functions, up to nine(teen) ... if (length(plotFUN) < 19) plotFUN = c(plotFUN, rep(plotFUN[1], times = 19 - length(plotFUN))) plot.1 = match.fun(plotFUN[1]); plot.2 = match.fun(plotFUN[2]) plot.3 = match.fun(plotFUN[3]); plot.4 = match.fun(plotFUN[4]) plot.5 = match.fun(plotFUN[5]); plot.6 = match.fun(plotFUN[6]) plot.7 = match.fun(plotFUN[7]); plot.8 = match.fun(plotFUN[8]) plot.9 = match.fun(plotFUN[9]); plot.10 = match.fun(plotFUN[10]) plot.11 = match.fun(plotFUN[11]); plot.12 = match.fun(plotFUN[12]) plot.13 = match.fun(plotFUN[13]); plot.14 = match.fun(plotFUN[14]) plot.15 = match.fun(plotFUN[15]); plot.16 = match.fun(plotFUN[16]) plot.17 = match.fun(plotFUN[17]); plot.18 = match.fun(plotFUN[18]) plot.19 = match.fun(plotFUN[19]) pick = 1 while (pick > 0) { pick = menu ( ### choices = paste("plot:", choices), choices = paste(" ", choices), title = "\nMake a plot selection (or 0 to exit):") # up to 19 plot functions ... switch (pick, plot.1(x), plot.2(x), plot.3(x), plot.4(x), plot.5(x), plot.6(x), plot.7(x), plot.8(x), plot.9(x), plot.10(x), plot.11(x), plot.12(x), plot.13(x), plot.14(x), plot.15(x), plot.16(x), plot.17(x), plot.18(x), plot.19(x)) } } ################################################################################ fRegression/R/terms-methods.R0000644000176000001440000000361111370220736015711 0ustar ripleyusers # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # A copy of the GNU General Public License is available via WWW at # http://www.gnu.org/copyleft/gpl.html. You can also obtain it by # writing to the Free Software Foundation, Inc., 59 Temple Place, # Suite 330, Boston, MA 02111-1307 USA. # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTIONS: REGRESSION TERMS: # terms.fREG Extracts 'fREG' Model Terms ################################################################################ setMethod(f = "terms", signature(x = "fREG"), definition = function(x, ...) { # A function implemented by Diethelm Wuertz # Description: # Extracts 'fREG' Model Terms # Arguments: # object - an object of class fREG as returned by the function # regFit # FUNCTION: # Formula: ans = stats::terms(slot(x, "fit"), ...) # Return Value: ans }) ################################################################################ fRegression/R/fREG-class.R0000644000176000001440000000345511370220736015012 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTION: DESCRIPTION: # 'fREG' fREG Class representation ################################################################################ setClass("fREG", # Class Representation representation( call = "call", formula = "formula", family = "character", method = "character", data = "list", fit = "list", residuals = "numeric", fitted = "numeric", title = "character", description = "character" ) ) ################################################################################ fRegression/R/predict-methods.R0000644000176000001440000000741111370220736016213 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTION: DESCRIPTION REGRESSION METHODS: # predict.fREG Predicts values from a fitted regression model ################################################################################ setMethod(f = "predict", signature(object = "fREG"), definition = function(object, newdata, se.fit = FALSE, type = "response", ...) { # A function implemented by Diethelm Wuertz # Description: # Predict method for Regression Modelling, an object of class "fREG" # FUNCTION: # Fit: fit = object@fit # Data as data.frame: if (missing(newdata)) { newdata = object@data$data } # Predict: if (object@method == "nnet" & type == "response") type = "raw" ans = .predict(object = fit, newdata = newdata, se.fit = se.fit, type = type, ...) # Make the output from 'predict' unique: if (se.fit) { if (!is.list(ans)) { if (is.matrix(ans)) ans = as.vector(ans) names(ans) = rownames(newdata) ans = list(fit = ans, se.fit = NA*ans) } else { ans = ans[1:2] } } else { if (is.matrix(ans)) ans = as.vector(ans) names(ans) = rownames(newdata) } # Return Value: ans }) # ------------------------------------------------------------------------------ # Note, in the following "object" concerns to the slot @fit: .predict.lm <- predict.lm # <- function (object, newdata, se.fit = FALSE, scale = NULL, df = Inf, # interval = c("none", "confidence", "prediction"), level = 0.95, # type = c("response", "terms"), terms = NULL, na.action = na.pass, # pred.var = res.var/weights, weights = 1, ...) .predict.rlm <- predict.lm # .predict.glm <- predict.glm # <- function (object, newdata = NULL, type = c("link", "response", # "terms"), se.fit = FALSE, dispersion = NULL, terms = NULL, # na.action = na.pass, ...) .predict.gam <- predict.gam # <- function (object, newdata, type = "link", se.fit = FALSE, terms = NULL, # block.size = 1000, newdata.guaranteed = FALSE, na.action = na.pass, # ...) .predict.ppr <- function(object, ...) { predict(object, ...) } # <- function(object, newdata, ...) .predict.nnet <- function(object, ...) { predict(object, ...) } # <- function(object, newdata, type=c("raw","class"), ...) #predict.polymars ---- can be found in polymars.R # <- function(object, newdata, se.fit = FALSE, type = "response", ...) ################################################################################ fRegression/R/coef-methods.R0000644000176000001440000000365611370220736015504 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTION: DESCRIPTION REGRESSION METHODS: # coef.fREG Returns coefficients from a fitted regression model ################################################################################ setMethod(f = "coef", signature(object = "fREG"), definition = function(object) { # A function implemented by Diethelm Wuertz # Description: # Extracts 'fREG' Model Coefficients # Arguments: # object - an object of class fREG as returned by the function regFit # FUNCTION: # Numeric vector of fitted values: ans = slot(object, "fit")$coef # Return Value: ans }) ################################################################################ fRegression/R/termPlot-methods.R0000644000176000001440000000361411370220736016370 0ustar ripleyusers # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # A copy of the GNU General Public License is available via WWW at # http://www.gnu.org/copyleft/gpl.html. You can also obtain it by # writing to the Free Software Foundation, Inc., 59 Temple Place, # Suite 330, Boston, MA 02111-1307 USA. # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTIONS: REGRESSION TERMS: # termPlot.fREG Displays 'fREG' Model Term Plots ################################################################################ termPlot.fREG <- ## setMethod(f = "termPlot", signature(model = "fREG"), definition = function(model, ...) { # A function implemented by Diethelm Wuertz # Description: # Displays 'fREG' Model Term Plots # Arguments: # model - an object of class fREG as returned by the function # regFit # FUNCTION: # Formula: ans = termplot(slot(model, "fit"), ...) # Return Value: ans } #) ################################################################################ fRegression/R/fittedPlot.R0000644000176000001440000001205511370220736015236 0ustar ripleyusers # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # A copy of the GNU General Public License is available via WWW at # http://www.gnu.org/copyleft/gpl.html. You can also obtain it by # writing to the Free Software Foundation, Inc., 59 Temple Place, # Suite 330, Boston, MA 02111-1307 USA. # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTION: REGRESSION TERM PLOTS: # .fittedPlot Line Plot # .fittedPersp Perspective Plot # .fittedContour Contour Plot ################################################################################ .fittedPlot = function(object, which = NULL) { # A function implemented by Diethelm Wuertz # Description: # Arguments: # object - an object of class 'fREG' as returned by the function regFit # FUNCTION: model = object@fit$model responseName = colnames(model)[attr(terms(object), "response")] model.mat = as.matrix(object@fit$model)[,-attr(terms(object), "response")] N = NCOL(model.mat) zero = rep(0, times = N) if (is.null(which)) which = 1:N colNames = colnames(model.mat)[which] ans = NULL for (i in which) { one = zero one[i] = 1 new.model.mat = model.mat new.model.mat = 0 * model.mat x = new.model.mat[, i] = model.mat %*% one y = predict(object, newdata = as.data.frame(new.model.mat)) ans = cbind(ans, y) plot(x, y, xlab = colNames[i], ylab = paste("Fitted", colNames[i])) } colnames(ans) = paste(responseName, "(", colNames, ")", sep = "") as.data.frame(ans) } # ------------------------------------------------------------------------------ .fittedPersp <- function(object) { # A function implemented by Diethelm Wuertz # Description: # Arguments: # object - an object of class 'fREG' as returned by the function regFit # FUNCTION: # Settings: model = object@fit$model responseName = colnames(model)[attr(terms(object), "response")] model.mat = as.matrix(object@fit$model)[,-attr(terms(object), "response")] N = NCOL(model.mat) colNames = colnames(model.mat) for (i in 1:(N-1)) { rangeX = range(model.mat[, i]) X = seq(rangeX[1], rangeX[2], length = 10) newdata = matrix(rep(0, times = N*10*10), ncol = N) newdata[ ,i] = X for (j in (i+1):N) { rangeY = range(model.mat[, j]) Y = seq(rangeY[1], rangeY[2], length = 10) XY = gridVector(X, Y) newdata[, j] = Y colnames(newdata) = colNames print(head(newdata)) Z = predict(object, as.data.frame(newdata)) Z = matrix(Z, ncol = 10) .perspPlot(X, Y, Z, xlab = colNames[i], ylab = colNames[j]) } } } # ------------------------------------------------------------------------------ .fittedContour <- function(object) { # A function implemented by Diethelm Wuertz # Description: # Arguments: # object - an object of class 'fREG' as returned by the function regFit # FUNCTION: # Settings: model = object@fit$model responseName = colnames(model)[attr(terms(object), "response")] model.mat = as.matrix(object@fit$model)[,-attr(terms(object), "response")] N = NCOL(model.mat) colNames = colnames(model.mat) for (i in 1:(N-1)) { rangeX = range(model.mat[, i]) X = seq(rangeX[1], rangeX[2], length = 10) newdata = matrix(rep(0, times = N*10*10), ncol = N) newdata[ ,i] = X for (j in (i+1):N) { rangeY = range(model.mat[, j]) Y = seq(rangeY[1], rangeY[2], length = 10) XY = gridVector(X, Y) newdata[, j] = Y colnames(newdata) = colNames print(head(newdata)) Z = predict(object, as.data.frame(newdata)) Z = matrix(Z, ncol = 10) .contourPlot(X, Y, Z, xlab = colNames[i], ylab = colNames[j]) } } } ################################################################################ fRegression/R/zzz.R0000644000176000001440000000343712161634507013765 0ustar ripleyusers # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License as published by the Free Software Foundation; either # version 2 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU Library General Public License for more details. # # You should have received a copy of the GNU Library General # Public License along with this library; if not, write to the # Free Foundation, Inc., 59 Temple Place, Suite 330, Boston, # MA 02111-1307 USA # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ ## .First.lib = ## function(lib, pkg) ## { ## # Startup Mesage and Desription: ## MSG <- if(getRversion() >= "2.5") packageStartupMessage else message ## dsc <- packageDescription(pkg) ## if(interactive() || getOption("verbose")) { ## # not in test scripts ## MSG(sprintf("Rmetrics Package %s (%s) loaded.", pkg, dsc$Version)) ## } ## # Load dll: ## library.dynam("fRegression", pkg, lib) ## } if(!exists("Sys.setenv", mode = "function")) # pre R-2.5.0, use "old form" Sys.setenv <- Sys.putenv ################################################################################ fRegression/R/lmTest.R0000644000176000001440000001307012157313037014367 0ustar ripleyusers # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # A copy of the GNU General Public License is available via WWW at # http://www.gnu.org/copyleft/gpl.html. You can also obtain it by # writing to the Free Software Foundation, Inc., 59 Temple Place, # Suite 330, Boston, MA 02111-1307 USA. # Copyrights (C) # for this R-port: # 1999 - 2008, Diethelm Wuertz, Rmetrics Foundation, GPL # Diethelm Wuertz # info@rmetrics.org # www.rmetrics.org # for the code accessed (or partly included) from other R-ports: # see R's copyright and license files # for the code accessed (or partly included) from contributed R-ports # and other sources # see Rmetrics's copyright file ################################################################################ # FUNCTION: TIME SERIES TESTS # lmTest Linear Modelling Test, select from: # bgTest Breusch-Godfrey Test # bpTest Breusch-Pagan Test # dwTest Durbin-Watson Test # gqTest Goldfeld-Quandt Test # harvTest Harvey-Collier Test # hmcTest Harrison-McCabe Test # rainTest Rainbow Test # resetTest Ramsey's RESET Test ################################################################################ ################################################################################ # BUILTIN - PACKAGE DESCRIPTION: # Package: lmtest # Title: Testing Linear Regression Models # Version: 0.9-3 # Date: $Date: 2003/02/19 15:54:30 $ # Author: Torsten Hothorn , # Achim Zeileis , David Mitchell # Maintainer: Achim Zeileis # Description: A collection of tests, data sets and examples # for diagnostic checking in linear regression models. # Depends: R (>= 1.4.0) # License: GPL ################################################################################ lmTest <- function(formula, method = c("bg", "bp", "dw", "gq", "harv", "hmc", "rain", "reset"), data = list(), ...) { # A function implemented by Diethelm Wuertz # FUNCTION: # Load Library: # Here we use a BUILTIN ... # require(lmtest) # Settings: method = match.arg(method) # DW: if (method == "dw") ans = lmtest::dwtest(formula = formula, data = data, ...) # BP: if (method == "bp") ans = lmtest::bptest(formula = formula, data = data, ...) # GQ: if (method == "gq") ans = lmtest::gqtest(formula = formula, data = data, ...) # HMC: if (method == "hmc") ans = lmtest::hmctest(formula = formula, data = data, ...) # HARV: if (method == "harv") ans = lmtest::harvtest(formula = formula, data = data, ...) # RAIN: if (method == "rain") ans = lmtest::raintest(formula = formula, data = data, ...) # RESET: if (method == "reset") ans = lmtest::reset(formula = formula, data = data, ...) # BG: if (method == "bg") ans = lmtest::bgtest(formula = formula, data = data, ...) # Return Result: ans } # ****************************************************************************** dwTest <- function(formula, alternative = c("greater", "two.sided", "less"), iterations = 15, exact = NULL, tol = 1.0e-10, data = list()) { lmtest::dwtest(formula, alternative, iterations, exact, tol, data) } # ------------------------------------------------------------------------------ bpTest <- function(formula, varformula = NULL, studentize = TRUE, data = list()) { lmtest::bptest(formula, varformula, studentize, data) } # ------------------------------------------------------------------------------ gqTest <- function(formula, point=0.5, order.by = NULL, data = list()) { lmtest::gqtest(formula, point, order.by, data) } # ------------------------------------------------------------------------------ hmcTest <- function(formula, point = 0.5, order.by = NULL, simulate.p = TRUE, nsim = 1000, plot = FALSE, data = list()) { lmtest::hmctest(formula, point, order.by, simulate.p, nsim, plot, data) } # ------------------------------------------------------------------------------ harvTest <- function(formula, order.by = NULL, data = list()) { lmtest::harvtest(formula, order.by, data) } # ------------------------------------------------------------------------------ rainTest = function(formula, fraction = 0.5, order.by = NULL, center = NULL, data = list()) { lmtest::raintest(formula, fraction, order.by, center, data) } # ------------------------------------------------------------------------------ resetTest <- function(formula, power = 2:3, type = c("fitted", "regressor", "princomp"), data = list()) { lmtest::reset(formula, power, type, data) } # ------------------------------------------------------------------------------ bgTest <- function(formula, order = 1, type = c("Chisq", "F"), data = list()) { lmtest::bgtest(formula, order, type, data) } ################################################################################ fRegression/MD50000644000176000001440000000537512261241424013110 0ustar ripleyusers93d0006ec0ad45d5334ec471f69ab506 *ChangeLog 8d1cbd626763da22a58823952f0912d5 *DESCRIPTION 1ef9032ea8e2291bf150674ba4835a0b *NAMESPACE 056fea650d95be1831ed8667a3950b45 *R/coef-methods.R c54e44657bcce48c23025b791e89216c *R/fREG-class.R b8be22a72a84547d77ad6c00fe67e253 *R/fitted-methods.R 7e0204d1e483e55bc94b759fd49d8962 *R/fittedPlot.R 199ff1af7fc5fb934b2de5461a680e78 *R/formula-methods.R 41ca512e43584d9705dd3ade4fc2d001 *R/lmTest.R 274ac3661cc14dda15d3d04c382cf6b0 *R/plot-methods.R b5d461177a1274f5531bf1330531f332 *R/polymars.R b46ac3382cebfbef6057931c8ff318d0 *R/predict-methods.R 209471fa77dcbac773e5adb001067cfe *R/regFit.R 241267f9bbdc5bca0b4f3a8abfbb0750 *R/regSim.R 75138e9b85b596434e2fbd8a7e00fe64 *R/residuals-methods.R 604e0fdf17f45904c30c294912b83394 *R/show-methods.R b2580cec9f2cd521d39d049ce0760c46 *R/summary-methods.R 099970cbbcea3bacdead07f7b728d959 *R/termPlot-methods.R 1dc22bb42d71abdb4c8b7acfb8d1025d *R/terms-methods.R 4a393ea28c1acc2e4d3e16eb5328ce28 *R/vcov-methods.R e3ac35e5c846b78cc60cdeaf5b9e143b *R/zzz.R 6042b9c5e5bec3ecc1b6959cd2858b64 *inst/COPYRIGHT.html 5f16a6861f06eddcf85d0a26ef916d6d *inst/unitTests/Makefile 8e6c3efa2d826d92c1d21a95432e7c20 *inst/unitTests/runTests.R 0915fb7e8c2a5554e422038af29866ea *inst/unitTests/runit.LPP2005.R fd8567bf638bb964f41c5317e9e69fa0 *inst/unitTests/runit.RegressionModelling.R 45948e5a58c3edcf29326d3a92168436 *inst/unitTests/runit.TermPlots.R cd13f953fd7aed4217642f9f678d6e32 *inst/unitTests/runit.TimeSeries.R ae2b3aafed56f5b77af30089cb7bb521 *inst/unitTests/runit.polymars.R 19dcf37d9175424792dc38559eca53b6 *inst/unitTests/runit.regFit.R a7d18fde42f58f378a64a02a653a674a *inst/unitTests/runit.terms.R b490525d26d94f0377bbe48558962bd8 *man/RegressionTestsInterface.Rd 3532c7aca9ee6c439a7fd76a8af6056b *man/coef-methods.Rd a7856292309dba2fe30910d2195f11e6 *man/fREG-class.Rd c96f9e39911f2f0016632253772dc19a *man/fREG-package.Rd 4f48f434b8200abf366e128802117e7c *man/fitted-methods.Rd 0b320a8d2eb00dd7014fb73cc32b87c3 *man/formula-methods.Rd d9e1ee99ba5f487614cf7028c7185e21 *man/plot-methods.Rd 16c635a4370d9b78df0b0e266f912bad *man/predict-methods.Rd c3c739a8763003ab6562c6f861a3f1bf *man/regFit.Rd bc9a4a4535e61789e1c6e8158e9a2531 *man/regSim.Rd 5825590f1702a4095990f13e23728c0b *man/residuals-methods.Rd d54bbf381b978501f370924d403b5df9 *man/show-methods.Rd e6a6914b0490127e6fb96941c7901aa3 *man/summary-methods.Rd dcfa7e8000381f2870a1263edf4846d2 *man/termPlot-methods.Rd a81b94c32434535579a59cd5e71a7ae7 *man/terms-methods.Rd c912dfe0b8d81577309779ac220a708f *man/vcov-methods.Rd 7ba97abe7e0c4c5b73583d0ce48e7cbb *src/LmTests.f 3996e7c16bfb96fad295ee425815cb4d *src/Makevars 624e949f55eafa4911000ea92736445e *src/MarsModelling.f 409902a73d370a8c7648e713011e94bc *tests/Rplots.pdf ca566e590ec30abd0718c5375e1a446f *tests/doRUnit.R fRegression/DESCRIPTION0000644000176000001440000000241312261241424014274 0ustar ripleyusersPackage: fRegression Version: 3010.80 Revision: 5548 Date: 2014-01-02 Title: Regression Based Decision and Prediction Author: Diethelm Wuertz (for the Rmetrics port), R core team (for lm() from R's base and nnet() from nnet package); B.R. Ripley (for glm() from R's base); S.N. Wood (for gam() from mgcv package); N.N. (for ppr() from modreg package); M. O' Connors (for functions from polspline package); and T. Hothorn, A. Zeileis G. Millo and D. Mitchell (for bgtest(), bptest(), dwtest(), gqtest(), harvtest(), hmctest(), raintest(), reset() and resettest() from lmtest package) Depends: R (>= 2.4.0), fBasics, fTrading, fMultivar, mgcv, nnet Imports: methods, polspline, lmtest, MASS Suggests: RUnit Maintainer: Yohan Chalabi Description: Environment for teaching "Financial Engineering and Computational Finance" Note: Several parts are still preliminary and may be changed in the future. this typically includes function and argument names, as well as defaults for arguments and return values. LazyData: yes License: GPL (>= 2) URL: http://www.rmetrics.org Packaged: 2014-01-02 10:31:40 UTC; yohan NeedsCompilation: yes Repository: CRAN Date/Publication: 2014-01-02 11:44:36 fRegression/ChangeLog0000644000176000001440000000342412261240014014335 0ustar ripleyusers2014-01-02 chalabi * DESCRIPTION, NAMESPACE, R/polymars.R, inst/unitTests/runit.RegressionModelling.R, inst/unitTests/runit.TermPlots.R: Using quote instead of as.name when calling polymars(). 2013-12-17 chalabi * ChangeLog, DESCRIPTION, NAMESPACE: updated DESC and ChangeLog * DESCRIPTION: updated DESC 2013-12-10 chalabi * ChangeLog, DESCRIPTION: 2013-06-23 chalabi * DESCRIPTION, R/zzz.R, src/Makevars: updated Fortran flags, version number and removed .First.lib() 2012-12-10 chalabi * ChangeLog, DESCRIPTION: Updated ChangeLog and DESCRIPTION files after submission to CRAN * DESCRIPTION: Updated 'Author' and added 'Imports' fields to reflect third-party functions used in fRegression * NAMESPACE: Updated NAMESPACE * R/summary-methods.R: Fixed partial argument match * R/lmTest.R: Replaced built-in functions by calls to original functions in lmtest package. * NAMESPACE: Added NAMESPACE * DESCRIPTION: Updated version number, maintainer field and 'Note' fields 2011-09-23 mmaechler * DESCRIPTION: remove deprecated "LazyLoad" entry 2010-07-23 chalabi * inst/DocCopying.pdf: removed DocCopying.pdf license is already specified in DESCRIPTION file 2009-09-30 chalabi * DESCRIPTION: updated version number 2009-09-29 chalabi * ChangeLog, DESCRIPTION: updated DESC and ChangeLog 2009-07-14 chalabi * man/RegressionTestsInterface.Rd: fixed equation in Rd 2009-04-02 chalabi * DESCRIPTION: more explicit depends and suggests field in DESC file. 2009-04-01 chalabi * R/regFit.R: regFit data arg is coerced to a data.frame when calling underlying method * DESCRIPTION: updated DESC file 2009-01-28 chalabi * man/fREG-class.Rd, man/plot-methods.Rd, man/regFit.Rd, man/regSim.Rd: updated manual pages to new Rd parser fRegression/man/0000755000176000001440000000000012251673344013352 5ustar ripleyusersfRegression/man/summary-methods.Rd0000644000176000001440000000126111370220736016771 0ustar ripleyusers\name{summary-methods} \docType{methods} \alias{summary-methods} \alias{summary,ANY-method} \alias{summary,fREG-method} \title{Regression Summary Methods} \description{ Summary methods for regressing modelling. } \section{Methods}{ \describe{ \item{object = "ANY"}{ Generic function } \item{object = "fREG"}{ Summary method for objects of class 'fREG'. } } } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## regSim - x = regSim(model = "LM3", n = 50) ## regFit - fit = regFit(Y ~ X1 + X2 + X3, data = x, use = "lm") ## summary summary(fit) } \keyword{models} fRegression/man/plot-methods.Rd0000644000176000001440000000353511370220736016260 0ustar ripleyusers\name{plot-methods} \docType{methods} \alias{plot-methods} \alias{plot,ANY,ANY-method} \alias{plot,fREG,missing-method} \title{Regression Model Plot Methods} \description{ Plots results obtained from a fitted regression model. } \usage{ \S4method{plot}{fREG,missing}(x, which = "ask", \dots) } \arguments{ \item{x}{ an object of class 'fREG'. } \item{which}{ a character string selectiong which plot should be displayed. By default \code{which="ask"} which allows to generate plots interactively. } \item{\dots}{ additional arguments to be passed to the underlying plot functions. } } \section{Methods}{ \describe{ \item{x = "ANY", y = "ANY"}{ Generic function. } \item{x = "fREG", y = "missing"}{ Plot function to display results obtained from a fitted regression model. } } } \details{ The plots are a set of graphs which are common to the regression models implemented in the function \code{regFit}. This includes linear regression models \code{use="lm"}, robust linear regression models \code{use="rlm"}, generalized linear regression models \code{use = "glm"}, generalized additive regression models \code{use = "gam"}, prjection pursuit regression models \code{use = "ppr"}, neural network regression models \code{use = "nnet"}, and polytochomous MARS models \code{use = "polymars"}. In addition one can also use the original plot functions of the original models, .e.g. \code{plot(slot(object, "fit")}. } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## regSim - x = regSim(model = "LM3", n = 50) ## regFit - fit = regFit(Y ~ X1 + X2 + X3, data = x, use = "lm") ## plot - } \keyword{models} fRegression/man/fREG-class.Rd0000644000176000001440000000654511370220736015533 0ustar ripleyusers\name{fREG-class} \docType{class} \alias{fREG-class} \title{Class "fREG"} \description{ The class 'fREG' represents a fitted model of an heteroskedastic time series process. } \section{Objects from the Class}{ Objects can be created by calls of the function \code{regFit}. The returned object represents parameter estimates of linear and generalized linear models. } \section{Slots}{ \describe{ \item{\code{call}:}{Object of class \code{"call"}: the call of the \code{garch} function. } \item{\code{formula}:}{Object of class \code{"formula"}: the formula used in parameter estimation. } \item{\code{family}:}{Object of class \code{"character"}: the family objects provide a convenient way to specify the details of the models used by function \code{grefFit} For details we refer to the documentation for the function \code{glm} in R's base package on how such model fitting takes place. } \item{\code{method}:}{Object of class \code{"character"}: a string denoting the regression model in use, i.e. one of those listed in the \code{use} argument of the function \code{regFit} or \code{gregFit}. } \item{\code{data}:}{Object of class \code{"list"}: a list with at least two entries named \code{x} containing the data frame used for the estimation, and \code{data} with the object of the rectangular input data. } \item{\code{fit}:}{Object of class \code{"list"}: a list with the results from the parameter estimation. The entries of the list depend on the selected algorithm, see below. } \item{\code{residuals}:}{Object of class \code{"numeric"}: a numeric vector with the residual values. } \item{\code{fitted}:}{Object of class \code{"numeric"}: a numeric vector with the fitted values. } \item{\code{title}:}{Object of class \code{"character"}: a title string. } \item{\code{description}:}{Object of class \code{"character"}: a string with a brief description. } } } \section{Methods}{ \describe{ \item{show}{\code{signature(object = "fREG")}: prints an object of class 'fREG'. } \item{plot}{\code{signature(x = "fREG", y = "missing")}: plots an object of class 'fREG'. } \item{summary}{\code{signature(object = "fREG")}: summarizes results and diagnostic analysis of an object of class 'fREG'. } \item{predict}{\code{signature(object = "fREG")}: forecasts mean and volatility from an object of class 'fREG'. } \item{fitted}{\code{signature(object = "fREG")}: extracts fitted values from an object of class 'fREG'. } \item{residuals}{\code{signature(object = "fREG")}: extracts fresiduals from an object of class 'fREG'. } \item{coef}{\code{signature(object = "fREG")}: extracts fitted coefficients from an object of class 'fREG'. } \item{formula}{\code{signature(x = "fREG")}: extracts formula expression from an object of class 'fREG'. } } } \author{ Diethelm Wuertz and Rmetrics Core Team. } \keyword{programming} fRegression/man/RegressionTestsInterface.Rd0000644000176000001440000004467011370220736020632 0ustar ripleyusers\name{RegressionTestsInterface} \alias{RegressionTestsInterface} \alias{lmTest} \alias{bgTest} \alias{bpTest} \alias{dwTest} \alias{gqTest} \alias{harvTest} \alias{hmcTest} \alias{rainTest} \alias{resetTest} \title{Regression Tests} \description{ A collection and description of functions to test linear regression models, including tests for higher serial correlations, for heteroskedasticity, for autocorrelations of disturbances, for linearity, and functional relations. \cr The methods are: \tabular{ll}{ \code{"bg"} \tab Breusch--Godfrey test for higher order serial correlation, \cr \code{"bp"} \tab Breusch--Pagan test for heteroskedasticity, \cr \code{"dw"} \tab Durbin--Watson test for autocorrelation of disturbances, \cr \code{"gq"} \tab Goldfeld--Quandt test for heteroskedasticity, \cr \code{"harv"} \tab Harvey--Collier test for linearity, \cr \code{"hmc"} \tab Harrison--McCabe test for heteroskedasticity, \cr \code{"rain"} \tab Rainbow test for linearity, and \cr \code{"reset"} \tab Ramsey's RESET test for functional relation. } There is nothing new, it's just a wrapper to the underlying test functions from R's contributed package \code{lmtest}. The functions are available as "Builtin" functions. Nevertheless, the user can still install and use the original functions from \R's \code{lmtest} package. } \usage{ lmTest(formula, method = c("bg", "bp", "dw", "gq", "harv", "hmc", "rain", "reset"), data = list(), \dots) bgTest(formula, order = 1, type = c("Chisq", "F"), data = list()) bpTest(formula, varformula = NULL, studentize = TRUE, data = list()) dwTest(formula, alternative = c("greater", "two.sided", "less"), iterations = 15, exact = NULL, tol = 1e-10, data = list()) gqTest(formula, point=0.5, order.by = NULL, data = list()) harvTest(formula, order.by = NULL, data = list()) hmcTest(formula, point = 0.5, order.by = NULL, simulate.p = TRUE, nsim = 1000, plot = FALSE, data = list()) rainTest(formula, fraction = 0.5, order.by = NULL, center = NULL, data = list()) resetTest(formula, power = 2:3, type = c("fitted", "regressor", "princomp"), data = list()) } \arguments{ \item{alternative}{ [dwTest] - \cr a character string specifying the alternative hypothesis, either \code{"greater"}, \code{"two.sided"}, or \code{"less"}. } \item{center}{ [rainTest] - \cr a numeric value. If center is smaller than \code{1} it is interpreted as percentages of data, i.e. the subset is chosen that \code{n*fraction} observations are around observation number \code{n*center}. If \code{center} is greater than \code{1} it is interpreted to be the index of the center of the subset. By default center is \code{0.5}. If the Mahalanobis distance is chosen center is taken to be the mean regressor, but can be specified to be a k-dimensional vector if k is the number of regressors and should be in the range of the respective regressors. } \item{data}{ an optional data frame containing the variables in the model. By default the variables are taken from the environment which \code{lmTest} and the other tests are called from. } \item{exact}{ [dwTest] - \cr a logical flag. If set to \code{FALSE} a normal approximation will be used to compute the p value, if \code{TRUE} the "pan" algorithm is used. The default is to use "pan" if the sample size is \code{< 100}. } \item{formula}{ a symbolic description for the linear model to be tested. } \item{fraction}{ [rainTest] - \cr a numeric value, by default 0.5. The percentage of observations in the subset is determined by \code{fraction*n} if \code{n} is the number of observations in the model. } \item{iterations}{ [dwTest] - \cr an integer specifying the number of iterations when calculating the p-value with the "pan" algorithm. By default 15. } \item{method}{ the test method which should be applied. } \item{nsim}{ [hmcTest] - \cr an integer value. Determins how many runs are used to simulate the p value, by default 1000. } \item{order}{ [bgTest] - \cr an integer. The maximal order of serial correlation to be tested. By default 1. } \item{order.by}{ [gqTest][harvTest] - \cr a formula. A formula with a single explanatory variable like \code{~ x}. Then the observations in the model are ordered by the size of \code{x}. If set to \code{NULL}, the default, the observations are assumed to be ordered (e.g. a time series). \cr [rainTest] - \cr either a formula or a string. A formula with a single explanatory variable like \code{~ x}. The observations in the model are ordered by the size of \code{x}. If set to \code{NULL}, the default, the observations are assumed to be ordered (e.g. a time series). If set to \code{"mahalanobis"} then the observations are ordered by their Mahalanobis distance of the data. } \item{plot}{ [hmcTest] - \cr a logical flag. If \code{TRUE} the test statistic for all possible breakpoints is plotted, the default is \code{FALSE}. } \item{point}{ [gqTest][hmcTest] - \cr a numeric value. If point is smaller than \code{1} it is interpreted as percentages of data, i.e. \code{n*point} is taken to be the (potential) breakpoint in the variances, if \code{n} is the number of observations in the model. If \code{point} is greater than \code{1} it is interpreted to be the index of the breakpoint. By default \code{0.5}. } \item{power}{ [resetTest] - \cr integers, by default \code{2:3}. A vector of positive integers indicating the powers of the variables that should be included. By default it is tested for a quadratic or cubic influence of the fitted response. } \item{simulate.p}{ [hmcTest] - \cr a logical. If \code{TRUE}, the default, a p-value will be assessed by simulation, otherwise the p-value is \code{NA}. } \item{studentize}{ [bpTest] - \cr a logical value. If set to \code{TRUE} Koenker's studentized version of the test statistic will be used. By default set to \code{TRUE}. } \item{tol}{ [dwTest] - \cr the tolerance value. Eigenvalues computed have to be greater than \code{tol=1e-10} to be treated as non-zero. } \item{type}{ [bgTest] - \cr the type of test statistic to be returned. Either \code{"Chisq"} for the Chi-squared test statistic or \code{"F"} for the F test statistic. \cr [resetTest] - \cr a string indicating whether powers of the \code{"fitted"} response, the \code{"regressor"} variables (factors are left out) or the first principal component, \code{"princomp"}, of the regressor matrix should be included in the extended model. } \item{varformula}{ [bpTest] - \cr a formula describing only the potential explanatory variables for the variance, no dependent variable needed. By default the same explanatory variables are taken as in the main regression model. } \item{\dots}{ [regTest] - \cr additional arguments passed to the underlying lm test. Some of the tests can specify additional optional arguments like for alternative hypothesis, the type of test statistic to be returned, or others. All the optional arguments have default settings. } } \details{ \bold{bg -- Breusch Godfrey Test:} \cr\cr Under \eqn{H_0} the test statistic is asymptotically Chi-squared with degrees of freedom as given in \code{parameter}. If \code{type} is set to \code{"F"} the function returns the exact F statistic which, under \eqn{H_0}, follows an \eqn{F} distribution with degrees of freedom as given in \code{parameter}. The starting values for the lagged residuals in the supplementary regression are chosen to be 0.\cr \code{[lmtest:bgtest]} \cr \bold{bp -- Breusch Pagan Test:} \cr\cr The Breusch--Pagan test fits a linear regression model to the residuals of a linear regression model (by default the same explanatory variables are taken as in the main regression model) and rejects if too much of the variance is explained by the additional explanatory variables. Under \eqn{H_0} the test statistic of the Breusch-Pagan test follows a chi-squared distribution with \code{parameter} (the number of regressors without the constant in the model) degrees of freedom.\cr \code{[lmtest:bptest]} \cr \bold{dw -- Durbin Watson Test:} \cr\cr The Durbin--Watson test has the null hypothesis that the autocorrelation of the disturbances is 0; it can be tested against the alternative that it is greater than, not equal to, or less than 0 respectively. This can be specified by the \code{alternative} argument. The null distribution of the Durbin-Watson test statistic is a linear combination of chi-squared distributions. The p value is computed using a Fortran version of the Applied Statistics Algorithm AS 153 by Farebrother (1980, 1984). This algorithm is called "pan" or "gradsol". For large sample sizes the algorithm might fail to compute the p value; in that case a warning is printed and an approximate p value will be given; this p value is computed using a normal approximation with mean and variance of the Durbin-Watson test statistic.\cr \code{[lmtest:dwtest]} \cr \bold{gq -- Goldfeld Quandt Test:} \cr\cr The Goldfeld--Quandt test compares the variances of two submodels divided by a specified breakpoint and rejects if the variances differ. Under \eqn{H_0} the test statistic of the Goldfeld-Quandt test follows an F distribution with the degrees of freedom as given in \code{parameter}.\cr \code{[lmtest:gqtest]} \cr \bold{harv - Harvey Collier Test:} \cr\cr The Harvey-Collier test performs a t-test (with \code{parameter} degrees of freedom) on the recursive residuals. If the true relationship is not linear but convex or concave the mean of the recursive residuals should differ from 0 significantly.\cr \code{[lmtest:harvtest]} \cr \bold{hmc -- Harrison McCabe Test:} \cr\cr The Harrison--McCabe test statistic is the fraction of the residual sum of squares that relates to the fraction of the data before the breakpoint. Under \eqn{H_0} the test statistic should be close to the size of this fraction, e.g. in the default case close to 0.5. The null hypothesis is reject if the statistic is too small.\cr \code{[lmtest:hmctest]} \cr \bold{rain -- Rainbow Test:} \cr\cr The basic idea of the Rainbow test is that even if the true relationship is non-linear, a good linear fit can be achieved on a subsample in the "middle" of the data. The null hypothesis is rejected whenever the overall fit is significantly inferious to the fit of the subsample. The test statistic under \eqn{H_0} follows an F distribution with \code{parameter} degrees of freedom.\cr \code{[lmtest:raintest]} \cr \bold{reset -- Ramsey's RESET Test} \cr\cr RESET test is popular means of diagnostic for correctness of functional form. The basic assumption is that under the alternative, the model can be written by the regression \eqn{ y = X\beta + Z\gamma + u}{y=X * beta + Z * gamma}. \code{Z} is generated by taking powers either of the fitted response, the regressor variables or the first principal component of \code{X}. A standard F-Test is then applied to determin whether these additional variables have significant influence. The test statistic under \eqn{H_0} follows an F distribution with \code{parameter} degrees of freedom.\cr \code{[lmtest:reset]} } \value{ A list with class \code{"htest"} containing the following components: \item{statistic}{ the value of the test statistic. } \item{parameter}{ the lag order. } \item{p.value}{ the p-value of the test. } \item{method}{ a character string indicating what type of test was performed. } \item{data.name}{ a character string giving the name of the data. } \item{alternative}{ a character string describing the alternative hypothesis. } } \note{ The underlying \code{lmtest} package comes wit a lot of helpful examples. We highly recommend to install the \code{lmtest} package and to study the examples given therein. } \references{ Breusch, T.S. (1979); \emph{Testing for Autocorrelation in Dynamic Linear Models}, Australian Economic Papers 17, 334--355. Breusch T.S. and Pagan A.R. (1979); \emph{A Simple Test for Heteroscedasticity and Random Coefficient Variation}, Econometrica 47, 1287--1294 Durbin J. and Watson G.S. (1950); \emph{Testing for Serial Correlation in Least Squares Regression I}, Biometrika 37, 409--428. Durbin J. and Watson G.S. (1951); \emph{Testing for Serial Correlation in Least Squares Regression II}, Biometrika 38, 159--178. Durbin J. and Watson G.S. (1971); \emph{Testing for Serial Correlation in Least Squares Regression III}, Biometrika 58, 1--19. Farebrother R.W. (1980); \emph{Pan's Procedure for the Tail Probabilities of the Durbin-Watson Statistic}, Applied Statistics 29, 224--227. Farebrother R.W. (1984); \emph{The Distribution of a Linear Combination of \eqn{\chi^2}{chi^2} Random Variables}, Applied Statistics 33, 366--369. Godfrey, L.G. (1978); \emph{Testing Against General Autoregressive and Moving Average Error Models when the Regressors Include Lagged Dependent Variables}, Econometrica 46, 1293--1302. Goldfeld S.M. and Quandt R.E. (1965); \emph{Some Tests for Homoskedasticity} Journal of the American Statistical Association 60, 539--547. Harrison M.J. and McCabe B.P.M. (1979); \emph{A Test for Heteroscedasticity based on Ordinary Least Squares Residuals} Journal of the American Statistical Association 74, 494--499. Harvey A. and Collier P. (1977); \emph{Testing for Functional Misspecification in Regression Analysis}, Journal of Econometrics 6, 103--119. Johnston, J. (1984); \emph{Econometric Methods}, Third Edition, McGraw Hill Inc. Kraemer W. and Sonnberger H. (1986); \emph{The Linear Regression Model under Test}, Heidelberg: Physica. Racine J. and Hyndman R. (2002); \emph{Using R To Teach Econometrics}, Journal of Applied Econometrics 17, 175--189. Ramsey J.B. (1969); \emph{Tests for Specification Error in Classical Linear Least Squares Regression Analysis}, Journal of the Royal Statistical Society, Series B 31, 350--371. Utts J.M. (1982); \emph{The Rainbow Test for Lack of Fit in Regression}, Communications in Statistics - Theory and Methods 11, 1801--1815. } \author{ Achim Zeileis and Torsten Hothorn for the \code{lmtest} package, \cr Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## bg | dw - # Generate a Stationary and an AR(1) Series: x = rep(c(1, -1), 50) y1 = 1 + x + rnorm(100) # Perform Breusch-Godfrey Test for 1st order serial correlation: lmTest(y1 ~ x, "bg") # ... or for fourth order serial correlation: lmTest(y1 ~ x, "bg", order = 4) # Compare with Durbin-Watson Test Results: lmTest(y1 ~ x, "dw") y2 = filter(y1, 0.5, method = "recursive") lmTest(y2 ~ x, "bg") ## bp - # Generate a Regressor: x = rep(c(-1, 1), 50) # Generate heteroskedastic and homoskedastic Disturbances err1 = rnorm(100, sd = rep(c(1, 2), 50)) err2 = rnorm(100) # Generate a Linear Relationship: y1 = 1 + x + err1 y2 = 1 + x + err2 # Perform Breusch-Pagan Test bp = lmTest(y1 ~ x, "bp") bp # Calculate Critical Value for 0.05 Level qchisq(0.95, bp$parameter) lmTest(y2 ~ x, "bp") ## dw - # Generate two AR(1) Error Terms # with parameter rho = 0 (white noise) # and rho = 0.9 respectively err1 = rnorm(100) # Generate Regressor and Dependent Variable x = rep(c(-1,1), 50) y1 = 1 + x + err1 # Perform Durbin-Watson Test: lmTest(y1 ~ x, "dw") err2 = filter(err1, 0.9, method = "recursive") y2 = 1 + x + err2 lmTest(y2 ~ x, "dw") ## gq - # Generate a Regressor: x = rep(c(-1, 1), 50) # Generate Heteroskedastic and Homoskedastic Disturbances: err1 = c(rnorm(50, sd = 1), rnorm(50, sd = 2)) err2 = rnorm(100) # Generate a Linear Relationship: y1 = 1 + x + err1 y2 = 1 + x + err2 # Perform Goldfeld-Quandt Test: lmTest(y1 ~ x, "gq") lmTest(y2 ~ x, "gq") ## harv - # Generate a Regressor and Dependent Variable: x = 1:50 y1 = 1 + x + rnorm(50) y2 = y1 + 0.3*x^2 # Perform Harvey-Collier Test: harv = lmTest(y1 ~ x, "harv") harv # Calculate Critical Value vor 0.05 level: qt(0.95, harv$parameter) lmTest(y2 ~ x, "harv") ## hmc - # Generate a Regressor: x = rep(c(-1, 1), 50) # Generate Heteroskedastic and Homoskedastic Disturbances: err1 = c(rnorm(50, sd = 1), rnorm(50, sd = 2)) err2 = rnorm(100) # Generate a Linear Relationship: y1 = 1 + x + err1 y2 = 1 + x + err2 # Perform Harrison-McCabe Test: lmTest(y1 ~ x, "hmc") lmTest(y2 ~ x, "hmc") ## rain - # Generate Series: x = c(1:30) y = x^2 + rnorm(30, 0, 2) # Perform rainbow Test rain = lmTest(y ~ x, "rain") rain # Compute Critical Value: qf(0.95, rain$parameter[1], rain$parameter[2]) ## reset - # Generate Series: x = c(1:30) y1 = 1 + x + x^2 + rnorm(30) y2 = 1 + x + rnorm(30) # Perform RESET Test: lmTest(y1 ~ x , "reset", power = 2, type = "regressor") lmTest(y2 ~ x , "reset", power = 2, type = "regressor") } \keyword{htest} fRegression/man/regFit.Rd0000644000176000001440000003205711370220736015062 0ustar ripleyusers\name{regFit} \alias{regFit} \alias{gregFit} \title{Regression Modelling} \description{ Estimates the parameters of a regression model. } \usage{ regFit(formula, data, family = gaussian, use = c("lm", "rlm", "glm","gam", "ppr", "nnet", "polymars"), title = NULL, description = NULL, \dots) } \arguments{ \item{data}{ \code{data} is the data frame containing the variables in the model. By default the variables are taken from \code{environment(formula)}, typically the environment from which \code{lm} is called. } \item{description}{ a brief description of the porject of type character. } \item{family}{ a description of the error distribution and link function to be used in \code{glm} and \code{gam} models. See \code{\link{glm}} and \code{\link{family}} for more details. } \item{formula}{ a symbolic description of the model to be fit. \cr A typical \code{glm} predictor has the form \code{response ~ terms} where \code{response} is the (numeric) response vector and \code{terms} is a series of terms which specifies a (linear) predictor for \code{response}. For \code{binomial} models the response can also be specified as a \code{factor}. \cr A \code{gam} formula, see also \code{gam.models}, allows that smooth terms can be added to the right hand side of the formula. See \code{gam.side.conditions} for details and examples. } \item{use}{ denotes the regression method by a character string used to fit the model. \code{method} must be one of the strings in the default argument.\cr \code{"LM"}, for linear regression models, \cr \code{"GLM"} for generalized linear modelling,\cr \code{"GAM"} for generalized additive modelling,\cr \code{"PPR"} for projection pursuit regression,\cr \code{"POLYMARS"} for molytochomous MARS, and\cr \code{"NNET"} for feedforward neural network modelling. } \item{title}{ a character string which allows for a project title. } \item{\dots}{ additional optional arguments to be passed to the underlying functions. For details we refer to inspect the following help pages: \code{\link{lm}}, \code{\link{glm}}, \code{gam}, \code{\link{ppr}}, \code{polymars}, or \code{nnet}. } } \value{ returns an S4 object of class \code{"fREG"}. } \details{ The function \code{regFit} was created to provide a selection of regression models working together with Rmetrics' \code{"timeSeries"} objects and providing a common S4 object as the returned value. These models include linear modeling, robust linear modeling, generalized linear modeling, generalized additive modelling, projection pursuit regression, neural networks, and polytochomous MARS models.\cr % ----------------------------------------------- \bold{LM -- Linear Modelling:} \cr\cr Univariate linear regression analysis is a statistical methodology that assumes a linear relationship between some predictor variables and a response variable. The goal is to estimate the coefficients and to predict new data from the estimated linear relationship. R's base function \code{lm(formula, data, subset, weights, na.action, method = "qr", }\cr \code{ model = TRUE, x = FALSE, y = FALSE, qr = TRUE, singular.ok = TRUE, }\cr \code{ contrasts = NULL, offset, ...) }\cr is used to fit linear models. It can be used to carry out regression, single stratum analysis of variance and analysis of covariance, although \code{aov} may provide a more convenient interface for these. Rmetrics' function \code{regFit(formula, data, use = "lm", ...) }\cr calls R's base function \code{lm} but with the difference that the \code{data} argument, may be any rectangular object which can be transferred by the function \code{as.data.frame} into a data frame with named columns, e.g. an object of class \code{"timeSeries"}. The function \code{regFit} returns an S4 object of class \code{"fREG"} whose slot \code{@fit} is the object as returned by the function \code{"lm"}. In addtion we have S4 methods \code{fitted} and \code{residuals} which allow to retrieve the fitted values and the residuals as objects of same classe as defined by the argument \code{data}. The function \code{plot.lm} provides four plots: a plot of residuals against fitted values, a Scale-Location plot of sqrt(| residuals |) against fitted values, a normal QQ plot, and a plot of Cook's distances versus row labels.\cr \code{[stats:lm]} \cr % ----------------------------------------------- \bold{LM -- Robust Linear Modelling:} \cr\cr To fit a linear model by robust regression using an M estimator R offers the function \code{rlm(formula, data, weights, ..., subset, na.action, }\cr \code{ method = c("M", "MM", "model.frame"), }\cr \code{ wt.method = c("inv.var", "case"), }\cr \code{ model = TRUE, x.ret = TRUE, y.ret = FALSE, contrasts = NULL) }\cr from package \code{MASS}. Again we can use the Rmetrics' wrapper \code{regFit(formula, data, use = "rlm", ...) }\cr which allows us to use for example S4 \code{timeSeries} objects as input and to get the output as an S4 object with the known slots.\cr \code{[MASS::rlm]} \cr % ----------------------------------------------- \bold{GLM -- Generalized Linear Models:} \cr\cr Generalized linear modelling extends the linear model in two directions. (i) with a monotonic differentiable link function describing how the expected values are related to the linear predictor, and (ii) with response variables having a probability distribution from an exponential family.\cr R's base function from package \code{stats} comes with the function \code{glm(formula, family = gaussian, data, weights, subset, }\cr \code{ na.action, start = NULL, etastart, mustart, offset, }\cr \code{ control = glm.control(...), model = TRUE, method = "glm.fit", }\cr \code{ x = FALSE, y = TRUE, contrasts = NULL, ...) }\cr Again we can use the Rmetrics' wrapper \code{regFit(formula, data, use = "gam", ...) }\cr \code{[stats::glm]} \cr % ----------------------------------------------- \bold{GAM -- Generalized Additive Models:} \cr\cr An additive model generalizes a linear model by smoothing individually each predictor term. A generalized additive model extends the additive model in the same spirit as the generalized liner amodel extends the linear model, namely for allowing a link function and for allowing non-normal distributions from the exponential family.\cr \code{[mgcv:gam]} \cr % ----------------------------------------------- \bold{PPR -- Projection Pursuit Regression:} \cr\cr The basic method is given by Friedman (1984), and is essentially the same code used by S-PLUS's \code{ppreg}. It is observed that this code is extremely sensitive to the compiler used. The algorithm first adds up to \code{max.terms}, by default \code{ppr.nterms}, ridge terms one at a time; it will use less if it is unable to find a term to add that makes sufficient difference. The levels of optimization, argument \code{optlevel}, by default 2, differ in how thoroughly the models are refitted during this process. At level 0 the existing ridge terms are not refitted. At level 1 the projection directions are not refitted, but the ridge functions and the regression coefficients are. Levels 2 and 3 refit all the terms; level 3 is more careful to re-balance the contributions from each regressor at each step and so is a little less likely to converge to a saddle point of the sum of squares criterion. The \code{plot} method plots Ridge functions for the projection pursuit regression fit.\cr \code{[stats:ppr]} \cr % ----------------------------------------------- \bold{POLYMARS -- Polytochomous MARS:} \cr\cr The algorithm employed by \code{polymars} is different from the MARS(tm) algorithm of Friedman (1991), though it has many similarities. Also the name \code{polymars} has been used for this algorithm well before MARS was trademarked.\cr \code{[polyclass:polymars]} \cr % ----------------------------------------------- \bold{NNET -- Feedforward Neural Network Regression:} \cr\cr If the response in \code{formula} is a factor, an appropriate classification network is constructed; this has one output and entropy fit if the number of levels is two, and a number of outputs equal to the number of classes and a softmax output stage for more levels. If the response is not a factor, it is passed on unchanged to \code{nnet.default}. A quasi-Newton optimizer is used, written in \code{C}. \cr \code{[nnet:nnet]} } \references{ Belsley D.A., Kuh E., Welsch R.E. (1980); \emph{Regression Diagnostics}; Wiley, New York. Dobson, A.J. (1990); \emph{An Introduction to Generalized Linear Models}; Chapman and Hall, London. Draper N.R., Smith H. (1981); \emph{Applied Regression Analysis}; Wiley, New York. Friedman, J.H. (1991); \emph{Multivariate Adaptive Regression Splines (with discussion)}, The Annals of Statistics 19, 1--141. Friedman J.H., and Stuetzle W. (1981); \emph{Projection Pursuit Regression}; Journal of the American Statistical Association 76, 817-823. Friedman J.H. (1984); \emph{SMART User's Guide}; Laboratory for Computational Statistics, Stanford University Technical Report No. 1. Green, Silverman (1994); \emph{Nonparametric Regression and Generalized Linear Models}; Chapman and Hall. Gu, Wahba (1991); \emph{Minimizing GCV/GML Scores with Multiple Smoothing Parameters via the Newton Method}; SIAM J. Sci. Statist. Comput. 12, 383-398. Hastie T., Tibshirani R. (1990); \emph{Generalized Additive Models}; Chapman and Hall, London. Kooperberg Ch., Bose S., and Stone C.J. (1997); \emph{Polychotomous Regression}, Journal of the American Statistical Association 92, 117--127. McCullagh P., Nelder, J.A. (1989); \emph{Generalized Linear Models}; Chapman and Hall, London. Myers R.H. (1986); \emph{Classical and Modern Regression with Applications}; Duxbury, Boston. Rousseeuw P.J., Leroy, A. (1987); \emph{Robust Regression and Outlier Detection}; Wiley, New York. Seber G.A.F. (1977); \emph{Linear Regression Analysis}; Wiley, New York. Stone C.J., Hansen M., Kooperberg Ch., and Truong Y.K. (1997); \emph{The use of polynomial splines and their tensor products in extended linear modeling (with discussion)}. Venables, W.N., Ripley, B.D. (1999); \emph{Modern Applied Statistics with S-PLUS}; Springer, New York. Wahba (1990); \emph{Spline Models of Observational Data}; SIAM. Weisberg S. (1985); \emph{Applied Linear Regression}; Wiley, New York. Wood (2000); \emph{Modelling and Smoothing Parameter Estimation with Multiple Quadratic Penalties}; JRSSB 62, 413-428. Wood (2001); \emph{mgcv: GAMs and Generalized Ridge Regression for \R}. R News 1, 20-25. Wood (2001); \emph{Thin Plate Regression Splines}. There exists a vast literature on regression. The references listed above are just a small sample of what is available. The book by Myers' is an introductory text book that covers discussions of much of the recent advances in regression technology. Seber's book is at a higher mathematical level and covers much of the classical theory of least squares. } \author{ The R core team for the \code{lm} functions from R's \code{base} package, \cr B.R. Ripley for the \code{glm} functions from R's \code{base} package, \cr S.N. Wood for the \code{gam} functions from R's \code{mgcv} package, \cr N.N. for the \code{ppr} functions from R's \code{modreg} package, \cr M. O' Connors for the \code{polymars} functions from R's \code{?} package, \cr The R core team for the \code{nnet} functions from R's \code{nnet} package, \cr Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## regSim - x = regSim(model = "LM3", n = 100) # LM regFit(Y ~ X1 + X2 + X3, data = x, use = "lm") # RLM regFit(Y ~ X1 + X2 + X3, data = x, use = "rlm") # AM regFit(Y ~ X1 + X2 + X3, data = x, use = "gam") # PPR regFit(Y ~ X1 + X2 + X3, data = x, use = "ppr") # NNET regFit(Y ~ X1 + X2 + X3, data = x, use = "nnet") # POLYMARS if (require(polspline)) { regFit(Y ~ X1 + X2 + X3, data = x, use = "polymars") } } \keyword{models} fRegression/man/vcov-methods.Rd0000644000176000001440000000155611370220736016260 0ustar ripleyusers\name{vcov-methods} \docType{methods} \alias{vcov-methods} \alias{vcov,ANY-method} \alias{vcov,fREG-method} \title{Extract Regression Model vcov} \description{ Extracts vcov from a fitted regression model. } \section{Methods}{ \describe{ \item{object = "ANY"}{ Generic function } \item{object = "fREG"}{ Extractor function for vcov. } } } \note{ \code{vcov} is a generic function which extracts fitted values from objects returned by modeling functions, here the \code{regFit} and \code{gregFit} parameter estimation functions. } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## regSim - x = regSim(model = "LM3", n = 50) ## regFit - fit = regFit(Y ~ X1 + X2 + X3, data = x, use = "lm") ## vcov - vcov(fit) } \keyword{models} fRegression/man/terms-methods.Rd0000644000176000001440000000154411370220736016432 0ustar ripleyusers\name{terms-methods} \docType{methods} \alias{terms-methods} \alias{terms,ANY-method} \alias{terms,fREG-method} \title{Regression Model Plot Methods} \description{ Plots results obtained from a fitted regression model. } \usage{ \S4method{terms}{fREG}(x, \dots) } \arguments{ \item{x}{ an object of class 'fREG'. } \item{\dots}{ additional arguments to be passed to the underlying functions. } } \section{Methods}{ \describe{ \item{x = "ANY"}{ Generic function. } \item{x = "fREG"}{ Terms extractor function. } } } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## regSim - x = regSim(model = "LM3", n = 50) ## regFit - fit = regFit(Y ~ X1 + X2 + X3, data = x, use = "lm") } \keyword{models} fRegression/man/fitted-methods.Rd0000644000176000001440000000274611370220736016564 0ustar ripleyusers\name{fitted-methods} \docType{methods} \alias{fitted-methods} \alias{fitted,ANY-method} \alias{fitted,fREG-method} \title{Extract Regression Model Fitted Values} \description{ Extracts fitted values from a fitted regression model. } \section{Methods}{ \describe{ \item{object = "ANY"}{ Generic function } \item{object = "fREG"}{ Extractor function for fitted values. } } } \note{ \code{fitted} is a generic function which extracts fitted values from objects returned by modeling functions, here the \code{regFit} and \code{gregFit} parameter estimation functions. The class of the fitted values is the same as the class of the data input to the function \code{regFit} or \code{gregFit}. In contrast the slot \code{fitted} returns a numeric vector. } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## regSim - x.df = regSim(model = "LM3", n = 50) ## regFit - # Use data.frame input: fit = regFit(Y ~ X1 + X2 + X3, data = x.df, use = "lm") ## fitted - val = slot(fit, "fitted") head(val) class(val) val = fitted(fit) head(val) class(val) ## regFit - # Convert to dummy timeSeries Object: x.tS = as.timeSeries(x.df) fit = regFit(Y ~ X1 + X2 + X3, data = x.tS, use = "lm") ## fitted - val = slot(fit, "fitted") head(val) class(val) val = fitted(fit) head(val) class(val) } \keyword{models} fRegression/man/termPlot-methods.Rd0000644000176000001440000000155111370220736017104 0ustar ripleyusers\name{termPlot} \docType{methods} % \alias{termPlot-methods} % \alias{termPlot,ANY-method} \alias{termPlot.fREG} \title{Regression Model Plot Methods} \description{ Plots results obtained from a fitted regression model. } \usage{ \method{termPlot}{fREG}(model, \dots) } \arguments{ \item{model}{ an object of class 'fREG'. } \item{\dots}{ additional arguments to be passed to the underlying functions. } } \section{Methods}{ \describe{ \item{x = "ANY"}{ Generic function. } \item{x = "fREG"}{ Term plot function. } } } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## regSim - x = regSim(model = "LM3", n = 50) ## regFit - fit = regFit(Y ~ X1 + X2 + X3, data = x, use = "lm") } \keyword{models} fRegression/man/coef-methods.Rd0000644000176000001440000000156311370220736016215 0ustar ripleyusers\name{coef-methods} \docType{methods} \alias{coef-methods} \alias{coef,ANY-method} \alias{coef,fREG-method} \title{REG coefficients Methods} \description{ Extracts coefficients from a fitted regression model. } \section{Methods}{ \describe{ \item{object = "ANY"}{ Generic function. } \item{object = "fREG"}{ Extractor function for coefficients. } } } \note{ \code{coef} is a generic function which extracts the coefficients from objects returned by modeling functions, here the \code{regFit} and \code{gregFit} parameter estimation functions. } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## regSim - x = regSim(model = "LM3", n = 50) ## regFit - fit = regFit(Y ~ X1 + X2 + X3, data = x, use = "lm") ## coef - coef(fit) } \keyword{models} fRegression/man/formula-methods.Rd0000644000176000001440000000157711370220736016753 0ustar ripleyusers\name{formula-methods} \docType{methods} \alias{formula-methods} \alias{formula,ANY-method} \alias{formula,fREG-method} \title{Extract Regressiom Model formula} \description{ Extracts formula from a fitted regression model. } \section{Methods}{ \describe{ \item{object = "ANY"}{ Generic function } \item{object = "fGARCH"}{ Formula } } } \note{ \code{formula} is a generic function which extracts the formula expression from objects returned by modeling functions, here the \code{regFit} and \code{gregFit} parameter estimation function. } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## regSim - x = regSim(model = "LM3", n = 50) ## regFit - fit = regFit(Y ~ X1 + X2 + X3, data = x, use = "lm") ## formula - formula(fit) } \keyword{models} fRegression/man/predict-methods.Rd0000644000176000001440000000241111370220736016724 0ustar ripleyusers\name{predict-methods} \docType{methods} \alias{predict-methods} \alias{predict,ANY-method} \alias{predict,fREG-method} \title{Regression Models Prediction Function} \description{ Predicts a time series from a fitted regression model. } \usage{ \S4method{predict}{fREG}(object, newdata, se.fit = FALSE, type = "response", \dots) } \arguments{ \item{newdata}{ new data. } \item{object}{ an object of class \code{fREG} as returned from the function \code{regFit()}. } \item{se.fit}{ a logical flag. Should standard errors be included? By default \code{FALSE}. } \item{type}{ a character string by default \code{"response"}. } \item{\dots}{ arguments to be passed. } } \section{Methods}{ \describe{ \item{object = "ANY"}{ Generic function } \item{object = "fREG"}{ Predict method for regression models. } } } \value{ returns ... } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## regSim - x = regSim(model = "LM3", n = 50) ## regFit - fit = regFit(Y ~ X1 + X2 + X3, data = x, use = "lm") ## predict - } \keyword{models} fRegression/man/regSim.Rd0000644000176000001440000000556511370220736015074 0ustar ripleyusers\name{regSim} \alias{regSim} \alias{LM3} \alias{LOGIT3} \alias{GAM3} \title{Regression Model Simulation} \description{ Simulates regression models. } \usage{ regSim(model = "LM3", n = 100, ...) LM3(n = 100, seed = 4711) LOGIT3(n = 100, seed = 4711) GAM3(n = 100, seed = 4711) } \arguments{ \item{model}{ a character string defining the function name from which the regression model will be simulated. } \item{n}{ an integer value setting the length, i.e. the number of records of the output series, an integer value. By default \code{n=100}. } \item{seed}{ an integer value, the recommended way to specify seeds for random number generation. } \item{\dots}{ arguments to be passed to the underlying function specified by the \code{model} argument. } } \details{ The function \code{regSim} allows to simulate from various regression models defined by one of the three example functions \code{LM3}, \code{LOGIT3}, \code{GAM3} or by a user specified function. The examples are defined in the following way: \code{# LM3:}\cr \code{> y = 0.75 * x1 + 0.25 * x2 - 0.5 * x3 + 0.1 * eps }\cr \code{# LOGIT3:}\cr \code{> y = 1 / (1 + exp(- 0.75 * x1 + 0.25 * x2 - 0.5 * x3 + eps)) }\cr \code{# GAM3:}\cr \code{> y = scale(scale(sin(2 * pi * x1)) + scale(exp(x2)) + scale(x3)) }\cr \code{> y = y + 0.1 * rnorm(n, sd = sd(y))}\cr \code{"LM3"} models a liner regression model, \code{"LOGIT3"} a generalized linear regression model expressed by a logit model, and \code{"GAM"} an additive model. \code{x1}, \code{x2}, \code{x3}, and \code{eps} are random normal deviates of length \code{n}. The \code{model} function should return an rectangular series defined as an object of class \code{data.frame}, \code{timeSeries} or \code{mts} which can be accepted from the parameter estimation functions \code{regFit} and \code{gregFit}. } \value{ The function \code{garchSim} returns an object of the same class as returned by the underlying function \code{match.fun(model)}. These may be objects of class \code{data.frame}, \code{timeSeries} or \code{mts}. } \note{ This function is still under development. For the future we plan, that the function \code{regSim} will be able to generate general regression models. } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## LM2 - # Data for a user defined linear regression model: LM2 = function(n){ x = rnorm(n) y = rnorm(n) eps = 0.1 * rnorm(n) z = 0.5 + 0.75 * x + 0.25 * y + eps data.frame(Z = z, X = x, Y = y) } for (FUN in c("LM2", "LM3")) { cat(FUN, ":\n", sep = "") print(regSim(model = FUN, n = 10)) } } \keyword{models} fRegression/man/residuals-methods.Rd0000644000176000001440000000200711370220736017266 0ustar ripleyusers\name{residuals-methods} \docType{methods} \alias{residuals-methods} \alias{residuals,ANY-method} \alias{residuals,fREG-method} \title{Extract Regression Model Residuals} \description{ Extracts residuals from a fitted regression object. } \usage{ \S4method{residuals}{fREG}(object) } \arguments{ \item{object}{ an object of class \code{fREG} as returned from the function \code{regFit()} or \code{gregFit()}. } } \section{Methods}{ \describe{ \item{object = "ANY"}{ Generic function } \item{object = "fREG"}{ Residuals } } } \note{ \code{residuals} is a generic function which extracts residual values from objects returned by modeling functions. } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## regSim - x = regSim(model = "LM3", n = 50) ## regFit - fit = regFit(Y ~ X1 + X2 + X3, data = x, use = "lm") ## residuals - residuals(fit) } \keyword{models} fRegression/man/fREG-package.Rd0000644000176000001440000000602311370220736016010 0ustar ripleyusers\name{fRegression-package} \alias{fRegression-package} \alias{fRegression} \docType{package} \title{Regression Modelling Package} \description{ Package of functions for regression modelling. } \details{ \tabular{ll}{ Package: \tab fRegression\cr Type: \tab Package\cr Version: \tab 261.73.1\cr Date: \tab 2008\cr License: \tab GPL Version 2 or later\cr Copyright: \tab (c) 1999-2008 Diethelm Wuertz, Rmetrics Foundation\cr URL: \tab \url{http://www.rmetrics.org} } Regression modelling, especially linear modelling, is a widely used application in finance. In finance it mostly appears in the form that a variable is modelled as a linear or more complex relationship as a function of other variables. For example the decision of buying or selling in a trading model may be triggered by the outcome of a regression model, e.g. neural networks are a well known tool in this field. Rmetrics has build a simple interface to several regression models available in the base and contributed packages of R. By default the following regression models are interfaced and available through the function \code{regFit}: ... All the functions of the \code{regFit} family return the same object, an object of class \code{"fREG"} with the following slots: call, formula, method, data, fit, residuals, fitted, title, and description. Thus, independent of the regression model applied we can use the same S4 methods for all types of regression. This includes, print, plot, summary, predict, fitted, residuals, coef, and formula methods. Evenmore the user can add further regression models to this framework either his own implementations or implementations available through contributed R packages. } \section{Class Representation}{ contains functions to simulate artificial regression models. Functions: \tabular{ll}{ \code{regSim} \tab Simulates artificail regression model data sets. } } \section{Simulation of Regression Models}{ contains functions to fit the parameters regression models Functions: \tabular{ll}{ \code{regFit} \tab Estimates the parameters of a regression model, \cr \code{gregFit} \tab Estimates the parameters of a generalized regression model, \cr \code{fitted} \tab Extracts fitted values from a fitted 'fREG' object, \cr \code{residuals} \tab Extracts residuals from a fitted 'fREG' object, \cr \code{coef} \tab Extracts coefficients from a fitted 'fREG' object, \cr \code{formula} \tab Extracts formula expression from a fitted 'fREG' object. } } \section{Forecasting}{ contains functions to forcecast from a regression model. Functions: \tabular{ll}{ \code{predict} \tab Forecasts from an object of class 'fREG'.} } \author{ Diethelm Wuertz and Rmetrics Core Team. } \keyword{package} fRegression/man/show-methods.Rd0000644000176000001440000000167511370220736016265 0ustar ripleyusers\name{show-methods} \docType{methods} \alias{show-methods} \alias{show,ANY-method} \alias{show,fREG-method} \title{Regression Modelling Show Methods} \description{ Show methods for regression modelling. } \section{Methods}{ \describe{ \item{object = "ANY"}{ Generic function. } \item{object = "fREG"}{ Print method for objects of class 'fREG'. } } } \details{ The show or print method returns the same information for all supported regression models through the \code{use} argument in the function \code{regFit}. These are the 'title', the 'formula', the 'family' and the 'model parameters'. } \author{ Diethelm Wuertz for the Rmetrics \R-port. } \examples{ ## regSim - x = regSim(model = "LM3", n = 50) ## regFit - fit = regFit(Y ~ X1 + X2 + X3, data = x, use = "lm") ## print - print(fit) } \keyword{models}