inst/doc/AddingCustomFeatureEngineering.R

In PatientLevelPrediction: Develop Clinical Prediction Models Using the Common Data Model

## ----echo = FALSE, message = FALSE, warning = FALSE---------------------------
library(PatientLevelPrediction)

## ----echo = TRUE, eval=FALSE--------------------------------------------------
# createAgeSpline <- function(knots = 5) {
#   # create list of inputs to implement function
#   featureEngineeringSettings <- list(
#     knots = knots
#   )
# 
#   # specify the function that will implement the sampling
#   attr(featureEngineeringSettings, "fun") <- "implementAgeSplines"
# 
#   # make sure the object returned is of class "sampleSettings"
#   class(featureEngineeringSettings) <- "featureEngineeringSettings"
#   return(featureEngineeringSettings)
# }

## ----tidy=FALSE,eval=FALSE----------------------------------------------------
# implementAgeSplines <- function(trainData, featureEngineeringSettings, model = NULL) {
#   # if there is a model, it means this function is called through applyFeatureengineering, meaning it   # should apply the model fitten on training data to the test data
#   if (is.null(model)) {
#     knots <- featureEngineeringSettings$knots
#     ageData <- trainData$labels
#     y <- ageData$outcomeCount
#     X <- ageData$ageYear
#     model <- mgcv::gam(
#       y ~ s(X, bs = "cr", k = knots, m = 2)
#     )
#     newData <- data.frame(
#       rowId = ageData$rowId,
#       covariateId = 2002,
#       covariateValue = model$fitted.values
#     )
#   } else {
#     ageData <- trainData$labels
#     X <- trainData$labels$ageYear
#     y <- ageData$outcomeCount
#     newData <- data.frame(y = y, X = X)
#     yHat <- predict(model, newData)
#     newData <- data.frame(
#       rowId = trainData$labels$rowId,
#       covariateId = 2002,
#       covariateValue = yHat
#     )
#   }
# 
#   # remove existing age if in covariates
#   trainData$covariateData$covariates <- trainData$covariateData$covariates |>
#     dplyr::filter(!.data$covariateId %in% c(1002))
# 
#   # update covRef
#   Andromeda::appendToTable(
#     trainData$covariateData$covariateRef,
#     data.frame(
#       covariateId = 2002,
#       covariateName = "Cubic restricted age splines",
#       analysisId = 2,
#       conceptId = 2002
#     )
#   )
# 
#   # update covariates
#   Andromeda::appendToTable(trainData$covariateData$covariates, newData)
# 
#   featureEngineering <- list(
#     funct = "implementAgeSplines",
#     settings = list(
#       featureEngineeringSettings = featureEngineeringSettings,
#       model = model
#     )
#   )
# 
#   attr(trainData$covariateData, "metaData")$featureEngineering <- listAppend(
#     attr(trainData$covariateData, "metaData")$featureEngineering,
#     featureEngineering
#   )
# 
#   return(trainData)
# }

## ----tidy=TRUE,eval=TRUE------------------------------------------------------
citation("PatientLevelPrediction")