
# take care of meaningless dots arguments in plot functions.
sanitize.plot.dots = function(dots, meaningless) {

  # warn about them.
  if (any(names(dots) %in% meaningless))
    warning("arguments ", paste(meaningless, collapse = ", "),
      " will be silently ignored.")
  # nuke them from orbit.
  for (m in meaningless)
    dots[[m]] = NULL

  return(dots)

}#SANITIZE.PLOT.DOTS

# check a colour identifier (not necessarily a string/integer).
check.colour = function(col, num = 1, expand = FALSE, labels) {

  # if the colours are provided as a list (as opposed to an array) then unlist.
  if (is.list(col))
    col = unlist(col)

  # either one colour for all entities, or one colour for each entity.
  if (length(col) %!in% c(1, num)) {

    if (num == 1)
      stop(sprintf("%s must be a single colour.", deparse(substitute(col))))
    else
      stop(sprintf("%s must be a single colour or a vector of %d colours.",
        deparse(substitute(col)), num))

  }#THEN

  # this conversion is faithful to the output of col2rgb() and prevents possible
  # "missing value where TRUE/FALSE needed" errors.
  if (any(is.na(col)))
    col[is.na(col)] = "transparent"

  # this incantation returns TRUE if col2rgb() succeeds, because its return
  # value is guaranteed to be a matrix; and FALSE if col2rgb() fails and with
  # some error.
  valid = sapply(col, function(col)
              tryCatch(is.matrix(col2rgb(col)), error = function(x) { FALSE }))

  if (any(!valid))
    stop("invalid colour identifier(s) in ", deparse(substitute(col)), " : ",
           sQuote(col[!valid]))

  if (expand) {

    # expand the colour into a vector if only one colour is provided.
    if (length(col) == 1)
      col = rep(col, num)

    # add names.
    if (!missing(labels)) {

      if (is.null(names(col)))
        col = structure(col, names = labels)
      else if (!setequal(names(col), labels))
        stop("colours specified with unknown names ",
          sQuote(col[names(col) %!in% labels]))

    }#THEN

  }#THEN

  return(col)

}#CHECK.COLOUR

# check the line type identifier.
check.lty = function(lty) {

  lty.strings = c("blank", "solid", "dashed", "dotted", "dotdash", "longdash",
                  "twodash")

  if (length(lty) > 1)
    stop(sprintf("%s must be a single line type identifier.",
      deparse(substitute(lty))))
  if ((lty %!in% 0:6) && (lty %!in% lty.strings))
    stop(sprintf("%s is not a valid line type identifier.",
           deparse(substitute(lty))))

  # Rgraphviz does not support mixing numeric and string values, remap them.
  if (is.positive.integer(lty))
    lty = lty.strings[lty + 1]

  return(lty)

}#CHECK.LTY

# check the nodes and arcs to highlight and their graphical parameters.
check.highlight = function(highlight, nodes) {

  highlight.params = c("nodes", "arcs", "col", "fill", "lwd", "lty", "textCol")

  # nothing to highlight, leave the graph as it is.
  if (is.null(highlight) || (length(highlight) == 0))
    return(NULL)

  if (!is.list(highlight) || any(names(highlight) %!in% highlight.params))
    stop("highlight must be a list with a subset of the following",
         " elements: ", sQuote(highlight.params), ".")

  if ("nodes" %in% names(highlight))
    check.nodes(highlight$nodes, graph = nodes)

  if ("arcs" %in% names(highlight)) {

    highlight$arcs = check.arcs(highlight$arcs, nodes = nodes)

    # disregard empty arc sets.
    if (nrow(highlight$arcs) == 0)
      highlight$arcs = NULL

  }#THEN

  if ("col" %in% names(highlight))
    check.colour(highlight$col)
  else
    highlight$col = "red"

  if ("fill" %in% names(highlight)) {

    if ("nodes" %!in% names(highlight))
      warning("no node to apply the 'fill' color to, ignoring.")

    check.colour(highlight$fill)

  }#THEN
  else
    highlight$fill = "transparent"

  if ("lwd" %in% names(highlight)) {

    if ("arcs" %!in% names(highlight))
      warning("no arc to apply the 'lwd' setting to, ignoring.")

    if (!is.positive(highlight$lwd))
      stop("the line width must be a positive number.")

  }#THEN

  if ("lty" %in% names(highlight)) {

    if ("arcs" %!in% names(highlight))
      warning("no arc to apply the 'lty' setting to, ignoring.")

    highlight$lty = check.lty(highlight$lty)

  }#THEN

  if ("textCol" %in% names(highlight)) {

    if ("nodes" %!in% names(highlight))
      warning("no node to apply the 'textColor' color to, ignoring.")

    check.colour(highlight$textCol)

  }#THEN
  else
    highlight$textCol = "black"

  return(highlight)

}#CHECK.HIGHLIGHT

# check the grid used to make probability bar/line plots easier to read.
check.chart.grid = function(grid, fitted, range) {

  nodes = nodes(fitted)
  nnodes = length(nodes)
  grid.list = structure(vector(nnodes, mode = "list"), names = nodes)

  sanitize = function(grid, fitted.node, range) {

    # remove duplicated values.
    if (anyDuplicated(grid))
      warning("duplicated grid points.")
    grid = unique(grid)

    if (is(fitted.node, c("bn.fit.dnode", "bn.fit.onode"))) {

      # make sure the grid points are within the appropriate range.
      if (!is.probability.vector(grid, zero = TRUE))
        stop("grid values must be between zero and one in node ", node, ".")

    }#THEN
    else if (is(fitted.node, c("bn.fit.gnode", "bn.fit.cgnode"))) {

      # make sure there are no NAs, Infs, ets.
      if (!is.real.vector(grid))
        stop("grid values for node ", node, " must be real numbers.")

      # make sure the grid points are within the appropriate range.
      if (any(grid[grid != 0] < range[1]) || any(grid[grid != 0] > range[2]))
        warning("discarding out-of-range grid values in node ", node, ".")

      # make special allowances for zero, even if it is out of range.
      grid =
        union(grid[grid >= range[1] & grid <= range[2]], intersect(grid, 0))

    }#THEN

  }#SANITIZE

  if (is.logical(grid)) {

    for (node in nodes) {

      if (is(fitted[[node]], c("bn.fit.dnode", "bn.fit.onode"))) {

        if (identical(grid, TRUE))
          grid.list[[node]] = c(0, 0.25, 0.50, 0.75)
        else
          grid.list[node] = list(NULL)

      }#THEN
      else if (is(fitted[[node]], c("bn.fit.gnode", "bn.fit.cgnode"))) {

        if (identical(grid, TRUE)) {

          if (all(range[[node]] <= 0) || all(range[[node]] >= 0))
            grid.list[[node]] = c(0, range[[node]], mean(range[[node]]))
          else
            grid.list[[node]] = c(0, range[[node]] / 2, range[[node]])

        }#THEN
        else {

          grid.list[node] = list(NULL)

        }#ELSE

      }#THEN

    }#FOR

  }#THEN
  else if (is.real.vector(grid) && (length(grid) >= 1)) {

    for (node in nodes)
      grid.list[[node]] = sanitize(grid, fitted[[node]], range[[node]])

  }#THEN
  else if (is.list(grid)) {

    if (length(grid) != nnodes)
      stop("the list of grid points has ", length(grid),
           " elements, but the network has ", nnodes, " nodes.")
    if (is.null(names(grid)) || !setequal(names(grid), nodes))
      stop("the list of grid points must be a named list with one element per node.")

    for (node in nodes)
      grid.list[[node]] = sanitize(grid[[node]], fitted[[node]], range[[node]])

  }#THEN
  else {

    stop("the grid is defined by one or more numbers in the range of the parameter values.")

  }#ELSE

  return(grid.list)

}#CHECK.CHART.GRID
