
# check test labels.
check.test = function(test, data) {

  data.type = attr(data, "metadata")$type
  if (is.null(data.type))
    data.type = data.type(data)

  if (!missing(test) && !is.null(test)) {

    # check the test label.
    check.label(test, choices = available.tests, labels = test.labels,
      argname = "conditional independence test", see = "bnlearn-package")
    # check if it's the right test for the data (discrete, continuous).
    if ((data.type != "ordered") &&
        (test %in% available.ordinal.tests))
      stop("test '", test, "' may only be used with ordinal data.")
    if ((data.type %!in% discrete.data.types) &&
        (test %in% available.discrete.tests))
      stop("test '", test, "' may only be used with discrete data.")
    if ((data.type != "continuous") &&
        (test %in% available.continuous.tests))
      stop("test '", test, "' may only be used with continuous data.")
    if ((data.type != "mixed-cg") &&
        (test %in% available.mixedcg.tests))
      stop("test '", test, "' may only be used with a mixture of continuous and discrete data.")

    return(test)

  }#THEN
  else {

    if (data.type == "ordered")
      return("jt")
    else if (data.type %in% c("factor", "mixed-do"))
      return("mi")
    else if (data.type == "continuous")
      return("cor")
    else if (data.type == "mixed-cg")
      return("mi-cg")

  }#ELSE

}#CHECK.TEST

# check the target nominal type I error rate.
check.alpha = function(alpha, network = NULL) {

  # check the target nominal type I error rate
  if (!missing(alpha) && !is.null(alpha)) {

    # validate alpha.
    if (!is.probability(alpha))
      stop("alpha must be a numerical value in [0,1].")

  }#THEN
  else {

    # check if there is an alpha value stored in the bn object;
    # otherwise use the usual 0.05 value.
    if (!is.null(network$learning$args$alpha))
      alpha = network$learning$args$alpha
    else
      alpha = 0.05

  }#ELSE

  return(alpha)

}#CHECK.ALPHA

# sanitize the extra arguments passed to the conditional independence tests.
check.test.args = function(test, network = NULL, data, extra.args) {

  # check the imaginary sample size.
  if (has.argument(test, "B", test.extra.args))
    extra.args[["B"]] =
      check.B(B = extra.args[["B"]], network = network, criterion = test)

  # check the R function implementing a custom test.
  if (has.argument(test, "fun", test.extra.args))
    extra.args[["fun"]] =
      check.custom.test.function(fun = extra.args[["fun"]], network = network)
  if (has.argument(test, "args", test.extra.args))
    extra.args[["args"]] =
      check.custom.test.arguments(args = extra.args[["args"]], network = network)

  # warn about and remove unused arguments.
  extra.args = check.unused.args(extra.args, test.extra.args[[test]])

  return(extra.args)

}#CHECK.TEST.ARGS

# check the number of permutation/bootstrap samples.
check.B = function(B, network, criterion) {

  if (criterion %in% resampling.tests) {

    if (!missing(B) && !is.null(B)) {

      if (!is.positive.integer(B))
        stop("the number of permutations/bootstrap replications must be a positive integer number.")

      B = as.integer(B)

    }#THEN
    else {

      if (!is.null(network$learning$args$B))
        B = network$learning$args$B
      else if (criterion %in% semiparametric.tests)
        B = 100L
      else
        B = 5000L

    }#ELSE

  }#THEN
  else {

    if (!missing(B) && !is.null(B))
      warning("this test does not require any permutations/bootstrap resampling, ignoring B.\n")

    B = NULL

  }#ELSE

  return(B)

}#CHECK.B

# format the "x ~ y | z1 + z2" description of a conditional independence test.
ci.test.data.name = function(x, y, z) {

  if (length(z) > 0)
    return(paste0(x, " ~ ", y, " | ", paste(z, collapse = " + ")))
  else
    return(paste0(x, " ~ ", y))

}#CI.TEST.DATA.NAME

# sanitize a conditional independence test specified as columns of a data frame;
# return the data subset to the variables involved (the tested variables in the
# first two columns, the conditioning variables in the following ones).
check.ci.test.character = function(x, y, z, data) {

  if (missing(y))
    stop("one or both of the variables to test are missing.")
  if (missing(z) || is.null(z))
    z = character(0)
  # the data must be a data frame to select the test variables from it.
  if (missing(data))
    stop("the data are missing.")
  if (!is.data.frame(data))
    stop("the data must be in a data frame.")
  # the variables must be distinct columns of the data.
  check.nodes(c(x, y, z), graph = names(data))

  # keep only the variables involved in the test and validate them, so that
  # unrelated columns do not influence the test or its sanitization. Latent
  # (fully-unobserved) variables are allowed: they are dropped from the
  # conditioning set, and make the test trivially independent if tested.
  data = check.data(data[, c(x, y, z), drop = FALSE], allow.missing = TRUE)

  return(list(data = data, data.name = ci.test.data.name(x, y, z)))

}#CHECK.CI.TEST.CHARACTER

# sanitize a conditional independence test specified as raw data vectors; return
# the data collected into a data frame (the tested variables in the first two
# columns, the conditioning variables in the following ones).
check.ci.test.vector = function(x, y, z, xlab, ylab, zlab) {

  # check the variables involved in the test.
  if (!is.vector(x))
    stop("'x' must be a vector.")
  if (!is.vector(y))
    stop("'y' must be a vector.")
  if (length(y) != length(x))
    stop("'x' and 'y' must have the same length.")

  if (!missing(z)) {

    if (is.matrix(z) || is.data.frame(z)) {

      if (nrow(z) != length(x))
        stop("'x', 'y', and 'z' must have the same length.")

    }#THEN
    else if (is.vector(z)) {

      if (length(z) != length(x))
        stop("'x', 'y', and 'z' must have the same length.")

    }#THEN
    else
      stop("'z' must be a numeric vector, matrix or data frame.")

    # build the data frame.
    data = data.frame(x = x, y = y, z = z)
    conditioning = (length(z) > 0)

  }#THEN
  else {

    # build the data frame.
    data = data.frame(x = x, y = y)
    conditioning = FALSE

  }#ELSE

  # check the data are there; latent (fully-unobserved) variables are allowed.
  data = check.data(data, allow.missing = TRUE)

  # the conditioning part of the description is the label of the z argument.
  zlabel = character(0)
  if (conditioning)
    zlabel = zlab

  return(list(data = data,
              data.name = ci.test.data.name(xlab, ylab, zlabel)))

}#CHECK.CI.TEST.VECTOR

# check the R function implementing a custom score.
check.custom.test.function = function(fun, network) {

  # there is no possible default value.
  if (is.null(fun)) {

    if (!is.null(network$learning$args$fun))
      fun = network$learning$args$fun
    else
      stop("missing the custom test function.")

  }#THEN
  else {

    # check the argument list.
    fun.arguments = names(formals(fun))
    if (!identical(fun.arguments, c("x", "y", "z", "data", "args")))
      stop("the custom test function must have signature function(x, y, z, data, args).")

  }#ELSE

  return(fun)

}#CHECK.CUSTOM.TEST.FUNCTION

# check the additional argument list passed to a custom test.
check.custom.test.arguments = function(args, network) {

  # default to an empty argument list.
  if (is.null(args)) {

    if (!is.null(network$learning$args$args))
      args = network$learning$args$args
    else
      args = list()

  }#THEN
  else {

    if (!is.list(args))
      stop("the arguments for the custom test must be passed as a list.")

  }#ELSE

  return(args)

}#CHECK.CUSTOM.TEST.ARGUMENTS
