R/maic.R

In anoiana/buzzz: collection of helper functions

#' MAIC Analysis
#'
#' @param ipd matrix of individual patient data.
#' @param sld vector of summary level data.
#'
#' @return vector of weight
#' @export
#'
#' @examples
#' ipd = as.matrix(iris[,1:3])
#' sld = `names<-`(c(5,2.5,3),colnames(ipd))
#' wei = maic_func(ipd,sld)
maic_func = function(ipd, sld){

     val = sapply(names(sld), function(i) ! i%in% colnames(ipd) )
     if(sum(val) >0){
          notval = names(sld)[val]
          notval = paste(notval, collapse = ", ")
          stop(stringr::str_glue("Variables {notval} are not available in IPD"))
     }

     obj = function(alpha,X) sum(exp(X%*%alpha))

     X = sweep(ipd,2,sld, `-`)

     opt1 = stats::optim(par = rep(0,ncol(ipd)), fn = obj, X = X)$par

     w =  c(exp(X%*%opt1))

     diff<-
          tibble::tibble(Variable = names(sld),
                         Expected = sld,
                         True = apply(ipd,2,stats::weighted.mean,w=w)
          )%>%
          dplyr::mutate(absolute = abs(True - Expected))
     print(diff)
     invisible(w)
}