R/aimerMethods.R

In dajmcdon/aimer: Amplified, Initially Marginal, Eigenvector Regression

#'predicts new values for an aimer model.
#'
#'@param object required, a model generated by the aimer function.
#'@param newdata required, a new data matrix to predict with.
#'@param ... additional arguments, currently ignored.
#'
#'@return predicted value vector of length nrow(newdata).
#'
#'@export
predict.aimer <- function(object, newdata, ...){
    newdata = sweep(as.matrix(newdata), 2, object$meanx)
    indeces = object$beta != 0
    newdata[,indeces] %*% object$beta[indeces] + object$meany
}




#'predicts new values for an aimerCV model.
#'
#'@param object required, a model generated by the aimerCV function.
#'@param newdata required, a new data matrix to predict with.
#'@param ... additional arguments, currently ignored.
#'
#'@return predicted value vector of length nrow(newdata).
#'
#'@export
predict.aimerCV <- function(object, newdata, ...){
    predict.aimer(object, newdata)
}



#'returns the fitted values of an aimer model.
#'
#'@param object required, an aimer model.
#'@param ... additional arguments, currently ignored.
#'
#'@return fitted values of the original data (vector of length n).
#'
#'@export
fitted.aimer <- function(object, ...){
    object$fitted
}

#'returns the fitted values of an aimerCV model.
#'
#'@param object required, an aimerCV model.
#'@param ... additional arguments, currently ignored.
#'
#'@return fitted values of the original data (vector of length n).
#'
#'@export
fitted.aimerCV <- function(object, ...){
    object$fitted
}

#'returns the residuals of an aimer model.
#'
#'@param object required, an aimer model.
#'@param ... additional arguments, currently ignored.
#'
#'@return residuals of the original data (vector of length n).
#'
#'@export
residuals.aimer <- function(object, ...){
    object$residuals
}


#'returns the residuals of an aimerCV model.
#'
#'@param object required, an aimerCV model.
#'@param ... additional arguments, currently ignored.
#'
#'@return residuals of the original data (vector of length n).
#'
#'@export
residuals.aimerCV <- function(object, ...){
    object$residuals
}




#'returns the coefficients of an aimer model.
#'
#'@param object required, an aimer model.
#'@param ... additional arguments, currently ignored.
#'
#'@return coefficient vector for the model
#'
#'@export
coef.aimer <- function(object, ...){
    object$beta
}



#'returns the coefficients of an aimerCV model.
#'
#'@param object required, an aimerCV model.
#'@param ... additional arguments, currently ignored.
#'
#'@return coefficient vector for the model
#'
#'@export
coef.aimerCV <- function(object, ...){
    object$beta
}


#'plots the residuals in terms of the fitted values for an aimer model
#'
#'@param x required, an aimer model.
#'@param ... additional arguments, passed to `plot`
#'
#'@return void.
#'
#'@export
plot.aimer <- function(x, ...){
    plot(x$residuals ~ x$fitted, xlab = "fitted values", ylab = "residuals", ...)
}

#'creates a heatmap of each value of ncomps tested in an aimerCV model
#'
#'@param x required, an aimerCV model.
#'@param ... additional arguments, currently ignored
#'
#'@return void.
#'
#'@export
#'@importFrom graphics par plot
plot.aimerCV <- function(x, ...){
    original = par(ask = TRUE)
    # if (!requireNamespace("ggplot2", quietly = TRUE)){
    #     stop("This function requires the installation of the ggplot2 package.")
    # }
    MyDF = data.frame(expand.grid(x$ncomps, x$nCovs))
    best = match(x$nCov.select.best, x$nCovs.select)
    getColor <- function(coord){
        x$mse[best, coord[1], coord[2]]
    }
    MyDF$col = apply(expand.grid(1:length(x$ncomps), 1:length(x$nCovs)),
                     MARGIN = 1, FUN = getColor)
    p = ggplot2::ggplot(MyDF, ggplot2::aes_string(x = 'Var1', y = 'Var2', fill = 'col')) +
      ggplot2::geom_tile() +
      ggplot2::scale_fill_continuous(low = 'blue', high = 'red',
                                     guide = ggplot2::guide_legend(title = 'MSE')) +
      ggplot2::xlab("ncomps") +
      ggplot2::ylab("nCovs") +
      ggplot2::ggtitle("For Optimal nCov.select")
    print(p)
#    image(x = x$ncomps, y = x$nCovs,
#          z = x$mse[x$nCovs.select == x$nCov.select.best,,],
#          xlab = "ncomps", ylab = "ncovs", main = "for optimal value of nCovs.select")
    MyDF = data.frame(expand.grid(x$nCovs.select, x$ncomps))
    best = match(x$nCov.best, x$nCovs)
    getColor <- function(coord){
        x$mse[coord[1], coord[2], best]
    }
    MyDF$col = apply(expand.grid(1:length(x$nCovs.select), 1:length(x$ncomps)),
                     MARGIN = 1, FUN = getColor)
    p = ggplot2::ggplot(MyDF, ggplot2::aes_string(x = 'Var1', y = 'Var2', fill = 'col')) +
      ggplot2::geom_tile() +
      ggplot2::scale_fill_continuous(low = 'blue', high = 'red',
                                     guide = ggplot2::guide_legend(title = 'MSE')) +
      ggplot2::xlab("nCovs.select") +
      ggplot2::ylab("ncomps") + ggplot2::ggtitle("For Optimal nCovs")
    print(p)
#    image(x = x$nCovs.select, y = x$ncomps,
#          z = x$mse[,,x$nCovs == x$nCov.best],
#          xlab = "nCovs.select", ylab = "ncomps", main = "for optimal value of nCovs")
    MyDF = data.frame(expand.grid(x$nCovs.select, x$nCovs))
    best = match(x$ncomp.best, x$ncomps)
    getColor <- function(coord){
        x$mse[coord[1], best, coord[2]]
    }
    MyDF$col = apply(expand.grid(1:length(x$nCovs.select), 1:length(x$nCovs)),
                     MARGIN = 1, FUN = getColor)
    p = ggplot2::ggplot(MyDF, ggplot2::aes_string(x = 'Var1', y = 'Var2', fill = 'col')) +
      ggplot2::geom_tile() +
      ggplot2::scale_fill_continuous(low = 'blue', high = 'red',
                                     guide = ggplot2::guide_legend(title = 'MSE')) +
      ggplot2::xlab("nCovs.select") +
      ggplot2::ylab("nCovs") + ggplot2::ggtitle("For Optimal ncomps")
    print(p)
#    image(x = x$nCovs.select, y = x$nCovs,
#          z = x$mse[,x$ncomps == x$ncomp.best,],
#          xlab = "nCovs.select", ylab = "nCovs", main = "for optimal value of ncomps")
    par(original)
}