#' @include MeasureClassif.R
MeasureBinarySimple = R6Class(
  "MeasureBinarySimple",
  inherit = MeasureClassif,
  public = list(
    fun = NULL,
    fun_obs_loss = NULL,
    na_value = NaN,
    initialize = function(name, param_set = ps()) {
      info = mlr3measures::measures[[name]]
      weights = info$sample_weights
      properties = if (weights) "weights" else character()

      if (!is.na(info$obs_loss)) {
        properties = c(properties, "obs_loss")
        self$fun_obs_loss = get(info$obs_loss, envir = asNamespace("mlr3measures"), mode = "function")
      }

      super$initialize(
        id = paste0("classif.", name),
        param_set = param_set,
        range = c(info$lower, info$upper),
        minimize = info$minimize,
        properties = properties,
        predict_type = info$predict_type,
        task_properties = "twoclass",
        packages = "mlr3measures",
        label = info$title,
        man = paste0("mlr3::mlr_measures_classif.", name)
      )

      self$fun = get(name, envir = asNamespace("mlr3measures"), mode = "function")

      if (test_list(info$trafo)) {
        self$trafo = info$trafo
      }
    }
  ),

  private = list(
    .score = function(prediction, task, weights = NULL, ...) {
      truth = prediction$truth
      positive = levels(truth)[1L]
      invoke(
        self$fun,
        .args = self$param_set$get_values(),
        truth = truth,
        response = prediction$response,
        prob = prediction$prob[, positive],
        positive = positive,
        na_value = self$na_value,
        sample_weights = weights
      )
    },

    .extra_hash = c("fun", "fun_obs_loss", "na_value"),

    .obs_loss = function(prediction, ...) {
      truth = prediction$truth
      positive = levels(truth)[1L]
      invoke(
        self$fun_obs_loss,
        .args = self$param_set$get_values(),
        truth = truth,
        response = prediction$response,
        prob = prediction$prob[, positive],
        positive = positive
      )
    }
  )
)

#' @include MeasureClassif.R
MeasureClassifSimple = R6Class(
  "MeasureClassifSimple",
  inherit = MeasureClassif,
  public = list(
    fun = NULL,
    fun_obs_loss = NULL,
    na_value = NaN,
    initialize = function(name, param_set = ps()) {
      info = mlr3measures::measures[[name]]
      weights = info$sample_weights
      properties = if (weights) "weights" else character()
      if (!is.na(info$obs_loss)) {
        properties = c(properties, "obs_loss")
        self$fun_obs_loss = get(info$obs_loss, envir = asNamespace("mlr3measures"), mode = "function")
      }

      super$initialize(
        id = paste0("classif.", name),
        param_set = param_set,
        range = c(info$lower, info$upper),
        minimize = info$minimize,
        properties = properties,
        predict_type = info$predict_type,
        packages = "mlr3measures",
        label = info$title,
        man = paste0("mlr3::mlr_measures_classif.", name)
      )
      self$fun = get(name, envir = asNamespace("mlr3measures"), mode = "function")
      if (test_list(info$trafo)) {
        self$trafo = info$trafo
      }
    }
  ),

  private = list(
    .score = function(prediction, task, weights = NULL, ...) {
      invoke(
        self$fun,
        .args = self$param_set$get_values(),
        truth = prediction$truth,
        response = prediction$response,
        prob = prediction$prob,
        na_value = self$na_value,
        sample_weights = weights
      )
    },

    .extra_hash = c("fun", "fun_obs_loss", "na_value"),

    .obs_loss = function(prediction, ...) {
      invoke(
        self$fun_obs_loss,
        .args = self$param_set$get_values(),
        truth = prediction$truth,
        response = prediction$response,
        prob = prediction$prob
      )
    }
  )
)

#' @include MeasureRegr.R
MeasureRegrSimple = R6Class(
  "MeasureRegrSimple",
  inherit = MeasureRegr,
  public = list(
    fun = NULL,
    fun_obs_loss = NULL,
    na_value = NaN,
    initialize = function(name, param_set = NULL) {
      if (is.null(param_set)) {
        param_set = ps()
      } else {
        # cloning required because the param set lives in the
        # dictionary mlr_measures
        param_set = param_set$clone()
      }

      info = mlr3measures::measures[[name]]
      weights = info$sample_weights
      properties = if (weights) "weights" else character()
      if (!is.na(info$obs_loss)) {
        properties = c(properties, "obs_loss")
        self$fun_obs_loss = get(info$obs_loss, envir = asNamespace("mlr3measures"), mode = "function")
      }

      super$initialize(
        id = paste0("regr.", name),
        param_set = param_set,
        range = c(info$lower, info$upper),
        minimize = info$minimize,
        properties = properties,
        predict_type = info$predict_type,
        packages = "mlr3measures",
        label = info$title,
        man = paste0("mlr3::mlr_measures_regr.", name)
      )
      self$fun = get(name, envir = asNamespace("mlr3measures"), mode = "function")

      if (test_list(info$trafo)) {
        self$trafo = info$trafo
      }
    }
  ),

  private = list(
    .score = function(prediction, task, weights = NULL, ...) {
      invoke(
        self$fun,
        .args = self$param_set$get_values(),
        truth = prediction$truth,
        response = prediction$response,
        se = prediction$se,
        na_value = self$na_value,
        sample_weights = weights
      )
    },

    .extra_hash = c("fun", "fun_obs_loss", "na_value"),

    .obs_loss = function(prediction, ...) {
      invoke(
        self$fun_obs_loss,
        .args = self$param_set$get_values(),
        truth = prediction$truth,
        response = prediction$response,
        se = prediction$se
      )
    }
  )
)

#' @include MeasureSimilarity.R
MeasureSimilaritySimple = R6Class(
  "MeasureSimilaritySimple",
  inherit = MeasureSimilarity,
  public = list(
    fun = NULL,
    na_value = NaN,
    initialize = function(name, param_set = NULL) {
      if (is.null(param_set)) {
        param_set = ps()
      } else {
        # cloning required because the param set lives in the
        # dictionary mlr_measures
        param_set = param_set$clone()
      }

      info = mlr3measures::measures[[name]]
      self$fun = get(name, envir = asNamespace("mlr3measures"), mode = "function")

      agg = function(rr) {
        sets = map(rr$learners, function(l) l$selected_features())
        self$fun(sets, p = length(rr$task$feature_names))
      }

      super$initialize(
        id = paste0("sim.", name),
        param_set = param_set,
        range = c(info$lower, info$upper),
        minimize = info$minimize,
        aggregator = agg,
        predict_type = NA_character_,
        packages = "mlr3measures",
        label = info$title,
        man = paste0("mlr3::mlr_measures_sim.", name),
      )
    }
  ),

  private = list(
    .extra_hash = c("fun", "na_value")
  )
)


### binary classification measures

#' @templateVar id auc
#' @template measure_binary
mlr_measures$add("classif.auc", function() MeasureBinarySimple$new(name = "auc"))

#' @templateVar id bbrier
#' @template measure_binary
mlr_measures$add("classif.bbrier", function() MeasureBinarySimple$new(name = "bbrier"))

#' @templateVar id dor
#' @template measure_binary
mlr_measures$add("classif.dor", function() MeasureBinarySimple$new(name = "dor"))

#' @templateVar id fbeta
#' @template measure_binary
mlr_measures$add("classif.fbeta", function() {
  MeasureBinarySimple$new(name = "fbeta", param_set = ps(beta = p_int(lower = 0L)))
})

#' @templateVar id fdr
#' @template measure_binary
mlr_measures$add("classif.fdr", function() MeasureBinarySimple$new(name = "fdr"))

#' @templateVar id fn
#' @template measure_binary
mlr_measures$add("classif.fn", function() MeasureBinarySimple$new(name = "fn"))

#' @templateVar id fnr
#' @template measure_binary
mlr_measures$add("classif.fnr", function() MeasureBinarySimple$new(name = "fnr"))

#' @templateVar id fomr
#' @template measure_binary
mlr_measures$add("classif.fomr", function() MeasureBinarySimple$new(name = "fomr"))

#' @templateVar id fp
#' @template measure_binary
mlr_measures$add("classif.fp", function() MeasureBinarySimple$new(name = "fp"))

#' @templateVar id fpr
#' @template measure_binary
mlr_measures$add("classif.fpr", function() MeasureBinarySimple$new(name = "fpr"))

#' @templateVar id npv
#' @template measure_binary
mlr_measures$add("classif.npv", function() MeasureBinarySimple$new(name = "npv"))

#' @templateVar id ppv
#' @template measure_binary
mlr_measures$add("classif.ppv", function() MeasureBinarySimple$new(name = "ppv"))

#' @templateVar id prauc
#' @template measure_binary
mlr_measures$add("classif.prauc", function() MeasureBinarySimple$new(name = "prauc"))

#' @templateVar id precision
#' @template measure_binary
mlr_measures$add("classif.precision", function() MeasureBinarySimple$new(name = "precision"))

#' @templateVar id tn
#' @template measure_binary
mlr_measures$add("classif.tn", function() MeasureBinarySimple$new(name = "tn"))

#' @templateVar id tnr
#' @template measure_binary
mlr_measures$add("classif.tnr", function() MeasureBinarySimple$new(name = "tnr"))

#' @templateVar id specificity
#' @template measure_binary
mlr_measures$add("classif.specificity", function() MeasureBinarySimple$new(name = "specificity"))

#' @templateVar id tp
#' @template measure_binary
mlr_measures$add("classif.tp", function() MeasureBinarySimple$new(name = "tp"))

#' @templateVar id tpr
#' @template measure_binary
mlr_measures$add("classif.tpr", function() MeasureBinarySimple$new(name = "tpr"))

#' @templateVar id recall
#' @template measure_binary
mlr_measures$add("classif.recall", function() MeasureBinarySimple$new(name = "recall"))

#' @templateVar id sensitivity
#' @template measure_binary
mlr_measures$add("classif.sensitivity", function() MeasureBinarySimple$new(name = "sensitivity"))

### multiclass classification measures

#' @templateVar id acc
#' @template measure_classif
mlr_measures$add("classif.acc", function() MeasureClassifSimple$new(name = "acc"))

#' @templateVar id bacc
#' @template measure_classif
mlr_measures$add("classif.bacc", function() MeasureClassifSimple$new(name = "bacc"))

#' @templateVar id mbrier
#' @template measure_classif
mlr_measures$add("classif.mbrier", function() MeasureClassifSimple$new(name = "mbrier"))

#' @templateVar id ce
#' @template measure_classif
mlr_measures$add("classif.ce", function() MeasureClassifSimple$new(name = "ce"))

#' @templateVar id logloss
#' @template measure_classif
mlr_measures$add("classif.logloss", function() MeasureClassifSimple$new(name = "logloss"))

#' @templateVar id mauc_aunu
#' @template measure_classif
mlr_measures$add("classif.mauc_aunu", function() MeasureClassifSimple$new(name = "mauc_aunu"))

#' @templateVar id mauc_aunp
#' @template measure_classif
mlr_measures$add("classif.mauc_aunp", function() MeasureClassifSimple$new(name = "mauc_aunp"))

#' @templateVar id mauc_au1u
#' @template measure_classif
mlr_measures$add("classif.mauc_au1u", function() MeasureClassifSimple$new(name = "mauc_au1u"))

#' @templateVar id mauc_au1p
#' @template measure_classif
mlr_measures$add("classif.mauc_au1p", function() MeasureClassifSimple$new(name = "mauc_au1p"))

#' @templateVar id mauc_mu
#' @template measure_classif
mlr_measures$add("classif.mauc_mu", function() MeasureClassifSimple$new(name = "mauc_mu"))

#' @templateVar id mcc
#' @template measure_classif
mlr_measures$add("classif.mcc", function() MeasureClassifSimple$new(name = "mcc"))


### regression measures

#' @templateVar id bias
#' @template measure_regr
mlr_measures$add("regr.bias", function() MeasureRegrSimple$new(name = "bias"))

#' @templateVar id ktau
#' @template measure_regr
mlr_measures$add("regr.ktau", function() MeasureRegrSimple$new(name = "ktau"))

#' @templateVar id mae
#' @template measure_regr
mlr_measures$add("regr.mae", function() MeasureRegrSimple$new(name = "mae"))

#' @templateVar id mape
#' @template measure_regr
mlr_measures$add("regr.mape", function() MeasureRegrSimple$new(name = "mape"))

#' @templateVar id maxae
#' @template measure_regr
mlr_measures$add("regr.maxae", function() MeasureRegrSimple$new(name = "maxae"))

#' @templateVar id medae
#' @template measure_regr
mlr_measures$add("regr.medae", function() MeasureRegrSimple$new(name = "medae"))

#' @templateVar id medse
#' @template measure_regr
mlr_measures$add("regr.medse", function() MeasureRegrSimple$new(name = "medse"))

#' @templateVar id mse
#' @template measure_regr
mlr_measures$add("regr.mse", function() MeasureRegrSimple$new(name = "mse"))

#' @templateVar id msle
#' @template measure_regr
mlr_measures$add("regr.msle", function() MeasureRegrSimple$new(name = "msle"))

#' @templateVar id pbias
#' @template measure_regr
mlr_measures$add("regr.pbias", function() MeasureRegrSimple$new(name = "pbias"))

#' @templateVar id rmse
#' @template measure_regr
mlr_measures$add("regr.rmse", function() MeasureRegrSimple$new(name = "rmse"))

#' @templateVar id rmsle
#' @template measure_regr
mlr_measures$add("regr.rmsle", function() MeasureRegrSimple$new(name = "rmsle"))

#' @templateVar id sae
#' @template measure_regr
mlr_measures$add("regr.sae", function() MeasureRegrSimple$new(name = "sae"))

#' @templateVar id smape
#' @template measure_regr
mlr_measures$add("regr.smape", function() MeasureRegrSimple$new(name = "smape"))

#' @templateVar id srho
#' @template measure_regr
mlr_measures$add("regr.srho", function() MeasureRegrSimple$new(name = "srho"))

#' @templateVar id sse
#' @template measure_regr
mlr_measures$add("regr.sse", function() MeasureRegrSimple$new(name = "sse"))


### similarity measures

#' @templateVar id jaccard
#' @template measure_similarity
mlr_measures$add("sim.jaccard", function() MeasureSimilaritySimple$new(name = "jaccard"))

#' @templateVar id phi
#' @template measure_similarity
mlr_measures$add("sim.phi", function() {
  MeasureSimilaritySimple$new(name = "phi", param_set = ps(p = p_int(lower = 1L)))
})
