#' Calculate diagnostic performance and cutoff estimates from smoothed ROC curves.
#'
#' Calculates population-level sensitivity, specificity, and diagnostic cutoff estimates from smoothed ROC curves generated using the \ifelse{html}{\code{\link[pROC:smooth]{smooth()}}}{\code{smooth()}} function of the ‘pROC’ package via the ` “fitdist” ` method. A `smooth.roc` object is provided as input, and metrics can be calculated for the estimated diagnostic cutoff that maximizes the Youden index, or for the estimated diagnostic cutoff that achieves a user specified sensitivity or specificity value.
#'
#' @param smooth.roc
#' A `smooth.roc` object generated by \ifelse{html}{\code{\link[pROC:smooth]{smooth()}}}{\code{smooth()}} using `method = "fitdistr"`.
#'
#' @param type
#' Character string specifying the criterion used to define the diagnostic cutoff to return estimates for. If `"best"`, estimates for the cutoff that maximizes the Youden index are calculated and returned. If `"specificity"`, estimates for the cutoff that achieves a target specificity value specified by `target.value` are calculated and returned. If `"sensitivity"`, estimates for the cutoff that achieves a target sensitivity value specified by `target.value` are calculated and returned.
#'
#' @param target.value
#' Numeric value ranging between 0 and 1 that specifies the target sensitivity or specificity value defining the cutoff to calculate estimates for when `type` is not `"best"`.
#'
#' @param method
#' Character string specifying the methodology used to generate estimates. If `"continuous"`, values are estimated via continuous optimization of the smoothed ROC curve using the fitted case and control population probability density functions. If `"grid"`, cutoff values are selected via optimization over the grid-discretized operating points of the smoothed ROC curve, matching the internal behavior of the native \ifelse{html}{\code{\link[pROC:coords]{coords()}}}{\code{coords()}}  function of the ‘pROC’ package. `"continuous"` provides finer resolution and potentially more accurate estimates; however, sensitivity and specificity values will not perfectly match those returned by the \ifelse{html}{\code{\link[pROC:coords]{coords()}}}{\code{coords()}}  function. `"continuous"` is default.
#'
#' @param quiet
#' Specifies whether to silence messages generated during estimate calculation. Default value is `FALSE`.
#'
#' @return
#' A named numeric vector containing the estimated diagnostic performance and cutoff values:
#'
#' \item{`threshold`}{ The estimated diagnostic cutoff value.}
#' \item{`specificity`}{The estimated specificity at the cutoff value.}
#' \item{`sensitivity`}{The estimated sensitivity at the cutoff value.}
#'
#' @seealso
#' \ifelse{html}{\link[pROC]{pROC-package}}{pROC-package} \cr
#' \ifelse{html}{\code{\link[pROC:roc]{roc()}}}{\code{pROC::roc()}} \cr
#' \ifelse{html}{\code{\link[pROC:smooth]{smooth()}}}{\code{pROC::smooth()}} \cr
#' \ifelse{html}{\code{\link[pROC:coords]{coords()}}}{\code{pROC::coords()}} \cr
#' [rocTools-package] \cr
#' [find.distr()] \cr
#' \code{\link{blood_data}}
#'
#' @examples
#' # load packages and example blood biomarker data
#'
#' library(pROC)
#' library(rocTools)
#' data(blood_data)
#'
#' # build raw ROC curve
#'
#' raw_roc <- roc(
#'   blood_data,
#'   response = "Diagnosis",
#'   predictor = "NfL"
#' )
#'
#' # find best fitting case and control distribution
#' # families to use for ROC smoothing
#'
#' best_fits <- find.distr(raw_roc)
#'
#' # use best fitting families to build smooth ROC curve
#'
#' smooth_roc <- smooth(
#'   raw_roc,
#'   method = "fitdistr",
#'   density.controls = best_fits$density.controls,
#'   density.cases = best_fits$density.cases,
#'   start.controls = best_fits$start.controls,
#'   start.cases = best_fits$start.cases
#' )
#'
#' # calculate sensitivity, specificity, and cutoff
#' # estimates for the max Youden cutoff
#'
#' sm.coords(smooth_roc, type = "best")
#'
#' # calculate sensitivity, specificity, and cutoff estimates
#' # for the cutoff that yields 90% sensitivity
#'
#' sm.coords(
#'   smooth_roc,
#'   type = "sensitivity",
#'   target.value = 0.9
#' )
#'
#' # calculate sensitivity, specificity, and cutoff estimates
#' # for the cutoff that yields 75% specificity
#'
#' sm.coords(
#'   smooth_roc,
#'   type = "specificity",
#'   target.value = 0.75
#' )
#'
#' @export

sm.coords<-function(
    smooth.roc,
    type=c("best", "specificity", "sensitivity"),
    target.value=NULL,
    method=c("continuous", "grid"),
    quiet=FALSE
){

  # check input
  # -----------------------------------------------------------

  smooth_roc<-smooth.roc
  method<-match.arg(method)
  type<-match.arg(type)

  if(!inherits(smooth_roc, "smooth.roc")){
    stop("Input must be a smooth.roc object generated by the 'pROC' package.")
  }

  if(is.null(smooth_roc$smoothing.args$method)||
     smooth_roc$smoothing.args$method!="fitdistr"){
    stop("Input must be a smooth.roc object generated with method = \"fitdistr\".")
  }

  roc_emp<-attr(smooth_roc, "roc")
  if(is.null(roc_emp)){
    stop(
      "Input must be a smooth.roc object with the original raw roc object ",
      "attached as an attribute."
    )
  }

  if(type!="best"){

    if(is.null(target.value)){
      stop("target.value must be supplied when type is not 'best'.")
    }

    if(!is.numeric(target.value)||
       length(target.value)!=1||
       target.value<=0||
       target.value>=1){
      stop("target.value must be a single numeric value between 0 and 1.")
    }
  }

  # extract case and control PDFs
  # -----------------------------------------------------------

  fit0<-smooth_roc$fit.controls
  fit1<-smooth_roc$fit.cases

  densfun_to_p<-function(d){
    switch(d,
           normal=pnorm,
           gamma=pgamma,
           lognormal=plnorm,
           weibull=pweibull,
           stop("Unsupported distribution: ", d)
    )
  }

  pfun0<-densfun_to_p(fit0$densfun)
  pfun1<-densfun_to_p(fit1$densfun)

  F0<-function(c){
    do.call(pfun0, c(list(c), as.list(fit0$estimate)))
  }

  F1<-function(c){
    do.call(pfun1, c(list(c), as.list(fit1$estimate)))
  }

  # helpers for calculating Youden index,
  # sensitivity, and specificity
  # -----------------------------------------------------------

  if(smooth_roc$direction=="<"){

    youden_c<-function(c){
      y<-F0(c)-F1(c)
      y[!is.finite(y)]<-0
      y
    }

    sens_c<-function(c){
      1-F1(c)
    }

    spec_c<-function(c){
      F0(c)
    }

  }else{

    youden_c<-function(c){
      y<-F1(c)-F0(c)
      y[!is.finite(y)]<-0
      y
    }

    sens_c<-function(c){
      F1(c)
    }

    spec_c<-function(c){
      1-F0(c)
    }
  }

  # extract raw x data
  # -----------------------------------------------------------

  x<-roc_emp$original.predictor
  lo<-min(x, na.rm=TRUE)
  hi<-max(x, na.rm=TRUE)
  eps<-1e-8*(hi-lo)

  # implement grid method
  # -----------------------------------------------------------

  if(method=="grid"){

    sens<-smooth_roc$sensitivities
    spec<-smooth_roc$specificities

    if(type=="best"){

      youden<-sens+spec-1
      idx<-which.max(youden)

    }else if(type=="sensitivity"){

      idx<-which.min(abs(sens-target.value))

      if(target.value<min(sens)||target.value>max(sens)){
        if(quiet==FALSE){
          warning(
            "Requested sensitivity not attainable: ",
            "Returning threshold for closest achievable sensitivity."
          )
        }
      }

    }else{

      idx<-which.min(abs(spec-target.value))

      if(target.value<min(spec)||target.value>max(spec)){
        if(quiet==FALSE){
          warning(
            "Requested specificity not attainable: ",
            "Returning threshold for closest achievable specificity."
          )
        }
      }
    }

    # recover fitted distribution cutoff from grid

    if(smooth_roc$direction=="<"){

      qfun0<-switch(fit0$densfun,
                    normal=qnorm,
                    gamma=qgamma,
                    lognormal=qlnorm,
                    weibull=qweibull)

      c_opt<-do.call(
        qfun0,
        c(list(spec[idx]), as.list(fit0$estimate))
      )

    }else{

      qfun1<-switch(fit1$densfun,
                    normal=qnorm,
                    gamma=qgamma,
                    lognormal=qlnorm,
                    weibull=qweibull)

      c_opt<-do.call(
        qfun1,
        c(list(sens[idx]), as.list(fit1$estimate))
      )
    }

    if(!is.finite(c_opt)){

      c_opt<-ifelse(c_opt>0, hi, lo)
      c_opt<-max(min(c_opt, hi-eps), lo+eps)

      if(type=="best"){
        warning(
          "Maximum Youden index is 0: ",
          "Returning boundary threshold from the raw roc object."
        )
      }
    }

    # build output

    return(c(
      threshold=c_opt,
      specificity=spec[idx],
      sensitivity=sens[idx]
    ))
  }

  # implement continuous method
  # -----------------------------------------------------------

  if(type=="best"){

    rng<-range(x, na.rm=TRUE)

    opt<-try(
      optimize(youden_c, interval=rng, maximum=TRUE),
      silent=TRUE
    )

    if(inherits(opt, "try-error")){
      stop("Continuous optimization of Youden index failed.")
    }

    c_opt<-opt$maximum

  }else if(type=="sensitivity"){

    obj<-function(c){
      abs(sens_c(c)-target.value)
    }

    opt<-optimize(obj, interval=c(lo, hi))
    c_opt<-opt$minimum

    if(abs(sens_c(c_opt)-target.value)>1e-6){
      if(quiet==FALSE){
        warning(
          "Requested sensitivity not attainable: ",
          "Returning threshold for closest achievable sensitivity."
        )
      }
    }

  }else{

    obj<-function(c){
      abs(spec_c(c)-target.value)
    }

    opt<-optimize(obj, interval=c(lo, hi))
    c_opt<-opt$minimum

    if(abs(spec_c(c_opt)-target.value)>1e-6){
      if(quiet==FALSE){
        warning(
          "Requested specificity not attainable: ",
          "Returning threshold for closest achievable specificity."
        )
      }
    }
  }

  if(!is.finite(c_opt)){

    c_opt<-ifelse(c_opt>0, hi, lo)
    c_opt<-max(min(c_opt, hi-eps), lo+eps)

    if(type=="best"){
      if(quiet==FALSE){
        warning(
          "Maximum Youden index is 0: ",
          "Returning boundary threshold from the raw roc object."
        )
      }
    }
  }

  # build output

  c(
    threshold=c_opt,
    specificity=spec_c(c_opt),
    sensitivity=sens_c(c_opt)
  )
}
