R/statistics-models-menu.R

In Rcmdr: R Commander

# Statistics Menu dialogs

# last modified 2023-08-07 by J. Fox

    # Models menu

linearRegressionModel <- function () {
  defaults <- list(initial.x = NULL, initial.y = NULL, 
                   initial.subset = gettextRcmdr("<all valid cases>"),
                   initial.delete.cases=gettextRcmdr("<use all valid cases>"))
  dialog.values <- getDialog("linearRegressionModel", defaults)
  initializeDialog(title = gettextRcmdr("Linear Regression"))
  variablesFrame <- tkframe(top)
  .numeric <- Numeric()
  xBox <- variableListBox(variablesFrame, .numeric, selectmode = "multiple", 
                          title = gettextRcmdr("Explanatory variables (pick one or more)"), 
                          initialSelection = varPosn (dialog.values$initial.x, "numeric"))
  yBox <- variableListBox(variablesFrame, .numeric, title = gettextRcmdr("Response variable (pick one)"), 
                          initialSelection = varPosn (dialog.values$initial.y, "numeric"))
  UpdateModelNumber()
  modelName <- tclVar(paste("RegModel.", getRcmdr("modelNumber"), 
                            sep = ""))
  modelFrame <- tkframe(top)
  model <- ttkentry(modelFrame, width = "20", textvariable = modelName)
  subsetBox(subset.expression = dialog.values$initial.subset)
  removeVariable <- tclVar(dialog.values$initial.delete.cases)
  removeFrame <- tkframe(variablesFrame)
  removeEntry <- ttkentry(removeFrame, width="60", textvariable=removeVariable)
  removeScroll <- ttkscrollbar(removeFrame, orient="horizontal",
                               command=function(...) tkxview(removeEntry, ...))
  tkconfigure(removeEntry, xscrollcommand=function(...) tkset(removeScroll, ...))
  onOK <- function() {
    x <- getSelection(xBox)
    y <- getSelection(yBox)
    closeDialog()
    if (0 == length(y)) {
      UpdateModelNumber(-1)
      errorCondition(recall = linearRegressionModel, message = gettextRcmdr("You must select a response variable."))
      return()
    }
    if (0 == length(x)) {
      UpdateModelNumber(-1)
      errorCondition(recall = linearRegressionModel, message = gettextRcmdr("No explanatory variables selected."))
      return()
    }
    if (is.element(y, x)) {
      UpdateModelNumber(-1)
      errorCondition(recall = linearRegressionModel, message = gettextRcmdr("Response and explanatory variables must be different."))
      return()
    }
    remove <- trim.blanks(tclvalue(removeVariable))
    remove.cases <- if (remove == gettextRcmdr("<use all valid cases>") || remove == ""){
      "" 
    } else {
      removeRows <- getCases(remove, remove=TRUE)
      paste(", subset =", removeRows)
    }
    if (remove.cases != "" && inherits(removeRows, "cases-error")){
      errorCondition(recall = linearRegressionModel,
                     message = removeRows,
                     model=TRUE)
      return()
    }
    subset.save <- subset <- tclvalue(subsetVariable)
    if (trim.blanks(subset) == gettextRcmdr("<all valid cases>") || 
        trim.blanks(subset) == "") {
      subset <- ""
    }
    else {
      subset <- paste(", subset=", subset, sep = "")
    }
    if (subset != "" && remove.cases != ""){
      UpdateModelNumber(-1)
      errorCondition(recall = linearRegressionModel, 
                     message = gettextRcmdr("You cannot specify both case removal and subset cases"))
      return()
    }
    modelValue <- trim.blanks(tclvalue(modelName))
    if (!is.valid.name(modelValue)) {
      UpdateModelNumber(-1)
      errorCondition(recall = linearRegressionModel, message = sprintf(gettextRcmdr("\"%s\" is not a valid name."), 
                                                                       modelValue))
      return()
    }
    if (is.element(modelValue, listLinearModels())) {
      if ("no" == tclvalue(checkReplace(modelValue, type = gettextRcmdr("Model")))) {
        UpdateModelNumber(-1)
          if (getRcmdr("onApplyCalled")){
              putRcmdr("onApplyCalled", FALSE)
              return()
          }
        linearRegressionModel()
        return()
      }
    }
    command <- paste("lm(", y, "~", paste(x, collapse = "+"), 
                     ", data=", ActiveDataSet(), subset, remove.cases, ")", sep = "")
    doItAndPrint(paste(modelValue, " <- ", command, sep = ""))
    doItAndPrint(paste("summary(", modelValue, ")", sep = ""))
    activeModel(modelValue)
    if (subset != "" || remove.cases != "") putRcmdr("modelWithSubset", TRUE) else putRcmdr("modelWithSubset", FALSE)
    initial.delete.cases <- if (remove.cases == "") gettextRcmdr("<use all valid cases>") else remove 
    putDialog ("linearRegressionModel", list (initial.x = x, initial.y = y, 
                                              initial.subset = if (subset == "") gettextRcmdr("<all valid cases>") else subset.save,
                                              initial.delete.cases = initial.delete.cases))
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject = "lm", model = TRUE, reset = "linearRegressionModel", apply = "linearRegressionModel")
  tkgrid(labelRcmdr(modelFrame, text = gettextRcmdr("Enter name for model:")), 
         model, sticky = "w")
  tkgrid(modelFrame, sticky = "w")
  tkgrid(getFrame(yBox), labelRcmdr(variablesFrame, text = "    "), 
         getFrame(xBox), sticky = "nw")
  tkgrid(variablesFrame, sticky = "w")
  tkgrid(labelRcmdr(removeFrame, text=" "))
  tkgrid(labelRcmdr(removeFrame, text=gettextRcmdr("Indices or names of row(s) to remove"),
                    foreground=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
  tkgrid(removeEntry, sticky="w")
  tkgrid(removeScroll, sticky="ew")
  if (getRcmdr("model.case.deletion")) tkgrid(removeFrame, sticky="nw", columnspan=3)
  tkgrid(subsetFrame, sticky = "w")
  tkgrid(buttonsFrame, stick = "w")
  tkgrid.configure(helpButton, sticky = "e")
  dialogSuffix()
}

linearModel <- function(){
  initializeDialog(title=gettextRcmdr("Linear Model"))
  defaults <- list(initial.weight = gettextRcmdr("<no variable selected>"),
                   initial.delete.cases=gettextRcmdr("<use all valid cases>"))
  dialog.values <- getDialog("linearModel", defaults)
  .activeModel <- ActiveModel()
  currentModel <- if (!is.null(.activeModel))
    class(get(.activeModel, envir=.GlobalEnv))[1] == "lm"
  else FALSE
  if (currentModel) {
    currentFields <- formulaFields(get(.activeModel, envir=.GlobalEnv))
    if (currentFields$data != ActiveDataSet()) currentModel <- FALSE
  }
  if (isTRUE(getRcmdr("reset.model"))) {
    currentModel <- FALSE
    putRcmdr("reset.model", FALSE)
  }
  UpdateModelNumber()
  modelName <- tclVar(paste("LinearModel.", getRcmdr("modelNumber"), sep=""))
  modelFrame <- tkframe(top)
  model <- ttkentry(modelFrame, width="20", textvariable=modelName)
  removeVariable <- tclVar(dialog.values$initial.delete.cases)
  removeFrame <- tkframe(top)
  removeEntry <- ttkentry(removeFrame, width="60", textvariable=removeVariable)
  removeScroll <- ttkscrollbar(removeFrame, orient="horizontal",
                               command=function(...) tkxview(removeEntry, ...))
  tkconfigure(removeEntry, xscrollcommand=function(...) tkset(removeScroll, ...))
  onOK <- function(){
    closeDialog()
    modelValue <- trim.blanks(tclvalue(modelName))
    if (!is.valid.name(modelValue)){
      errorCondition(recall=linearModel, message=sprintf(gettextRcmdr('"%s" is not a valid name.'), modelValue), model=TRUE)
      return()
    }
    subset <- tclvalue(subsetVariable)
    if (trim.blanks(subset) == gettextRcmdr("<all valid cases>") || trim.blanks(subset) == ""){
      subset <- ""
    }
    # else{
    #   subset <- paste(", subset=", subset, sep="")
    # }
    weight.var <- getSelection(weightComboBox)
    weights <- if (weight.var == gettextRcmdr("<no variable selected>")) ""
#    else paste(", weights=", weight.var, sep="")
    else weight.var
    check.empty <- gsub(" ", "", tclvalue(lhsVariable))
    if ("" == check.empty) {
      errorCondition(recall=linearModel, message=gettextRcmdr("Left-hand side of model empty."), model=TRUE)
      return()
    }
    check.empty <- gsub(" ", "", tclvalue(rhsVariable))
    if ("" == check.empty) {
      errorCondition(recall=linearModel, message=gettextRcmdr("Right-hand side of model empty."), model=TRUE)
      return()
    }
    if (is.element(modelValue, listLinearModels())) {
      if ("no" == tclvalue(checkReplace(modelValue, type=gettextRcmdr("Model")))){
        UpdateModelNumber(-1)
          if (getRcmdr("onApplyCalled")){
              putRcmdr("onApplyCalled", FALSE)
              return()
          }
        linearModel()
        return()
      }
    }
    remove <- trim.blanks(tclvalue(removeVariable))
    remove.cases <- if (remove == gettextRcmdr("<use all valid cases>") || remove == ""){
      "" 
    } else {
#      removeRows <- getCases(remove, remove=TRUE)
#      paste(", subset =", removeRows)
        getCases(remove, remove=TRUE)
    }
#    if (remove.cases != "" && inherits(removeRows, "cases-error")){
    if (remove.cases != "" && inherits(remove.cases, "cases-error")){
      errorCondition(recall = linearModel,
                     message = removeRows,
                     model=TRUE)
      return()
    }
    if (subset != "" && remove.cases != ""){
      errorCondition(recall = linearModel, 
                     message = gettextRcmdr("You cannot specify both case removal and subset cases"), 
                     model=TRUE)
      return()
    }
    formula <- paste(tclvalue(lhsVariable), tclvalue(rhsVariable), sep=" ~ ")
    # command <- paste("lm(", formula,
    #                  ", data=", ActiveDataSet(), subset, weights, remove.cases, ")", sep="")
    # doItAndPrint(paste(modelValue, " <- ", command, sep = ""))
    command <- Command("lm", formula, data=ActiveDataSet(), subset=subset, weights=weights,
                       subset=remove.cases, to=modelValue)
    doItAndPrint(command)
    doItAndPrint(paste("summary(", modelValue, ")", sep=""))
    activeModel(modelValue)
    if (subset != "" || remove.cases != "") putRcmdr("modelWithSubset", TRUE) else putRcmdr("modelWithSubset", FALSE)
    initial.delete.cases <- gettextRcmdr("<use all valid cases>")
    putDialog("linearModel", list(initial.weight = weight.var, 
                                  initial.delete.cases = initial.delete.cases))
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject="linearModel", model=TRUE, reset="resetLinearModel", apply="linearModel")
  tkgrid(labelRcmdr(modelFrame, text=gettextRcmdr("Enter name for model:")), model, sticky="w")
  tkgrid(modelFrame, sticky="w")
  modelFormula()
  subsetWeightFrame <- tkframe(top)
  subsetBox(window=subsetWeightFrame, model=TRUE)
  weightComboBox <- variableComboBox(subsetWeightFrame, variableList=Numeric(), 
                                     initialSelection=dialog.values$initial.weight,
                                     title=gettextRcmdr("Weights"))
  tkgrid(getFrame(xBox), sticky="w")
  tkgrid(outerOperatorsFrame, sticky="w")
  tkgrid(formulaFrame, sticky="w")
  tkgrid(labelRcmdr(removeFrame, text=" "))
  tkgrid(labelRcmdr(removeFrame, text=gettextRcmdr("Indices or names of row(s) to remove"),
                    foreground=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
  tkgrid(removeEntry, sticky="w")
  tkgrid(removeScroll, sticky="ew")
  if (getRcmdr("model.case.deletion")) tkgrid(removeFrame, sticky="nw", columnspan=3)
  tkgrid(subsetFrame, tklabel(subsetWeightFrame, text="   "),
         getFrame(weightComboBox), sticky="nw")
  tkgrid(subsetWeightFrame, sticky="w")
  tkgrid(buttonsFrame, sticky="w")
  dialogSuffix(focus=lhsEntry, preventDoubleClick=TRUE)
}

resetLinearModel <- function(){
	putRcmdr("reset.model", TRUE)
	putDialog("linearModel", NULL)
	putDialog("linearModel", NULL, resettable=FALSE)
	linearModel()
}

generalizedLinearModel <- function(){
  families <- c("gaussian", "binomial", "poisson", "Gamma", "inverse.gaussian",
                "quasibinomial", "quasipoisson")
  links <- c("identity", "inverse", "log", "logit", "probit",
             "cloglog", "sqrt", "1/mu^2")
  availableLinks <- matrix(c(
    TRUE,  TRUE,  TRUE,  FALSE, FALSE, FALSE, FALSE, FALSE,
    FALSE, FALSE, FALSE, TRUE,  TRUE,  TRUE,  FALSE, FALSE,
    TRUE,  FALSE, TRUE,  FALSE, FALSE, FALSE, TRUE,  FALSE,
    TRUE,  TRUE,  TRUE,  FALSE, FALSE, FALSE, FALSE, FALSE,
    TRUE,  TRUE,  TRUE,  FALSE, FALSE, FALSE, FALSE, TRUE,
    FALSE, FALSE, FALSE, TRUE,  TRUE,  TRUE,  FALSE, FALSE,
    TRUE,  FALSE, TRUE,  FALSE, FALSE, FALSE, TRUE,  FALSE),
    7, 8, byrow=TRUE)
  rownames(availableLinks) <- families
  colnames(availableLinks) <- links
  canonicalLinks <- c("identity", "logit", "log", "inverse", "1/mu^2", "logit", "log")
  names(canonicalLinks) <- families
  defaults <- list(initial.weight = gettextRcmdr("<no variable selected>"),
                   initial.delete.cases=gettextRcmdr("<use all valid cases>"))
  dialog.values <- getDialog("generalizedLinearModel", defaults)
  initializeDialog(title=gettextRcmdr("Generalized Linear Model"))
  .activeModel <- ActiveModel()
  currentModel <- if (!is.null(.activeModel))
    class(get(.activeModel, envir=.GlobalEnv))[1] == "glm"
  else FALSE
  if (currentModel) {
    currentFields <- formulaFields(get(.activeModel, envir=.GlobalEnv), glm=TRUE)
    if (currentFields$data != ActiveDataSet()) currentModel <- FALSE
  }
  if (isTRUE(getRcmdr("reset.model"))) {
    currentModel <- FALSE
    putRcmdr("reset.model", FALSE)
  }
  modelFormula()
  UpdateModelNumber()
  modelName <- tclVar(paste("GLM.", getRcmdr("modelNumber"), sep=""))
  modelFrame <- tkframe(top)
  model <- ttkentry(modelFrame, width="20", textvariable=modelName)
  linkFamilyFrame <- tkframe(top)
  familyFrame <- tkframe(linkFamilyFrame)
  max.height <- getRcmdr("variable.list.height")
  familyBox <- tklistbox(familyFrame, height=length(families), # height=min(max.height, length(families)), 
                         exportselection="FALSE",
                         selectmode="single", background="white")
  # familyScroll <- ttkscrollbar(familyFrame,
  #                              command=function(...) tkyview(familyBox, ...))
  # tkconfigure(familyBox, yscrollcommand=function(...) tkset(familyScroll, ...))
  for (fam in families) tkinsert(familyBox, "end", fam)
  linkFrame <- tkframe(linkFamilyFrame)
  linkBox <- tklistbox(linkFrame, height=max.height, exportselection="FALSE",
                       selectmode="single", background="white")
  subsetWeightFrame <- tkframe(top)
  subsetBox(window=subsetWeightFrame, model=TRUE)
  weightComboBox <- variableComboBox(subsetWeightFrame, variableList=Numeric(), 
                                     initialSelection=dialog.values$initial.weight,
                                     title=gettextRcmdr("Weights"))
  onFamilySelect <- function(){
    family <- families[as.numeric(tkcurselection(familyBox)) + 1]
    availLinks <- links[availableLinks[family,]]
    tkdelete(linkBox, "0", "end")
    for (lnk in availLinks) tkinsert(linkBox, "end", lnk)
    canLink <- canonicalLinks[family]
    tkconfigure(linkBox, height=length(availLinks))
    tkselection.set(linkBox, which(canLink == availLinks) - 1)
  }
  removeVariable <- tclVar(dialog.values$initial.delete.cases)
  removeFrame <- tkframe(top)
  removeEntry <- ttkentry(removeFrame, width="60", textvariable=removeVariable)
  removeScroll <- ttkscrollbar(removeFrame, orient="horizontal",
                               command=function(...) tkxview(removeEntry, ...))
  tkconfigure(removeEntry, xscrollcommand=function(...) tkset(removeScroll, ...))
  onOK <- function(){
    check.empty <- gsub(" ", "", tclvalue(lhsVariable))
    if ("" == check.empty) {
      errorCondition(recall=generalizedLinearModel, model=TRUE, message=gettextRcmdr("Left-hand side of model empty."))
      return()
    }
    check.empty <- gsub(" ", "", tclvalue(rhsVariable))
    if ("" == check.empty) {
      errorCondition(recall=generalizedLinearModel, model=TRUE, message=gettextRcmdr("Right-hand side of model empty."))
      return()
    }
    modelValue <- trim.blanks(tclvalue(modelName))
    if (!is.valid.name(modelValue)){
      errorCondition(recall=generalizedLinearModel, model=TRUE, message=sprintf(gettextRcmdr('"%s" is not a valid name.'), modelValue))
      return()
    }
    if (is.element(modelValue, listGeneralizedLinearModels())) {
      if ("no" == tclvalue(checkReplace(modelValue, type=gettextRcmdr("Model")))){
        UpdateModelNumber(-1)
        closeDialog()
        if (getRcmdr("onApplyCalled")){
            putRcmdr("onApplyCalled", FALSE)
            return()
        }
        generalizedLinearModel()
        return()
      }
    }
    formula <- paste(tclvalue(lhsVariable), tclvalue(rhsVariable), sep=" ~ ")
    family <- families[as.numeric(tkcurselection(familyBox)) + 1]
    availLinks <- links[availableLinks[family,]]
    link <- availLinks[as.numeric(tkcurselection(linkBox)) + 1]
    subset <- tclvalue(subsetVariable)
    closeDialog()
    if (trim.blanks(subset) == gettextRcmdr("<all valid cases>") || trim.blanks(subset) == ""){
      subset <- ""
    }
    else{
      subset <- paste(", subset=", subset, sep="")
    }
    weight.var <- getSelection(weightComboBox)
    weights <- if (weight.var == gettextRcmdr("<no variable selected>")) ""
    else paste(", weights=", weight.var, sep="")
    remove <- trim.blanks(tclvalue(removeVariable))
    remove.cases <- if (remove == gettextRcmdr("<use all valid cases>") || remove == ""){
      "" 
    } else {
      removeRows <- getCases(remove, remove=TRUE)
      paste(", subset =", removeRows)
    }
    if (remove.cases != "" && inherits(removeRows, "cases-error")){
      errorCondition(recall = generalizedLinearModel,
                     message = removeRows,
                     model=TRUE)
      return()
    }
    if (subset != "" && remove.cases != ""){
      errorCondition(recall = generalizedLinearModel, 
                     message = gettextRcmdr("You cannot specify both case removal and subset cases"), 
                     model=TRUE)
      return()
    }
    initial.delete.cases <- gettextRcmdr("<use all valid cases>")
    putDialog("generalizedLinearModel", list(initial.weight = weight.var, 
                                             initial.delete.cases = initial.delete.cases))
    
    command <- paste("glm(", formula, ", family=", family, "(", link, 
                     "), data=", ActiveDataSet(), subset, weights, remove.cases, ")", sep="")
    doItAndPrint(paste(modelValue, " <- ", command, sep = ""))
    doItAndPrint(paste("summary(", modelValue, ")", sep=""))
    activeModel(modelValue)
    if ((family == "binomial" || family =="quasibinomial") && link == "logit"){
      doItAndPrint(paste0("exp(coef(", modelValue,
                          '))  # Exponentiated coefficients ("odds ratios")'))
    }
    if ((family == "poisson" || family =="quasipoisson") && link == "log"){
      doItAndPrint(paste0("exp(coef(", modelValue,
                          '))  # Exponentiated coefficients'))
    }
    if (subset != "" || remove.cases != "") putRcmdr("modelWithSubset", TRUE) else putRcmdr("modelWithSubset", FALSE)
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject="generalizedLinearModel", model=TRUE, reset="resetGLM", apply="generalizedLinearModel")
  helpButton <- buttonRcmdr(buttonsFrame, text="Help", width="12", command=onHelp)
  tkgrid(labelRcmdr(modelFrame, text=gettextRcmdr("Enter name for model:")), model, sticky="w")
  tkgrid(modelFrame, sticky="w")
  tkgrid(getFrame(xBox), sticky="w")
  tkgrid(outerOperatorsFrame, sticky="w")
  tkgrid(formulaFrame, sticky="w")
  tkgrid(subsetFrame, tklabel(subsetWeightFrame, text="   "),
         getFrame(weightComboBox), sticky="nw")
  tkgrid(labelRcmdr(removeFrame, text=" "))
  tkgrid(labelRcmdr(removeFrame, text=gettextRcmdr("Indices or names of row(s) to remove"),
                    foreground=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
  tkgrid(removeEntry, sticky="w")
  tkgrid(removeScroll, sticky="ew")
  if (getRcmdr("model.case.deletion")) tkgrid(removeFrame, sticky="nw", columnspan=3)
  tkgrid(subsetWeightFrame, sticky="w")  
  tkgrid(labelRcmdr(linkFamilyFrame, text=gettextRcmdr("Family (double-click to select)"), fg=getRcmdr("title.color"), font="RcmdrTitleFont"),
         labelRcmdr(linkFamilyFrame, text="   "), labelRcmdr(linkFamilyFrame, text=gettextRcmdr("Link function"), fg=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
  #  tkgrid(familyBox, familyScroll, sticky="nw")
  tkgrid(familyBox, sticky="nw")
  tkgrid(linkBox, sticky="nw")
  tkgrid(familyFrame, labelRcmdr(linkFamilyFrame, text="   "), linkFrame, sticky="nw")
  tkgrid(linkFamilyFrame, sticky="w")
  tkgrid(buttonsFrame, sticky="w")
  #  tkgrid.configure(familyScroll, sticky="ns")
  fam <- if (currentModel) which(currentFields$family == families) - 1 else 1
  tkselection.set(familyBox, fam)
  availLinks <- links[availableLinks[fam + 1,]]
  for (lnk in availLinks) tkinsert(linkBox, "end", lnk)
  tkconfigure(linkBox, height=length(availLinks))
  lnk <- if (currentModel) which(currentFields$link == availLinks) - 1 else 0
  tkselection.set(linkBox, lnk)
  tkbind(familyBox, "<Double-ButtonPress-1>", onFamilySelect)
  dialogSuffix(focus=lhsEntry, preventDoubleClick=TRUE)
}

resetGLM <- function(){
	putRcmdr("reset.model", TRUE)
	putDialog("generalizedLinearModel", NULL)
	putDialog("generalizedLinearModel", NULL, resettable=FALSE)
	generalizedLinearModel()
}

ordinalRegressionModel <- function(){
  defaults <- list(initial.type="logistic",
                   initial.delete.cases=gettextRcmdr("<use all valid cases>"))
  dialog.values <- getDialog("ordinalRegressionModel", defaults)
  Library("MASS")
  initializeDialog(title=gettextRcmdr("Ordinal Regression Model"))
  .activeModel <- ActiveModel()
  .activeDataSet <- ActiveDataSet()
  currentModel <- if (!is.null(.activeModel))
    class(get(.activeModel, envir=.GlobalEnv))[1] == "polr"
  else FALSE
  if (currentModel) {
    currentFields <- formulaFields(get(.activeModel, envir=.GlobalEnv))
    if (currentFields$data != .activeDataSet) currentModel <- FALSE
  }
  if (isTRUE(getRcmdr("reset.model"))) {
    currentModel <- FALSE
    putRcmdr("reset.model", FALSE)
  }
  UpdateModelNumber()
  modelName <- tclVar(paste("OrdRegModel.", getRcmdr("modelNumber"), sep=""))
  modelFrame <- tkframe(top)
  model <- ttkentry(modelFrame, width="20", textvariable=modelName)
  radioButtons(name="modelType",
               buttons=c("logistic", "probit"), initialValue=dialog.values$initial.type,
               labels=gettextRcmdr(c("Proportional-odds logit", "Ordered probit")),
               title=gettextRcmdr("Type of Model"))
  removeVariable <- tclVar(dialog.values$initial.delete.cases)
  removeFrame <- tkframe(top)
  removeEntry <- ttkentry(removeFrame, width="60", textvariable=removeVariable)
  removeScroll <- ttkscrollbar(removeFrame, orient="horizontal",
                               command=function(...) tkxview(removeEntry, ...))
  tkconfigure(removeEntry, xscrollcommand=function(...) tkset(removeScroll, ...))
  onOK <- function(){
    modelValue <- trim.blanks(tclvalue(modelName))
    closeDialog()
    if (!is.valid.name(modelValue)){
      errorCondition(recall=ordinalRegressionModel, message=sprintf(gettextRcmdr('"%s" is not a valid name.'), modelValue), model=TRUE)
      return()
    }
    subset <- tclvalue(subsetVariable)
    if (trim.blanks(subset) == gettextRcmdr("<all valid cases>") || trim.blanks(subset) == ""){
      subset <- ""
    }
    else{
      subset <- paste(", subset=", subset, sep="")
    }
    check.empty <- gsub(" ", "", tclvalue(lhsVariable))
    if ("" == check.empty) {
      errorCondition(recall=ordinalRegressionModel, message=gettextRcmdr("Left-hand side of model empty."), model=TRUE)
      return()
    }
    check.empty <- gsub(" ", "", tclvalue(rhsVariable))
    if ("" == check.empty) {
      errorCondition(recall=ordinalRegressionModel, message=gettextRcmdr("Right-hand side of model empty."), model=TRUE)
      return()
    }
    if (!is.factor(eval(parse(text=tclvalue(lhsVariable)), envir=get(.activeDataSet, envir=.GlobalEnv)))){
      errorCondition(recall=ordinalRegressionModel, message=gettextRcmdr("Response variable must be a factor"))
      return()
    }
    if (is.element(modelValue, listProportionalOddsModels())) {
      if ("no" == tclvalue(checkReplace(modelValue, type=gettextRcmdr("Model")))){
        UpdateModelNumber(-1)
          if (getRcmdr("onApplyCalled")){
              putRcmdr("onApplyCalled", FALSE)
              return()
          }
        proportionalOddsModel()
        return()
      }
    }
    remove <- trim.blanks(tclvalue(removeVariable))
    remove.cases <- if (remove == gettextRcmdr("<use all valid cases>") || remove == ""){
      "" 
    } else {
      removeRows <- getCases(remove, remove=TRUE)
      paste(", subset =", removeRows)
    }
    if (remove.cases != "" && inherits(removeRows, "cases-error")){
      errorCondition(recall = ordinalRegressionModel,
                     message = removeRows,
                     model=TRUE)
      return()
    }
    if (subset != "" && remove.cases != ""){
      errorCondition(recall = ordinalRegressionModel, 
                     message = gettextRcmdr("You cannot specify both case removal and subset cases"), 
                     model=TRUE)
      return()
    }
    initial.delete.cases <- gettextRcmdr("<use all valid cases>")
    putDialog("ordinalRegressionModel", list(initial.type = tclvalue(modelTypeVariable),
                                             initial.delete.cases = initial.delete.cases))
    formula <- paste(tclvalue(lhsVariable), tclvalue(rhsVariable), sep=" ~ ")
    command <- paste("polr(", formula, ', method="', tclvalue(modelTypeVariable),
                     '", data=', .activeDataSet, subset, remove.cases, ", Hess=TRUE)", sep="")
    doItAndPrint(paste(modelValue, " <- ", command, sep = ""))
    doItAndPrint(paste("summary(", modelValue, ")", sep=""))
    activeModel(modelValue)
    if (subset != "" || remove.cases != "") putRcmdr("modelWithSubset", TRUE) else putRcmdr("modelWithSubset", FALSE)
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject="polr", model=TRUE, reset = "resetPOLR", apply = "ordinalRegressionModel")
  tkgrid(labelRcmdr(modelFrame, text=gettextRcmdr("Enter name for model:")), model, sticky="w")
  tkgrid(modelFrame, sticky="w")
  modelFormula()
  subsetBox(model=TRUE)
  tkgrid(getFrame(xBox), sticky="w")
  tkgrid(outerOperatorsFrame, sticky="w")
  tkgrid(formulaFrame, sticky="w")
  tkgrid(labelRcmdr(removeFrame, text=" "))
  tkgrid(labelRcmdr(removeFrame, text=gettextRcmdr("Indices or names of row(s) to remove"),
                    foreground=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
  tkgrid(removeEntry, sticky="w")
  tkgrid(removeScroll, sticky="ew")
  if (getRcmdr("model.case.deletion")) tkgrid(removeFrame, sticky="nw", columnspan=3)
  tkgrid(subsetFrame, sticky="w")
  tkgrid(modelTypeFrame, sticky="w")
  tkgrid(buttonsFrame, sticky="w")
  dialogSuffix(focus=lhsEntry, preventDoubleClick=TRUE)
}

resetPOLR <- function(){
	putRcmdr("reset.model", TRUE)
	putDialog("ordinalRegressionModel", NULL)
	ordinalRegressionModel()
}

multinomialLogitModel <- function(){
  Library("nnet")
  dialog.values <- getDialog("multinomialLogitModel", 
                             list(initial.delete.cases=gettextRcmdr("<use all valid cases>")))
  initializeDialog(title=gettextRcmdr("Multinomial Logit Model"))
  .activeModel <- ActiveModel()
  .activeDataSet <- ActiveDataSet()
  currentModel <- if (!is.null(.activeModel))
    class(get(.activeModel, envir=.GlobalEnv))[1] == "multinom"
  else FALSE
  if (currentModel) {
    currentFields <- formulaFields(get(.activeModel, envir=.GlobalEnv))
    if (currentFields$data != .activeDataSet) currentModel <- FALSE
  }
  if (isTRUE(getRcmdr("reset.model"))) {
    currentModel <- FALSE
    putRcmdr("reset.model", FALSE)
  }
  UpdateModelNumber()
  modelName <- tclVar(paste("MLM.", getRcmdr("modelNumber"), sep=""))
  modelFrame <- tkframe(top)
  model <- ttkentry(modelFrame, width="20", textvariable=modelName)
  removeVariable <- tclVar(dialog.values$initial.delete.cases)
  removeFrame <- tkframe(top)
  removeEntry <- ttkentry(removeFrame, width="60", textvariable=removeVariable)
  removeScroll <- ttkscrollbar(removeFrame, orient="horizontal",
                               command=function(...) tkxview(removeEntry, ...))
  tkconfigure(removeEntry, xscrollcommand=function(...) tkset(removeScroll, ...))
  onOK <- function(){
    modelValue <- trim.blanks(tclvalue(modelName))
    closeDialog()
    if (!is.valid.name(modelValue)){
      errorCondition(recall=multinomialLogitModel, message=sprintf(gettextRcmdr('"%s" is not a valid name.'), modelValue), model=TRUE)
      return()
    }
    subset <- tclvalue(subsetVariable)
    if (trim.blanks(subset) == gettextRcmdr("<all valid cases>") || trim.blanks(subset) == ""){
      subset <- ""
    }
    else{
      subset <- paste(", subset=", subset, sep="")
    }
    check.empty <- gsub(" ", "", tclvalue(lhsVariable))
    if ("" == check.empty) {
      errorCondition(recall=multinomialLogitModel, message=gettextRcmdr("Left-hand side of model empty."), model=TRUE)
      return()
    }
    check.empty <- gsub(" ", "", tclvalue(rhsVariable))
    if ("" == check.empty) {
      errorCondition(recall=multinomialLogitModel, message=gettextRcmdr("Right-hand side of model empty."), model=TRUE)
      return()
    }
    if (!is.factor(eval(parse(text=tclvalue(lhsVariable)), envir=get(.activeDataSet, envir=.GlobalEnv)))){
      errorCondition(recall=multinomialLogitModel, message=gettextRcmdr("Response variable must be a factor"))
      return()
    }
    if (is.element(modelValue, listMultinomialLogitModels())) {
      if ("no" == tclvalue(checkReplace(modelValue, type=gettextRcmdr("Model")))){
        UpdateModelNumber(-1)
          if (getRcmdr("onApplyCalled")){
              putRcmdr("onApplyCalled", FALSE)
              return()
          }
        multinomialLogitModel()
        return()
      }
    }
    remove <- trim.blanks(tclvalue(removeVariable))
    remove.cases <- if (remove == gettextRcmdr("<use all valid cases>") || remove == ""){
      "" 
    } else {
      removeRows <- getCases(remove, remove=TRUE)
      paste(", subset =", removeRows)
    }
    if (remove.cases != "" && inherits(removeRows, "cases-error")){
      errorCondition(recall = multinomialLogitModel,
                     message = removeRows,
                     model=TRUE)
      return()
    }
    if (subset != "" && remove.cases != ""){
      errorCondition(recall = multinomialLogitModel, 
                     message = gettextRcmdr("You cannot specify both case removal and subset cases"), 
                     model=TRUE)
      return()
    }
    initial.delete.cases <- gettextRcmdr("<use all valid cases>")
    putDialog("multinomialLogitModel", list(initial.delete.cases = initial.delete.cases))
    formula <- paste(tclvalue(lhsVariable), tclvalue(rhsVariable), sep=" ~ ")
    command <- paste("multinom(", formula,
                     ", data=", .activeDataSet, subset, remove.cases, ", trace=FALSE)", sep="")
    doItAndPrint(paste(modelValue, " <- ", command, sep = ""))
    doItAndPrint(paste("summary(", modelValue, ", cor=FALSE, Wald=TRUE)", sep=""))
    activeModel(modelValue)
    if (subset != "" || remove.cases != "") putRcmdr("modelWithSubset", TRUE) else putRcmdr("modelWithSubset", FALSE)
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject="multinom", model=TRUE, reset="resetMNL", apply="multinomialLogitModel")
  tkgrid(labelRcmdr(modelFrame, text=gettextRcmdr("Enter name for model:")), model, sticky="w")
  tkgrid(modelFrame, sticky="w")
  modelFormula()
  subsetBox(model=TRUE)
  tkgrid(getFrame(xBox), sticky="w")
  tkgrid(outerOperatorsFrame, sticky="w")
  tkgrid(formulaFrame, sticky="w")
  tkgrid(labelRcmdr(removeFrame, text=" "))
  tkgrid(labelRcmdr(removeFrame, text=gettextRcmdr("Indices or names of row(s) to remove"),
                    foreground=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
  tkgrid(removeEntry, sticky="w")
  tkgrid(removeScroll, sticky="ew")
  if (getRcmdr("model.case.deletion")) tkgrid(removeFrame, sticky="nw", columnspan=3)
  tkgrid(subsetFrame, sticky="w")
  tkgrid(buttonsFrame, sticky="w")
  dialogSuffix(focus=lhsEntry, preventDoubleClick=TRUE)
}

resetMNL <- function(){
	putRcmdr("reset.model", TRUE)
	multinomialLogitModel()
}

formulaFields <- function(model, hasLhs=TRUE, glm=FALSE){
	formula <- as.character(formula(model)) # as.character(model$call$formula)
	if (hasLhs){
		lhs <- formula[2]
		rhs <- formula[3]
	} else {
		lhs <- NULL
		rhs <- formula[2]
	}
	data <- as.character(getCall(model)$data) # as.character(model$call$data)
	which.subset <- which("subset" == names(getCall(model))) # which("subset" == names(model$call))
	subset <- if (0 == length(which.subset)) ""
		else as.character(getCall(model))[[which.subset]] # as.character(model$call)[[which.subset]]
	if (glm) {
		fam <- as.character(getCall(model)$family) # as.character(model$call$family)
		family <- fam[1]
		link <- fam[2]
	}
	else {
		family <- NULL
		link <- NULL
	}
	list(lhs=lhs, rhs=rhs, data=data, subset=subset, family=family, link=link)
}

linearMixedModel <- function(){
  Library("lme4")
  initializeDialog(title=gettextRcmdr("Linear Mixed Model"))
  defaults <- list(initial.weight = gettextRcmdr("<no variable selected>"), initial.estimType="reml",
                   initial.delete.cases=gettextRcmdr("<use all valid cases>"))
  dialog.values <- getDialog("linearMixedModel", defaults)
  .activeModel <- ActiveModel()
  currentModel <- if (!is.null(.activeModel))
    class(get(.activeModel, envir=.GlobalEnv))[1] == "lmerMod"
  else FALSE
  if (currentModel) {
    currentFields <- formulaFields(get(.activeModel, envir=.GlobalEnv))
    if (currentFields$data != ActiveDataSet()) currentModel <- FALSE
  }
  if (isTRUE(getRcmdr("reset.model"))) {
    currentModel <- FALSE
    putRcmdr("reset.model", FALSE)
  }
  UpdateModelNumber()
  modelName <- tclVar(paste("LMM.", getRcmdr("modelNumber"), sep=""))
  modelFrame <- tkframe(top)
  model <- ttkentry(modelFrame, width="20", textvariable=modelName)
  radioButtons(name="estimType",
               buttons=c("reml", "ml"), initialValue=dialog.values$initial.estimType,
               labels=gettextRcmdr(c("Restricted maximum likelihood (REML)", "Maximum likelihood (ML)")),
               title=gettextRcmdr("Estimation Criterion"))
  removeVariable <- tclVar(dialog.values$initial.delete.cases)
  removeFrame <- tkframe(top)
  removeEntry <- ttkentry(removeFrame, width="60", textvariable=removeVariable)
  removeScroll <- ttkscrollbar(removeFrame, orient="horizontal",
                               command=function(...) tkxview(removeEntry, ...))
  tkconfigure(removeEntry, xscrollcommand=function(...) tkset(removeScroll, ...))
  onOK <- function(){
    modelValue <- trim.blanks(tclvalue(modelName))
    closeDialog()
    if (!is.valid.name(modelValue)){
      errorCondition(recall=linearMixedModel, message=sprintf(gettextRcmdr('"%s" is not a valid name.'), modelValue), model=TRUE)
      return()
    }
    subset <- tclvalue(subsetVariable)
    if (trim.blanks(subset) == gettextRcmdr("<all valid cases>") || trim.blanks(subset) == ""){
      subset <- ""
    }
    else{
      subset <- paste(", subset=", subset, sep="")
    }
    weight.var <- getSelection(weightComboBox)
    estimType <- tclvalue(estimTypeVariable)
    weights <- if (weight.var == gettextRcmdr("<no variable selected>")) ""
    else paste(", weights=", weight.var, sep="")
    check.empty <- gsub(" ", "", tclvalue(lhsVariable))
    if ("" == check.empty) {
      errorCondition(recall=linearMixedModel, message=gettextRcmdr("Left-hand side of model empty."), model=TRUE)
      return()
    }
    check.empty <- gsub(" ", "", tclvalue(rhsVariable))
    if ("" == check.empty) {
      errorCondition(recall=linearMixedModel, message=gettextRcmdr("Right-hand side of model empty."), model=TRUE)
      return()
    }
    if (!grepl("\\(.*\\|.*\\)", tclvalue(rhsVariable))) {
      errorCondition(recall=linearMixedModel, message=gettextRcmdr("There are no random effects in the model."), model=TRUE)
      return()
    }
    if (is.element(modelValue, listLMMs())) {
      if ("no" == tclvalue(checkReplace(modelValue, type=gettextRcmdr("Model")))){
        UpdateModelNumber(-1)
          if (getRcmdr("onApplyCalled")){
              putRcmdr("onApplyCalled", FALSE)
              return()
          }
        linearMixedModel()
        return()
      }
    }
    remove <- trim.blanks(tclvalue(removeVariable))
    remove.cases <- if (remove == gettextRcmdr("<use all valid cases>") || remove == ""){
      "" 
    } else {
      removeRows <- getCases(remove, remove=TRUE)
      paste(", subset =", removeRows)
    }
    if (remove.cases != "" && inherits(removeRows, "cases-error")){
      errorCondition(recall = linearMixedModel,
                     message = removeRows,
                     model=TRUE)
      return()
    }
    if (subset != "" && remove.cases != ""){
      errorCondition(recall = linearMixedModel, 
                     message = gettextRcmdr("You cannot specify both case removal and subset cases"), 
                     model=TRUE)
      return()
    }
    initial.delete.cases <- gettextRcmdr("<use all valid cases>")
    putDialog("linearMixedModel", list(initial.weight = weight.var, initial.estimType=estimType,
                                       initial.delete.cases = initial.delete.cases))
    
    formula <- paste(tclvalue(lhsVariable), tclvalue(rhsVariable), sep=" ~ ")
    reml <- as.character(estimType == "reml")
    command <- paste("lmer(", formula,
                     ", data=", ActiveDataSet(), subset, remove.cases, weights, ", REML=", reml, ")", sep="")
    doItAndPrint(paste(modelValue, " <- ", command, sep = ""))
    doItAndPrint(paste("summary(", modelValue, ")", sep=""))
    activeModel(modelValue)
    if (subset != "" || remove.cases != "") putRcmdr("modelWithSubset", TRUE) else putRcmdr("modelWithSubset", FALSE)
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject="lmer", model=TRUE, reset="resetLMM", apply="linearMixedModel")
  tkgrid(labelRcmdr(modelFrame, text=gettextRcmdr("Enter name for model:")), model, sticky="w")
  tkgrid(modelFrame, sticky="w")
  modelFormula(showBar=TRUE)
  subsetWeightFrame <- tkframe(top)
  subsetBox(window=subsetWeightFrame, model=TRUE)
  weightComboBox <- variableComboBox(subsetWeightFrame, variableList=Numeric(), 
                                     initialSelection=dialog.values$initial.weight,
                                     title=gettextRcmdr("Weights"))
  tkgrid(getFrame(xBox), sticky="w")
  tkgrid(outerOperatorsFrame, sticky="w")
  tkgrid(formulaFrame, sticky="w")
  tkgrid(subsetFrame, tklabel(subsetWeightFrame, text="   "),
         getFrame(weightComboBox), sticky="nw")
  tkgrid(labelRcmdr(removeFrame, text=" "))
  tkgrid(labelRcmdr(removeFrame, text=gettextRcmdr("Indices or names of row(s) to remove"),
                    foreground=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
  tkgrid(removeEntry, sticky="w")
  tkgrid(removeScroll, sticky="ew")
  if (getRcmdr("model.case.deletion")) tkgrid(removeFrame, sticky="nw", columnspan=3)
  tkgrid(subsetWeightFrame, sticky="w")	
  tkgrid(estimTypeFrame, sticky="w")
  tkgrid(buttonsFrame, sticky="w")
  dialogSuffix(focus=lhsEntry, preventDoubleClick=TRUE)
}

resetLMM <- function(){
  putRcmdr("reset.model", TRUE)
  putDialog("linearMixedModel", NULL)
  putDialog("linearMixedModel", NULL, resettable=FALSE)
  linearMixedModel()
}

generalizedLinearMixedModel <- function(){
  families <- c("gaussian", "binomial", "poisson", "Gamma", "inverse.gaussian",
                "quasibinomial", "quasipoisson")
  links <- c("identity", "inverse", "log", "logit", "probit",
             "cloglog", "sqrt", "1/mu^2")
  availableLinks <- matrix(c(
    TRUE,  TRUE,  TRUE,  FALSE, FALSE, FALSE, FALSE, FALSE,
    FALSE, FALSE, FALSE, TRUE,  TRUE,  TRUE,  FALSE, FALSE,
    TRUE,  FALSE, TRUE,  FALSE, FALSE, FALSE, TRUE,  FALSE,
    TRUE,  TRUE,  TRUE,  FALSE, FALSE, FALSE, FALSE, FALSE,
    TRUE,  TRUE,  TRUE,  FALSE, FALSE, FALSE, FALSE, TRUE,
    FALSE, FALSE, FALSE, TRUE,  TRUE,  TRUE,  FALSE, FALSE,
    TRUE,  FALSE, TRUE,  FALSE, FALSE, FALSE, TRUE,  FALSE),
    7, 8, byrow=TRUE)
  rownames(availableLinks) <- families
  colnames(availableLinks) <- links
  canonicalLinks <- c("identity", "logit", "log", "inverse", "1/mu^2", "logit", "log")
  names(canonicalLinks) <- families
  defaults <- list(initial.weight = gettextRcmdr("<no variable selected>"),
                   initial.delete.cases=gettextRcmdr("<use all valid cases>"))
  dialog.values <- getDialog("generalizedLinearMixedModel", defaults)
  initializeDialog(title=gettextRcmdr("Generalized Linear Mixed Model"))
  .activeModel <- ActiveModel()
  currentModel <- if (!is.null(.activeModel))
    class(get(.activeModel, envir=.GlobalEnv))[1] == "glmerMod"
  else FALSE
  if (currentModel) {
    currentFields <- formulaFields(get(.activeModel, envir=.GlobalEnv), glm=TRUE)
    if (currentFields$data != ActiveDataSet()) currentModel <- FALSE
  }
  if (isTRUE(getRcmdr("reset.model"))) {
    currentModel <- FALSE
    putRcmdr("reset.model", FALSE)
  }
  modelFormula(showBar=TRUE)
  UpdateModelNumber()
  modelName <- tclVar(paste("GLMM.", getRcmdr("modelNumber"), sep=""))
  modelFrame <- tkframe(top)
  model <- ttkentry(modelFrame, width="20", textvariable=modelName)
  linkFamilyFrame <- tkframe(top)
  familyFrame <- tkframe(linkFamilyFrame)
  max.height <- getRcmdr("variable.list.height")
  familyBox <- tklistbox(familyFrame, height=length(families), 
                         exportselection="FALSE",
                         selectmode="single", background="white")
  for (fam in families) tkinsert(familyBox, "end", fam)
  linkFrame <- tkframe(linkFamilyFrame)
  linkBox <- tklistbox(linkFrame, height=max.height, exportselection="FALSE",
                       selectmode="single", background="white")
  subsetWeightFrame <- tkframe(top)
  subsetBox(window=subsetWeightFrame, model=TRUE)
  weightComboBox <- variableComboBox(subsetWeightFrame, variableList=Numeric(), 
                                     initialSelection=dialog.values$initial.weight,
                                     title=gettextRcmdr("Weights"))
  removeVariable <- tclVar(dialog.values$initial.delete.cases)
  removeFrame <- tkframe(top)
  removeEntry <- ttkentry(removeFrame, width="60", textvariable=removeVariable)
  removeScroll <- ttkscrollbar(removeFrame, orient="horizontal",
                               command=function(...) tkxview(removeEntry, ...))
  tkconfigure(removeEntry, xscrollcommand=function(...) tkset(removeScroll, ...))
  onFamilySelect <- function(){
    family <- families[as.numeric(tkcurselection(familyBox)) + 1]
    availLinks <- links[availableLinks[family,]]
    tkdelete(linkBox, "0", "end")
    for (lnk in availLinks) tkinsert(linkBox, "end", lnk)
    canLink <- canonicalLinks[family]
    tkconfigure(linkBox, height=length(availLinks))
    tkselection.set(linkBox, which(canLink == availLinks) - 1)
  }
  onOK <- function(){
    check.empty <- gsub(" ", "", tclvalue(lhsVariable))
    if ("" == check.empty) {
      errorCondition(recall=generalizedLinearMixedModel, model=TRUE, message=gettextRcmdr("Left-hand side of model empty."))
      return()
    }
    check.empty <- gsub(" ", "", tclvalue(rhsVariable))
    if ("" == check.empty) {
      errorCondition(recall=generalizedLinearMixedModel, model=TRUE, message=gettextRcmdr("Right-hand side of model empty."))
      return()
    }
    modelValue <- trim.blanks(tclvalue(modelName))
    if (!is.valid.name(modelValue)){
      errorCondition(recall=generalizedLinearMixedModel, model=TRUE, message=sprintf(gettextRcmdr('"%s" is not a valid name.'), modelValue))
      return()
    }
    if (!grepl("\\(.*\\|.*\\)", tclvalue(rhsVariable))) {
      errorCondition(recall=generalizedLinearMixedModel, message=gettextRcmdr("There are no random effects in the model."), model=TRUE)
      return()
    }
    if (is.element(modelValue, listGLMMs())) {
      if ("no" == tclvalue(checkReplace(modelValue, type=gettextRcmdr("Model")))){
        UpdateModelNumber(-1)
          if (getRcmdr("onApplyCalled")){
              putRcmdr("onApplyCalled", FALSE)
              return()
          }
        closeDialog()
        generalizedLinearMixedModel()
        return()
      }
    }
    remove <- trim.blanks(tclvalue(removeVariable))
    remove.cases <- if (remove == gettextRcmdr("<use all valid cases>") || remove == ""){
      "" 
    } else {
      removeRows <- getCases(remove, remove=TRUE)
      paste(", subset =", removeRows)
    }
    if (remove.cases != "" && inherits(removeRows, "cases-error")){
      errorCondition(recall = generalizedLinearMixedModel,
                     message = removeRows,
                     model=TRUE)
      return()
    }
    initial.delete.cases <- gettextRcmdr("<use all valid cases>")
    formula <- paste(tclvalue(lhsVariable), tclvalue(rhsVariable), sep=" ~ ")
    family <- families[as.numeric(tkcurselection(familyBox)) + 1]
    availLinks <- links[availableLinks[family,]]
    link <- availLinks[as.numeric(tkcurselection(linkBox)) + 1]
    subset <- tclvalue(subsetVariable)
    closeDialog()
    if (trim.blanks(subset) == gettextRcmdr("<all valid cases>") || trim.blanks(subset) == ""){
      subset <- ""
    }
    else{
      subset <- paste(", subset=", subset, sep="")
    }
    if (subset != "" && remove.cases != ""){
      errorCondition(recall = generalizedLinearMixedModel, 
                     message = gettextRcmdr("You cannot specify both case removal and subset cases"), model=TRUE)
      return()
    }
    weight.var <- getSelection(weightComboBox)
    putDialog("generalizedLinearMixedModel", list(initial.weight = weight.var, 
                                                  initial.delete.cases = initial.delete.cases))
    weights <- if (weight.var == gettextRcmdr("<no variable selected>")) ""
    else paste(", weights=", weight.var, sep="")
    command <- paste("glmer(", formula, ", family=", family, "(", link,
                     "), data=", ActiveDataSet(), subset, remove.cases, weights, ")", sep="")
    doItAndPrint(paste(modelValue, " <- ", command, sep = ""))
    doItAndPrint(paste("summary(", modelValue, ")", sep=""))
    activeModel(modelValue)
    if ((family == "binomial" || family =="quasibinomial") && link == "logit"){
      doItAndPrint(paste0("exp(coef(", modelValue,
                          '))  # Exponentiated coefficients ("odds ratios")'))
    }
    if ((family == "poisson" || family =="quasipoisson") && link == "log"){
      doItAndPrint(paste0("exp(coef(", modelValue,
                          '))  # Exponentiated coefficients'))
    }
    if (subset != "" || remove.cases != "") putRcmdr("modelWithSubset", TRUE) else putRcmdr("modelWithSubset", FALSE)
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject="glmer", model=TRUE, reset="resetGLMM", apply="generalizedLinearMixedModel")
  helpButton <- buttonRcmdr(buttonsFrame, text="Help", width="12", command=onHelp)
  tkgrid(labelRcmdr(modelFrame, text=gettextRcmdr("Enter name for model:")), model, sticky="w")
  tkgrid(modelFrame, sticky="w")
  tkgrid(getFrame(xBox), sticky="w")
  tkgrid(outerOperatorsFrame, sticky="w")
  tkgrid(formulaFrame, sticky="w")
  tkgrid(subsetFrame, tklabel(subsetWeightFrame, text="   "),
         getFrame(weightComboBox), sticky="nw")
  tkgrid(labelRcmdr(removeFrame, text=" "))
  tkgrid(labelRcmdr(removeFrame, text=gettextRcmdr("Indices or names of row(s) to remove"),
                    foreground=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
  tkgrid(removeEntry, sticky="w")
  tkgrid(removeScroll, sticky="ew")
  if (getRcmdr("model.case.deletion")) tkgrid(removeFrame, sticky="nw", columnspan=3)
  tkgrid(subsetWeightFrame, sticky="w")  
  tkgrid(labelRcmdr(linkFamilyFrame, text=gettextRcmdr("Family (double-click to select)"), fg=getRcmdr("title.color"), font="RcmdrTitleFont"),
         labelRcmdr(linkFamilyFrame, text="   "), labelRcmdr(linkFamilyFrame, text=gettextRcmdr("Link function"), fg=getRcmdr("title.color"), font="RcmdrTitleFont"), sticky="w")
  tkgrid(familyBox, sticky="nw")
  tkgrid(linkBox, sticky="nw")
  tkgrid(familyFrame, labelRcmdr(linkFamilyFrame, text="   "), linkFrame, sticky="nw")
  tkgrid(linkFamilyFrame, sticky="w")
  tkgrid(buttonsFrame, sticky="w")
  fam <- if (currentModel) which(currentFields$family == families) - 1
  else 1
  tkselection.set(familyBox, fam)
  availLinks <- links[availableLinks[fam + 1,]]
  for (lnk in availLinks) tkinsert(linkBox, "end", lnk)
  tkconfigure(linkBox, height=length(availLinks))
  lnk <- if (currentModel) which(currentFields$link == availLinks) - 1
  else 0
  tkselection.set(linkBox, lnk)
  tkbind(familyBox, "<Double-ButtonPress-1>", onFamilySelect)
  dialogSuffix(focus=lhsEntry, preventDoubleClick=TRUE)
}

resetGLMM <- function(){
  putRcmdr("reset.model", TRUE)
  putDialog("generalizedLinearMixedModel", NULL)
  putDialog("generalizedLinearMixedModel", NULL, resettable=FALSE)
  generalizedLinearMixedModel()
}