d0f81a51 |
#' @eval get_description('linear_model')
|
883f7f27 |
#' @import struct
#' @export linear_model
|
1a7cd70b |
#' @examples
|
4391cdba |
#' D = iris_DatasetExperiment()
#' M = linear_model(formula = y~Species)
#'
|
acec9d54 |
linear_model = function(formula,na_action='na.omit',contrasts=list(),...) {
|
a110b7e7 |
out=struct::new_struct('linear_model',
formula=formula,
|
acec9d54 |
na_action=na_action,
|
a110b7e7 |
contrasts=contrasts,
...)
|
8db793ae |
return(out)
}
.linear_model<-setClass(
|
c34a3c53 |
"linear_model",
contains='model',
slots=c(
# INPUTS
|
b3b2ba0e |
formula='entity',
na_action='enum',
contrasts='entity',
|
883f7f27 |
|
c34a3c53 |
# OUTPUTS
|
b3b2ba0e |
lm='entity',
coefficients='entity',
residuals='entity',
fitted_values='entity',
predicted_values='entity',
r_squared='entity',
adj_r_squared='entity'
|
883f7f27 |
|
c34a3c53 |
),
|
d0f81a51 |
prototype = list(name='Linear model',
description=paste0(
'Linear models can be used to carry out ',
'regression, single stratum analysis of variance and analysis ',
'of covariance.'),
|
c34a3c53 |
type="regression",
predicted='predicted_values',
|
a110b7e7 |
.params=c('formula','na_action','contrasts'),
.outputs=c('lm','coefficients','residuals','fitted_values','predicted_values','r_squared','adj_r_squared'),
|
d0f81a51 |
libraries='stats',
formula=ents$formula,
na_action=enum(name='NA action',
description=c(
'na.omit' = 'Incomplete cases are removed.',
'na.fail' = 'An error is thrown if NA are present.',
'na.exclude'='Incomplete cases are removed, and the output result is padded to the correct size using NA.',
'na.pass' = 'Does not apply a linear model if NA are present.'
),
|
c34a3c53 |
value='na.omit',
type='character',
|
8329945f |
allowed=c('na.omit','na.fail','na.exclude','na.pass')
|
c34a3c53 |
),
|
b3b2ba0e |
contrasts=entity(name='Contrasts',
|
d0f81a51 |
description='The contrasts associated with a factor.',
|
c34a3c53 |
type='list'
),
|
883f7f27 |
|
b3b2ba0e |
lm=entity(name='Linear model object',
|
8db793ae |
description='The lm object for this model_',
|
c34a3c53 |
type='lm'
),
|
b3b2ba0e |
coefficients=entity(name='Model coefficients',
|
8db793ae |
description='The coefficients for the fitted model_',
|
c34a3c53 |
type='numeric'
),
|
b3b2ba0e |
residuals=entity(name='Residuals',
|
8db793ae |
description='The residuals for the fitted model_',
|
c34a3c53 |
type='numeric'
),
|
b3b2ba0e |
fitted_values=entity(name='Fitted values',
|
8db793ae |
description='The fitted values for the data used to train the model_',
|
c34a3c53 |
type='numeric'
),
|
b3b2ba0e |
predicted_values=entity(name='Predicted values',
|
8db793ae |
description='The predicted values for new data using the fitted model_',
|
c34a3c53 |
type='numeric'
|
a1752138 |
),
|
b3b2ba0e |
r_squared=entity(name='R Squared',
|
8db793ae |
description='The value of R Squared for the fitted model_',
|
a1752138 |
type='numeric'
),
|
b3b2ba0e |
adj_r_squared=entity(name='Adjusted R Squared',
|
8db793ae |
description='The value ofAdjusted R Squared for the fitted model_',
|
a1752138 |
type='numeric'
|
c34a3c53 |
)
)
|
883f7f27 |
)
#' @export
|
5d21f82d |
#' @template model_train
|
8db793ae |
setMethod(f="model_train",
signature=c("linear_model",'DatasetExperiment'),
|
c34a3c53 |
definition=function(M,D)
{
X=cbind(D$data,D$sample_meta)
|
c17a810f |
if (length(M$contrasts)==0) {
|
c34a3c53 |
M$lm=lm(formula = M$formula, na.action = M$na_action,data=X) # default contrasts
} else {
M$lm=lm(formula = M$formula, na.action = M$na_action, contrasts = M$contrasts,data=X)
}
M$coefficients=coefficients(M$lm)
M$residuals=residuals(M$lm)
M$fitted_values=fitted(M$lm)
|
a1752138 |
M$r_squared=summary(M$lm)$r.squared
M$adj_r_squared=summary(M$lm)$adj.r.squared
|
c34a3c53 |
return(M)
}
|
883f7f27 |
)
#' @export
|
28dfb678 |
#' @template model_predict
|
8db793ae |
setMethod(f="model_predict",
signature=c("linear_model",'DatasetExperiment'),
|
c34a3c53 |
definition=function(M,D)
{
X=cbind(D$data,D$sample_meta)
M$predicted_values(predict(M$lm,newdata = X))
return(M)
}
|
883f7f27 |
)
|