Nothing
#####################################################################################
## Author: Daniel Sabanés Bové [daniel *.* sabanesbove *a*t* ifspm *.* uzh *.* ch]
## Project: hypergsplines
##
## Time-stamp: <[calculateModel.R] by DSB Fre 15/06/2012 17:05 (CEST)>
##
## Description:
## For one specific model configuration, do the marginalization over the
## spline coefficients, calculate the resulting coefficient of determination
## etc. We have a separate function for this because both model exploration
## and posterior parameter sampling need this functionality.
##
## History:
## 15/09/2010 file creation
## 27/09/2010 keep the column names of X.lin also when "rescaling"
## with backsolve is necessary
## 13/10/2010 done: transfer this whole function to C++ via RcppArmadillo
## and check if the speed is increased well enough
## 14/10/2010 use Z.tcrossprod.list of modelData
## 04/04/2011 Cleanup:
## Include here only the C++ version. The old R version can be
## found in the archive packages.
## 26/07/2011 allow for non-integer vector config
## 15/06/2012 throw error message if model is not identifiable, i.e., if the
## number of included covariates plus intercept is not smaller than
## the number of observations
#####################################################################################
##' @include modelData.R
{}
##' Calculate intermediate information for a specific model
##'
##' @param config the model configuration vector
##' @param modelData the result from \code{\link{modelData}}
##' @return A list with necessary intermediate information
##'
##' @example examples/calculateModel.R
##'
##' @export
##' @keywords regression internal
##' @author Daniel Sabanes Bove \email{daniel.sabanesbove@@ifspm.uzh.ch}
calculateModel <- function(config,
modelData)
{
## coerce config to double vector
config <- as.double(config)
## checks:
stopifnot(identical(length(config), modelData$nCovs),
sum(config > 0) + 1 < modelData$nObs)
## then directly go C++
ret <- .Call("cpp_calculateModel",
config,
modelData)
## attach names
colnames(ret$X.lin) <- names(ret$betaOLS) <-
colnames(modelData$X)[ret$whichLinear]
## and return
return(ret)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.