inst/doc/myConcomitant.R

In flexmix: Flexible Mixture Modeling

myConcomitant <-
  function(formula = ~ 1) {
    z <- new("FLXP",
             name = "myConcomitant",
             formula = formula)
    z@fit <- function(x, y, w, ...) {
      if (missing(w) || is.null(w)) w <- rep(1, length(x))
      f <- as.integer(factor(apply(x, 1, paste,
                                   collapse = "")))
      AVG <- apply(w*y, 2, tapply, f, mean)
      (AVG/rowSums(AVG))[f,,drop=FALSE]
    }
    z@refit <- function(x, y, w, ...) {
      if (missing(w) || is.null(w)) w <- rep(1, length(x))
      f <- as.integer(factor(apply(x, 1, paste,
                                   collapse = "")))
      AVG <- apply(w*y, 2, tapply, f, mean)
      (AVG/rowSums(AVG))
    }
    z
  }