R/ridgereg.R

In afuergut/lib7af: Reference Class for Linear and Ridge Regression

#' @title Refernce Class for Calculating Ridge Regression
#' @description You can have Reference Class containing some calculations by giving formula, data and lambda.
#' @field formula Formula
#' @field data Data Frame
#' @field lambda Lambda
#' @import readxl
#' @export ridgereg
#' @export


ridgereg <- setRefClass("ridgereg", fields = list(Coefficients="matrix", lambda = "numeric", Fitted_Values ="matrix", 
                                                  actuname = "character", x_norm = "matrix", formula = "formula", 
                                                  data = "data.frame"),
                      methods = list(
                        initialize = function(formula, data, lambda){
                          formula <<- formula
                          data <<- data
                          lambda <<- lambda
                          actuname <<- deparse(substitute(data))
                          
                          label <- all.vars(formula)[1]
                          y <- data[[label]]
                          #y <- as.matrix(data[all.vars(formula)[1]])
                          X <- model.matrix(formula, data)
                          X <- X[,-1]
                          
                          # normalize x
                          x_norm <<- scale(X)
                          #x_norm <<- cbind(X[,1],x_norm)
                          
                          # regression coefficients with qr decomposition
                          QR <- qr(x_norm)
                          Q <- qr.Q(QR)
                          R <- qr.R(QR)
                          Coefficients <<- solve(t(R)%*%R + lambda*diag(dim(t(R) %*% R)[1]))%*% t(R) %*% t(Q) %*% y
                          rownames(Coefficients) <<- colnames(X)

                          # fitted values
                          Fitted_Values <<- x_norm %*% Coefficients
                          colnames(Fitted_Values) <<- " Fitted Values"
                        },
                        print = function(){
                          cat("Call:", sep="\n")
                          cat(paste("ridgereg(","formula = ",formula,", data = ",actuname,")", sep=""), sep="\n")
                          cat(sep="\n")
                          cat("Coefficients:")
                          cat(sep="\n")
                          return(t(Coefficients))
                        },
                        predict = function(values = NULL){
                          if (!is.null(values)) {
                            predict<-as.numeric(t(as.matrix(values)%*%Coefficients))
                            return(predict)
                          } else {
                            return(Fitted_Values)
                          }
                        },
                        coef = function(){
                          return(t(Coefficients))
                        }
                      )
)