R/fitted.assignment.R

In jtrecenti/bnlearn: Bayesian Network Structure Learning, Parameter Learning and Inference

fitted.assignment.backend = function(x, name, value) {

  # preserve the original object for subsequent sanity checks.
  to.replace = x[[name]]
  new = to.replace

  if (is(to.replace, c("bn.fit.dnode", "bn.fit.onode"))) {

    # check the consistency of the new conditional distribution.
    value = check.fit.dnode.spec(value, node = name)
    # sanity check the new obejct by comparing it to the old one.
    value = check.dnode.vs.spec(value, to.replace)
    # replace the conditional probability table.
    new$prob = value

  }#THEN
  else if (is(to.replace, "bn.fit.gnode")) {

    if (is(value, c("lm", "glm", "penfit")) && is(to.replace, "bn.fit.gnode")) {

      # ordinary least squares, ridge, lasso, and elastic net.
      value = list(coef = coefficients(value), resid = residuals(value),
                fitted = fitted(value), sd = sd(residuals(value)))
      # if the intercept is not there, set it to zero.
      if ("(Intercept)" %!in% names(value$coef))
        value$coef = c("(Intercept)" = 0, value$coef)

    }#THEN
    else {

      # check the consistency of the new conditional distribution.
      check.fit.gnode.spec(value, node = name)

    }#ELSE

    # sanity check the new obejct by comparing it to the old one.
    check.gnode.vs.spec(value, to.replace)

    # replace the regression coefficients, keeping the names and the ordering.
    if (is.null(names(value$coef)))
      new$coefficients = structure(value$coef, names = names(new$coefficients))
    else
      new$coefficients = noattr(value$coef[names(new$coefficients)], ok = "names")

    # replace the residuals' standard deviation.
    if (is.null(value$sd))
      new$sd = sd(value$resid) * sqrt((length(value$resid) - 1) /
                 (length(value$resid) - length(value$coef)))
    else
      new$sd = noattr(value$sd)

    # replace the residuals, padding with NAs if needed.
    if (is.null(value$resid))
      new$residuals = rep(as.numeric(NA), length(new$resid))
    else
      new$residuals = noattr(value$resid)

    # replace the fitted values, padding with NAs if needed.
    if (is.null(value$fitted))
      new$fitted.values = rep(as.numeric(NA), length(new$fitted))
    else
      new$fitted.values = noattr(value$fitted)

  }#THEN
  else if (is(to.replace, "bn.fit.cgnode")) {

    # check the consistency of the new conditional distribution.
    check.fit.gnode.spec(value, node = name)
    # sanity check the new obejct by comparing it to the old one.
    check.cgnode.vs.spec(value, to.replace)

    # replace the regression coefficients, keeping the names and the ordering.
    if (is.null(names(value$coef)))
      dimnames(value$coef) = dimnames(new$coefficients)

    new$coefficients = noattr(value$coef)

    # replace the residuals' standard deviation.
    if (is.null(value$sd))
      new$sd = by(data = value$resid, INDICES = new$configs,
                 FUN = function(x) {
                   sd(x) * sqrt((length(x) - 1) / (length(x) - nrow(value$coef)))
                  })
    else
      new$sd = value$sd

    new$sd = structure(noattr(new$sd), names = colnames(value$coef))

    # replace the residuals, padding with NAs if needed.
    if (is.null(value$resid))
      new$residuals = rep(as.numeric(NA), length(new$resid))
    else
      new$residuals = noattr(value$resid)

    # replace the fitted values, padding with NAs if needed.
    if (is.null(value$fitted))
      new$fitted.values = rep(as.numeric(NA), length(new$fitted))
    else
      new$fitted.values = noattr(value$fitted)

  }#THEN

  return(new)

}#FITTED.ASSIGNMENT.BACKEND