diff --git a/NAMESPACE b/NAMESPACE index 3735faf..372ca75 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,13 +1,22 @@ # Generated by roxygen2: do not edit by hand +S3method(handler_predict,accept_model) +S3method(predict,accept_model) +S3method(vetiver_create_description,accept_model) +S3method(vetiver_ptype,accept_model) export(accept) export(accept1) export(accept2) +export(handler_predict) export(plotExacerbations) export(plotHeatMap) +export(predict) export(predictCountProb) export(set_openai_api_key) export(show_openai_api_key) +export(vetiver_create_description) +export(vetiver_create_meta) +export(vetiver_ptype) import(dplyr) importFrom(reldist,wtd.quantile) importFrom(splines,bs) diff --git a/R/vetiver-compatibility.R b/R/vetiver-compatibility.R new file mode 100644 index 0000000..653accd --- /dev/null +++ b/R/vetiver-compatibility.R @@ -0,0 +1,78 @@ +#class(accept) <- c("accept_model", class(accept)) + +#' @export +vetiver_create_description <- function(model) { + UseMethod("vetiver_create_description") +} + +#' @export +vetiver_create_description.accept_model <- function(model) { + "The Acute COPD Exacerbation Prediction Tool (ACCEPT)" +} + +#' @export +predict<- function(object, newdata) { + UseMethod("predict") +} + +#' @export +predict.accept_model <- function(object, newdata) { + accept(newdata) +} + +#' @export +vetiver_ptype<- function(model,...) { + UseMethod("vetiver_ptype") +} + +#' @export +vetiver_ptype.accept_model <- function(model, ...) { + vctrs::vec_ptype(tibble::tibble(ID = character(), + male = logical(), + age = integer(), + smoker = logical(), + oxygen = logical(), + statin = logical(), + LAMA = logical(), + LABA = logical(), + ICS = logical(), + FEV1 = double(), + BMI = double(), + SGRQ = integer(), + LastYrExacCount = integer(), + LastYrSevExacCount = integer() + )) +} + + +#' @export +vetiver_create_meta<- function(model, metadata) { + UseMethod("vetiver_create_meta") +} + +vetiver_create_meta.accept_model <- function(model, metadata) { + vetiver_meta(metadata, required_pkgs = "accept") +} + + +#' @export +handler_predict <- function(vetiver_model) { + UseMethod("handler_predict") +} + + +#' @export +handler_predict.accept_model <- function(vetiver_model, ...) { + + ptype <- vetiver_model$prototype + + function(req) { + newdata <- req$body + newdata <- vetiver_type_convert(newdata, ptype) + newdata <- hardhat::scream(newdata, ptype) + ret <- predict(vetiver_model$model, newdata = newdata, ...) + list(.pred = ret) + } + +} +