R/linear_model_class.R
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
 )