version 0.0.1

DESCRIPTION

@@ -0,0 +1,19 @@
+Package: flexmixNL
+Type: Package
+Title: Finite Mixture Modeling of Generalized Nonlinear Models
+Version: 0.0.1
+Authors@R: c(person("Sanela", "Omerovic", role = c("aut", "cre"),
+                    email = "omerovic@alumni.tugraz.at"),
+             person("Herwig", "Friedl", role = c("ths")))
+Description: The fitting of mixtures of generalized nonlinear models is implemented as an extension of the existing package 'flexmix'. 
+Depends: flexmix (>= 2.3.14), gnm (>= 1.0.8)
+Imports: methods, stats, utils
+LazyLoad: yes
+License: GPL-2 | GPL-3
+NeedsCompilation: no
+Packaged: 2019-07-24 18:12:54 UTC; Sanela
+Author: Sanela Omerovic [aut, cre],
+  Herwig Friedl [ths]
+Maintainer: Sanela Omerovic <omerovic@alumni.tugraz.at>
+Repository: CRAN
+Date/Publication: 2019-07-27 08:10:02 UTC

MD5

@@ -0,0 +1,10 @@
+08a454218458b6eb4ab6486389071d8b *DESCRIPTION
+34c6cc4181511f93ddcda32bf7b4c223 *NAMESPACE
+efc630603b0db8feb091865c02e57640 *R/FLXMRnlm.r
+30e7c6aab409e7b4c12c689b2a68bf86 *data/GReg.RData
+292d5f6e6e9cb24046b9a2aaf629ca39 *data/NReg.RData
+3e0d70f7c6425bffa6809b9d8890d4fa *man/FLXMRnlm.Rd
+7320f46a6978ffc1431fd1b62c62ac4a *man/GReg.Rd
+28acf119cc52c95b8e66a067f6c7afef *man/NReg.Rd
+d89d241c90ed99b478da31a96c387859 *man/flexmixNL-internal.Rd
+eae84a183f891663ffbed32aeed4e79c *man/flexmixNL-package.Rd

NAMESPACE

@@ -0,0 +1,21 @@
+import("methods")
+import("flexmix")
+importFrom("gnm", "gnm")
+importFrom("stats", "as.formula", "coef", "df.residual", "dnorm", "dgamma", 
+           "get_all_vars", "nls", "residuals", "update", "weights", "Gamma", 
+           "terms", "update.formula")
+importFrom("utils", "data", "globalVariables")
+
+
+exportPattern("^[[:alpha:]]+")
+exportMethods(
+    "FLXdeterminePostunscaled",
+    "FLXgetModelmatrix",
+    "FLXmstep"
+)
+exportClasses(
+    "FLXMRnlm" 
+)
+
+
+

R/FLXMRnlm.r

@@ -0,0 +1,146 @@
+setClass("FLXMRnlm",
+         representation(start = "list",
+                        family = "character",
+                        refit = "function"),
+         contains = "FLXMR")
+
+utils::globalVariables(c("w"))
+
+FLXMRnlm <- function(formula = .~.,
+                     family = c("gaussian", "Gamma"),
+                     start = list(), offset = NULL)
+{
+  formula <- as.formula(formula)
+  family <- match.arg(family)
+
+  z <- new("FLXMRnlm", weighted = TRUE, formula = formula, start = start,
+           name = paste("FLXMRnlm", family, sep=":"), offset = offset,
+           family = family, refit = refit)
+
+  if(family=="gaussian"){ 
+    z@defineComponent <- function(para){
+      predict <- function(x, ...){
+        data0 <- data.frame(x)
+        startEnv <- new.env(hash = FALSE, parent = environment(formula))
+        for (i in names(para$start)) assign(i, para$coef[[i]], envir = startEnv)
+        p <- eval(formula[[3L]], data0, startEnv)
+        p
+      }
+      logLik <- function(x, y, ...) dnorm(y, mean = predict(x, ...), 
+                                          sd = para$sigma, log = TRUE)
+
+      new("FLXcomponent",
+          parameters=list(coef = para$coef, sigma = para$sigma),
+          logLik = logLik, predict = predict,
+          df = para$df)
+    }
+    z@fit <- function(formula, start, x, y, w)
+    {
+      fit <- nls.wfit(formula = formula, start = start, 
+                      data = data.frame(x,y,w))
+      z@defineComponent(para = list(coef = coef(fit),
+                                    start = as.list(fit$start),
+                                    df = length(fit$start)+1,
+                                    sigma = sqrt(sum(fit$weights * 
+                                                       fit$residuals^2 /
+                                                       mean(fit$weights))/ 
+                                                   (fit$df.residuals))))
+    }
+  }else if(family=="Gamma"){
+    z@defineComponent <- function(para){
+      predict <- function(x, ...){
+        dotarg <- list(...)
+        if("offset" %in% names(dotarg)) offset <- dotarg$offset
+        p <- sapply(seq_len(nrow(x)),
+                    function(i) {
+                      eval(parse(text = as.formula(formula[[3L]][[3L]])$term(
+                        unlist(para$coef),x[i,])))
+                    })
+        p <- as.matrix(p)
+      }
+
+      logLik <- function(x, y, ...) {
+        dgamma(y, shape = para$shape, scale = predict(x, ...)/para$shape,
+               log = TRUE)}
+
+      new("FLXcomponent", parameters = list(coef = para$coef, 
+                                            shape = para$shape),
+          predict = predict, logLik = logLik, df = para$df)
+    }
+
+    z@fit <- function(formula, start, x, y, w)
+    { 
+      fit <- gnm.wfit(formula = formula, start = start, data= data.frame(x,y,w),
+                      family = Gamma(link="identity"))
+      z@defineComponent(para = list(fit = fit, coef = fit$coefficients,
+                                    df = length(start)+1,
+                                    shape = sum(fit$prior.weights)/
+                                      fit$deviance))
+    }
+  }
+  else stop(paste("Unknown family", family))
+  z
+}
+
+setMethod("FLXgetModelmatrix", signature(model = "FLXMRnlm"),
+          function(model, data, formula, start = list(),...)
+          {
+            if(is.null(model@formula))  model@formula <- formula
+            model@fullformula <- update.formula(formula, model@formula)
+            mt <- terms(formula, data = data)
+            varNamesRHS <- all.vars(formula[[3L]])
+            prednames <- varNamesRHS[varNamesRHS %in% names(data)]
+            model@x <- as.matrix(data[prednames])
+            response <- all.vars(update(formula, . ~ 1))
+            model@y <- as.matrix(data[response])
+            model
+          })
+
+setMethod("FLXmstep", signature(model = "FLXMRnlm"),
+          function(model, weights, components,...) {
+            sapply(seq_len(ncol(weights)),
+                   function(k) {
+                     if(length(names(components[[k]]@parameters))==0)
+                       model@fit(model@formula, model@start[[k]], model@x, 
+                                 model@y, weights[,k])
+                     else
+                       model@fit(model@formula, 
+                                 as.list(components[[k]]@parameters$coef), 
+                                 model@x, model@y, weights[,k])
+                   })
+          })
+
+setMethod("FLXdeterminePostunscaled", signature(model = "FLXMRnlm"),
+          function(model, components, ...) {
+            sapply(components, function(x) x@logLik(model@x, model@y))
+          })
+
+nls.wfit <- function(formula, start, data = list())
+{
+  w <- data$w
+  fit <- nls(formula = formula, start = start, data = data, 
+             weights = as.vector(w))
+  startEnv <- new.env(hash = FALSE, parent = environment(formula))
+  for (i in names(start)) assign(i, coef(fit)[[i]], envir = startEnv)
+  fit$fitted.values <- eval(formula[[3L]], data, startEnv)
+  response <- all.vars(update(formula, . ~ 1))
+  fit$residuals <- as.vector(residuals(fit))
+  fit$df.residuals <- df.residual(fit)
+  fit$weights <- weights(fit)
+  fit$formula <- formula
+  fit$start <- coef(fit)
+  fit
+}
+
+gnm.wfit <- function(formula, start, data = list(), family = list())
+{
+  w <- data$w
+  fit <- gnm(formula = formula, family = Gamma(link = "identity"),
+             data = data, start = unlist(start), weights = as.vector(w), 
+             verbose = FALSE, trace = FALSE, checkLinear = TRUE)
+  fit$df.residuals <- df.residual(fit)
+  fit$coefficients <- coef(fit)
+  fit$start <- as.list(unlist(coef(fit)))
+  fit$rank <- fit$rank[1]
+  fit
+}

man/FLXMRnlm.Rd

@@ -0,0 +1,49 @@
+\name{FLXMRnlm}
+\alias{FLXMRnlm}
+\alias{FLXnlm}
+\title{flexmixNL Interface for Generalized Nonlinear Models}
+\description{
+  This is the main driver for \code{\link{flexmixNL}} interfacing the 
+  family of Generalized Nonlinear Models.
+}
+\usage{
+FLXMRnlm(formula = . ~ ., 
+         family = c("gaussian", "Gamma"), 
+         start = list(), 
+         offset = NULL)
+}
+\arguments{
+  \item{formula}{A model \code{\link{formula}} decribing the nonlinear predictor 
+  and including variables and  regression parameters. }
+  \item{family}{A character string naming a family function 
+  (\code{family="gaussian"} or \code{family="Gamma"} available).}
+  \item{start}{A list of starting values for the regression parameters.}
+  \item{offset}{Specification of an \emph{a priori} known
+    component to be included in the nonlinear predictor during fitting.}
+}
+\details{
+Models for \code{\link{FLXMRnlm}} are specified by a model formula 
+(\code{\link{formula}} argument) relating the response to a 
+nonlinear predictor. 
+When fitting normal mixture models (\code{family="gaussian"}) the nonlinear 
+predictor is explicitely formulated (see also \code{\link{nls}}). 
+When fitting gamma mixture models (\code{family="Gamma"}) the nonlinear 
+predictor is specified by a symbolic description (see also \code{\link{gnm}}). 
+
+Variables not included in the data frame (see also \code{\link{flexmix}}) 
+are identified as the regression parameters. Starting values are required for 
+every regression parameter. 
+
+See \code{\link{flexmixNL}} for examples.
+}
+\value{Returns an object of class \code{FLXMRnlm}.}
+
+\author{Sanela Omerovic}
+
+
+\seealso{\code{\link{flexmixNL}}, \code{\link{formula}}, 
+\code{\link{gnm}}, \code{\link{nls}}}
+
+\keyword{regression}
+\keyword{nonlinear}
+\keyword{models}

man/GReg.Rd

@@ -0,0 +1,31 @@
+\name{GReg}
+\alias{GReg}
+\title{Artificial Example for Gamma Regression}
+\description{
+  A simple artificial regression example containing 200 data points  
+  with two latent classes. The data set includes one independent variable 
+  (uniform on \eqn{[0,10]}) and one dependent variable with gamma distribution.
+}
+
+\usage{data("GReg")}
+
+\format{
+  This data frame contains the following columns:
+  \describe{
+    \item{x}{
+      a numeric vector giving the independent variable.
+    }
+    \item{yg}{
+      a numeric vector giving the dependent variable with gamma distribution.
+    }
+    \item{class}{
+      a numeric vector indicating the labeling of the data points to two 
+      distinct classes.
+    }
+  }
+}
+\examples{
+data("GReg", package = "flexmixNL")
+plot(yg ~ x, col = class, data = GReg)
+}
+\keyword{datasets}

man/NReg.Rd

@@ -0,0 +1,32 @@
+\name{NReg}
+\alias{NReg}
+\title{Artificial Example for Normal Regression}
+\description{
+  A simple artificial regression example containing 200 data points  
+  with two latent classes. The data set includes one independent variable 
+  (uniform on \eqn{[0,10]}) and one dependent variable with normal 
+  distribution.
+}
+
+\usage{data("NReg")}
+
+\format{
+  This data frame contains the following columns:
+  \describe{
+    \item{x}{
+      a numeric vector giving the independent variable.
+    }
+    \item{yn}{
+      a numeric vector giving the dependent variable with normal distribution.
+    }
+    \item{class}{
+      a numeric vector indicating the labeling of the data points to distinct 
+      classes.
+    }
+  }
+}
+\examples{
+data("NReg", package = "flexmixNL")
+plot(yn ~ x, col = class, data = NReg)
+}
+\keyword{datasets}

man/flexmixNL-internal.Rd

@@ -0,0 +1,12 @@
+\name{flexmixNL-internal}
+\alias{FLXgetModelmatrix,FLXMRnlm-method}
+\alias{FLXdeterminePostunscaled,FLXMRnlm-method}
+\alias{FLXMRnlm-class}
+\alias{FLXmstep,FLXMRnlm-method}       
+\alias{gnm.wfit}
+\alias{nls.wfit}
+
+\title{Internal flexmixNL Functions}
+\description{Internal \code{\link{flexmixNL}} functions, methods and classes.}
+\details{These are not to be called by the user.}
+\keyword{internal}

man/flexmixNL-package.Rd

@@ -0,0 +1,60 @@
+\name{flexmixNL-package}
+\alias{flexmixNL-package}
+\alias{flexmixNL}
+\docType{package}
+\title{Mixtures of Generalized Nonlinear Models}
+\description{Extension of package \code{flexmix} for fitting mixtures of 
+Generalized Nonlinear Models.}
+\details{The package \code{flexmixNL} implements an extension for the package 
+\code{\link{flexmix}} for fitting mixtures of Generalized Nonlinear Models 
+(GNMs). The package provides a specified M-step for the EM-algorithm within the 
+FlexMix framework (see also \code{\link{flexmix}}) for fitting 
+GNMs for the normal and gamma distribution. 
+The mixture model is specified by the function \code{\link{FLXMRnlm}}.
+}
+\author{Sanela Omerovic}
+
+
+\keyword{cluster}
+\keyword{regression}
+\keyword{nonlinear}
+\seealso{
+See also \code{\link{flexmix}} for finite mixtures of regression models and 
+\code{\link{gnm}} for the fitting of Generalized Nonlinear Models (GNMs) for 
+further information.}
+
+\examples{
+# example 1.
+data("NReg", package = "flexmixNL")
+# mixture of two nonlinear regression models (normal distribution).
+start1 <- list(a = 170, b = 5)
+start2 <- list(a = 130, b = 5)
+model <- flexmix(yn ~ x, k = 2, data = NReg,
+                     model = list(FLXMRnlm(formula = yn ~ a*x / (b+x),
+                                           family = "gaussian", 
+                                           start = list(start1, start2))))
+# final cluster assignments.                                           
+plot(yn ~ x, col = clusters(model), data = NReg)
+
+# example 2.
+data("GReg", package = "flexmixNL")
+# mixture of two nonlinear regression models (gamma distribution).
+exp.1 = function(x,predictors){
+  list(predictors = list(a = 1, b = 1),
+       variables = list(substitute(x)),
+       term = function(predictors, variables){
+         sprintf("exp( \%s + \%s * \%s)", 
+         predictors[1], predictors[2], variables)
+       })
+}
+class(exp.1) = "nonlin"
+
+start1 <- list(a = -0.4, b = 0.3)
+start2 <- list(a = -0.1, b = 0.4)
+model2 <- flexmix(yg ~ x, k = 2, data = GReg,
+                      model = list(FLXMRnlm(formula = yg ~ -1 + exp.1(x),
+                                            family = "Gamma", 
+                                            start = list(start1, start2))))
+# final cluster assignments.  
+plot(yg ~ x, col = clusters(model2), data = GReg)
+}