.packageName <- "Rcmdr"
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/Rexcel-specific.R"
# These functions for Excel supportwritten by Erich Neuwirth
#  last modified: 20 March 2008 by J. Fox  (following instructions from Erich Neuwirth)

    RExcelSupported <- function(){
    	RExcelSupport <- getOption("Rcmdr")$RExcelSupport
        !is.null(RExcelSupport) && RExcelSupport && exists("RExcelEnv") &&
            exists("putRExcel", where="RExcelEnv")
    	}




    SubmitToCommander <- function(commands){
        .log <- LogWindow()
        lines<-commands
        lines <- strsplit(lines, "\n")[[1]]
        .console.output <- getRcmdr("console.output")
        .output <- OutputWindow()
        iline <- 1
        nlines <- length(lines)
        while (iline <= nlines){
            while (whitespaceonly(lines[iline])) iline <- iline + 1
            if (iline > nlines) break
            current.line <- lines[iline]
            if (.console.output) cat(paste("\nRcmdr> ", current.line,"\n", sep=""))
            else{
                tkinsert(.output, "end", paste("\n> ", current.line,"\n", sep=""))
                tktag.add(.output, "currentLine", "end - 2 lines linestart", "end - 2 lines lineend")
                tktag.configure(.output, "currentLine", foreground=getRcmdr("command.text.color"))
                }
            jline <- iline + 1
            while (jline <= nlines){
                if (class(try(parse(text=current.line),silent=TRUE))!="try-error") break
                if (.console.output)cat(paste("Rcmdr+ ", lines[jline], sep="\n"))
                else{
                    tkinsert(.output, "end", paste("+ ", lines[jline],"\n", sep=""))
                    tktag.add(.output, "currentLine", "end - 2 lines linestart", "end - 2 lines lineend")
                    tktag.configure(.output, "currentLine", foreground=getRcmdr("command.text.color"))
                    }
                current.line <- paste(current.line, lines[jline],sep="\n")
                jline <- jline + 1
                iline <- iline + 1
                }
            if (!(is.null(current.line) || is.na(current.line))){
            if (length(grep("<-", current.line)) > 0){
                justDoIt(current.line)
            	loggerForExcel(current.line)
                }
            else if (length(grep("^remove\\(", current.line)) > 0){
                current.line <- sub(")", ", envir=.GlobalEnv)", current.line)
                justDoIt(current.line)
            	loggerForExcel(current.print.line)
                }
##            else if (any(sapply(Commander.Input.exceptions,
##                    function(.x) length(grep(paste("^", .x, "\\(", sep=""), current.line)) > 0))){
##                justDoIt(current.line)
##            	loggerForExcel(current.line)
##                }
            else if (length(current.line)>0) {
		          doItAndPrint(current.line, log=FALSE)
            	loggerForExcel(current.line)
		          }
            }
            iline <- iline + 1
        }
    tkyview.moveto(.output, 1)
    }




loggerForExcel <- function(command){
    if (is.SciViews()) return(svlogger(command))    # +PhG
    .log <- LogWindow()
    .output <- OutputWindow()
    if (getRcmdr("log.commands")) {
        tkinsert(.log, "end", paste(command,"\n", sep=""))
        tkyview.moveto(.log, 1)
        }
    }

#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/cluster.R"
# this code by Dan Putler, used with permission

# last modified 17 September 2008 by J. Fox

assignCluster <- function(clusterData, origData, clusterVec){
    rowsDX <- row.names(clusterData)
    rowsX <- row.names(origData)
    clustAssign <- rep(NA, length(rowsX))
    validData <- rowsX %in% rowsDX
    clustAssign[validData] <- clusterVec
    return(as.factor(clustAssign))
    }

KMeans <- function (x, centers, iter.max=10, num.seeds=10) {
    # fixed 15 Mar 05 by J. Fox
    if(mode(x)=="numeric") x<-data.frame(new.x=x)
    KM <- kmeans(x=x, centers=centers, iter.max=iter.max)
    for(i in 2:num.seeds) {
        newKM <- kmeans(x=x, centers=centers, iter.max=iter.max)
        if(sum(newKM$withinss) < sum(KM$withinss)) {
            KM <- newKM
            }
        }
    KM$tot.withinss <- sum(KM$withinss)
    xmean <- apply(x, 2, mean)
    centers <- rbind(KM$centers, xmean)
    bss1 <- as.matrix(dist(centers)^2)
    KM$betweenss <- sum(as.vector(bss1[nrow(bss1),])*c(KM$size,0))
    return(KM)
    }

listKmeansSolutions <- function(envir=.GlobalEnv, ...) {
    objects <- ls(envir=envir, ...)
    if (length(objects) == 0) NULL
    else objects[sapply(objects, 
        function(.x) {
            .x <- get(.x, envir=envir)
            if (mode(.x) != "list")
                return(FALSE)
            else "cluster" == names(.x)[1] && "centers" == names(.x)[2]
#            if(mode(eval(parse(text=.x), envir=envir)) != "list" )
#                return(FALSE)
#            else {"cluster" == (names(eval(parse(text=.x),
#                envir=envir))[1]) &
#             "centers" == (names(eval(parse(text=.x), envir=envir))[2])}
            }
         )]
    }

kmeansClustering <- function(){
    initializeDialog(title=gettextRcmdr("KMeans Clustering"))
    dataFrame <- tkframe(top)
    xBox <- variableListBox(dataFrame, Numeric(), selectmode="multiple",
      title=gettextRcmdr("Variables (pick one or more)"))
    subsetBox(dataFrame)
    optionsFrame <- tkframe(top)
    clusterNumber <- tclVar("2")
    clusterNumSlider <- tkscale(optionsFrame, from=2, to=10, showvalue=TRUE,
      variable=clusterNumber, resolution=1, orient="horizontal")
    seedNumber <- tclVar("10")
    seedNumSlider <- tkscale(optionsFrame, from=1, to=20, showvalue=TRUE,
      variable=seedNumber, resolution=1, orient="horizontal")
    iterNumber <- tclVar("10")
    iterNumSlider <- tkscale(optionsFrame, from=5, to=30, showvalue=TRUE,
      variable=iterNumber, resolution=5, orient="horizontal")
    summaryClusters <- tclVar("1")
    summaryCB <- tkcheckbutton(optionsFrame)
    tkconfigure(summaryCB, variable=summaryClusters)
    plotClusters <- tclVar("1")
    plotCB <- tkcheckbutton(optionsFrame)
    tkconfigure(plotCB, variable=plotClusters)
    assignClusters <- tclVar("0")
    assignCB <- tkcheckbutton(optionsFrame)
    tkconfigure(assignCB, variable=assignClusters)
    assignName <- tclVar("KMeans")
    assignField <- ttkentry(optionsFrame, width="15",
      textvariable=assignName)
    onOK <- function(){
        x <- getSelection(xBox)
        nvar <- length(x)
        subset <- trim.blanks(tclvalue(subsetVariable))
        nClusters <- tclvalue(clusterNumber)
        seeds <- tclvalue(seedNumber)
        iters <- tclvalue(iterNumber)
        clusterSummary <- tclvalue(summaryClusters)
        clusterPlot <- tclvalue(plotClusters)
        clusterAssign <- tclvalue(assignClusters)
        clusterVariable <- trim.blanks(tclvalue(assignName))
        closeDialog()
        if (clusterAssign == "1"){
           if (is.element(clusterVariable, Variables())) {
                if ("no" == tclvalue(checkReplace(clusterVariable))){
                    kmeansClustering()
                    return()
                    }
                }
           } 
        if (length(x)==0) {
            errorCondition(recall=kmeansClustering, 
              message=gettextRcmdr("No variables selected."))
            return()
            }
        varFormula <- paste(x, collapse=" + ")
        vars <- paste(x, collapse=",", sep="")
        .activeDataSet <- ActiveDataSet()
        dset <- if (trim.blanks(subset) == gettextRcmdr("<all valid cases>")) .activeDataSet
          else {paste(.activeDataSet, "[", .activeDataSet, "$", subset, ", ]",
            sep="")}
        xmat <- paste("model.matrix(~-1 + ", varFormula, ", ", dset, ")",
          sep="")
        command <- paste("KMeans(", xmat, ", centers = ", nClusters,
          ", iter.max = ", iters, ", num.seeds = ", seeds, ")", sep="")
        assign(".cluster", justDoIt(command), envir=.GlobalEnv)
        logger(paste(".cluster <- ", command, sep=""))
        if (clusterSummary == "1") {
            doItAndPrint(paste(".cluster$size # Cluster Sizes"))
            doItAndPrint(paste(".cluster$centers # Cluster Centroids"))
            doItAndPrint(paste(
              ".cluster$withinss # Within Cluster Sum of Squares"))
            doItAndPrint(paste(
              ".cluster$tot.withinss # Total Within Sum of Squares"))
            doItAndPrint(paste(
              ".cluster$betweenss # Between Cluster Sum of Squares"))
            }
        if (clusterPlot == "1") {
            plotCommand <- paste("biplot(princomp(", xmat, 
              "), xlabs = as.character(.cluster$cluster))", sep="")
           justDoIt(plotCommand)
           logger(plotCommand)
           }
        if (clusterAssign == "1") {
            assignCommand <- paste(.activeDataSet, "$", clusterVariable,
              " <- assignCluster(", xmat, ", ", .activeDataSet,
              ", .cluster$cluster)", sep="")
            justDoIt(assignCommand)
            logger(assignCommand)
            activeDataSet(.activeDataSet)
            }
        justDoIt(paste("remove(.cluster)"))
        logger(paste("remove(.cluster)"))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="KMeans")
    tkgrid(getFrame(xBox), sticky="nw")
    tkgrid(subsetFrame, sticky="w")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Number of clusters:")),
      clusterNumSlider, sticky="sw")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Number of starting seeds:")),
      seedNumSlider, sticky="sw")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Maximum iterations:")),
      iterNumSlider, sticky="sw")
    tkgrid(labelRcmdr(optionsFrame, 
      text=gettextRcmdr("Print cluster summary")), summaryCB, sticky="w")
    tkgrid(labelRcmdr(optionsFrame, 
      text=gettextRcmdr("Bi-plot of clusters")), plotCB, sticky="w")
    tkgrid(labelRcmdr(optionsFrame, 
      text=gettextRcmdr("Assign clusters to\nthe data set         ")),
      assignCB, sticky="w")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Assignment variable: ")),
      assignField, sticky="w")
    tkgrid(dataFrame, labelRcmdr(top, text="  "), optionsFrame,
        sticky="nw")
    tkgrid(buttonsFrame, columnspan=3, sticky="w")
    dialogSuffix(rows=3, columns=3)
    }

listHclustSolutions <- function(envir=.GlobalEnv, ...) {
    objects <- ls(envir=envir, ...)
    if (length(objects) == 0) NULL
    else objects[sapply(objects,
        function(.x) "hclust" == class(get(.x, envir=envir))[1]) ]
#        function(.x) "hclust" == (class(eval(parse(text=.x), envir=envir))[1]))]
    }

hierarchicalCluster <- function(){
    solutionNumber=length(listHclustSolutions())
    initializeDialog(title=gettextRcmdr("Hierarchical Clustering"))
    solutionFrame <- tkframe(top)
    solutionName <- tclVar(paste("HClust.", (solutionNumber+1),
        sep=""))
    solutionField <- ttkentry(solutionFrame, width="20",
      textvariable=solutionName)
    dataFrame <- tkframe(top)
    xBox <- variableListBox(dataFrame, Numeric(), selectmode="multiple",
      title=gettextRcmdr("Variables (pick one or more)"))
    subsetBox(dataFrame)
    radioButtons(name="method",
      buttons=c("ward", "single", "complete","average", "mcquitty", "median",
      "centroid"), labels=gettextRcmdr(c("Ward's Method", "Single Linkage",
      "Complete Linkage", "Average Linkage", "McQuitty's Method",
      "Median Linkage", "Centroid Linkage")), title=gettextRcmdr("Clustering Method"))
    optionsFrame <- tkframe(top)
    radioButtons(optionsFrame, name="distanceType", buttons=c("euc", "euc2",
      "city", "none"), labels=gettextRcmdr(c("Euclidean", "Squared-Euclidian", 
      "Manhattan (City Block)", "No Transformation")), title=gettextRcmdr("Distance Measure"))
    checkFrame <- tkframe(optionsFrame)
    plotDendro <- tclVar("1")
    plotCB <- tkcheckbutton(checkFrame)
    tkconfigure(plotCB, variable=plotDendro)
    onOK <- function(){
        x <- getSelection(xBox)
        nvar <- length(x)
        clusMethod <- tclvalue(methodVariable)
        distance <- tclvalue(distanceTypeVariable)
        subset <- trim.blanks(tclvalue(subsetVariable))
        dendro <- tclvalue(plotDendro)
        solution <- trim.blanks(tclvalue(solutionName))
        if (length(x)==0) {
            errorCondition(recall=hierarchicalCluster, 
              message=gettextRcmdr("No variables selected."))
            return()
            }
        closeDialog()
        varFormula <- paste(x, collapse="+")
        vars <- paste(x, collapse=",", sep="")
        .activeDataSet <- ActiveDataSet()
        dset <- if (subset == gettextRcmdr("<all valid cases>")) .activeDataSet
          else {paste(.activeDataSet, "[", .activeDataSet, "$", subset, ", ]",
            sep="")}
        xmat <- paste("model.matrix(~-1 + ", varFormula, ", ", dset, ")",
          sep="")
        if(distance=="euc") {
            dx <- paste("dist(", xmat, ")", sep="")
            distlab <- "euclidian"
        }
        else if(distance=="euc2") {
            dx <- paste("dist(", xmat, ")^2", sep="")
            distlab <- "squared-euclidian"
        }
        else if(distance=="city") {
            dx <- paste("dist(", xmat, ", method= ", '"manhattan"', ")",
                sep="")
            distlab <- "city-block"
        }
        else {
            dx <- xmat
            distlab <- "untransformed"
        }
        command <- paste("hclust(", dx, " , method= ", '"', clusMethod, '"',
          ")", sep="")
        assign(solution, justDoIt(command), envir=.GlobalEnv)
        logger(paste(solution, " <- ", command, sep=""))
        if (dendro == "1") {
            justDoIt(paste("plot(", solution, ", main= ",'"',
              "Cluster Dendrogram for Solution ", solution, '"', ", xlab= ",
              '"',"Observation Number in Data Set ", dset, '"',
               ", sub=", '"', "Method=", clusMethod,
              "; Distance=", distlab, '"', ")", sep=""))
            logger(paste("plot(", solution, ", main= ",'"',
              "Cluster Dendrogram for Solution ", solution, '"', ", xlab= ",
              '"',"Observation Number in Data Set ", dset, '"',
               ", sub=", '"', "Method=", clusMethod,
              "; Distance=", distlab, '"', ")",
              sep=""))
            }
         activateMenus()
         tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="hclust")
    tkgrid(solutionField, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Clustering solution name:")),
      solutionFrame, sticky="w")
    tkgrid(getFrame(xBox), sticky="nw")
    tkgrid(subsetFrame, sticky="w")
    tkgrid(distanceTypeFrame, sticky="w")
    tkgrid(labelRcmdr(checkFrame, text="  "), sticky="w")
    tkgrid(labelRcmdr(checkFrame, text=gettextRcmdr("Plot Dendrogram  ")), plotCB,
      sticky="w")
    tkgrid(checkFrame, sticky="w")
    tkgrid(dataFrame, methodFrame, optionsFrame, sticky="nw")
    tkgrid(buttonsFrame, columnspan=3, sticky="w")
    dialogSuffix(rows=3, columns=3)
    }

hclustSummary <- function(){
    parseDataSet <- function(x) {
        y <- get(x)$call
#        y <- eval(parse(text=paste(x, "$call", sep="")))
        string1 <- unlist(strsplit(as.character(y)[2], "\\("))
        string2 <- unlist(strsplit(string1[3], ","))
        if(length(grep("\\[", string2[2])) == 0) {
            out <- gsub(")", "", gsub(" ", "", gsub("\\^2", "",
                string2[2])))
            }
        else {
            string3 <- unlist(strsplit(string2[2], "\\["))
            out <- gsub(" ", "", string3[1])
            }
        return(out)
        }
    hclustObjects <- listHclustSolutions()
    testDataSet <- tapply(hclustObjects, as.factor(1:length(hclustObjects)),
      parseDataSet)
    .activeDataSet <- ActiveDataSet()
    validHclust <- hclustObjects[testDataSet==.activeDataSet]
    initializeDialog(
      title=gettextRcmdr("Hierarchical Cluster Summary"))
    hclustBox <- variableListBox(top, validHclust, selectmode="single",
      title=gettextRcmdr("Select One Clustering Solution"))
    optionsFrame <- tkframe(top)
    clusterNumber <- tclVar("2")
    slider <- tkscale(optionsFrame, from=2, to=10, showvalue=TRUE,
      variable=clusterNumber, resolution=1, orient="horizontal")
    summaryClusters <- tclVar("1")
    summaryCB <- tkcheckbutton(optionsFrame)
    tkconfigure(summaryCB, variable=summaryClusters)
    plotClusters <- tclVar("1")
    plotCB <- tkcheckbutton(optionsFrame)
    tkconfigure(plotCB, variable=plotClusters)
    if(length(hclustObjects)==0) {
        errorCondition(recall=return,
          message=gettextRcmdr("There are no hierachical clustering solutions"))
        }
    if(length(validHclust)==0) {
        errorCondition(recall=return, message=
     gettextRcmdr("No hierachical clustering solutions are associated with this data set."))
        }
   onOK <- function(){
        solution <- getSelection(hclustBox)
        if(length(solution)==0) {
          errorCondition(recall=hclustSummary,
            message=gettextRcmdr("A clustering solution has not been selected."))
          return()
            }
        clusters <- as.numeric(tclvalue(clusterNumber))
        clusterVar <- paste("cutree(", solution, ", k = ", clusters, ")",
          sep="")
        clusterSummary <- tclvalue(summaryClusters)
        clusterPlot <- tclvalue(plotClusters)
        hclustCall <- get(solution)$call
#        hclustCall <- eval(parse(text=paste(solution,"$call",sep="")))
        string1 <- unlist(strsplit(as.character(hclustCall)[2], "\\("))
        string2 <- unlist(strsplit(string1[3], ","))
        form.vars <- string2[1]
        closeDialog()
        if(length(grep("\\[", string2[2])) == 0) {
            xmat <- paste("model.matrix(", form.vars, ", ", .activeDataSet, ")",
              sep="")
            }
        else {
            string3 <- unlist(strsplit(string2[2], "\\["))
            xmat <- paste("model.matrix(", form.vars, ", ", .activeDataSet, "[",
              string3[2], ", ]",")", sep="")
            }
        if (clusterSummary == "1") {
            doItAndPrint(paste("summary(as.factor(", clusterVar,
              ")) # Cluster Sizes", sep=""))
            centroidsCommand <- paste("by(", xmat, ", as.factor(", clusterVar,
              "), mean) # Cluster Centroids", sep="")
            doItAndPrint(centroidsCommand)
            }
        if (clusterPlot == "1") {
             plotCommand <- paste("biplot(princomp(", xmat, 
               "), xlabs = as.character(", clusterVar, "))", sep="")
            justDoIt(plotCommand)
            logger(plotCommand)
            }
        tkfocus(CommanderWindow())
        } 
    OKCancelHelp(helpSubject="biplot")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Number of clusters:")), slider,
      sticky="sw")
    tkgrid(labelRcmdr(optionsFrame, 
      text=gettextRcmdr("Print cluster summary")), summaryCB, sticky="w")
    tkgrid(labelRcmdr(optionsFrame, 
      text=gettextRcmdr("Bi-plot of clusters")), plotCB, sticky="w")
    tkgrid(getFrame(hclustBox), optionsFrame, sticky="nw")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=2, columns=3)
    }

appendHclustGroup <- function(){
    parseDataSet <- function(x) {
        y <- get(x)$call
#        y <- eval(parse(text=paste(x, "$call", sep="")))
        string1 <- unlist(strsplit(as.character(y)[2], "\\("))
        string2 <- unlist(strsplit(string1[3], ","))
        if(length(grep("\\[", string2[2])) == 0) {
            out <- gsub(")", "", gsub(" ", "", gsub("\\^2", "",
                string2[2])))
            }
        else {
            string3 <- unlist(strsplit(string2[2], "\\["))
            out <- gsub(" ", "", string3[1])
            }
        return(out)
        }
    hclustObjects <- listHclustSolutions()
    if(length(hclustObjects)==0) {
        Message(message=gettextRcmdr("There are no hierachical clustering solutions"),
            type = "error")
        return()
        }    
    testDataSet <- tapply(hclustObjects, as.factor(1:length(hclustObjects)),
      parseDataSet)
    .activeDataSet <- ActiveDataSet()
    validHclust <- hclustObjects[testDataSet==.activeDataSet]
    if(length(validHclust)==0) {
        Message(message=gettextRcmdr("No hierachical clustering solutions are associated with this data set."),
            type = "error")
        return()
        }
    initializeDialog(
      title=gettextRcmdr("Append Cluster Groups to the Active Data Set"))
    hclustBox <- variableListBox(top, validHclust, selectmode="single",
      title=gettextRcmdr("Select One Clustering Solution"))
    optionsFrame <- tkframe(top)
    labelName <- tclVar("hclus.label")
    labelNameField <- ttkentry(optionsFrame, width="15",
      textvariable=labelName)
    clusterNumber <- tclVar("2")
    slider <- tkscale(optionsFrame, from=2, to=10, showvalue=TRUE,
      variable=clusterNumber, resolution=1, orient="horizontal")
   onOK <- function(){
        solution <- getSelection(hclustBox)
        if(length(solution)==0) {
          errorCondition(recall=appendHclustGroup,
            message=gettextRcmdr("A clustering solution has not been selected."))
          return()
            }
        clusters <- as.numeric(tclvalue(clusterNumber))
        label <- trim.blanks(tclvalue(labelName))
        closeDialog()
        if (is.element(label, Variables())) {
            if ("no" == tclvalue(checkReplace(label))){
                appendHclustGroup()
                return()
                }
            }
        hclustCall <- get(solution)$call        
#        hclustCall <- eval(parse(text=paste(solution,"$call",sep="")))
        string1 <- unlist(strsplit(as.character(hclustCall)[2], "\\("))
        string2 <- unlist(strsplit(string1[3], ","))
        form.vars <- string2[1]
        if(length(grep("\\[", string2[2])) == 0) {
            xmat <- paste("model.matrix(", form.vars, ", ", .activeDataSet, ")",
              sep="")
            }
        else {
            string3 <- unlist(strsplit(string2[2], "\\["))
            xmat <- paste("model.matrix(", form.vars, ", ", .activeDataSet, "[",
              string3[2], ", ]",")", sep="")
            }
        clusterVar <- paste("cutree(", solution, ", k = ", clusters, ")",
          sep="")
        command <- paste(.activeDataSet, "$", label, " <- assignCluster(",
          xmat, ", ", .activeDataSet, ", ", clusterVar, ")", sep="")
        result <- justDoIt(command)
        logger(command)
		if (class(result)[1] !=  "try-error") activeDataSet(.activeDataSet)
        tkfocus(CommanderWindow())
        } 
    OKCancelHelp(helpSubject="assignCluster")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("  Assigned cluster label:")),
      labelNameField, sticky="w")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("  Number of clusters:")),
        slider, sticky="sw")
    tkgrid(getFrame(hclustBox), optionsFrame, sticky="nw")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=2, columns=3)
    }
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/commander.R"

# The R Commander and command logger

# last modified 16 October 2010 by J. Fox
#   slight changes 12 Aug 04 by Ph. Grosjean
#   changes 21 June 2007 by Erich Neuwirth for Excel support (marked EN)
#   modified 17 December 2008 by Richard Heiberger  ##rmh

Commander <- function(){
	RcmdrVersion <- "1.6-3"
	##    DESCRIPTION <- readLines(file.path(.find.package("Rcmdr"), "DESCRIPTION")[1])
	##    RcmdrVersion <- trim.blanks(sub("^Version:", "",
	##        grep("^Version:", D, value=TRUE)))
	putRcmdr("quotes", options(useFancyQuotes=FALSE))
	putRcmdr("messageNumber", 0)
	# the following test suggested by Richard Heiberger
	if ("RcmdrEnv" %in% search() &&
		exists("commanderWindow", "RcmdrEnv") &&
		!is.null(get("commanderWindow", "RcmdrEnv"))) {
		warning("The R Commander is already open.")
		return(invisible(NULL))
	}
	if (is.SciViews()) return(invisible(svCommander(Version=RcmdrVersion))) # +PhG
	setOption <- function(option, default, global=TRUE) {
		opt <- if (is.null(current[option][[1]])) default else current[option][[1]]
		if (global) putRcmdr(option, opt)
		else opt
	}
	current <- options("Rcmdr")[[1]]
	setOption("number.messages", TRUE)
	etc <- setOption("etc", file.path(.path.package(package="Rcmdr")[1], "etc"))
	etcMenus <- setOption("etcMenus", etc)
	putRcmdr("etcMenus", etcMenus)
	onCopy <- function(){
		focused <- tkfocus()
		if ((tclvalue(focused) != LogWindow()$ID) && (tclvalue(focused) != OutputWindow()$ID) && (tclvalue(focused) != MessagesWindow()$ID))
			focused <- LogWindow()
		selection <- strsplit(tclvalue(tktag.ranges(focused, "sel")), " ")[[1]]
		if (is.na(selection[1])) return()
		text <- tclvalue(tkget(focused, selection[1], selection[2]))
		tkclipboard.clear()
		tkclipboard.append(text)
	}
	onDelete <- function(){
		focused <- tkfocus()
		if ((tclvalue(focused) != LogWindow()$ID) && (tclvalue(focused) != OutputWindow()$ID) && (tclvalue(focused) != MessagesWindow()$ID))
			focused <- LogWindow()
		selection <- strsplit(tclvalue(tktag.ranges(focused, "sel")), " ")[[1]]
		if (is.na(selection[1])) return()
		tkdelete(focused, selection[1], selection[2])
	}
	onCut <- function(){
		onCopy()
		onDelete()
	}
	onPaste <- function(){
		onDelete()
		focused <- tkfocus()
		if ((tclvalue(focused) != LogWindow()$ID) && (tclvalue(focused) != OutputWindow()$ID)  && (tclvalue(focused) != MessagesWindow()$ID))
			focused <- LogWindow()
		text <- tclvalue(.Tcl("selection get -selection CLIPBOARD"))
		if (length(text) == 0) return()
		tkinsert(focused, "insert", text)
	}
	onFind <- function(){
		focused <- tkfocus()
		if ((tclvalue(focused) != LogWindow()$ID) && (tclvalue(focused) != OutputWindow()$ID)  && (tclvalue(focused) != MessagesWindow()$ID))
			focused <- LogWindow()
		initializeDialog(title=gettextRcmdr("Find"))
		textFrame <- tkframe(top)
		textVar <- tclVar("")
		textEntry <- ttkentry(textFrame, width="20", textvariable=textVar)
		checkBoxes(frame="optionsFrame", boxes=c("regexpr", "case"), initialValues=c("0", "1"),
			labels=gettextRcmdr(c("Regular-expression search", "Case sensitive")))
		radioButtons(name="direction", buttons=c("foward", "backward"), labels=gettextRcmdr(c("Forward", "Backward")),
			values=c("-forward", "-backward"), title=gettextRcmdr("Search Direction"))
		onOK <- function(){
			text <- tclvalue(textVar)
			if (text == ""){
				errorCondition(recall=onFind, message=gettextRcmdr("No search text specified."))
				return()
			}
			type <- if (tclvalue(regexprVariable) == 1) "-regexp" else "-exact"
			case <- tclvalue(caseVariable) == 1
			direction <- tclvalue(directionVariable)
			stop <- if (direction == "-forward") "end" else "1.0"
			where <- if (case) tksearch(focused, type, direction, "--", text, "insert", stop)
				else tksearch(focused, type, direction, "-nocase", "--", text, "insert", stop)
			where <- tclvalue(where)
			if (where == "") {
				Message(message=gettextRcmdr("Text not found."),
					type="note")
				if (GrabFocus()) tkgrab.release(top)
				tkdestroy(top)
				tkfocus(CommanderWindow())
				return()
			}
			if (GrabFocus()) tkgrab.release(top)
			tkfocus(focused)
			tkmark.set(focused, "insert", where)
			tksee(focused, where)
			tkdestroy(top)
		}
		OKCancelHelp()
		tkgrid(labelRcmdr(textFrame, text=gettextRcmdr("Search for:")), textEntry, sticky="w")
		tkgrid(textFrame, sticky="w")
		tkgrid(optionsFrame, sticky="w")
		tkgrid(directionFrame, sticky="w")
		tkgrid(buttonsFrame, sticky="w")
		dialogSuffix(rows=4, columns=1, focus=textEntry)
	}
	onSelectAll <- function() {
		focused <- tkfocus()
		if ((tclvalue(focused) != LogWindow()$ID) && (tclvalue(focused) != OutputWindow()$ID) && (tclvalue(focused) != MessagesWindow()$ID))
			focused <- LogWindow()
		tktag.add(focused, "sel", "1.0", "end")
		tkfocus(focused)
	}
	onClear <- function(){
		onSelectAll()
		onDelete()
	}
	onUndo <- function(){
		focused <- tkfocus()
		if ((tclvalue(focused) != LogWindow()$ID) && (tclvalue(focused) != OutputWindow()$ID) && (tclvalue(focused) != MessagesWindow()$ID))
			focused <- LogWindow()
		tcl(focused, "edit", "undo")
	}
	onRedo <- function(){
		focused <- tkfocus()
		if ((tclvalue(focused) != LogWindow()$ID) && (tclvalue(focused) != OutputWindow()$ID) && (tclvalue(focused) != MessagesWindow()$ID))
			focused <- LogWindow()
		tcl(focused, "edit", "redo")
	}
	messageTag(reset=TRUE)
	putRcmdr("RcmdrVersion", RcmdrVersion)
	putRcmdr(".activeDataSet", NULL)
	putRcmdr(".activeModel", NULL)
	putRcmdr("logFileName", NULL)
	putRcmdr("outputFileName", NULL)
	putRcmdr("saveFileName", NULL)
	putRcmdr("modelNumber", 0)
	putRcmdr("rgl", FALSE)
	putRcmdr("Identify3d", NULL)
	setOption("log.font.size", if (.Platform$OS.type == "windows") 10 else 12)
	putRcmdr("logFont", tkfont.create(family="courier", size=getRcmdr("log.font.size")))
#    putRcmdr("operatorFont", tkfont.create(family="courier", size=getRcmdr("log.font.size")))
	scale.factor <- current$scale.factor
	if (!is.null(scale.factor)) .Tcl(paste("tk scaling ", scale.factor, sep=""))
	if (packageAvailable("car")){
		require("car")
		setOption("default.contrasts", c("contr.Treatment", "contr.poly"))
	}
	else setOption("default.contrasts", c("contr.treatment", "contr.poly"))
	setOption("log.commands", TRUE)
	setOption("console.output", FALSE)
	log.height <- as.character(setOption("log.height", if (!getRcmdr("log.commands")) 0 else 10, global=FALSE))
	log.width <- as.character(setOption("log.width", 80, global=FALSE))
	output.height <- as.character(setOption("output.height",
			if (getRcmdr("console.output")) 0
				else if ((as.numeric(log.height) != 0) || (!getRcmdr("log.commands"))) 2*as.numeric(log.height)
				else 20, global=FALSE))
	messages.height <- as.character(setOption("messages.height", 3))
	putRcmdr("saveOptions", options(warn=1, contrasts=getRcmdr("default.contrasts"), width=as.numeric(log.width),
			na.action="na.exclude", graphics.record=TRUE))
	setOption("ask.to.exit", TRUE)
	setOption("ask.on.exit", TRUE)
	setOption("double.click", FALSE)
	setOption("sort.names", TRUE)
	setOption("grab.focus", TRUE)
	setOption("attach.data.set", FALSE)
	setOption("log.text.color", "black")
	setOption("command.text.color", "red")
	setOption("output.text.color", "darkblue")
	setOption("error.text.color", "red")
	setOption("warning.text.color", "darkgreen")
	setOption("prefixes", c("Rcmdr> ", "Rcmdr+ ", "RcmdrMsg: ", "RcmdrMsg+ "))
	setOption("multiple.select.mode", "extended")
	setOption("suppress.X11.warnings",
		interactive() && .Platform$GUI == "X11") # to address problem in X11 (Linux or Mac OS X)
#		interactive() && .Platform$GUI == "X11" && getRversion() < "2.4.0")
	setOption("showData.threshold", 100)
	setOption("retain.messages", TRUE)
	setOption("crisp.dialogs",  TRUE)
	setOption("length.output.stack", 10)
	setOption("length.command.stack", 10)
	putRcmdr("outputStack", as.list(rep(NA, getRcmdr("length.output.stack"))))
	putRcmdr("commandStack", as.list(rep(NA, getRcmdr("length.command.stack"))))
	setOption("variable.list.height", 4)
	setOption("variable.list.width", c(20, Inf))
	if (getRcmdr("suppress.X11.warnings")) {
		putRcmdr("messages.connection", file(open = "w+"))
		sink(getRcmdr("messages.connection"), type="message")
#        putRcmdr("length.messages", 0)
	}
	if (.Platform$OS.type != "windows") {
		putRcmdr("oldPager", options(pager=RcmdrPager))
		default.font.size <- as.character(setOption("default.font.size", 12, global=FALSE))
		default.font <- setOption("default.font",
			paste("*helvetica-medium-r-normal-*-", default.font.size, "*", sep=""), global=FALSE)
		.Tcl(paste("option add *font ", default.font, sep=""))
	}
	placement <- setOption("placement", "-40+20", global=FALSE)
	source.files <- list.files(etc, pattern="\\.[Rr]$")
	for (file in source.files) {
		source(file.path(etc, file))
		cat(paste(gettextRcmdr("Sourced:"), file, "\n"))
	}
	Plugins <- options()$Rcmdr$plugins
	allPlugins <- listPlugins(loaded=TRUE)
	for (plugin in Plugins){
		if (!require(plugin, character.only=TRUE)){
			putRcmdr("commanderWindow", NULL)
			stop(sprintf(gettextRcmdr("the plug-in package %s is missing"), plugin))
		}
		if (!is.element(plugin, allPlugins)){
			putRcmdr("commanderWindow", NULL)
			stop(sprintf(gettextRcmdr("the package %s is not an Rcmdr plug-in"), plugin))
		}
	}
	Menus <- read.table(file.path(etcMenus, "Rcmdr-menus.txt"), colClasses = "character")
	addMenus <- function(Menus){
		removeMenus <- function(what){
			children <- Menus[Menus[,3] == what, 2]
			which <- what == Menus[,2] |  what == Menus[,5]
			Menus <<- Menus[!which,]
			for (child in children) removeMenus(child)
		}
		nms <- c("type", "menuOrItem", "operationOrParent", "label",
			"commandOrMenu", "activation", "install")
		names(Menus) <- nms
		for (plugin in Plugins) {
			MenusToAdd <- read.table(file.path(.path.package(package=plugin)[1], "etc/menus.txt"),
				colClasses = "character")
			names(MenusToAdd) <- nms
			for (i in 1:nrow(MenusToAdd)){
				line <- MenusToAdd[i,]
				if (line[1, "type"] == "remove"){
					##					which <- line[1, "menuOrItem"] == Menus[,2] | line[1, "menuOrItem"] == Menus[,3] | line[1, "menuOrItem"] == Menus[,5]
					##					Menus <- Menus[!which,]
					removeMenus(line[1, "menuOrItem"])
					next
				}
				if (line[1, "type"] == "menu"){
					where <- if (line[1, "operationOrParent"] == "topMenu") 0
						else max(which((Menus[, "type"] == "menu") &
										(Menus[, "menuOrItem"] == line[1, "operationOrParent"])))
				}
				else if (line[1, "type"] == "item"){
					if (line[1, "operationOrParent"] == "command"){
						which <- which((Menus[, "operationOrParent"] == "command") &
								(Menus[, "menuOrItem"] == line[1, "menuOrItem"]))
						where <- if (length(which) == 0)
								which((Menus[, "type"] == "menu")
										& (Menus[, "menuOrItem"] == line[1, "menuOrItem"]))
							else max(which)
					}
					else if (line[1, "operationOrParent"] == "cascade"){
						where <- if (line[1, "menuOrItem"] != "topMenu")
								max(which((Menus[, "operationOrParent"] == "cascade") &
											(Menus[, "menuOrItem"] == line[1, "menuOrItem"]) | (Menus[, "commandOrMenu"] == line[1, "menuOrItem"])))
							else {
								max(which((Menus[, "operationOrParent"] == "cascade") &
											(Menus[, "menuOrItem"] == "topMenu") &
											(Menus[, "commandOrMenu"] != "toolsMenu") &
											(Menus[, "commandOrMenu"] != "helpMenu")))
							}
					}
					else stop(sprintf(gettextRcmdr('unrecognized operation, "%s", in plugin menu line %i'),
								line[1, "operation"], i))
				}
				else stop(sprintf(gettextRcmdr('unrecognized type, "%s", in plugin menu line %i'),
							line[1, "type"], i))
				Menus <- insertRows(Menus, line, where)
			}
		}
		Menus
	}
	Menus <- addMenus(Menus)
	menuNames <- Menus[Menus[,1] == "menu",]
	duplicateMenus <- duplicated(menuNames)
	if (any(duplicateMenus)) stop(paste(gettextRcmdr("Duplicate menu names:"),
				menuNames[duplicateMenus]))
	.Menus <- menus <- list()
	menuItems <- 0
	oldMenu <- ncol(Menus) == 6
	setOption("suppress.menus", FALSE)
	## added by EN ###############################
	if (RExcelSupported())
		putRExcel(".rexcel.menu.dataframe", Menus)
	## end of change ###############################
	##    exceptions <- scan(file.path(etc, "log-exceptions.txt"), what="", quiet=TRUE, comment.char="#")
	## added by EN ###############################
	##   	putRcmdr("Commander.Input.exceptions", exceptions)
	## end of change ###############################
	modelClasses <- scan(file.path(etc, "model-classes.txt"), what="", quiet=TRUE, comment.char="#")
	for (plugin in Plugins){
		description <- readLines(file.path(.path.package(package=plugin)[1], "DESCRIPTION"))
		##        addExceptions <- description[grep("Log-Exceptions:", description)]
		##        addExceptions <- gsub(" ", "", sub("^Log-Exceptions:", "", addExceptions))
		##        addExceptions <- unlist(strsplit(addExceptions, ","))
		addModels <- description[grep("Models:", description)]
		addModels <- gsub(" ", "", sub("^Models:", "", addModels))
		addModels <- unlist(strsplit(addModels, ","))
		##        if (length(addExceptions) > 0) exceptions <- c(exceptions, addExceptions)
		if (length(addModels) > 0) modelClasses <- c(modelClasses, addModels)
	}
	putRcmdr("modelClasses", modelClasses)
	onEdit <- function(){
		if (activeDataSet() == FALSE) {
			tkfocus(CommanderWindow())
			return()
		}
		command <- paste("fix(", ActiveDataSet(), ")", sep="")
		logger(command)
		justDoIt(command)
		activeDataSet(ActiveDataSet())
		tkwm.deiconify(CommanderWindow())
		tkfocus(CommanderWindow())
	}
	onView <- function(){
		if (packageAvailable("relimp")) Library("relimp")
		if (activeDataSet() == FALSE) {
			tkfocus(CommanderWindow())
			return()
		}
		suppress <- if(getRcmdr("suppress.X11.warnings")) ", suppress.X11.warnings=FALSE" else ""
		view.height <- max(as.numeric(output.height) + as.numeric(log.height), 10)
		ncols <- ncol(get(ActiveDataSet()))
#        ncols <- eval(parse(text=paste("ncol(", ActiveDataSet(), ")")))
		command <- if (packageAvailable("relimp") && ncols <= getRcmdr("showData.threshold")){
				paste("showData(", ActiveDataSet(), ", placement='-20+200', font=getRcmdr('logFont'), maxwidth=",
					log.width, ", maxheight=", view.height, suppress, ")", sep="")
			}
			else paste("View(", ActiveDataSet(), ")", sep="")
		logger(command)
		justDoIt(command)
#        tkwm.deiconify(CommanderWindow())
#        tkfocus(CommanderWindow())
	}
	# the following function modified 14 July 07 by Erich Neuwirth
	onSubmit <- function(){
		.log <- LogWindow()
		selection <- strsplit(tclvalue(tktag.ranges(.log, "sel")), " ")[[1]]
		if (is.na(selection[1])) {
			tktag.add(.log, "currentLine", "insert linestart", "insert lineend")
			selection <- strsplit(tclvalue(tktag.ranges(.log,"currentLine")), " ")[[1]]
			tktag.delete(.log, "currentLine")
			if (is.na(selection[1])) {
				Message(message=gettextRcmdr("Nothing is selected."),
					type="error")
				tkfocus(CommanderWindow())
				return()
			}
		}
		lines <- tclvalue(tkget(.log, selection[1], selection[2]))
		lines <- strsplit(lines, "\n")[[1]]
		.console.output <- getRcmdr("console.output")
		.output <- OutputWindow()
		iline <- 1
		nlines <- length(lines)
		while (iline <= nlines){
			while (nchar(lines[iline])==0) iline <- iline + 1
			if (iline > nlines) break
			current.line <- lines[iline]
			if (.console.output) cat(paste("\n", getRcmdr("prefixes")[1], current.line,"\n", sep=""))
			else{
				tkinsert(.output, "end", paste("\n> ", current.line,"\n", sep="")) ### end of changed
				tktag.add(.output, "currentLine", "end - 2 lines linestart", "end - 2 lines lineend")
				tktag.configure(.output, "currentLine", foreground=getRcmdr("command.text.color"))
			}
			jline <- iline + 1
			while (jline <= nlines){
				if (class(try(parse(text=current.line),silent=TRUE))!="try-error") break
				if (.console.output)cat(paste(getRcmdr("prefixes")[2], lines[jline],"\n", sep=""))
				else{
					tkinsert(.output, "end", paste("+ ", lines[jline],"\n", sep=""))
					tktag.add(.output, "currentLine", "end - 2 lines linestart", "end - 2 lines lineend")
					tktag.configure(.output, "currentLine", foreground=getRcmdr("command.text.color"))
				}
				current.line <- paste(current.line, lines[jline],sep="\n")
				jline <- jline + 1
				iline <- iline + 1
			}
			if (!(is.null(current.line) || is.na(current.line))) doItAndPrint(current.line, log=FALSE)
			iline <- iline + 1
			tkyview.moveto(.output, 1)
			tkfocus(.log)
		}
	}
	contextMenuLog <- function(){
		.log <- LogWindow()
		contextMenu <- tkmenu(tkmenu(.log), tearoff=FALSE)
		tkadd(contextMenu, "command", label=gettextRcmdr("Submit"), command=onSubmit)
		tkadd(contextMenu, "command", label=gettextRcmdr("Cut"), command=onCut)
		tkadd(contextMenu, "command", label=gettextRcmdr("Copy"), command=onCopy)
		tkadd(contextMenu, "command", label=gettextRcmdr("Paste"), command=onPaste)
		tkadd(contextMenu, "command", label=gettextRcmdr("Delete"), command=onDelete)
		tkadd(contextMenu, "command", label=gettextRcmdr("Find..."), command=onFind)
		tkadd(contextMenu, "command", label=gettextRcmdr("Select all"), command=onSelectAll)
		tkadd(contextMenu, "command", label=gettextRcmdr("Undo"), command=onUndo)
		tkadd(contextMenu, "command", label=gettextRcmdr("Redo"), command=onRedo)
		tkadd(contextMenu, "command", label=gettextRcmdr("Clear window"), command=onClear)
		tkpopup(contextMenu, tkwinfo("pointerx", .log), tkwinfo("pointery", .log))
	}
	contextMenuOutput <- function(){
		.output <- OutputWindow()
		contextMenu <- tkmenu(tkmenu(.output), tearoff=FALSE)
		tkadd(contextMenu, "command", label=gettextRcmdr("Cut"), command=onCut)
		tkadd(contextMenu, "command", label=gettextRcmdr("Copy"), command=onCopy)
		tkadd(contextMenu, "command", label=gettextRcmdr("Paste"), command=onPaste)
		tkadd(contextMenu, "command", label=gettextRcmdr("Delete"), command=onDelete)
		tkadd(contextMenu, "command", label=gettextRcmdr("Find..."), command=onFind)
		tkadd(contextMenu, "command", label=gettextRcmdr("Select all"), command=onSelectAll)
		tkadd(contextMenu, "command", label=gettextRcmdr("Undo"), command=onUndo)
		tkadd(contextMenu, "command", label=gettextRcmdr("Redo"), command=onRedo)
		tkadd(contextMenu, "command", label=gettextRcmdr("Clear window"), command=onClear)
		tkpopup(contextMenu, tkwinfo("pointerx", .output), tkwinfo("pointery", .output))
	}
	contextMenuMessages <- function(){
		.messages <- MessagesWindow()
		contextMenu <- tkmenu(tkmenu(.messages), tearoff=FALSE)
		tkadd(contextMenu, "command", label=gettextRcmdr("Cut"), command=onCut)
		tkadd(contextMenu, "command", label=gettextRcmdr("Copy"), command=onCopy)
		tkadd(contextMenu, "command", label=gettextRcmdr("Paste"), command=onPaste)
		tkadd(contextMenu, "command", label=gettextRcmdr("Delete"), command=onDelete)
		tkadd(contextMenu, "command", label=gettextRcmdr("Find..."), command=onFind)
		tkadd(contextMenu, "command", label=gettextRcmdr("Select all"), command=onSelectAll)
		tkadd(contextMenu, "command", label=gettextRcmdr("Undo"), command=onUndo)
		tkadd(contextMenu, "command", label=gettextRcmdr("Redo"), command=onRedo)
		tkadd(contextMenu, "command", label=gettextRcmdr("Clear window"), command=onClear)
		tkpopup(contextMenu, tkwinfo("pointerx", .messages), tkwinfo("pointery", .messages))
	}
	if (getRcmdr("crisp.dialogs")) tclServiceMode(on=FALSE)
	putRcmdr("commanderWindow", tktoplevel())
	.commander <- CommanderWindow()
#    tkwm.withdraw(.commander)
	tkwm.geometry(.commander, placement)
	tkwm.title(.commander, gettextRcmdr("R Commander"))
	tkwm.protocol(.commander, "WM_DELETE_WINDOW", CloseCommander)
	topMenu <- tkmenu(.commander)
	tkconfigure(.commander, menu=topMenu)
	position <- numeric(0)
	if (!getRcmdr("suppress.menus")){
		for (m in 1:nrow(Menus)){
			install <- if (oldMenu) "" else Menus[m, 7]
			if ((install != "") && (!eval(parse(text=install)))) next
			if (Menus[m, 1] == "menu") {
				position[Menus[m, 2]] <- 0
				assign(Menus[m, 2], tkmenu(get(Menus[m, 3]), tearoff=FALSE))
#                assign(Menus[m, 2], tkmenu(eval(parse(text=Menus[m, 3])), tearoff=FALSE))
				menus[[Menus[m, 2]]] <- list(ID=get(Menus[m, 2])$ID, position=0)
			}
			else if (Menus[m, 1] == "item") {
				if (Menus[m, 3] == "command"){
					position[Menus[m, 2]] <- position[Menus[m, 2]] + 1
					if (Menus[m, 6] == "")
						tkadd(get(Menus[m, 2]), "command", label=gettextMenus(Menus[m, 4]),
							command=get(Menus[m, 5]))
#                        tkadd(eval(parse(text=Menus[m, 2])),"command", label=gettextRcmdr(Menus[m, 4]),
#                            command=eval(parse(text=Menus[m, 5])))
					else {
						tkadd(get(Menus[m, 2]), "command", label=gettextMenus(Menus[m, 4]),
							command=get(Menus[m, 5]), state="disabled")
#                        tkadd(eval(parse(text=Menus[m, 2])),"command", label=gettextRcmdr(Menus[m, 4]),
#                            command=eval(parse(text=Menus[m, 5])),  state="disabled")
						menuItems <- menuItems + 1
						menus[[Menus[m, 2]]]$position <- position[Menus[m, 2]]
						.Menus[[menuItems]] <- list(ID=menus[[Menus[m, 2]]]$ID, position=position[Menus[m, 2]],
							activation=eval(parse(text=paste("function()", Menus[m, 6]))))
					}
				}
				else if (Menus[m, 3] == "cascade")
					tkadd(get(Menus[m, 2]), "cascade", label=gettextMenus(Menus[m, 4]),
						menu=get(Menus[m, 5]))
#                    tkadd(eval(parse(text=Menus[m, 2])),"cascade", label=gettextRcmdr(Menus[m, 4]),
#                        menu=eval(parse(text=Menus[m, 5])))
				else stop(paste(gettextRcmdr("menu definition error:"), Menus[m, ], collapse=" "),
						domain=NA)
			}
			else stop(paste(gettextRcmdr("menu definition error:"), Menus[m, ], collapse=" "),
					domain=NA)
		}
	}
	putRcmdr("Menus", .Menus)
	putRcmdr("autoRestart", FALSE)
	activateMenus()
	controlsFrame <- tkframe(CommanderWindow())
	editButton <- buttonRcmdr(controlsFrame, text=gettextRcmdr("Edit data set"), command=onEdit)
	viewButton <- buttonRcmdr(controlsFrame, text=gettextRcmdr("View data set"), command=onView)
	putRcmdr("dataSetName", tclVar(gettextRcmdr("<No active dataset>")))
	putRcmdr("dataSetLabel", tkbutton(controlsFrame, textvariable=getRcmdr("dataSetName"), foreground="red",
			relief="groove", command=selectActiveDataSet))
	logFrame <- tkframe(CommanderWindow())
	putRcmdr("logWindow", tktext(logFrame, bg="white", foreground=getRcmdr("log.text.color"),
			font=getRcmdr("logFont"), height=log.height, width=log.width, wrap="none", undo=TRUE))
	.log <- LogWindow()
	logXscroll <- ttkscrollbar(logFrame, orient="horizontal",
		command=function(...) tkxview(.log, ...))
	logYscroll <- ttkscrollbar(logFrame,
		command=function(...) tkyview(.log, ...))
	tkconfigure(.log, xscrollcommand=function(...) tkset(logXscroll, ...))
	tkconfigure(.log, yscrollcommand=function(...) tkset(logYscroll, ...))
	outputFrame <- tkframe(.commander)
	submitIm <- tcl("image", "create", "bitmap", file=file.path(etc, "submit.xbm"))
	if (getRcmdr("console.output"))
		submitButton <- if (English()) buttonRcmdr(logFrame, image=submitIm,
					borderwidth="2", command=onSubmit)
			else buttonRcmdr(logFrame, text=gettextRcmdr("Submit"), borderwidth="2", command=onSubmit)
	else submitButton <- if (English()) buttonRcmdr(outputFrame, image=submitIm,
					borderwidth="2", command=onSubmit)
			else buttonRcmdr(outputFrame, text=gettextRcmdr("Submit"), borderwidth="2", command=onSubmit)
	putRcmdr("outputWindow", tktext(outputFrame, bg="white", foreground=getRcmdr("output.text.color"),
			font=getRcmdr("logFont"), height=output.height, width=log.width, wrap="none", undo=TRUE))
	.output <- OutputWindow()
	outputXscroll <- ttkscrollbar(outputFrame, orient="horizontal",
		command=function(...) tkxview(.output, ...))
	outputYscroll <- ttkscrollbar(outputFrame,
		command=function(...) tkyview(.output, ...))
	tkconfigure(.output, xscrollcommand=function(...) tkset(outputXscroll, ...))
	tkconfigure(.output, yscrollcommand=function(...) tkset(outputYscroll, ...))
	messagesFrame <- tkframe(.commander)
	putRcmdr("messagesWindow", tktext(messagesFrame, bg="lightgray",
			font=getRcmdr("logFont"), height=messages.height, width=log.width, wrap="none", undo=TRUE))
	.messages <- MessagesWindow()
	messagesXscroll <- ttkscrollbar(messagesFrame, orient="horizontal",
		command=function(...) tkxview(.messages, ...))
	messagesYscroll <- ttkscrollbar(messagesFrame,
		command=function(...) tkyview(.messages, ...))
	tkconfigure(.messages, xscrollcommand=function(...) tkset(messagesXscroll, ...))
	tkconfigure(.messages, yscrollcommand=function(...) tkset(messagesYscroll, ...))
	putRcmdr("modelName", tclVar(gettextRcmdr("<No active model>")))
	putRcmdr("modelLabel", tkbutton(controlsFrame, textvariable=getRcmdr("modelName"), foreground="red",
			relief="groove", command=selectActiveModel))
	show.edit.button <- options("Rcmdr")[[1]]$show.edit.button
	show.edit.button <- if (is.null(show.edit.button)) TRUE else show.edit.button
	if (!getRcmdr("suppress.menus")){
		RcmdrIm <- tcl("image", "create", "bitmap", file=file.path(etc, "Rcmdr.xbm"), foreground="red")
		tkgrid(labelRcmdr(controlsFrame, image=RcmdrIm),
			labelRcmdr(controlsFrame, text=gettextRcmdr("Data set:")), getRcmdr("dataSetLabel"),
			labelRcmdr(controlsFrame, text="  "), if(show.edit.button) editButton, viewButton,
			labelRcmdr(controlsFrame, text=gettextRcmdr("    Model: ")), getRcmdr("modelLabel"), sticky="w")
		tkgrid(controlsFrame, sticky="w")
	}
	.log.commands <-  getRcmdr("log.commands")
	.console.output <- getRcmdr("console.output")
	if (.log.commands) tkgrid(labelRcmdr(logFrame, text=gettextRcmdr("Script Window"), foreground="blue"),
			if (.log.commands && .console.output) submitButton, sticky="w")
	tkgrid(.log, logYscroll, sticky="news", columnspan=2)
	tkgrid(logXscroll)
	if (.log.commands) tkgrid(logFrame, sticky="news", padx=10, pady=0, columnspan=2)
	tkgrid(labelRcmdr(outputFrame, text=gettextRcmdr("Output Window"), foreground="blue"),
		if (.log.commands && !.console.output) submitButton, sticky="w")
	tkgrid(.output, outputYscroll, sticky="news", columnspan=2)
	tkgrid(outputXscroll, columnspan=1 + (.log.commands && !.console.output))
	if (!.console.output) tkgrid(outputFrame, sticky="news", padx=10, pady=0, columnspan=2)
	tkgrid(labelRcmdr(messagesFrame, text=gettextRcmdr("Messages"), foreground=getRcmdr("error.text.color")), sticky="w")
	tkgrid(.messages, messagesYscroll, sticky="news", columnspan=2)
	tkgrid(messagesXscroll)
	if (!.console.output) tkgrid(messagesFrame, sticky="news", padx=10, pady=0, columnspan=2) ##rmh & J. Fox
	tkgrid.configure(logYscroll, sticky="ns")
	tkgrid.configure(logXscroll, sticky="ew")
	tkgrid.configure(outputYscroll, sticky="ns")
	tkgrid.configure(outputXscroll, sticky="ew")
	tkgrid.configure(messagesYscroll, sticky="ns")
	tkgrid.configure(messagesXscroll, sticky="ew")
	.commander <- CommanderWindow()
	tkgrid.rowconfigure(.commander, 0, weight=0)
	tkgrid.rowconfigure(.commander, 1, weight=1)
	tkgrid.rowconfigure(.commander, 2, weight=1)
	tkgrid.columnconfigure(.commander, 0, weight=1)
	tkgrid.columnconfigure(.commander, 1, weight=0)
	if (.log.commands){
		tkgrid.rowconfigure(logFrame, 0, weight=0)
		tkgrid.rowconfigure(logFrame, 1, weight=1)
		tkgrid.rowconfigure(logFrame, 2, weight=0)
		tkgrid.columnconfigure(logFrame, 0, weight=1)
		tkgrid.columnconfigure(logFrame, 1, weight=0)
	}
	if (!.console.output){
		tkgrid.rowconfigure(outputFrame, 0, weight=0)
		tkgrid.rowconfigure(outputFrame, 1, weight=1)
		tkgrid.rowconfigure(outputFrame, 2, weight=0)
		tkgrid.columnconfigure(outputFrame, 0, weight=1)
		tkgrid.columnconfigure(outputFrame, 1, weight=0)
	}
	tkgrid.rowconfigure(messagesFrame, 0, weight=0)
	tkgrid.rowconfigure(messagesFrame, 1, weight=0)
	tkgrid.rowconfigure(messagesFrame, 2, weight=0)
	tkgrid.columnconfigure(messagesFrame, 0, weight=1)
	tkgrid.columnconfigure(messagesFrame, 1, weight=0)
	.Tcl("update idletasks")
	tkbind(.commander, "<Control-x>", onCut)
	tkbind(.commander, "<Control-X>", onCut)
	tkbind(.commander, "<Control-c>", onCopy)
	tkbind(.commander, "<Control-C>", onCopy)
#	if (.Platform$OS.type != "windows"){
#		tkbind(.commander, "<Control-v>", onPaste)
#		tkbind(.commander, "<Control-V>", onPaste)
#		tkbind(.commander, "<Alt-BackSpace>", onUndo)
#	}
	tkbind(.commander, "<Control-r>", onSubmit)
	tkbind(.commander, "<Control-R>", onSubmit)
	tkbind(.commander, "<Control-Tab>", onSubmit)
	tkbind(.commander, "<Control-f>", onFind)
	tkbind(.commander, "<Control-F>", onFind)
	tkbind(.commander, "<Control-s>", saveLog)
	tkbind(.commander, "<Control-S>", saveLog)
	tkbind(.commander, "<Control-a>", onSelectAll)
	tkbind(.commander, "<Control-A>", onSelectAll)
	tkbind(.commander, "<Control-w>", onRedo)
	tkbind(.commander, "<Control-W>", onRedo)
	tkbind(.commander, "<Alt-BackSpace>", onUndo)
	tkbind(.log, "<ButtonPress-3>", contextMenuLog)
	tkbind(.output, "<ButtonPress-3>", contextMenuOutput)
	tkbind(.messages, "<ButtonPress-3>", contextMenuMessages)
	tkwm.deiconify(.commander)
	tkfocus(.commander)
	if (getRcmdr("crisp.dialogs")) tclServiceMode(on=TRUE)
	tkwait <- options("Rcmdr")[[1]]$tkwait  # to address problem in Debian Linux
	if ((!is.null(tkwait)) && tkwait) {
		.commander.done <<- tclVar("0")
		tkwait.variable(.commander.done)
	}
	##    if (!packageAvailable("rgl")) Message(gettextRcmdr("The rgl package is absent; 3D plots are unavailable."), type="warning")
	Message(paste(gettextRcmdr("R Commander Version "), getRcmdr("RcmdrVersion"), ": ", date(), sep=""))
	if (.Platform$GUI == "Rgui"  && ismdi()) Message(gettextRcmdr(
				"The Windows version of the R Commander works best under RGui\nwith the single-document interface (SDI); see ?Commander."),
			type="warning")
}


# the following function modified 24 July 07 by Richard Heiberger
#  and subsequently by J. Fox 26 July 07
# last modified 10 January 2010 by J. Fox

logger <- function(command){
	pushCommand(command)
	if (is.SciViews()) return(svlogger(command))    # +PhG
	.log <- LogWindow()
	.output <- OutputWindow()
	command <- splitCmd(command)
	if (getRcmdr("log.commands")) {
		last2 <- tclvalue(tkget(.log, "end -2 chars", "end"))
		if (last2 != "\n\n") tkinsert(.log, "end", "\n")
		tkinsert(.log, "end", paste(command,"\n", sep=""))
		tkyview.moveto(.log, 1)
	}
	lines <- strsplit(command, "\n")[[1]]
	tkinsert(.output, "end", "\n")
	if (getRcmdr("console.output")) {
		for (line in seq(along.with=lines)) {
			prompt <- ifelse (line==1, paste("\n", getRcmdr("prefixes")[1], sep=""), paste("\n", getRcmdr("prefixes")[2], sep=""))
			cat(paste(prompt, lines[line]))  ##rmh
		}
		cat("\n")                          ##rmh
	}
	else {
		for (line in  seq(along.with=lines)) {
			prompt <- ifelse(line==1, "> ", "+ ")
			tkinsert(.output, "end", paste(prompt, lines[line], "\n", sep=""))
			tktag.add(.output, "currentLine", "end - 2 lines linestart", "end - 2 lines lineend")
			tktag.configure(.output, "currentLine", foreground=getRcmdr("command.text.color"))
			tkyview.moveto(.output, 1)
		}
	}
	command
}

justDoIt <- function(command) {
	Message()
	if (!getRcmdr("suppress.X11.warnings")){
		messages.connection <- file(open="w+")
		sink(messages.connection, type="message")
		on.exit({
				sink(type="message")
				close(messages.connection)
			})
	}
	else messages.connection <- getRcmdr("messages.connection")
	capture.output(result <- try(eval(parse(text=command), envir=.GlobalEnv), silent=TRUE))
	if (class(result)[1] ==  "try-error"){
		Message(message=paste(strsplit(result, ":")[[1]][2]), type="error")
		tkfocus(CommanderWindow())
		return(result)
	}
	checkWarnings(readLines(messages.connection))
	result
}

doItAndPrint <- function(command, log=TRUE) {
	# with modifications from Duncan Murdoch 4 Jan 08
	Message()
	.console.output <- getRcmdr("console.output")
	.output <- OutputWindow()
	if (!.console.output) {
		width <- (as.numeric(tkwinfo("width", .output)) - 2*as.numeric(tkcget(.output, borderwidth=NULL)) - 2)/
			as.numeric(tkfont.measure(tkcget(.output, font=NULL), "0"))
		eval(parse(text=paste("options(width=", floor(width), ")", sep="")))
	}
	if (!getRcmdr("suppress.X11.warnings")){
		messages.connection <- file(open="w+")
		sink(messages.connection, type="message")
		on.exit({
				sink(type="message")
				close(messages.connection)
			})
	}
	else messages.connection <- getRcmdr("messages.connection")
	output.connection <- file(open="w+")
	sink(output.connection, type="output")
	on.exit({
			if (!.console.output) sink(type="output") # if .console.output, output connection already closed
			close(output.connection)
		}, add=TRUE)
	if (log) logger(command) else pushCommand(command)
	result <- try(parse(text=paste(command)), silent=TRUE)
	if (class(result)[1] == "try-error"){
		Message(message=paste(strsplit(result, ":")[[1]][2]), type="error")
		if (.console.output) sink(type="output")
		tkfocus(CommanderWindow())
		return(result)
	} else {
		exprs <- result
		result <- NULL
	}
	for (i in seq_along(exprs)) {
		ei <- exprs[i]
		result <-  try(withVisible(eval(ei, envir=.GlobalEnv)), silent=TRUE)
		if (class(result)[1] ==  "try-error"){
			Message(message=paste(strsplit(result, ":")[[1]][2]), type="error")
			if (.console.output) sink(type="output")
			tkfocus(CommanderWindow())
			return(result)
		}
		result <- if (result$visible == FALSE) NULL else result$value
		if (!is.null(result)) pushOutput(result)
		if (isS4object(result)) show(result) else print(result)
		.Output <- readLines(output.connection)
		if (length(.Output) > 0 && .Output[length(.Output)] == "NULL")
			.Output <- .Output[-length(.Output)] # suppress "NULL" line at end of output
		if (length(.Output) != 0) {  # is there output to print?
			if (.console.output) {
				out <- .Output
				sink(type="output")
				for (line in out) cat(paste(line, "\n", sep=""))
			}
			else{
				for (line in .Output) tkinsert(.output, "end", paste(line, "\n", sep=""))
				tkyview.moveto(.output, 1)
			}
		}
		else if (.console.output) sink(type="output")
		###### added by EN  ######################
		if (RExcelSupported())
			putRExcel(".rexcel.last.output",.Output)
		###### end of change  #####################
		# errors already intercepted, display any warnings
		checkWarnings(readLines(messages.connection))
	}
	result
}

checkWarnings <- function(messages){
	if (getRcmdr("suppress.X11.warnings")){
#		X11.warning <- grep("^Warning\\: X11 protocol error\\: BadWindow \\(invalid Window parameter\\)",
#			messages)
		X11.warning <- grep("X11 protocol error|Warning in structure", messages)
		if (length(X11.warning) > 0){
			messages <- messages[-X11.warning]
		}
		if (length(messages) == 0) Message()
		else if (length(messages) > 10) {
			messages <- c(paste(length(messages), "warnings."),
				gettextRcmdr("First and last 5 warnings:"),
				head(messages,5), ". . .", tail(messages, 5))
			Message(message=paste(messages, collapse="\n"), type="warning")
		}
		else {
			if (length(grep("warning", messages, ignore.case=TRUE)) > 0)
				Message(message=paste(messages, collapse="\n"), type="warning")
			else Message(message=paste(messages, collapse="\n"), type="note")
		}
	}
	else{
		if (length(messages) == 0) Message()
		else if (length(messages) > 10){
			messages <- c(paste(length(messages), "warnings."),
				gettextRcmdr("First and last 5 warnings:"),
				head(messages, 5), ". . .", tail(messages, 5))
			Message(message=paste(messages, collapse="\n"), type="warning")
		}
		else {
			if (length(grep("warning", messages, ignore.case=TRUE)) > 0)
				Message(message=paste(messages, collapse="\n"), type="warning")
			else Message(message=paste(messages, collapse="\n"), type="note")
		}
	}
	tkfocus(CommanderWindow())
}

pause <- function(seconds = 1){
	if (seconds <= 0) stop("seconds must be positive")
	start <- proc.time()[3]
	while (as.numeric(elapsed <- (proc.time()[3] - start)) < seconds) {}
	elapsed
}

Message <- function(message, type=c("note", "error", "warning")){
	if (is.SciViews()) return(svMessage(message, type))    # +PhG
	tcl("update") 
	.message <- MessagesWindow()
	type <- match.arg(type)
	if (type != "note") tkbell()
	if (getRcmdr("retain.messages")) {
#		if (!missing(message)) tkinsert(.message, "end", "\n")
#		else if (!is.null(getRcmdr("last.message"))) {
		if (missing(message) && !is.null(getRcmdr("last.message"))) {
#			tkinsert(.message, "end", "\n\n")
			putRcmdr("last.message", NULL)
			tkyview.moveto(.message, 1.0)
		}
	}
	else if (type == "note"){
		lastMessage <- tclvalue(tkget(MessagesWindow(),  "end - 2 lines", "end"))
		if (length(c(grep(gettextRcmdr("ERROR:"), lastMessage), grep(gettextRcmdr("WARNING:"), lastMessage))) == 0)
			tkdelete(.message, "1.0", "end")
	}
	else tkdelete(.message, "1.0", "end")
	col <- if (type == "error") getRcmdr("error.text.color")
		else if (type == "warning") getRcmdr("warning.text.color")
		else getRcmdr("output.text.color")
	prefix <- switch(type, error=gettextRcmdr("ERROR"), warning=gettextRcmdr("WARNING"), note=gettextRcmdr("NOTE"))
	if (missing(message)){
		return()
	}
	putRcmdr("last.message", type)
	message <- paste(prefix, ": ", message, sep="")
	if (getRcmdr("retain.messages") && getRcmdr("number.messages")) {
		messageNumber <- getRcmdr("messageNumber") + 1
		putRcmdr("messageNumber", messageNumber)
		message <- paste("[", messageNumber, "] ", message, sep="")
	}
	######### added by EN #####################
	if (RExcelSupported())
		putRExcel(".rexcel.last.message",message)
	######### end of change ###############
	lines <- strsplit(message, "\n")[[1]]
	
	######### added by rmh #####################                   ##rmh
	if (console.output) {                                        ##rmh & J. Fox
		if (sink.number() != 0) sink()							## fixed by J. Fox
		for (jline in seq(along.with=lines)) {                            ##rmh
			Header <- if (jline==1) getRcmdr("prefixes")[3] else getRcmdr("prefixes")[4]     ##rmh
			cat(paste(Header, lines[jline], "\n", sep=""))             ##rmh
		}                                                            ##rmh
	}                                                              ##rmh
	else                                                           ##rmh
		######### end of change ###############                        ##rmh
		
		for (line in lines){
			tagName <- messageTag()
			tkinsert(.message, "end", paste(line, "\n", sep=""))
			tktag.add(.message, tagName, "end - 2 lines linestart", "end - 2 lines lineend")
			tktag.configure(.message, tagName, foreground=col)
			tkyview.moveto(.message, 1.0)
		}
}

messageTag <- function(reset=FALSE){
	if (reset){
		putRcmdr("tagNumber", 0)
		return()
	}
	tagNumber <- getRcmdr("tagNumber") + 1
	putRcmdr("tagNumber", tagNumber)
	paste("message", tagNumber, sep="")
}

pushOutput <- function(element) {
	stack <- getRcmdr("outputStack")
	stack <- c(list(element), stack[-getRcmdr("length.output.stack")])
	putRcmdr("outputStack", stack)
}

popOutput <- function(){
	stack <- getRcmdr("outputStack")
	lastOutput <- stack[[1]]
	putRcmdr("outputStack", c(stack[-1], NA))
	lastOutput
}

pushCommand <- function(element) {
	stack <- getRcmdr("commandStack")
	stack <- c(list(element), stack[-getRcmdr("length.command.stack")])
	putRcmdr("commandStack", stack)
}

popCommand <- function(){
	stack <- getRcmdr("commandStack")
	lastCommand <- stack[[1]]
	putRcmdr("commandStack", c(stack[-1], NA))
	lastCommand
}
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/data-menu.R"
# last modified 21 September 2010 by J. Fox

# Data menu dialogs

newDataSet <- function() {
	initializeDialog(title=gettextRcmdr("New Data Set"))
	dsname <- tclVar(gettextRcmdr("Dataset"))
	entryDsname <- ttkentry(top, width="20", textvariable=dsname)
	onOK <- function(){
		dsnameValue <- trim.blanks(tclvalue(dsname))
		if (dsnameValue == "") {
			errorCondition(recall=newDataSet,
				message=gettextRcmdr("You must enter the name of a data set."))
			return()
		}
		if (!is.valid.name(dsnameValue)) {
			errorCondition(recall=newDataSet,
				message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (is.element(dsnameValue, listDataSets())) {
			if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
				newDataSet()
				return()
			}
		}
		command <- "edit(as.data.frame(NULL))"
		result <- justDoIt(command)
		result <- as.data.frame(lapply(result, function(x) if (is.character(x)) factor(x) else x))
		if (class(result)[1] !=  "try-error"){ 
			assign(dsnameValue, result, envir=.GlobalEnv)
			logger(paste(dsnameValue, "<-", command))
			if (nrow(get(dsnameValue)) == 0){
				#        	if (eval(parse(text=paste("nrow(", dsnameValue, ")"))) == 0){
				errorCondition(recall=newDataSet, message=gettextRcmdr("empty data set."))
				return()
			}
			activeDataSet(dsnameValue)
		}
		closeDialog()
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="edit.data.frame")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("Enter name for data set:")), entryDsname, sticky="e")
	tkgrid(buttonsFrame, columnspan="2", sticky="w")
	tkgrid.configure(entryDsname, sticky="w")
	dialogSuffix(rows=2, columns=2, focus=entryDsname)
}

selectActiveDataSet <- function(){
	dataSets <- listDataSets()
	.activeDataSet <- ActiveDataSet()
	if ((length(dataSets) == 1) && !is.null(.activeDataSet)) {
		Message(message=gettextRcmdr("There is only one dataset in memory."),
			type="warning")
		tkfocus(CommanderWindow())
		return()
	}
	if (length(dataSets) == 0){
		Message(message=gettextRcmdr("There are no data sets from which to choose."),
			type="error")
		tkfocus(CommanderWindow())
		return()
	}
	initializeDialog(title=gettextRcmdr("Select Data Set"))
	dataSetsBox <- variableListBox(top, dataSets, title=gettextRcmdr("Data Sets (pick one)"),
		initialSelection=if (is.null(.activeDataSet)) NULL else which(.activeDataSet == dataSets) - 1)
	onOK <- function(){
		activeDataSet(getSelection(dataSetsBox))
		closeDialog()
		tkfocus(CommanderWindow())
	}
	OKCancelHelp()
	tkgrid(getFrame(dataSetsBox), sticky="nw")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=2, columns=1)
}

listDataSetsInPackages <- function() doItAndPrint("data()")

Recode <- function(){
	require("car")
	processRecode <- function(recode){
		parts <- strsplit(recode, "=")[[1]]
		if (length(grep(",", parts[1])) > 0) paste("c(", parts[1], ") = ", parts[2], sep="")
		else paste(parts, collapse="=")
	}
	dataSet <- activeDataSet()
	initializeDialog(title=gettextRcmdr("Recode Variables"))
	variablesBox <- variableListBox(top, Variables(),
		selectmode="multiple", title=gettextRcmdr("Variables to recode (pick one or more)"))
	variablesFrame <- tkframe(top)
	newVariableName <- tclVar(gettextRcmdr("variable"))
	newVariable <- ttkentry(variablesFrame, width="20", textvariable=newVariableName)
	recodesFrame <- tkframe(top)
	recodes <- tktext(recodesFrame, bg="white", font=getRcmdr("logFont"),
		height="5", width="40", wrap="none")
	recodesXscroll <- ttkscrollbar(recodesFrame, orient="horizontal",
		command=function(...) tkxview(recodes, ...))
	recodesYscroll <- ttkscrollbar(recodesFrame,
		command=function(...) tkyview(recodes, ...))
	tkconfigure(recodes, xscrollcommand=function(...) tkset(recodesXscroll, ...))
	tkconfigure(recodes, yscrollcommand=function(...) tkset(recodesYscroll, ...))
	asFactorFrame <- tkframe(top)
	asFactorVariable <- tclVar("1")
	asFactorCheckBox <- tkcheckbutton(asFactorFrame, variable=asFactorVariable)
	onOK <- function(){
		asFactor <- tclvalue(asFactorVariable) == "1"
		recode.directives <- gsub("\n", "; ", tclvalue(tkget(recodes, "1.0", "end")))
		check.empty <- gsub(";", "", gsub(" ", "", recode.directives))
		if ("" == check.empty) {
			errorCondition(recall=Recode,
				message=gettextRcmdr("No recode directives specified."))
			return()
		}
		if (0 != length(grep("'", recode.directives))) {
			errorCondition(recall=Recode,
				message=gettextRcmdr('Use only double-quotes (" ") in recode directives'))
			return()
		}
		recode.directives <- strsplit(recode.directives, ";")[[1]]
		recode.directives <- paste(sapply(recode.directives, processRecode), collapse=";")
		variables <- getSelection(variablesBox)
		closeDialog()
		if (length(variables) == 0) {
			errorCondition(recall=Recode, message=gettextRcmdr("You must select a variable."))
			return()
		}
		multiple <- if (length(variables) > 1) TRUE else FALSE
		name <- trim.blanks(tclvalue(newVariableName))
		for (variable in variables){
			newVar <- if (multiple) paste(name, variable, sep="") else name
			if (!is.valid.name(newVar)){
				errorCondition(recall=Recode,
					message=paste('"', newVar, '" ',
						gettextRcmdr("is not a valid name."), sep=""))
				return()
			}
			if (is.element(newVar, Variables())) {
				if ("no" == tclvalue(checkReplace(newVar))){
					Recode()
					return()
				}
			}
			cmd <- paste("recode(", dataSet,"$",variable, ", '", recode.directives,
				"', as.factor.result=", asFactor, ")", sep="")
			logger(paste(dataSet,"$",newVar, " <- ", cmd, sep=""))
			result <- justDoIt(paste(dataSet,"$",newVar, " <- ", cmd, sep=""))
			if (class(result)[1] !=  "try-error") activeDataSet(dataSet, flushModel=FALSE)
			tkfocus(CommanderWindow())
		}
	}
	OKCancelHelp(helpSubject="Recode")
	tkgrid(getFrame(variablesBox), sticky="nw")
	tkgrid(labelRcmdr(variablesFrame, text=""))
	tkgrid(labelRcmdr(variablesFrame,
			text=gettextRcmdr("New variable name or prefix for multiple recodes: ")),
		newVariable, sticky="w")
	tkgrid(labelRcmdr(asFactorFrame,
			text=gettextRcmdr("Make (each) new variable a factor")), asFactorCheckBox,
		sticky="w")
	tkgrid(labelRcmdr(asFactorFrame, text=""))
	tkgrid(labelRcmdr(recodesFrame, text=gettextRcmdr("Enter recode directives"), fg="blue"),
		sticky="w")
	tkgrid(recodes, recodesYscroll, sticky="nw")
	tkgrid(recodesXscroll)
	tkgrid(variablesFrame, sticky="w")
	tkgrid(asFactorFrame, sticky="w")
	tkgrid(recodesFrame, sticky="w")
	tkgrid(buttonsFrame, sticky="w", columnspan=2)
	tkgrid.configure(recodesXscroll, sticky="ew")
	tkgrid.configure(recodesYscroll, sticky="ns")
	dialogSuffix(rows=4, columns=2, bindReturn=FALSE)
}

Compute <- function(){
	onDoubleClick <-function(){
		var <- trim.blanks(getSelection(variablesBox))
		word <- paste("\\[", gettextRcmdr("factor"), "\\]", sep="")
		if (length(grep(word, var)) == 1)
			var <- trim.blanks(sub(word, "",  var))
		tkfocus(compute)
		expr <- tclvalue(computeVar)
		tclvalue(computeVar) <- if (expr == "") var
			else paste(expr, var, sep=if (rev(strsplit(expr, "")[[1]])[1] =="(" ) "" else " ")
		tkicursor(compute, "end")
		tkxview.moveto(compute, "1")
	}
	dataSet <- activeDataSet()
	initializeDialog(title=gettextRcmdr("Compute New Variable"))
	.variables <- Variables()
	variables <- paste(.variables, ifelse(is.element(.variables, Factors()), gettextRcmdr("[factor]"), ""))
	variablesBox <- variableListBox(top, variables, title=gettextRcmdr("Current variables (double-click to expression)"))
	tkbind(variablesBox$listbox, "<Double-ButtonPress-1>", onDoubleClick)
	variablesFrame <- tkframe(top)
	newVariableName <- tclVar(gettextRcmdr("variable"))
	newVariable <- ttkentry(variablesFrame, width="20", textvariable=newVariableName)
	computeFrame <- tkframe(top)
	computeVar <- tclVar("")
	compute <- ttkentry(computeFrame, font=getRcmdr("logFont"), width="30", textvariable=computeVar)
	computeXscroll <- ttkscrollbar(computeFrame,
		orient="horizontal", command=function(...) tkxview(compute, ...))
	tkconfigure(compute, xscrollcommand=function(...) tkset(computeXscroll, ...))
	onOK <- function(){
		closeDialog()
		newVar <- trim.blanks(tclvalue(newVariableName))
		if (!is.valid.name(newVar)){
			errorCondition(recall=Compute,
				message=paste('"', newVar, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		express <- tclvalue(computeVar)
		check.empty <- gsub(";", "", gsub(" ", "", express))
		if ("" == check.empty) {
			errorCondition(recall=Compute,
				message=gettextRcmdr("No expression specified."))
			return()
		}
		if (is.element(newVar, Variables())) {
			if ("no" == tclvalue(checkReplace(newVar, gettextRcmdr("Variable")))){
				Compute()
				return()
			}
		}
		command <-  paste(dataSet,"$",newVar, " <- with(", ActiveDataSet(),
			", ", express, ")", sep="")
		logger(command)
		result <- justDoIt(command)
		if (class(result)[1] !=  "try-error") activeDataSet(dataSet, flushModel=FALSE)
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="Compute")
	tkgrid(getFrame(variablesBox), sticky="nw", columnspan=2)
	tkgrid(labelRcmdr(variablesFrame, text=gettextRcmdr("New variable name")), sticky="w")
	tkgrid(newVariable, labelRcmdr(variablesFrame, text="     "), sticky="w")
	tkgrid(labelRcmdr(computeFrame, text=gettextRcmdr("Expression to compute")), sticky="w")
	tkgrid(compute, sticky="w")
	tkgrid(computeXscroll, sticky="ew")
	tkgrid(variablesFrame, computeFrame, sticky="nw")
	tkgrid(buttonsFrame, sticky="w", columnspan=2)
	dialogSuffix(rows=3, columns=2, focus=compute)
}

deleteVariable <- function(){
	dataSet <- activeDataSet()
	initializeDialog(title=gettextRcmdr("Delete Variables"))
	variablesBox <- variableListBox(top, Variables(),
		title=gettextRcmdr("Variable(s) to delete (pick one or more)"), selectmode="multiple",
		initialSelection=NULL)
	onOK <- function(){
		variables <- getSelection(variablesBox)
		closeDialog()
		if (length(variables) == 0) {
			errorCondition(recall=deleteVariable, message=gettextRcmdr("You must select one or more variables."))
			return()
		}
		if (length(variables) == 1){
			response <- tclvalue(RcmdrTkmessageBox(message=sprintf(gettextRcmdr("Delete %s?\nPlease confirm."), variables), icon="warning", type="okcancel", default="cancel"))
			if (response == "cancel") {
				onCancel()
				return()
			}
		}
		else{
			response <- tclvalue(RcmdrTkmessageBox(message=
						sprintf(gettextRcmdr("Delete %d variables?\nPlease confirm."), length(variables)),
					icon="warning", type="okcancel", default="cancel"))
			if (response == "cancel") {
				onCancel()
				return()
			}
		}
		for (variable in variables){
			eval(parse(text=paste(dataSet, "$", variable, "<- NULL", sep="")), envir=.GlobalEnv)
			logger(paste(dataSet, "$", variable, " <- NULL", sep=""))
		}
		activeDataSet(dataSet, flushModel=FALSE)
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="NULL")
	tkgrid(getFrame(variablesBox), sticky="nw")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=2, columns=1)
}

readDataSet <- function() {
	initializeDialog(title=gettextRcmdr("Read Text Data From File, Clipboard, or URL"))
	optionsFrame <- tkframe(top)
	dsname <- tclVar(gettextRcmdr("Dataset"))
	entryDsname <- ttkentry(optionsFrame, width="20", textvariable=dsname)
	radioButtons(optionsFrame, "location", buttons=c("local", "clipboard", "url"), 
		labels=gettextRcmdr(c("Local file system", "Clipboard", "Internet URL")), title=gettextRcmdr("Location of Data File"))
	headerVariable <- tclVar("1")
	headerCheckBox <- tkcheckbutton(optionsFrame, variable=headerVariable)
	##   clipboardVariable <- tclVar("0")
	##   clipboardCheckBox <- tkcheckbutton(optionsFrame, variable=clipboardVariable)
	radioButtons(optionsFrame, "delimiter", buttons=c("whitespace", "commas", "tabs"),
		labels=gettextRcmdr(c("White space", "Commas", "Tabs")), title=gettextRcmdr("Field Separator"))
	otherButton <- ttkradiobutton(delimiterFrame, variable=delimiterVariable, value="other")
	otherVariable <- tclVar("")
	otherEntry <- ttkentry(delimiterFrame, width="4", textvariable=otherVariable)
	radioButtons(optionsFrame, "decimal", buttons=c("period", "comma"),
		labels=gettextRcmdr(c("Period [.]", "Comma [,]")), title=gettextRcmdr("Decimal-Point Character"))
	missingVariable <- tclVar("NA")
	missingEntry <- ttkentry(optionsFrame, width="8", textvariable=missingVariable)
	onOK <- function(){
		closeDialog()
		dsnameValue <- trim.blanks(tclvalue(dsname))
		if (dsnameValue == ""){
			errorCondition(recall=readDataSet,
				message=gettextRcmdr("You must enter a name for the data set."))
			return()
		}
		if (!is.valid.name(dsnameValue)){
			errorCondition(recall=readDataSet,
				message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (is.element(dsnameValue, listDataSets())) {
			if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
				readDataSet()
				return()
			}
		}
		##        clip <- tclvalue(clipboardVariable) == "1"
		location <- tclvalue(locationVariable)
		file <- if (location == "clipboard") "clipboard" 
			else if (location == "local") tclvalue(tkgetOpenFile(filetypes=
							gettextRcmdr('{"Text Files" {".txt" ".TXT" ".dat" ".DAT" ".csv" ".CSV"}} {"All Files" {"*"}}')))
			else {
				initializeDialog(subdialog, title=gettextRcmdr("Internet URL"))
				onOKsub <- function(){
					closeDialog(subdialog)
				}
				urlFrame <- tkframe(subdialog)
				urlVar <- tclVar("")
				url <- ttkentry(urlFrame, font=getRcmdr("logFont"), width="30", textvariable=urlVar)
				urlXscroll <- ttkscrollbar(urlFrame,
					orient="horizontal", command=function(...) tkxview(url, ...))
				tkconfigure(url, xscrollcommand=function(...) tkset(urlXscroll, ...))
				subOKCancelHelp()
				tkgrid(url, sticky="w")
				tkgrid(urlXscroll, sticky="ew")
				tkgrid(urlFrame, sticky="nw")
				tkgrid(subButtonsFrame, sticky="w")
				dialogSuffix(subdialog, rows=2, columns=1, focus=url, onOK=onOKsub)
				tclvalue(urlVar)
			}
		if (file == "") {
			if (getRcmdr("grab.focus")) tkgrab.release(top)
			tkdestroy(top)
			return()
		}
		head <- tclvalue(headerVariable) == "1"
		delimiter <- tclvalue(delimiterVariable)
		del <- if (delimiter == "whitespace") ""
			else if (delimiter == "commas") ","
			else if (delimiter == "tabs") "\\t"
			else tclvalue(otherVariable)
		miss <- tclvalue(missingVariable)
		dec <- if (tclvalue(decimalVariable) == "period") "." else ","
		command <- paste('read.table("', file,'", header=', head,
			', sep="', del, '", na.strings="', miss, '", dec="', dec, '", strip.white=TRUE)', sep="")
		logger(paste(dsnameValue, " <- ", command, sep=""))
		result <- justDoIt(command)
		if (class(result)[1] !=  "try-error"){
			assign(dsnameValue, result, envir=.GlobalEnv)
			activeDataSet(dsnameValue)
		}
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="read.table")
	tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, sticky="w")
	tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Variable names in file:")), headerCheckBox, sticky="w")
	##    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Read data from clipboard:")), clipboardCheckBox, sticky="w")
	tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Missing data indicator:")), missingEntry, sticky="w")
	tkgrid(locationFrame, sticky="w")
	tkgrid(labelRcmdr(delimiterFrame, text=gettextRcmdr("Other")), otherButton,
		labelRcmdr(delimiterFrame, text=gettextRcmdr("  Specify:")), otherEntry, sticky="w")
	tkgrid(delimiterFrame, sticky="w", columnspan=2)
	tkgrid(decimalFrame, sticky="w")
	tkgrid(optionsFrame, sticky="w")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=5, columns=1)
}

readDataFromPackage <- function() {
	env <- environment()
	datasets <- NULL
	initializeDialog(title=gettextRcmdr("Read Data From Package"))
	dsname <- tclVar("")
	package <- NULL
	enterFrame <- tkframe(top)
	entryDsname <- ttkentry(enterFrame, width="20", textvariable=dsname)
	packages <- sort(.packages())
	packages <- packages[! packages %in% c("base", "stats")]
	packages <- packages[sapply(packages, function(package){
				ds <- data(package=package)$results
				if (nrow(ds) == 0) return(FALSE)
				ds <- ds[, "Item"]
				valid <- sapply(ds, is.valid.name)
				length(ds[valid]) > 0
			})]
	packageDatasetFrame <- tkframe(top)
	packageFrame <- tkframe(packageDatasetFrame)
	packageBox <- tklistbox(packageFrame, height="4", exportselection="FALSE",
		selectmode="single", background="white")
	packageScroll <- ttkscrollbar(packageFrame,
		command=function(...) tkyview(packageBox, ...))
	tkconfigure(packageBox, yscrollcommand=function(...) tkset(packageScroll, ...))
	for (p in packages) tkinsert(packageBox, "end", p)
	datasetFrame <- tkframe(packageDatasetFrame)
	datasetBox <- tklistbox(datasetFrame, height="4", exportselection="FALSE",
		selectmode="single", background="white")
	datasetScroll <- ttkscrollbar(datasetFrame,
		command=function(...) tkyview(datasetBox, ...))
	tkconfigure(datasetBox, yscrollcommand=function(...) tkset(datasetScroll, ...))
	onPackageSelect <- function(){
		assign("package", packages[as.numeric(tkcurselection(packageBox)) + 1], envir=env)
		datasets <<- data(package=package)$results[,3]
		valid <- sapply(datasets, is.valid.name)
		datasets <<- datasets[valid]
		tkdelete(datasetBox, "0", "end")
		for (dataset in datasets) tkinsert(datasetBox, "end", dataset)
		tkconfigure(datasetBox, height=min(4, length(datasets)))
		firstChar <- tolower(substr(datasets, 1, 1))
		len <- length(datasets)
		onLetter <- function(letter){
			letter <- tolower(letter)
			current <- 1 + round(as.numeric(unlist(strsplit(tclvalue(tkyview(datasetBox) ), " "))[1])*len)
			mat <- match(letter, firstChar[-(1:current)])
			if (is.na(mat)) return()
			tkyview.scroll(datasetBox, mat, "units")
		}
		onA <- function() onLetter("a")
		onB <- function() onLetter("b")
		onC <- function() onLetter("c")
		onD <- function() onLetter("d")
		onE <- function() onLetter("e")
		onF <- function() onLetter("f")
		onG <- function() onLetter("g")
		onH <- function() onLetter("h")
		onI <- function() onLetter("i")
		onJ <- function() onLetter("j")
		onK <- function() onLetter("k")
		onL <- function() onLetter("l")
		onM <- function() onLetter("m")
		onN <- function() onLetter("n")
		onO <- function() onLetter("o")
		onP <- function() onLetter("p")
		onQ <- function() onLetter("q")
		onR <- function() onLetter("r")
		onS <- function() onLetter("s")
		onT <- function() onLetter("t")
		onU <- function() onLetter("u")
		onV <- function() onLetter("v")
		onW <- function() onLetter("w")
		onX <- function() onLetter("x")
		onY <- function() onLetter("y")
		onZ <- function() onLetter("z")
		for (letter in c(letters, LETTERS)){
			tkbind(datasetBox, paste("<", letter, ">", sep=""),
				get(paste("on", toupper(letter), sep="")))
		}
		onClick <- function() tkfocus(datasetBox)
		tkbind(datasetBox, "<ButtonPress-1>", onClick)
	}
	onDatasetSelect <- function(){
		tclvalue(dsname) <- datasets[as.numeric(tkcurselection(datasetBox)) + 1]
	}
	firstChar <- tolower(substr(packages, 1, 1))
	len <- length(packages)
	onLetter <- function(letter){
		letter <- tolower(letter)
		current <- 1 + round(as.numeric(unlist(strsplit(tclvalue(tkyview(packageBox) ), " "))[1])*len)
		mat <- match(letter, firstChar[-(1:current)])
		if (is.na(mat)) return()
		tkyview.scroll(packageBox, mat, "units")
	}
	onA <- function() onLetter("a")
	onB <- function() onLetter("b")
	onC <- function() onLetter("c")
	onD <- function() onLetter("d")
	onE <- function() onLetter("e")
	onF <- function() onLetter("f")
	onG <- function() onLetter("g")
	onH <- function() onLetter("h")
	onI <- function() onLetter("i")
	onJ <- function() onLetter("j")
	onK <- function() onLetter("k")
	onL <- function() onLetter("l")
	onM <- function() onLetter("m")
	onN <- function() onLetter("n")
	onO <- function() onLetter("o")
	onP <- function() onLetter("p")
	onQ <- function() onLetter("q")
	onR <- function() onLetter("r")
	onS <- function() onLetter("s")
	onT <- function() onLetter("t")
	onU <- function() onLetter("u")
	onV <- function() onLetter("v")
	onW <- function() onLetter("w")
	onX <- function() onLetter("x")
	onY <- function() onLetter("y")
	onZ <- function() onLetter("z")
	for (letter in c(letters, LETTERS)){
		tkbind(packageBox, paste("<", letter, ">", sep=""),
			get(paste("on", toupper(letter), sep="")))
	}
	onClick <- function() tkfocus(packageBox)
	tkbind(packageBox, "<ButtonPress-1>", onClick)
	onOK <- function(){
		datasetName <- datasets[as.numeric(tkcurselection(datasetBox)) + 1]
		dsnameValue <- tclvalue(dsname)
		if (dsnameValue != "" && is.null(package)){
			closeDialog()
			if (is.element(dsnameValue, listDataSets())) {
				if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
					if (GrabFocus()) tkgrab.release(top)
					tkdestroy(top)
					readDataFromPackage()
					return()
				}
			}
			save.options <- options(warn=2)
			check <- try(eval(parse(text=logger(paste("data(", dsnameValue, ")", sep=""))),
					envir=.GlobalEnv), silent=TRUE)
			options(save.options)
			if (class(check) == "try-error"){
				errorCondition(recall=readDataFromPackage,
					message=sprintf(gettextRcmdr("Data set %s does not exit"), dsnameValue))
				return()
			}
			activeDataSet(dsnameValue)
			tkfocus(CommanderWindow())
		}
		else{
			if (is.null(package)) {
				errorCondition(recall=readDataFromPackage, message=gettextRcmdr("You must select a package."))
				return()
			}
			if (length(datasetName) == 0) {
				errorCondition(recall=readDataFromPackage, message=gettextRcmdr("You must select a data set.")    )
				return()
			}
			if (is.element(datasetName, listDataSets())) {
				if ("no" == tclvalue(checkReplace(datasetName, gettextRcmdr("Data set")))){
					if (GrabFocus()) tkgrab.release(top)
					tkdestroy(top)
					readDataFromPackage()
					return()
				}
			}
			closeDialog()
			command <- paste("data(", datasetName, ', package="', package, '")', sep="")
			result <- justDoIt(command)
			logger(command)
			if (class(result)[1] !=  "try-error") activeDataSet(datasetName)
			tkfocus(CommanderWindow())
		}
	}
	onDataHelp <- function(){
		datasetName <- data(package=package)$results[as.numeric(tkcurselection(datasetBox)) + 1,3]
		dsnameValue <- tclvalue(dsname)
		if (dsnameValue == "") dsnameValue <- datasetName
		if (length(dsnameValue) == 0) Message(gettextRcmdr("No data set selected."), type="warning")
		else if (is.null(package)) doItAndPrint(paste('help("', dsnameValue, '")', sep=""))
		else doItAndPrint(paste('help("', dsnameValue, '", package="', package, '")', sep=""))
	}
	OKCancelHelp(helpSubject="data")
	dataHelpButton <- buttonRcmdr(top, text=gettextRcmdr("Help on selected data set"), command=onDataHelp)
	tkgrid(labelRcmdr(packageDatasetFrame, text=gettextRcmdr("Package (Double-click to select)"), fg="blue"),
		labelRcmdr(packageDatasetFrame, text="   "), labelRcmdr(packageDatasetFrame, text=gettextRcmdr("Data set (Double-click to select)"),
			fg="blue"), sticky="w")
	tkgrid(packageBox, packageScroll, sticky="nw")
	tkgrid(datasetBox, datasetScroll, sticky="nw")
	tkgrid(packageFrame, labelRcmdr(packageDatasetFrame, text="   "), datasetFrame, sticky="nw")
	tkgrid(packageDatasetFrame, sticky="w")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("OR"), fg="red"), sticky="w")
	tkgrid(labelRcmdr(enterFrame, text=gettextRcmdr("Enter name of data set:  "), fg="blue"), entryDsname, sticky="w")
	tkgrid(enterFrame, sticky="w")
	tkgrid(dataHelpButton, sticky="w")
	tkgrid(buttonsFrame, sticky="w")
	tkgrid.configure(packageScroll, sticky="ns")
	tkgrid.configure(datasetScroll, sticky="ns")
	tkbind(packageBox, "<Double-ButtonPress-1>", onPackageSelect)
	tkbind(datasetBox, "<Double-ButtonPress-1>", onDatasetSelect)
	dialogSuffix(rows=5, columns=1, focus=entryDsname)
}

importSPSS <- function() {
	Library("foreign")
	initializeDialog(title=gettextRcmdr("Import SPSS Data Set"))
	dsname <- tclVar(gettextRcmdr("Dataset"))
	entryDsname <- ttkentry(top, width="20", textvariable=dsname)
	asFactor <- tclVar("1")
	asFactorCheckBox <- tkcheckbutton(top, variable=asFactor)
	maxLevels <- tclVar("Inf")
	entryMaxLevels <- ttkentry(top, width="5", textvariable=maxLevels)
	onOK <- function(){
		closeDialog()
		dsnameValue <- trim.blanks(tclvalue(dsname))
		if (dsnameValue == ""){
			errorCondition(recall=importSPSS,
				message=gettextRcmdr("You must enter the name of a data set."))
			return()
		}
		if (!is.valid.name(dsnameValue)){
			errorCondition(recall=importSPSS,
				message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (is.element(dsnameValue, listDataSets())) {
			if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
				importSPSS()
				return()
			}
		}
		file <- tclvalue(tkgetOpenFile(
				filetypes=gettextRcmdr('{"SPSS save files" {".sav" ".SAV"}} {"SPSS portable files" {".por" ".POR"}} {"All Files" {"*"}}')))
		if (file == "") {
			tkfocus(CommanderWindow())
			return()
		}
		factor <- tclvalue(asFactor) == "1"
		levels <- as.numeric(tclvalue(maxLevels))
		command <- paste('read.spss("', file,'", use.value.labels=', factor,
			", max.value.labels=", levels, ", to.data.frame=TRUE)", sep="")
		logger(paste(dsnameValue, " <- ", command, sep=""))
		result <- justDoIt(command)
		if (class(result)[1] !=  "try-error"){
			assign(dsnameValue, result, envir=.GlobalEnv)
			activeDataSet(dsnameValue)
		}
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="read.spss")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("Enter name for data set:")), entryDsname, sticky="w")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("Convert value labels\nto factor levels"), justify="left"),
		asFactorCheckBox, sticky="w")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("Maximum number\nof value labels\nfor factor conversion"), justify="left"),
		entryMaxLevels, sticky="w")
	tkgrid(buttonsFrame, columnspan="2", sticky="w")
	tkgrid.configure(entryDsname, sticky="w")
	tkgrid.configure(asFactorCheckBox, sticky="w")
	tkgrid.configure(entryMaxLevels, sticky="w")
	dialogSuffix(rows=4, columns=2, focus=entryDsname)
}

importMinitab <- function() {
	Library("foreign")
	initializeDialog(title=gettextRcmdr("Import Minitab Data Set"))
	dsname <- tclVar(gettextRcmdr("Dataset"))
	entryDsname <- ttkentry(top, width="20", textvariable=dsname)
	onOK <- function(){
		closeDialog()
		dsnameValue <- trim.blanks(tclvalue(dsname))
		if (dsnameValue == ""){
			errorCondition(recall=importMinitab,
				message=gettextRcmdr("You must enter the name of a data set."))
			return()
		}
		if (!is.valid.name(dsnameValue)){
			errorCondition(recall=importMinitab,
				message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (is.element(dsnameValue, listDataSets())) {
			if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
				importMinitab()
				return()
			}
		}
		file <- tclvalue(tkgetOpenFile(
				filetypes=gettextRcmdr('{"Minitab portable files" {".mtp" ".MTP"}} {"All Files" {"*"}}')))
		if (file == "") {
			tkfocus(CommanderWindow())
			return()
		}
		command <- paste('read.mtp("', file,'")', sep="")
		datalist <- justDoIt(command)
		lengths <- sapply(datalist, length)
		datalist <- datalist[lengths != 0]
		lengths <- lengths[lengths != 0]
		if (!all(lengths == length(datalist[[1]]))){
			Message(message=
					paste(gettextRcmdr("Minitab data set contains elements of unequal length.\nData set cannot be converted.")),
				type="error")
			tkdestroy(top)
			tkfocus(CommanderWindow())
			return()
		}
		assign(dsnameValue, as.data.frame(datalist), envir=.GlobalEnv)
		logger(paste(dsnameValue, " <- as.data.frame(", command, ")", sep=""))
		activeDataSet(dsnameValue)
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="read.mtp")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("Enter name for data set:")), entryDsname, sticky="e")
	tkgrid(buttonsFrame, columnspan="2", sticky="w")
	tkgrid.configure(entryDsname, sticky="w")
	dialogSuffix(rows=2, columns=2, focus=entryDsname)
}

# the following function was contributed by Michael Ash (modified by J. Fox 2 Feb 05)

importSTATA <- function() {
	Library("foreign")
	initializeDialog(title=gettextRcmdr("Import STATA Data Set"))
	dsname <- tclVar(gettextRcmdr("Dataset"))
	entryDsname <- ttkentry(top, width="20", textvariable=dsname)
	asFactor <- tclVar("1")
	asFactorCheckBox <- tkcheckbutton(top, variable=asFactor)
	asDate <- tclVar("1")
	asDateCheckBox <- tkcheckbutton(top, variable=asDate)
	asMissingType <- tclVar("1")
	asMissingTypeCheckBox <- tkcheckbutton(top, variable=asMissingType)
	asConvertUnderscore <- tclVar("1")
	asConvertUnderscoreCheckBox <- tkcheckbutton(top, variable=asConvertUnderscore)
	asWarnMissingLabels <- tclVar("1")
	asWarnMissingLabelsCheckBox <- tkcheckbutton(top, variable=asWarnMissingLabels)
	onOK <- function(){
		closeDialog()
		dsnameValue <- trim.blanks(tclvalue(dsname))
		if (dsnameValue == ""){
			errorCondition(recall=importSTATA,
				message=gettextRcmdr("You must enter the name of a data set."))
			return()
		}
		if (!is.valid.name(dsnameValue)){
			errorCondition(recall=importSTATA,
				message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (is.element(dsnameValue, listDataSets())) {
			if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
				importSTATA()
				return()
			}
		}
		file <- tclvalue(tkgetOpenFile(
				filetypes=gettextRcmdr('{"STATA datasets" {".dta" ".DTA"}} {"All Files" {"*"}}')))
		if (file == "") {
			tkfocus(CommanderWindow())
			return()
		}
		convert.date <- tclvalue(asDate) == "1"
		factor <- tclvalue(asFactor) == "1"
		missingtype <- tclvalue(asMissingType) == "1"
		convertunderscore <- tclvalue(asConvertUnderscore) == "1"
		warnmissinglabels <- tclvalue(asWarnMissingLabels) == "1"
		command <- paste('read.dta("', file,'", convert.dates=', convert.date,
			", convert.factors=", factor, ", missing.type=", missingtype,
			", convert.underscore=", convertunderscore, ", warn.missing.labels=TRUE)", sep="")
		logger(paste(dsnameValue, " <- ", command, sep=""))
		result <- justDoIt(command)
		if (class(result)[1] !=  "try-error"){
			assign(dsnameValue, result, envir=.GlobalEnv)
			activeDataSet(dsnameValue)
		}
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="read.dta")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("Enter name for data set:")), entryDsname, sticky="w")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("Convert value labels\nto factor levels"), justify="left"),
		asFactorCheckBox, sticky="w")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("Convert dates to R format"), justify="left"),
		asDateCheckBox, sticky="w")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("Multiple missing types (>=Stata 8)"), justify="left"),
		asMissingTypeCheckBox, sticky="w")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("Convert underscore to period"), justify="left"),
		asConvertUnderscoreCheckBox, sticky="w")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("Warn on missing labels"), justify="left"),
		asWarnMissingLabelsCheckBox, sticky="w")
	tkgrid(buttonsFrame, columnspan="2", sticky="w")
	tkgrid.configure(entryDsname, sticky="w")
	tkgrid.configure(asFactorCheckBox, sticky="w")
	tkgrid.configure(asDateCheckBox, sticky="w")
	tkgrid.configure(asMissingTypeCheckBox, sticky="w")
	tkgrid.configure(asWarnMissingLabelsCheckBox, sticky="w")
	dialogSuffix(rows=4, columns=2, focus=entryDsname)
}

# The following function was contributed by Matthieu Lesnoff
#  (added with small changes by J. Fox, 20 July 06 & 30 July 08)

importRODBCtable <- function(){
	# load the RODBC package and stops the program if not available
	if(!require(RODBC))
		stop(gettextRcmdr("This function requires the RODBC package.\n"))
	# close all databases in case of error
	on.exit(odbcCloseAll())
# Enter the name of data set, by default : Dataset
	initializeDialog(title = gettextRcmdr("Import from Excel, Access or dBase data set"))
	dsname <- tclVar(gettextRcmdr("Dataset"))
	entryDsname <- ttkentry(top, width = "35", textvariable = dsname)
	onOK <- function(){
		closeDialog()
		dsnameValue <- trim.blanks(tclvalue(dsname))
		if(dsnameValue == ""){
			errorCondition(recall = importRODBCtable,
				message = gettextRcmdr("You must enter the name of a data set."))
			return()
		}
		if(!is.valid.name(dsnameValue)){
			errorCondition(recall = queryimportRODBCtable,
				message = paste('"', dsnameValue, '" ',
					gettextRcmdr("is not a valid name."), sep = ""))
			return()
		}
		if(is.element(dsnameValue, listDataSets())){
			if("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
				importRODBCtable()
				return()
			}
		}
		File <- tclvalue(tkgetOpenFile(filetypes = gettextRcmdr(
					'{"MS Excel file" {*.xls ".XLS"}} {"MS Excel 2007 file" {*.xlsx ".XLSX"}} {"MS Access database" {*.mdb ".MDB"}} {"MS Access 2007 database" {*.accdb ".ACCDB"}} {"dBase-like file" {*.dbf ".DBF"}} {"All Files" {"*"}}'
				)))
		if(File == ""){
			tkfocus(CommanderWindow())
			return()
		}
		sop <- match(".", rev(strsplit(File, NULL)[[1]]))[1]
		ext <- tolower(substring(File, nchar(File) - sop + 2, nchar(File)))
		channel <- switch(EXPR = ext,
			xls = odbcConnectExcel(File),
			xlsx = odbcConnectExcel2007(File),
			mdb = odbcConnectAccess(File),
			accdb = odbcConnectAccess2007(File),
			dbf = odbcConnectDbase(File))
		# For Excel and Access cases, need to select a particular sheet or table
		if(ext != "dbf"){
			tabdat <- sqlTables(channel)
			names(tabdat) <- tolower(names(tabdat))
			if(ext == "mdb" || ext == "accdb")
				tabdat <- tabdat[tabdat$table_type == "TABLE", 3]
			if(ext == "xls" || ext == "xlsx"){
				tabname <- tabdat$table_name
				tabdat <- ifelse(tabdat$table_type =="TABLE",
					substring(tabname, 2, nchar(tabname) - 2),
					substring(tabname, 1, nchar(tabname) - 1))
			}
			# if there are several tables
			if(length(tabdat)>1)
				fil <- tk_select.list(sort(tabdat),
					title = gettextRcmdr("Select one table"))
			else
				fil <- tabdat
			if(fil == ""){
				errorCondition(message=gettextRcmdr("No table selected"))
				return()
			}
			if(ext == "xls" || ext == "xlsx")
				fil <- paste("[", fil, "$]", sep = "")
		}
		# dBase file
		else{
			sop <- match(".", rev(strsplit(File, NULL)[[1]]))[1]
			root <- tolower(substring(File, 1, nchar(File) - sop))
			revstr <- rev(strsplit(root, NULL)[[1]])
			sop <- if(is.na(match(c("/", "\\"), revstr)[1]))
					length(revstr) else match(c("/", "\\"), revstr)[1] - 1
			toor <- revstr[seq(sop)]
			fil <- paste(rev(toor), collapse = "")
		}
		# Retrieve the data
		dat <- sqlQuery(channel = channel, query = paste("select * from", fil))
		names(dat)<- trim.blanks(names(dat))
		dat <- trim.col.na(dat)
		odbcCloseAll()
		assign(dsnameValue, as.data.frame(dat), envir = .GlobalEnv)
		command <- paste("sqlQuery(channel = ",channel,", select * from ", fil,")",
			sep = "")
		logger(paste(dsnameValue, " <- ", command, sep = ""))
		activeDataSet(dsnameValue)
		tkfocus(CommanderWindow())
	}  ## End of function onOK
	OKCancelHelp(helpSubject="odbcConnect")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("Enter name of data set:  ")),
		entryDsname, sticky="e")
	tkgrid(buttonsFrame, columnspan="2", sticky="w")
	tkgrid.configure(entryDsname, sticky="w")
	dialogSuffix(rows=2, columns=2, focus=entryDsname)
}


numericToFactor <- function(){
	initializeDialog(title=gettextRcmdr("Convert Numeric Variables to Factors"))
	variableBox <- variableListBox(top, Numeric(), selectmode="multiple",
		title=gettextRcmdr("Variables (pick one or more)"))
	radioButtons(name="levels", buttons=c("names", "numbers"),
		labels=gettextRcmdr(c("Supply level names", "Use numbers")), title=gettextRcmdr("Factor Levels"))
	factorName <- tclVar(gettextRcmdr("<same as variables>"))
	factorNameField <- ttkentry(top, width="20", textvariable=factorName)
	onOK <- function(){
		variables <- getSelection(variableBox)
		closeDialog()
		if (length(variables) == 0) {
			errorCondition(recall=numericToFactor, message=gettextRcmdr("You must select a variable."))
			return()
		}
		facname <- trim.blanks(tclvalue(factorName))
		.activeDataSet <- ActiveDataSet()
		cmd <- paste("apply(", .activeDataSet, "[c(", paste(
				paste('"', variables, '"', sep=""),
				collapse=","), ")], 2, function(x) sort(unique(x)))", sep="")
		levs <- eval(parse(text=cmd), envir=.GlobalEnv)
		sameLevels <- (length(variables) == 1) ||
			((is.matrix(levs)) && (all(0 == apply(levs, 1, var))))
		for (name in variables){
			fname <- if (facname == gettextRcmdr("<same as variables>")) name
				else if (length(variables) == 1) facname
				else paste(facname, name, sep="")
			if (!is.valid.name(fname)){
				errorCondition(recall=numericToFactor,
					message=paste('"', fname, '" ', gettextRcmdr("is not a valid name."), sep=""))
				return()
			}
			if (is.element(fname, Variables())) {
				if ("no" == tclvalue(checkReplace(fname))){
					numericToFactor()
					return()
				}
			}
			levelsType <- tclvalue(levelsVariable)
			env <- environment()
			if (((name == variables[1]) || (!sameLevels)) && (levelsType == "names")){
				values <- sort(unique(eval(parse(text=paste(.activeDataSet, "$", name, sep="")),
							envir=.GlobalEnv)))
				nvalues <- length(values)
				if (nvalues > 30) {
					errorCondition(recall=numericToFactor,
						message=sprintf(gettextRcmdr("Number of levels (%d) too large."), nvalues))
					return()
				}
				initializeDialog(subdialog,
					title=paste(gettextRcmdr("Level Names for"),
						if(sameLevels && length(variables) > 1) "Factors" else fname))
				names <- rep("", nvalues)
				onOKsub <- function() {
					closeDialog(subdialog)
					for (i in 1:nvalues){
						names[i] <- eval(parse(text=paste("tclvalue(levelName", i, ")", sep="")))
					}
					if (length(unique(names)) != nvalues){
						errorCondition(recall=numericToFactor,
							message=gettextRcmdr("Levels names are not unique."))
						return()
					}
					if (any(names == "")){
						errorCondition(recall=numericToFactor,
							message=gettextRcmdr("A level name is empty."))
						return()
					}
					assign("labels", paste(paste("'", names, "'", sep=""), collapse=","),
						envir=env)
				}
				subOKCancelHelp()
				tkgrid(labelRcmdr(subdialog, text=gettextRcmdr("Numeric value")), labelRcmdr(subdialog, text=gettextRcmdr("Level name")), sticky="w")
				for (i in 1:nvalues){
					valVar <- paste("levelName", i, sep="")
					assign(valVar, tclVar(""))
					assign(paste("entry", i, sep=""), ttkentry(subdialog, width="20",
							textvariable=get(valVar)))
#                        textvariable=eval(parse(text=valVar))))
					tkgrid(labelRcmdr(subdialog, text=values[i]), get(paste("entry", i, sep="")), sticky="w")
#                    tkgrid(labelRcmdr(subdialog, text=values[i]), eval(parse(text=paste("entry", i, sep=""))), sticky="w")
				}
				tkgrid(subButtonsFrame, sticky="w", columnspan=2)
				dialogSuffix(subdialog, rows=nvalues+2, columns=2, focus=entry1, onOK=onOKsub)
			}
			if (levelsType == "names"){
				if (!exists("labels", mode="character")) return()
				command <- paste("factor(", .activeDataSet, "$", name,
					", labels=c(", labels, "))", sep="")
				result <- justDoIt(paste(.activeDataSet, "$", fname, " <- ", command, sep=""))
				logger(paste(.activeDataSet,"$", fname," <- ", command, sep=""))
				if (class(result)[1] !=  "try-error") activeDataSet(.activeDataSet)
				tkfocus(CommanderWindow())
			}
			else{
				command <- paste("as.factor(", .activeDataSet, "$", name, ")", sep="")
				result <- justDoIt(paste(.activeDataSet, "$", fname, " <- ", command, sep=""))
				logger(paste(.activeDataSet, "$", fname," <- ", command, sep=""))
				if (class(result)[1] !=  "try-error") activeDataSet(.activeDataSet, flushModel=FALSE)
				tkfocus(CommanderWindow())
			}
		}
	}
	OKCancelHelp(helpSubject="factor")
	tkgrid(getFrame(variableBox), levelsFrame, sticky="nw")
	tkgrid(labelRcmdr(top,
			text=gettextRcmdr("New variable name or prefix for multiple variables:")),
		factorNameField, sticky="w")
	tkgrid(buttonsFrame, sticky="w", columnspan=2)
	tkgrid.configure(numbersButton, sticky="w")
	tkgrid.configure(namesButton, sticky="w")
	dialogSuffix(rows=4, columns=2, preventGrabFocus=TRUE)
}

binVariable <- function(){
# Author: Dan Putler (revision by J. Fox, 2 Feb 05)
#    if (!checkActiveDataSet()) return()
#    if (!checkNumeric()) return()
	env <- environment()
	initializeDialog(title=gettextRcmdr("Bin a Numeric Variable"))
	variableFrame <- tkframe(top)
	variableBox <- variableListBox(variableFrame, Numeric(), title=gettextRcmdr("Variable to bin (pick one)"))
	newVariableFrame <- tkframe(variableFrame)
	newVariableName <- tclVar(gettextRcmdr("variable"))
	newVariable <- ttkentry(newVariableFrame, width="18", textvariable=newVariableName)
	binsFrame <- tkframe(top)
	binsVariable <- tclVar("3")
	slider <- tkscale(binsFrame, from=2, to=20, showvalue=TRUE, variable=binsVariable,
		resolution=1, orient="horizontal")
	optionsFrame <- tkframe(top)
	radioButtons(optionsFrame, name="levels", buttons=c("specify", "numbers", "ranges"),
		labels=gettextRcmdr(c("Specify names", "Numbers", "Ranges")), title=gettextRcmdr("Level Names"))
	radioButtons(optionsFrame, name="method", buttons=c("intervals", "proportions", "natural"),
		labels=gettextRcmdr(c("Equal-width bins", "Equal-count bins", "Natural breaks\n(from K-means clustering)")),
		title=gettextRcmdr("Binning Method"))
	onOK <- function(){
		levels <- tclvalue(levelsVariable)
		bins <- as.numeric(tclvalue(binsVariable))
		varName <- getSelection(variableBox)
		closeDialog()
		if (length(varName) == 0){
			errorCondition(recall=binVariable, message=gettextRcmdr("You must select a variable."))
			return()
		}
		newVar <- tclvalue(newVariableName)
		if (is.element(newVar, Variables())) {
			if ("no" == tclvalue(checkReplace(newVar))){
				binVariable()
				return()
			}
		}
		if (!is.valid.name(newVar)){
			errorCondition(message=paste('"', newVar, '" ', gettextRcmdr("is not a valid name."), sep=""),
				recall=binVariable)
			return()
		}
		method <- tclvalue(methodVariable)
		if (levels == "specify"){
			initializeDialog(subdialog, title=gettextRcmdr("Bin Names"))
			onOKsub <- function() {
				closeDialog(subdialog)
				level <- character(bins)
				for (i in 1:bins){
					level[i] <- eval(parse(text=paste("tclvalue(levelName", i, ")", sep="")))
				}
				if (length(unique(level)) != length(level)){
					errorCondition(window=subdialog, message=gettextRcmdr("Level names must be unique."),
						recall=onOK)
					return()
				}
				assign("levelNames", level, envir=env)
			}
			subOKCancelHelp()
			tkgrid(labelRcmdr(subdialog, text=gettextRcmdr("Bin"), fg="blue"),
				labelRcmdr(subdialog, text=gettextRcmdr("Name"), fg="blue"), sticky="w")
			for (i in 1:bins){
				valVar <- paste("levelName", i, sep="")
				assign(valVar, tclVar(i))
				assign(paste("entry", i, sep=""), ttkentry(subdialog, width="20",
						textvariable=get(valVar)))
#                    textvariable=eval(parse(text=valVar))))
				tkgrid(labelRcmdr(subdialog, text=as.character(i)), get(paste("entry", i, sep="")), sticky="w")
#                tkgrid(labelRcmdr(subdialog, text=as.character(i)), eval(parse(text=paste("entry", i, sep=""))), sticky="w")
			}
			tkgrid(subButtonsFrame, sticky="w", columnspan=2)
			dialogSuffix(subdialog, focus=entry1, rows=bins+1, columns=2, bindReturn=FALSE)
		}
		labels <- if (levels == "numbers") "FALSE"
			else if (levels == "ranges") "NULL"
			else {
				if (!exists("levelNames")){
					onCancel()
					binVariable()
					return()
				}
				paste("c('", paste(levelNames,  collapse="','"), "')", sep="")
			}
		.activeDataSet <- ActiveDataSet()
		command <- paste(.activeDataSet,"$",newVar, " <- ",
			"bin.var(", .activeDataSet,"$", varName, ", bins=", bins,
			", method=", "'", method, "', labels=", labels, ")", sep="")
		logger(command)
		result <- justDoIt(command)
		if (class(result)[1] !=  "try-error") activeDataSet(.activeDataSet, flushModel=FALSE)
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="bin.var")
	tkgrid(labelRcmdr(newVariableFrame, text=gettextRcmdr("New variable name"), fg="blue"), sticky="w")
	tkgrid(newVariable, sticky="w")
	tkgrid(getFrame(variableBox), labelRcmdr(variableFrame, text="    "), newVariableFrame, sticky="nw")
	tkgrid(variableFrame, sticky="w")
	tkgrid(labelRcmdr(binsFrame, text=gettextRcmdr("Number of bins:")), slider, sticky="s")
	tkgrid(binsFrame, sticky="w")
	tkgrid(levelsFrame, labelRcmdr(optionsFrame, text="    "), methodFrame, sticky="nw")
	tkgrid(optionsFrame, sticky="w")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=4, columns=1)
}

reorderFactor <- function(){
	initializeDialog(title=gettextRcmdr("Reorder Factor Levels"))
	variableBox <- variableListBox(top, Factors(), title=gettextRcmdr("Factor (pick one)"))
	orderedFrame <- tkframe(top)
	orderedVariable <- tclVar("0")
	orderedCheckBox <- tkcheckbutton(orderedFrame, variable=orderedVariable)
	factorName <- tclVar(gettextRcmdr("<same as original>"))
	factorNameField <- ttkentry(top, width="20", textvariable=factorName)
	onOK <- function(){
		variable <- getSelection(variableBox)
		closeDialog()
		if (length(variable) == 0) {
			errorCondition(recall=reorderFactor, message=gettextRcmdr("You must select a variable."))
			return()
		}
		name <- trim.blanks(tclvalue(factorName))
		if (name == gettextRcmdr("<same as original>")) name <- variable
		if (!is.valid.name(name)){
			errorCondition(recall=reorderFactor,
				message=paste('"', name, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (is.element(name, Variables())) {
			if ("no" == tclvalue(checkReplace(name))){
				reorderFactor()
				return()
			}
		}
		.activeDataSet <- ActiveDataSet()
		old.levels <- eval(parse(text=paste("levels(", .activeDataSet, "$", variable, ")",
					sep="")), envir=.GlobalEnv)
		nvalues <- length(old.levels)
		ordered <- tclvalue(orderedVariable)
		if (nvalues > 30) {
			errorCondition(recall=reorderFactor,
				message=sprintf(gettextRcmdr("Number of levels (%d) too large."), nvalues))
			return()
		}
		initializeDialog(subdialog, title=gettextRcmdr("Reorder Levels"))
		order <- 1:nvalues
		onOKsub <- function() {
			closeDialog(subdialog)
			opt <- options(warn=-1)
			for (i in 1:nvalues){
				order[i] <- as.numeric(eval(parse(text=paste("tclvalue(levelOrder", i, ")", sep=""))))
			}
			options(opt)
			if (any(sort(order) != 1:nvalues) || any(is.na(order))){
				errorCondition(recall=reorderFactor,
					message=paste(gettextRcmdr("Order of levels must include all integers from 1 to "), nvalues, sep=""))
				return()
			}
			levels <- old.levels[order(order)]
			ordered <- if (ordered == "1") ", ordered=TRUE" else ""
			command <- paste("factor(", .activeDataSet, "$", variable,
				", levels=c(", paste(paste("'", levels, "'", sep=""), collapse=","), ")",
				ordered, ")", sep="")
			result <- justDoIt(paste(.activeDataSet, "$", name, " <- ", command, sep=""))
			logger(paste(.activeDataSet,"$", name," <- ", command, sep=""))
			if (class(result)[1] !=  "try-error") activeDataSet(.activeDataSet, flushModel=FALSE)
		}
		subOKCancelHelp()
		tkgrid(labelRcmdr(subdialog, text=gettextRcmdr("Old Levels"), fg="blue"),
			labelRcmdr(subdialog, text=gettextRcmdr("New order"), fg="blue"), sticky="w")
		for (i in 1:nvalues){
			valVar <- paste("levelOrder", i, sep="")
			assign(valVar, tclVar(i))
			assign(paste("entry", i, sep=""), ttkentry(subdialog, width="2",
					textvariable=get(valVar)))
#                textvariable=eval(parse(text=valVar))))
			tkgrid(labelRcmdr(subdialog, text=old.levels[i]), get(paste("entry", i, sep="")), sticky="w")
#            tkgrid(labelRcmdr(subdialog, text=old.levels[i]), eval(parse(text=paste("entry", i, sep=""))), sticky="w")
		}
		tkgrid(subButtonsFrame, sticky="w", columnspan=2)
		dialogSuffix(subdialog, focus=entry1, rows=nvalues+1, columns=2)
	}
	OKCancelHelp(helpSubject="factor")
	tkgrid(getFrame(variableBox), sticky="nw")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("Name for factor")), sticky="w")
	tkgrid(factorNameField, sticky="w")
	tkgrid(labelRcmdr(orderedFrame, text=gettextRcmdr("Make ordered factor")), orderedCheckBox, sticky="w")
	tkgrid(orderedFrame, sticky="w")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=5, columns=1, preventGrabFocus=TRUE)
}

standardize <- function(X){
	initializeDialog(title=gettextRcmdr("Standardize Variables"))
	xBox <- variableListBox(top, Numeric(), title=gettextRcmdr("Variables (pick one or more)"),
		selectmode="multiple")
	onOK <- function(){
		x <- getSelection(xBox)
		closeDialog()
		if (length(x) == 0) {
			errorCondition(recall=standardize, message=gettextRcmdr("You must select one or more variables."))
			return()
		}
		xx <- paste('"', x, '"', sep="")
		.activeDataSet <- ActiveDataSet()
		command <- paste("scale(", .activeDataSet, "[,c(", paste(xx, collapse=","),
			")])", sep="")
		result <- justDoIt(command)
		assign(".Z", result, envir=.GlobalEnv)
		logger(paste(".Z <- ", command, sep=""))
		for (i in 1:length(x)){
			Z <- paste("Z.", x[i], sep="")
			if (is.element(Z, Variables())) {
				if ("no" == tclvalue(checkReplace(Z))){
					if (GrabFocus()) tkgrab.release(top)
					tkdestroy(top)
					next
				}
			}
			justDoIt(paste(.activeDataSet, "$", Z, " <- .Z[,", i, "]", sep=""))
			logger(paste(.activeDataSet, "$", Z, " <- .Z[,", i, "]", sep=""))
		}
		remove(.Z, envir=.GlobalEnv)
		logger("remove(.Z)")
		if (class(result)[1] !=  "try-error") activeDataSet(.activeDataSet, flushModel=FALSE)
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="scale")
	tkgrid(getFrame(xBox), sticky="w")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=2, columns=1)
}

helpDataSet <- function(){
	.activeDataSet <- ActiveDataSet()
	if (as.numeric(R.Version()$major) >= 2) doItAndPrint(paste('help("', .activeDataSet, '")', sep=""))
	else {
		justDoIt(paste("help('", .activeDataSet, "')", sep=""))
		logger(paste('help("', .activeDataSet, '")', sep=""))
	}
	NULL
}

variablesDataSet <- function(){
	doItAndPrint(paste("names(", ActiveDataSet(), ")", sep=""))
}

exportDataSet <- function() {
	dsname <- activeDataSet()
	initializeDialog(title=gettextRcmdr("Export Active Data Set"))
	checkBoxes(frame="optionsFrame", boxes=c("colnames", "rownames", "quotes"),
		initialValues=rep(1,3), labels=gettextRcmdr(c("Write variable names:", "Write row names:", "Quotes around character values:")))
	missingVariable <- tclVar("NA")
	missingEntry <- ttkentry(optionsFrame, width="8", textvariable=missingVariable)
	radioButtons(name="delimiter", buttons=c("spaces", "tabs", "commas"), labels=gettextRcmdr(c("Spaces", "Tabs", "Commas")),
		title=gettextRcmdr("Field Separator"))
	otherButton <- ttkradiobutton(delimiterFrame, variable=delimiterVariable, value="other")
	otherVariable <- tclVar("")
	otherEntry <- ttkentry(delimiterFrame, width="4", textvariable=otherVariable)
	onOK <- function(){
		closeDialog()
		col <- tclvalue(colnamesVariable) == 1
		row <- tclvalue(rownamesVariable) == 1
		quote <- tclvalue(quotesVariable) == 1
		delim <- tclvalue(delimiterVariable)
		missing <- tclvalue(missingVariable)
		sep <- if (delim == "tabs") "\\t"
			else if (delim == "spaces") " "
			else if (delim == "commas") ","
			else trim.blanks(tclvalue(otherVariable))
		saveFile <- tclvalue(tkgetSaveFile(filetypes=gettextRcmdr('{"Text Files" {".txt" ".TXT" ".dat" ".DAT" ".csv" ".CSV"}} {"All Files" {"*"}}'),
				defaultextension="txt", initialfile=paste(dsname, ".txt", sep="")))
		if (saveFile == "") {
			tkfocus(CommanderWindow())
			return()
		}
		command <- paste("write.table(", dsname, ', "', saveFile, '", sep="', sep,
			'", col.names=', col, ", row.names=", row, ", quote=", quote,
			', na="', missing, '")', sep="")
		justDoIt(command)
		logger(command)
		Message(paste(gettextRcmdr("Active dataset exported to file"), saveFile), type="note")
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="write.table")
	tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Missing values:")), missingEntry, sticky="w")
	tkgrid(optionsFrame, sticky="w")
	tkgrid(labelRcmdr(delimiterFrame, text=gettextRcmdr("Other")), otherButton,
		labelRcmdr(delimiterFrame, text=gettextRcmdr("  Specify:")), otherEntry, sticky="w")
	tkgrid(delimiterFrame, stick="w")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=3, columns=1)
}

filterNA <- function(){
	dataSet <- activeDataSet()
	initializeDialog(title=gettextRcmdr("Remove Missing Data"))
	allVariablesFrame <- tkframe(top)
	allVariables <- tclVar("1")
	allVariablesCheckBox <- tkcheckbutton(allVariablesFrame, variable=allVariables)
	variablesBox <- variableListBox(top, Variables(), selectmode="multiple", initialSelection=NULL,
		title=gettextRcmdr("Variables (select one or more)"))
	newDataSetName <- tclVar(gettextRcmdr("<same as active data set>"))
	dataSetNameFrame <- tkframe(top)
	dataSetNameEntry <- ttkentry(dataSetNameFrame, width="25", textvariable=newDataSetName)
	onOK <- function(){
		x <- getSelection(variablesBox)
		closeDialog()
		newName <- trim.blanks(tclvalue(newDataSetName))
		.activeDataSet <- ActiveDataSet()
		if (newName == gettextRcmdr("<same as active data set>")) newName <- .activeDataSet
		if (!is.valid.name(newName)){
			errorCondition(recall=filterNA,
				message=paste('"', newName, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (is.element(newName, listDataSets())) {
			if ("no" == tclvalue(checkReplace(newName, gettextRcmdr("Data set")))){
				filterNA()
				return()
			}
		}
		if (tclvalue(allVariables) == "1"){
			command <- paste(newName, " <- na.omit(", .activeDataSet, ")", sep="")
			logger(command)
			result <- justDoIt(command)
			if (class(result)[1] !=  "try-error") activeDataSet(newName)
			tkfocus(CommanderWindow())
		}
		else {
			if (length(x) == 0) {
				errorCondition(recall=filterNA, message=gettextRcmdr("No variables were selected."))
				return()
			}
			x <- paste('"', x, '"', sep="")
			command <- paste(newName, " <- na.omit(", .activeDataSet, "[,c(", paste(x, collapse=","),
				')])', sep="")
			logger(command)
			result <- justDoIt(command)
			if (class(result)[1] !=  "try-error") activeDataSet(newName)
			tkfocus(CommanderWindow())
		}
	}
	OKCancelHelp(helpSubject="na.omit")
	tkgrid(labelRcmdr(allVariablesFrame, text=gettextRcmdr("Include all variables")),
		allVariablesCheckBox, sticky="w")
	tkgrid(allVariablesFrame, sticky="w")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("   OR"), fg="red"), sticky="w")
	tkgrid(getFrame(variablesBox), sticky="nw")
	tkgrid(labelRcmdr(dataSetNameFrame, text=gettextRcmdr("Name for new data set")), sticky="w")
	tkgrid(dataSetNameEntry, sticky="w")
	tkgrid(dataSetNameFrame, sticky="w")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=4, columns=1)
}

subsetDataSet <- function(){
	dataSet <- activeDataSet()
	initializeDialog(title=gettextRcmdr("Subset Data Set"))
	allVariablesFrame <- tkframe(top)
	allVariables <- tclVar("1")
	allVariablesCheckBox <- tkcheckbutton(allVariablesFrame, variable=allVariables)
	variablesBox <- variableListBox(top, Variables(), selectmode="multiple",
		initialSelection=NULL, title=gettextRcmdr("Variables (select one or more)"))
	subsetVariable <- tclVar(gettextRcmdr("<all cases>"))
	subsetFrame <- tkframe(top)
	subsetEntry <- ttkentry(subsetFrame, width="20", textvariable=subsetVariable)
	subsetScroll <- ttkscrollbar(subsetFrame, orient="horizontal",
		command=function(...) tkxview(subsetEntry, ...))
	tkconfigure(subsetEntry, xscrollcommand=function(...) tkset(subsetScroll, ...))
	newDataSetName <- tclVar(gettextRcmdr("<same as active data set>"))
	dataSetNameFrame <- tkframe(top)
	dataSetNameEntry <- ttkentry(dataSetNameFrame, width="25", textvariable=newDataSetName)
	onOK <- function(){
		newName <- trim.blanks(tclvalue(newDataSetName))
		if (newName == gettextRcmdr("<same as active data set>")) newName <- ActiveDataSet()
		if (!is.valid.name(newName)){
			errorCondition(recall=subsetDataSet,
				message=paste('"', newName, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (is.element(newName, listDataSets())) {
			if ("no" == tclvalue(checkReplace(newName, type=gettextRcmdr("Data set")))){
				closeDialog()
				subsetDataSet()
				return()
			}
		}
		selectVars <- if (tclvalue(allVariables) == "1") ""
			else {
				x <- getSelection(variablesBox)
				if (0 > length(x)) {
					errorCondition(recall=subsetDataSet,
						message=gettextRcmdr("No variables were selected."))
					return()
				}
				paste(", select=c(", paste(x, collapse=","), ")", sep="")
			}
		closeDialog()
		cases <- tclvalue(subsetVariable)
		selectCases <- if (cases == gettextRcmdr("<all cases>")) ""
			else paste(", subset=", cases, sep="")
		if (selectVars == "" && selectCases ==""){
			errorCondition(recall=subsetDataSet,
				message=gettextRcmdr("New data set same as active data set."))
			return()
		}
		command <- paste(newName, " <- subset(", ActiveDataSet(), selectCases, selectVars, ")",
			sep="")
		logger(command)
		result <- justDoIt(command)
		if (class(result)[1] !=  "try-error") activeDataSet(newName)
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="subset")
	tkgrid(labelRcmdr(allVariablesFrame, text=gettextRcmdr("Include all variables")),
		allVariablesCheckBox, sticky="w")
	tkgrid(allVariablesFrame, sticky="w")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("   OR"), fg="red"), sticky="w")
	tkgrid(getFrame(variablesBox), sticky="nw")
	tkgrid(labelRcmdr(subsetFrame, text=gettextRcmdr("Subset expression")), sticky="w")
	tkgrid(subsetEntry, sticky="w")
	tkgrid(subsetScroll, sticky="ew")
	tkgrid(subsetFrame, sticky="w")
	tkgrid(labelRcmdr(dataSetNameFrame, text=gettextRcmdr("Name for new data set")), sticky="w")
	tkgrid(dataSetNameEntry, sticky="w")
	tkgrid(dataSetNameFrame, sticky="w")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=6, columns=1)
}

setCaseNames <- function(){
	dataSet <- activeDataSet()
	initializeDialog(title=gettextRcmdr("Set Case Names"))
	variablesBox <- variableListBox(top, Variables(), title=gettextRcmdr("Select variable containing row names"),
		initialSelection=NULL)
	onOK <- function(){
		variable <- getSelection(variablesBox)
		closeDialog()
		if (length(variable) == 0) {
			errorCondition(recall=setCaseNames, message=gettextRcmdr("You must select a variable."))
			return()
		}
		var <- eval(parse(text=paste(dataSet, "$", variable, sep="")), envir=.GlobalEnv)
		if (length(var) != length(unique(var))){
			errorCondition(recall=setCaseNames, message=gettextRcmdr("Case names must be unique."))
			return()
		}
		command <- paste("row.names(", dataSet, ") <- as.character(", dataSet, "$", variable, ")", sep="")
		result <- justDoIt(command)
		logger(command)
		eval(parse(text=paste(dataSet, "$", variable, "<- NULL", sep="")), envir=.GlobalEnv)
		logger(paste(dataSet, "$", variable, " <- NULL", sep=""))
		if (class(result)[1] !=  "try-error") activeDataSet(dataSet, flushModel=FALSE)
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="row.names")
	tkgrid(getFrame(variablesBox), sticky="nw")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=3, columns=1)
}

renameVariables <- function(){
	initializeDialog(title=gettextRcmdr("Rename Variables"))
	variableBox <- variableListBox(top, Variables(), title=gettextRcmdr("Variables (pick one or more)"),
		selectmode="multiple", initialSelection=NULL)
	onOK <- function(){
		variables <- getSelection(variableBox)
		closeDialog()
		nvariables <- length(variables)
		if (nvariables < 1) {
			errorCondition(recall=renameVariables, message=gettextRcmdr("No variables selected."))
			return()
		}
		.activeDataSet <- ActiveDataSet()
		unordered.names <- names(get(.activeDataSet))
#        unordered.names <- names(eval(parse(text=.activeDataSet)))
		which.variables <- match(variables, unordered.names)
		initializeDialog(subdialog, title=gettextRcmdr("Variable Names"))
		newnames <- rep("", nvariables)
		onOKsub <- function() {
			closeDialog(subdialog)
			for (i in 1:nvariables){
				newnames[i] <- eval(parse(text=paste("tclvalue(newName", i, ")", sep="")))
			}
			if (any(newnames == "")){
				errorCondition(recall=renameVariables, message=gettextRcmdr("A variable name is empty."))
				return()
			}
			test.names <- newnames == make.names(newnames)
			if (!all(test.names)){
				errorCondition(recall=renameVariables,
					message=paste(gettextRcmdr("The following variable names are not valid:\n"),
						paste(newnames[!test.names], collapse=", ")))
				return()
			}
			all.names <- names(get(.activeDataSet))
#            all.names <- eval(parse(text=paste("names(", .activeDataSet, ")")))
			all.names[which.variables] <- newnames
			if (length(unique(all.names)) != length(all.names)){
				errorCondition(recall=renameVariables, message=gettextRcmdr("Variable names are not unique"))
				return()
			}
			command <- paste("names(", .activeDataSet, ")[c(", paste(which.variables, collapse=","),
				")] <- c(", paste('"', newnames, '"', collapse=",", sep=""), ")", sep="")
			result <- justDoIt(command)
			logger(command)
			if (class(result)[1] !=  "try-error") activeDataSet(.activeDataSet, flushModel=FALSE)
			tkfocus(CommanderWindow())
		}
		subOKCancelHelp()
		tkgrid(labelRcmdr(subdialog, text=gettextRcmdr("Old Name"), fg="blue"),
			labelRcmdr(subdialog, text=gettextRcmdr("New name"), fg="blue"), sticky="w")
		for (i in 1:nvariables){
			valVar <- paste("newName", i, sep="")
			assign(valVar, tclVar(""))
			assign(paste("entry", i, sep=""), ttkentry(subdialog, width="20",
#                textvariable=eval(parse(text=valVar))))
					textvariable=get(valVar)))
			tkgrid(labelRcmdr(subdialog, text=variables[i]), get(paste("entry", i, sep="")), sticky="w")
#            tkgrid(labelRcmdr(subdialog, text=variables[i]), eval(parse(text=paste("entry", i, sep=""))), sticky="w")
		}
		tkgrid(subButtonsFrame, sticky="w", columnspan=2)
		dialogSuffix(subdialog, rows=nvariables+2, columns=2, focus=entry1, onOK=onOKsub)
	}
	OKCancelHelp(helpSubject="names")
	tkgrid(getFrame(variableBox), sticky="nw")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=2, columns=1)
}

setContrasts <- function(){
	initializeDialog(title=gettextRcmdr("Set Contrasts for Factor"))
	variableBox <- variableListBox(top, Factors(), title=gettextRcmdr("Factor (pick one)"))
	radioButtons(name="contrasts", buttons=c("treatment", "sum", "helmert", "poly", "specify"),
		values=c("contr.Treatment", "contr.Sum", "contr.helmert", "contr.poly", "specify"),
		labels=gettextRcmdr(c("Treatment (dummy) contrasts", "Sum (deviation) contrasts", "Helmert contrasts",
				"Polynomial contrasts", "Other (specify)")), title=gettextRcmdr("Contrasts"))
	onOK <- function(){
		variable <- getSelection(variableBox)
		closeDialog()
		if (length(variable) == 0) {
			errorCondition(recall=setContrasts, message=gettextRcmdr("You must select a variable."))
			return()
		}
		contrasts <- tclvalue(contrastsVariable)
		if (contrasts != "specify"){
			command <- paste("contrasts(", ActiveDataSet(), "$", variable, ') <- "', contrasts, '"', sep="")
			result <- justDoIt(command)
			logger(command)
			if (class(result)[1] !=  "try-error") activeDataSet(ActiveDataSet())
			tkfocus(CommanderWindow())
		}
		else{
			initializeDialog(subdialog, title=gettextRcmdr("Specify Contrasts"))
			tkgrid(labelRcmdr(subdialog, text=gettextRcmdr("Enter Contrast Coefficients"), fg="blue"), sticky="w")
			env <- environment()
			tableFrame <- tkframe(subdialog)
			row.names <- eval(parse(text=paste("levels(", ActiveDataSet(), "$", variable, ")")))
			row.names <- substring(paste(abbreviate(row.names, 12), "            "), 1, 12)
			nrows <- length(row.names)
			ncols <- nrows - 1
			make.col.names <- paste("labelRcmdr(tableFrame, text='", gettextRcmdr("Contrast Name:"), "')", sep="")
			for (j in 1:ncols) {
				varname <- paste(".col.", j, sep="")
				assign(varname, tclVar(paste(".", j, sep="")), envir=env)
				make.col.names <- paste(make.col.names, ", ",
					"ttkentry(tableFrame, width='12', textvariable=", varname, ")", sep="")
			}
			eval(parse(text=paste("tkgrid(", make.col.names, ", sticky='w')", sep="")), envir=env)
			for (i in 1:nrows){
				make.row <- paste("labelRcmdr(tableFrame, text='", row.names[i], "')")
				for (j in 1:ncols){
					varname <- paste(".tab.", i, ".", j, sep="")
					assign(varname, tclVar("0"), envir=env)
					make.row <- paste(make.row, ", ", "ttkentry(tableFrame, width='5', textvariable=",
						varname, ")", sep="")
				}
				eval(parse(text=paste("tkgrid(", make.row, ", sticky='w')", sep="")), envir=env)
			}
			tkgrid(tableFrame, sticky="w")
			onOKsub <- function(){
				closeDialog(subdialog)
				cell <- 0
				values <- rep(NA, nrows*ncols)
				for (j in 1:ncols){
					for (i in 1:nrows){
						cell <- cell + 1
						varname <- paste(".tab.", i, ".", j, sep="")
						values[cell] <- as.numeric(eval(parse(text=paste("tclvalue(", varname,")", sep=""))))
					}
				}
				values <- na.omit(values)
				if (length(values) != nrows*ncols){
					errorCondition(subdialog, recall=setContrasts,
						message=sprintf(gettextRcmdr(
								"Number of valid entries in contrast matrix(%d)\nnot equal to number of levels (%d) * number of contrasts (%d)."), length(values), nrows, ncols))
					return()
				}
				if (qr(matrix(values, nrows, ncols))$rank < ncols) {
					errorCondition(subdialog, recall=setContrasts, message=gettextRcmdr("Contrast matrix is not of full column rank"))
					return()
				}
				contrast.names <- rep("", ncols)
				for (j in 1:ncols){
					varname <- paste(".col.", j, sep="")
					contrast.names[j] <- eval(parse(text=paste("tclvalue(", varname,")", sep="")))
				}
				if (length(unique(contrast.names)) < ncols) {
					errorCondition(subdialog, recall=setContrasts, message=gettextRcmdr("Contrast names must be unique"))
					return()
				}
				command <- paste("matrix(c(", paste(values, collapse=","), "), ", nrows, ", ", ncols,
					")", sep="")
				assign(".Contrasts", justDoIt(command), envir=.GlobalEnv)
				logger(paste(".Contrasts <- ", command, sep=""))
				command <- paste("colnames(.Contrasts) <- c(",
					paste("'", contrast.names, "'", sep="", collapse=", "), ")", sep="")
				justDoIt(command)
				logger(command)
				command <- paste("contrasts(", ActiveDataSet(), "$", variable, ") <- .Contrasts", sep="")
				result <- justDoIt(command)
				logger(command)
				justDoIt("remove(.Contrasts, envir=.GlobalEnv)")
				logger("remove(.Contrasts)")
				if (class(result)[1] !=  "try-error") activeDataSet(ActiveDataSet(), flushModel=FALSE)
				tkfocus(CommanderWindow())
			}
			subOKCancelHelp(helpSubject="contrasts")
			tkgrid(tableFrame, sticky="w")
			tkgrid(labelRcmdr(subdialog, text=""))
			tkgrid(subButtonsFrame, sticky="w")
			dialogSuffix(subdialog, rows=5, columns=1, focus=subdialog)
		}
	}
	OKCancelHelp(helpSubject="contrasts")
	tkgrid(getFrame(variableBox), sticky="nw")
	tkgrid(contrastsFrame, sticky="w")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=4, columns=1)
}

refreshActiveDataSet <- function() activeDataSet(ActiveDataSet())

addObsNumbers <- function(){
	dsname <- ActiveDataSet()
	if (is.element("ObsNumber", listVariables())) {
		if ("no" == tclvalue(checkReplace("ObsNumber", gettextRcmdr("Variable")))){
			return()
		}
	}
	nrows <- nrow(get(dsname, envir=.GlobalEnv))
#    nrows <- eval(parse(text=paste("nrow(", dsname, ")", sep="")), envir=.GlobalEnv)
	command <- paste(dsname, "$ObsNumber <- 1:", nrows, sep="")
	logger(command)
	result <- justDoIt(command)
	if (class(result)[1] !=  "try-error") activeDataSet(dsname, flushModel=FALSE)
}

Stack <- function(){
	initializeDialog(title=gettextRcmdr("Stack Variables"))
	variableBox <- variableListBox(top, Numeric(), selectmode="multiple",
		title=gettextRcmdr("Variables (pick two or more)"))
	factorName <- tclVar(gettextRcmdr("factor"))
	factorNameField <- ttkentry(top, width="20", textvariable=factorName)
	variableName <- tclVar(gettextRcmdr("variable"))
	variableNameField <- ttkentry(top, width="20", textvariable=variableName)
	datasetName <- tclVar(gettextRcmdr("StackedData"))
	datasetNameField <- ttkentry(top, width="20", textvariable=datasetName)
	onOK <- function(){
		variables <- getSelection(variableBox)
		facname <- tclvalue(factorName)
		varname <- tclvalue(variableName)
		dsname <- tclvalue(datasetName)
		closeDialog()
		if (length(variables) < 2) {
			errorCondition(recall=Stack,
				message=gettextRcmdr("You must select at least two variables."))
			return()
		}
		if (!is.valid.name(facname)){
			errorCondition(recall=Stack,
				message=paste('"', facname, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (!is.valid.name(varname)){
			errorCondition(recall=Stack,
				message=paste('"', varname, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (!is.valid.name(dsname)){
			errorCondition(recall=Stack,
				message=paste('"', dsname, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (is.element(dsname, listDataSets())) {
			if ("no" == tclvalue(checkReplace(dsname, gettextRcmdr("Data set")))){
				Stack()
				return()
			}
		}
		command <- paste(dsname, " <- stack(", activeDataSet(), "[, c(",
			paste(paste('"', variables, '"', sep=""), collapse=","), ")])", sep="")
		logger(command)
		result <- justDoIt(command)
		command <- paste("names(", dsname, ') <- c("', varname, '", "', facname, '")',
			sep="")
		logger(command)
		justDoIt(command)
		if (class(result)[1] !=  "try-error") activeDataSet(dsname)
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="stack")
	tkgrid(getFrame(variableBox), sticky="nw", columnspan=2)
	tkgrid(labelRcmdr(top, text=""))
	tkgrid(labelRcmdr(top,
			text=gettextRcmdr("Name for stacked data set:")), datasetNameField, sticky="w")
	tkgrid(labelRcmdr(top,
			text=gettextRcmdr("Name for variable:")), variableNameField, sticky="w")
	tkgrid(labelRcmdr(top,
			text=gettextRcmdr("Name for factor:")), factorNameField, sticky="w")
	tkgrid(buttonsFrame, sticky="w", columnspan=2)
	dialogSuffix(rows=5, columns=2, preventGrabFocus=TRUE)
}

loadDataSet <- function() {
	file <- tclvalue(tkgetOpenFile(filetypes=
				gettextRcmdr('{"R Data Files" {".rda" ".Rda" ".RDA" ".RData"}} {"All Files" {"*"}}')))
	if (file == "") return()
	command <- paste('load("', file,'")', sep="")
	dsname <- justDoIt(command)
	logger(command)
	if (class(dsname)[1] !=  "try-error") activeDataSet(dsname)
	tkfocus(CommanderWindow())
}

saveDataSet <- function() {
	file <- tclvalue(tkgetSaveFile(filetypes=
				gettextRcmdr('{"R Data Files" {".rda" ".Rda" ".RDA" ".RData"}} {"All Files" {"*"}}'),
			defaultextension="rda", initialfile=paste(activeDataSet(), "rda", sep=".")))
	if (file == "") return()
	command <- paste('save("', activeDataSet(), '", file="', file, '")', sep="")
	justDoIt(command)
	logger(command)
}

RemoveRows <- function(){
	dataSet <- activeDataSet()
	initializeDialog(title=gettextRcmdr("Remove Rows from Active Data Set"))
	removeVariable <- tclVar(gettextRcmdr(""))
	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, ...))
	newDataSetName <- tclVar(gettextRcmdr("<same as active data set>"))
	dataSetNameFrame <- tkframe(top)
	dataSetNameEntry <- ttkentry(dataSetNameFrame, width="25", textvariable=newDataSetName)
	onOK <- function(){
		newName <- trim.blanks(tclvalue(newDataSetName))
		if (newName == gettextRcmdr("<same as active data set>")) newName <- ActiveDataSet()
		if (!is.valid.name(newName)){
			errorCondition(recall=RemoveRows,
				message=paste('"', newName, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (is.element(newName, listDataSets())) {
			if ("no" == tclvalue(checkReplace(newName, type=gettextRcmdr("Data set")))){
				closeDialog()
				RemoveRows()
				return()
			}
		}
		remove <- tclvalue(removeVariable)
		if (remove==""){
			errorCondition(recall=RemoveRows,
				message="No rows to remove")
			closeDialog()
			return()
		}
		removeRows <- paste("c(", gsub(" ", ",", remove), ")", sep="")
		remove <- try(eval(parse(text=removeRows)), silent=TRUE)
		if (class(remove) == "try-error"){
			errorCondition(recall=RemoveRows,
				message=remove)
			closeDialog()
			return()
		}
		closeDialog()
		removeRows <- if (is.numeric(remove)) paste("-", removeRows, sep="") 
			else paste("!(rownames(", ActiveDataSet(), ") %in% ", removeRows, ")", sep="")
		command <- paste(newName, " <- ", ActiveDataSet(), "[", removeRows, ",]", sep="")
		logger(command)
		result <- justDoIt(command)
		if (class(result)[1] !=  "try-error") activeDataSet(newName)
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="[.data.frame")
	tkgrid(labelRcmdr(removeFrame, text=gettextRcmdr("Indices or quoted names of row(s) to remove"),
			foreground="blue"), sticky="w")
	tkgrid(removeEntry, sticky="w")
	tkgrid(removeScroll, sticky="ew")
	tkgrid(removeFrame, sticky="w")
	tkgrid(labelRcmdr(dataSetNameFrame, text=gettextRcmdr("Name for new data set")), sticky="w")
	tkgrid(dataSetNameEntry, sticky="w")
	tkgrid(dataSetNameFrame, sticky="w")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=3, columns=1)
}

mergeDataSets <- function(){
	dataSets <- listDataSets()
	.activeDataSet <- ActiveDataSet()
	initializeDialog(title=gettextRcmdr("Merge Data Sets"))
	dsname <- tclVar("MergedDataset")
	dsnameFrame <- tkframe(top)
	entryDsname <- ttkentry(dsnameFrame, width="20", textvariable=dsname)
	dataSet1Box <- variableListBox(top, dataSets, title=gettextRcmdr("First Data Set (pick one)"),
		initialSelection=if (is.null(.activeDataSet)) NULL else which(.activeDataSet == dataSets) - 1)
	dataSet2Box <- variableListBox(top, dataSets, title=gettextRcmdr("Second Data Set (pick one)"))
	commonVar <- tclVar("0")
	commonFrame <- tkframe(top)
	commonButton <- tkcheckbutton(commonFrame, variable=commonVar)	
	radioButtons(top, "direction", buttons=c("rows", "columns"), 
		labels=gettextRcmdr(c("Merge rows", "Merge columns")), title=gettextRcmdr("Direction of Merge"))
	onOK <- function(){
		dsnameValue <- trim.blanks(tclvalue(dsname))
		if (dsnameValue == "") {
			errorCondition(recall=mergeDataSets,
				message=gettextRcmdr("You must enter the name of a data set."))
			return()
		}
		if (!is.valid.name(dsnameValue)) {
			errorCondition(recall=mergeDataSets,
				message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (is.element(dsnameValue, listDataSets())) {
			if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
				closeDialog()
				mergeDataSets()
				return()
			}
		}
		name1 <- getSelection(dataSet1Box)
		name2 <- getSelection(dataSet2Box)
		if (length(name1) == 0){
			errorCondition(recall=mergeDataSets,
				message=gettextRcmdr("You must select a data set."))
			return()
		}
		if (length(name2) == 0){
			errorCondition(recall=mergeDataSets,
				message=gettextRcmdr("You must select a data set."))
			return()
		}
		if (name1 == name2){
			errorCondition(recall=mergeDataSets,
				message=gettextRcmdr("You cannot merge a data set with itself."))
			return()
		}
		common <- if (tclvalue(commonVar) == "1") TRUE else FALSE
		direction <- tclvalue(directionVariable)
		if (direction == "rows"){
			command <- paste(dsnameValue, " <- mergeRows(", name1, ", ", name2,
				", common.only=", common, ")", sep="")
			doItAndPrint(command)	
		}
		else {
			command <- paste(dsnameValue, " <- merge(", name1, ", ", name2,
				", all=", !common, ', by="row.names")', sep="")
			doItAndPrint(command)
			command <- paste("rownames(", dsnameValue, ") <- ", dsnameValue, "$Row.names", sep="")
			doItAndPrint(command)
			command <- paste(dsnameValue, "$Row.names <- NULL", sep="")
			doItAndPrint(command)
		}
		activeDataSet(dsnameValue)
		closeDialog()
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(help="mergeRows")
	tkgrid(labelRcmdr(dsnameFrame, text=gettextRcmdr("Name for merged data set:  ")), entryDsname)
	tkgrid(dsnameFrame, sticky="w", columnspan=2)
	tkgrid(getFrame(dataSet1Box), getFrame(dataSet2Box), sticky="nw")
	tkgrid(labelRcmdr(commonFrame, text=gettextRcmdr("Merge only common\nrows or columns")), 
		commonButton, sticky="nw")
	tkgrid(directionFrame, commonFrame, sticky="sw")
	tkgrid(buttonsFrame, sticky="w", columnspan=2)
	dialogSuffix(rows=5, columns=2)
}

Aggregate <- function(){
	.activeDataSet <- ActiveDataSet()
	initializeDialog(title=gettextRcmdr("Aggregate Observations"))
	dsname <- tclVar("AggregatedData")
	dsnameFrame <- tkframe(top)
	entryDsname <- ttkentry(dsnameFrame, width="20", textvariable=dsname)
	variablesBox <- variableListBox(top, Variables(), 
		title=gettextRcmdr("Variables to aggregate\n(pick one or more)"),
		selectmode="multiple")
	byBox <- variableListBox(top, Factors(), 
		title=gettextRcmdr("Aggregate by\n(pick one or more)"),
		selectmode="multiple")
	radioButtons(name="statistic", buttons=c("mean", "sum"), labels=gettextRcmdr(c("Mean", "Sum")), 
		title=gettextRcmdr("Statistic"))
	otherVariable <- tclVar("")
	otherButton <- ttkradiobutton(statisticFrame, variable=statisticVariable, value="other")
	otherEntry <- ttkentry(statisticFrame, width="20", textvariable=otherVariable)   
	tkgrid(labelRcmdr(statisticFrame, text=gettextRcmdr("Other (specify)")), otherButton, otherEntry, sticky="w")
	onOK <- function(){
		dsnameValue <- trim.blanks(tclvalue(dsname))
		if (dsnameValue == "") {
			errorCondition(recall=Aggregate,
				message=gettextRcmdr("You must enter the name of a data set."))
			return()
		}
		if (!is.valid.name(dsnameValue)) {
			errorCondition(recall=Aggregate,
				message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
			return()
		}
		if (is.element(dsnameValue, listDataSets())) {
			if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
				Aggregate()
				return()
			}
		}
		variables <- getSelection(variablesBox)
		byVariables <- getSelection(byBox)
		if (length(variables) == 0){
			errorCondition(recall=Aggregate,
				message=gettextRcmdr("You must select at least one variable to aggregate."))
			return()
		}
		if (length(byVariables) == 0){
			errorCondition(recall=Aggregate,
				message=gettextRcmdr("You must select at least one variable to aggregate by."))
			return()
		}
		if (any(byVariables %in% variables)){
			errorCondition(recall=Aggregate,
				message=gettextRcmdr("Variables to aggregate and those to aggregate by must be different."))
			return()
		}
		statistic <- tclvalue(statisticVariable)
		if (statistic == "other") statistic <- tclvalue(otherVariable)
		vars <- paste(paste('"', variables, '"', sep=""), collapse=",")
		by <-paste("list(", paste(paste(byVariables, "=", .activeDataSet, "$", byVariables, sep=""), 
				collapse=", "), ")", sep="")
		command <- paste(dsnameValue, " <- aggregate(", .activeDataSet, "[,c(", vars, "), drop=FALSE], by=", by,
			", FUN=", statistic, ")", sep="")
		doItAndPrint(command)
		activeDataSet(dsnameValue)
		closeDialog()
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(help="aggregate")
	tkgrid(labelRcmdr(dsnameFrame, text=gettextRcmdr("Name for aggregated data set:  ")), entryDsname)
	tkgrid(dsnameFrame, sticky="w", columnspan=2)
	tkgrid(getFrame(variablesBox), getFrame(byBox), sticky="nw")
	tkgrid(statisticFrame, sticky="w", columnspan=2)
	tkgrid(buttonsFrame, sticky="w", columnspan=2)
	dialogSuffix(rows=5, columns=2)
}
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/distributions-menu.R"
# Distributions menu dialogs

# last modified 8 July 2010 by J. Fox

#   many distributions added (and some other changes) by Miroslav Ristic (20 July 06)

normalQuantiles <- function(){
    initializeDialog(title=gettextRcmdr("Normal Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    muVar <- tclVar("0")
    muEntry <- ttkentry(top, width="6", textvariable=muVar)
    sigmaVar <- tclVar("1")
    sigmaEntry <- ttkentry(top, width="6", textvariable=sigmaVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
        if ("" == quantiles) {
            errorCondition(recall=normalQuantiles, message=gettextRcmdr("No probabilities specified."))
            return()
            }
		warn <- options(warn=-1)
        mu <- as.numeric(tclvalue(muVar))
        sigma <- as.numeric(tclvalue(sigmaVar))
		options(warn)
		if (is.na(mu)) {
			errorCondition(recall=normalQuantiles, message=gettextRcmdr("Mean not specified."))
			return()
			}
        if (is.na(sigma) || sigma <= 0) {
            errorCondition(recall=normalQuantiles, message=gettextRcmdr("Standard deviation must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("qnorm(c(", quantiles, "), mean=", mu,
            ", sd=", sigma, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qnorm")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("mu (mean)")), muEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("sigma (standard deviation)")), sigmaEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(muEntry, sticky="w")
    tkgrid.configure(sigmaEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=quantilesEntry)
    }

normalProbabilities <- function(){
    initializeDialog(title=gettextRcmdr("Normal Probabilities"))
    probabilitiesVar <- tclVar("")
    probabilitiesEntry <- ttkentry(top, width="30", textvariable=probabilitiesVar)
    muVar <- tclVar("0")
    muEntry <- ttkentry(top, width="6", textvariable=muVar)
    sigmaVar <- tclVar("1")
    sigmaEntry <- ttkentry(top, width="6", textvariable=sigmaVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <-  gsub(" +", ",", gsub(",", " ", tclvalue(probabilitiesVar)))
        if ("" == probabilities) {
            errorCondition(recall=normalProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
		warn <- options(warn=-1)
        mu <- as.numeric(tclvalue(muVar))
        sigma <- as.numeric(tclvalue(sigmaVar))
		options(warn)
		if (is.na(mu)) {
			errorCondition(recall=normalQuantiles, message=gettextRcmdr("Mean not specified."))
			return()
		}
        if (is.na(sigma) || sigma <= 0) {
            errorCondition(recall=normalProbabilities, message=gettextRcmdr("Standard deviation must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("pnorm(c(", probabilities, "), mean=", mu, 
            ", sd=", sigma, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="pnorm")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("mu (mean)")), muEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("sigma (standard deviation)")), sigmaEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(probabilitiesEntry, sticky="w")
    tkgrid.configure(muEntry, sticky="w")
    tkgrid.configure(sigmaEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=1, focus=probabilitiesEntry)
    }
    
tQuantiles <- function(){
    initializeDialog(title=gettextRcmdr("t Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    dfVar <- tclVar("")
    dfEntry <- ttkentry(top, width="6", textvariable=dfVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
        if ("" == quantiles) {
            errorCondition(recall=tQuantiles, message=gettextRcmdr("No probabilities specified.")) 
            return()
            }
		warn <- options(warn=-1)
        df <- as.numeric(tclvalue(dfVar))
		options(warn)
        if (is.na(df)) {
            errorCondition(recall=tQuantiles, message=gettextRcmdr("Degrees of freedom not specified."))
            return()
            }
        if (df <= 0) {
            errorCondition(recall=tQuantiles, message=gettextRcmdr("Degrees of freedom must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("qt(c(", quantiles, "), df=", df, 
            ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qt")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Degrees of freedom")), dfEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(dfEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=5, columns=2, focus=quantilesEntry)
    }
    
tProbabilities <- function(){
    initializeDialog(title=gettextRcmdr("t Probabilities"))
    probabilitiesVar <- tclVar("")
    probabilitiesEntry <- ttkentry(top, width="30", textvariable=probabilitiesVar)
    dfVar <- tclVar("")
    dfEntry <- ttkentry(top, width="6", textvariable=dfVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <-  gsub(" +", ",", gsub(",", " ", tclvalue(probabilitiesVar)))
		warn <- options(warn=-1)
        df <- as.numeric(tclvalue(dfVar))
		options(warn)
        if ("" == probabilities) {
            errorCondition(recall=tProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
        if (is.na(df)) {
            errorCondition(recall=tProbabilities, message=gettextRcmdr("Degrees of freedom not specified."))
            return()
            }
        if (df <= 0) {
            errorCondition(recall=tProbabilities, message=gettextRcmdr("Degrees of freedom must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("pt(c(", probabilities, "), df=", df, 
            ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="pt")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Degrees of freedom")), dfEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(probabilitiesEntry, sticky="w")
    tkgrid.configure(dfEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=5, columns=2, focus=probabilitiesEntry)
    }

chisqQuantiles <- function(){
    initializeDialog(title=gettextRcmdr("Chi-Squared Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    dfVar <- tclVar("")
    dfEntry <- ttkentry(top, width="6", textvariable=dfVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
        if ("" == quantiles) {
            errorCondition(recall=chisqQuantiles, message=gettextRcmdr("No probabilities specified."))
            return()
            }
		warn <- options(warn=-1)
        df <- as.numeric(tclvalue(dfVar))
		options(warn)
        if (is.na(df)) {
            errorCondition(recall=chisqQuantiles, message=gettextRcmdr("Degrees of freedom not specified."))
            return()
            }
        if (df <= 0) {
            errorCondition(recall=chisqQuantiles, message=gettextRcmdr("Degrees of freedom must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("qchisq(c(", quantiles, "), df=", df, 
            ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qchisq")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Degrees of freedom")), dfEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(dfEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=5, columns=2, focus=quantilesEntry)
    }
    
chisqProbabilities <- function(){
    initializeDialog(title=gettextRcmdr("Chi-Squared Probabilities"))
    probabilitiesVar <- tclVar("")
    probabilitiesEntry <- ttkentry(top, width="30", textvariable=probabilitiesVar)
    dfVar <- tclVar("")
    dfEntry <- ttkentry(top, width="6", textvariable=dfVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <-  gsub(" +", ",", gsub(",", " ", tclvalue(probabilitiesVar)))
        if ("" == probabilities) {
            errorCondition(recall=chisqProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
		warn <- options(warn=-1)
        df <- as.numeric(tclvalue(dfVar))
		options(warn)
        if (is.na(df)) {
            errorCondition(recall=chisqProbabilities, message=gettextRcmdr("Degrees of freedom not specified."))
            return()
            }
        if (df <= 0) {
            errorCondition(recall=chisqProbabilities, message=gettextRcmdr("Degrees of freedom must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("pchisq(c(", probabilities, "), df=", df, 
            ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="pchisq")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Degrees of freedom")), dfEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(OKbutton, cancelButton, sticky="w")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(probabilitiesEntry, sticky="w")
    tkgrid.configure(dfEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=5, columns=2, focus=probabilitiesEntry)
    }

FQuantiles <- function(){
    initializeDialog(title=gettextRcmdr("F Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    df1Var <- tclVar("")
    df1Entry <- ttkentry(top, width="6", textvariable=df1Var)
    df2Var <- tclVar("")
    df2Entry <- ttkentry(top, width="6", textvariable=df2Var)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
        if ("" == quantiles) {
            errorCondition(recall=FQuantiles, message=gettextRcmdr("Probabilities not specified"))
            return()
            }
		warn <- options(warn=-1)
        df1 <- as.numeric(tclvalue(df1Var))
        df2 <- as.numeric(tclvalue(df2Var))
		options(warn)
        if (is.na(df1) || is.na(df2)) {
            errorCondition(recall=FQuantiles, message=gettextRcmdr("Degrees of freedom not specified."))
            return()
            }
        if (df1 <= 0 || df2 <= 0) {
            errorCondition(recall=FQuantiles, message=gettextRcmdr("Degrees of freedom must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("qf(c(", quantiles, "), df1=", df1, 
            ", df2=", df2, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qf")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Numerator degrees of freedom")), df1Entry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Denominator degrees of freedom")), df2Entry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(df1Entry, sticky="w")
    tkgrid.configure(df2Entry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=quantilesEntry)
    }
    
FProbabilities <- function(){
    initializeDialog(title=gettextRcmdr("F Probabilities"))
    probabilitiesVar <- tclVar("")
    probabilitiesEntry <- ttkentry(top, width="30", textvariable=probabilitiesVar)
    df1Var <- tclVar("")
    df1Entry <- ttkentry(top, width="6", textvariable=df1Var)
    df2Var <- tclVar("")
    df2Entry <- ttkentry(top, width="6", textvariable=df2Var)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <-  gsub(" +", ",", gsub(",", " ", tclvalue(probabilitiesVar)))
        if ("" == probabilities) {
            errorCondition(recall=FProbabilities, message=gettextRcmdr("Values not specified."))
            return()
            }
		warn <- options(warn=-1)
        df1 <- as.numeric(tclvalue(df1Var))
        df2 <- as.numeric(tclvalue(df2Var))
		options(warn=-1)
        if (is.na(df1) || is.na(df2)) {
            errorCondition(recall=FProbabilities, message=gettextRcmdr("Degrees of freedom not specified."))
            return()
            }
        if (df1 <= 0 || df2 <= 0) {
            errorCondition(recall=FProbabilities, message=gettextRcmdr("Degrees of freedom must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("pf(c(", probabilities, "), df1=", df1, 
            ", df2=", df2, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="pf")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Numerator degrees of freedom")), df1Entry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Denominator degrees of freedom")), df2Entry, sticky="e")    
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(probabilitiesEntry, sticky="w")
    tkgrid.configure(df1Entry, sticky="w")
    tkgrid.configure(df2Entry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=probabilitiesEntry)
    }
    
exponentialQuantiles<-function() { 
    initializeDialog(title=gettextRcmdr("Exponential Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    rateVar <- tclVar("1")
    rateEntry <- ttkentry(top, width="6", textvariable=rateVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
        if ("" == quantiles) {
            errorCondition(recall=exponentialQuantiles, message=gettextRcmdr("Probabilities not specified."))
            return()
            }
		warn <- options(warn=-1)
        rate <- as.numeric(tclvalue(rateVar))
		options(warn)
        if (is.na(rate) || rate <= 0) {
            errorCondition(recall=exponentialQuantiles, message=gettextRcmdr("Rate must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("qexp(c(", quantiles, "), rate=", rate, ", lower.tail=", tail == "lower", ")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qexp")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Rate")), rateEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(rateEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=1, focus=quantilesEntry)
    }
    
exponentialProbabilities <- function(){
    initializeDialog(title=gettextRcmdr("Exponential Probabilities"))
    probabilitiesVar <- tclVar("")
    probabilitiesEntry <- ttkentry(top, width="30", textvariable=probabilitiesVar)
    rateVar <- tclVar("1")
    rateEntry <- ttkentry(top, width="6", textvariable=rateVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <-  gsub(" +", ",", gsub(",", " ", tclvalue(probabilitiesVar)))
        if ("" == probabilities) {
            errorCondition(recall=exponentialProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
		warn <- options(warn=-1)
        rate <- as.numeric(tclvalue(rateVar))
		options(warn)
        if (is.na(rate) || rate <= 0) {
            errorCondition(recall=exponentialProbabilities, message=gettextRcmdr("Rate must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("pexp(c(", probabilities, "), rate=", rate, ", lower.tail=", tail == "lower", ")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="pexp")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Rate")), rateEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(probabilitiesEntry, sticky="w")
    tkgrid.configure(rateEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=1, focus=probabilitiesEntry)
    }
    
uniformQuantiles<-function() { 
    initializeDialog(title=gettextRcmdr("Uniform Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    minVar <- tclVar("0")
    maxVar <- tclVar("1")
    minEntry <- ttkentry(top, width="6", textvariable=minVar)
    maxEntry <- ttkentry(top, width="6", textvariable=maxVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
        if ("" == quantiles) {
            errorCondition(recall=uniformQuantiles, message=gettextRcmdr("Probabilities not specified."))
            return()
            }
		warn <- options(warn=-1)
        min <- as.numeric(tclvalue(minVar))
        max <- as.numeric(tclvalue(maxVar))
		options(warn)
        if (is.na(min) || is.na(max) || min >= max) {
            errorCondition(recall=uniformQuantiles, message=gettextRcmdr("Lower limit must be less than upper limit."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("qunif(c(", quantiles, "), min=", min, ", max=", max, ", lower.tail=", tail == "lower", ")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qunif")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Minimum")), minEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Maximum")), maxEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(minEntry, sticky="w")
    tkgrid.configure(maxEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=1, focus=quantilesEntry)
    }
    
uniformProbabilities <- function(){
    initializeDialog(title=gettextRcmdr("Uniform Probabilities"))
    probabilitiesVar <- tclVar("")
    probabilitiesEntry <- ttkentry(top, width="30", textvariable=probabilitiesVar)
    minVar <- tclVar("0")
    maxVar <- tclVar("1")
    minEntry <- ttkentry(top, width="6", textvariable=minVar)
    maxEntry <- ttkentry(top, width="6", textvariable=maxVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <-  gsub(" +", ",", gsub(",", " ", tclvalue(probabilitiesVar)))
		warn <- options(warn=-1)
        min <- as.numeric(tclvalue(minVar))
        max <- as.numeric(tclvalue(maxVar))
		options(warn)
        tail <- tclvalue(tailVar)
        if ("" == probabilities) {
            errorCondition(recall=uniformProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
        if (is.na(min) || is.na(max) || min >= max) {
            errorCondition(recall=uniformProbabilities, message=gettextRcmdr("Lower limit must be less than upper limit."))
            return()
            }
        doItAndPrint(paste("punif(c(", probabilities, "), min=", min, ", max=", max, ", lower.tail=", tail == "lower", ")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="punif")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Minimum")), minEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Maximum")), maxEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(probabilitiesEntry, sticky="w")
    tkgrid.configure(minEntry, sticky="w")
    tkgrid.configure(maxEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=1, focus=probabilitiesEntry)
    }
    
betaQuantiles <- function(){
    initializeDialog(title=gettextRcmdr("Beta Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    shape1Var <- tclVar("")
    shape1Entry <- ttkentry(top, width="6", textvariable=shape1Var)
    shape2Var <- tclVar("")
    shape2Entry <- ttkentry(top, width="6", textvariable=shape2Var)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
        if ("" == quantiles) {
            errorCondition(recall=betaQuantiles, message=gettextRcmdr("Probabilities not specified"))
            return()
            }
		warn <- options(warn=-1)
        shape1 <- as.numeric(tclvalue(shape1Var))
        shape2 <- as.numeric(tclvalue(shape2Var))
		options(warn)
        if (is.na(shape1) || is.na(shape2)) {
            errorCondition(recall=betaQuantiles, message=gettextRcmdr("Shapes not specified."))
            return()
            }
        if (shape1 <= 0 || shape2 <= 0) {
            errorCondition(recall=betaQuantiles, message=gettextRcmdr("Shapes must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("qbeta(c(", quantiles, "), shape1=", shape1, 
            ", shape2=", shape2, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qbeta")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=paste(gettextRcmdr("Shape"), "1")), shape1Entry, sticky="e")
    tkgrid(labelRcmdr(top, text=paste(gettextRcmdr("Shape"), "2")), shape2Entry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(shape1Entry, sticky="w")
    tkgrid.configure(shape2Entry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=quantilesEntry)
    }
    
betaProbabilities <- function(){
    initializeDialog(title=gettextRcmdr("Beta Probabilities"))
    probabilitiesVar <- tclVar("")
    probabilitiesEntry <- ttkentry(top, width="30", textvariable=probabilitiesVar)
    shape1Var <- tclVar("")
    shape1Entry <- ttkentry(top, width="6", textvariable=shape1Var)
    shape2Var <- tclVar("")
    shape2Entry <- ttkentry(top, width="6", textvariable=shape2Var)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <-  gsub(" +", ",", gsub(",", " ", tclvalue(probabilitiesVar)))
        if ("" == probabilities) {
            errorCondition(recall=betaProbabilities, message=gettextRcmdr("Values not specified."))
            return()
            }
		warn <- options(warn=-1)
        shape1 <- as.numeric(tclvalue(shape1Var))
        shape2 <- as.numeric(tclvalue(shape2Var))
		options(warn)
        if (is.na(shape1) || is.na(shape2)) {
            errorCondition(recall=betaProbabilities, message=gettextRcmdr("Shapes not specified."))
            return()
            }
        if (shape1 <= 0 || shape2 <= 0) {
            errorCondition(recall=betaProbabilities, message=gettextRcmdr("Shapes must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("pbeta(c(", probabilities, "), shape1=", shape1, 
            ", shape2=", shape2, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="pbeta")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=paste(gettextRcmdr("Shape"), "1")), shape1Entry, sticky="e")
    tkgrid(labelRcmdr(top, text=paste(gettextRcmdr("Shape"), "2")), shape2Entry, sticky="e")    
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(probabilitiesEntry, sticky="w")
    tkgrid.configure(shape1Entry, sticky="w")
    tkgrid.configure(shape2Entry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=probabilitiesEntry)
    }
    
CauchyQuantiles <- function(){
    initializeDialog(title=gettextRcmdr("Cauchy Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    locationVar <- tclVar("0")
    locationEntry <- ttkentry(top, width="6", textvariable=locationVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
        if ("" == quantiles) {
            errorCondition(recall=CauchyQuantiles, message=gettextRcmdr("No probabilities specified."))
            return()
            }
		warn <- options(warn=-1)
        location <- as.numeric(tclvalue(locationVar))
        s <- as.numeric(tclvalue(sVar))
		options(warn)
        if (is.na(s) || s <= 0) {
            errorCondition(recall=CauchyQuantiles, message=gettextRcmdr("Scale must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("qcauchy(c(", quantiles, "), location=", location,
            ", scale=", s, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qcauchy")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Location")), locationEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(locationEntry, sticky="w")
    tkgrid.configure(sEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=quantilesEntry)
    }

CauchyProbabilities <- function(){
    initializeDialog(title=gettextRcmdr("Cauchy Probabilities"))
    probabilitiesVar <- tclVar("")
    probabilitiesEntry <- ttkentry(top, width="30", textvariable=probabilitiesVar)
    locationVar <- tclVar("0")
    locationEntry <- ttkentry(top, width="6", textvariable=locationVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <-  gsub(" +", ",", gsub(",", " ", tclvalue(probabilitiesVar)))
        if ("" == probabilities) {
            errorCondition(recall=CauchyProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
		warn <- options(warn=-1)
        location <- as.numeric(tclvalue(locationVar))
        s <- as.numeric(tclvalue(sVar))
		options(warn)
        if (is.na(s) || s <= 0) {
            errorCondition(recall=CauchyProbabilities, message=gettextRcmdr("Scale must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("pcauchy(c(", probabilities, "), location=", location, 
            ", scale=", s, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="pcauchy")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Location")), locationEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(probabilitiesEntry, sticky="w")
    tkgrid.configure(locationEntry, sticky="w")
    tkgrid.configure(sEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=1, focus=probabilitiesEntry)
    }
    
logisticQuantiles <- function(){
    initializeDialog(title=gettextRcmdr("Logistic Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    locationVar <- tclVar("0")
    locationEntry <- ttkentry(top, width="6", textvariable=locationVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
        if ("" == quantiles) {
            errorCondition(recall=logisticQuantiles, message=gettextRcmdr("No probabilities specified."))
            return()
            }
		warn <- options(warn=-1)
        location <- as.numeric(tclvalue(locationVar))
        s <- as.numeric(tclvalue(sVar))
		options(warn)
        if (is.na(s) || s <= 0) {
            errorCondition(recall=logisticQuantiles, message=gettextRcmdr("Scale must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("qlogis(c(", quantiles, "), location=", location,
            ", scale=", s, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qlogis")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Location")), locationEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(locationEntry, sticky="w")
    tkgrid.configure(sEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=quantilesEntry)
    }

logisticProbabilities <- function(){
    initializeDialog(title=gettextRcmdr("Logistic Probabilities"))
    probabilitiesVar <- tclVar("")
    probabilitiesEntry <- ttkentry(top, width="30", textvariable=probabilitiesVar)
    locationVar <- tclVar("0")
    locationEntry <- ttkentry(top, width="6", textvariable=locationVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <-  gsub(" +", ",", gsub(",", " ", tclvalue(probabilitiesVar)))
        if ("" == probabilities) {
            errorCondition(recall=logisticProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
		warn <- options(warn=-1)
        location <- as.numeric(tclvalue(locationVar))
        s <- as.numeric(tclvalue(sVar))
		options(warn)
        if (is.na(s) || s <= 0) {
            errorCondition(recall=logisticProbabilities, message=gettextRcmdr("Scale must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("plogis(c(", probabilities, "), location=", location, 
            ", scale=", s, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="plogis")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Location")), locationEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(probabilitiesEntry, sticky="w")
    tkgrid.configure(locationEntry, sticky="w")
    tkgrid.configure(sEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=1, focus=probabilitiesEntry)
    }
    
lognormalQuantiles <- function(){
    initializeDialog(title=gettextRcmdr("Lognormal Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    meanlogVar <- tclVar("0")
    meanlogEntry <- ttkentry(top, width="6", textvariable=meanlogVar)
    sdlogVar <- tclVar("1")
    sdlogEntry <- ttkentry(top, width="6", textvariable=sdlogVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
        if ("" == quantiles) {
            errorCondition(recall=lognormalQuantiles, message=gettextRcmdr("No probabilities specified."))
            return()
            }
		warn <- options(warn=-1)
        meanlog <- as.numeric(tclvalue(meanlogVar))
        sdlog <- as.numeric(tclvalue(sdlogVar))
		options(warn)
		if (is.na(meanlog)){
			errorCondition(recall=lognormalQuantiles, message=gettextRcmdr("Mean not specified."))
			return()
			}
        if (is.na(sdlog) || sdlog <= 0) {
            errorCondition(recall=lognormalQuantiles, message=gettextRcmdr("Standard deviation must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("qlnorm(c(", quantiles, "), meanlog=", meanlog,
            ", sdlog=", sdlog, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qlnorm")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Mean (log scale)")), meanlogEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Standard deviation (log scale)")), sdlogEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(meanlogEntry, sticky="w")
    tkgrid.configure(sdlogEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=quantilesEntry)
    }

lognormalProbabilities <- function(){
    initializeDialog(title=gettextRcmdr("Lognormal Probabilities"))
    probabilitiesVar <- tclVar("")
    probabilitiesEntry <- ttkentry(top, width="30", textvariable=probabilitiesVar)
    meanlogVar <- tclVar("0")
    meanlogEntry <- ttkentry(top, width="6", textvariable=meanlogVar)
    sdlogVar <- tclVar("1")
    sdlogEntry <- ttkentry(top, width="6", textvariable=sdlogVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <-  gsub(" +", ",", gsub(",", " ", tclvalue(probabilitiesVar)))
        if ("" == probabilities) {
            errorCondition(recall=lognormalProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
		warn <- options(warn=-1)
        meanlog <- as.numeric(tclvalue(meanlogVar))
        sdlog <- as.numeric(tclvalue(sdlogVar))
		options(warn)
		if (is.na(meanlog)) {
			errorCondition(recall=lognormalProbabilities, message=gettextRcmdr("Mean not specified."))
			return()
			}
	    if (is.na(sdlog) || sdlog <= 0) {
	        errorCondition(recall=lognormalProbabilities, message=gettextRcmdr("Scale must be positive."))
	        return()
	        }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("plnorm(c(", probabilities, "), meanlog=", meanlog, 
            ", sdlog=", sdlog, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="plnorm")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Mean (log scale)")), meanlogEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Standard deviation (log scale)")), sdlogEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(probabilitiesEntry, sticky="w")
    tkgrid.configure(meanlogEntry, sticky="w")
    tkgrid.configure(sdlogEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=1, focus=probabilitiesEntry)
    }

gammaQuantiles <- function(){
    initializeDialog(title=gettextRcmdr("Gamma Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    shapeVar <- tclVar("")
    shapeEntry <- ttkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
        if ("" == quantiles) {
            errorCondition(recall=gammaQuantiles, message=gettextRcmdr("No probabilities specified."))
            return()
            }
		warn <- options(warn=-1)
        shape <- as.numeric(tclvalue(shapeVar))
		s <- as.numeric(tclvalue(sVar))
		options(warn)
        if (is.na(shape)) {
            errorCondition(recall=gammaQuantiles, message=gettextRcmdr("Shape not specified."))
            return()
            }
        if (shape <= 0) {
            errorCondition(recall=gammaQuantiles, message=gettextRcmdr("Shape must be positive."))
            return()
            }
        if (is.na(s) || s <= 0) {
            errorCondition(recall=gammaQuantiles, message=gettextRcmdr("Scale must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("qgamma(c(", quantiles, "), shape=", shape,
            ", scale=", s, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qgamma")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Shape")), shapeEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale (inverse rate)")), sEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(shapeEntry, sticky="w")
    tkgrid.configure(sEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=quantilesEntry)
    }

gammaProbabilities <- function(){
    initializeDialog(title=gettextRcmdr("Gamma Probabilities"))
    probabilitiesVar <- tclVar("")
    probabilitiesEntry <- ttkentry(top, width="30", textvariable=probabilitiesVar)
    shapeVar <- tclVar("")
    shapeEntry <- ttkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <-  gsub(" +", ",", gsub(",", " ", tclvalue(probabilitiesVar)))
        if ("" == probabilities) {
            errorCondition(recall=gammaProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
		warn <- options(warn=-1)
        shape <- as.numeric(tclvalue(shapeVar))
		s <- as.numeric(tclvalue(sVar))
		options(warn)
        if (is.na(shape)) {
            errorCondition(recall=gammaProbabilities, message=gettextRcmdr("Shape not specified."))
            return()
            }
        if (shape <= 0) {
            errorCondition(recall=gammaProbabilities, message=gettextRcmdr("Shape must be positive."))
            return()
            }
        if (is.na(s) || s <= 0) {
            errorCondition(recall=gammaProbabilities, message=gettextRcmdr("Scale must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("pgamma(c(", probabilities, "), shape=", shape, 
            ", scale=", s, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="pgamma")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Shape")), shapeEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale (inverse rate)")), sEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(probabilitiesEntry, sticky="w")
    tkgrid.configure(shapeEntry, sticky="w")
    tkgrid.configure(sEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=1, focus=probabilitiesEntry)
    }

WeibullQuantiles <- function(){
    initializeDialog(title=gettextRcmdr("Weibull Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    shapeVar <- tclVar("")
    shapeEntry <- ttkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
        if ("" == quantiles) {
            errorCondition(recall=WeibullQuantiles, message=gettextRcmdr("No probabilities specified."))
            return()
            }
		warn <- options(warn=-1)
        shape <- as.numeric(tclvalue(shapeVar))
		s <- as.numeric(tclvalue(sVar))
		options(warn)
        if (is.na(shape)) {
            errorCondition(recall=WeibullQuantiles, message=gettextRcmdr("Shape not specified."))
            return()
            }
        if (shape <= 0) {
            errorCondition(recall=WeibullQuantiles, message=gettextRcmdr("Shape must be positive."))
            return()
            }
        if (is.na(s) || s <= 0) {
            errorCondition(recall=WeibullQuantiles, message=gettextRcmdr("Scale must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("qweibull(c(", quantiles, "), shape=", shape,
            ", scale=", s, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qweibull")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Shape")), shapeEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(shapeEntry, sticky="w")
    tkgrid.configure(sEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=quantilesEntry)
    }

WeibullProbabilities <- function(){
    initializeDialog(title=gettextRcmdr("Weibull Probabilities"))
    probabilitiesVar <- tclVar("")
    probabilitiesEntry <- ttkentry(top, width="30", textvariable=probabilitiesVar)
    shapeVar <- tclVar("")
    shapeEntry <- ttkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <-  gsub(" +", ",", gsub(",", " ", tclvalue(probabilitiesVar)))
        if ("" == probabilities) {
            errorCondition(recall=WeibullProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
		warn <- options(warn=-1)
        shape <- as.numeric(tclvalue(shapeVar))
		s <- as.numeric(tclvalue(sVar))
		options(warn)
        if (is.na(shape)) {
            errorCondition(recall=WeibullProbabilities, message=gettextRcmdr("Shape not specified."))
            return()
            }
        if (shape <= 0) {
            errorCondition(recall=WeibullProbabilities, message=gettextRcmdr("Shape must be positive."))
            return()
            }
        if (is.na(s) || s <= 0) {
            errorCondition(recall=WeibullProbabilities, message=gettextRcmdr("Scale must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("pweibull(c(", probabilities, "), shape=", shape, 
            ", scale=", s, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="pweibull")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Shape")), shapeEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(probabilitiesEntry, sticky="w")
    tkgrid.configure(shapeEntry, sticky="w")
    tkgrid.configure(sEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=1, focus=probabilitiesEntry)
    }

GumbelQuantiles <- function(){
    initializeDialog(title=gettextRcmdr("Gumbel Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    shapeVar <- tclVar("")
    shapeEntry <- ttkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
        if ("" == quantiles) {
            errorCondition(recall=GumbelQuantiles, message=gettextRcmdr("No probabilities specified."))
            return()
            }
		warn <- options(warn=-1)
        shape <- as.numeric(tclvalue(shapeVar))
		s <- as.numeric(tclvalue(sVar))
		options(warn)
        if (is.na(shape)) {
            errorCondition(recall=GumbelQuantiles, message=gettextRcmdr("Shape not specified."))
            return()
            }
        if (shape <= 0) {
            errorCondition(recall=GumbelQuantiles, message=gettextRcmdr("Shape must be positive."))
            return()
            }
        if (is.na(s) || s <= 0) {
            errorCondition(recall=GumbelQuantiles, message=gettextRcmdr("Scale must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("log(qweibull(c(", quantiles, "), shape=", shape,
            ", scale=", s, ", lower.tail=", tail == "lower",")) # Gumbel distribution", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qweibull")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Shape (log scale)")), shapeEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale (log scale)")), sEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(shapeEntry, sticky="w")
    tkgrid.configure(sEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=quantilesEntry)
    }

GumbelProbabilities <- function(){
    initializeDialog(title=gettextRcmdr("Gumbel Probabilities"))
    probabilitiesVar <- tclVar("")
    probabilitiesEntry <- ttkentry(top, width="30", textvariable=probabilitiesVar)
    shapeVar <- tclVar("")
    shapeEntry <- ttkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <-  gsub(" +", ",", gsub(",", " ", tclvalue(probabilitiesVar)))
        if ("" == probabilities) {
            errorCondition(recall=GumbelProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
		warn <- options(warn=-1)
        shape <- as.numeric(tclvalue(shapeVar))
		s <- as.numeric(tclvalue(sVar))
		options(warn)
        if (is.na(shape)) {
            errorCondition(recall=GumbelProbabilities, message=gettextRcmdr("Shape not specified."))
            return()
            }
        if (shape <= 0) {
            errorCondition(recall=GumbelProbabilities, message=gettextRcmdr("Shape must be positive."))
            return()
            }
        if (is.na(s) || s <= 0) {
            errorCondition(recall=GumbelProbabilities, message=gettextRcmdr("Scale must be positive."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("pweibull(exp(c(", probabilities, ")), shape=", shape, 
            ", scale=", s, ", lower.tail=", tail == "lower",") # Gumbel distribution", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="pweibull")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Shape (log scale)")), shapeEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale (log scale)")), sEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(probabilitiesEntry, sticky="w")
    tkgrid.configure(shapeEntry, sticky="w")
    tkgrid.configure(sEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=1, focus=probabilitiesEntry)
    }
    
    
binomialQuantiles <- function(){
    initializeDialog(title=gettextRcmdr("Binomial Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    trialsVar <- tclVar("")
    trialsEntry <- ttkentry(top, width="6", textvariable=trialsVar)
    probVar <- tclVar(".5")
    probEntry <- ttkentry(top, width="6", textvariable=probVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
		warn <- options(warn=-1)
        trials <- round(as.numeric(tclvalue(trialsVar)))
        prob <- as.numeric(tclvalue(probVar))
		options(warn)
        if ("" == quantiles) {
            errorCondition(recall=binomialQuantiles, message=gettextRcmdr("Probabilities not specified."))
            return()
            }
        if (is.na(trials)) {
            errorCondition(recall=binomialQuantiles, message=gettextRcmdr("Binomial trials not specified."))
            return()
            }
        if (is.na(prob)) {
            errorCondition(recall=binomialQuantiles, message=gettextRcmdr("Probability of success not specified."))
            return()
            }
        if (prob < 0 || prob > 1) {
            errorCondition(recall=binomialQuantiles, message=gettextRcmdr("Probability of success must be between 0 and 1."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("qbinom(c(", quantiles, "), size=", trials, 
            ", prob=", prob, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qbinom")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Binomial trials")), trialsEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame,columnspan=2, sticky="w")
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(trialsEntry, sticky="w")
    tkgrid.configure(probEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=quantilesEntry)
    }
    
binomialProbabilities <- function(){
    initializeDialog(title=gettextRcmdr("Cumulative Binomial Probabilities"))
    probabilitiesVar <- tclVar("")
    probabilitiesEntry <- ttkentry(top, width="30", textvariable=probabilitiesVar)
    trialsVar <- tclVar("")
    trialsEntry <- ttkentry(top, width="6", textvariable=trialsVar)
    probVar <- tclVar(".5")
    probEntry <- ttkentry(top, width="6", textvariable=probVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <-  gsub(" +", ",", gsub(",", " ", tclvalue(probabilitiesVar)))
		warn <- options(warn=-1)
        trials <- round(as.numeric(tclvalue(trialsVar)))
        prob <- as.numeric(tclvalue(probVar))
		options(warn)
        if ("" == probabilities) {
            errorCondition(recall=binomialProbabilities, message=gettextRcmdr("Values not specified.")) 
            return()
            }
        if (is.na(trials)) {
            errorCondition(recall=binomialProbabilities, message=gettextRcmdr("Binomial trials not specified."))
            return()
            }
        if (is.na(prob)) {
            errorCondition(recall=binomialProbabilities, message=gettextRcmdr("Probability of success not specified."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("pbinom(c(", probabilities, "), size=", trials, 
            ", prob=", prob, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="pbinom")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Binomial trials")), trialsEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")    
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(probabilitiesEntry, sticky="w")
    tkgrid.configure(trialsEntry, sticky="w")
    tkgrid.configure(probEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=probabilitiesEntry)
    }

binomialMass <- function(){
    checkTrials <- function(trials){
        RcmdrTkmessageBox(message=sprintf(gettextRcmdr("Number of trials, %d, is large.\nCreate long output?"), trials),
            icon="warning", type="yesno", default="no")
        }
    initializeDialog(title=gettextRcmdr("Binomial Probabilities"))
    trialsVar <- tclVar("")
    trialsEntry <- ttkentry(top, width="6", textvariable=trialsVar)
    probVar <- tclVar(".5")
    probEntry <- ttkentry(top, width="6", textvariable=probVar)
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        trials <- as.numeric(tclvalue(trialsVar))
		prob <- as.numeric(tclvalue(probVar))
		options(warn)
        if (is.na(trials)) {
            errorCondition(recall=binomialMass, message=gettextRcmdr("Binomial trials not specified."))
            return()
            }
        if (trials > 50){
            if ("no" == tclvalue(checkTrials(trials))){
                if (getRcmdr("grab.focus")) tkgrab.release(top)
                tkdestroy(top)
                binomialMass()
                return()
                }
            }
        if (is.na(prob)) {
            errorCondition(recall=binomialMass, message=gettextRcmdr("Probability of success not specified."))
            return()
            }
        command <- paste("data.frame(Pr=dbinom(0:", trials, ", size=", trials, 
            ", prob=", prob, "))", sep="")
        logger(paste(".Table <- ", command, sep=""))
        assign(".Table", justDoIt(command), envir=.GlobalEnv)
        logger(paste("rownames(.Table) <- 0:", trials, sep=""))
        justDoIt(paste("rownames(.Table) <- 0:", trials, sep=""))
        doItAndPrint(".Table")
        logger("remove(.Table)") 
        remove(.Table, envir=.GlobalEnv)       
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dbinom")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Binomial trials")), trialsEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(trialsEntry, sticky="w")
    tkgrid.configure(probEntry, sticky="w")
    dialogSuffix(rows=3, columns=2, focus=trialsEntry)
    }

PoissonMass <- function(){
    checkRange <- function(range){
        RcmdrTkmessageBox(message=sprintf(gettextRcmdr("Range of values over which to plot, %d, is large.\nCreate long output?"), range),
            icon="warning", type="yesno", default="no")
        }
    initializeDialog(title=gettextRcmdr("Poisson Probabilities"))
    meanVar <- tclVar("")
    meanEntry <- ttkentry(top, width="6", textvariable=meanVar)
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        mean <- as.numeric(tclvalue(meanVar))
		options(warn)
        if (is.na(mean)) {
            errorCondition(recall=PoissonMass, message=gettextRcmdr("Poisson mean not specified."))
            return()
            }
        if (mean < 0) {
            errorCondition(recall=PoissonMass, message=gettextRcmdr("Poisson mean cannot be negative."))
            return()
            }
        min <- qpois(.00005, lambda=mean)
        max <- qpois(.99995, lambda=mean)
        range <- max - min
        if (range > 50){
            if ("no" == tclvalue(checkRange(range))){
                if (getRcmdr("grab.focus")) tkgrab.release(top)
                tkdestroy(top)
                PoissonMass()
                return()
                }
            }
        command <- paste("data.frame(Pr=round(dpois(", min, ":", max, ", lambda=", mean, "), 4))", sep="")
        logger(paste(".Table <- ", command, sep=""))
        assign(".Table", justDoIt(command), envir=.GlobalEnv)
        logger(paste("rownames(.Table) <- ", min, ":", max, sep=""))
        justDoIt(paste("rownames(.Table) <- ", min, ":", max, sep=""))
        doItAndPrint(".Table")
        logger("remove(.Table)") 
        remove(.Table, envir=.GlobalEnv)       
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dpois")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Mean")), meanEntry, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(meanEntry, sticky="w")
    dialogSuffix(rows=2, columns=2, focus=meanEntry)
    }

# the following functions were contributed by G. Jay Kerns, Andy Chang, and  Theophilius Boye
#  modified by J. Fox

PoissonQuantiles  <- function(){
    initializeDialog(title=gettextRcmdr("Poisson Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    lambdaVar <- tclVar("1")
    lambdaEntry <- ttkentry(top, width="6", textvariable=lambdaVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
        if ("" == quantiles) {
            errorCondition(recall=PoissonQuantiles, message=gettextRcmdr("No probabilities specified."))
            return()
            }
        lambda <- tclvalue(lambdaVar)
        tail <- tclvalue(tailVar)
        if (is.na(lambda)) {
            errorCondition(recall=PoissonQuantiles, message=gettextRcmdr("Poisson mean not specified."))
            return()
            }
        if (lambda < 0) {
            errorCondition(recall=PoissonQuantiles, message=gettextRcmdr("Poisson mean cannot be negative."))
            return()
            }
        doItAndPrint(paste("qpois(c(", quantiles, "), lambda=", lambda,
                     ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qpois")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Mean")),lambdaEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(lambdaEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=quantilesEntry)
    }
    
PoissonProbabilities  <- function(){
    initializeDialog(title=gettextRcmdr("Poisson Probabilities"))
    probabilitiesVar <- tclVar("")
    probabilitiesEntry <- ttkentry(top, width="30", textvariable=probabilitiesVar)
    lambdaVar <- tclVar("1")
    lambdaEntry <- ttkentry(top, width="6", textvariable=lambdaVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <-  gsub(" +", ",", gsub(",", " ", tclvalue(probabilitiesVar)))
        if ("" == probabilities) {
            errorCondition(recall=PoissonProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
        lambda <- tclvalue(lambdaVar)
        tail <- tclvalue(tailVar)
        if (is.na(lambda)) {
            errorCondition(recall=PoissonProbabilities, message=gettextRcmdr("Poisson mean not specified."))
            return()
            }
        if (lambda < 0) {
            errorCondition(recall=PoissonProbabilities, message=gettextRcmdr("Poisson mean cannot be negative."))
            return()
            }
        doItAndPrint(paste("ppois(c(", probabilities, "), lambda=", lambda,
                           ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="ppois")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Mean")), lambdaEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(probabilitiesEntry, sticky="w")
    tkgrid.configure(lambdaEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=1, focus=probabilitiesEntry)
    }

geomQuantiles  <- function(){
    initializeDialog(title=gettextRcmdr("Geometric Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    probVar <- tclVar("0.5")
    probEntry <- ttkentry(top, width="6", textvariable=probVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
        if ("" == quantiles) {
              errorCondition(recall=geomQuantiles, message=gettextRcmdr("No probabilities specified."))
              return()
        }
        prob <- tclvalue(probVar)
        tail <- tclvalue(tailVar)
        if ( is.na(prob) ){
              errorCondition(recall=geomQuantiles, message=gettextRcmdr("Probability of success not specified."))
              return()
        }
        if (prob < 0 || prob > 1) {
            errorCondition(recall=geomQuantiles, message=gettextRcmdr("Probability of success must be between 0 and 1."))
            return()
            }
        doItAndPrint(paste("qgeom(c(", quantiles, "), prob=", prob,
                     ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qgeom")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(probEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=quantilesEntry)
    }

geomProbabilities  <- function(){
    initializeDialog(title=gettextRcmdr("Geometric Probabilities"))
    probabilitiesVar <- tclVar("")
    probabilitiesEntry <- ttkentry(top, width="30", textvariable=probabilitiesVar)
    probVar <- tclVar("0.5")
    probEntry <- ttkentry(top, width="6", textvariable=probVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <-  gsub(" +", ",", gsub(",", " ", tclvalue(probabilitiesVar)))
        if ("" == probabilities) {
              errorCondition(recall=geomProbabilities, message=gettextRcmdr("No values specified."))
              return()
        }
        prob <- tclvalue(probVar)
        tail <- tclvalue(tailVar)
        if ( is.na(prob) ){
              errorCondition(recall=geomProbabilities, message=gettextRcmdr("Probability of success was not specified."))
              return()
        }
        if (prob < 0 || prob > 1) {
            errorCondition(recall=geomProbabilities, message=gettextRcmdr("Probability of success must be between 0 and 1."))
            return()
            }
        doItAndPrint(paste("pgeom(c(", probabilities, "), prob=", prob,
                           ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="pgeom")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(probabilitiesEntry, sticky="w")
    tkgrid.configure(probEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=1, focus=probabilitiesEntry)
    }

geomMass  <- function(){
    checkRange <- function(range){
        RcmdrTkmessageBox(message=sprintf(gettextRcmdr("Range of values over which to plot, %d, is large.\nCreate long output?"), range),
            icon="warning", type="yesno", default="no")
        }
    initializeDialog(title=gettextRcmdr("Geometric Probabilities"))
    probVar <- tclVar("0.5")
    probEntry <- ttkentry(top, width="6", textvariable=probVar)
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        prob <- as.numeric(tclvalue(probVar))
		options(warn)
        if (is.na(prob) ) {
              errorCondition(recall=geomMass, message=gettextRcmdr("Probability of success was not specified."))
              return()
        }
        if (prob < 0 || prob > 1) {
            errorCondition(recall=geomMass, message=gettextRcmdr("Probability of success must be between 0 and 1."))
            return()
            }
        xmin <- qgeom(.0005, prob=prob)
        xmax <- qgeom(.9995, prob=prob)
        range <- xmax - xmin
        if (range > 50){
            if ("no" == tclvalue(checkRange(range))){
                if (getRcmdr("grab.focus")) tkgrab.release(top)
                tkdestroy(top)
                geomMass()
                return()
                }
            }
        command <- paste("data.frame(Pr=dgeom(", xmin, ":", xmax, ", prob=", prob, "))", sep="")
        logger(paste(".Table <- ", command, sep=""))
        assign(".Table", justDoIt(command), envir=.GlobalEnv)
        logger(paste("rownames(.Table) <- ", xmin, ":", xmax, sep=""))
        justDoIt(paste("rownames(.Table) <- ", xmin, ":", xmax, sep=""))
        doItAndPrint(".Table")
        logger("remove(.Table)")
        remove(.Table, envir=.GlobalEnv)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dgeom")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(probEntry, sticky="w")
    dialogSuffix(rows=2, columns=2, focus=probEntry)
    }

hyperQuantiles  <- function(){
    initializeDialog(title=gettextRcmdr("Hypergeometric Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    mVar <- tclVar("1")
    mEntry <- ttkentry(top, width="6", textvariable=mVar)
    nVar <- tclVar("1")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    kVar <- tclVar("1")
    kEntry <- ttkentry(top, width="6", textvariable=kVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
        if ("" == quantiles) {
              errorCondition(recall=hyperQuantiles, message=gettextRcmdr("No probabilities specified."))
              return()
        }
		warn <- options(warn=-1)
        m <- as.numeric(tclvalue(mVar))
        n <- as.numeric(tclvalue(nVar))
        k <- as.numeric(tclvalue(kVar))
		options(warn)
        # Do some error checking
        if ( is.na(m) ){
              errorCondition(recall=hyperQuantiles, message=gettextRcmdr("The m parameter was not specified."))
              return()
        }
        if ( m < 0 ){
              errorCondition(recall=hyperQuantiles, message=gettextRcmdr("The m parameter cannot be negative."))
              return()
        }
        m <- round(m)
        if ( is.na(n) ){
              errorCondition(recall=hyperQuantiles, message=gettextRcmdr("The n parameter was not specified."))
              return()
        }
        if ( n < 0 ){
              errorCondition(recall=hyperQuantiles, message=gettextRcmdr("The n parameter cannot be negative."))
              return()
        }
        n <- round(n)
        if ( is.na(k) ){
              errorCondition(recall=hyperQuantiles, message=gettextRcmdr("The k parameter was not specified."))
              return()
        }
        k <- round(k)
        if ( k > (m + n) ){
                errorCondition(recall=hyperQuantiles,
                message=gettextRcmdr("The k parameter cannot be greater than m + n."))
                        return()
                    }
        if ( k < 0 ){
                errorCondition(recall=hyperQuantiles,
                message=gettextRcmdr("The k parameter cannot be negative."))
                        return()
                    }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("qhyper(c(", quantiles, "), m=", m,
            ", n=", n, ", k=", k,", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qhyper")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("m (number of white balls in the urn)")), mEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("n (number of black balls in the urn)")), nEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("k (number of balls drawn from the urn)")), kEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(mEntry, sticky="w")
    tkgrid.configure(nEntry, sticky="w")
    tkgrid.configure(kEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=7, columns=2, focus=quantilesEntry)
    }

hyperProbabilities  <- function(){
    initializeDialog(title=gettextRcmdr("Hypergeometric Probabilities"))
    ProbabilitiesVar <- tclVar("")
    ProbabilitiesEntry <- ttkentry(top, width="30", textvariable=ProbabilitiesVar)
    mVar <- tclVar("1")
    mEntry <- ttkentry(top, width="6", textvariable=mVar)
    nVar <- tclVar("1")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    kVar <- tclVar("1")
    kEntry <- ttkentry(top, width="6", textvariable=kVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <-  gsub(" +", ",", gsub(",", " ", tclvalue(ProbabilitiesVar)))
        if ("" == probabilities) {
              errorCondition(recall=hyperProbabilities.ipsr, message=gettextRcmdr("No values specified."))
              return()
        }
		warn <- options(warn=-1)
        m <- as.numeric(tclvalue(mVar))
        n <- as.numeric(tclvalue(nVar))
        k <- as.numeric(tclvalue(kVar))
		options(warn)
        # Do some error checking
        if ( is.na(m) ){
              errorCondition(recall=hyperProbabilities, message=gettextRcmdr("The m parameter was not specified."))
              return()
        }
        if ( m < 0 ){
              errorCondition(recall=hyperProbabilities, message=gettextRcmdr("The m parameter cannot be negative."))
              return()
        }
        m <- round(m)
        if ( is.na(n) ){
              errorCondition(recall=hyperProbabilities, message=gettextRcmdr("The n parameter was not specified."))
              return()
        }
        if ( n < 0 ){
              errorCondition(recall=hyperProbabilities, message=gettextRcmdr("The n parameter cannot be negative."))
              return()
        }
        n <- round(n)
        if ( is.na(k) ){
              errorCondition(recall=hyperProbabilities, message=gettextRcmdr("The k parameter was not specified."))
              return()
        }
        k <- round(k)
        if ( k > (m + n) ){
                errorCondition(recall=hyperProbabilities,
                message=gettextRcmdr("The k parameter cannot be greater than m + n."))
                        return()
                    }
        if ( k < 0 ){
                errorCondition(recall=hyperProbabilities,
                message=gettextRcmdr("The k parameter cannot be negative."))
                        return()
                    }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("phyper(c(", probabilities, "), m=", m,
            ", n=", n, ", k=", k,", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }

    OKCancelHelp(helpSubject="phyper")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), ProbabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("m (number of white balls in the urn)")), mEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("n (number of black balls in the urn)")), nEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("k (number of balls drawn from the urn)")), kEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(ProbabilitiesEntry, sticky="w")
    tkgrid.configure(mEntry, sticky="w")
    tkgrid.configure(nEntry, sticky="w")
    tkgrid.configure(kEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=7, columns=2, focus=ProbabilitiesEntry)
    }

hyperMass  <- function(){
    checkRange <- function(range){
        RcmdrTkmessageBox(message=sprintf(gettextRcmdr("Range of values over which to plot, %d, is large.\nCreate long output?"), range),
            icon="warning", type="yesno", default="no")
        }
    initializeDialog(title=gettextRcmdr("Hypergeometric  Probabilities"))
    mVar <- tclVar("1")
    mEntry <- ttkentry(top, width="6", textvariable=mVar)
    nVar <- tclVar("1")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    kVar <- tclVar("1")
    kEntry <- ttkentry(top, width="6", textvariable=kVar)
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        m <- as.numeric(tclvalue(mVar))
        n <- as.numeric(tclvalue(nVar))
        k <- as.numeric(tclvalue(kVar))
		options(warn)
        # Do some error checking
        if ( is.na(m) ){
              errorCondition(recall=hyperMass, message=gettextRcmdr("The m parameter was not specified."))
              return()
        }
        if ( m < 0 ){
              errorCondition(recall=hyperMass, message=gettextRcmdr("The m parameter cannot be negative."))
              return()
        }
        m <- round(m)
        if ( is.na(n) ){
              errorCondition(recall=hyperMass, message=gettextRcmdr("The n parameter was not specified."))
              return()
        }
        if ( n < 0 ){
              errorCondition(recall=hyperMass, message=gettextRcmdr("The n parameter cannot be negative."))
              return()
        }
        n <- round(n)
        if ( is.na(k) ){
              errorCondition(recall=hyperMass, message=gettextRcmdr("The k parameter was not specified."))
              return()
        }
        k <- round(k)
        if ( k > (m + n) ){
                errorCondition(recall=hyperMass,
                message=gettextRcmdr("The k parameter cannot be greater than m + n."))
                        return()
                    }
        if ( k < 0 ){
                errorCondition(recall=hyperMass,
                message=gettextRcmdr("The k parameter cannot be negative."))
                        return()
                    }
        xmin <- qhyper(.0005, m=m, n=n, k=k)
        xmax <- qhyper(.9995, m=m, n=n, k=k)
        if (xmax - xmin > 50){
            if ("no" == tclvalue(checkRange(range))){
                if (getRcmdr("grab.focus")) tkgrab.release(top)
                tkdestroy(top)
                hyperMass()
                return()
                }
            }
        command <- paste("data.frame(Pr=dhyper(", xmin, ":", xmax, ", m=", m, ", n=", n, ", k=", k, "))", sep="")
        logger(paste(".Table <- ", command, sep=""))
        assign(".Table", justDoIt(command), envir=.GlobalEnv)
        logger(paste("rownames(.Table) <- ", xmin, ":", xmax, sep=""))
        justDoIt(paste("rownames(.Table) <- ", xmin, ":", xmax, sep=""))
        doItAndPrint(".Table")
        logger("remove(.Table)")
        remove(.Table, envir=.GlobalEnv)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dhyper")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("m (number of white balls in the urn)")), mEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("n (number of black balls in the urn)")), nEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("k (number of balls drawn from the urn)")), kEntry, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(mEntry, sticky="w")
    tkgrid.configure(nEntry, sticky="w")
    tkgrid.configure(kEntry, sticky="w")
    dialogSuffix(rows=4, columns=2, focus=mEntry)
    }

    negbinomialQuantiles  <- function(){
    initializeDialog(title=gettextRcmdr("Negative Binomial Quantiles"))
    quantilesVar <- tclVar("")
    quantilesEntry <- ttkentry(top, width="30", textvariable=quantilesVar)
    sizeVar <- tclVar("1")
    sizeEntry <- ttkentry(top, width="6", textvariable=sizeVar)
    probVar <- tclVar("0.5")
    probEntry <- ttkentry(top, width="6", textvariable=probVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(quantilesVar)))
        if ("" == quantiles) {
              errorCondition(recall=negbinomialQuantiles, 
                message=gettextRcmdr("No probabilities specified."))
              return()
          }
	  	warn <- options(warn=-1)
        size <- as.numeric(tclvalue(sizeVar))
        prob <- as.numeric(tclvalue(probVar))
		options(warn)
        # Do some error checking
        if ( is.na(size) ){
              errorCondition(recall=negbinomialQuantiles, 
                message=gettextRcmdr("Target number of successes not specified."))
              return()
          }
        if ( size < 0){
              errorCondition(recall=negbinomialQuantiles, 
                message=gettextRcmdr("Target number of successes cannot be negative."))
              return()
          }
        size <- round(size) 
        if ( is.na(prob) ){
              errorCondition(recall=negbinomialQuantiles, 
                message=gettextRcmdr("Probability of success not specified."))
              return()
          }
        if (prob < 0 || prob > 1) {
            errorCondition(recall=negbinomialQuantiles, 
              message=gettextRcmdr("Probability of success must be between 0 and 1."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("qnbinom(c(", quantiles, "), size=", size,
            ", prob=", prob, ", lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qnbinom")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Target number of successes")), sizeEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(quantilesEntry, sticky="w")
    tkgrid.configure(sizeEntry, sticky="w")
    tkgrid.configure(probEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=quantilesEntry)
    }

negbinomialProbabilities  <- function(){
    initializeDialog(title=gettextRcmdr("Negative Binomial Probabilities"))
    ProbabilitiesVar <- tclVar("")
    ProbabilitiesEntry <- ttkentry(top, width="30", textvariable=ProbabilitiesVar)
    sizeVar <- tclVar("1")
    sizeEntry <- ttkentry(top, width="6", textvariable=sizeVar)
    probVar <- tclVar("0.5")
    probEntry <- ttkentry(top, width="6", textvariable=probVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- ttkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- ttkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <-  gsub(" +", ",", gsub(",", " ", tclvalue(ProbabilitiesVar)))
        if ("" == quantiles) {
              errorCondition(recall=negbinomialProbabilities, 
                message=gettextRcmdr("No values specified."))
              return()
        }
		warn <- options(warn=-1)
        size <- as.numeric(tclvalue(sizeVar))
        prob <- as.numeric(tclvalue(probVar))
		options(warn)
        # Do some error checking
        if ( is.na(size) ){
              errorCondition(recall=negbinomialProbabilities, 
                message=gettextRcmdr("Target number of successes not specified."))
              return()
          }
        if ( size < 0){
              errorCondition(recall=negbinomialProbabilities, 
                message=gettextRcmdr("Target number of successes cannot be negative."))
              return()
          }
        size <- round(size) 
        if ( is.na(prob) ){
              errorCondition(recall=negbinomialProbabilities, 
                message=gettextRcmdr("Probability of success not specified."))
              return()
          }
        if (prob < 0 || prob > 1) {
            errorCondition(recall=negbinomialProbabilities, 
              message=gettextRcmdr("Probability of success must be between 0 and 1."))
            return()
            }
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("pnbinom(c(", quantiles, "), size=", size,
            ", prob=", prob, ",  lower.tail=", tail == "lower",")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="pnbinom")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Variable value(s)")), ProbabilitiesEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Target number of successes")), sizeEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Upper tail")), upperTailButton, sticky="e")
    tkgrid(buttonsFrame, sticky="w", columnspan=2)
    tkgrid.configure(ProbabilitiesEntry, sticky="w")
    tkgrid.configure(sizeEntry, sticky="w")
    tkgrid.configure(probEntry, sticky="w")
    tkgrid.configure(lowerTailButton, sticky="w")
    tkgrid.configure(upperTailButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=ProbabilitiesEntry)
    }

negbinomialMass  <- function(){
    checkRange <- function(range){
        RcmdrTkmessageBox(message=sprintf(gettextRcmdr("Range of values over which to plot, %d, is large.\nCreate long output?"), range),
            icon="warning", type="yesno", default="no")
        }
    initializeDialog(title=gettextRcmdr("Negative Binomial Probabilities"))
    trialsVar <- tclVar("1")
    trialsEntry <- ttkentry(top, width="6", textvariable=trialsVar)
    probVar <- tclVar("0.5")
    probEntry <- ttkentry(top, width="6", textvariable=probVar)
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        trials <- as.numeric(tclvalue(trialsVar))
		prob <- as.numeric(tclvalue(probVar))
		options(warn)
        if ( is.na(trials) ){
              errorCondition(recall=negbinomialMass, 
                message=gettextRcmdr("Target number of successes not specified."))
              return()
          }
        if ( trials < 0){
              errorCondition(recall=negbinomialMass, 
                message=gettextRcmdr("Target number of successes cannot be negative."))
              return()
          }
        trials <- round(trials)
        if ( is.na(prob) ){
              errorCondition(recall=negbinomialMass, 
                message=gettextRcmdr("Probability of success not specified."))
              return()
          }
        if (prob < 0 || prob > 1) {
            errorCondition(recall=negbinomialMass, 
              message=gettextRcmdr("Probability of success must be between 0 and 1."))
            return()
            }
        xmin <- qnbinom(.0005, size=trials, prob=prob)
        xmax <- qnbinom(.9995, size=trials, prob=prob) 
        range <- xmax - xmin
        if (range > 50){
            if ("no" == tclvalue(checkRange(range))){
                if (getRcmdr("grab.focus")) tkgrab.release(top)
                tkdestroy(top)
                negbinomialMass()
                return()
                }
            }
        command <- paste("data.frame(Pr=dnbinom(", xmin, ":", xmax, ", size=", trials,", prob=", prob, "))", sep="")
        logger(paste(".Table <- ", command, sep=""))
        assign(".Table", justDoIt(command), envir=.GlobalEnv)
        logger(paste("rownames(.Table) <- ", xmin, ":", xmax, sep=""))
        justDoIt(paste("rownames(.Table) <- ", xmin, ":", xmax, sep=""))
        doItAndPrint(".Table")
        logger("remove(.Table)")
        remove(.Table, envir=.GlobalEnv)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dnbinom")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Target number of successes")), trialsEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(trialsEntry, sticky="w")
    tkgrid.configure(probEntry, sticky="w")
    dialogSuffix(rows=3, columns=2, focus=trialsEntry)
    }
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/distributions-plotDistributions-menu.R"
# Distributions menu dialogs for plots

# last modified 30 August 2009 by J. Fox

#   many distributions added (and some other changes) by Miroslav Ristic  (20 July 06)

normalDistributionPlot <- function(){
    initializeDialog(title=gettextRcmdr("Normal Distribution"))
    muVar <- tclVar("0")
    muEntry <- ttkentry(top, width="6", textvariable=muVar)
    sigmaVar <- tclVar("1")
    sigmaEntry <- ttkentry(top, width="6", textvariable=sigmaVar)
    functionVar <- tclVar("Density")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        mu <- as.numeric(tclvalue(muVar))
        sigma <- as.numeric(tclvalue(sigmaVar))
		options(warn)
		if (is.na(mu)) {
			errorCondition(recall=normalDistributionPlot, message=gettextRcmdr("Mean not specified."))
			return()
		}
        if (is.na(sigma) || sigma <= 0) {
            errorCondition(recall=normalDistributionPlot, message=gettextRcmdr("Standard deviation must be positive."))
            return()
            }
        fun <- tclvalue(functionVar)
        fn <- if (fun == "Density") "dnorm" else "pnorm"
        min <- round(qnorm(.0005, mean=mu, sd=sigma), 3)
        max <- round(qnorm(.9995, mean=mu, sd=sigma), 3)
        command <- paste("seq(", min, ", ", max, ", length.out=100)", sep="")
        logger(paste(".x <- ", command, sep=""))
        assign(".x", justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("plot(.x, ", fn, "(.x, mean=", mu, 
            ", sd=", sigma, '), xlab="x", ylab="', fun, 
            '", main=expression(paste("Normal Distribution: ", mu, " = ',
            mu, ', ", sigma, " = ', sigma, '")), type="l")', sep=""))
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dnorm")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("mu (mean)")), muEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("sigma (standard deviation)")), sigmaEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(muEntry, sticky="w")
    tkgrid.configure(sigmaEntry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=5, columns=2, focus=muEntry)
    }

tDistributionPlot <- function(){
    initializeDialog(title=gettextRcmdr("t Distribution"))
    dfVar <- tclVar("")
    dfEntry <- ttkentry(top, width="6", textvariable=dfVar)
    functionVar <- tclVar("Density")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        df <- as.numeric(tclvalue(dfVar))
		options(warn)
        if (is.na(df)) {
            errorCondition(recall=tDistributionPlot, message=gettextRcmdr("Degrees of freedom not specified."))
            return()
            }
        if (df<=0) {
            errorCondition(recall=tDistributionPlot, message=gettextRcmdr("Degrees of freedom must be positive."))
            return()
            }
        fun <- tclvalue(functionVar)
        fn <- if (fun == "Density") "dt" else "pt"
        min <- round(qt(.0005, df=df), 3)
        max <- round(qt(.9995, df=df), 3)
        command <- paste("seq(", min, ", ", max, ", length.out=100)", sep="")
        logger(paste(".x <- ", command, sep=""))
        assign(".x", justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("plot(.x, ", fn, "(.x, df=", df, 
            '), xlab="t", ylab="', fun, 
            '", main="t Distribution: df = ', df, '", type="l")', sep=""))
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dt")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Degrees of freedom")), dfEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(dfEntry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=4, columns=2, focus=dfEntry)
    }

chisquareDistributionPlot <- function(){
    initializeDialog(title=gettextRcmdr("Chi-squared Distribution"))
    dfVar <- tclVar("")
    dfEntry <- ttkentry(top, width="6", textvariable=dfVar)
    functionVar <- tclVar("Density")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        df <- as.numeric(tclvalue(dfVar))
		options(warn)
        if (is.na(df)) {
            errorCondition(recall=chisquareDistributionPlot,message=gettextRcmdr("Degrees of freedom not specified."))
            return()
            }
        if (df<=0) {
            errorCondition(recall=chisquareDistributionPlot, message=gettextRcmdr("Degrees of freedom must be positive."))
            return()
            }
        fun <- tclvalue(functionVar)
        fn <- if (fun == "Density") "dchisq" else "pchisq"
        min <- round(qchisq(.0005, df=df), 3)
        max <- round(qchisq(.9995, df=df), 3)
        command <- paste("seq(", min, ", ", max, ", length.out=100)", sep="")
        logger(paste(".x <- ", command, sep=""))
        assign(".x", justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("plot(.x, ", fn, "(.x, df=", df, 
            '), xlab=expression(chi^2), ylab="', fun, 
            '", main="Chi-Squared Distribution: df = ', df, '", type="l")', sep=""))
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dchisq")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Degrees of freedom")), dfEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(dfEntry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=4, columns=2, focus=dfEntry)
    }

FDistributionPlot <- function(){
    initializeDialog(title=gettextRcmdr("F Distribution"))
    df1Var <- tclVar("")
    df2Var <- tclVar("")
    df1Entry <- ttkentry(top, width="6", textvariable=df1Var)
    df2Entry <- ttkentry(top, width="6", textvariable=df2Var)
    functionVar <- tclVar("Density")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        df1 <- as.numeric(tclvalue(df1Var))
        df2 <- as.numeric(tclvalue(df2Var))
		options(warn)
        if (is.na(df1)) {
            errorCondition(recall=FDistributionPlot, message=gettextRcmdr("Numerator degrees of freedom not specified."))
            return()
            }
        if (is.na(df2)) {
             errorCondition(recall=FDistributionPlot, message=gettextRcmdr("Denominator degrees of freedom not specified."))
            return()
            }
        if (df1 <= 0) {
            errorCondition(recall=FDistributionPlot, message=gettextRcmdr("Numerator degrees of freedom must be positive."))
            return()
            }
        if (df2 <= 0) {
            errorCondition(recall=FDistributionPlot, message=gettextRcmdr("Denominator degrees of freedom must be positive."))
            return()
            }
        fun <- tclvalue(functionVar)
        fn <- if (fun == "Density") "df" else "pf"
        min <- round(qf(.0005, df1=df1, df2=df2), 3)
        max <- round(qf(.9995, df1=df1, df2=df2), 3)
        command <- paste("seq(", min, ", ", max, ", length.out=100)", sep="")
        logger(paste(".x <- ", command, sep=""))
        assign(".x", justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("plot(.x, ", fn, "(.x, df1=", df1, ", df2=", df2,
            '), xlab="f", ylab="', fun, 
            '", main="F Distribution: Numerator df = ', df1, ', Denominator df = ', df2, 
            '", type="l")', sep=""))
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="df")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Numerator degrees of freedom")), df1Entry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Denominator degrees of freedom")), df2Entry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(df1Entry, sticky="w")
    tkgrid.configure(df2Entry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=5, columns=2, focus=df1Entry)
    }

exponentialDistributionPlot <- function() { 
    initializeDialog(title=gettextRcmdr("Exponential Distribution"))
    rateVar <- tclVar("1")
    rateEntry <- ttkentry(top, width="6", textvariable=rateVar)
    functionVar <- tclVar("Density")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        rate <- as.numeric(tclvalue(rateVar))
		options(warn)
        if (is.na(rate) || rate <= 0) {
            errorCondition(recall=exponentialDistributionPlot, message=gettextRcmdr("Rate must be positive."))
            return()
            }
        fun <- tclvalue(functionVar)
        fn <- if (fun == "Density") "dexp" else "pexp"
        min <- round(qexp(.0005, rate=rate), 3)
        max <- round(qexp(.9995, rate=rate), 3)
        command <- paste("seq(", min, ", ", max, ", length.out=100)", sep="")
        logger(paste(".x <- ", command, sep=""))
        assign(".x", justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("plot(.x, ", fn, "(.x, rate=", rate, 
            '), xlab="x", ylab="', fun, 
            '", main="Exponential Distribution: rate = ', rate, '", type="l")', sep=""))
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dexp")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Rate")), rateEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(rateEntry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=4, columns=2, focus=rateEntry)
    }
    
uniformDistributionPlot <- function() { 
    initializeDialog(title=gettextRcmdr("Uniform Distribution"))
    minVar <- tclVar("0")
    maxVar <- tclVar("1")
    minEntry <- ttkentry(top, width="6", textvariable=minVar)
    maxEntry <- ttkentry(top, width="6", textvariable=maxVar)
    functionVar <- tclVar("Density")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        minValue <- as.numeric(tclvalue(minVar))
        maxValue <- as.numeric(tclvalue(maxVar))
		options(warn)
        if (is.na(minValue) || is.na(maxValue) || minValue >= maxValue) {
            errorCondition(recall=uniformDistributionPlot, message=gettextRcmdr("Lower limit must be less than upper limit."))
            return()
            }
        fun <- tclvalue(functionVar)
        fn <- if (fun == "Density") "dunif" else "punif"
        min <- round(qunif(.0005, min=minValue, max=maxValue), 3)
        max <- round(qunif(.9995, min=minValue, max=maxValue), 3)
        command <- paste("seq(", min, ", ", max, ", length.out=100)", sep="")
        logger(paste(".x <- ", command, sep=""))
        assign(".x", justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("plot(.x, ", fn, "(.x, min=", minValue, ", max=", maxValue,
            '), xlab="x", ylab="', fun, 
            '", main="Uniform Distribution: min=', minValue, ', max=', maxValue, '", type="l")', sep=""))
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dunif")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Minimum")), minEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Maximum")), maxEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(minEntry, sticky="w")
    tkgrid.configure(maxEntry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=4, columns=2, focus=minEntry)
    }
    
betaDistributionPlot <- function(){
    initializeDialog(title=gettextRcmdr("Beta Distribution"))
    shape1Var <- tclVar("")
    shape2Var <- tclVar("")
    shape1Entry <- ttkentry(top, width="6", textvariable=shape1Var)
    shape2Entry <- ttkentry(top, width="6", textvariable=shape2Var)
    functionVar <- tclVar("Density")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        shape1 <- as.numeric(tclvalue(shape1Var))
        shape2 <- as.numeric(tclvalue(shape2Var))
		options(warn)
        if (is.na(shape1) || is.na(shape2)) {
            errorCondition(recall=betaDistributionPlot, message=gettextRcmdr("Shapes not specified."))
            return()
            }
        if (shape1 <= 0 || shape2 <= 0) {
            errorCondition(recall=betaDistributionPlot, message=gettextRcmdr("Shapes must be positive."))
            return()
            }
        fun <- tclvalue(functionVar)
        fn <- if (fun == "Density") "dbeta" else "pbeta"
        min <- round(qbeta(.0005, shape1=shape1, shape2=shape2), 3)
        max <- round(qbeta(.9995, shape1=shape1, shape2=shape2), 3)
        command <- paste("seq(", min, ", ", max, ", length.out=100)", sep="")
        logger(paste(".x <- ", command, sep=""))
        assign(".x", justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("plot(.x, ", fn, "(.x, shape1=", shape1, ", shape2=", shape2,
            '), xlab="x", ylab="', fun, 
            '", main="Beta Distribution: Shapes a = ', shape1, ', b = ', shape2, 
            '", type="l")', sep=""))
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dbeta")
    tkgrid(labelRcmdr(top, text=paste(gettextRcmdr("Shape"), "1")), shape1Entry, sticky="e")
    tkgrid(labelRcmdr(top, text=paste(gettextRcmdr("Shape"), 2)), shape2Entry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(shape1Entry, sticky="w")
    tkgrid.configure(shape2Entry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=5, columns=2, focus=shape1Entry)
    }
    
CauchyDistributionPlot <- function(){
    initializeDialog(title=gettextRcmdr("Cauchy Distribution"))
    locationVar <- tclVar("0")
    locationEntry <- ttkentry(top, width="6", textvariable=locationVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    functionVar <- tclVar("Density")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        location <- as.numeric(tclvalue(locationVar))
        s <- as.numeric(tclvalue(sVar))
		options(warn)
        if (is.na(s) || s <= 0) {
            errorCondition(recall=CauchyDistributionPlot, message=gettextRcmdr("Scale must be positive."))
            return()
            }
        fun <- tclvalue(functionVar)
        fn <- if (fun == "Density") "dcauchy" else "pcauchy"
        min <- round(qcauchy(.01, location=location, scale=s), 3)
        max <- round(qcauchy(.99, location=location, scale=s), 3)
        command <- paste("seq(", min, ", ", max, ", length.out=100)", sep="")
        logger(paste(".x <- ", command, sep=""))
        assign(".x", justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("plot(.x, ", fn, "(.x, location=", location, 
            ", scale=", s, '), xlab="x", ylab="', fun, 
            '", main="Cauchy Distribution: location = ',
            location, ', scale = ', s, '", type="l")', sep=""))
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dcauchy")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Location")), locationEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(locationEntry, sticky="w")
    tkgrid.configure(sEntry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=5, columns=2, focus=locationEntry)
    }
    
logisticDistributionPlot <- function(){
    initializeDialog(title=gettextRcmdr("Logistic Distribution"))
    locationVar <- tclVar("0")
    locationEntry <- ttkentry(top, width="6", textvariable=locationVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    functionVar <- tclVar("Density")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        location <- as.numeric(tclvalue(locationVar))
        s <- as.numeric(tclvalue(sVar))
		options(warn)
        if (is.na(s) || s <= 0) {
            errorCondition(recall=logisticDistributionPlot, message=gettextRcmdr("Scale must be positive."))
            return()
            }
        fun <- tclvalue(functionVar)
        fn <- if (fun == "Density") "dlogis" else "plogis"
        min <- round(qlogis(.0005, location=location, scale=s), 3)
        max <- round(qlogis(.9995, location=location, scale=s), 3)
        command <- paste("seq(", min, ", ", max, ", length.out=100)", sep="")
        logger(paste(".x <- ", command, sep=""))
        assign(".x", justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("plot(.x, ", fn, "(.x, location=", location, 
            ", scale=", s, '), xlab="x", ylab="', fun, 
            '", main="Logistic Distribution: location = ',
            location, ', scale = ', s, '", type="l")', sep=""))
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dlogis")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Location")), locationEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(locationEntry, sticky="w")
    tkgrid.configure(sEntry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=5, columns=2, focus=locationEntry)
    }
    
lognormalDistributionPlot <- function(){
    initializeDialog(title=gettextRcmdr("Lognormal Distribution"))
    meanlogVar <- tclVar("0")
    meanlogEntry <- ttkentry(top, width="6", textvariable=meanlogVar)
    sdlogVar <- tclVar("1")
    sdlogEntry <- ttkentry(top, width="6", textvariable=sdlogVar)
    functionVar <- tclVar("Density")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        meanlog <- as.numeric(tclvalue(meanlogVar))
        sdlog <- as.numeric(tclvalue(sdlogVar))
		options(warn)
        if (is.na(sdlog) || sdlog <= 0) {
            errorCondition(recall=lognormalDistributionPlot, message=gettextRcmdr("Standard deviation must be positive."))
            return()
            }
        fun <- tclvalue(functionVar)
        fn <- if (fun == "Density") "dlnorm" else "plnorm"
        min <- round(qlnorm(.0005, meanlog=meanlog, sdlog=sdlog), 3)
        max <- round(qlnorm(.9995, meanlog=meanlog, sdlog=sdlog), 3)
        command <- paste("seq(", min, ", ", max, ", length.out=100)", sep="")
        logger(paste(".x <- ", command, sep=""))
        assign(".x", justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("plot(.x, ", fn, "(.x, meanlog=", meanlog, 
            ", sdlog=", sdlog, '), xlab="x", ylab="', fun, 
            '", main="Lognormal Distribution: Mean (log scale) = ',
            meanlog, ', SD (log scale) = ', sdlog, '", type="l")', sep=""))
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dlnorm")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Mean (log scale)")), meanlogEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Standard deviation (log scale)")), sdlogEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(meanlogEntry, sticky="w")
    tkgrid.configure(sdlogEntry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=5, columns=2, focus=meanlogEntry)
    }
    
gammaDistributionPlot <- function(){
    initializeDialog(title=gettextRcmdr("Gamma Distribution"))
    shapeVar <- tclVar("")
    shapeEntry <- ttkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    functionVar <- tclVar("Density")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        shape <- as.numeric(tclvalue(shapeVar))
		s <- as.numeric(tclvalue(sVar))
		options(warn)
        if (is.na(shape)) {
            errorCondition(recall=gammaDistributionPlot, message=gettextRcmdr("Shape not specified."))
            return()
            }
        if (shape <= 0) {
            errorCondition(recall=gammaDistributionPlot, message=gettextRcmdr("Shape must be positive."))
            return()
            }
        if (is.na(s) || s <= 0) {
            errorCondition(recall=gammaDistributionPlot, message=gettextRcmdr("Scale must be positive."))
            return()
            }
        fun <- tclvalue(functionVar)
        fn <- if (fun == "Density") "dgamma" else "pgamma"
        min <- round(qgamma(.0005, shape=shape, scale=s), 3)
        max <- round(qgamma(.9995, shape=shape, scale=s), 3)
        command <- paste("seq(", min, ", ", max, ", length.out=100)", sep="")
        logger(paste(".x <- ", command, sep=""))
        assign(".x", justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("plot(.x, ", fn, "(.x, shape=", shape, 
            ", scale=", s, '), xlab="x", ylab="', fun, 
            '", main="Gamma Distribution: shape = ',
            shape, ', scale = ', s, '", type="l")', sep=""))
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dgamma")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Shape")), shapeEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale (inverse rate)")), sEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(shapeEntry, sticky="w")
    tkgrid.configure(sEntry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=5, columns=2, focus=shapeEntry)
    }

WeibullDistributionPlot <- function(){
    initializeDialog(title=gettextRcmdr("Weibull Distribution"))
    shapeVar <- tclVar("")
    shapeEntry <- ttkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    functionVar <- tclVar("Density")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        shape <- as.numeric(tclvalue(shapeVar))
		s <- as.numeric(tclvalue(sVar))
		options(warn)
        if (is.na(shape)) {
            errorCondition(recall=WeibullDistributionPlot, message=gettextRcmdr("Shape not specified."))
            return()
            }
        if (shape <= 0) {
            errorCondition(recall=WeibullDistributionPlot, message=gettextRcmdr("Shape must be positive."))
            return()
            }
        if (is.na(s) || s <= 0) {
            errorCondition(recall=WeibullDistributionPlot, message=gettextRcmdr("Scale must be positive."))
            return()
            }
        fun <- tclvalue(functionVar)
        fn <- if (fun == "Density") "dweibull" else "pweibull"
        min <- round(qweibull(.0005, shape=shape, scale=s), 3)
        max <- round(qweibull(.9995, shape=shape, scale=s), 3)
        command <- paste("seq(", min, ", ", max, ", length.out=100)", sep="")
        logger(paste(".x <- ", command, sep=""))
        assign(".x", justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("plot(.x, ", fn, "(.x, shape=", shape, 
            ", scale=", s, '), xlab="x", ylab="', fun, 
            '", main="Weibull Distribution: shape = ',
            shape, ', scale = ', s, '", type="l")', sep=""))
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dweibull")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Shape")), shapeEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(shapeEntry, sticky="w")
    tkgrid.configure(sEntry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=5, columns=2, focus=shapeEntry)
    }

GumbelDistributionPlot <- function(){
    initializeDialog(title=gettextRcmdr("Gumbel Distribution"))
    shapeVar <- tclVar("")
    shapeEntry <- ttkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    functionVar <- tclVar("Density")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        shape <- as.numeric(tclvalue(shapeVar))
		s <- as.numeric(tclvalue(sVar))
		options(warn)
        if (is.na(shape)) {
            errorCondition(recall=GumbelDistributionPlot, message=gettextRcmdr("Shape not specified."))
            return()
            }
        if (shape <= 0) {
            errorCondition(recall=GumbelDistributionPlot, message=gettextRcmdr("Shape must be positive."))
            return()
            }
        if (is.na(s) || s <= 0) {
            errorCondition(recall=GumbelDistributionPlot, message=gettextRcmdr("Scale must be positive."))
            return()
            }
        fun <- tclvalue(functionVar)
        fn <- if (fun == "Density") "dweibull" else "pweibull"
        min <- round(log(qweibull(.0005, shape=shape, scale=s)), 3)
        max <- round(log(qweibull(.9995, shape=shape, scale=s)), 3)
        command <- paste("exp(seq(", min, ", ", max, ", length.out=100))", sep="")
        logger(paste(".x <- ", command, sep=""))
        assign(".x", justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("plot(log(.x), ", fn, "(.x, shape=", shape, 
            ", scale=", s, '), xlab="x", ylab="', fun, 
            '", main="Gumbel Distribution: shape (log scale) = ',
            shape, ', scale (log scale) = ', s, '", type="l")', sep=""))
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dweibull")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Shape (log shape)")), shapeEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale (log scale)")), sEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(shapeEntry, sticky="w")
    tkgrid.configure(sEntry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=5, columns=2, focus=shapeEntry)
    }
    

binomialDistributionPlot <- function(){
    initializeDialog(title=gettextRcmdr("Binomial Distribution"))
    trialsVar <- tclVar("")
    trialsEntry <- ttkentry(top, width="6", textvariable=trialsVar)
    probVar <- tclVar(".5")
    probEntry <- ttkentry(top, width="6", textvariable=probVar)
    functionVar <- tclVar("Probability")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Probability")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        trials <- round(as.numeric(tclvalue(trialsVar)))
		prob <- as.numeric(tclvalue(probVar))
		options(warn)
        if (is.na(trials)) {
            errorCondition(recall=binomialDistributionPlot, message=gettextRcmdr("Binomial trials not specified."))
            return()
            } 
        if (is.na(prob)) {
            errorCondition(recall=binomialDistributionPlot, message=gettextRcmdr("Probability of success not specified."))
            return()
            }
        fun <- tclvalue(functionVar)
        min <- qbinom(.0005, size=trials, prob=prob)
        max <- qbinom(.9995, size=trials, prob=prob)
        command <- paste(min, ":", max, sep="")
        logger(paste(".x <- ", command, sep=""))
        assign(".x", justDoIt(command), envir=.GlobalEnv)
        if (fun == "Probability"){
            doItAndPrint(paste("plot(.x, dbinom(.x, size=", trials, ", prob=", prob,
                '), xlab="Number of Successes", ylab="Probability Mass", main="Binomial Distribution: Trials = ', 
                trials, ', Probability of success = ', prob, '", type="h")', sep=""))
            doItAndPrint(paste("points(.x, dbinom(.x, size=", trials, ", prob=", prob,
                '), pch=16)', sep=""))
            }
        else {
            command <- "rep(.x, rep(2, length(.x)))"
            logger(paste(".x <- ", command, sep=""))
            assign(".x", justDoIt(command), envir=.GlobalEnv)
            doItAndPrint(paste("plot(.x[-1], pbinom(.x, size=", trials, ", prob=", prob,
                ')[-length(.x)], xlab="Number of Successes", ylab="Cumulative Probability", main="Binomial Distribution: Trials = ', 
                trials, ', Probability of success = ', prob, '", type="l")', sep=""))
            }
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dbinom")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Binomial trials")), trialsEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot probability mass function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(trialsEntry, sticky="w")
    tkgrid.configure(probEntry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=5, columns=2, focus=trialsEntry)
    }

PoissonDistributionPlot <- function(){
    initializeDialog(title=gettextRcmdr("Poisson Distribution"))
    meanVar <- tclVar("")
    meanEntry <- ttkentry(top, width="6", textvariable=meanVar)
    functionVar <- tclVar("Probability")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Probability")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        mean <- as.numeric(tclvalue(meanVar))
		options(warn)
        if (is.na(mean)) {
            errorCondition(recall=PoissonDistributionPlot, message=gettextRcmdr("Mean not specified."))
            return()
            }
        if (mean < 0) {
            errorCondition(recall=PoissonDistributionPlot, message=gettextRcmdr("Poisson mean cannot be negative."))
            return()
            }
        fun <- tclvalue(functionVar)
        min <- qpois(.0005, lambda=mean)
        max <- qpois(.9995, lambda=mean)
        command <- paste(min, ":", max, sep="")
        logger(paste(".x <- ", command, sep=""))
        assign(".x", justDoIt(command), envir=.GlobalEnv)
        if (fun == "Probability"){
            doItAndPrint(paste("plot(.x, dpois(.x, lambda=", mean,
                '), xlab="x", ylab="Probability Mass", main="Poisson Distribution: Mean = ', 
                mean, '", type="h")', sep=""))
            doItAndPrint(paste("points(.x, dpois(.x, lambda=", mean,
                '), pch=16)', sep=""))
            }
        else {
            command <- "rep(.x, rep(2, length(.x)))"
            logger(paste(".x <- ", command, sep=""))
            assign(".x", justDoIt(command), envir=.GlobalEnv)
            doItAndPrint(paste("plot(.x[-1], ppois(.x, lambda=", mean,
                ')[-length(.x)], xlab="x", ylab="Probability Mass", main="Poisson Distribution: Mean = ', 
                mean, '", type="l")', sep=""))
            }
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dpois")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Mean")), meanEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot probability mass function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(meanEntry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=4, columns=2, focus=meanEntry)
    }
    
# the following functions were contributed by G. Jay Kerns, Andy Chang, and  Theophilius Boye
#  last modified 26 July 06 by J. Fox

geomDistributionPlot  <- function(){
    initializeDialog(title=gettextRcmdr("Geometric Distribution"))
    probVar <- tclVar("0.5")
    probEntry <- ttkentry(top, width="6", textvariable=probVar)
    functionVar <- tclVar("Probability")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Probability")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        prob <- as.numeric(tclvalue(probVar))
		options(warn)
        if ( is.na(prob) ) {
              errorCondition(recall=geomDistributionPlot, message=gettextRcmdr("Probability of success was not specified."))
              return()
        }
        if (prob < 0 || prob > 1) {
            errorCondition(recall=geomDistributionPlot, message=gettextRcmdr("Probability of success must be between 0 and 1."))
            return()
            }
        fun <- tclvalue(functionVar)
        xmin <- qgeom(.0005, prob=prob)
        xmax <- qgeom(.9995, prob=prob)
        command <- paste(xmin, ":", xmax, sep="")
        logger(paste(".x <- ", command, sep=""))
        assign(".x", justDoIt(command), envir=.GlobalEnv)
        if (fun == "Probability"){
            doItAndPrint(paste("plot(.x, dgeom(.x, prob=", prob,
                '), xlab="Number of Failures until Success", ylab="Probability Mass", main="Geometric Distribution: Prob of success = ', prob, '", type="h")', sep=""))
            doItAndPrint(paste("points(.x, dgeom(.x, prob=", prob,
                '), pch=16)', sep=""))
        } else {
            command <- "rep(.x, rep(2, length(.x)))"
            logger(paste(".x <- ", command, sep=""))
            assign(".x", justDoIt(command), envir=.GlobalEnv)
            doItAndPrint(paste("plot(.x[-1], pgeom(.x, prob=", prob,
                ')[-length(.x)], xlab="Number of Failures until Success", ylab="Cumulative Probability", main="Geometric Distribution: Probability of success = ', prob, '", type="l")', sep=""))
        }
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dgeom")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot probability mass function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(probEntry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=5, columns=2, focus=probEntry)
    }
    
hyperDistributionPlot  <- function(){
    initializeDialog(title=gettextRcmdr("Hypergeometric Distribution"))
    mVar <- tclVar("1")
    mEntry <- ttkentry(top, width="6", textvariable=mVar)
    nVar <- tclVar("1")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    kVar <- tclVar("1")
    kEntry <- ttkentry(top, width="6", textvariable=kVar)
    functionVar <- tclVar("Probability")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Probability")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        m <- as.numeric(tclvalue(mVar))
        n <- as.numeric(tclvalue(nVar))
        k <- as.numeric(tclvalue(kVar))
		options(warn)
        fun <- tclvalue(functionVar)
        # Do some error checking
        if ( is.na(m) ){
              errorCondition(recall=hyperDistributionPlot, message=gettextRcmdr("The m parameter was not specified."))
              return()
        }
        if ( m < 0 ){
              errorCondition(recall=hyperDistributionPlot, message=gettextRcmdr("The m parameter cannot be negative."))
              return()
        }
        m <- round(m)
        if ( is.na(n) ){
              errorCondition(recall=hyperDistributionPlot, message=gettextRcmdr("The n parameter was not specified."))
              return()
        }
        if ( n < 0 ){
              errorCondition(recall=hyperDistributionPlot, message=gettextRcmdr("The n parameter cannot be negative."))
              return()
        }
        n <- round(n)
        if ( is.na(k) ){
              errorCondition(recall=hyperDistributionPlot, message=gettextRcmdr("The k parameter was not specified."))
              return()
        }
        k <- round(k)
        if ( k > (m + n) ){
                errorCondition(recall=hyperDistributionPlot,
                message=gettextRcmdr("The k parameter cannot be greater than m + n."))
                        return()
                    }
        if ( k < 0 ){
                errorCondition(recall=hyperDistributionPlot,
                message=gettextRcmdr("The k parameter cannot be negative."))
                        return()
                    }

        xmin <- qhyper(.0005, m=m, n=n, k=k)
        xmax <- qhyper(.9995, m=m, n=n, k=k)
        command <- paste(xmin, ":", xmax, sep="")
        logger(paste(".x <- ", command, sep=""))
        assign(".x", justDoIt(command), envir=.GlobalEnv)
        if (fun == "Probability"){
            doItAndPrint(paste("plot(.x, dhyper(.x, m=", m, ", n=", n, ", k=", k,
                '), xlab="Number of White Balls in Sample", ylab="Probability Mass", main="Hypergeometric Distribution: m=',
                m, ", n=", n, ", k=", k, '", type="h")', sep=""))
            doItAndPrint(paste("points(.x, dhyper(.x, m=", m, ", n=", n, ", k=", k,
                '), pch=16)', sep=""))
            }
        else {
            command <- "rep(.x, rep(2, length(.x)))"
            logger(paste(".x <- ", command, sep=""))
            assign(".x", justDoIt(command), envir=.GlobalEnv)
            doItAndPrint(paste("plot(.x[-1], phyper(.x, m=", m, ", n=", n, ", k=", k,
                ')[-length(.x)], xlab="Number of White Balls in Sample", ylab="Cumulative Probability", main="Hypergeometric Distribution: m=',
                m, ", n=", n, ", k=", k, '", type="l")', sep=""))
            }
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dhyper")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("m (number of white balls in the urn)")), mEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("n (number of black balls in the urn)")), nEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("k (number of balls drawn from the urn)")), kEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot probability mass function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(mEntry, sticky="w")
    tkgrid.configure(nEntry, sticky="w")
    tkgrid.configure(kEntry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=6, columns=2, focus=mEntry)
    }

negbinomialDistributionPlot  <- function(){
    initializeDialog(title=gettextRcmdr("Negative Binomial Distribution"))
    trialsVar <- tclVar("1")
    trialsEntry <- ttkentry(top, width="6", textvariable=trialsVar)
    probVar <- tclVar("0.5")
    probEntry <- ttkentry(top, width="6", textvariable=probVar)
    functionVar <- tclVar("Probability")
    densityButton <- ttkradiobutton(top, variable=functionVar, value="Probability")
    distributionButton <- ttkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
		warn <- options(warn=-1)
        trials <- as.numeric(tclvalue(trialsVar))
		prob <- as.numeric(tclvalue(probVar))
		options(warn)
        if ( is.na(trials) ){
              errorCondition(recall=negbinomialDistributionPlot, 
                message=gettextRcmdr("Target number of successes not specified."))
              return()
          }
        if ( trials < 0){
              errorCondition(recall=negbinomialDistributionPlot, 
                message=gettextRcmdr("Target number of successes cannot be negative."))
              return()
          }
        trials <- round(trials)
        if ( is.na(prob) ){
              errorCondition(recall=negbinomialDistributionPlot, 
                message=gettextRcmdr("Probability of success not specified."))
              return()
          }
        if (prob < 0 || prob > 1) {
            errorCondition(recall=negbinomialDistributionPlot, 
              message=gettextRcmdr("Probability of success must be between 0 and 1."))
            return()
            }
        xmin <- qnbinom(.0005, size=trials, prob=prob)
        xmax <- qnbinom(.9995, size=trials, prob=prob) 
        logger(paste(".x <- ", xmin, ":", xmax, sep=""))
        assign(".x", justDoIt(paste(".x <- ", xmin, ":", xmax, sep="")), envir=.GlobalEnv)
        fun <- tclvalue(functionVar)
        if (fun == "Probability"){
            doItAndPrint(paste("plot(.x, dnbinom(.x, size=", trials, ", prob=", prob,
              '), xlab="Number of Failures Until Target Successes", ylab="Probability Mass", main=',
              paste('"Negative Binomial Distribution:\\nTarget successes = ', trials, ', Probability of success = ', prob, '"', sep=""), 
              ', type="h")', sep=""))
            doItAndPrint(paste("points(.x, dnbinom(.x, size=", trials, ", prob=", prob,
              '), pch=16)', sep=""))
            } 
        else {
            command <- "rep(.x, rep(2, length(.x)))"
            logger(paste(".x <- ", command, sep=""))
            assign(".x", justDoIt(command), envir=.GlobalEnv)
            doItAndPrint(paste("plot(.x[-1], pnbinom(.x, size=", trials, ", prob=", prob,
                ')[-length(.x)], xlab="Number of Failures Until Target Successes", ylab="Cumulative Probability", main=',
                paste('"Negative Binomial Distribution:\\nTarget successes = ',trials, ', Probability of success = ', prob, '"', sep=""), 
                ', type="l")', sep=""))
            }
        doItAndPrint('abline(h=0, col="gray")')
        remove(.x, envir=.GlobalEnv)
        logger("remove(.x)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dnbinom")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Target number of successes")), trialsEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot probability mass function")), densityButton, sticky="e")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Plot distribution function")), distributionButton, sticky="e")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(trialsEntry, sticky="w")
    tkgrid.configure(probEntry, sticky="w")
    tkgrid.configure(densityButton, sticky="w")
    tkgrid.configure(distributionButton, sticky="w")
    dialogSuffix(rows=5, columns=2, focus=trialsEntry)
    }
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/distributions-sample.R"
# Distributions menu dialogs for selecting samples

# last modified 17 September 2008 by J. Fox

normalDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from Normal Distribution"))
    dsname <- tclVar(gettextRcmdr("NormalSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="20", textvariable=dsname)
    muVar <- tclVar("0")
    muEntry <- ttkentry(top, width="6", textvariable=muVar)
    sigmaVar <- tclVar("1")
    sigmaEntry <- ttkentry(top, width="6", textvariable=sigmaVar)
    nVar <- tclVar("100")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"), 
        initialValues=c("1", "0", "0"), 
        labels=gettextRcmdr(c("Sample means", "Sample sums", 
            "Sample standard deviations")))    
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=normalDistributionSamples, 
                message=gettextRcmdr("You must enter the name of a data set."))  
            return()
            }  
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=normalDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                normalDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        mu <- as.numeric(tclvalue(muVar))
        sigma <- as.numeric(tclvalue(sigmaVar))
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
		options(warn)
		if (is.na(mu)) {
			errorCondition(recall=normalDistributionSamples, message=gettextRcmdr("Mean not specified."))
			return()
		}
        if (is.na(sigma) || sigma <= 0) {
            errorCondition(recall=normalDistributionSamples, message=gettextRcmdr("Standard deviation must be positive."))
            return()
            }
        if (is.na(n) || n <= 0) {
            errorCondition(recall=normalDistributionSamples, 
                message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=normalDistributionSamples, 
                message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(rnorm(", samples, "*", n, ", mean=", mu, ", sd=", sigma, "), ncol=", n, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1) 
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (n == 1) 
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', n,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", n, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="rnorm")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("mu (mean)")), muEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("sigma (standard deviation)")), sigmaEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=10, columns=2, focus=muEntry)
    }

# --- t distribution

tDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from t Distribution"))
    dsname <- tclVar(gettextRcmdr("tSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="20", textvariable=dsname)
    dfVar <- tclVar("")
    dfEntry <- ttkentry(top, width="6", textvariable=dfVar)
    nVar <- tclVar("100")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"), 
        initialValues=c("1", "0", "0"), 
        labels=gettextRcmdr(c("Sample means", "Sample sums", 
            "Sample standard deviations")))    
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=tDistributionSamples, 
                message=gettextRcmdr("You must enter the name of a data set."))  
            return()
            }  
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=tDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                tDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        df <- as.numeric(tclvalue(dfVar))
		n <- as.numeric(tclvalue(nVar))
		samples <- as.numeric(tclvalue(samplesVar))
		options(warn)
        if (is.na(df)) {
            errorCondition(recall=tDistributionSamples, 
                message=gettextRcmdr("Degrees of freedom not specified."))
            return()
            }
        if (df<=0) {
            errorCondition(recall=tDistributionSamples, 
                message=gettextRcmdr("Degrees of freedom must be positive."))
            return()
            }
        if (is.na(n) || n <= 0) {
            errorCondition(recall=tDistributionSamples, 
                message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=tDistributionSamples, 
                message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(rt(", samples, "*", n, ", df=", df, "), ncol=", n, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1) 
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (n == 1) 
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', n,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", n, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="rt")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Degrees of freedom")), dfEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=10, columns=2, focus=dfEntry)
    }

# ------- chisquare distribution

chisquareDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from Chi-squared Distribution"))
    dsname <- tclVar(gettextRcmdr("ChisquareSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="20", textvariable=dsname)
    dfVar <- tclVar("")
    dfEntry <- ttkentry(top, width="6", textvariable=dfVar)
    nVar <- tclVar("100")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"), 
        initialValues=c("1", "0", "0"), 
        labels=gettextRcmdr(c("Sample means", "Sample sums", 
            "Sample standard deviations")))    
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=chisquareDistributionSamples, 
                message=gettextRcmdr("You must enter the name of a data set."))  
            return()
            }  
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=chisquareDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                chisquareDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        df <- as.numeric(tclvalue(dfVar))
		n <- as.numeric(tclvalue(nVar))
		samples <- as.numeric(tclvalue(samplesVar))
		options(warn)
        if (is.na(df)) {
            errorCondition(recall=chisquareDistributionSamples, 
                message=gettextRcmdr("Degrees of freedom not specified."))
            return()
            }
        if (df<=0) {
            errorCondition(recall=chisquareDistributionSamples, 
                message=gettextRcmdr("Degrees of freedom must be positive."))
            return()
            }
        if (is.na(n) || n <= 0) {
            errorCondition(recall=chisquareDistributionSamples, 
                message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=chisquareDistributionSamples, 
                message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(rchisq(", samples, "*", n, ", df=", df, "), ncol=", n, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1) 
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (n == 1) 
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', n,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", n, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="rchisq")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Degrees of freedom")), dfEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=10, columns=2, focus=dfEntry)
    }
    
# ------ F-distribution

FDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from F Distribution"))
    dsname <- tclVar(gettextRcmdr("FSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="20", textvariable=dsname)
    df1Var <- tclVar("")
    df2Var <- tclVar("")
    df1Entry <- ttkentry(top, width="6", textvariable=df1Var)
    df2Entry <- ttkentry(top, width="6", textvariable=df2Var)
    nVar <- tclVar("100")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"), 
        initialValues=c("1", "0", "0"), 
        labels=gettextRcmdr(c("Sample means", "Sample sums", 
            "Sample standard deviations")))    
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=FDistributionSamples, 
                message=gettextRcmdr("You must enter the name of a data set."))  
            return()
            }  
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=FDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                FDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        df1 <- as.numeric(tclvalue(df1Var))
        df2 <- as.numeric(tclvalue(df2Var))
		n <- as.numeric(tclvalue(nVar))
		samples <- as.numeric(tclvalue(samplesVar))
		options(warn)
        if (is.na(df1)) {
            errorCondition(recall=FDistributionSamples, 
                message=gettextRcmdr("Numerator degrees of freedom not specified."))
            return()
            }
        if (is.na(df2)) {
             errorCondition(recall=FDistributionSamples, 
                message=gettextRcmdr("Denominator degrees of freedom not specified."))
            return()
            }
        if (df1 <= 0) {
            errorCondition(recall=FDistributionSamples, 
                message=gettextRcmdr("Numerator degrees of freedom must be positive."))
            return()
            }
        if (df2 <= 0) {
            errorCondition(recall=FDistributionSamples, 
                message=gettextRcmdr("Denominator degrees of freedom must be positive."))
            return()
            }
        if (is.na(n) || n <= 0) {
            errorCondition(recall=FDistributionSamples, 
                message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=FDistributionSamples, 
                message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(rf(", samples, "*", n, ", df1=", df1, ", df2=", df2, "), ncol=", n, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1) 
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (n == 1) 
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', n,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", n, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="rf")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Numerator degrees of freedom")), df1Entry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Denominator degrees of freedom")), df2Entry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=11, columns=2, focus=df1Entry)
    }

# ----- exponential distribution

exponentialDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from Exponential Distribution"))
    dsname <- tclVar(gettextRcmdr("ExponentialSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="20", textvariable=dsname)
    rateVar <- tclVar("1")
    rateEntry <- ttkentry(top, width="6", textvariable=rateVar)
    nVar <- tclVar("100")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"), 
        initialValues=c("1", "0", "0"), 
        labels=gettextRcmdr(c("Sample means", "Sample sums", 
            "Sample standard deviations")))    
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=tDistributionSamples, 
                message=gettextRcmdr("You must enter the name of a data set."))  
            return()
            }  
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=tDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                tDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        rate <- as.numeric(tclvalue(rateVar))
		n <- as.numeric(tclvalue(nVar))
		samples <- as.numeric(tclvalue(samplesVar))
		options(warn)
        if (is.na(rate) || rate <= 0) {
            errorCondition(recall=exponentialDistributionPlot, 
                message=gettextRcmdr("Rate must be positive."))
            return()
            }
        if (is.na(n) || n <= 0) {
            errorCondition(recall=tDistributionSamples, 
                message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=tDistributionSamples, 
                message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(rexp(", samples, "*", n, ", rate=", rate, "), ncol=", n, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1) 
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (n == 1) 
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', n,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", n, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="rexp")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Rate")), rateEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=10, columns=2, focus=rateEntry)
    }
    
# ----- uniform distribution

uniformDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from Uniform Distribution"))
    dsname <- tclVar(gettextRcmdr("UniformSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="20", textvariable=dsname)
    minVar <- tclVar("0")
    maxVar <- tclVar("1")
    minEntry <- ttkentry(top, width="6", textvariable=minVar)
    maxEntry <- ttkentry(top, width="6", textvariable=maxVar)
    nVar <- tclVar("100")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"), 
        initialValues=c("1", "0", "0"), 
        labels=gettextRcmdr(c("Sample means", "Sample sums", 
            "Sample standard deviations")))    
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=uniformDistributionSamples, 
                message=gettextRcmdr("You must enter the name of a data set."))  
            return()
            }  
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=uniformDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                uniformDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        minValue <- as.numeric(tclvalue(minVar))
        maxValue <- as.numeric(tclvalue(maxVar))
		n <- as.numeric(tclvalue(nVar))
		samples <- as.numeric(tclvalue(samplesVar))
		options(warn)
        if (is.na(minValue) || is.na(maxValue) || minValue >= maxValue) {
            errorCondition(recall=uniformDistributionSamples, 
                message=gettextRcmdr("Lower limit must be less than upper limit."))
            return()
            }
        if (is.na(n) || n <= 0) {
            errorCondition(recall=uniformDistributionSamples, 
                message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=uniformDistributionSamples, 
                message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(runif(", samples, "*", n, ", min=", minValue, ", max=", maxValue, "), ncol=", n, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1) 
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (n == 1) 
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', n,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", n, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="runif")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Minimum")), minEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Maximum")), maxEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=11, columns=2, focus=minEntry)
    }
    
# ----- beta distribution

betaDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from Beta Distribution"))
    dsname <- tclVar(gettextRcmdr("BetaSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="20", textvariable=dsname)
    shape1Var <- tclVar("")
    shape1Entry <- ttkentry(top, width="6", textvariable=shape1Var)
    shape2Var <- tclVar("")
    shape2Entry <- ttkentry(top, width="6", textvariable=shape2Var)
    nVar <- tclVar("100")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"), 
        initialValues=c("1", "0", "0"), 
        labels=gettextRcmdr(c("Sample means", "Sample sums", 
            "Sample standard deviations")))    
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=betaDistributionSamples, 
                message=gettextRcmdr("You must enter the name of a data set."))  
            return()
            }  
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=betaDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                betaDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        shape1 <- as.numeric(tclvalue(shape1Var))
        shape2 <- as.numeric(tclvalue(shape2Var))
		n <- as.numeric(tclvalue(nVar))
		samples <- as.numeric(tclvalue(samplesVar))
		options(warn)
        if (is.na(shape1) || is.na(shape2)) {
            errorCondition(recall=betaDistributionSamples, 
                message=gettextRcmdr("Shapes not specified."))
            return()
            }
        if (shape1 <= 0 || shape2 <= 0) {
            errorCondition(recall=betaDistributionSamples, 
                message=gettextRcmdr("Shapes must be positive."))
            return()
            }
        if (is.na(n) || n <= 0) {
            errorCondition(recall=betaDistributionSamples, 
                message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=betaDistributionSamples, 
                message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(rbeta(", samples, "*", n, ", shape1=", shape1, ", shape2=", shape2, "), ncol=", n, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1) 
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (n == 1) 
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', n,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", n, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="rbeta")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Shape 1")), shape1Entry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Shape 2")), shape2Entry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=11, columns=2, focus=shape1Entry)
    }

# ---- Cauchy distribution

CauchyDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from Cauchy Distribution"))
    dsname <- tclVar(gettextRcmdr("CauchySamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="20", textvariable=dsname)
    locationVar <- tclVar("0")
    locationEntry <- ttkentry(top, width="6", textvariable=locationVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    nVar <- tclVar("100")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"), 
        initialValues=c("1", "0", "0"), 
        labels=gettextRcmdr(c("Sample means", "Sample sums", 
            "Sample standard deviations")))    
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=CauchyDistributionSamples, 
                message=gettextRcmdr("You must enter the name of a data set."))  
            return()
            }  
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=CauchyDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                CauchyDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        location <- as.numeric(tclvalue(locationVar))
        s <- as.numeric(tclvalue(sVar))
		n <- as.numeric(tclvalue(nVar))
		samples <- as.numeric(tclvalue(samplesVar))
		options(warn)
		if (is.na(location)){
			errorCondition(recall=CauchyDistributionSamples,
					message=gettextRcmdr("Location not specified."))
		}		
        if (is.na(s) || s <= 0) {
            errorCondition(recall=CauchyDistributionSamples, 
                message=gettextRcmdr("Scale must be positive."))
            return()
            }
        if (is.na(n) || n <= 0) {
            errorCondition(recall=CauchyDistributionSamples, 
                message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=CauchyDistributionSamples, 
                message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(rcauchy(", samples, "*", n, ", location=", location, ", scale=", s, "), ncol=", n, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1) 
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (n == 1) 
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', n,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", n, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="rcauchy")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Location")), locationEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale")), sEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=11, columns=2, focus=locationEntry)
    }

# ---- logistic distribution

logisticDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from Logistic Distribution"))
    dsname <- tclVar(gettextRcmdr("LogisticSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="20", textvariable=dsname)
    locationVar <- tclVar("0")
    locationEntry <- ttkentry(top, width="6", textvariable=locationVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    nVar <- tclVar("100")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"), 
        initialValues=c("1", "0", "0"), 
        labels=gettextRcmdr(c("Sample means", "Sample sums", 
            "Sample standard deviations")))    
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=logisticDistributionSamples, 
                message=gettextRcmdr("You must enter the name of a data set."))  
            return()
            }  
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=logisticDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                CauchyDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        location <- as.numeric(tclvalue(locationVar))
        s <- as.numeric(tclvalue(sVar))
		n <- as.numeric(tclvalue(nVar))
		samples <- as.numeric(tclvalue(samplesVar))
		options(warn)
		if (is.na(location)){
			errorCondition(recall=logisticDistributionSamples,
					message=gettextRcmdr("Location not specified."))
			}
        if (is.na(s) || s <= 0) {
            errorCondition(recall=logisticDistributionSamples, 
                message=gettextRcmdr("Scale must be positive."))
            return()
            }
        if (is.na(n) || n <= 0) {
            errorCondition(recall=logisticDistributionSamples, 
                message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=logisticDistributionSamples, 
                message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(rlogis(", samples, "*", n, ", location=", location, ", scale=", s, "), ncol=", n, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1) 
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (n == 1) 
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', n,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", n, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="rlogis")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Location")), locationEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale")), sEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=11, columns=2, focus=locationEntry)
    }
    
# ---- lognormal distribution

lognormalDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from Log-Normal Distribution"))
    dsname <- tclVar(gettextRcmdr("LogNormalSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="20", textvariable=dsname)
    meanlogVar <- tclVar("0")
    meanlogEntry <- ttkentry(top, width="6", textvariable=meanlogVar)
    sdlogVar <- tclVar("1")
    sdlogEntry <- ttkentry(top, width="6", textvariable=sdlogVar)
    nVar <- tclVar("100")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"), 
        initialValues=c("1", "0", "0"), 
        labels=gettextRcmdr(c("Sample means", "Sample sums", 
            "Sample standard deviations")))    
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=lognormalDistributionSamples, 
                message=gettextRcmdr("You must enter the name of a data set."))  
            return()
            }  
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=lognormalDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                normalDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        meanlog <- as.numeric(tclvalue(meanlogVar))
        sdlog <- as.numeric(tclvalue(sdlogVar))
		n <- as.numeric(tclvalue(nVar))
		samples <- as.numeric(tclvalue(samplesVar))
		options(warn)
		if (is.na(meanlog)){
			errorCondition(recall=lognormalDistributionSamples,
				message=gettextRcmdr("Mean not specified."))
			}
        if (is.na(sdlog) || sdlog <= 0) {
            errorCondition(recall=lognormalDistributionSamples, 
                message=gettextRcmdr("Standard deviation must be positive."))
            return()
            }
        if (is.na(n) || n <= 0) {
            errorCondition(recall=lognormalDistributionSamples, 
                message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=lognormalDistributionSamples, 
                message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(rlnorm(", samples, "*", n, ", meanlog=", meanlog, ", sdlog=", sdlog, "), ncol=", n, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1) 
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (n == 1) 
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', n,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", n, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="rlnorm")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Mean (log scale)")), meanlogEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Standard deviation (log scale)")), sdlogEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=11, columns=2, focus=meanlogEntry)
    }

# ---- gamma distribution

gammaDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from Gamma Distribution"))
    dsname <- tclVar(gettextRcmdr("GammaSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="20", textvariable=dsname)
    shapeVar <- tclVar("")
    shapeEntry <- ttkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    nVar <- tclVar("100")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"), 
        initialValues=c("1", "0", "0"), 
        labels=gettextRcmdr(c("Sample means", "Sample sums", 
            "Sample standard deviations")))    
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=gammaDistributionSamples, 
                message=gettextRcmdr("You must enter the name of a data set."))  
            return()
            }  
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=gammaDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                gammaDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        shape <- as.numeric(tclvalue(shapeVar))
		s <- as.numeric(tclvalue(sVar))
		n <- as.numeric(tclvalue(nVar))
		samples <- as.numeric(tclvalue(samplesVar))
		options(warn)
        if (is.na(shape)) {
            errorCondition(recall=gammaDistributionSamples, 
                message=gettextRcmdr("Shape not specified."))
            return()
            }
        if (shape <= 0) {
            errorCondition(recall=gammaDistributionSamples, 
                message=gettextRcmdr("Shape must be positive."))
            return()
            }
        if (is.na(s) || s <= 0) {
            errorCondition(recall=gammaDistributionSamples, 
                message=gettextRcmdr("Scale must be positive."))
            return()
            }
        if (is.na(n) || n <= 0) {
            errorCondition(recall=gammaDistributionSamples, 
                message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=gammaDistributionSamples, 
                message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(rgamma(", samples, "*", n, ", shape=", shape, ", scale=", s, "), ncol=", n, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1) 
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (n == 1) 
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', n,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", n, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="rgamma")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Shape")), shapeEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale (inverse rate)")), sEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=11, columns=2, focus=shapeEntry)
    }
    
# ---- Weibull distribution

WeibullDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from Weibull Distribution"))
    dsname <- tclVar(gettextRcmdr("WeibullSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="20", textvariable=dsname)
    shapeVar <- tclVar("")
    shapeEntry <- ttkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    nVar <- tclVar("100")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"), 
        initialValues=c("1", "0", "0"), 
        labels=gettextRcmdr(c("Sample means", "Sample sums", 
            "Sample standard deviations")))    
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=WeibullDistributionSamples, 
                message=gettextRcmdr("You must enter the name of a data set."))  
            return()
            }  
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=WeibullDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                normalDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        shape <- as.numeric(tclvalue(shapeVar))
		s <- as.numeric(tclvalue(sVar))
		n <- as.numeric(tclvalue(nVar))
		samples <- as.numeric(tclvalue(samplesVar))
		options(warn)
        if (is.na(shape)) {
            errorCondition(recall=WeibullDistributionSamples, 
                message=gettextRcmdr("Shape not specified."))
            return()
            }
        if (shape <= 0) {
            errorCondition(recall=WeibullDistributionSamples, 
                message=gettextRcmdr("Shape must be positive."))
            return()
            }
        if (is.na(s) || s <= 0) {
            errorCondition(recall=WeibullDistributionSamples, 
                message=gettextRcmdr("Scale must be positive."))
            return()
            }
        if (is.na(n) || n <= 0) {
            errorCondition(recall=WeibullDistributionSamples, 
                message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=WeibullDistributionSamples, 
                message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(rweibull(", samples, "*", n, ", shape=", shape, ", scale=", s, "), ncol=", n, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1) 
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (n == 1) 
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', n,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", n, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="rweibull")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Shape")), shapeEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale")), sEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=11, columns=2, focus=shapeEntry)
    }
    
# ---- Gumbel distribution

GumbelDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from Gumbel Distribution"))
    dsname <- tclVar(gettextRcmdr("GumbelSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="20", textvariable=dsname)
    shapeVar <- tclVar("")
    shapeEntry <- ttkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- ttkentry(top, width="6", textvariable=sVar)
    nVar <- tclVar("100")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"), 
        initialValues=c("1", "0", "0"), 
        labels=gettextRcmdr(c("Sample means", "Sample sums", 
            "Sample standard deviations")))    
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=GumbelDistributionSamples, 
                message=gettextRcmdr("You must enter the name of a data set."))  
            return()
            }  
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=GumbelDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                normalDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        shape <- as.numeric(tclvalue(shapeVar))
		s <- as.numeric(tclvalue(sVar))
		n <- as.numeric(tclvalue(nVar))
		samples <- as.numeric(tclvalue(samplesVar))
		options(warn)
        if (is.na(shape)) {
            errorCondition(recall=GumbelDistributionSamples, 
                message=gettextRcmdr("Shape not specified."))
            return()
            }
        if (shape <= 0) {
            errorCondition(recall=GumbelDistributionSamples, 
                message=gettextRcmdr("Shape must be positive."))
            return()
            }
        if (is.na(s) || s <= 0) {
            errorCondition(recall=GumbelDistributionSamples, 
                message=gettextRcmdr("Scale must be positive."))
            return()
            }
        if (is.na(n) || n <= 0) {
            errorCondition(recall=GumbelDistributionSamples, 
                message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=GumbelDistributionSamples, 
                message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(log(rweibull(", samples, "*", n, ", shape=", shape, ", scale=", s, ")), ncol=", n, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1) 
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (n == 1) 
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', n,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", n, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="rweibull")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Shape (log shape)")), shapeEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale (log scale)")), sEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=11, columns=2, focus=shapeEntry)
    }
    
# ---- binomial distribution

binomialDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from Binomial Distribution"))
    dsname <- tclVar(gettextRcmdr("BinomialSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="20", textvariable=dsname)
    probVar <- tclVar(".5")
    probEntry <- ttkentry(top, width="6", textvariable=probVar)
    trialsVar <- tclVar("1")
    trialsEntry <- ttkentry(top, width="6", textvariable=trialsVar) 
    nVar <- tclVar("100")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"), 
        initialValues=c("1", "0", "0"), 
        labels=gettextRcmdr(c("Sample means", "Sample sums", 
            "Sample standard deviations")))    
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=binomialDistributionSamples, 
                message=gettextRcmdr("You must enter the name of a data set."))  
            return()
            }  
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=binomialDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                binomialDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        prob <- as.numeric(tclvalue(probVar))
		trials <- round(as.numeric(tclvalue(trialsVar)))
		n <- as.numeric(tclvalue(nVar))
		samples <- as.numeric(tclvalue(samplesVar))
		options(warn)
        if (is.na(prob)) {
            errorCondition(recall=binomialDistributionSamples, 
                message=gettextRcmdr("Probability of success not specified."))
            return()
            }
        if (prob < 0 || prob > 1) {
            errorCondition(recall=binomialDistributionSamples, 
                message=gettextRcmdr("Probability of success must be between 0 and 1."))
            return()
            }
        if (is.na(trials)) {
            errorCondition(recall=binomialDistributionSamples, 
                message=gettextRcmdr("Binomial trials not specified."))
            return()
            }
        if (is.na(n) || n <= 0) {
            errorCondition(recall=binomialDistributionSamples, 
                message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=binomialDistributionSamples, 
                message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(rbinom(", samples, "*", n, ", size=", trials, ", prob=", prob, "), ncol=", n, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1) 
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (n == 1) 
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', n,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", n, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="rbinom")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Binomial trials")), trialsEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=11, columns=2, focus=trialsEntry)
    }
    
# ---- Poisson distribution

PoissonDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from Poisson Distribution"))
    dsname <- tclVar(gettextRcmdr("PoissonSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="20", textvariable=dsname)
    meanVar <- tclVar("")
    meanEntry <- ttkentry(top, width="6", textvariable=meanVar)
    nVar <- tclVar("100")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"), 
        initialValues=c("1", "0", "0"), 
        labels=gettextRcmdr(c("Sample means", "Sample sums", 
            "Sample standard deviations")))    
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=PoissonDistributionSamples, 
                message=gettextRcmdr("You must enter the name of a data set."))  
            return()
            }  
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=PoissonDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                PoissonDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        mean <- as.numeric(tclvalue(meanVar))
		n <- as.numeric(tclvalue(nVar))
		samples <- as.numeric(tclvalue(samplesVar))
		options(warn)
        if (is.na(mean)) {
            errorCondition(recall=PoissonDistributionPlot, 
                message=gettextRcmdr("Mean not specified."))
            return()
            }
        if (mean < 0) {
            errorCondition(recall=PoissonDistributionPlot, 
                message=gettextRcmdr("Poisson mean cannot be negative."))
            return()
            }
        if (is.na(n) || n <= 0) {
            errorCondition(recall=PoissonDistributionSamples, 
                message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=PoissonDistributionSamples, 
                message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(rpois(", samples, "*", n, ", lambda=", mean, "), ncol=", n, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1) 
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (n == 1) 
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', n,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", n, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="rpois")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Mean")), meanEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=10, columns=2, focus=meanEntry)
    }
    
# ---- geometric distribution

geomDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from Geometric Distribution"))
    dsname <- tclVar(gettextRcmdr("GeometricSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="20", textvariable=dsname)
    probVar <- tclVar(".5")
    probEntry <- ttkentry(top, width="6", textvariable=probVar)
    nVar <- tclVar("100")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"),
        initialValues=c("1", "0", "0"),
        labels=gettextRcmdr(c("Sample means", "Sample sums",
            "Sample standard deviations")))
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=geomDistributionSamples,
                message=gettextRcmdr("You must enter the name of a data set."))
            return()
            }
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=geomDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                geomDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        prob <- as.numeric(tclvalue(probVar))
		n <- as.numeric(tclvalue(nVar))
		samples <- as.numeric(tclvalue(samplesVar))
		options(warn)
        if (is.na(prob)) {
            errorCondition(recall=geomDistributionSamples, 
                message=gettextRcmdr("Probability of success not specified."))
            return()
            }
        if (prob < 0 || prob > 1) {
            errorCondition(recall=geomDistributionSamples, 
                message=gettextRcmdr("Probability of success must be between 0 and 1."))
            return()
            }
        if (is.na(n) || n <= 0) {
            errorCondition(recall=geomDistributionSamples, 
                message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=geomDistributionSamples, 
                message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(rgeom(", samples, "*", n, ", prob=", prob, "), ncol=", n, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1)
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (n == 1)
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', n,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", n, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="rgeom")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname,
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=10, columns=2, focus=probEntry)
    }


# ---- hypergeometric distribution

hyperDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from Hypergeometric Distribution"))
    dsname <- tclVar(gettextRcmdr("HypergeometricSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="20", textvariable=dsname)
    mVar <- tclVar("1")
    mEntry <- ttkentry(top, width="6", textvariable=mVar)
    nVar <- tclVar("1")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    kVar <- tclVar("1")
    kEntry <- ttkentry(top, width="6", textvariable=kVar)
    sampleSizeVar <- tclVar("100")
    sampleSizeEntry <- ttkentry(top, width="6", textvariable=sampleSizeVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"),
        initialValues=c("1", "0", "0"),
        labels=gettextRcmdr(c("Sample means", "Sample sums",
            "Sample standard deviations")))
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=geometricDistributionSamples,
                message=gettextRcmdr("You must enter the name of a data set."))
            return()
            }
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=geometricDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                geometricDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        m <- as.numeric(tclvalue(mVar))
        n <- as.numeric(tclvalue(nVar))
        k <- as.numeric(tclvalue(kVar))
		options(warn)
        if ( is.na(m) ){
              errorCondition(recall=hyperDistributionSamples, 
                message=gettextRcmdr("The m parameter was not specified."))
              return()
        }
        if ( m < 0 ){
              errorCondition(recall=hyperDistributionSamples, 
                message=gettextRcmdr("The m parameter cannot be negative."))
              return()
        }
        m <- round(m)
        if ( is.na(n) ){
              errorCondition(recall=hyperDistributionSamples, 
                message=gettextRcmdr("The n parameter was not specified."))
              return()
        }
        if ( n < 0 ){
              errorCondition(recall=hyperDistributionSamples, 
                message=gettextRcmdr("The n parameter cannot be negative."))
              return()
        }
        n <- round(n)
        if ( is.na(k) ){
              errorCondition(recall=hyperDistributionSamples, 
                message=gettextRcmdr("The k parameter was not specified."))
              return()
        }
        k <- round(k)
        if ( k > (m + n) ){
                errorCondition(recall=hyperDistributionSamples,
                message=gettextRcmdr("The k parameter cannot be greater than m + n."))
                        return()
                    }
        if ( k < 0 ){
                errorCondition(recall=hyperDistributionSamples,
                message=gettextRcmdr("The k parameter cannot be negative."))
                        return()
                    }
        sampleSize <- as.numeric(tclvalue(sampleSizeVar))
        samples <- as.numeric(tclvalue(samplesVar))
        if (is.na(sampleSize) || sampleSize <= 0) {
            errorCondition(recall=geometricDistributionSamples, 
                message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=geometricDistributionSamples, 
                message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(rhyper(", samples, "*", sampleSize, ", n=", n, ", m=", m, ", k=", k,"), ncol=", sampleSize, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1)
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (sampleSize == 1)
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', sampleSize,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", sampleSize, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", sampleSize, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", sampleSize, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="rhyper")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname,
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("m (number of white balls in the urn)")), mEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("n (number of black balls in the urn)")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("k (number of balls drawn from the urn)")), kEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), sampleSizeEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=12, columns=2, focus=mEntry)
    }
    
negbinomialDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from Negative Binomial Distribution"))
    dsname <- tclVar(gettextRcmdr("NegativeBinomialSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- ttkentry(dsFrame, width="22", textvariable=dsname)
    probVar <- tclVar(".5")
    probEntry <- ttkentry(top, width="6", textvariable=probVar)
    trialsVar <- tclVar("1")
    trialsEntry <- ttkentry(top, width="6", textvariable=trialsVar) 
    nVar <- tclVar("100")
    nEntry <- ttkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- ttkentry(top, width="6", textvariable=samplesVar)
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sum", "sd"), 
        initialValues=c("1", "0", "0"), 
        labels=gettextRcmdr(c("Sample means", "Sample sums", 
            "Sample standard deviations")))    
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == "") {
            errorCondition(recall=negbinomialDistributionSamples, 
                message=gettextRcmdr("You must enter the name of a data set."))  
            return()
            }  
        if (!is.valid.name(dsnameValue)) {
            errorCondition(recall=negbinomialDistributionSamples,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))){
                negbinomialDistributionSamples()
                return()
                }
            }
		warn <- options(warn=-1)
        prob <- as.numeric(tclvalue(probVar))
		trials <- round(as.numeric(tclvalue(trialsVar)))
		n <- as.numeric(tclvalue(nVar))
		samples <- as.numeric(tclvalue(samplesVar))
		options(warn)
        if (is.na(prob)) {
            errorCondition(recall=negbinomialDistributionSamples, 
              message=gettextRcmdr("Probability of success not specified."))
            return()
            }
        if (prob < 0 || prob > 1) {
            errorCondition(recall=negbinomialDistributionSamples, 
              message=gettextRcmdr("Probability of success must be between 0 and 1."))
            return()
            }
        if (is.na(trials)) {
            errorCondition(recall=negbinomialDistributionSamples, 
              message=gettextRcmdr("Target number of successes not specified."))
            return()
            }
        if ( trials < 0){
              errorCondition(recall=negnegbinomialDistributionSamples, 
                message=gettextRcmdr("Target number of successes cannot be negative."))
              return()
          }
        if (is.na(n) || n <= 0) {
            errorCondition(recall=negbinomialDistributionSamples, 
              message=gettextRcmdr("Sample size must be positive."))
            return()
            }
        if (is.na(samples) || samples <= 0) {
            errorCondition(recall=negbinomialDistributionSamples, 
              message=gettextRcmdr("Number of samples must be positive."))
            return()
            }
        command <- paste(dsnameValue, " <- as.data.frame(matrix(rnbinom(", samples, "*", n, ", size=", trials, ", prob=", prob, "), ncol=", n, "))", sep="")
        justDoIt(command)
        logger(command)
        command <- if (samples == 1) 
            paste("rownames(", dsnameValue, ') <- "sample"', sep="")
            else paste("rownames(", dsnameValue, ') <- paste("sample", 1:', samples,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        command <- if (n == 1) 
            paste("colnames(", dsnameValue, ') <- "obs"', sep="")
            else paste("colnames(", dsnameValue, ') <- paste("obs", 1:', n,
                ', sep="")', sep="")
        justDoIt(command)
        logger(command)
        if (tclvalue(meanVariable) == "1") {
            command <- paste(dsnameValue, "$mean <- rowMeans(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sumVariable) == "1") {
            command <- paste(dsnameValue, "$sum <- rowSums(", dsnameValue,
                "[,1:", n, "])", sep="")
            justDoIt(command)
            logger(command)
            }
        if (tclvalue(sdVariable) == "1") {
            command <- paste(dsnameValue, "$sd <- apply(", dsnameValue,
                "[,1:", n, "], 1, sd)", sep="")
            justDoIt(command)
            logger(command)
            }
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="rnbinom")
    tkgrid(labelRcmdr(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Target number of successes")), trialsEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=11, columns=2, focus=trialsEntry)
    }

#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/file-menu.R"
# last modified 21 September 2010 by J. Fox

# File menu dialogs

loadLog <- function(){
    logFile <- tclvalue(tkgetOpenFile(filetypes=gettextRcmdr('{"Script Files" {".R"}} {"All Files" {"*"}}'),
        defaultextension="log"))
    if (logFile == "") return()
    fileCon <- file(logFile, "r")
    contents <- readLines(fileCon)
    close(fileCon)
    currentLogFileName <- getRcmdr("logFileName")
    putRcmdr("logFileName", logFile)
    .log <- LogWindow()
    if (tclvalue(tkget(.log, "1.0", "end")) != "\n"){
        response2 <- RcmdrTkmessageBox(message=gettextRcmdr("Save current log file?"),
                icon="question", type="yesno", default="yes")
        if ("yes" == tclvalue(response2)) saveLog(currentLogFileName)
        }
    tkdelete(.log, "1.0", "end")
    tkinsert(.log, "end", paste(contents, collapse="\n"))
    }

saveLog <- function() {
    .logFileName <- getRcmdr("logFileName")
    if (is.null(.logFileName)) {
        saveLogAs()
        return()
        }
    log <- tclvalue(tkget(LogWindow(), "1.0", "end"))
    fileCon <- file(.logFileName, "w")
    cat(log, file = fileCon)
    close(fileCon)
    Message(paste(gettextRcmdr("Script saved to"), .logFileName), type="note")
    }

saveLogAs <- function() {
    logFile <- tclvalue(tkgetSaveFile(filetypes=gettextRcmdr('{"Script Files" {".R"}} {"All Files" {"*"}}'),
        defaultextension="R", initialfile="RCommander.R"))
    if (logFile == "") return()
    log <- tclvalue(tkget(LogWindow(), "1.0", "end"))
    fileCon <- file(logFile, "w")
    cat(log, file = fileCon)
    close(fileCon)
    putRcmdr("logFileName", logFile)
     Message(paste(gettextRcmdr("Script saved to"), logFile), type="note")
    }

saveOutput <- function() {
    .outputFileName <- getRcmdr("outputFileName")
    if (is.null(.outputFileName)) {
        saveOutputAs()
        return()
        }
    output <- tclvalue(tkget(OutputWindow(), "1.0", "end"))
    fileCon <- file(.outputFileName, "w")
    cat(output, file = fileCon)
    close(fileCon)
    Message(paste(gettextRcmdr("Output saved to"), .outputFileName), type="note")
    }

saveOutputAs <- function() {
    outputFile <- tclvalue(tkgetSaveFile(filetypes=gettextRcmdr('{"Output Files" {".txt"}} {"All Files" {"*"}}'),
        defaultextension="txt", initialfile="RCommander.txt"))
    if (outputFile == "") return()
    output <- tclvalue(tkget(OutputWindow(), "1.0", "end"))
    fileCon <- file(outputFile, "w")
    cat(output, file = fileCon)
    close(fileCon)
    putRcmdr("outputFileName", outputFile)
    Message(paste(gettextRcmdr("Output saved to"), outputFile), type="note")
    }

saveWorkspaceAs <- function(){
    saveFile <- tclvalue(tkgetSaveFile(filetypes=gettextRcmdr('{"All Files" {"*"}}'),
        defaultextension="", initialfile=".RData"))
    if (saveFile == "") return()
    save(list=ls(envir=.GlobalEnv), file=saveFile)
    putRcmdr("saveFileName", saveFile)
    Message(paste(gettextRcmdr("R workspace saved to"), saveFile), type="note")
    }

saveWorkspace <- function() {
    .saveFileName <- getRcmdr("saveFileName")
    if (is.null(.saveFileName)) {
        saveWorkspaceAs()
        return()
        }
    else save(list=ls(envir=.GlobalEnv), file=.saveFileName)
    Message(paste(gettextRcmdr("R workspace saved to"), .saveFileName), type="note")
    }

CloseCommander <- function() closeCommander(ask=getRcmdr("ask.to.exit"), ask.save=getRcmdr("ask.on.exit"))

closeCommander <- function(ask=TRUE, ask.save=ask){
    if (ask){
        response <- tclvalue(RcmdrTkmessageBox(message=gettextRcmdr("Exit?"),
            icon="question", type="okcancel", default="cancel"))
        if (response == "cancel") return(invisible(response))
        }
	else {
		ask.save=FALSE
		response <- "ok"
	}
    sink(type="message")
#    if (rglLoaded()) rgl.quit()
    if (!is.null(ActiveDataSet()) && getRcmdr("attach.data.set"))
        justDoIt(logger(paste("detach(", ActiveDataSet(), ")", sep="")))
    putRcmdr(".activeDataSet", NULL)
    putRcmdr(".activeModel", NULL)
    if (ask.save && getRcmdr("log.commands") && tclvalue(tkget(LogWindow(), "1.0", "end")) != "\n"){
         response2 <- RcmdrTkmessageBox(message=gettextRcmdr("Save script file?"),
                 icon="question", type="yesno", default="yes")
         if ("yes" == tclvalue(response2)) saveLog()
         }
    if (ask.save && !getRcmdr("console.output") && tclvalue(tkget(OutputWindow(), "1.0", "end")) != "\n"){
         response3 <- RcmdrTkmessageBox(message=gettextRcmdr("Save output file?"),
                 icon="question", type="yesno", default="yes")
         if ("yes" == tclvalue(response3)) saveOutput()
         }
    if (.Platform$OS.type != "windows") options(getRcmdr("oldPager"))
    if (getRcmdr("suppress.X11.warnings")) {
        sink(type = "message")
        close(getRcmdr("messages.connection"))
    }
    options(getRcmdr("saveOptions"))
    tkdestroy(CommanderWindow())
    putRcmdr("commanderWindow", NULL)
    putRcmdr("logWindow", NULL)
    putRcmdr("messagesWindow", NULL)
    putRcmdr("outputWindow", NULL)
    options(getRcmdr("quotes"))
    tkwait <- options("Rcmdr")[[1]]$tkwait  # to address problem in Debian Linux
    if ((!is.null(tkwait)) && tkwait) tclvalue(.commander.done) <<- "1"
    return(invisible(response))
    }

closeCommanderAndR <- function(){
    response <- CloseCommander()
    if (response == "cancel") return()
    cat("\n")
    quit(save="no")
    }

Options <- function(){
    setOption <- function(option, default) {
        if (is.null(current[[option]])) default else current[[option]]
        }
    initializeDialog(title=gettextRcmdr("Commander Options"))
    current <- options("Rcmdr")[[1]]
    console.output <- setOption("console.output", FALSE)
    log.commands <- setOption("log.commands", TRUE)
    log.font.size <- setOption("log.font.size", 10)
    log.width <- setOption("log.width", 80)
    log.height <- if (!is.null(current$log.height)) current$log.height
                    else if (!log.commands) 0 else 10
    output.height <- if (!is.null(current$output.height)) current$output.height
        else if (console.output) 0 else 2*log.height
    contrasts <- setOption("default.contrasts", c("contr.Treatment", "contr.poly"))
    grab.focus <- setOption("grab.focus", TRUE)
    double.click <- setOption("double.click", FALSE)
    sort.names <- setOption("sort.names", TRUE)
    show.edit.button <- setOption("show.edit.button", TRUE)
    scale.factor <- current$scale.factor
    default.font.size <- setOption("default.font.size",
        if (.Platform$OS.type != "windows") 12 else 10)
    default.font <- setOption("default.font",
        paste("*helvetica-medium-r-normal-*-", default.font.size, "*", sep=""))
    consoleOutputVar <- tclVar(console.output)
    consoleOutputCheckBox <- tkcheckbutton(top, variable=consoleOutputVar)
    logCommandsVar <- tclVar(log.commands)
    logCommandsCheckBox <- tkcheckbutton(top, variable=logCommandsVar)
    logFontSizeVar <- tclVar(log.font.size)
    logFontSizeSlider <- tkscale(top, from=6, to=20, showvalue=TRUE, variable=logFontSizeVar,
        resolution=1, orient="horizontal")
    logWidthVar <- tclVar(log.width)
    logWidthSlider <- tkscale(top, from=30, to=120, showvalue=TRUE, variable=logWidthVar,
        resolution=5, orient="horizontal")
    logHeightVar <- tclVar(log.height)
    logHeightSlider <- tkscale(top, from=0, to=25, showvalue=TRUE, variable=logHeightVar,
        resolution=1, orient="horizontal")
    outputHeightVar <- tclVar(output.height)
    outputHeightSlider <- tkscale(top, from=0, to=50, showvalue=TRUE, variable=outputHeightVar,
        resolution=5, orient="horizontal")
    contrasts1 <- tclVar(contrasts[1])
    contrasts2 <- tclVar(contrasts[2])
    contrastsFrame <- tkframe(top)
    contrasts1Entry <- ttkentry(contrastsFrame, width="15", textvariable=contrasts1)
    contrasts2Entry <- ttkentry(contrastsFrame, width="15", textvariable=contrasts2)
    grabFocusVar <- tclVar(as.numeric(grab.focus))
    grabFocusCheckBox <- tkcheckbutton(top, variable=grabFocusVar)
    doubleClickVar <- tclVar(as.numeric(double.click))
    doubleClickCheckBox <- tkcheckbutton(top, variable=doubleClickVar)
    sortNamesVar <- tclVar(as.numeric(sort.names))
    sortNamesCheckBox <- tkcheckbutton(top, variable=sortNamesVar)
    showEditButtonVar <- tclVar(as.numeric(show.edit.button))
    showEditButtonCheckBox <- tkcheckbutton(top, variable=showEditButtonVar)
    scaleFactorVar <- tclVar(if (is.null(scale.factor)) 1.0 else scale.factor)
    scaleFactorSlider <- tkscale(top, from=0.2, to=3.0, showvalue=TRUE, variable=scaleFactorVar,
        resolution=0.2, orient="horizontal")
    defaultFont <- tclVar(default.font)
    defaultFontEntry <- ttkentry(top, width="30", textvariable=scaleFactorVar)
    onOK <- function(){
        closeDialog(top)
        log.font.size <- round(as.numeric(tclvalue(logFontSizeVar)))
        log.width <- round(as.numeric(tclvalue(logWidthVar)))
        log.height <- as.numeric(tclvalue(logHeightVar))
        log.commands <- as.logical(tclvalue(logCommandsVar) == "1") && (log.height != 0)
        output.height <- as.numeric(tclvalue(outputHeightVar))
        console.output <- as.logical(tclvalue(consoleOutputVar) == "1") || (output.height == 0)
        contrasts <- c(tclvalue(contrasts1), tclvalue(contrasts2))
        grab.focus <- tclvalue(grabFocusVar) == 1
        double.click <- tclvalue(doubleClickVar) == 1
        sort.names <- tclvalue(sortNamesVar) == 1
        show.edit.button <- tclvalue(showEditButtonVar) == 1
        scale.factor <- round(as.numeric(tclvalue(scaleFactorVar)), 1)
        if (scale.factor == 1) scale.factor <- NULL
        default.font <- tclvalue(defaultFont)
		options <- current
		options$log.font.size <- log.font.size
		options$log.width <- log.width
		options$log.height <- log.height
		options$log.commands <- log.commands
		options$output.height <- output.height
		options$console.output <- console.output
		options$default.contrasts <- contrasts
		options$grab.focus <- grab.focus
		options$double.click <- double.click
		options$sort.names <- sort.names
		options$show.edit.button <- show.edit.button
        if (.Platform$OS.type == "windows") options$scale.factor <- scale.factor
            else options$default.font <- default.font
        options(Rcmdr=options)
        closeCommander()
        Commander()
        }
    OKCancelHelp(helpSubject="Commander")
	if (.Platform$OS.type == "windows"){
		tkgrid(labelRcmdr(top, text=gettextRcmdr("Scale factor for Tk elements")), scaleFactorSlider, sticky="se")
		tkgrid.configure(scaleFactorSlider, sticky="w")
	}
	else {
		tkgrid(labelRcmdr(top, text=gettextRcmdr("Default font")), defaultFontEntry, sticky="e")
		tkgrid.configure(defaultFontEntry, sticky="w")
	}
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Log-font size (points)")), logFontSizeSlider, sticky="se")
    tkgrid.configure(logFontSizeSlider, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Log width (characters)")), logWidthSlider, sticky="se")
    tkgrid.configure(logWidthSlider, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Log height (lines)")), logHeightSlider, sticky="se")
    tkgrid.configure(logHeightSlider, sticky="w")
	tkgrid(labelRcmdr(top, text=gettextRcmdr("Output height (lines)")), outputHeightSlider, sticky="se")
	tkgrid.configure(outputHeightSlider, sticky="w")
    tkgrid(labelRcmdr(top, text=" "), sticky="w")	
	tkgrid(labelRcmdr(top, text=gettextRcmdr("Log commands to script window")), logCommandsCheckBox, sticky="e")
	tkgrid.configure(logCommandsCheckBox, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Send output to R Console")), consoleOutputCheckBox, sticky="e")
    tkgrid.configure(consoleOutputCheckBox, sticky="w")
    tkgrid(labelRcmdr(contrastsFrame, text=gettextRcmdr("Unordered factors")), labelRcmdr(contrastsFrame, text="   "),
        labelRcmdr(contrastsFrame, text=gettextRcmdr("Ordered factors")), sticky="w")
    tkgrid(contrasts1Entry, labelRcmdr(contrastsFrame, text="   "), contrasts2Entry, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Contrasts")), contrastsFrame, sticky="se")
    tkgrid.configure(contrastsFrame, sticky="sw")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Active window grabs focus")), grabFocusCheckBox, sticky="e")
    tkgrid.configure(grabFocusCheckBox, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Double-click presses OK button")), doubleClickCheckBox, sticky="e")
    tkgrid.configure(doubleClickCheckBox, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Sort variable names alphabetically")), sortNamesCheckBox, sticky="e")
    tkgrid.configure(sortNamesCheckBox, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Show edit button")), showEditButtonCheckBox, sticky="e")
    tkgrid.configure(showEditButtonCheckBox, sticky="w")
    tkconfigure(OKbutton, text=gettextRcmdr("Exit and Restart\nR Commander"), width=18)
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=11, columns=2)
    }

loadPackages <- function(){
    availablePackages <- sort(setdiff(.packages(all.available = TRUE), .packages()))
    if (length(availablePackages) == 0){
        errorCondition(message=gettextRcmdr("No packages available to load."))
        return()
        }
    initializeDialog(title=gettextRcmdr("Load Packages"))
    packagesBox <- variableListBox(top, availablePackages, title=gettextRcmdr("Packages (pick one or more)"),
        selectmode="multiple", listHeight=10)
    onOK <- function(){
        packages <- getSelection(packagesBox)
        closeDialog(top)
        if (length(packages) == 0){
            errorCondition(recall=loadPackages, message=gettextRcmdr("You must select at least one package."))
            return()
            }
        for (package in packages) {
			Library(package)
#            command <- paste('library("', package, '", pos = 4, character.only=TRUE)', sep="")
#            justDoIt(command)
            }
        Message(paste(gettextRcmdr("Packages loaded:"), paste(packages, collapse=", ")), type="note")
        }
    OKCancelHelp(helpSubject="library")
    tkgrid(getFrame(packagesBox), sticky="nw")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=1, columns=1)
    }
	
Setwd <- function(){
	wd <- tclvalue(tkchooseDirectory(initialdir=getwd()))
	if (wd != "") doItAndPrint(paste('setwd("', wd, '")', sep=""))
	}

#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/graphs-menu.R"
# Graphs menu dialogs

# last modified 28 June 2010 by J. Fox

indexPlot <- function(){
    initializeDialog(title=gettextRcmdr("Index Plot"))
    xBox <- variableListBox(top, Numeric(), title=gettextRcmdr("Variable (pick one)"))
    onOK <- function(){
        x <- getSelection(xBox)
        closeDialog()
        if (length(x) == 0){
            errorCondition(recall=indexPlot, message=gettextRcmdr("You must select a variable"))
            return()
            }
        type <- if (tclvalue(typeVariable) == "spikes") "h" else "p"
        identify <- tclvalue(identifyVariable) == "1"
        .activeDataSet <- ActiveDataSet()
        command <- paste("plot(", .activeDataSet, "$", x, ', type="', type, '")', sep="")
        doItAndPrint(command)
        if (par("usr")[3] <= 0) doItAndPrint('abline(h=0, col="gray")')
        if (identify) {
            RcmdrTkmessageBox(title="Identify Points",
                message=paste(gettextRcmdr("Use left mouse button to identify points,\n"),
						gettextRcmdr(if (MacOSXP()) "esc key to exit." else "right button to exit."), sep=""),
                icon="info", type="ok")
            command <- paste("identify(", .activeDataSet, "$", x,
                ", labels=rownames(", .activeDataSet, "))", sep="")
            doItAndPrint(command)
            }
        activateMenus()
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="plot")
    optionsFrame <- tkframe(top)
    typeVariable <- tclVar("spikes")
    spikesButton <- ttkradiobutton(optionsFrame, variable=typeVariable, value="spikes")
    pointsButton <- ttkradiobutton(optionsFrame, variable=typeVariable, value="points")
    identifyVariable <- tclVar("0")
    identifyCheckBox <- tkcheckbutton(optionsFrame, variable=identifyVariable)
    tkgrid(getFrame(xBox), sticky="nw")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Identify observations\nwith mouse"), justify="left"),
        identifyCheckBox, sticky="w")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Spikes")), spikesButton, sticky="w")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Points")), pointsButton, sticky="w")
    tkgrid(optionsFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=2, columns=1)
    }

Histogram <- function(){
    initializeDialog(title=gettextRcmdr("Histogram"))
    xBox <- variableListBox(top, Numeric(), title=gettextRcmdr("Variable (pick one)"))
    onOK <- function(){
        x <- getSelection(xBox)
        closeDialog()
        if (length(x) == 0){
            errorCondition(recall=Histogram, message=gettextRcmdr("You must select a variable"))
            return()
            }
        bins <- tclvalue(binsVariable)
        opts <- options(warn=-1)
        bins <- if (bins == gettextRcmdr("<auto>")) '"Sturges"' else as.numeric(bins)
        options(opts)
        scale <- tclvalue(scaleVariable)
        command <- paste("Hist(", ActiveDataSet(), "$", x, ', scale="',
            scale, '", breaks=', bins, ', col="darkgray")', sep="")
        doItAndPrint(command)
        activateMenus()
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="Hist")
    radioButtons(name="scale", buttons=c("frequency", "percent", "density"),
        labels=gettextRcmdr(c("Frequency counts", "Percentages", "Densities")), title=gettextRcmdr("Axis Scaling"))
    binsFrame <- tkframe(top)
    binsVariable <- tclVar(gettextRcmdr("<auto>"))
    binsField <- ttkentry(binsFrame, width="6", textvariable=binsVariable)
    tkgrid(getFrame(xBox), sticky="nw")
    tkgrid(labelRcmdr(binsFrame, text=gettextRcmdr("Number of bins: ")), binsField, sticky="w")
    tkgrid(binsFrame, sticky="w")
    tkgrid(scaleFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    tkgrid.configure(binsField, sticky="e")
    dialogSuffix(rows=4, columns=1)
    }

stemAndLeaf <- function(){
	Library("aplpack")
    initializeDialog(title=gettextRcmdr("Stem and Leaf Display"), preventCrisp=TRUE)
    xBox <- variableListBox(top, Numeric(), title=gettextRcmdr("Variable (pick one)"))
    displayDigits <- tclVar("1")
    onDigits <- function(...){
        tclvalue(displayDigits) <- formatC(10^as.numeric(tclvalue(leafsDigitValue)),
            format="fg", big.mark=",")
        tclvalue(leafsAutoVariable) <- "0"
        }
    radioButtons(name="parts", buttons=c("auto", "one", "two", "five"),
        values=c("auto", "1", "2", "5"), labels=c(gettextRcmdr("Automatic"), "   1", "   2", "   5"),
        title=gettextRcmdr("Parts Per Stem"))
    radioButtons(name="style", buttons=c("Tukey", "bare"), labels=gettextRcmdr(c("Tukey", "Repeated stem digits")),
        title=gettextRcmdr("Style of Divided Stems"))
    checkBoxes(frame="optionsFrame", boxes=c("trimOutliers", "showDepths", "reverseNegative"),
        initialValues=rep(1, 3), labels=gettextRcmdr(c("Trim outliers", "Show depths", "Reverse negative leaves")))
    leafsFrame <- tkframe(top)
    leafsDigitValue <- tclVar("0")
    leafsDigitSlider <- tkscale(leafsFrame, from=-6, to=6, showvalue=FALSE, variable=leafsDigitValue,
        resolution=1, orient="horizontal", command=onDigits)
    leafsDigitShow <- labelRcmdr(leafsFrame, textvariable=displayDigits, width=8, justify="right")
    leafsAutoVariable <- tclVar("1")
    leafsDigitCheckBox <- tkcheckbutton(leafsFrame, variable=leafsAutoVariable)
    onOK <- function(){
        x <- getSelection(xBox)
        closeDialog()
        if (length(x) == 0){
            errorCondition(recall=stemAndLeaf, message=gettextRcmdr("You must select a variable"))
            return()
            }
        unit <- if (tclvalue(leafsAutoVariable) == "1") ""
            else paste(", unit=", 10^as.numeric(tclvalue(leafsDigitValue)), sep="")
        m <- if (tclvalue(partsVariable) == "auto") ""
            else paste(", m=", tclvalue(partsVariable), sep="")
        trim <- if (tclvalue(trimOutliersVariable) == "1") ""
            else ", trim.outliers=FALSE"
        depths <- if (tclvalue(showDepthsVariable) == "1") ""
            else ", depths=FALSE"
        reverse <- if (tclvalue(reverseNegativeVariable) == "1") ""
            else ", reverse.negative.leaves=FALSE"
        style <- if (tclvalue(styleVariable) == "Tukey") ""
            else ', style="bare"'
        command <- paste("stem.leaf(", ActiveDataSet(), "$", x, style, unit, m, trim,
            depths, reverse, ", na.rm=TRUE)", sep="")
        doItAndPrint(command)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="stem.leaf")
    tkgrid(getFrame(xBox), sticky="nw")
    tkgrid(labelRcmdr(leafsFrame, text=gettextRcmdr("Leafs Digit:  "), fg="blue"),
        labelRcmdr(leafsFrame, text=gettextRcmdr("Automatic")), leafsDigitCheckBox,
        labelRcmdr(leafsFrame, text=gettextRcmdr("  or set:"), fg="red"), leafsDigitShow, leafsDigitSlider, sticky="w")
    tkgrid(leafsFrame, sticky="w")
    tkgrid(partsFrame, sticky="w")
    tkgrid(styleFrame, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Options"), fg="blue"), sticky="w")
    tkgrid(optionsFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    tclvalue(leafsAutoVariable) <- "1"
    dialogSuffix(rows=7, columns=1, preventCrisp=TRUE)
    }

boxPlot <- function(){
    initializeDialog(title=gettextRcmdr("Boxplot"))
    xBox <- variableListBox(top, Numeric(), title=gettextRcmdr("Variable (pick one)"))
    identifyVariable <- tclVar("0")
    identifyFrame <- tkframe(top)
    identifyCheckBox <- tkcheckbutton(identifyFrame, variable=identifyVariable)
    .groups <- FALSE
    onOK <- function(){
        x <- getSelection(xBox)
        closeDialog()
        if (length(x) == 0){
            errorCondition(recall=boxPlot, message=gettextRcmdr("You must select a variable"))
            return()
            }
        identifyPoints <- "1" == tclvalue(identifyVariable)
        .activeDataSet <- ActiveDataSet()
        var <- paste(.activeDataSet, "$", x, sep="")
        if (.groups == FALSE) {
            command <- (paste("boxplot(", var, ', ylab="', x, '")', sep=""))
            logger(command)
            justDoIt(command)
            if (identifyPoints) {
                RcmdrTkmessageBox(title="Identify Points",
						message=paste(gettextRcmdr("Use left mouse button to identify points,\n"),
							gettextRcmdr(if (MacOSXP()) "esc key to exit." else "right button to exit."), sep=""),
                    icon="info", type="ok")
                doItAndPrint(paste("identify(rep(1, length(", var,
                    ")), ", var, ", rownames(", .activeDataSet,"))", sep=""))
                }
            }
        else {
            command <- (paste("boxplot(", x, "~", .groups, ', ylab="', x,
                '", xlab="', .groups,'"',
                ", data=", .activeDataSet, ")", sep=""))
            logger(command)
            justDoIt(command)
            if (identifyPoints) {
                RcmdrTkmessageBox(title="Identify Points",
						message=paste(gettextRcmdr("Use left mouse button to identify points,\n"),
							gettextRcmdr(if (MacOSXP()) "esc key to exit." else "right button to exit."), sep=""),
                    icon="info", type="ok")
                doItAndPrint(paste("identify(", .activeDataSet, "$", .groups, ", ", var,
                    ", rownames(", .activeDataSet,"))", sep=""))
                }
            }
        activateMenus()
        tkfocus(CommanderWindow())
        }
    groupsBox(boxPlot)
    OKCancelHelp(helpSubject="boxplot")
    tkgrid(getFrame(xBox), sticky="nw")
    tkgrid(labelRcmdr(identifyFrame, text=gettextRcmdr("Identify outliers with mouse"), justify="left"),
        identifyCheckBox, sticky="w")
    tkgrid(identifyFrame, stick="w")
    tkgrid(groupsFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=4, columns=1)
    }

scatterPlot <- function(){
    require("car")
    initializeDialog(title=gettextRcmdr("Scatterplot"))
    .numeric <- Numeric()
    variablesFrame <- tkframe(top)
    xBox <- variableListBox(variablesFrame, .numeric, title=gettextRcmdr("x-variable (pick one)"))
    yBox <- variableListBox(variablesFrame, .numeric, title=gettextRcmdr("y-variable (pick one)"))
    optionsParFrame <- tkframe(top)
    checkBoxes(window=optionsParFrame, frame="optionsFrame", 
		boxes=c("identify", "jitterX", "jitterY", "logX", "logY", "boxplots", "lsLine", "smoothLine", "spread"),
        initialValues=c(0, 0, 0, 0, 0, 1, 1, 1, 1), 
		labels=gettextRcmdr(c("Identify points", "Jitter x-variable", "Jitter y-variable", "Log x-axis", "Log y-axis",
        "Marginal boxplots", "Least-squares line", "Smooth line", "Show spread")), title="Options")
    sliderValue <- tclVar("50")
    slider <- tkscale(optionsFrame, from=0, to=100, showvalue=TRUE, variable=sliderValue,
        resolution=5, orient="horizontal")
    subsetBox()
    labelsFrame <- tkframe(top)
    xlabVar <- tclVar(gettextRcmdr("<auto>"))
    ylabVar <- tclVar(gettextRcmdr("<auto>"))
    xlabFrame <- tkframe(labelsFrame)
    xlabEntry <- ttkentry(xlabFrame, width="25", textvariable=xlabVar)
    xlabScroll <- ttkscrollbar(xlabFrame, orient="horizontal",
        command=function(...) tkxview(xlabEntry, ...))
    tkconfigure(xlabEntry, xscrollcommand=function(...) tkset(xlabScroll, ...))
    tkgrid(labelRcmdr(xlabFrame, text=gettextRcmdr("x-axis label"), fg="blue"), sticky="w")
    tkgrid(xlabEntry, sticky="w")
    tkgrid(xlabScroll, sticky="ew")
    ylabFrame <- tkframe(labelsFrame)
    ylabEntry <- ttkentry(ylabFrame, width="25", textvariable=ylabVar)
    ylabScroll <- ttkscrollbar(ylabFrame, orient="horizontal",
        command=function(...) tkxview(ylabEntry, ...))
    tkconfigure(ylabEntry, xscrollcommand=function(...) tkset(ylabScroll, ...))
    tkgrid(labelRcmdr(ylabFrame, text=gettextRcmdr("y-axis label"), fg="blue"), sticky="w")
    tkgrid(ylabEntry, sticky="w")
    tkgrid(ylabScroll, sticky="ew")
    tkgrid(xlabFrame, labelRcmdr(labelsFrame, text="     "), ylabFrame, sticky="w")
    parFrame <- tkframe(optionsParFrame)
    pchVar <- tclVar(gettextRcmdr("<auto>"))
    pchEntry <- ttkentry(parFrame, width=25, textvariable=pchVar)
    cexValue <- tclVar("1")
    cex.axisValue <- tclVar("1")
    cex.labValue <- tclVar("1")
    cexSlider <- tkscale(parFrame, from=0.5, to=2.5, showvalue=TRUE, variable=cexValue,
        resolution=0.1, orient="horizontal")
    cex.axisSlider <- tkscale(parFrame, from=0.5, to=2.5, showvalue=TRUE, variable=cex.axisValue,
        resolution=0.1, orient="horizontal")
    cex.labSlider <- tkscale(parFrame, from=0.5, to=2.5, showvalue=TRUE, variable=cex.labValue,
        resolution=0.1, orient="horizontal")
    onOK <- function(){
        x <- getSelection(xBox)
        y <- getSelection(yBox)
        closeDialog()
        if (length(x) == 0 || length(y) == 0){
            errorCondition(recall=scatterPlot, message=gettextRcmdr("You must select two variables"))
            return()
            }
        if (x == y) {
            errorCondition(recall=scatterPlot, message=gettextRcmdr("x and y variables must be different"))
            return()
            }
        .activeDataSet <- ActiveDataSet()
        jitter <- if ("1" == tclvalue(jitterXVariable) && "1" == tclvalue(jitterYVariable)) ", jitter=list(x=1, y=1)"
            else if ("1" == tclvalue(jitterXVariable)) ", jitter=list(x=1)"
            else if ("1" == tclvalue(jitterYVariable)) ", jitter=list(y=1)"
            else ""
		logstring <- ""
		if ("1" == tclvalue(logXVariable)) logstring <- paste(logstring, "x", sep="")
		if ("1" == tclvalue(logYVariable)) logstring <- paste(logstring, "y", sep="")
		log <- if(logstring != "") paste(', log="', logstring, '"', sep="") else ""
		if("1" == tclvalue(identifyVariable)){
			RcmdrTkmessageBox(title="Identify Points",
					message=paste(gettextRcmdr("Use left mouse button to identify points,\n"),
						gettextRcmdr(if (MacOSXP()) "esc key to exit." else "right button to exit."), sep=""),
					icon="info", type="ok")
			idtext <- ', id.method="identify"'
		}
        else idtext <- ""
        box <- if ("1" == tclvalue(boxplotsVariable)) "'xy'" else "FALSE"
        line <- if("1" == tclvalue(lsLineVariable)) "lm" else "FALSE"
        smooth <- as.character("1" == tclvalue(smoothLineVariable))
		spread <- as.character("1" == tclvalue(spreadVariable))
        span <- as.numeric(tclvalue(sliderValue))
        subset <- tclvalue(subsetVariable)
        subset <- if (trim.blanks(subset) == gettextRcmdr("<all valid cases>")) ""
            else paste(", subset=", subset, sep="")
        xlab <- trim.blanks(tclvalue(xlabVar))
        xlab <- if(xlab == gettextRcmdr("<auto>")) "" else paste(', xlab="', xlab, '"', sep="")
        ylab <- trim.blanks(tclvalue(ylabVar))
        ylab <- if(ylab == gettextRcmdr("<auto>")) "" else paste(', ylab="', ylab, '"', sep="")
        cex <- as.numeric(tclvalue(cexValue))
        cex <- if(cex == 1) "" else paste(', cex=', cex, sep="")
        cex.axis <- as.numeric(tclvalue(cex.axisValue))
        cex.axis <- if(cex.axis == 1) "" else paste(', cex.axis=', cex.axis, sep="")
        cex.lab <- as.numeric(tclvalue(cex.labValue))
        cex.lab <- if(cex.lab == 1) "" else paste(', cex.lab=', cex.lab, sep="")
        pch <- gsub(" ", ",", tclvalue(pchVar))
        if ("" == pch) {
            errorCondition(recall=scatterPlot, message=gettextRcmdr("No plotting characters."))
            return()
            }
        pch <- if(trim.blanks(pch) == gettextRcmdr("<auto>")) "" else paste(", pch=c(", pch, ")", sep="")
        if (.groups == FALSE) {
            doItAndPrint(paste("scatterplot(", y, "~", x, log,
                ", reg.line=", line, ", smooth=", smooth, ", spread=", spread, idtext,
                ", boxplots=", box, ", span=", span/100, jitter, xlab, ylab,
                cex, cex.axis, cex.lab, pch,
                ", data=", .activeDataSet, subset, ")", sep=""))
            }
        else {
            doItAndPrint(paste("scatterplot(", y, "~", x," | ", .groups,
                ", reg.line=", line, ", smooth=", smooth, ", spread=", spread, idtext,
                ", boxplots=", box, ", span=", span/100, jitter, xlab, ylab,
                cex, cex.axis, cex.lab, pch,
                ", by.groups=", .linesByGroup,
                ", data=", .activeDataSet, subset, ")", sep=""))
            }
        activateMenus()
        tkfocus(CommanderWindow())
        }
    groupsBox(scatterPlot, plotLinesByGroup=TRUE)
    OKCancelHelp(helpSubject="scatterplot")
    tkgrid(getFrame(xBox), getFrame(yBox), sticky="nw")
    tkgrid(variablesFrame, sticky="w")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Span for smooth")), slider, sticky="w")
    tkgrid(labelRcmdr(parFrame, text=gettextRcmdr("Plotting Parameters"), fg="blue"), sticky="w")
    tkgrid(labelRcmdr(parFrame, text=gettextRcmdr("Plotting characters")), pchEntry, stick="w")
    tkgrid(labelRcmdr(parFrame, text=gettextRcmdr("Point size")), cexSlider, sticky="w")
    tkgrid(labelRcmdr(parFrame, text=gettextRcmdr("Axis text size")), cex.axisSlider, sticky="w")
    tkgrid(labelRcmdr(parFrame, text=gettextRcmdr("Axis-labels text size")), cex.labSlider, sticky="w")
    tkgrid(optionsFrame, parFrame, sticky="nw")
    tkgrid(optionsParFrame, sticky="w")
    tkgrid(labelsFrame, sticky="w")
    tkgrid(subsetFrame, sticky="w")
    tkgrid(groupsFrame, sticky="w")
    tkgrid(labelRcmdr(top, text=" "))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=8, columns=2)
    }

scatterPlotMatrix <- function(){
    require("car")
    initializeDialog(title=gettextRcmdr("Scatterplot Matrix"))
    variablesBox <- variableListBox(top, Numeric(), title=gettextRcmdr("Select variables (three or more)"),
        selectmode="multiple", initialSelection=NULL)
    checkBoxes(frame="optionsFrame", boxes=c("lsLine", "smoothLine", "spread"), initialValues=c(1,1,0),
        labels=gettextRcmdr(c("Least-squares lines", "Smooth lines", "Show spread")))
    sliderValue <- tclVar("50")
    slider <- tkscale(optionsFrame, from=0, to=100, showvalue=TRUE, variable=sliderValue,
        resolution=5, orient="horizontal")
    radioButtons(name="diagonal", buttons=c("density", "histogram", "boxplot", "oned", "qqplot", "none"),
        labels=gettextRcmdr(c("Density plots", "Histograms", "Boxplots", "One-dimensional scatterplots", "Normal QQ plots", "Nothing (empty)")),
        title=gettextRcmdr("On Diagonal"))
    subsetBox()
    onOK <- function(){
        variables <- getSelection(variablesBox)
        closeDialog()
        if (length(variables) < 3) {
            errorCondition(recall=scatterPlotMatrix, message=gettextRcmdr("Fewer than 3 variable selected."))
            return()
            }
        line <- if("1" == tclvalue(lsLineVariable)) "lm" else "FALSE"
        smooth <- as.character("1" == tclvalue(smoothLineVariable))
		spread <- as.character("1" == tclvalue(spreadVariable))
        span <- as.numeric(tclvalue(sliderValue))
        diag <- as.character(tclvalue(diagonalVariable))
        subset <- tclvalue(subsetVariable)
        subset <- if (trim.blanks(subset) == gettextRcmdr("<all valid cases>")) ""
            else paste(", subset=", subset, sep="")
        .activeDataSet <- ActiveDataSet()
        if (.groups == FALSE) {
           command <- paste("scatterplotMatrix(~", paste(variables, collapse="+"),
                ", reg.line=", line, ", smooth=", smooth, ", spread=", spread,
                ", span=", span/100, ", diagonal = '", diag,
                "', data=", .activeDataSet, subset, ")", sep="")
           logger(command)
           justDoIt(command)
            }
        else {
            command <- paste("scatterplotMatrix(~", paste(variables, collapse="+")," | ", .groups,
                ", reg.line=", line, ", smooth=", smooth, ", spread=", spread,
                ", span=", span/100, ", diagonal= '", diag,
                "', by.groups=", .linesByGroup,
                ", data=", .activeDataSet, subset, ")", sep="")
            logger(command)
            justDoIt(command)
            }
        activateMenus()
        tkfocus(CommanderWindow())
        }
    groupsBox(scatterPlot, plotLinesByGroup=TRUE)
    OKCancelHelp(helpSubject="scatterplotMatrix")
    tkgrid(getFrame(variablesBox), sticky="nw")
	tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Span for smooth")), slider, sticky="w")    
	tkgrid(optionsFrame, sticky="w")
    tkgrid(diagonalFrame, sticky="w")
    tkgrid(subsetFrame, sticky="w")
    tkgrid(groupsFrame, sticky="w")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=6, columns=2)
    }

barGraph <- function(){
    initializeDialog(title=gettextRcmdr("Bar Graph"))
    variableBox <- variableListBox(top, Factors(), title=gettextRcmdr("Variable (pick one)"))
    onOK <- function(){
        variable <- getSelection(variableBox)
        closeDialog()
        if (length(variable) == 0){
            errorCondition(recall=barGraph, message=gettextRcmdr("You must select a variable"))
            return()
            }
        command <- paste("barplot(table(", ActiveDataSet(), "$", variable, '), xlab="',
            variable, '", ylab="Frequency")', sep="")
        logger(command)
        justDoIt(command)
        activateMenus()
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="barplot")
    tkgrid(getFrame(variableBox), sticky="nw")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=2, columns=1)
    }

pieChart <- function(){
	Library("colorspace")
    initializeDialog(title=gettextRcmdr("Pie Chart"))
    variableBox <- variableListBox(top, Factors(), title=gettextRcmdr("Variable (pick one)"))
    onOK <- function(){
        variable <- getSelection(variableBox)
        closeDialog()
        if (length(variable) == 0){
            errorCondition(recall=pieChart, message=gettextRcmdr("You must select a variable"))
            return()
            }
        .activeDataSet <- ActiveDataSet()
        command <- (paste("pie(table(", .activeDataSet, "$", variable, "), labels=levels(",
            .activeDataSet, "$", variable, '), main="', variable, '", col=rainbow_hcl(length(levels(',
            .activeDataSet, "$", variable, "))))", sep=""))
        logger(command)
        justDoIt(command)
        activateMenus()
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="pie")
    tkgrid(getFrame(variableBox), sticky="nw")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=3, columns=1)
    }

linePlot <- function(){
    initializeDialog(title=gettextRcmdr("Line Plot"))
    variablesFrame <- tkframe(top)
    .numeric <- Numeric()
    xBox <- variableListBox(variablesFrame, .numeric, title=gettextRcmdr("x variable (pick one)"))
    yBox <- variableListBox(variablesFrame, .numeric, title=gettextRcmdr("y variables (pick one or more)"),
        selectmode="multiple", initialSelection=NULL)
    axisLabelVariable <- tclVar(gettextRcmdr("<use y-variable names>"))
    axisLabelFrame <- tkframe(top)
    axisLabelEntry <- ttkentry(axisLabelFrame, width="40", textvariable=axisLabelVariable)
    axisLabelScroll <- ttkscrollbar(axisLabelFrame, orient="horizontal",
        command=function(...) tkxview(axisLabelEntry, ...))
    tkconfigure(axisLabelEntry, xscrollcommand=function(...) tkset(axisLabelScroll, ...))
    legendFrame <- tkframe(top)
    legendVariable <- tclVar("0")
    legendCheckBox <- tkcheckbutton(legendFrame, variable=legendVariable)
    onOK <- function(){
        y <- getSelection(yBox)
        x <- getSelection(xBox)
        closeDialog()
        if (0 == length(x)) {
            errorCondition(recall=linePlot, message=gettextRcmdr("No x variable selected."))
            return()
            }
        if (0 == length(y)) {
            errorCondition(recall=linePlot, message=gettextRcmdr("No y variables selected."))
            return()
            }
        if (is.element(x, y)) {
            errorCondition(recall=linePlot, message=gettextRcmdr("x and y variables must be different."))
            return()
            }
        .activeDataSet <- ActiveDataSet()
        .x <- na.omit(eval(parse(text=paste(.activeDataSet, "$", x, sep="")), envir=.GlobalEnv))
        if (!identical(order(.x), seq(along.with=.x))){
            response <- tclvalue(RcmdrTkmessageBox(message=gettextRcmdr("x-values are not in order.\nContinue?"),
                icon="warning", type="okcancel", default="cancel"))
            if (response == "cancel") {
                onCancel()
                return()
                }
            }
        axisLabel <- tclvalue(axisLabelVariable)
        legend <- tclvalue(legendVariable) == "1"
        if (axisLabel == gettextRcmdr("<use y-variable names>")){
            axisLabel <- if (legend) ""
                else if(length(y) == 1) y
                else paste(paste("(", 1:length(y), ") ", y, sep=""), collapse=", ")
            }
        pch <- if (length(y) == 1) ", pch=1" else ""
        if (legend && length(y) > 1){
            mar <- par("mar")
            top <- 3.5 + length(y)
            command <- paste(".mar <- par(mar=c(", mar[1], ",", mar[2], ",", top, ",", mar[4], "))", sep="")
            logger(command)
            justDoIt(command)
            }
        command <- paste("matplot(", .activeDataSet, "$", x, ", ", .activeDataSet, "[, ",
            paste("c(", paste(paste('"', y, '"', sep=""), collapse=","), ")", sep=""),
            '], type="b", lty=1, ylab="', axisLabel, '"', pch, ")", sep="")
        logger(command)
        justDoIt(command)
        if (legend && length(y) > 1){
            n <- length(y)
            cols <- rep(1:6, 1 + n %/% 6)[1:n]
            logger(".xpd <- par(xpd=TRUE)")
            justDoIt(".xpd <- par(xpd=TRUE)")
            usr <- par("usr")
            command <- paste("legend(", usr[1], ", ", usr[4] + 1.2*top*strheight("x"), ", legend=",
                paste("c(", paste(paste('"', y, '"', sep=""), collapse=","), ")", sep=""),
                ", col=c(", paste(cols, collapse=","), "), lty=1, pch=c(",
                paste(paste('"', as.character(1:n), '"', sep=""), collapse=","), "))", sep="")
            logger(command)
            justDoIt(command)
            logger("par(mar=.mar)")
            justDoIt("par(mar=.mar)")
            logger("par(xpd=.xpd)")
            justDoIt("par(xpd=.xpd)")
            }
        activateMenus()
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="matplot")
    tkgrid(getFrame(xBox), labelRcmdr(variablesFrame, text="    "), getFrame(yBox), sticky="nw")
    tkgrid(variablesFrame, sticky="nw")
    tkgrid(labelRcmdr(axisLabelFrame, text=gettextRcmdr("Label for y-axis"), fg="blue"), sticky="w")
    tkgrid(axisLabelEntry, sticky="w")
    tkgrid(axisLabelScroll, sticky="ew")
    tkgrid(axisLabelFrame, sticky="w")
    tkgrid(labelRcmdr(legendFrame, text=gettextRcmdr("Plot legend")),
        legendCheckBox, sticky="w")
    tkgrid(legendFrame, sticky="w")
    tkgrid(buttonsFrame, stick="w")
    dialogSuffix(rows=4, columns=1)
    }

QQPlot <- function()
# this function modified by Martin Maechler
{
    require("car")
    initializeDialog(title=gettextRcmdr("Quantile-Comparison (QQ) Plot"))
    xBox <- variableListBox(top, Numeric(), title=gettextRcmdr("Variable (pick one)"))
    onOK <- function(){
        x <- getSelection(xBox)
        closeDialog()
       if (0 == length(x)) {
            errorCondition(recall=QQPlot, message=gettextRcmdr("You must select a variable."))
            return()
            }
        dist <- tclvalue(distVariable)
        save <- options(warn=-1)
        on.exit(save)
        retryMe <- function(msg) {
            Message(message= msg, type="error")
            QQPlot()
        }
        switch(dist,
               "norm" = { args <- 'dist="norm"' },
               "t" =  {
                   df <- tclvalue(tDfVariable)
                   df.num <- as.numeric(df)
                   if (is.na(df.num) || df.num < 1) {
                       retryMe(gettextRcmdr("df for t must be a positive number."))
                       return()
                   }
                   args <- paste('dist="t", df=', df, sep="")
               },
               "chisq" = {
                   df <- tclvalue(chisqDfVariable)
                   df.num <- as.numeric(df)
                   if (is.na(df.num) || df.num < 1) {
                       retryMe(gettextRcmdr("df for chi-square must be a positive number."))
                       return()
                   }
                   args <- paste('dist="chisq", df=', df, sep="")
               },
               "f" = {
                   df1 <- tclvalue(FDf1Variable)
                   df2 <- tclvalue(FDf2Variable)
                   df.num1 <- as.numeric(df1)
                   df.num2 <- as.numeric(df2)
                   if (is.na(df.num1) || df.num1 < 1 ||
                       is.na(df.num2) || df.num2 < 1) {
                       retryMe(gettextRcmdr("numerator and denominator \ndf for F must be positive numbers."))
                       return()
                   }
                   args <- paste('dist="f", df1=', df1, ', df2=', df2, sep="")
               },
               ## else -- other `dist' :
           {
               dist <- tclvalue(otherNameVariable)
               params <- tclvalue(otherParamsVariable)
               args <- paste('dist="', dist,'", ', params, sep="")
           }) # end{switch}
        .activeDataSet <- ActiveDataSet()
        if ("1" == tclvalue(identifyVariable)){
            RcmdrTkmessageBox(title="Identify Points",
					message=paste(gettextRcmdr("Use left mouse button to identify points,\n"),
						gettextRcmdr(if (MacOSXP()) "esc key to exit." else "right button to exit."), sep=""),
                icon="info", type="ok")
            idtext <- paste(", labels=rownames(", .activeDataSet, '), id.method="identify"', sep="")
            }
        else idtext <- ""
        command <- paste("qqPlot", "(", .activeDataSet, "$", x, ", ", args,
                          idtext, ")", sep="")
        doItAndPrint(command)
        activateMenus()
        tkfocus(CommanderWindow())
    }
    OKCancelHelp(helpSubject="qqPlot")
    distFrame <- tkframe(top)
    distVariable <- tclVar("norm")
    normalButton <- ttkradiobutton(distFrame, variable=distVariable, value="norm")
    tButton <- ttkradiobutton(distFrame, variable=distVariable, value="t")
    chisqButton <- ttkradiobutton(distFrame, variable=distVariable, value="chisq")
    FButton <- ttkradiobutton(distFrame, variable=distVariable, value="f")
    otherButton <- ttkradiobutton(distFrame, variable=distVariable, value="other")
    tDfFrame <- tkframe(distFrame)
    tDfVariable <- tclVar("")
    tDfField <- ttkentry(tDfFrame, width="6", textvariable=tDfVariable)
    chisqDfFrame <- tkframe(distFrame)
    chisqDfVariable <- tclVar("")
    chisqDfField <- ttkentry(chisqDfFrame, width="6", textvariable=chisqDfVariable)
    FDfFrame <- tkframe(distFrame)
    FDf1Variable <- tclVar("")
    FDf1Field <- ttkentry(FDfFrame, width="6", textvariable=FDf1Variable)
    FDf2Variable <- tclVar("")
    FDf2Field <- ttkentry(FDfFrame, width="6", textvariable=FDf2Variable)
    otherParamsFrame <- tkframe(distFrame)
    otherParamsVariable <- tclVar("")
    otherParamsField <- ttkentry(otherParamsFrame, width="30", textvariable=otherParamsVariable)
    otherNameVariable <- tclVar("")
    otherNameField <- ttkentry(otherParamsFrame, width="10", textvariable=otherNameVariable)
    identifyVariable <- tclVar("0")
    identifyFrame <- tkframe(top)
    identifyCheckBox <- tkcheckbutton(identifyFrame, variable=identifyVariable)
    tkgrid(getFrame(xBox), sticky="nw")
    tkgrid(labelRcmdr(identifyFrame, text=gettextRcmdr("Identify observations with mouse")),
           identifyCheckBox, sticky="w")
    tkgrid(identifyFrame, sticky="w")
    tkgrid(labelRcmdr(distFrame, text=gettextRcmdr("Distribution"), fg="blue"), columnspan=6, sticky="w")
    tkgrid(labelRcmdr(distFrame, text=gettextRcmdr("Normal")), normalButton, sticky="w")
    tkgrid(labelRcmdr(tDfFrame, text=gettextRcmdr("df = ")), tDfField, sticky="w")
    tkgrid(labelRcmdr(distFrame, text="t"), tButton, tDfFrame, sticky="w")
    tkgrid(labelRcmdr(chisqDfFrame, text=gettextRcmdr("df = ")), chisqDfField, sticky="w")
    tkgrid(labelRcmdr(distFrame, text=gettextRcmdr("Chi-square")), chisqButton,
           chisqDfFrame, sticky="w")
    tkgrid(labelRcmdr(FDfFrame, text=gettextRcmdr("Numerator df = ")), FDf1Field,
           labelRcmdr(FDfFrame, text=gettextRcmdr("Denominator df = ")), FDf2Field, sticky="w")
    tkgrid(labelRcmdr(distFrame, text="F"), FButton, FDfFrame, sticky="w")
    tkgrid(labelRcmdr(otherParamsFrame, text=gettextRcmdr("Specify: ")),
           otherNameField, labelRcmdr(otherParamsFrame, text=gettextRcmdr("Parameters: ")),
           otherParamsField, sticky="w")
    tkgrid(labelRcmdr(distFrame, text=gettextRcmdr("Other")), otherButton,
           otherParamsFrame, sticky="w")
    tkgrid(distFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=5, columns=1)
    }

PlotMeans <- function(){
    initializeDialog(title=gettextRcmdr("Plot Means"))
    groupBox <- variableListBox(top, Factors(), title=gettextRcmdr("Factors (pick one or two)"), selectmode="multiple")
    responseBox <- variableListBox(top, Numeric(), title=gettextRcmdr("Response Variable (pick one)"))
    onOK <- function(){
        groups <- getSelection(groupBox)
        response <- getSelection(responseBox)
        closeDialog()
        if (0 == length(groups)) {
            errorCondition(recall=PlotMeans, message=gettextRcmdr("No factors selected."))
            return()
            }
        if (2 < length(groups)) {
            errorCondition(recall=PlotMeans, message=gettextRcmdr("More than two factors selected."))
            return()
            }
        if (0 == length(response)) {
            errorCondition(recall=PlotMeans, message=gettextRcmdr("No response variable selected."))
            return()
            }
        .activeDataSet <- ActiveDataSet()
        error.bars <- tclvalue(errorBarsVariable)
        level <- if (error.bars == "conf.int") paste(", level=", tclvalue(levelVariable), sep="") else ""
        if (length(groups) == 1) doItAndPrint(paste("plotMeans(", .activeDataSet, "$", response,
            ", ", .activeDataSet, "$", groups[1],
            ', error.bars="', error.bars, '"', level, ')', sep=""))
        else {
            if (eval(parse(text=paste("length(levels(", .activeDataSet, "$", groups[1],
                ")) < length(levels(", .activeDataSet, "$", groups[2], "))", sep=""))))
                groups <- rev(groups)
            doItAndPrint(paste("plotMeans(", .activeDataSet, "$", response, ", ", .activeDataSet, "$", groups[1],
                ", ", .activeDataSet, "$", groups[2], ', error.bars="', error.bars, '"', level, ')', sep=""))
            }
        activateMenus()
        tkfocus(CommanderWindow())
        }
    optionsFrame <- tkframe(top)
    errorBarsVariable <- tclVar("se")
    seButton <- ttkradiobutton(optionsFrame, variable=errorBarsVariable, value="se")
    sdButton <- ttkradiobutton(optionsFrame, variable=errorBarsVariable, value="sd")
    confIntButton <- ttkradiobutton(optionsFrame, variable=errorBarsVariable, value="conf.int")
    noneButton <- ttkradiobutton(optionsFrame, variable=errorBarsVariable, value="none")
    levelVariable <- tclVar("0.95")
    levelEntry <- ttkentry(optionsFrame, width="6", textvariable=levelVariable)
    buttonsFrame <- tkframe(top)
    OKCancelHelp(helpSubject="plotMeans")
    tkgrid(getFrame(groupBox), getFrame(responseBox), sticky="nw")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Error Bars"), fg="blue"), sticky="w")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Standard errors")), seButton, sticky="w")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Standard deviations")), sdButton, sticky="w")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Confidence intervals")), confIntButton,
        labelRcmdr(optionsFrame, text=gettextRcmdr("   Level of confidence:")), levelEntry, sticky="w")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("No error bars")), noneButton, sticky="w")
    tkgrid(optionsFrame, columnspan=2, sticky="w")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=3, columns=2)
    }

Scatter3D <- function(){
    use.rgl <- options("Rcmdr")[[1]]$use.rgl
    if (length(use.rgl) == 0 || use.rgl) {
		Library("car")
        Library("rgl")
        Library("mgcv")
        }
    initializeDialog(title=gettextRcmdr("3D Scatterplot"))
    variablesFrame <- tkframe(top)
    .numeric <- Numeric()
    xBox <- variableListBox(variablesFrame, .numeric, title=gettextRcmdr("Explanatory variables (pick two)"), selectmode="multiple",
        initialSelection=NULL)
    yBox <- variableListBox(variablesFrame, .numeric, title=gettextRcmdr("Response variable (pick one)"))
    surfacesFrame <- tkframe(top)
    identifyPoints <- tclVar("0")
    identifyPointsCheckBox <- tkcheckbutton(surfacesFrame, variable=identifyPoints)
    axisScales <- tclVar("1")
    axisScalesCheckBox <- tkcheckbutton(surfacesFrame, variable=axisScales)
    gridLines <- tclVar("1")
    gridLinesCheckBox <- tkcheckbutton(surfacesFrame, variable=gridLines)
    squaredResiduals <- tclVar("0")
    squaredResidualsCheckBox <- tkcheckbutton(surfacesFrame, variable=squaredResiduals)
    linearLSSurface <- tclVar("1")
    linearLSCheckBox <- tkcheckbutton(surfacesFrame, variable=linearLSSurface)
    quadLSSurface <- tclVar("0")
    quadLSCheckBox <- tkcheckbutton(surfacesFrame, variable=quadLSSurface)
    nonparSurface <- tclVar("0")
    nonparCheckBox <- tkcheckbutton(surfacesFrame, variable=nonparSurface)
    dfNonparVariable <- tclVar(gettextRcmdr("<auto>"))
    dfNonparField <- ttkentry(surfacesFrame, width="6", textvariable=dfNonparVariable)
    additiveSurface <- tclVar("0")
    additiveCheckBox <- tkcheckbutton(surfacesFrame, variable=additiveSurface)
    dfAddVariable <- tclVar(gettextRcmdr("<auto>"))
    dfAddField <- ttkentry(surfacesFrame, width="6", textvariable=dfAddVariable)
    ellipsoid <- tclVar("0")
    ellipsoidCheckBox <- tkcheckbutton(surfacesFrame, variable=ellipsoid)
    bgFrame <- tkframe(top)
    bgVariable <-tclVar("white")
    whiteButton <- ttkradiobutton(bgFrame, variable=bgVariable, value="white")
    blackButton <- ttkradiobutton(bgFrame, variable=bgVariable, value="black")
    onOK <- function(){
        x <- getSelection(xBox)
        y <- getSelection(yBox)
        closeDialog()
        if (length(y) == 0) {
            errorCondition(recall=Scatter3D, message=gettextRcmdr("You must select a response variable."))
            return()
            }
        if (2 != length(x)) {
            errorCondition(recall=Scatter3D, message=gettextRcmdr("You must select 2 explanatory variables."))
            return()
            }
        if (is.element(y, x)) {
            errorCondition(recall=Scatter3D, message=gettextRcmdr("Response and explanatory variables must be different."))
            return()
            }
        scales <- if (tclvalue(axisScales) == 1) "TRUE" else "FALSE"
        grid <- if (tclvalue(gridLines) == 1) "TRUE" else "FALSE"
        resids <- if(tclvalue(squaredResiduals) == 1) ', residuals="squares"' else ", residuals=TRUE"
        lin <- if(tclvalue(linearLSSurface) == 1) '"linear"'
        quad <- if(tclvalue(quadLSSurface) == 1) '"quadratic"'
        nonpar <- if (tclvalue(nonparSurface) == 1) '"smooth"'
        additive <- if (tclvalue(additiveSurface) == 1) '"additive"'
        surfaces <- c(lin, quad, nonpar, additive)
        nsurfaces <- length(surfaces)
        if (nsurfaces > 1) resids <- ""
        ellips <- if(tclvalue(ellipsoid) == 1) "TRUE" else "FALSE"
        opts <- options(warn=-1)
        dfNonpar <- tclvalue(dfNonparVariable)
        dfNonpar <- if (dfNonpar == gettextRcmdr("<auto>")) "" else paste(", df.smooth=", as.numeric(dfNonpar), sep="")
        dfAdd <- tclvalue(dfAddVariable)
        dfAdd <- if (dfAdd == gettextRcmdr("<auto>")) "" else paste(", df.additive=", as.numeric(dfAdd), sep="")
        options(opts)
        fit <- if (nsurfaces == 0) ", surface=FALSE"
            else if (nsurfaces == 1) paste(", fit=", surfaces, sep="")
            else paste(", fit=c(", paste(surfaces, collapse=","), ")", sep="")
        bg <- tclvalue(bgVariable)
        .activeDataSet <- ActiveDataSet()
        if (.groups != FALSE){
            groups <- paste(", groups=", .activeDataSet, "$", .groups, sep="")
            parallel <- paste(", parallel=", .linesByGroup, sep="")
            }
        else groups <- parallel <- ""
        command <- paste("scatter3d(", .activeDataSet, "$", x[1], ", ",
            .activeDataSet, "$", y, ", ", .activeDataSet, "$", x[2], fit, resids, dfNonpar,
            dfAdd, groups, parallel, ', bg="', bg, '", axis.scales=', scales, ', grid=', grid,
            ', ellipsoid=', ellips, ', xlab="', x[1], '", ylab="', y, '", zlab="', x[2], '")', sep="")
        doItAndPrint(command)
        putRcmdr("rgl", TRUE)
        command <- paste("identify3d(", .activeDataSet, "$", x[1], ", ",
            .activeDataSet, "$", y, ", ", .activeDataSet, "$", x[2], groups,
            ', axis.scales=', scales,
            ", labels=row.names(", .activeDataSet, "))", sep="")
        putRcmdr("Identify3d", command)
        .Tcl("update")
        if (tclvalue(identifyPoints) == 1){
            RcmdrTkmessageBox(title="Identify Points",
					message=paste(gettextRcmdr("Use left mouse button to identify points,\n"),
						gettextRcmdr(if (MacOSXP()) "esc key to exit." else "right button to exit."), sep=""),
                icon="info", type="ok")
            doItAndPrint(command)
            }
        activateMenus()
        tkfocus(CommanderWindow())
        rgl.bringtotop()
        }
    groupsBox(Scatter3D, plotLinesByGroup=TRUE, plotLinesByGroupsText=gettextRcmdr("Parallel regression surfaces"))
    OKCancelHelp(helpSubject="Scatter3DDialog")
    tkgrid(getFrame(yBox), labelRcmdr(variablesFrame, text="  "), getFrame(xBox), sticky="nw")
    tkgrid(variablesFrame, sticky="nw")
    tkgrid(labelRcmdr(surfacesFrame, text=gettextRcmdr("Identify observations\nwith mouse")), identifyPointsCheckBox, sticky="w")
    tkgrid(labelRcmdr(surfacesFrame, text=gettextRcmdr("Show axis scales")), axisScalesCheckBox, sticky="w")
    tkgrid(labelRcmdr(surfacesFrame, text=gettextRcmdr("Show surface grid lines")), gridLinesCheckBox, sticky="w")
    tkgrid(labelRcmdr(surfacesFrame, text=gettextRcmdr("Show squared residuals")), squaredResidualsCheckBox, sticky="w")
    tkgrid(labelRcmdr(surfacesFrame, text=gettextRcmdr("Surfaces to Fit"), fg="blue"), sticky="w")
    tkgrid(labelRcmdr(surfacesFrame, text=gettextRcmdr("Linear least-squares")), linearLSCheckBox, sticky="w")
    tkgrid(labelRcmdr(surfacesFrame, text=gettextRcmdr("Quadratic least-squares")), quadLSCheckBox, sticky="w")
    dfLabel <- labelRcmdr(surfacesFrame, text=gettextRcmdr("df = "))
    tkgrid(labelRcmdr(surfacesFrame, text=gettextRcmdr("Smooth regression")), nonparCheckBox,
        dfLabel, dfNonparField, sticky="w")
    tkgrid.configure(dfLabel, sticky="e")
    tkgrid(labelRcmdr(surfacesFrame, text=gettextRcmdr("Additive regression")), additiveCheckBox,
        labelRcmdr(surfacesFrame, text=gettextRcmdr("df(each term) = ")), dfAddField, sticky="w")
    tkgrid(labelRcmdr(surfacesFrame, text=gettextRcmdr("Plot 50% concentration ellipsoid")), ellipsoidCheckBox, sticky="w")
    tkgrid(surfacesFrame, sticky="w")
    tkgrid(labelRcmdr(bgFrame, text=gettextRcmdr("Background Color"), fg="blue"), sticky="w", columnspan=2)
    tkgrid(labelRcmdr(bgFrame, text=gettextRcmdr("Black")), blackButton, sticky="w")
    tkgrid(labelRcmdr(bgFrame, text=gettextRcmdr("White")), whiteButton, sticky="w")
    tkgrid(bgFrame, sticky="w")
    tkgrid(groupsFrame, sticky="w")
    tkgrid(buttonsFrame, stick="w")
    dialogSuffix(rows=5, columns=1)
    }

Identify3D <- function(){
    if (0 == rgl.cur()) {
        Message(message=gettextRcmdr("There is no current RGL graphics device."),
            type="error")
        return()
        }
    RcmdrTkmessageBox(title="Identify Points",
        message=gettextRcmdr("Drag right mouse button to identify points,\nclick right button to exit."),
        icon="info", type="ok")
    command <- getRcmdr("Identify3d")
    doItAndPrint(command)
    }

saveBitmap <- function(){
    if (1 == dev.cur()) {
        Message(gettextRcmdr("There is no current graphics device to save."), type="error")
        return()
        }
    initializeDialog(title=gettextRcmdr("Save Graph as Bitmap"))
    radioButtons(name="filetype", buttons=c("png", "jpeg"), labels=c("PNG", "JPEG"), title=gettextRcmdr("Graphics File Type"))
    sliderFrame <- tkframe(top)
    widthVariable <- tclVar("500")
    widthSlider <- tkscale(sliderFrame, from=200, to=1000, showvalue=TRUE, variable=widthVariable,
        resolution=25, orient="horizontal")
    heightVariable <- tclVar("500")
    heightSlider <- tkscale(sliderFrame, from=200, to=1000, showvalue=TRUE, variable=heightVariable,
        resolution=25, orient="horizontal")
    onOK <- function(){
        closeDialog()
        width <- tclvalue(widthVariable)
        height <- tclvalue(heightVariable)
        type <- tclvalue(filetypeVariable)
        if (type == "png"){
            ext <- "png"
            filetypes <- gettextRcmdr('{"PNG Files" {".png" ".PNG"}} {"All Files" {"*"}}')
            initial <- "RGraph.png"
            }
        else{
            ext <- "jpg"
            filetypes <- gettextRcmdr('{"JPEG Files" {".jpg" ".JPG" ".jpeg" ".JPEG"}} {"All Files" {"*"}}')
            initial <- "RGraph.jpg"
            }
        filename <- tclvalue(tkgetSaveFile(filetypes=filetypes, defaultextension=ext, initialfile=initial))
        if (filename == "") return()
        command <- paste('dev.print(', type, ', filename="', filename, '", width=', width, ', height=', height, ')', sep="")
        doItAndPrint(command)
        Message(paste(gettextRcmdr("Graph saved to file"), filename), type="note")
        }
    OKCancelHelp(helpSubject="png")
    tkgrid(filetypeFrame, sticky="w")
    tkgrid(labelRcmdr(sliderFrame, text=gettextRcmdr("Width (pixels)")), widthSlider, sticky="sw")
    tkgrid(labelRcmdr(sliderFrame, text=gettextRcmdr("Height (pixels)")), heightSlider, sticky="sw")
    tkgrid(sliderFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=3, columns=1)
    }

savePDF <- function(){
    if (1 == dev.cur()) {
        Message(gettextRcmdr("There is no current graphics device to save."), type="error")
        return()
        }
    initializeDialog(title=gettextRcmdr("Save Graph as PDF/Postscript"))
    radioButtons(name="filetype", buttons=c("pdf", "postscript", "eps"),
        labels=gettextRcmdr(c("PDF", "Postscript", "Encapsulated Postscript")), title=gettextRcmdr("Graphics File Type"))
    sliderFrame <- tkframe(top)
    widthVariable <- tclVar("5")
    widthSlider <- tkscale(sliderFrame, from=3, to=10, showvalue=TRUE, variable=widthVariable,
        resolution=0.1, orient="horizontal")
    heightVariable <- tclVar("5")
    heightSlider <- tkscale(sliderFrame, from=3, to=10, showvalue=TRUE, variable=heightVariable,
        resolution=0.1, orient="horizontal")
    pointSizeVariable <- tclVar("10")
    pointSizeSlider <- tkscale(sliderFrame, from=6, to=14, showvalue=TRUE, variable=pointSizeVariable,
        resolution=1, orient="horizontal")
    onOK <- function(){
        closeDialog()
        width <- tclvalue(widthVariable)
        height <- tclvalue(heightVariable)
        type <- tclvalue(filetypeVariable)
        pointsize <- tclvalue(pointSizeVariable)
        if (type == "pdf"){
            ext <- "pdf"
            filetypes <- gettextRcmdr('{"PDF Files" {".pdf" ".PDF"}} {"All Files" {"*"}}')
            initial <- "RGraph.pdf"
            }
        else if (type == "postscript") {
            ext <- "ps"
            filetypes <- gettextRcmdr('{"Postscript Files" {".ps" ".PS"}} {"All Files" {"*"}}')
            initial <- "RGraph.ps"
            }
        else {
            ext <- "eps"
            filetypes <- gettextRcmdr('{"Encapsulated Postscript Files" {".eps" ".EPS"}} {"All Files" {"*"}}')
            initial <- "RGraph.eps"
            }
        filename <- tclvalue(tkgetSaveFile(filetypes=filetypes, defaultextension=ext, initialfile=initial))
        if (filename == "") return()
        command <- if (type == "eps") paste('dev.copy2eps(file="', filename, '", width=', width, ', height=', height,
                ', pointsize=', pointsize, ')', sep="")
            else paste('dev.print(', type, ', file="', filename, '", width=', width, ', height=', height,
                ', pointsize=', pointsize, ')', sep="")
        doItAndPrint(command)
        Message(paste(gettextRcmdr("Graph saved to file"), filename), type="note")
        }
    OKCancelHelp(helpSubject="pdf")
    tkgrid(filetypeFrame, sticky="w")
    tkgrid(labelRcmdr(sliderFrame, text=gettextRcmdr("Width (inches)")), widthSlider, sticky="sw")
    tkgrid(labelRcmdr(sliderFrame, text=gettextRcmdr("Height (inches)")), heightSlider, sticky="sw")
    tkgrid(labelRcmdr(sliderFrame, text=gettextRcmdr("Text size (points)")), pointSizeSlider, sticky="sw")
    tkgrid(sliderFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=3, columns=1)
    }

saveRglGraph <- function(){
    if (0 == rgl.cur()) {
        Message(message=gettextRcmdr("There is no current RGL graphics device to save."),
            type="error")
        return()
        }
    ext <- "png"
    filetypes <- gettextRcmdr('{"PNG Bitmap Files" {".png" ".PNG"}} {"All Files" {"*"}}')
    initial <- "RGLGraph.png"
    filename <- tclvalue(tkgetSaveFile(filetypes=filetypes, defaultextension=ext, initialfile=initial))
    if (filename == "") return()
    command <- paste('rgl.snapshot("', filename, '")', sep="")
    doItAndPrint(command)
    Message(paste(gettextRcmdr("Graph saved to file"), filename), type="note")
    }

# The following function by Richard Heiberger, with small modifications by J. Fox

## The following function by Richard Heiberger, with small modifications by J. Fox
## with more modifications by Richard Heiberger.
## 2008-01-03 added conditions, layout, and multiple colors
Xyplot <- function() {
	Library("lattice")
	initializeDialog(title=gettextRcmdr("XY Conditioning Plot"))
	predictorFrame <- tkframe(top)
	predictorBox <- variableListBox(predictorFrame, Numeric(), title=gettextRcmdr("Explanatory variables (pick one or more)"), selectmode="multiple")
	responseBox <- variableListBox(predictorFrame, Numeric(), title=gettextRcmdr("Response variables (pick one or more)"), selectmode="multiple")
	cgFrame <- tkframe(top)
	conditionsBox <- variableListBox(cgFrame, Factors(), title=gettextRcmdr("Conditions '|' (pick zero or more)"), selectmode="multiple", initialSelection=FALSE)
	groupsBox <- variableListBox(cgFrame, Factors(), title=gettextRcmdr("Groups 'groups=' (pick zero or more)"), selectmode="multiple", initialSelection=FALSE)
	checkBoxes(frame="optionsFrame",
			boxes=c("auto.key", "outer"),
			initialValues=c(1,0),
			labels=gettextRcmdr(c("Automatically draw key", 
							"Different panels for different y~x combinations")))
	relationFrame <- tkframe(top)
	radioButtons(window=relationFrame,
			name="x.relation",
			buttons=c("same", "free", "sliced"),
			labels=gettextRcmdr(c("Identical", "Free", "Same range")),
			title=gettextRcmdr("X-Axis Scales in Different Panels"))
	radioButtons(window=relationFrame,
			name="y.relation",
			buttons=c("same", "free", "sliced"),
			labels=gettextRcmdr(c("Identical", "Free", "Same range")),
			title=gettextRcmdr("Y-Axis Scales in Different Panels"))
	
	scalarsFrame <- tkframe(top)
	
	layoutColumnsVar <- tclVar("")
	layoutColumnsEntry <- tkentry(scalarsFrame, width="6", textvariable=layoutColumnsVar)
	layoutRowsVar <- tclVar("")
	layoutRowsEntry <- tkentry(scalarsFrame, width="6", textvariable=layoutRowsVar)
	
	onOK <- function() {
		predictor <- getSelection(predictorBox)
		response <- getSelection(responseBox)
		conditions <- getSelection(conditionsBox)
		groups <- getSelection(groupsBox)
		closeDialog()
		if (0 == length(response)) {
			errorCondition(recall=Xyplot.HH, message=gettextRcmdr("At least one response variable must be selected."))
			return()
		}
		if (0 == length(predictor)) {
			errorCondition(recall=Xyplot.HH, message=gettextRcmdr("At least one explanatory variable must be selected."))
			return()
		}
		auto.key <- ("1" == tclvalue(auto.keyVariable))
		outer    <- ("1" == tclvalue(outerVariable))
		x.relation <- as.character(tclvalue(x.relationVariable))
		y.relation <- as.character(tclvalue(y.relationVariable))
		
		layoutColumns  <- as.numeric(tclvalue(layoutColumnsVar))
		layoutRows     <- as.numeric(tclvalue(layoutRowsVar))
		layout.command <- ""
		number.na <- is.na(layoutColumns) + is.na(layoutRows)
		
		if (number.na==1) {
			errorCondition(recall=Xyplot.HH,
					message=gettextRcmdr("Both or neither layout values must be numbers."))
			return()
		}
		if (number.na==0) layout.command <- deparse(c(layoutColumns, layoutRows))
		
		.activeDataSet <- ActiveDataSet()
		
		
		
		condtions.command <-
				if (length(conditions)==0) {
					if (outer) {
						if (layout.command=="")
							paste(", layout=c(",
									length(predictor),
									",",
									length(response),
									")")
						else
							paste(", layout=", layout.command, sep="")
					}
				}
				else {  ## (length(conditions)>0)
					if (outer) {
						condition.levels <- prod(sapply(conditions, d.f=get(.activeDataSet),
										function(g, d.f) length(levels(d.f[[g]]))))
						paste(", layout=c(",
								condition.levels,
								"*",
								length(predictor),
								",",
								length(response),
								")",
								## ", between=list(x=c(0,0, 1, 0,0), y=1)",
								", between=list(x=c(",
								paste(rep(c(rep(0, condition.levels-1), 1),
												length=condition.levels*length(predictor)-1),
										collapse=","),
								"), y=1)")
					}
				}
		
		groups.command <-
				if (length(groups)==1) paste(", groups=", groups, sep="")
				else ""
		
		xyplot.command <- paste("xyplot(",
				paste(response, collapse=' + '),
				" ~ ",
				paste(predictor, collapse=' + '),
				if (length(conditions) > 0)
							paste(" | ",
									paste(conditions, collapse=' + ')
							) else "",
				if (outer) ",\n outer=TRUE",
				condtions.command,
				groups.command,
				", pch=16",
				if (auto.key) ",\n auto.key=list(border=TRUE), par.settings = simpleTheme(pch=16)" else "",
				paste(", scales=list(x=list(relation='",
						x.relation,
						"'), y=list(relation='",
						y.relation,
						"'))", sep=""),
				",\n data=", .activeDataSet, ')', sep="")
		doItAndPrint(xyplot.command)
		activateMenus()
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="xyplot")
	tkgrid(getFrame(predictorBox), getFrame(responseBox),
			columnspan=1, sticky="w")
	tkgrid(predictorFrame, sticky="w")
	tkgrid(getFrame(conditionsBox),
			tklabel(cgFrame, text=gettextRcmdr("           ")),
			getFrame(groupsBox),
			columnspan=1, sticky="w")
	tkgrid(cgFrame, sticky="w")
	tkgrid(tklabel(top, text=gettextRcmdr("Options"), fg="blue"), sticky="w")
	tkgrid(optionsFrame, sticky="w")
	tkgrid(x.relationFrame, y.relationFrame, columnspan=2, sticky="w")
	tkgrid(relationFrame, sticky="w")
	tkgrid(tklabel(top, text=gettextRcmdr("Layout"), fg="blue"), sticky="w")
	tkgrid(tklabel(scalarsFrame, text=gettextRcmdr("number of columns:")), layoutColumnsEntry, sticky="w")
	tkgrid(tklabel(scalarsFrame, text=gettextRcmdr("number of rows:")), layoutRowsEntry, sticky="w")
	tkgrid(scalarsFrame, sticky="w")
	tkgrid(buttonsFrame, columnspan=2, sticky="w")
	dialogSuffix(rows=6, columns=2)
}


# set the colour palette

setPalette <- function() {
    cval <- function(x,y) -sum((x-y)^2)
    contrasting <- function(x)
        optim(rep(127, 3),cval,lower=0,upper=255,method="L-BFGS-B",y=x)$par
    # the following local function from Thomas Lumley via r-help
    convert <- function (color){
        rgb <- col2rgb(color)/255
        L <- c(0.2, 0.6, 0) %*% rgb
        ifelse(L >= 0.2, "#000060", "#FFFFA0")
        }
    env <- environment()
    pal <- palette()
    pickColor <- function(initialcolor, parent){
        tclvalue(.Tcl(paste("tk_chooseColor", .Tcl.args(title = "Select a Color",
            initialcolor=initialcolor, parent=parent))))
        }
    initializeDialog(title=gettextRcmdr("Set Color Palette"))
    hexcolor <- colorConverter(toXYZ = function(hex,...) {
        rgb <- t(col2rgb(hex))/255
        colorspaces$sRGB$toXYZ(rgb,...) },
        fromXYZ = function(xyz,...) {
            rgb <- colorspaces$sRGB$fromXYZ(xyz,..)
            rgb <- round(rgb,5)
            if (min(rgb) < 0 || max(rgb) > 1) as.character(NA)
            else rgb(rgb[1],rgb[2],rgb[3])},
            white = "D65", name = "#rrggbb")
    cols <- t(col2rgb(pal))
    hex <- convertColor(cols, from="sRGB", to=hexcolor, scale.in=255, scale.out=NULL)
    for (i in 1:8) assign(paste("hex", i, sep="."), hex[i], envir=env)
    paletteFrame <- tkframe(top)
    button1 <- tkbutton(paletteFrame, text=hex[1], bg = hex[1],
        fg=convert(hex[1]),
        command=function() {
            color <- pickColor(hex[1], parent=button1)
            fg <- convert(color)
            tkconfigure(button1, bg=color, fg=fg)
            assign("hex.1", color, envir=env)
            }
        )
    button2 <- tkbutton(paletteFrame, text=hex[2], bg = hex[2],
        fg=convert(hex[2]),
        command=function() {
            color <- pickColor(hex[2], parent=button2)
            fg <- convert(color)
            tkconfigure(button2, bg=color, fg=fg)
            assign("hex.2", color, envir=env)
            }
        )
     button3 <- tkbutton(paletteFrame, text=hex[3], bg = hex[3],
        fg=convert(hex[3]),
        command=function() {
            color <- pickColor(hex[3], parent=button3)
            fg <- convert(color)
            tkconfigure(button3, bg=color, fg=fg)
            assign("hex.3", color, envir=env)
            }
        )
     button4 <- tkbutton(paletteFrame, text=hex[4], bg = hex[4],
        fg=convert(hex[4]),
        command=function() {
            color <- pickColor(hex[4], parent=button4)
            fg <- convert(color)
            tkconfigure(button4, bg=color, fg=fg)
            assign("hex.4", color, envir=env)
            }
        )
     button5 <- tkbutton(paletteFrame, text=hex[5], bg = hex[5],
        fg=convert(hex[5]),
        command=function() {
            color <- pickColor(hex[5], parent=button5)
            fg <- convert(color)
            tkconfigure(button5, bg=color, fg=fg)
            assign("hex.5", color, envir=env)
            }
        )
     button6 <- tkbutton(paletteFrame, text=hex[6], bg = hex[6],
        fg=convert(hex[6]),
        command=function() {
            color <- pickColor(hex[6], parent=button6)
            fg <- convert(color)
            tkconfigure(button6, bg=color, fg=fg)
            assign("hex.6", color, envir=env)
            }
        )
     button7 <- tkbutton(paletteFrame, text=hex[7], bg = hex[7],
        fg=convert(hex[7]),
        command=function() {
            color <- pickColor(hex[7], parent=button7)
            fg <- convert(color)
            tkconfigure(button7, bg=color, fg=fg)
            assign("hex.7", color, envir=env)
            }
        )
     button8 <- tkbutton(paletteFrame, text=hex[8], bg = hex[8],
        fg=convert(hex[8]),
        command=function() {
            color <- pickColor(hex[8], parent=button8)
            fg <- convert(color)
            tkconfigure(button8, bg=color, fg=fg)
            assign("hex.8", color, envir=env)
            }
        )
     onOK <- function(){
        closeDialog(top)
        palette(c(hex.1, hex.2, hex.3, hex.4, hex.5, hex.6, hex.7, hex.8))
        Message(gettextRcmdr("Color palette reset.", type="note"))
        }
    OKCancelHelp(helpSubject="palette")
    tkgrid(button1, button2, button3, button4, button5, button6, button7, button8)
    tkgrid(paletteFrame)
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=2)
    }
	
	stripChart <- function(){
		initializeDialog(title=gettextRcmdr("Strip Chart"))
		groupBox <- variableListBox(top, Factors(), title=gettextRcmdr("Factors (pick zero or more)"), selectmode="multiple")
		responseBox <- variableListBox(top, Numeric(), title=gettextRcmdr("Response Variable (pick one)"))
		onOK <- function(){
			groups <- getSelection(groupBox)
			response <- getSelection(responseBox)
			closeDialog()
			if (0 == length(response)) {
				errorCondition(recall=stripChart, message=gettextRcmdr("No response variable selected."))
				return()
			}
			.activeDataSet <- ActiveDataSet()
			plotType <- tclvalue(plotTypeVariable)
			method <- paste(', method="', plotType, '"', sep="")
			if (length(groups) == 0) doItAndPrint(paste("stripchart(", .activeDataSet, "$", response,
								method, ', xlab="', response, '")', sep=""))
			else {
				groupNames <- paste(groups, collapse="*")
				doItAndPrint(paste('stripchart(', response, ' ~ ', groupNames,
								', vertical=TRUE', method, ', xlab="', groupNames, '", ylab="', response,
								'", data=', .activeDataSet, ')', sep=""))
			}
			activateMenus()
			tkfocus(CommanderWindow())
		}
		radioButtons(name="plotType", buttons=c("stack", "jitter"), labels=gettextRcmdr(c("Stack", "Jitter")), title=gettextRcmdr("Duplicate Values"))
		buttonsFrame <- tkframe(top)
		OKCancelHelp(helpSubject="stripchart")
		tkgrid(getFrame(groupBox), getFrame(responseBox), sticky="nw")
		tkgrid(plotTypeFrame, sticky="w")
		tkgrid(buttonsFrame, columnspan=2, sticky="w")
		dialogSuffix(rows=3, columns=2)
	}

#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/ismdi.R"
# this function by Uwe Ligges; used with permission

ismdi <- function(){
    return(mdi = as.logical(.C("ismodemdi", as.integer(0), PACKAGE = "Rcmdr")[[1]]))
}
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/model-menu.R"
# Model menu dialogs

# last modified 28 June 2010 by J. Fox

selectActiveModel <- function(){
    models <- listAllModels()
    .activeModel <- ActiveModel()
    if ((length(models) == 1) && !is.null(.activeModel)) {
        Message(message=gettextRcmdr("There is only one model in memory."),
                type="warning")
        tkfocus(CommanderWindow())
        return()
        }
    if (length(models) == 0){
        Message(message=gettextRcmdr("There are no models from which to choose."),
                type="error")
        tkfocus(CommanderWindow())
        return()
        }
    initializeDialog(title=gettextRcmdr("Select Model"))
    .activeDataSet <- ActiveDataSet()
    initial <- if (is.null(.activeModel)) NULL else which(.activeModel == models) - 1
    modelsBox <- variableListBox(top, models, title=gettextRcmdr("Models (pick one)"), 
        initialSelection=initial)
    onOK <- function(){
        model <- getSelection(modelsBox)
        closeDialog()
        if (length(model) == 0) {
            tkfocus(CommanderWindow())
            return()
            }
        dataSet <- as.character(get(model)$call$data)
#        dataSet <- eval(parse(text=paste("as.character(", model, "$call$data)")))
        if (length(dataSet) == 0){
            errorCondition(message=gettextRcmdr("There is no dataset associated with this model."))
            return()
            }
        dataSets <- listDataSets()
        if (!is.element(dataSet, dataSets)){
            errorCondition(message=sprintf(gettextRcmdr("The dataset associated with this model, %s, is not in memory."), dataSet))
            return()
            }
        if (is.null(.activeDataSet) || (dataSet != .activeDataSet)) activeDataSet(dataSet)
        activeModel(model)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp()
    nameFrame <- tkframe(top)
    tkgrid(labelRcmdr(nameFrame, fg="blue", text=gettextRcmdr("Current Model: ")), 
        labelRcmdr(nameFrame, text=tclvalue(getRcmdr("modelName"))), sticky="w")
    tkgrid(nameFrame, sticky="w", columnspan="2")
    tkgrid(getFrame(modelsBox), columnspan="2", sticky="w")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=3, columns=2)
    }

summarizeModel <- function(){
    .activeModel <- ActiveModel()
    if (is.null(.activeModel) || !checkMethod("summary", .activeModel)) return()
    doItAndPrint(paste("summary(", .activeModel, ", cor=FALSE)", sep=""))
    }

plotModel <- function(){
    .activeModel <- ActiveModel()
    if (is.null(.activeModel) || !checkMethod("plot", .activeModel)) return()
    command <- "oldpar <- par(oma=c(0,0,3,0), mfrow=c(2,2))"
    justDoIt(command)
    logger(command)
    doItAndPrint(paste("plot(", .activeModel, ")", sep=""))
    command <- "par(oldpar)"
    justDoIt(command)
    logger(command)
    }

CRPlots <- function(){
    Library("car")
    .activeModel <- ActiveModel()
    if (is.null(.activeModel) || !checkMethod("crPlot", .activeModel)) return()
    doItAndPrint(paste("crPlots(", .activeModel, ")", sep=""))
    activateMenus()
    }

	AVPlots <- function(){
		Library("car")
		.activeModel <- ActiveModel()
		if (is.null(.activeModel) || !checkMethod("avPlot", .activeModel)) return()
		response <- tclvalue(RcmdrTkmessageBox(
						message=paste(gettextRcmdr("Identify points with mouse?\n"),
							gettextRcmdr(if (MacOSXP()) "esc key to exit." else "right button to exit."), sep=""),
						icon="question", type="yesno", default="no"))
		idmethod <- if (response == "yes") ', id.method="identify"' else ""
		doItAndPrint(paste("avPlots(", .activeModel, idmethod, ")", sep=""))
		activateMenus()
	}

anovaTable <- function(){
    Library("car")
    .activeModel <- ActiveModel()
    if (is.null(.activeModel)) return()
	initializeDialog(title=gettextRcmdr("ANOVA Table"))
	radioButtons(name="type",
			buttons=c("I", "II", "III"),
			values=c("I", "II", "III"), initialValue="II",
			labels=gettextRcmdr(c('Sequential ("Type I")', 'Partial, obeying marginality ("Type II")', 'Partial, ignoring marginality ("Type III")')),
			title=gettextRcmdr("Type of Tests"))
	onOK <- function(){
		type <- as.character(tclvalue(typeVariable))
		closeDialog()
		if (is.glm <- glmP()){
			family <- eval(parse(text=paste(.activeModel, "$family$family", sep="")))
		}
		if (type == "I"){
			if (!checkMethod("anova", .activeModel)) {
				errorCondition(message=gettextRcmdr("There is no appropriate anova method for a model of this class."))
				return()
				}
			if (is.glm){
				test <- if (family %in% c("binomial", "poisson")) "Chisq"
					else "F"
				doItAndPrint(paste("anova(", .activeModel, ', test="',  test, '")', sep=""))
			}
			else doItAndPrint(paste("anova(", .activeModel, ")", sep=""))
			}
		else {
			if (!checkMethod("Anova", .activeModel)) {
				errorCondition(message=gettextRcmdr("There is no appropriate Anova method for a model of this class."))
				return()
				}
			if (is.glm){
				test <- if (family %in% c("binomial", "poisson")) "LR"
					else "F"
				doItAndPrint(paste("Anova(", .activeModel, ', type="', type, '", test="', test, '")', sep=""))
			}
			else doItAndPrint(paste("Anova(", .activeModel, ', type="', type, '")', sep=""))
			if (type == "III") Message(message=gettextRcmdr("Type III tests require careful attention to contrast coding."),
				type="warning")
			}
		}
	OKCancelHelp(helpSubject="Anova")
	tkgrid(typeFrame, sticky="w")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=2, columns=1)
    }

VIF <- function(){
    Library("car")
    .activeModel <- ActiveModel()
    if (is.null(.activeModel) || !checkMethod("vif", .activeModel)) return()
    doItAndPrint(paste("vif(", .activeModel, ")", sep=""))
    }
            
InfluencePlot <- function(){
	Library("car")
	.activeModel <- ActiveModel()
	if (is.null(.activeModel) || !checkMethod("influencePlot", .activeModel)) return()
	response <- tclvalue(RcmdrTkmessageBox(
					message=paste(gettextRcmdr("Identify points with mouse?\n"),
							gettextRcmdr(if (MacOSXP()) "esc key to exit." else "right button to exit."), sep=""),
					icon="question", type="yesno", default="no"))
	idmethod <- if (response == "yes") ', id.method="identify"' else ""
	doItAndPrint(paste("influencePlot(", .activeModel, idmethod, ")", sep=""))
}  
    
effectPlots <- function(){
    Library("effects")
    .activeModel <- ActiveModel()
    if (is.null(.activeModel) || !checkMethod("effect", .activeModel)) return()
    doItAndPrint('trellis.device(theme="col.whitebg")')
    command <- paste("plot(allEffects(", .activeModel, "), ask=FALSE)", sep="")
    justDoIt(command)
    logger(command)
    activateMenus()
    NULL
    }

addObservationStatistics <- function(){
    if (is.null(.activeModel)) return()
    addVariable <- function(name){
        variable <- paste(name, ".", .activeModel, sep="")
        if (is.element(variable, .variables)) {
            ans <- checkReplace(variable)
            if (tclvalue(ans) == "no") return()
            }
        command <- paste(name, "(", .activeModel, ")", sep="")
        justDoIt(paste(.activeDataSet, "$", variable, " <- ", command, sep=""))
        logger(paste(.activeDataSet, "$", variable, " <- ", command, sep=""))
        }
    if (getRcmdr("modelWithSubset")){
        Message(message=
            gettextRcmdr("Observation statistics not available\nfor a model fit to a subset of the data."),
            type="error")
        tkfocus(.commander)
        return()
        }
    initializeDialog(title=gettextRcmdr("Add Observation Statistics to Data"))
    .activeModel <- ActiveModel()
    .activeDataSet <- ActiveDataSet()
    .variables <- Variables()
    obsNumberExists <- is.element("obsNumber", .variables)
    activate <- c(  checkMethod("fitted", .activeModel, default=TRUE, reportError=FALSE),
                    checkMethod("residuals", .activeModel, default=TRUE, reportError=FALSE),
                    checkMethod("rstudent", .activeModel, reportError=FALSE),
                    checkMethod("hatvalues", .activeModel, reportError=FALSE),
                    checkMethod("cooks.distance", .activeModel, reportError=FALSE))
    checkBoxes(frame="selectFrame", boxes=c(c("fitted", "residuals", "rstudent", "hatvalues", "cookd")[activate],
        "obsNumbers"),
        initialValues=c(rep(1, sum(activate)), if(obsNumberExists) "0" else "1"),
        labels=c(gettextRcmdr(c("Fitted values", "Residuals", "Studentized residuals", "Hat-values", "Cook's distances"))[activate],
        gettextRcmdr("Observation indices")))
    onOK <- function(){
        closeDialog()
        if (activate[1] && tclvalue(fittedVariable) == 1) addVariable("fitted")
        if (activate[2] && tclvalue(residualsVariable) == 1) addVariable("residuals")
        if (activate[3] && tclvalue(rstudentVariable) == 1) addVariable("rstudent")
        if (activate[4] && tclvalue(hatvaluesVariable) == 1) addVariable("hatvalues")
        if (activate[5] && tclvalue(cookdVariable) == 1) addVariable("cooks.distance")
        if (tclvalue(obsNumbersVariable) == 1){
            proceed <- if (obsNumberExists) tclvalue(checkReplace("obsNumber")) else "yes"
            if (proceed == "yes") {
                command <- paste(.activeDataSet, "$obsNumber <- 1:nrow(", .activeDataSet, ")", sep="")
                justDoIt(command)
                logger(command)
                }
            }
        activeDataSet(.activeDataSet, flushModel=FALSE)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="influence.measures")
    tkgrid(selectFrame, sticky="w")  
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=5, columns=1)
    }

residualQQPlot <- function(){
    Library("car")
    .activeModel <- ActiveModel()
    if (is.null(.activeModel) || !checkMethod("qqPlot", .activeModel)) return()
    initializeDialog(title=gettextRcmdr("Residual Quantile-Comparison Plot"))
    selectFrame <- tkframe(top)
    simulateVar <- tclVar("1")
    identifyVar <- tclVar("0")
    simulateCheckBox <- tkcheckbutton(selectFrame, variable=simulateVar)
    identifyCheckBox <- tkcheckbutton(selectFrame, variable=identifyVar)
    onOK <- function(){
        closeDialog()
        simulate <- tclvalue(simulateVar) == 1
        if (tclvalue(identifyVar) == 1){
			identify <- ', id.method="identify"'
			RcmdrTkmessageBox(title="Identify Points",
					message=paste(gettextRcmdr("Use left mouse button to identify points,\n"),
						gettextRcmdr(if (MacOSXP()) "esc key to exit." else "right button to exit."), sep=""),
					icon="info", type="ok")
		}
		else identify <- ""
        command <- paste("qqPlot(", .activeModel, ", simulate=", simulate, identify,
            ")", sep="")
        doItAndPrint(command)
        activateMenus()
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="qq.plot.lm")
    tkgrid(labelRcmdr(selectFrame, text=gettextRcmdr("Simulated confidence envelope")), simulateCheckBox, sticky="w")
    tkgrid(labelRcmdr(selectFrame, text=gettextRcmdr("Identify points with mouse")), identifyCheckBox, sticky="w")
    tkgrid(selectFrame, sticky="w")  
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=2, columns=1)
    }

testLinearHypothesis <- function(){
    Library("car")
    .activeModel <- ActiveModel()
    if (is.null(.activeModel) || !checkMethod("linearHypothesis", .activeModel, default=TRUE)) return()
    env <- environment()
    initializeDialog(title=gettextRcmdr("Test Linear Hypothesis"))
    outerTableFrame <- tkframe(top)
    assign(".tableFrame", tkframe(outerTableFrame), envir=env)
    setUpTable <- function(...){
        tkdestroy(get(".tableFrame", envir=env))
        assign(".tableFrame", tkframe(outerTableFrame), envir=env)
        nrows <- as.numeric(tclvalue(rowsValue))
        col.names <- names(coef(get(.activeModel)))
#        col.names <- eval(parse(text=paste("names(coef(", .activeModel, "))")))
        col.names <- substring(paste(abbreviate(col.names, 12), "            "), 1, 12)
        make.col.names <- "labelRcmdr(.tableFrame, text='')"
        for (j in 1:ncols) {
            make.col.names <- paste(make.col.names, ", ", 
                "labelRcmdr(.tableFrame, text='", col.names[j], "')", sep="")
            }
        rhsText <- gettextRcmdr("Right-hand side")
        make.col.names <- paste(make.col.names, ", labelRcmdr(.tableFrame, text='          ')",
            ", labelRcmdr(.tableFrame, text='", rhsText, "')", sep="")
        eval(parse(text=paste("tkgrid(", make.col.names, ")", sep="")), envir=env)
        for (i in 1:nrows){   
            varname <- paste(".tab.", i, ".1", sep="") 
            rhs.name <- paste(".rhs.", i, sep="")
            assign(varname, tclVar("0") , envir=env)
            assign(rhs.name, tclVar("0"), envir=env)
            make.row <- paste("labelRcmdr(.tableFrame, text=", i, ")")
            make.row <- paste(make.row, ", ", "ttkentry(.tableFrame, width='5', textvariable=", 
                varname, ")", sep="")
            for (j in 2:ncols){
                varname <- paste(".tab.", i, ".", j, sep="")
                assign(varname, tclVar("0"), envir=env)
                make.row <- paste(make.row, ", ", "ttkentry(.tableFrame, width='5', textvariable=", 
                    varname, ")", sep="")
                }
            make.row <- paste(make.row, ", labelRcmdr(.tableFrame, text='     '),",
                "ttkentry(.tableFrame, width='5', textvariable=", rhs.name, ")", sep="")
            eval(parse(text=paste("tkgrid(", make.row, ")", sep="")), envir=env)
            }
        tkgrid(get(".tableFrame", envir=env), sticky="w")
        }
    ncols <- length(coef(get(.activeModel)))
#    ncols <- eval(parse(text=paste("length(coef(", .activeModel, "))")))
    rowsFrame <- tkframe(top)
    rowsValue <- tclVar("1")
    rowsSlider <- tkscale(rowsFrame, from=1, to=ncols, showvalue=FALSE, variable=rowsValue,
        resolution=1, orient="horizontal", command=setUpTable)
    rowsShow <- labelRcmdr(rowsFrame, textvariable=rowsValue, width=2, justify="right")
    onOK <- function(){
        nrows <- as.numeric(tclvalue(rowsValue))
        cell <- 0
        values <- rep(NA, nrows*ncols)
        rhs <- rep(NA, nrows)
        for (i in 1:nrows){
            rhs.name <- paste(".rhs.", i, sep="")
            rhs[i] <- as.numeric(eval(parse(text=paste("tclvalue(", rhs.name,")", sep=""))))
            for (j in 1:ncols){
                cell <- cell+1
                varname <- paste(".tab.", i, ".", j, sep="")
                values[cell] <- as.numeric(eval(parse(text=paste("tclvalue(", varname,")", sep=""))))
                }
            }
        values <- na.omit(values)
        closeDialog()
        if (length(values) != nrows*ncols){
            Message(message=sprintf(gettextRcmdr("Number of valid entries in hypothesis matrix(%d)\nnot equal to number of rows (%d) * number of columns (%d)."), 
                length(values), nrows, ncols), type="error")
            testLinearHypothesis()
            return()
            }
        if (qr(matrix(values, nrows, ncols, byrow=TRUE))$rank < nrows) {
            Message(message=gettextRcmdr("Hypothesis matrix is not of full row rank."),
                type="error")
            testLinearHypothesis()
            return()
            }            
        rhs <- na.omit(rhs)
        if (length(rhs) != nrows){
            errorCondition(recall=testLinearHypothesis, message=sprintf(gettextRcmdr("Number of valid entries in rhs vector (%d)\nis not equal to number of rows (%d)."), length(rhs), nrows))
            return()
            }
        command <- paste("matrix(c(", paste(values, collapse=","), "), ", nrows, ", ", ncols,
            ", byrow=TRUE)", sep="")
        assign(".Hypothesis", justDoIt(command), envir=.GlobalEnv)
        logger(paste(".Hypothesis <- ", command, sep=""))
        command <- paste("c(", paste(rhs, collapse=","), ")", sep="")
        assign(".RHS", justDoIt(command), envir=.GlobalEnv)
        logger(paste(".RHS <- ", command, sep=""))
        command <- paste("linearHypothesis(", .activeModel, ", .Hypothesis, rhs=.RHS)", sep="")
        doItAndPrint(command)
        justDoIt("remove(.Hypothesis, .RHS, envir=.GlobalEnv)") 
        logger("remove(.Hypothesis, .RHS)")                                              
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="linearHypothesis")
    tkgrid(labelRcmdr(rowsFrame, text=gettextRcmdr("Number of Rows:")), rowsSlider, rowsShow, sticky="w")
    tkgrid(rowsFrame, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Enter hypothesis matrix and right-hand side vector:"), fg="blue"), sticky="w")
    tkgrid(outerTableFrame, sticky="w")
    tkgrid(labelRcmdr(top, text=""))
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=4, columns=1)       
    } 

compareModels <- function(){
    models <- listAllModels()
    if (length(models) < 2){
        Message(message=gettextRcmdr("There are fewer than two models."),
                type="error")
        tkfocus(CommanderWindow())
        return()
        }
    initializeDialog(title=gettextRcmdr("Compare Models"))
    modelsBox1 <- variableListBox(top, models, title=gettextRcmdr("First model (pick one)"))
    modelsBox2 <- variableListBox(top, models, title=gettextRcmdr("Second model (pick one)"))
    onOK <- function(){
        model1 <- getSelection(modelsBox1)
        model2 <- getSelection(modelsBox2)
        closeDialog()
        if (length(model1) == 0 || length(model2) == 0) {
            errorCondition(recall=compareModels, message=gettextRcmdr("You must select two models."))
            return()
            }
        if (!checkMethod("anova", model1)) {
            return()
            }
        if (!class(get(model1, envir=.GlobalEnv))[1] == class(get(model2, envir=.GlobalEnv))[1]){
#        if (!eval(parse(text=paste("class(", model1, ")[1] == class(", model2, ")[1]",
#            sep="")), envir=.GlobalEnv)){
                Message(message=gettextRcmdr("Models are not of the same class."),
                    type="error")
                compareModels()
                return()
                }
		if (glmP()){
			family1 <- eval(parse(text=paste(model1, "$family$family", sep="")))
			family2 <- eval(parse(text=paste(model2, "$family$family", sep="")))
			if (family1 != family2){
				Message(message=gettextRcmdr("Models do not have the same family."),
					type="error")
				compareModels()
				return()
			}
			test <- if (family1 %in% c("binomial", "poisson")) "Chisq"
				else "F"
			doItAndPrint(paste("anova(", model1, ", ", model2, ', test="', test, '")', sep=""))
		}
        else doItAndPrint(paste("anova(", model1, ", ", model2, ")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="anova")
    tkgrid(getFrame(modelsBox1), getFrame(modelsBox2), sticky="nw")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=2, columns=2)
    }
    
BreuschPaganTest <- function(){
    if (is.null(.activeModel)) return()
    Library("lmtest")
	currentModel <- FALSE
    initializeDialog(title=gettextRcmdr("Breusch-Pagan Test"))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Score Test for Nonconstant Error Variance"), fg="blue"), sticky="w")
    optionsFrame <- tkframe(top)
    onOK <- function(){
        .activeModel <- ActiveModel()
        var <- tclvalue(varVariable)
        closeDialog()
        type <- if (var == "fitted") paste(", varformula = ~ fitted.values(",
                    .activeModel, ")", sep="") 
                else if (var == "predictors") ""
                else paste(", varformula = ~", tclvalue(rhsVariable), sep="")
        student <- if (tclvalue(studentVariable) == 1) "TRUE" else "FALSE"
        model.formula <- as.character(formula(get(.activeModel)))
#        model.formula <- as.character(eval(parse(text=paste("formula(", .activeModel, ")", sep=""))))
        model.formula <- paste(model.formula[2], "~", model.formula[3])
        command <- paste("bptest(", model.formula, type, ", studentize=", student,
            ", data=", ActiveDataSet(), ")", sep="")
        doItAndPrint(command)  
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="bptest")
    studentVariable <- tclVar("0")
    studentFrame <- tkframe(optionsFrame)
    studentCheckBox <- tkcheckbutton(studentFrame, variable=studentVariable)
    tkgrid(labelRcmdr(studentFrame, text=gettextRcmdr("Studentized test statistic"), justify="left"),
        studentCheckBox, sticky="w")
    tkgrid(studentFrame, sticky="w")
    radioButtons(optionsFrame, name="var", buttons=c("fitted", "predictors", "other"), 
        labels=gettextRcmdr(c("Fitted values", "Explanatory variables", "Other (specify)")), title=gettextRcmdr("Variance Formula"))
    tkgrid(varFrame, sticky="w")
    modelFormula(optionsFrame, hasLhs=FALSE)
    tkgrid(formulaFrame, sticky="w")
    tkgrid(outerOperatorsFrame)
    tkgrid(getFrame(xBox), sticky="w")
    tkgrid(optionsFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=4, columns=1)
    }

DurbinWatsonTest <- function(){
    if (is.null(.activeModel)) return()
    Library("lmtest")
    initializeDialog(title=gettextRcmdr("Durbin-Waton Test"))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Test for First-Order Error Autocorrelation"), fg="blue"), sticky="w")
    onOK <- function(){
        altHypothesis <- tclvalue(altHypothesisVariable)
        closeDialog()
        model.formula <- as.character(formula(get(ActiveModel())))
#        model.formula <- as.character(eval(parse(text=paste("formula(", ActiveModel(), ")", sep=""))))
        model.formula <- paste(model.formula[2], "~", model.formula[3])
        command <- paste("dwtest(", model.formula, ', alternative="', altHypothesis,
             '", data=', ActiveDataSet(), ')', sep="")
        doItAndPrint(command)  
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="dwtest")
    radioButtons(name="altHypothesis", buttons=c("greater", "notequal", "less"), values=c("greater", "two.sided", "less"),
        labels=c("rho >  0", "rho != 0", "rho <  0"), title=gettextRcmdr("Alternative Hypothesis"))
    tkgrid(altHypothesisFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=3, columns=1)
    }

RESETtest <- function(){
    if (is.null(.activeModel)) return()
    Library("lmtest")
    initializeDialog(title=gettextRcmdr("RESET Test"))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Test for Nonlinearity"), fg="blue"), sticky="w")
    onOK <- function(){
        type <- tclvalue(typeVariable)
        square <- tclvalue(squareVariable)
        cube <- tclvalue(cubeVariable)
        closeDialog()
        model.formula <- as.character(formula(get(ActiveModel())))
#        model.formula <- as.character(eval(parse(text=paste("formula(", ActiveModel(), ")", sep=""))))
        model.formula <- paste(model.formula[2], "~", model.formula[3])
        if (square == "0" && cube == "0"){
            errorCondition(recall=RESETtest, message=gettextRcmdr("No powers are checked."))
            return()
            }
        powers <- if (square == "1" && cube == "1") "2:3"
            else if (square == "1" && cube == "0") "2"
            else if (square == "0" && cube == "1") "3"
        command <- paste("resettest(", model.formula, ", power=", powers,
            ', type="', type, '", data=', ActiveDataSet(), ')', sep="")
        doItAndPrint(command)  
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="reset")
    optionsFrame <- tkframe(top)
    squareVariable <- tclVar("1")
    squareCheckBox <- tkcheckbutton(optionsFrame, variable=squareVariable)
    cubeVariable <- tclVar("1")
    cubeCheckBox <- tkcheckbutton(optionsFrame, variable=cubeVariable)
    typeVariable <- tclVar("regressor")
    radioButtons(optionsFrame, name="type", buttons=c("regressor", "fitted", "princomp"),
        labels=gettextRcmdr(c("Explanatory variables", "Fitted values", "First principal component")),
        title=gettextRcmdr("Type of Test")) 
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Powers to Include"), fg="blue"), sticky="w")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("2 (squares)")), squareCheckBox, sticky="w")
    tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("3 (cubes)   ")), cubeCheckBox, sticky="w")
    tkgrid(typeFrame, sticky="w")
    tkgrid(optionsFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=3, columns=1)
    }

OutlierTest <- function(){
    if (is.null(.activeModel)) return()
    Library("car")
    .activeModel <- ActiveModel()
    if (!checkMethod("outlierTest", .activeModel)) {
        errorCondition(gettextRcmdr("There is no appropriate outlierTest method for a model of this class."))
        return()
        }
    doItAndPrint(paste("outlierTest(", .activeModel, ")", sep=""))
    }
    
confidenceIntervals <- function(){
    if (is.null(.activeModel)) return()
    Library("MASS")
    initializeDialog(title=gettextRcmdr("Confidence Intervals"))
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Confidence Intervals for Individual Coefficients"), fg="blue"), sticky="w")
    onOK <- function(){
        level <- tclvalue(confidenceLevel)
        opts <- options(warn=-1)
        lev <- as.numeric(level)
        options(opts)
        closeDialog()
        if ((is.na(lev)) || (lev < 0) || (lev > 1)) {
            Message(gettextRcmdr("Confidence level must be a number between 0 and 1."))
            tkfocus(CommanderWindow())
            return()
            }
        command <- if (glm) paste("Confint(", .activeModel, ", level=", level,
            ', type="', tclvalue(typeVariable), '")', sep="")
            else paste("Confint(", .activeModel, ", level=", level, ")", sep="")
        doItAndPrint(command)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="Confint")
    confidenceFrame <- tkframe(top)
    confidenceLevel <- tclVar(".95")
    confidenceField <- ttkentry(confidenceFrame, width="6", textvariable=confidenceLevel)
    radioButtons(top, name="type", buttons=c("LR", "Wald"),
        labels=gettextRcmdr(c("Likelihood-ratio statistic", "Wald statistic")), title=gettextRcmdr("Test Based On"))
    tkgrid(labelRcmdr(confidenceFrame, text=gettextRcmdr("Confidence Level: ")), confidenceField, sticky="w")
    tkgrid(confidenceFrame, sticky="w")
    .activeModel <- ActiveModel()
    glm <- class(get(.activeModel))[1] == "glm"
#    glm <- eval(parse(text=paste("class(", .activeModel, ")")))[1] == "glm"
    if (glm) tkgrid(typeFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=3 + glm, columns=1)
    }
	
aic <- function(){
	.activeModel <- ActiveModel()
	if (is.null(.activeModel)) return()
	doItAndPrint(paste("AIC(", .activeModel, ")", sep=""))
	}
	
bic <- function(){
	.activeModel <- ActiveModel()
	if (is.null(.activeModel)) return()
	doItAndPrint(paste("AIC(", .activeModel, ", k = log(nobs(", .activeModel, "))) # BIC", sep=""))
}

stepwiseRegression <- function(){
	initializeDialog(title=gettextRcmdr("Stepwise Model Selection"))
	onOK <- function(){
		direction <- as.character(tclvalue(directionVariable))
		criterion <- as.character(tclvalue(criterionVariable))
		closeDialog()
		doItAndPrint(paste("stepwise(", ActiveModel(),
						", direction='", direction, "', criterion='", criterion,
						"')", sep=""))
		tkdestroy(top)
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="stepwise")
	radioButtons(top, name="direction", buttons=c("bf", "fb", "b", "f"), 
			values=c("backward/forward", "forward/backward", "backward", "forward"),
			labels=gettextRcmdr(c("backward/forward", "forward/backward", "backward", "forward")),
			title=gettextRcmdr("Direction"))
	radioButtons(top, name="criterion", buttons=c("bic", "aic"), 
			values=c("BIC", "AIC"),
			labels=gettextRcmdr(c("BIC", "AIC")),
			title=gettextRcmdr("Criterion"))
	tkgrid(directionFrame, criterionFrame, sticky="nw")
	tkgrid(buttonsFrame, columnspan=2, sticky="w")
	dialogSuffix(rows=2, columns=2)
}

subsetRegression <- function(){
	Library("leaps")
	initializeDialog(title=gettextRcmdr("Subset Model Selection"))
	onOK <- function(){
		formula <- paste(sub("^[ ]*", "", deparse(formula(get(ActiveModel())))), collapse="")
		criterion <- as.character(tclvalue(criterionVariable))
		nbest <- as.numeric(tclvalue(nbestValue))
		nvmax <- as.numeric(tclvalue(nvmaxValue))
		really.big <- if (nvmax > 50) "TRUE" else "FALSE"
		closeDialog()
		doItAndPrint(paste("plot(regsubsets(", formula, ", data=", ActiveDataSet(),
						", nbest=", nbest, ", nvmax=", nvmax, "), scale='", criterion,
						"')", sep=""))
		tkdestroy(top)
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="regsubsets")
	radioButtons(top, name="criterion", buttons=c("bic", "Cp", "adjr2", "r2"), 
			labels=gettextRcmdr(c("BIC", "Mallows Cp", "Adjusted R-sq.", "R-squared")),
			title=gettextRcmdr("Criterion for Model Plot"))
	nvar <- ncol(model.matrix(get(ActiveModel())))
	nbestValue <- tclVar("1")
	nvmaxValue <- tclVar(as.character(min(25, nvar)))
	slidersFrame <- tkframe(top)
	nbestSlider <- tkscale(slidersFrame, from=1, to=10, showvalue=TRUE, variable=nbestValue,
			resolution=1, orient="horizontal")
	nvmaxSlider <- tkscale(slidersFrame, from=1, to=nvar, 
			showvalue=TRUE, variable=nvmaxValue, resolution=1, orient="horizontal")
	tkgrid(tklabel(slidersFrame, text="     "),
		tklabel(slidersFrame, text=gettextRcmdr("Number of best models\nof each size:"), fg="blue"), 
			nbestSlider, sticky="w")
	tkgrid(tklabel(slidersFrame, text="     "),
		tklabel(slidersFrame, text=gettextRcmdr("Maximum size:"), fg="blue"),nvmaxSlider, sticky="e")
	tkgrid(criterionFrame, slidersFrame, sticky="nw")
	tkgrid(buttonsFrame, columnspan=2, sticky="w")
	dialogSuffix(rows=2, columns=2)
}
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/sciviews-specific.R"
# SciViews specific R Commander code

# Supplied by Ph. Grosjean
# last modified 18 August 2009 by J. Fox
#  small fix to call to list.files() by J. Fox 17 Jan 05
#  modifications 18 Feb 06 by J. Fox
#  small change 20 Mar 08 by J. Fox

is.SciViews <- function() {
    # SciViews defines the option "SciViews.version".
    # So, we test if we are in SciViews this way:
    res <- !is.null(getOption("SciViews.version"))
    res
    }
    
is.SciViews.TclTk <- function() {
    # Determine if a TclTk-communicating SciViews client is currently running
    res <- (!is.null(getOption("SciViews.TclTk")) && getOption("SciViews.TclTk") == TRUE)
    res
    }
    
tkfocus <- function(...){
    # A call to tcltk:::tkfocus() causes a GPF in SciViews
    # => replaced by this version that check if we are in SciViews or not
    if (!is.SciViews()) tcltk:::tkfocus(...)
    }

svCommander <- function(Version = "1.1-0"){
    # The SciViews specific Commander() function
    if (is.SciViews()) {
        # TO DO: automatically generate the menu from "Rcmdr-menus.txt"
        # Display the R commander menu
        #...
        setOption <- function(option, default, global=TRUE) {
            opt <- if (is.null(current[[option]])) default else current[[option]]
            if (global) putRcmdr(option, opt)
            else opt
            }
        etc <- file.path(.path.package(package="Rcmdr")[1], "etc")
        # Do NOT sink error messages!
        #assign(".messages.connection", textConnection(".messages", open = "w"), envir=.GlobalEnv)
        #sink(.messages.connection, type="message")
        messageTag(reset=TRUE)
		putRcmdr("RcmdrVersion", Version)
		#putRcmdr("length.messages", 0)
        putRcmdr(".activeDataSet", NULL)
        putRcmdr(".activeModel", NULL)
        putRcmdr("logFileName", NULL)
        putRcmdr("outputFileName", NULL)
        putRcmdr("saveFileName", NULL)
        putRcmdr("modelNumber", 0)
        putRcmdr("rgl", FALSE)
        current <- options("Rcmdr")[[1]]
        setOption("log.font.size", if (.Platform$OS.type == "windows") 10 else 12)
        putRcmdr("logFont", tkfont.create(family="courier", size=getRcmdr("log.font.size")))
#    	putRcmdr("operatorFont", tkfont.create(family="courier", size=getRcmdr("log.font.size")))
		scale.factor <- current$scale.factor
        if (!is.null(scale.factor)) .Tcl(paste("tk scaling ", scale.factor, sep=""))
        if (packageAvailable("car")) {
            require("car")
            setOption("contrasts", c("contr.Treatment", "contr.poly"))
            }
        else setOption("contrasts", c("contr.treatment", "contr.poly"))
        setOption("log.commands", TRUE)
        #assign("logCommands", if (log.commands) tclVar("1") else tclVar("0"))
        setOption("console.output", TRUE) # Must be set to TRUE for SciViews app!
        log.height <- as.character(setOption("log.height", if (!getRcmdr("log.commands")) 0 else 10, global=FALSE))
        log.width <- as.character(setOption("log.width", 80, global=FALSE))
    	output.height <- as.character(setOption("output.height",
        	if (getRcmdr("console.output")) 0
        	else if ((as.numeric(log.height) != 0) || (!getRcmdr("log.commands"))) 2*as.numeric(log.height)
        	else 20, global=FALSE))
        setOption("output.height", output.height)
        putRcmdr("saveOptions", options(warn=1, contrasts=getRcmdr("contrasts"), width=as.numeric(log.width),
            na.action="na.exclude", graphics.record=TRUE))
        setOption("double.click", FALSE)
        setOption("sort.names", TRUE)
        setOption("grab.focus", TRUE)
        setOption("attach.data.set", FALSE)
        setOption("log.text.color", "black")
        setOption("command.text.color", "red")
        setOption("output.text.color", "darkblue")
        setOption("error.text.color", "red")
        setOption("warning.text.color", "darkgreen")
        setOption("multiple.select.mode", "extended")
        setOption("suppress.X11.warnings", .Platform$GUI == "X11") # to address problem in Linux
        setOption("showData.threshold", 100)
    	setOption("retain.messages", FALSE)
        setOption("crisp.dialogs",  (.Platform$OS.type == "windows") && (getRversion() >= "2.1.1"))
		if (.Platform$OS.type != "windows") {
        	putRcmdr("oldPager", options(pager=RcmdrPager))
        	default.font.size <- as.character(setOption("default.font.size", 12, global=FALSE))
        	default.font <- setOption("default.font",
            	paste("*helvetica-medium-r-normal-*-", default.font.size, "*", sep=""), global=FALSE)
        	.Tcl(paste("option add *font ", default.font, sep=""))
        	}
    	#if (getRcmdr("crisp.dialogs")) tclServiceMode(on=FALSE)
    	#if (getRcmdr("suppress.X11.warnings")) {
        #	putRcmdr("messages.connection", textConnection(".messages", open = "w", local=FALSE))
        #	sink(getRcmdr("messages.connection"), type="message")
        #	putRcmdr("length.messages", 0)
        #	}
        putRcmdr("commanderWindow", NULL)
        .commander <- NULL
		placement <- setOption("placement", "-40+20", global=FALSE)
#        source.files <- list.files(etc, pattern="\\.R$")  # duplicate line commented out by J. Fox
#        .commander.done <<- tclVar("0")
   #     source.files <- list.files(etc, pattern="\\.[Rr]$")
   #     for (file in source.files) {
   #          source(file.path(etc, file))
   #          cat(paste("Sourced:", file, "\n"))
   #          }
   #     Menus <- read.table(file.path(etc, "Rcmdr-menus.txt"), as.is=TRUE)
	    # TO DO: we need another treatment for this!
        #for (m in 1:nrow(Menus)){
        #    if (Menus[m, 1] == "menu") assign(Menus[m, 2], tkmenu(eval(parse(text=Menus[m, 3])), tearoff=FALSE))
        #    else if (Menus[m, 1] == "item") {
        #         if (Menus[m, 3] == "command")
        #             tkadd(eval(parse(text=Menus[m, 2])),"command", label=Menus[m, 4], command=eval(parse(text=Menus[m, 5])))
        #         else if (Menus[m, 3] == "cascade")
        #             tkadd(eval(parse(text=Menus[m, 2])),"cascade", label=Menus[m, 4], menu=eval(parse(text=Menus[m, 5])))
        #         else stop(paste("menu defintion error:", Menus[m, ], collapse=" "))
        #         }
        #    else stop(paste("menu defintion error:", Menus[m, ], collapse=" "))
        #    }
        putRcmdr("Menus", list())
		exceptions <- scan(file.path(etc, "log-exceptions.txt"), what="", quiet=TRUE, comment.char="#")
        putRcmdr("modelClasses", scan(file.path(etc, "model-classes.txt"), what="", quiet=TRUE, comment.char="#"))
		putRcmdr("dataSetName", tclVar("<No active dataset>"))
		putRcmdr("dataSetLabel", NULL)
        putRcmdr("logWindow", NULL)
        putRcmdr("outputWindow", NULL)
		putRcmdr("messagesWindow", NULL)
		putRcmdr("modelName", tclVar("<No active model>"))
        putRcmdr("modelLabel", NULL)
		show.edit.button <- options("Rcmdr")[[1]]$show.edit.button
        show.edit.button <- if (is.null(show.edit.button)) TRUE else show.edit.button
        if (!packageAvailable("rgl")) Message(gettextRcmdr("The rgl package is absent; 3D plots are unavailable."), type="warning")
    	Message(paste(gettextRcmdr("R Commander Version "), getRcmdr("RcmdrVersion"), ": ", date(), sep=""))
		}
    }

svlogger <- function(command){
     # the SciViews specific logger() function
     if (is.SciViews()) {
         # Behaviour is different if it is a TclTk communicating client,
         # or a plug
         if (is.SciViews.TclTk()) { # TclTk SciViews client
             getTemp <- function(x, default = NULL, mode="any") {
                 if  (exists(x, envir = TempEnv(), mode = mode,
					inherits = FALSE)) {
                     return(get(x, envir = TempEnv(), mode = mode,
						inherits = FALSE))
                 } else { # Variable not found, return the default value
                     return(default)
                 }
             }
             if (getRcmdr("log.commands")) {
                 CmdFun <- getTemp(".guiCmd", mode = "function")
                 if (!is.null(CmdFun)) CmdFun(paste("<<<<Log\n", command))
             }
             lines <- strsplit(command, "\n")[[1]]
             for (line in lines) cat(paste("\n> Rcmdr >", line, "\n"))
             command
         } else {    # plug SciViews client
             lines <- strsplit(command, "\n")[[1]]
             for (line in lines) {
                 cat(paste("<<<<History", line, "<<<<\n>>>> ", line,
					"    #[R-cmdr]\n", sep=""))
                 if (getRcmdr("log.commands")) cat(paste("<<<<Script",
					command, "\n<<<<", sep=""))
                 }
             command
             }
         }
     }
    
svMessage <- function(message, type = c("note", "error", "warning")) {
	# the SciViews specific Message function
    if (sink.number() > 0) sink(type="output")   # Make sure output is not diverted!
	type <- match.arg(type)
    type <- type[1]
	if (type == "note") return()    # Currently we display nothing if it is a note!
	if (type != "note") tkbell()
    prefix <- switch(type, error="Rcmdr Error", warning="Rcmdr Warning", note="Rcmdr Note", "Rcmdr")
    if (missing(message)) return()
    message <- paste(prefix, ": ", message, sep="")
    lines <- strsplit(message, "\n")[[1]]
    for (line in lines) cat(line, "\n")
    return(NULL)
	}

activeDataSetEdit <- function() {
    # This is SciViews equivalent to onEdit function of Commander()
    if (activeDataSet() == FALSE)
        return()
    .activeDataSet <- ActiveDataSet()
    command <- paste("fix(", .activeDataSet, ")", sep="")
    justDoIt(command)
    svlogger(command)
    activeDataSet(.activeDataSet)
    invisible()
}

activeDataSetView <- function() {
    # This is SciViews equivalent to onView function of Commander()
    if (activeDataSet() == FALSE) {
        return()
        }
    view.height <- 30 #max(as.numeric(output.height) + as.numeric(log.height), 10)
    ncols <- eval(parse(text=paste("ncol(", ActiveDataSet(), ")")))
    command <- if (packageAvailable("relimp") && ncols <= getRcmdr("showData.threshold")){
        Library("relimp")
        paste("showData(", ActiveDataSet(), ", placement='-20+200', font=getRcmdr('logFont'), maxwidth=",
        80, ", maxheight=", view.height, ")", sep="")
        }
    else paste("invisible(edit(", ActiveDataSet(), "))", sep="")
    justDoIt(command)
    invisible(svlogger(command))
	}

optionLogCommand <- function() {
    # Change log option in SciViews
    response <- tclvalue(tkmessageBox(message="Log R-cmdr commands in a script?",
        icon="question", type="yesno", default="yes"))
    val <- if (response == "yes") TRUE else FALSE
    putRcmdr("log.commands", val)
    Opts <- options("Rcmdr")[[1]]
    Opts$log.commands <- val
    options(Rcmdr=Opts)
    refreshStatus()
}

optionAttachDataSet <- function() {
    # Change attach option in SciViews
    response <- tclvalue(tkmessageBox(message="Attach active data set?",
        icon="question", type="yesno", default="yes"))
    val <- if (response == "yes") TRUE else FALSE
    putRcmdr("attach.data.set", val)
    Opts <- options("Rcmdr")[[1]]
    Opts$attach.data.set <- val
    options(Rcmdr=Opts)
    refreshStatus()
}

optionSortVariables <- function() {
    # Change sort variable names option
    response <- tclvalue(tkmessageBox(message="Sort variable names alphabetically?",
        icon="question", type="yesno", default="yes"))
    val <- if (response == "yes") TRUE else FALSE
    putRcmdr("sort.names", val)
    Opts <- options("Rcmdr")[[1]]
    Opts$sort.names <- val
    options(Rcmdr=Opts)
    refreshStatus()
}

refreshStatus <- function() {
    # Refresh dataset and model indication in the status bar of SciViews Client
    DataSet <- ActiveDataSet()
    if (is.null(DataSet) || length(DataSet) == 0) DataSet <- "<no data>"
    Model <- ActiveModel()
    if (is.null(Model) || length(Model) == 0) Model <- "<no model>"
    if (getRcmdr("log.commands")) Opts <- " [log]" else Opts <- " "
    if (getRcmdr("attach.data.set")) Opts <- paste(Opts, "[attach]", sep="")
    if (getRcmdr("sort.names")) Opts <- paste(Opts, "[sort]", sep="")
    # If it is a "SciViews TclTk GUI" client, use it...
    if (is.SciViews.TclTk()) {
        cat(paste("Data: ", DataSet, ", Model: ", Model, Opts, sep=""), file = file.path(tempdir(), "svStatus.txt"))
        # getTemp from SciViews[svMisc] is redefined here to avoid a Depends: svMisc!
        getTemp <- function(x, default = NULL, mode="any") {
            if  (exists(x, envir = TempEnv(), mode = mode, inherits = FALSE)) {
                return(get(x, envir = TempEnv(), mode = mode, inherits = FALSE))
            } else { # Variable not found, return the default value
                return(default)
            }
        }
        CmdFun <- getTemp(".guiCmd", mode = "function")
        if (!is.null(CmdFun)) CmdFun("<<<<Status")
        # Possibly update data in the object browser
        if (exists(".guiObjCallback", envir = TempEnv(), inherits = FALSE)) getTemp(".guiObjCallback")()
    } else {    # This should be SciViews Insider, or other similar client
        cat("<<<<StatusTextData: ", DataSet, ", Model: ", Model, Opts, "<<<<", sep="")
    }
}

helpSciViews <- function() {
    if (as.numeric(R.Version()$major) >= 2) print(help("Rcmdr.sciviews-specific"))
    else help("Rcmdr.sciviews-specific")
    }
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/startup.R"
# last modified 22 September 2009 by J. Fox

.onAttach <- function(...){
    if(interactive()) Commander()
    else {
        message("The Commander GUI is launched only in interactive sessions",
            domain="R-Rcmdr")
        return()
        }
    packageStartupMessage(gettext("\nRcmdr Version", domain="R-Rcmdr"), " ",
        getRcmdr("RcmdrVersion"), "\n")
#	if (.Platform$GUI == "Rgui"  && ismdi()) packageStartupMessage(paste(gettextRcmdr("NOTE"), ": ",
#		gettextRcmdr(
#		"The Windows version of the R Commander works best under RGui with the single-document interface (SDI)\nSee ?Commander"),
#		sep=""))
    }

.onLoad <- function(...){
    packagesAvailable <- function(packages){
        sapply(sapply(packages, .find.package, quiet=TRUE),
            function(x) length(x) != 0)
        }
    if (!interactive()) return()
    save.options <- options(warn=-1)
    on.exit(options(save.options))
    tcltk <- require(tcltk)
    if (!tcltk) stop(gettext("The tcltk package is absent. The R Commander cannot function.", domain="R-Rcmdr"))
    required.packages <- rev(c("abind", "aplpack", "car", "colorspace", 
		"effects", "foreign", "grid", "Hmisc", "lattice", "leaps", "lmtest",
        "MASS", "mgcv", "multcomp", "nlme", "nnet", "relimp", "rgl"))
    if (.Platform$OS.type == "windows") required.packages <- c(required.packages, "RODBC")
    packages.to.load <- options("Rcmdr")[[1]]$load.at.startup
    if (is.null(packages.to.load)) packages.to.load <- "car"
    for (package in packages.to.load){
        if (length(.find.package(package, quiet=TRUE)) != 0)
            require(package, character.only=TRUE)
        }
    check <- options("Rcmdr")[[1]]$check.packages
    if (length(check) > 0 && !check) return()
    packages.to.check <- union(required.packages, packages.to.load)
    available.packages <- packagesAvailable(packages.to.check)
    missing.packages <- packages.to.check[!available.packages]
    if (any(!available.packages)) {
        response <- tkmessageBox(message=paste(gettext("The following packages used by Rcmdr are missing:\n", domain="R-Rcmdr"),
                            paste(missing.packages, collapse=", "),
                            gettext("\nWithout these packages, some features will not be available.", domain="R-Rcmdr"),
                            gettext("\nInstall these packages?", domain="R-Rcmdr")),
                        icon="error", type="yesno")
        if (tclvalue(response) == "yes") {
            top <- tktoplevel(borderwidth=10)
            tkwm.title(top, gettext("Install Missing Packages", domain="R-Rcmdr"))
            locationFrame <- tkframe(top)
            locationVariable <- tclVar("CRAN")
            CRANbutton <- ttkradiobutton(locationFrame, variable=locationVariable, value="CRAN")
#         Note: Bioconductor code not currently necessary
#            BioconductorButton <- ttkradiobutton(locationFrame, variable=locationVariable, value="Bioconductor")
            localButton <- ttkradiobutton(locationFrame, variable=locationVariable, value="local")
            directoryVariable <- tclVar("")
            directoryFrame <- tkframe(locationFrame)
            onBrowse <- function(){
                tclvalue(directoryVariable) <- tclvalue(tkchooseDirectory())
                }
            browseButton <- buttonRcmdr(directoryFrame, text=gettext("Browse...", domain="R-Rcmdr"), width="12", command=onBrowse, borderwidth=3)
            locationField <- ttkentry(directoryFrame, width="20", textvariable=directoryVariable)
            locationScroll <- ttkscrollbar(directoryFrame, orient="horizontal",
                command=function(...) tkxview(locationField, ...))
            tkconfigure(locationField, xscrollcommand=function(...) tkset(locationScroll, ...))
            tkgrid(labelRcmdr(top, text=gettext("Install Packages From:", domain="R-Rcmdr"), fg="blue"), sticky="nw")
            tkgrid(labelRcmdr(directoryFrame, text=gettext("Specify package  \ndirectory:", domain="R-Rcmdr"), justify="left"),
                locationField, sticky="w")
            tkgrid(browseButton, locationScroll, sticky="w")
            tkgrid(locationScroll, sticky="ew")
            tkgrid(labelRcmdr(locationFrame, text="CRAN"), CRANbutton, sticky="w")
#            tkgrid(labelRcmdr(locationFrame, text="Bioconductor"), BioconductorButton, sticky="w")
            tkgrid(labelRcmdr(locationFrame, text=gettext("Local package directory\n(must include PACKAGES index file)", domain="R-Rcmdr"),
                justify="left"), localButton, directoryFrame, sticky="nw")
            tkgrid(locationFrame, sticky="w")
            tkgrid(labelRcmdr(top, text=""))
            onOK <- function(){
                errorMessage <- function() tkmessageBox(message=paste(
                    gettext("The following packages were not found at the specified location:\n", domain="R-Rcmdr"),
                    paste(missing.packages[!present], collapse=", ")),  icon="warning", type="ok")
                tkgrab.release(top)
                tkdestroy(top)
                location <- tclvalue(locationVariable)
                if (location == "CRAN") {
                    packages <- utils:::CRAN.packages()[,1]
                    present <- missing.packages %in% packages
                    if (!all(present)) errorMessage()
                    if (!any(present)) return()
                    utils:::install.packages(missing.packages[present], dependencies=TRUE, lib=.libPaths()[1])
                    }
#                else if (location == "Bioconductor") {
#                    packages <- CRAN.packages(CRAN=getOption("BIOC"))[,1]
#                    present <- missing.packages %in% packages
#                    if (!all(present)) errorMessage()
#                    install.packages(missing.packages[present], lib=.libPaths()[1],
#                        CRAN=getOption("BIOC"))
#                    }
                else {
                    directory <- paste("file:", tclvalue(directoryVariable), sep="")
                    packages <- utils:::CRAN.packages(contriburl=directory)[,1]
                    present <- missing.packages %in% packages
                    if (!all(present)) errorMessage()
                    if (!any(present)) return()
                    utils:::install.packages(missing.packages[present], contriburl=directory,
                        dependencies=TRUE, lib=.libPaths()[1])
                    }
                }
            onCancel <- function(){
                tkgrab.release(top)
                tkdestroy(top)
                return()
                }
            onHelp <- function() help("install.packages")
            buttonsFrame <- tkframe(top)
            OKbutton <- buttonRcmdr(buttonsFrame, text="OK", foreground="darkgreen", width="12", command=onOK, default="active",
                    borderwidth=3)
            cancelButton <- buttonRcmdr(buttonsFrame, text=gettext("Cancel", domain="R-Rcmdr"), foreground="red", width="12", command=onCancel,
                    borderwidth=3)
            helpButton <- buttonRcmdr(buttonsFrame, text=gettext("Help", domain="R-Rcmdr"), width="12", command=onHelp, borderwidth=3)
            tkgrid(OKbutton, labelRcmdr(buttonsFrame, text="  "), cancelButton,
                   labelRcmdr(buttonsFrame, text="            "),
                helpButton, sticky="w")
            tkgrid(buttonsFrame, sticky="w")
            for (row in 0:2) tkgrid.rowconfigure(top, row, weight=0)
            tkgrid.columnconfigure(top, 0, weight=0)
            .Tcl("update idletasks")
            tkwm.resizable(top, 0, 0)
            tkbind(top, "<Return>", onOK)
            tkwm.deiconify(top)
            tkgrab.set(top)
            tkfocus(top)
            tkwait.window(top)
            }
        }
    }
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/statistics-dimensional-menu.R"
# Statistics Menu dialogs

# last modified 7 June 2009 by J. Fox

    # Dimensional-analysis menu
    
Reliability <- function(){
    initializeDialog(title=gettextRcmdr("Scale Reliability"))
    xBox <- variableListBox(top, Numeric(), selectmode="multiple", title=gettextRcmdr("Variables (pick three or more)"))
    onOK <- function(){
        x <- getSelection(xBox)
        closeDialog()
        if (3 > length(x)) {
            errorCondition(recall=Reliability, message=gettextRcmdr("Fewer than 3 variables selected."))
            return()
            }
        x <- paste('"', x, '"', sep="")
        doItAndPrint(paste("reliability(cov(", ActiveDataSet(), "[,c(", paste(x, collapse=","),
            ')], use="complete.obs"))', sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="reliability")
    tkgrid(getFrame(xBox), sticky="nw")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=2, columns=1)
    }

principalComponents <- function(){
    initializeDialog(title=gettextRcmdr("Principal Components Analysis"))
    xBox <- variableListBox(top, Numeric(), selectmode="multiple", title=gettextRcmdr("Variables (pick two or more)"))
    subsetBox()
    checkBoxes(frame="optionsFrame", boxes=c("correlations", "screeplot", "addPC"), initialValues=c("1", "0", "0"),
        labels=gettextRcmdr(c("Analyze correlation matrix", "Screeplot", "Add principal components to data set")))
    onOK <- function(){
        putRcmdr("ncomponents", 0)
        x <- getSelection(xBox)
        nvar <- length(x)
        correlations <- tclvalue(correlationsVariable)
        subset <- tclvalue(subsetVariable)
        screeplot <- tclvalue(screeplotVariable)
        addPC <- tclvalue(addPCVariable)
        closeDialog()
        if (2 > length(x)) {
            errorCondition(recall=principalComponents, message=gettextRcmdr("Fewer than 2 variables selected."))
            return()
            }
        subset <- if (trim.blanks(subset) == gettextRcmdr("<all valid cases>")) "" else paste(", subset=", subset, sep="")
        correlations <- if (correlations == "1") "TRUE" else "FALSE"
        .activeDataSet <- ActiveDataSet()
        command <- paste("princomp(~", paste(x, collapse="+"), ", cor=", correlations,
            ", data=", .activeDataSet, subset, ")", sep="")
        assign(".PC", justDoIt(command), envir=.GlobalEnv)
        logger(paste(".PC <- ", command, sep=""))
        doItAndPrint("unclass(loadings(.PC))  # component loadings")
        doItAndPrint(".PC$sd^2  # component variances")
		doItAndPrint("summary(.PC) # proportions of variance")
        if (screeplot == "1") {
            justDoIt("screeplot(.PC)")
            logger("screeplot(.PC)")
            }
        if (addPC == "1") {
            initializeDialog(subdialog, title=gettextRcmdr("Number of Components"))
            tkgrid(labelRcmdr(subdialog, text=gettextRcmdr("Number of components to retain:"), fg="blue"), sticky="w")    
            sliderFrame <- tkframe(subdialog)
            sliderValue <- tclVar("1")
            componentsSlider <- tkscale(sliderFrame, from=1, to=nvar, showvalue=FALSE, variable=sliderValue,
                resolution=1, orient="horizontal")
            componentsShow <- labelRcmdr(sliderFrame, textvariable=sliderValue, width=2, justify="right")
            onOKsub <- function() {
                closeDialog(subdialog)
                putRcmdr("ncomponents", as.numeric(tclvalue(sliderValue)))
                    }
            subOKCancelHelp()
            tkgrid(componentsSlider, componentsShow, sticky="nw")
            tkgrid(sliderFrame, sticky="w")
            tkgrid(subButtonsFrame, sticky="w")
            dialogSuffix(subdialog, onOK=onOKsub, rows=2, columns=1, focus=subdialog)
            if ((ncomponents <- getRcmdr("ncomponents")) > 0){
                for(i in 1:ncomponents){
                    var <- paste("PC", i, sep="")
                    if (is.element(var, Variables())) {
                        if ("no" == tclvalue(checkReplace(var))) next
                        }
                    justDoIt(paste(.activeDataSet, "$PC", i, " <- .PC$scores[,", i, "]", sep=""))
                    logger(paste(.activeDataSet, "$PC", i, " <- .PC$scores[,", i, "]", sep=""))
                    }
                activeDataSet(.activeDataSet)
                }
            }
        remove(.PC, envir=.GlobalEnv)   
        logger("remove(.PC)")
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="princomp")
    tkgrid(getFrame(xBox), sticky="nw")
    tkgrid(subsetFrame, sticky="w")
    tkgrid(optionsFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=4, columns=1)
    }

factorAnalysis <- function(){
    initializeDialog(title=gettextRcmdr("Factor Analysis"))
    xBox <- variableListBox(top, Numeric(), selectmode="multiple", title=gettextRcmdr("Variables (pick three or more)"))
    subsetBox()
    optionsFrame <- tkframe(top)
    checkFrame <- tkframe(top)
    radioButtons(checkFrame, name="rotation", buttons=c("noRotate", "varimax", "promax"), 
        values=c("none", "varimax", "promax"), initialValue="varimax", labels=gettextRcmdr(c("None", "Varimax", "Promax")),
        title=gettextRcmdr("Factor Rotation"))
    radioButtons(checkFrame, name="scores", buttons=c("noScores", "bartlett", "regression"),
        values=c("none", "Bartlett", "regression"), labels=gettextRcmdr(c("None", "Bartlett's method", "Regression method")),
        title=gettextRcmdr("Factor Scores"))
    onOK <- function(){
        x <- getSelection(xBox)
        nvar <- length(x)
        subset <- tclvalue(subsetVariable)
        rotation <- tclvalue(rotationVariable)
        scores <- tclvalue(scoresVariable)
        closeDialog()
        if (3 > length(x)) {
            errorCondition(recall=factorAnalysis, message=gettextRcmdr("Fewer than 3 variables selected."))
            return()
            }
        f <- function(k, p) ((p - k)^2 - p - k)^2
        max.factors <- floor(optimize(f, c(0, nvar), tol=.0001, p=nvar)$minimum)
        initializeDialog(subdialog, title=gettextRcmdr("Number of Factors"))
        tkgrid(labelRcmdr(subdialog, text=gettextRcmdr("Number of factors to extract:"), fg="blue"), sticky="w")    
        sliderFrame <- tkframe(subdialog)
        sliderValue <- tclVar("1")
        componentsSlider <- tkscale(sliderFrame, from=1, to=max.factors, showvalue=FALSE, variable=sliderValue,
            resolution=1, orient="horizontal")
        componentsShow <- labelRcmdr(sliderFrame, textvariable=sliderValue, width=2, justify="right")
        onOKsub <- function() {
            closeDialog(subdialog)
            putRcmdr("nfactors", as.numeric(tclvalue(sliderValue)))
                }
        subOKCancelHelp()
        tkgrid(componentsSlider, componentsShow, sticky="nw")
        tkgrid(sliderFrame, sticky="w")
        tkgrid(subButtonsFrame, sticky="w")
        dialogSuffix(subdialog, onOK=onOKsub, rows=2, columns=1, focus=subdialog)
        subset <- if (trim.blanks(subset) == gettextRcmdr("<all valid cases>")) "" else paste(", subset=", subset, sep="")
        .activeDataSet <- ActiveDataSet()
        command <- paste("factanal(~", paste(x, collapse="+"), ", factors=", getRcmdr("nfactors"), ', rotation="', rotation,
            '", scores="', scores, '", data=', .activeDataSet, subset, ")", sep="")
        assign(".FA", justDoIt(command), envir=.GlobalEnv)
        logger(paste(".FA <- ", command, sep=""))
        doItAndPrint(".FA")
        if (scores != "none") {
            for(i in 1:getRcmdr("nfactors")){
                var <- paste("F", i, sep="")
                if (is.element(var, Variables())) {
                    if ("no" == tclvalue(checkReplace(var))) next
                    }
                justDoIt(paste(.activeDataSet, "$F", i, " <- .FA$scores[,", i, "]", sep=""))
                logger(paste(.activeDataSet, "$F", i, " <- .FA$scores[,", i, "]", sep=""))
                }
            activeDataSet(.activeDataSet)
            }
        logger("remove(.FA)")
        remove(.FA, envir=.GlobalEnv)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="factanal")
    tkgrid(getFrame(xBox), sticky="nw")
    tkgrid(subsetFrame, sticky="w")
    tkgrid(optionsFrame, sticky="w")
    tkgrid(rotationFrame, labelRcmdr(checkFrame, text="    "), scoresFrame, sticky="w")
    tkgrid(checkFrame, sticky="w")
    tkgrid(buttonsFrame,  sticky="w")
    dialogSuffix(rows=5, columns=1)
    }
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/statistics-means-menu.R"
# Statistics Menu dialogs

# last modified 20 November 2010 by J. Fox

    # Means menu

independentSamplesTTest <- function(){
    initializeDialog(title=gettextRcmdr("Independent Samples t-Test"))
    variablesFrame <- tkframe(top)
    groupBox <- variableListBox(variablesFrame, TwoLevelFactors(), title=gettextRcmdr("Groups (pick one)"))
    responseBox <- variableListBox(variablesFrame, Numeric(), title=gettextRcmdr("Response Variable (pick one)"))
    onOK <- function(){
        group <- getSelection(groupBox)
        if (length(group) == 0) {
            errorCondition(recall=independentSamplesTTest, message=gettextRcmdr("You must select a groups variable."))
            return()
            }
        response <- getSelection(responseBox)
        if (length(response) == 0) {
            errorCondition(recall=independentSamplesTTest, message=gettextRcmdr("You must select a response variable."))
            return()
            }
        alternative <- as.character(tclvalue(alternativeVariable))
        level <- tclvalue(confidenceLevel)
        variances <- as.character(tclvalue(variancesVariable))
        closeDialog()
        doItAndPrint(paste("t.test(", response, "~", group,
            ", alternative='", alternative, "', conf.level=", level,
            ", var.equal=", variances,
            ", data=", ActiveDataSet(), ")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="t.test")
    optionsFrame <- tkframe(top)
    radioButtons(optionsFrame, name="alternative", buttons=c("twosided", "less", "greater"), values=c("two.sided", "less", "greater"),
        labels=gettextRcmdr(c("Two-sided", "Difference < 0", "Difference > 0")), title=gettextRcmdr("Alternative Hypothesis"))
    confidenceFrame <- tkframe(optionsFrame)
    confidenceLevel <- tclVar(".95")
    confidenceField <- ttkentry(confidenceFrame, width="6", textvariable=confidenceLevel)
    radioButtons(optionsFrame, name="variances", buttons=c("yes", "no"), values=c("TRUE", "FALSE"), initialValue="FALSE",
        labels=gettextRcmdr(c("Yes", "No")), title=gettextRcmdr("Assume equal variances?"))
    tkgrid(getFrame(groupBox), labelRcmdr(variablesFrame, text="    "), getFrame(responseBox), sticky="nw")
    tkgrid(variablesFrame, sticky="nw")
    tkgrid(labelRcmdr(confidenceFrame, text=gettextRcmdr("Confidence Level"), fg="blue"),sticky="w")
    tkgrid(confidenceField, sticky="w")
    groupsLabel(groupsBox=groupBox)
    tkgrid(alternativeFrame, labelRcmdr(optionsFrame, text="    "), confidenceFrame, labelRcmdr(optionsFrame, text="    "),
        variancesFrame, sticky="nw")
    tkgrid(optionsFrame, sticky="nw")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=4, columns=1)
    }

pairedTTest <- function(){
    initializeDialog(title=gettextRcmdr("Paired t-Test"))
    .numeric <- Numeric()
    xBox <- variableListBox(top, .numeric, title=gettextRcmdr("First variable (pick one)"))
    yBox <- variableListBox(top, .numeric, title=gettextRcmdr("Second variable (pick one)"))
    onOK <- function(){
        x <- getSelection(xBox)
        y <- getSelection(yBox)
        if (length(x) == 0 | length(y) == 0){
            errorCondition(recall=pairedTTest, message=gettextRcmdr("You must select two variables."))
            return()
            }
        if (x == y){
            errorCondition(recall=pairedTTest, message=gettextRcmdr("Variables must be different."))
            return()
            }
        alternative <- as.character(tclvalue(alternativeVariable))
        level <- tclvalue(confidenceLevel)
        closeDialog()
        .activeDataSet <- ActiveDataSet()
        doItAndPrint(paste("t.test(", .activeDataSet, "$", x, ", ",
            .activeDataSet, "$", y,
            ", alternative='", alternative, "', conf.level=", level,
            ", paired=TRUE)", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="t.test")
    radioButtons(top, name="alternative", buttons=c("twosided", "less", "greater"), values=c("two.sided", "less", "greater"),
        labels=gettextRcmdr(c("Two-sided", "Difference < 0", "Difference > 0")), title=gettextRcmdr("Alternative Hypothesis"))
    confidenceFrame <- tkframe(top)
    confidenceLevel <- tclVar(".95")
    confidenceField <- ttkentry(confidenceFrame, width="6", textvariable=confidenceLevel)
    tkgrid(getFrame(xBox), getFrame(yBox), sticky="nw")
    tkgrid(labelRcmdr(confidenceFrame, text=gettextRcmdr("Confidence Level"), fg="blue"))
    tkgrid(confidenceField, sticky="w")
    tkgrid(alternativeFrame, confidenceFrame, sticky="nw")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=3, columns=2)
    }

singleSampleTTest <- function(){
    initializeDialog(title=gettextRcmdr("Single-Sample t-Test"))
    xBox <- variableListBox(top, Numeric(), title=gettextRcmdr("Variable (pick one)"))
    onOK <- function(){
        x <- getSelection(xBox)
        if (length(x) == 0){
            errorCondition(recall=singleSampleTTest, message=gettextRcmdr("You must select a variable."))
            return()
            }
        alternative <- as.character(tclvalue(alternativeVariable))
        level <- tclvalue(confidenceLevel)
        mu <- tclvalue(muVariable)
        closeDialog()
        doItAndPrint(paste("t.test(", ActiveDataSet(), "$", x,
            ", alternative='", alternative, "', mu=", mu, ", conf.level=", level,
            ")", sep=""))
        tkdestroy(top)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="t.test")
    radioButtons(top, name="alternative", buttons=c("twosided", "less", "greater"), values=c("two.sided", "less", "greater"),
        labels=gettextRcmdr(c("Population mean != mu0", "Population mean < mu0", "Population mean > mu0")),
        title=gettextRcmdr("Alternative Hypothesis"))
    rightFrame <- tkframe(top)
    confidenceFrame <- tkframe(rightFrame)
    confidenceLevel <- tclVar(".95")
    confidenceField <- ttkentry(confidenceFrame, width="6", textvariable=confidenceLevel)
    muFrame <- tkframe(rightFrame)
    muVariable <- tclVar("0.0")
    muField <- ttkentry(muFrame, width="8", textvariable=muVariable)
    tkgrid(getFrame(xBox), sticky="nw")
    tkgrid(labelRcmdr(rightFrame, text=""), sticky="w")
    tkgrid(labelRcmdr(muFrame, text=gettextRcmdr("Null hypothesis: mu = ")), muField, sticky="w")
    tkgrid(muFrame, sticky="w")
    tkgrid(labelRcmdr(confidenceFrame, text=gettextRcmdr("Confidence Level: ")), confidenceField, sticky="w")
    tkgrid(confidenceFrame, sticky="w")
    tkgrid(alternativeFrame, rightFrame, sticky="nw")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(confidenceField, sticky="e")
    dialogSuffix(rows=4, columns=2)
    }

	oneWayAnova <- function(){
		Library("multcomp")
		Library("abind")
		initializeDialog(title=gettextRcmdr("One-Way Analysis of Variance"))
		UpdateModelNumber()
		modelName <- tclVar(paste("AnovaModel.", getRcmdr("modelNumber"), sep=""))
		modelFrame <- tkframe(top)
		model <- ttkentry(modelFrame, width="20", textvariable=modelName)
		groupBox <- variableListBox(top, Factors(), title=gettextRcmdr("Groups (pick one)"))
		responseBox <- variableListBox(top, Numeric(), title=gettextRcmdr("Response Variable (pick one)"))
		optionsFrame <- tkframe(top)
		pairwiseVariable <- tclVar("0")
		pairwiseCheckBox <- tkcheckbutton(optionsFrame, variable=pairwiseVariable)
		onOK <- function(){
			modelValue <- trim.blanks(tclvalue(modelName))
			if (!is.valid.name(modelValue)){
				UpdateModelNumber(-1)
				errorCondition(recall=oneWayAnova, message=sprintf(gettextRcmdr('"%s" is not a valid name.'), modelValue))
				return()
			}
			if (is.element(modelValue, listAOVModels())) {
				if ("no" == tclvalue(checkReplace(modelValue, type=gettextRcmdr("Model")))){
					UpdateModelNumber(-1)
					tkdestroy(top)
					oneWayAnova()
					return()
				}
			}
			group <- getSelection(groupBox)
			response <- getSelection(responseBox)
			closeDialog()
			if (length(group) == 0){
				errorCondition(recall=oneWayAnova, message=gettextRcmdr("You must select a groups factor."))
				return()
			}
			if (length(response) == 0){
				errorCondition(recall=oneWayAnova, message=gettextRcmdr("You must select a response variable."))
				return()
			}
			.activeDataSet <- ActiveDataSet()
			command <- paste(modelValue, " <- aov(", response, " ~ ", group, ", data=", .activeDataSet, ")", sep="")
			justDoIt(command)
			logger(command)
			doItAndPrint(paste("summary(", modelValue, ")", sep=""))
			doItAndPrint(paste("numSummary(", .activeDataSet, "$", response, " , groups=", .activeDataSet, "$", group,
					', statistics=c("mean", "sd"))', sep=""))
			activeModel(modelValue)
			pairwise <- tclvalue(pairwiseVariable)
			if (pairwise == 1) {
				if (eval(parse(text=paste("length(levels(", .activeDataSet, "$", group, ")) < 3"))))
					Message(message=gettextRcmdr("Factor has fewer than 3 levels; pairwise comparisons omitted."),
						type="warning")
				# the following lines modified by Richard Heiberger and subsequently by J. Fox
				else {
					command <- paste(".Pairs <- glht(", modelValue, ", linfct = mcp(", group, ' = "Tukey"))', sep="")
					justDoIt(command)
					logger(command)
					doItAndPrint("summary(.Pairs) # pairwise tests")
					doItAndPrint("confint(.Pairs) # confidence intervals")
					doItAndPrint("cld(.Pairs) # compact letter display")
					justDoIt("old.oma <- par(oma=c(0,5,0,0))")
					logger("old.oma <- par(oma=c(0,5,0,0))")
					justDoIt("plot(confint(.Pairs))")
					logger("plot(confint(.Pairs))")
					justDoIt("par(old.oma)")
					logger("par(old.oma)")
					logger("remove(.Pairs)")
					remove(.Pairs, envir=.GlobalEnv)
				}
			}
			tkfocus(CommanderWindow())
		}
		OKCancelHelp(helpSubject="anova", model=TRUE)
		tkgrid(labelRcmdr(modelFrame, text=gettextRcmdr("Enter name for model: ")), model, sticky="w")
		tkgrid(modelFrame, sticky="w", columnspan=2)
		tkgrid(getFrame(groupBox), getFrame(responseBox), sticky="nw")
		tkgrid(labelRcmdr(optionsFrame, text=gettextRcmdr("Pairwise comparisons of means")), pairwiseCheckBox, sticky="w")
		tkgrid(optionsFrame, sticky="w", columnspan=2)
		tkgrid(buttonsFrame, columnspan=2, sticky="w")
		dialogSuffix(rows=4, columns=2)
	}

	multiWayAnova <- function(){
		initializeDialog(title=gettextRcmdr("Multi-Way Analysis of Variance"))
		UpdateModelNumber()
		modelName <- tclVar(paste("AnovaModel.", getRcmdr("modelNumber"), sep=""))
		modelFrame <- tkframe(top)
		model <- ttkentry(modelFrame, width="20", textvariable=modelName)
		groupBox <- variableListBox(top, Factors(), selectmode="multiple", title=gettextRcmdr("Factors (pick one or more)"))
		responseBox <- variableListBox(top, Numeric(), title=gettextRcmdr("Response Variable (pick one)"))
		onOK <- function(){
			modelValue <- trim.blanks(tclvalue(modelName))
			if (!is.valid.name(modelValue)){
				UpdateModelNumber(-1)
				errorCondition(recall=multiWayAnova, message=sprintf(gettextRcmdr('"%s" is not a valid name.'), modelValue))
				return()
			}
			if (is.element(modelValue, listAOVModels())) {
				if ("no" == tclvalue(checkReplace(modelValue, type=gettextRcmdr("Model")))){
					UpdateModelNumber(-1)
					tkdestroy(top)
					multiWayAnova()
					return()
				}
			}
			groups <- getSelection(groupBox)
			response <- getSelection(responseBox)
			closeDialog()
			if (length(groups) == 0){
				errorCondition(recall=multiWayAnova, message=gettextRcmdr("You must select at least one factor."))
				return()
			}
			if (length(response) == 0){
				errorCondition(recall=multiWayAnova, message=gettextRcmdr("You must select a response variable."))
				return()
			}
			.activeDataSet <- ActiveDataSet()
			groups.list <- paste(paste(groups, "=", .activeDataSet, "$", groups, sep=""), collapse=", ")
			doItAndPrint(paste(modelValue, " <- (lm(", response, " ~ ", paste(groups, collapse="*"),
					", data=", .activeDataSet, "))", sep=""))
			doItAndPrint(paste("Anova(", modelValue, ")", sep=""))
			doItAndPrint(paste("tapply(", .activeDataSet, "$", response, ", list(", groups.list,
					"), mean, na.rm=TRUE) # means", sep=""))
			doItAndPrint(paste("tapply(", .activeDataSet, "$", response, ", list(", groups.list,
					"), sd, na.rm=TRUE) # std. deviations", sep=""))
			doItAndPrint(paste("tapply(", .activeDataSet, "$", response, ", list(", groups.list,
					"), function(x) sum(!is.na(x))) # counts", sep=""))
			activeModel(modelValue)
			tkfocus(CommanderWindow())
		}
		OKCancelHelp(helpSubject="Anova", model=TRUE)
		tkgrid(labelRcmdr(modelFrame, text=gettextRcmdr("Enter name for model: ")), model, sticky="w")
		tkgrid(modelFrame, sticky="w", columnspan=2)
		tkgrid(getFrame(groupBox), getFrame(responseBox), sticky="nw")
		tkgrid(buttonsFrame, columnspan=2, sticky="w")
		dialogSuffix(rows=4, columns=2)
	}
	
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/statistics-models-menu.R"
# Statistics Menu dialogs

# last modified 18 August 2009 by J. Fox

    # Models menu

linearRegressionModel <- function(){
    initializeDialog(title=gettextRcmdr("Linear Regression"))
    variablesFrame <- tkframe(top)
    .numeric <- Numeric()
    xBox <- variableListBox(variablesFrame, .numeric, selectmode="multiple",
        title=gettextRcmdr("Explanatory variables (pick one or more)"))
    yBox <- variableListBox(variablesFrame, .numeric, title=gettextRcmdr("Response variable (pick one)"))
    UpdateModelNumber()
    modelName <- tclVar(paste("RegModel.", getRcmdr("modelNumber"), sep=""))
    modelFrame <- tkframe(top)
    model <- ttkentry(modelFrame, width="20", textvariable=modelName)
    subsetBox()
    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()
            }
        subset <- tclvalue(subsetVariable)
        if (trim.blanks(subset) == gettextRcmdr("<all valid cases>") || trim.blanks(subset) == ""){
            subset <- ""
            putRcmdr("modelWithSubset", FALSE)
            }
        else{
            subset <- paste(", subset=", subset, sep="")
            putRcmdr("modelWithSubset", TRUE)
            }
        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)
                linearRegressionModel()
                return()
                }
            }
        command <- paste("lm(", y, "~", paste(x, collapse="+"),
            ", data=", ActiveDataSet(), subset, ")", sep="")
        logger(paste(modelValue, " <- ", command, sep=""))
        assign(modelValue, justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("summary(", modelValue, ")", sep=""))
        activeModel(modelValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="lm", model=TRUE)
    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(subsetFrame, sticky="w")
    tkgrid(buttonsFrame, stick="w")
    tkgrid.configure(helpButton, sticky="e")
    dialogSuffix(rows=4, columns=1)
    }

linearModel <- function(){
    initializeDialog(title=gettextRcmdr("Linear Model"))
    .activeModel <- ActiveModel()
    currentModel <- if (!is.null(.activeModel))
        class(get(.activeModel, envir=.GlobalEnv))[1] == "lm"
#        eval(parse(text=paste("class(", .activeModel, ")[1] == 'lm'", sep="")),
#            envir=.GlobalEnv)
        else FALSE
    if (currentModel) {
        currentFields <- formulaFields(get(.activeModel, envir=.GlobalEnv))
#        currentFields <- formulaFields(eval(parse(text=.activeModel),
#            envir=.GlobalEnv))
        if (currentFields$data != ActiveDataSet()) currentModel <- FALSE
        }
    UpdateModelNumber()
    modelName <- tclVar(paste("LinearModel.", getRcmdr("modelNumber"), sep=""))
    modelFrame <- tkframe(top)
    model <- ttkentry(modelFrame, width="20", textvariable=modelName)
    onOK <- function(){
        modelValue <- trim.blanks(tclvalue(modelName))
        closeDialog()
        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 <- ""
            putRcmdr("modelWithSubset", FALSE)
            }
        else{
            subset <- paste(", subset=", subset, sep="")
            putRcmdr("modelWithSubset", TRUE)
            }
        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)
                linearModel()
                return()
                }
            }
        formula <- paste(tclvalue(lhsVariable), tclvalue(rhsVariable), sep=" ~ ")
        command <- paste("lm(", formula,
            ", data=", ActiveDataSet(), subset, ")", sep="")
        logger(paste(modelValue, " <- ", command, sep=""))
        assign(modelValue, justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("summary(", modelValue, ")", sep=""))
        activeModel(modelValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="linearModel", model=TRUE)
    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(subsetFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=6, columns=1, focus=lhsEntry, preventDoubleClick=TRUE)
    }

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
    initializeDialog(title=gettextRcmdr("Generalized Linear Model"))
    .activeModel <- ActiveModel()
    currentModel <- if (!is.null(.activeModel))
        class(get(.activeModel, envir=.GlobalEnv))[1] == "glm"
#        eval(parse(text=paste("class(", .activeModel, ")[1] == 'glm'", sep="")),
#            envir=.GlobalEnv)
        else FALSE
    if (currentModel) {
        currentFields <- formulaFields(get(.activeModel, envir=.GlobalEnv), glm=TRUE)
#        currentFields <- formulaFields(eval(parse(text=.activeModel),
#            envir=.GlobalEnv), glm=TRUE)
        if (currentFields$data != ActiveDataSet()) currentModel <- 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)
    familyBox <- tklistbox(familyFrame, height="4", 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="4", exportselection="FALSE",
        selectmode="single", background="white")
    subsetBox(model=TRUE)
    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=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()
                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 <- ""
            putRcmdr("modelWithSubset", FALSE)
            }
        else{
            subset <- paste(", subset=", subset, sep="")
            putRcmdr("modelWithSubset", TRUE)
            }
        command <- paste("glm(", formula, ", family=", family, "(", link,
            "), data=", ActiveDataSet(), subset, ")", sep="")
        logger(paste(modelValue, " <- ", command, sep=""))
        assign(modelValue, justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("summary(", modelValue, ")", sep=""))
        activeModel(modelValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="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, sticky="w")
        tkgrid(labelRcmdr(linkFamilyFrame, text=gettextRcmdr("Family (double-click to select)"), fg="blue"),
        labelRcmdr(linkFamilyFrame, text="   "), labelRcmdr(linkFamilyFrame, text=gettextRcmdr("Link function"), fg="blue"), sticky="w")
    tkgrid(familyBox, familyScroll, 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(rows=7, columns=1, focus=lhsEntry, preventDoubleClick=TRUE)
    }

ordinalRegressionModel <- function(){
    Library("MASS")
    initializeDialog(title=gettextRcmdr("Ordinal Regression Model"))
    .activeModel <- ActiveModel()
    .activeDataSet <- ActiveDataSet()
    currentModel <- if (!is.null(.activeModel))
        class(get(.activeModel, envir=.GlobalEnv))[1] == "polr"
#        eval(parse(text=paste("class(", .activeModel, ")[1] == 'polr'", sep="")),
#            envir=.GlobalEnv)
        else FALSE
    if (currentModel) {
        currentFields <- formulaFields(get(.activeModel, envir=.GlobalEnv))
#        currentFields <- formulaFields(eval(parse(text=.activeModel),
#            envir=.GlobalEnv))
        if (currentFields$data != .activeDataSet) currentModel <- 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"),
        labels=gettextRcmdr(c("Proportional-odds logit", "Ordered probit")),
        title=gettextRcmdr("Type of Model"))
    onOK <- function(){
        modelValue <- trim.blanks(tclvalue(modelName))
        closeDialog()
        if (!is.valid.name(modelValue)){
            errorCondition(recall=proportionalOddsModel, 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 <- ""
            putRcmdr("modelWithSubset", FALSE)
            }
        else{
            subset <- paste(", subset=", subset, sep="")
            putRcmdr("modelWithSubset", TRUE)
            }
        check.empty <- gsub(" ", "", tclvalue(lhsVariable))
        if ("" == check.empty) {
            errorCondition(recall=proportionalOddsModel, message=gettextRcmdr("Left-hand side of model empty."), model=TRUE)
            return()
            }
        check.empty <- gsub(" ", "", tclvalue(rhsVariable))
        if ("" == check.empty) {
            errorCondition(recall=proportionalOddsModel, message=gettextRcmdr("Right-hand side of model empty."), model=TRUE)
            return()
            }
        if (!is.factor(eval(parse(text=tclvalue(lhsVariable)), envir=get(.activeDataSet, envir=.GlobalEnv)))){
#        if (!is.factor(eval(parse(text=tclvalue(lhsVariable)), envir=eval(parse(text=.activeDataSet), envir=.GlobalEnv)))){
            errorCondition(recall=proportionalOddsModel, message=gettextRcmdr("Response variable must be a factor"))
            return()
            }
        if (is.element(modelValue, listProportionalOddsModels())) {
            if ("no" == tclvalue(checkReplace(modelValue, type=gettextRcmdr("Model")))){
                UpdateModelNumber(-1)
                proportionalOddsModel()
                return()
                }
            }
        formula <- paste(tclvalue(lhsVariable), tclvalue(rhsVariable), sep=" ~ ")
        command <- paste("polr(", formula, ', method="', tclvalue(modelTypeVariable),
            '", data=', .activeDataSet, subset, ", Hess=TRUE)", sep="")
        logger(paste(modelValue, " <- ", command, sep=""))
        assign(modelValue, justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("summary(", modelValue, ")", sep=""))
        activeModel(modelValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="polr", model=TRUE)
    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(subsetFrame, sticky="w")
    tkgrid(modelTypeFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=7, columns=1, focus=lhsEntry, preventDoubleClick=TRUE)
    }

multinomialLogitModel <- function(){
    Library("nnet")
    initializeDialog(title=gettextRcmdr("Multinomial Logit Model"))
    .activeModel <- ActiveModel()
    .activeDataSet <- ActiveDataSet()
    currentModel <- if (!is.null(.activeModel))
        class(get(.activeModel, envir=.GlobalEnv))[1] == "multinom"
#        eval(parse(text=paste("class(", .activeModel, ")[1] == 'multinom'", sep="")),
#            envir=.GlobalEnv)
        else FALSE
    if (currentModel) {
        currentFields <- formulaFields(get(.activeModel, envir=.GlobalEnv))
#        currentFields <- formulaFields(eval(parse(text=.activeModel),
#            envir=.GlobalEnv))
        if (currentFields$data != .activeDataSet) currentModel <- FALSE
        }
    UpdateModelNumber()
    modelName <- tclVar(paste("MLM.", getRcmdr("modelNumber"), sep=""))
    modelFrame <- tkframe(top)
    model <- ttkentry(modelFrame, width="20", textvariable=modelName)
    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 <- ""
            putRcmdr("modelWithSubset", FALSE)
            }
        else{
            subset <- paste(", subset=", subset, sep="")
            putRcmdr("modelWithSubset", TRUE)
            }
        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)))){
#        if (!is.factor(eval(parse(text=tclvalue(lhsVariable)), envir=eval(parse(text=.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)
                multinomialLogitModel()
                return()
                }
            }
        formula <- paste(tclvalue(lhsVariable), tclvalue(rhsVariable), sep=" ~ ")
        command <- paste("multinom(", formula,
            ", data=", .activeDataSet, subset, ", trace=FALSE)", sep="")
        logger(paste(modelValue, " <- ", command, sep=""))
        assign(modelValue, justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(paste("summary(", modelValue, ", cor=FALSE, Wald=TRUE)", sep=""))
        activeModel(modelValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="multinom", model=TRUE)
    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(subsetFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=6, columns=1, focus=lhsEntry, preventDoubleClick=TRUE)
    }

formulaFields <- function(model, hasLhs=TRUE, glm=FALSE){
	formula <- as.character(model$call$formula)
	if (hasLhs){
		lhs <- formula[2]
		rhs <- formula[3]
	} else {
		lhs <- NULL
		rhs <- formula[2]
	}
	data <- as.character(model$call$data)
	which.subset <- which("subset" == names(model$call))
	subset <- if (0 == length(which.subset)) ""
		else as.character(model$call)[[which.subset]]
	if (glm) {
		fam <- 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)
}
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/statistics-nonparametric-menu.R"
# Statistics Menu dialogs

# last modified 1 July 05 by J. Fox

    # Nonparametric tests menu
    
twoSampleWilcoxonTest <- function(){
    initializeDialog(title=gettextRcmdr("Two-Sample Wilcoxon Test"))
    groupBox <- variableListBox(top, TwoLevelFactors(), title=gettextRcmdr("Groups (pick one)"))
    responseBox <- variableListBox(top, Numeric(), title=gettextRcmdr("Response Variable (pick one)"))
    onOK <- function(){
        group <- getSelection(groupBox)
        if (length(group) == 0) {
            errorCondition(recall=twoSampleWilcoxonTest, message=gettextRcmdr("You must select a groups variable."))
            return()
            }
        response <- getSelection(responseBox)
        if (length(response) == 0) {
            errorCondition(recall=twoSampleWilcoxonTest, message=gettextRcmdr("You must select a response variable."))
            return()
            }
        alternative <- as.character(tclvalue(alternativeVariable))
        test <- as.character(tclvalue(testVariable))
        closeDialog()
        .activeDataSet <- ActiveDataSet()
        doItAndPrint(paste("tapply(", paste(.activeDataSet,"$", response, sep=""),
            ", ", paste(.activeDataSet,"$", group, sep=""), ", median, na.rm=TRUE)", sep=""))
        if (test == "default"){
            doItAndPrint(paste("wilcox.test(", response, " ~ ", group, ', alternative="', 
            alternative, '", data=', .activeDataSet, ")", sep=""))
            }
        else doItAndPrint(paste("wilcox.test(", response, " ~ ", group, ", alternative='", 
            alternative, "', exact=", test=="exact", 
            ", correct=", test=="correct",", data=", .activeDataSet, ")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="wilcox.test")
    radioButtons(name="alternative", buttons=c("twosided", "less", "greater"), values=c("two.sided", "less", "greater"),
        labels=gettextRcmdr(c("Two-sided", "Difference < 0", "Difference > 0")), title=gettextRcmdr("Alternative Hypothesis"))
    radioButtons(name="test", buttons=c("default", "exact", "normal", "correct"), 
        labels=gettextRcmdr(c("Default", "Exact", "Normal approximation", "Normal approximation with\ncontinuity correction")), 
        title=gettextRcmdr("Type of Test"))
    tkgrid(getFrame(groupBox), getFrame(responseBox), sticky="nw")
    groupsLabel(groupsBox=groupBox, columnspan=2)
    tkgrid(alternativeFrame, testFrame, sticky="nw")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=4, columns=2)
    }    

pairedWilcoxonTest <- function(){
    initializeDialog(title=gettextRcmdr("Paired Wilcoxon Test"))
    .numeric <- Numeric()
    xBox <- variableListBox(top, .numeric, title=gettextRcmdr("First variable (pick one)"))
    yBox <- variableListBox(top, .numeric, title=gettextRcmdr("Second variable (pick one)"))
    onOK <- function(){
        x <- getSelection(xBox)
        y <- getSelection(yBox)
        closeDialog()
        alternative <- as.character(tclvalue(alternativeVariable))
        test <- as.character(tclvalue(testVariable))
        if (length(x) == 0 | length(y) == 0) {
            errorCondition(recall=pairedWilcoxonTest, message=gettextRcmdr("You must select two variables."))
            return()
            }
        if (x == y) {
            errorCondition(recall=pairedWilcoxonTest, message=gettextRcmdr("The two variables must be different."))
            return()
            }
        .activeDataSet <- ActiveDataSet()
        doItAndPrint(paste("median(", .activeDataSet, "$", x, " - ", .activeDataSet, "$", y, 
            ", na.rm=TRUE) # median difference", sep=""))
        if (test == "default"){
             doItAndPrint(paste("wilcox.test(", .activeDataSet, "$", x, ", ", 
                .activeDataSet, "$", y,
                ", alternative='", alternative,
                "', paired=TRUE)", sep=""))           
            }
        else if (test == "exact"){
            doItAndPrint(paste("wilcox.test(", .activeDataSet, "$", x, ", ", 
                .activeDataSet, "$", y,
                ", alternative='", alternative,
                "', exact=TRUE, paired=TRUE)", sep=""))
                }
        else {
            doItAndPrint(paste("wilcox.test(", .activeDataSet, "$", x, ", ", 
                .activeDataSet, "$", y,
                ", alternative='", alternative, "', correct=", test=="correct",
                ", exact=FALSE, paired=TRUE)", sep=""))
                }
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="wilcox.test")
    radioButtons(name="alternative", buttons=c("twosided", "less", "greater"), values=c("two.sided", "less", "greater"),
        labels=gettextRcmdr(c("Two-sided", "Difference < 0", "Difference > 0")), title=gettextRcmdr("Alternative Hypothesis"))
    radioButtons(name="test", buttons=c("default", "exact", "normal", "correct"), 
        labels=gettextRcmdr(c("Default", "Exact", "Normal approximation", "Normal approximation with\ncontinuity correction")), 
        title=gettextRcmdr("Type of Test"))
    tkgrid(getFrame(xBox), getFrame(yBox), sticky="nw")    
    tkgrid(alternativeFrame, testFrame, sticky="nw")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=3, columns=2)
    }
    
KruskalWallisTest <- function(){
    initializeDialog(title=gettextRcmdr("Kruskal-Wallis Rank Sum Test"))
    groupBox <- variableListBox(top, Factors(), title=gettextRcmdr("Groups (pick one)"))
    responseBox <- variableListBox(top, Numeric(), title=gettextRcmdr("Response Variable (pick one)"))
    onOK <- function(){
        group <- getSelection(groupBox)
        if (length(group) == 0) {
            errorCondition(recall=KruskalWallisTest, message=gettextRcmdr("You must select a groups variable."))
            return()
            }
        response <- getSelection(responseBox)
        closeDialog()
        if (length(response) == 0) {
            errorCondition(recall=KruskalWallisTest, message=gettextRcmdr("You must select a response variable."))
            return()
            }
        .activeDataSet <- ActiveDataSet()
        doItAndPrint(paste("tapply(", paste(.activeDataSet, "$", response, sep=""),
            ", ", paste(.activeDataSet, "$", group, sep=""), ", median, na.rm=TRUE)", sep=""))
        doItAndPrint(paste("kruskal.test(", response, " ~ ", group, ", data=",
            .activeDataSet, ")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="kruskal.test")
    tkgrid(getFrame(groupBox), getFrame(responseBox), sticky="nw")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=2, columns=2)
    }
	
FriedmanTest <- function(){
	initializeDialog(title=gettextRcmdr("Friedman Rank Sum Test"))
	responseBox <- variableListBox(top, Numeric(), selectmode="multiple", 
			title=gettextRcmdr("Repeated-Measures Variables (pick two or more)"))
	onOK <- function(){
		responses <- getSelection(responseBox)
		closeDialog()
		if (length(responses) < 2) {
			errorCondition(recall=FriedmanTest, message=gettextRcmdr("You must select at least two variables."))
			return()
			}
		.activeDataSet <- ActiveDataSet()
		command <- paste('na.omit(with(', .activeDataSet, ', cbind(', paste(responses, collapse=", "), ')))', sep="")
		logger(paste(".Responses <- ", command, sep=""))
		assign(".Responses", justDoIt(command), envir=.GlobalEnv)
		doItAndPrint("apply(.Responses, 2, median)")
		doItAndPrint("friedman.test(.Responses)")
		logger("remove(.Responses)")
		remove(.Responses, envir=.GlobalEnv)
		tkfocus(CommanderWindow())
		}
	OKCancelHelp(helpSubject="friedman.test")
	tkgrid(getFrame(responseBox), sticky="nw")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=2, columns=1)
	}
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/statistics-proportions-menu.R"
# Statistics Menu dialogs

# last modified 18 August 2009 by J. Fox

    # Proportions menu
    
singleProportionTest <- function(){
    initializeDialog(title=gettextRcmdr("Single-Sample Proportion Test"))
    xBox <- variableListBox(top, TwoLevelFactors(), title=gettextRcmdr("Variable (pick one)"))
    onOK <- function(){
        x <- getSelection(xBox)
        if (length(x) == 0) {
            errorCondition(recall=singleProportionTest, message=gettextRcmdr("You must select a variable."))
            return()
            }
        alternative <- as.character(tclvalue(alternativeVariable))
        level <- tclvalue(confidenceLevel)
        test <- as.character(tclvalue(testVariable))
        p <- tclvalue(pVariable)
        closeDialog()
        command <- paste("xtabs(~", x, ", data=", ActiveDataSet(), ")")
        logger(paste(".Table <-", command))
        assign(".Table", justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(".Table")
        if (test == "normal") doItAndPrint(paste("prop.test(rbind(.Table), alternative='", 
            alternative, "', p=", p, ", conf.level=", level, ", correct=FALSE)", sep=""))
        else if (test == "corrected") doItAndPrint(paste("prop.test(rbind(.Table), alternative='", 
            alternative, "', p=", p, ", conf.level=", level, ", correct=TRUE)", sep=""))
        else doItAndPrint(paste("binom.test(rbind(.Table), alternative='", 
            alternative, "', p=", p, ", conf.level=", level, ")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="prop.test")
    radioButtons(top, name="alternative", buttons=c("twosided", "less", "greater"), values=c("two.sided", "less", "greater"),
        labels=gettextRcmdr(c("Population proportion != p0", "Population proportion < p0", "Population proportion > p0")), title=gettextRcmdr("Alternative Hypothesis"))
    rightFrame <- tkframe(top)
    confidenceFrame <- tkframe(rightFrame)
    confidenceLevel <- tclVar(".95")
    confidenceField <- ttkentry(confidenceFrame, width="6", textvariable=confidenceLevel)
    pFrame <- tkframe(rightFrame)
    pVariable <- tclVar(".5")
    pField <- ttkentry(pFrame, width="6", textvariable=pVariable)
    radioButtons(name="test", buttons=c("normal", "corrected", "exact"), 
        labels=gettextRcmdr(c("Normal approximation", "Normal approximation with\ncontinuity correction", "Exact binomial")), 
        title=gettextRcmdr("Type of Test"))
    tkgrid(getFrame(xBox), sticky="nw")    
    tkgrid(labelRcmdr(pFrame, text=gettextRcmdr("Null hypothesis: p = "), fg="blue"), pField, sticky="w")
    tkgrid(pFrame, sticky="w")
    tkgrid(labelRcmdr(rightFrame, text=""))
    tkgrid(labelRcmdr(confidenceFrame, text=gettextRcmdr("Confidence Level: "), fg="blue"), confidenceField, sticky="w")
    tkgrid(confidenceFrame, sticky="w")
    tkgrid(alternativeFrame, rightFrame, sticky="nw")
    tkgrid(testFrame, sticky="w")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(confidenceField, sticky="e")
    dialogSuffix(rows=4, columns=2)
    }

twoSampleProportionsTest <- function(){
    Library("abind")
    initializeDialog(title=gettextRcmdr("Two-Sample Proportions Test"))
    .twoLevelFactors <- TwoLevelFactors()
    groupsBox <- variableListBox(top, .twoLevelFactors, title=gettextRcmdr("Groups (pick one)"))
    xBox <- variableListBox(top, .twoLevelFactors, title=gettextRcmdr("Response Variable (pick one)"))
    onOK <- function(){
        groups <- getSelection(groupsBox)
        if (length(groups) == 0) {
            errorCondition(recall=twoSampleProportionsTest, message=gettextRcmdr("You must select a groups variable."))
            return()
            }
        x <- getSelection(xBox)
        if (length(x) == 0) {
            errorCondition(recall=twoSampleProportionsTest, message=gettextRcmdr("You must select a response variable."))
            return()
            }
        if (x == groups) {
            errorCondition(recall=twoSampleProportionsTest, message=gettextRcmdr("Groups and response variables must be different."))
            return()
            }
        alternative <- as.character(tclvalue(alternativeVariable))
        level <- tclvalue(confidenceLevel)
        test <- as.character(tclvalue(testVariable))
        closeDialog()
        command <- paste("xtabs(~", groups, "+", x, ", data=", ActiveDataSet(), ")", sep="")
        logger(paste(".Table <-", command))
        assign(".Table", justDoIt(command), envir=.GlobalEnv)
        doItAndPrint("rowPercents(.Table)")
        if (test == "normal") doItAndPrint(paste("prop.test(.Table, alternative='", 
            alternative, "', conf.level=", level, ", correct=FALSE)", sep=""))
        else doItAndPrint(paste("prop.test(.Table, alternative='", 
            alternative, "', conf.level=", level, ", correct=TRUE)", sep=""))
        logger("remove(.Table)")
        remove(.Table, envir=.GlobalEnv)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="prop.test")
    radioButtons(name="alternative", buttons=c("twosided", "less", "greater"), values=c("two.sided", "less", "greater"),
        labels=gettextRcmdr(c("Two-sided", "Difference < 0", "Difference > 0")), title=gettextRcmdr("Alternative Hypothesis"))
    rightFrame <- tkframe(top)
    confidenceFrame <- tkframe(rightFrame)
    confidenceLevel <- tclVar(".95")
    confidenceField <- ttkentry(confidenceFrame, width="6", textvariable=confidenceLevel)
    radioButtons(name="test", buttons=c("normal", "corrected"), 
        labels=gettextRcmdr(c("Normal approximation", "Normal approximation with\ncontinuity correction")), title=gettextRcmdr("Type of Test"))
    tkgrid(getFrame(groupsBox), getFrame(xBox), sticky="nw")    
    groupsLabel(columnspan=2)
    tkgrid(labelRcmdr(confidenceFrame, text=gettextRcmdr("Confidence Level: "), fg="blue"), confidenceField, sticky="w")
    tkgrid(confidenceFrame, sticky="w")
    tkgrid(alternativeFrame, rightFrame, sticky="nw")
    tkgrid(testFrame, sticky="w")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    tkgrid.configure(confidenceField, sticky="e")
    dialogSuffix(rows=5, columns=2)
    }
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/statistics-summaries-menu.R"
# Statistics Menu dialogs

# last modified 8 July 2010 by J. Fox

    # Summaries menu
    
summarizeDataSet <- function(){
    nvar <- length(Variables())
    .activeDataSet <- ActiveDataSet()
    if (nvar > 10){
        response <- RcmdrTkmessageBox(message=sprintf(gettextRcmdr("There are %d variables in the data set %s.\nDo you want to proceed?"), nvar, .activeDataSet),
            icon="question", type="okcancel", default="cancel")
        if ("cancel" == tclvalue(response)) {
            tkfocus(CommanderWindow())
            return()
            }
        }
    doItAndPrint(paste("summary(", .activeDataSet, ")", sep=""))
    }

numericalSummaries <- function(){
    Library("abind")
    initializeDialog(title=gettextRcmdr("Numerical Summaries"))
    xBox <- variableListBox(top, Numeric(), selectmode="multiple", title=gettextRcmdr("Variables (pick one or more)"))
    checkBoxes(frame="checkBoxFrame", boxes=c("mean", "sd"), initialValues=c("1", "1"), labels=gettextRcmdr(c("Mean", "Standard Deviation")))
    quantilesVariable <- tclVar("1")
    quantilesFrame <- tkframe(top)
    quantilesCheckBox <- tkcheckbutton(quantilesFrame, variable=quantilesVariable)
    quantiles <- tclVar("0, .25, .5, .75, 1")
    quantilesEntry <- ttkentry(quantilesFrame, width="20", textvariable=quantiles)
    groupsBox(recall=numericalSummaries, label=gettextRcmdr("Summarize by:"), initialLabel=gettextRcmdr("Summarize by groups"))
    onOK <- function(){
        x <- getSelection(xBox)
        if (length(x) == 0){
            errorCondition(recall=numericalSummaries, message=gettextRcmdr("You must select a variable."))
            return()
            }
        closeDialog()
        quants <- paste("c(", gsub(",+", ",", gsub(" ", ",", tclvalue(quantiles))), ")", sep="")
        .activeDataSet <- ActiveDataSet()
        vars <- if (length(x) == 1) paste('"', x, '"', sep="") 
            else paste("c(", paste('"', x, '"', collapse=", ", sep=""), ")", sep="")
        vars <- paste(.activeDataSet, "[,", vars, "]", sep="")
        stats <- paste("c(",
            paste(c('"mean"', '"sd"', '"quantiles"')
                [c(tclvalue(meanVariable), tclvalue(sdVariable), tclvalue(quantilesVariable)) == 1], 
                collapse=", "), ")", sep="")
        if (stats == "c()"){
             errorCondition(recall=numericalSummaries, message=gettextRcmdr("No statistics selected."))
            return()
            }               
        command <- if (.groups != FALSE) {
            grps <- paste(.activeDataSet, "$", .groups, sep="")
            paste("numSummary(", vars, ", groups=", grps, ", statistics=", stats, 
				", quantiles=", quants, ")", sep="")
            }
        else  paste("numSummary(", vars, ", statistics=", stats, 
			", quantiles=", quants, ")", sep="")
        doItAndPrint(command) 
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="numSummary")
    tkgrid(getFrame(xBox), sticky="nw")    
    tkgrid(checkBoxFrame, sticky="w")
    tkgrid(labelRcmdr(quantilesFrame, text=gettextRcmdr("Quantiles")), quantilesCheckBox,
        labelRcmdr(quantilesFrame, text=gettextRcmdr(" quantiles:")), quantilesEntry, sticky="w")
    tkgrid(quantilesFrame, sticky="w")
    tkgrid(groupsFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=6, columns=1)
    }

frequencyDistribution <- function(){
    initializeDialog(title=gettextRcmdr("Frequency Distributions"))
    xBox <- variableListBox(top, Factors(), selectmode="multiple",
        title=gettextRcmdr("Variables (pick one or more)"))
    optionsFrame <- tkframe(top)
    goodnessOfFitVariable <- tclVar("0")
    goodnessOfFitCheckBox <- tkcheckbutton(optionsFrame, variable=goodnessOfFitVariable)
    onOK <- function(){
        x <- getSelection(xBox)
        if (length(x) == 0){
            errorCondition(recall=frequencyDistribution, message=gettextRcmdr("You must select a variable."))
            return()
            }
        goodnessOfFit <- tclvalue(goodnessOfFitVariable)
        if (length(x) > 1 && goodnessOfFit == "1"){
            errorCondition(recall=frequencyDistribution, 
                message=gettextRcmdr("Goodness-of-fit test not available when more than one variable is selected."))
            return()
            }
        closeDialog()
        .activeDataSet <- ActiveDataSet()
        for (variable in x){
            command <- paste("table(", .activeDataSet, "$", variable, ")", sep="")
            logger(paste(".Table <-", command))
            assign(".Table", justDoIt(command), envir=.GlobalEnv)
            doItAndPrint(paste(".Table  # counts for", variable))
            doItAndPrint(paste("round(100*.Table/sum(.Table), 2)  # percentages for", variable))
            }
        env <- environment()
        if (goodnessOfFit == 1){
            initializeDialog(subwin, title=gettextRcmdr("Goodness-of-Fit Test"))
            hypothesisFrame <- tkframe(subwin)
            levs <- eval(parse(text=paste("levels(", .activeDataSet, "$", x, ")", sep="")))
            n.levs <- length(levs)
            assign(".entry.1", tclVar(paste("1/", n.levs, sep="")), envir=env)
            make.entries <- "labelRcmdr(hypothesisFrame, text='Hypothesized probabilities:   ')"
            make.lev.names <- "labelRcmdr(hypothesisFrame, text='Factor levels:')"
            for (i in 1:n.levs) {
                entry.varname <- paste(".entry.", i, sep="")
                assign(entry.varname, tclVar(paste("1/", n.levs, sep="")), envir=env)
                make.entries <- paste(make.entries, ", ", "ttkentry(hypothesisFrame, width='5', textvariable=", 
                        entry.varname, ")", sep="")
                make.lev.names <- paste(make.lev.names, ", labelRcmdr(hypothesisFrame, text='", levs[i], "')", sep="")
                }
            eval(parse(text=paste("tkgrid(", make.lev.names, ", sticky='w')", sep="")), envir=env)
            eval(parse(text=paste("tkgrid(", make.entries, ", stick='w')", sep="")), envir=env)
            tkgrid(hypothesisFrame, sticky="w")
            onOKsub <- function(){
                probs <- rep(NA, n.levs)
                for (i in 1:n.levs){
                    entry.varname <- paste(".entry.", i, sep="")
                    res <- try(
                        entry <- eval(parse(text=eval(parse(text=paste("tclvalue(", entry.varname,")", sep="")), envir=env))),
                        silent=TRUE)
                    if (class(res) == "try-error"){
                        errorCondition(subwin, message=gettextRcmdr("Invalid entry."))
                        return()
                        }
                    if (length(entry) == 0){
                        errorCondition(subwin, message=gettextRcmdr("Missing entry."))
                        return()
                        }
                    opts <- options(warn=-1)
                    probs[i] <- as.numeric(entry)
                    options(opts)
                    }
                probs <- na.omit(probs)
                if (length(probs) != n.levs){
                    errorCondition(subwin, message=sprintf(gettextRcmdr("Number of valid entries (%d)\nnot equal to number levels (%d)."), length(probs), 
                        n.levs))
                    return()
                    }
                if (any(probs < 0)){
                    errorCondition(subwin, message=gettextRcmdr("Negative probabilities not allowed."))
                    return()
                    }
                if (abs(sum(probs) - 1) > 0.001){
                    Message(message=gettextRcmdr("Probabilities rescaled to sum to 1."), type="warning")
                    probs <- probs/sum(probs)
                    }
                closeDialog(subwin)
                command <- paste("c(", paste(probs, collapse=","), ")", sep="")
                logger(paste(".Probs <-", command))
                assign(".Probs", justDoIt(command), envir=.GlobalEnv)
                doItAndPrint("chisq.test(.Table, p=.Probs)")
                logger("remove(.Probs)")
                remove(.Probs, envir=.GlobalEnv)
                }
            subOKCancelHelp(subwin)
            tkgrid(subButtonsFrame, sticky="w")
            dialogSuffix(subwin, rows=2, columns=1, onOK=onOKsub, focus=subwin)
            }            
        logger("remove(.Table)") 
        remove(.Table, envir=.GlobalEnv)  
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="table")
    tkgrid(getFrame(xBox), sticky="nw")    
    tkgrid(labelRcmdr(optionsFrame, 
        text=gettextRcmdr("Chi-square goodness-of-fit test (for one variable only)")), 
            goodnessOfFitCheckBox, sticky="w")
    tkgrid(optionsFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=3, columns=2)
    }

statisticsTable <- function(){
	initializeDialog(title=gettextRcmdr("Table of Statistics"))
	variablesFrame <- tkframe(top)
	groupBox <- variableListBox(variablesFrame, Factors(), selectmode="multiple", 
		title=gettextRcmdr("Factors (pick one or more)"))
	responseBox <- variableListBox(variablesFrame, Numeric(), selectmode="multiple", 
		title=gettextRcmdr("Response variables (pick one or more)"))
	radioButtons(name="statistic", buttons=c("mean", "median", "sd"), labels=gettextRcmdr(c("Mean", "Median", "Standard deviation")), title=gettextRcmdr("Statistic"))
	otherVariable <- tclVar("")
	otherButton <- ttkradiobutton(statisticFrame, variable=statisticVariable, value="other")
	otherEntry <- ttkentry(statisticFrame, width="20", textvariable=otherVariable)   
	tkgrid(labelRcmdr(statisticFrame, text=gettextRcmdr("Other (specify)")), otherButton, otherEntry, sticky="w")
	onOK <- function(){
		groups <- getSelection(groupBox)
		if (0 == length(groups)) {
			errorCondition(recall=statisticsTable, message=gettextRcmdr("No factors selected."))
			return()
		}
		responses <- getSelection(responseBox)
		if (0 == length(responses)) {
			errorCondition(recall=statisticsTable, message=gettextRcmdr("You must select a response variable."))
			return()
		}
		statistic <- tclvalue(statisticVariable)
		if (statistic == "other") statistic <- tclvalue(otherVariable)
		closeDialog()
		.activeDataSet <- ActiveDataSet()
		groups.list <- paste(paste(groups, "=", .activeDataSet, "$", groups, sep=""), collapse=", ")
		for (response in responses){
			if (length(responses) > 1) 
				doItAndPrint(paste("# Table for ", response, ":", sep=""))                
			doItAndPrint(paste("tapply(", .activeDataSet, "$", response, 
					", list(", groups.list, "), ", statistic, ", na.rm=TRUE)", sep=""))
		}
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="tapply")
	tkgrid(getFrame(groupBox), labelRcmdr(variablesFrame, text="    "),getFrame(responseBox), sticky="nw")
	tkgrid(variablesFrame, sticky="w")
	tkgrid(statisticFrame, sticky="w")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=3, columns=1, focus=otherEntry)
}
    
correlationMatrix <- function(){
	initializeDialog(title=gettextRcmdr("Correlation Matrix"))
	xBox <- variableListBox(top, Numeric(), selectmode="multiple", title=gettextRcmdr("Variables (pick two or more)"))
	radioButtons(name="correlations", buttons=c("pearson", "spearman", "partial"), values=c("Pearson", "Spearman", "partial"),
		labels=gettextRcmdr(c("Pearson product-moment", "Spearman rank-order", "Partial")), title=gettextRcmdr("Type of Correlations"))
	pvaluesFrame <- tkframe(top)
	pvaluesVar <- tclVar("0")
	pvaluesCheckbox <- tkcheckbutton(pvaluesFrame, variable=pvaluesVar)
	onOK <- function(){
		correlations <- tclvalue(correlationsVariable)
		x <- getSelection(xBox)
		if (2 > length(x)) {
			errorCondition(recall=correlationMatrix, message=gettextRcmdr("Fewer than 2 variables selected."))
			return()
		}
		if ((correlations == "partial") && (3 > length(x))) {
			errorCondition(recall=correlationMatrix, message=gettextRcmdr("Fewer than 3 variables selected\nfor partial correlations."))
			return()
		}
		closeDialog()
		x <- paste('"', x, '"', sep="")
		.activeDataSet <- ActiveDataSet()
		pvalues <- tclvalue(pvaluesVar)
		if (correlations == "Pearson"){
			if (pvalues == 0){
				doItAndPrint(paste("cor(", .activeDataSet, "[,c(", paste(x, collapse=","),
						')], use="complete.obs")', sep=""))
			}
			else{
				Library("Hmisc")
				doItAndPrint(paste("rcorr.adjust(", .activeDataSet, "[,c(", paste(x, collapse=","),
						')], type="pearson")', sep=""))
			}
		}
		else if (correlations == "Spearman"){
			logger("# Spearman rank-order correlations")
			if (pvalues == 0){
				doItAndPrint(paste("cor(", .activeDataSet, "[,c(", paste(x, collapse=","),
						')], use="complete.obs", method="spearman")', sep=""))
			}
			else{
				Library("Hmisc")
				doItAndPrint(paste("rcorr.adjust(", .activeDataSet, "[,c(", paste(x, collapse=","),
						')], type="spearman")', sep=""))				
			}
		}
		else doItAndPrint(paste("partial.cor(", .activeDataSet, "[,c(", paste(x, collapse=","),
					')], use="complete.obs")', sep=""))    
		tkfocus(CommanderWindow())
	}
	OKCancelHelp(helpSubject="rcorr.adjust")
	tkgrid(getFrame(xBox), sticky="nw")
	tkgrid(correlationsFrame, sticky="w")
	tkgrid(labelRcmdr(pvaluesFrame, 
			text=gettextRcmdr("Pairwise p-values\nfor Pearson or Spearman correlations")), 
		pvaluesCheckbox, sticky="w")
	tkgrid(pvaluesFrame, sticky="w")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=4, columns=1)
}

	
# the following dialog contributed by Stefano Calza, modified by J. Fox
    
correlationTest <- function(){
  initializeDialog(title=gettextRcmdr("Correlation Test"))
  xBox <- variableListBox(top, Numeric(), selectmode="multiple", title=gettextRcmdr("Variables (pick two)"))
  radioButtons(name="correlations", buttons=c("pearson", "spearman", "kendall"),
               labels=gettextRcmdr(c("Pearson product-moment", "Spearman rank-order", "Kendall's tau")),
               title=gettextRcmdr("Type of Correlation"))
  radioButtons(name="alternative", buttons=c("two.sided", "less", "greater"), values=c("two.sided", "less", "greater"),
               labels=gettextRcmdr(c("Two-sided", "Correlation < 0", "Correlation > 0")), title=gettextRcmdr("Alternative Hypothesis"))  
  onOK <- function(){
    alternative <- as.character(tclvalue(alternativeVariable))
    correlations <- as.character(tclvalue(correlationsVariable))
    x <- getSelection(xBox)
    if (2 > length(x)) {
      errorCondition(recall=correlationTest,
        message=gettextRcmdr("Fewer than 2 variables selected."))
      return()
    }
    if(2 < length(x)) {
      errorCondition(recall=correlationTest,
        message=gettextRcmdr("More than 2 variables selected."))
      return()
    }
    closeDialog()
    .activeDataSet <- ActiveDataSet()
    command <- paste("cor.test(", .activeDataSet, "$", x[1], ", ", .activeDataSet, "$", x[2],
        ', alternative="', alternative, '", method="', correlations, '")', sep="")
    doItAndPrint(command)  
    tkfocus(CommanderWindow())
  }
  OKCancelHelp(helpSubject="cor.test")
  tkgrid(getFrame(xBox), sticky="nw")
  tkgrid(labelRcmdr(top, text=""))
  tkgrid(correlationsFrame,alternativeFrame, sticky="w")
  tkgrid(buttonsFrame,columnspan=2,sticky="w")
  dialogSuffix(rows=4, columns=1)
}

countMissing <- function(){
  command <- paste("sapply(", activeDataSet(), 
    ", function(x)(sum(is.na(x)))) # NA counts", sep="")
  doItAndPrint(command)
  invisible(NULL)
  }
  
ShapiroTest <- function(){
    initializeDialog(title=gettextRcmdr("Shapiro-Wilk Test for Normality"))
    variableBox <- variableListBox(top, Numeric(), title=gettextRcmdr("Variable (pick one)"))
    onOK <- function(){
        var <- getSelection(variableBox)
        if (length(var) == 0) {
            errorCondition(recall=ShapiroTest, message=gettextRcmdr("You must select a variable."))
            return()
            }
        closeDialog()
        doItAndPrint(paste("shapiro.test(",ActiveDataSet(), "$", var, ")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="shapiro.test")
    tkgrid(getFrame(variableBox), sticky="nw")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=2, columns=1)
    }
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/statistics-tables-menu.R"
# Statistics Menu dialogs

# last modified 18 August 2009 by J. Fox

    # Tables menu

twoWayTable <- function(){
    Library("abind")
    initializeDialog(title=gettextRcmdr("Two-Way Table"))
    variablesFrame <- tkframe(top)
    .factors <- Factors()
    rowBox <- variableListBox(variablesFrame, .factors, title=gettextRcmdr("Row variable (pick one)"))
    columnBox <- variableListBox(variablesFrame, .factors, title=gettextRcmdr("Column variable (pick one)"))
    subsetBox()
    onOK <- function(){
        row <- getSelection(rowBox)
        column <- getSelection(columnBox)
        if (length(row) == 0 || length(column) == 0){
            errorCondition(recall=twoWayTable, message=gettextRcmdr("You must select two variables."))
            return()
            }
        if (row == column) {
            errorCondition(recall=twoWayTable, message=gettextRcmdr("Row and column variables are the same."))
            return()
            }
        percents <- as.character(tclvalue(percentsVariable))
        chisq <- tclvalue(chisqTestVariable)
        chisqComp <- tclvalue(chisqComponentsVariable)
        expected <- tclvalue(expFreqVariable)
        fisher <- tclvalue(fisherTestVariable)
        subset <- tclvalue(subsetVariable)
        subset <- if (trim.blanks(subset) == gettextRcmdr("<all valid cases>")) ""
            else paste(", subset=", subset, sep="")
        closeDialog()
        command <- paste("xtabs(~", row, "+", column, ", data=", ActiveDataSet(),
            subset, ")", sep="")
        logger(paste(".Table <- ", command, sep=""))
        assign(".Table", justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(".Table")
        if (percents == "row") doItAndPrint("rowPercents(.Table) # Row Percentages")
        if (percents == "column") doItAndPrint("colPercents(.Table) # Column Percentages")
        if (percents == "total") doItAndPrint("totPercents(.Table) # Percentage of Total")
        if (chisq == 1) {
            command <- "chisq.test(.Table, correct=FALSE)"
            logger(paste(".Test <- ", command, sep=""))
            assign(".Test", justDoIt(command), envir=.GlobalEnv)
            doItAndPrint(".Test")
            if (expected == 1) doItAndPrint(".Test$expected # Expected Counts")
            warnText <- NULL
            if (0 < (nlt1 <- sum(.Test$expected < 1))) warnText <- paste(nlt1,
                gettextRcmdr("expected frequencies are less than 1"))
            if (0 < (nlt5 <- sum(.Test$expected < 5))) warnText <- paste(warnText, "\n", nlt5,
                gettextRcmdr(" expected frequencies are less than 5"), sep="")
            if (!is.null(warnText)) Message(message=warnText,
                type="warning")
            if (chisqComp == 1) {
                command <- "round(.Test$residuals^2, 2) # Chi-square Components"
                doItAndPrint(command)
                }
            logger("remove(.Test)")
            remove(.Test, envir=.GlobalEnv)
            }
        if (fisher == 1) doItAndPrint("fisher.test(.Table)")
        logger("remove(.Table)")
        remove(.Table, envir=.GlobalEnv)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="xtabs")
    radioButtons(name="percents",
        buttons=c("rowPercents", "columnPercents", "totalPercents", "nonePercents"),
        values=c("row", "column", "total", "none"), initialValue="none",
        labels=gettextRcmdr(c("Row percentages", "Column percentages", "Percentages of total", "No percentages")), title=gettextRcmdr("Compute Percentages"))
    checkBoxes(frame="testsFrame", boxes=c("chisqTest", "chisqComponents", "expFreq", "fisherTest"), initialValues=c("1", "0", "0", "0"),
        labels=gettextRcmdr(c("Chi-square test of independence", "Components of chi-square statistic",
            "Print expected frequencies", "Fisher's exact test")))
    tkgrid(getFrame(rowBox), labelRcmdr(variablesFrame, text="    "), getFrame(columnBox), sticky="nw")
    tkgrid(variablesFrame, sticky="w")
    tkgrid(percentsFrame, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Hypothesis Tests"), fg="blue"), sticky="w")
    tkgrid(testsFrame, sticky="w")
    tkgrid(subsetFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=6, columns=1)
    }

multiWayTable <- function(){
    Library("abind")
    initializeDialog(title=gettextRcmdr("Multi-Way Table"))
    variablesFrame <- tkframe(top)
    .factors <- Factors()
    rowBox <- variableListBox(variablesFrame, .factors, title=gettextRcmdr("Row variable (pick one)"))
    columnBox <- variableListBox(variablesFrame, .factors, title=gettextRcmdr("Column variable (pick one)"))
    controlBox <- variableListBox(variablesFrame, .factors, selectmode="multiple",
        title=gettextRcmdr("Control variable(s) (pick one or more)"))
    subsetBox()
    onOK <- function(){
        row <- getSelection(rowBox)
        column <- getSelection(columnBox)
        controls <- getSelection(controlBox)
        if (length(row) == 0 || length(column) == 0 || length(controls) == 0) {
            errorCondition(recall=multiWayTable, message=gettextRcmdr("You must select row, column, and control variables"))
            return()
            }
        if ((row == column) || is.element(row, controls) || is.element(column, controls)) {
            errorCondition(recall=multiWayTable, message=gettextRcmdr("Row, column, and control variables must be different."))
            return()
            }
        percents <- as.character(tclvalue(percentsVariable))
        subset <- tclvalue(subsetVariable)
        subset <- if (trim.blanks(subset) == gettextRcmdr("<all valid cases>")) ""
            else paste(", subset=", subset, sep="")
        closeDialog()
        command <- paste("xtabs(~", row, "+", column, "+", paste(controls, collapse="+"),
            ", data=", ActiveDataSet(), subset, ")", sep="")
        logger(paste(".Table <- ", command, sep=""))
        assign(".Table", justDoIt(command), envir=.GlobalEnv)
        doItAndPrint(".Table")
        if (percents == "row") doItAndPrint("rowPercents(.Table) # Row Percentages")
        if (percents == "column") doItAndPrint("colPercents(.Table) # Column Percentages")
        logger("remove(.Table)")
        remove(.Table, envir=.GlobalEnv)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="xtabs")
    radioButtons(name="percents", buttons=c("rowPercents", "columnPercents", "nonePercents"), values=c("row", "column", "none"),
        initialValue="none", labels=gettextRcmdr(c("Row percentages", "Column percentages", "No percentages")), title=gettextRcmdr("Compute Percentages"))
    tkgrid(getFrame(rowBox), labelRcmdr(variablesFrame, text="    "), getFrame(columnBox), labelRcmdr(variablesFrame, text="    "),
        getFrame(controlBox), sticky="nw")
    tkgrid(variablesFrame, sticky="w")
    tkgrid(percentsFrame, sticky="w")
    tkgrid(subsetFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=4, columns=1)
    }

enterTable <- function(){
    Library("abind")
    env <- environment()
    initializeDialog(title=gettextRcmdr("Enter Two-Way Table"))
    outerTableFrame <- tkframe(top)
    assign(".tableFrame", tkframe(outerTableFrame), envir=env)
    setUpTable <- function(...){
        tkdestroy(get(".tableFrame", envir=env))
        assign(".tableFrame", tkframe(outerTableFrame), envir=env)
        nrows <- as.numeric(tclvalue(rowsValue))
        ncols <- as.numeric(tclvalue(colsValue))
        make.col.names <- "labelRcmdr(.tableFrame, text='')"
        for (j in 1:ncols) {
            col.varname <- paste(".colname.", j, sep="")
            assign(col.varname, tclVar(j), envir=env)
            make.col.names <- paste(make.col.names, ", ", "ttkentry(.tableFrame, width='5', textvariable=",
                    col.varname, ")", sep="")
            }
        eval(parse(text=paste("tkgrid(", make.col.names, ")", sep="")), envir=env)
        for (i in 1:nrows){
            varname <- paste(".tab.", i, ".1", sep="")
            assign(varname, tclVar("") , envir=env)
            row.varname <- paste(".rowname.", i, sep="")
            assign(row.varname, tclVar(i), envir=env)
            make.row <- paste("ttkentry(.tableFrame, width='5', textvariable=",
                row.varname, ")", sep="")
            make.row <- paste(make.row, ", ", "ttkentry(.tableFrame, width='5', textvariable=",
                varname, ")", sep="")
            for (j in 2:ncols){
                varname <- paste(".tab.", i, ".", j, sep="")
                assign(varname, tclVar(""), envir=env)
                make.row <- paste(make.row, ", ", "ttkentry(.tableFrame, width='5', textvariable=",
                    varname, ")", sep="")
                }
            eval(parse(text=paste("tkgrid(", make.row, ")", sep="")), envir=env)
            }
        tkgrid(get(".tableFrame", envir=env), sticky="w")
        }
    rowColFrame <- tkframe(top)
    rowsValue <- tclVar("2")
    rowsSlider <- tkscale(rowColFrame, from=2, to=10, showvalue=FALSE, variable=rowsValue,
        resolution=1, orient="horizontal", command=setUpTable)
    rowsShow <- labelRcmdr(rowColFrame, textvariable=rowsValue, width=2, justify="right")
    colsValue <- tclVar("2")
    colsSlider <- tkscale(rowColFrame, from=2, to=10, showvalue=FALSE, variable=colsValue,
        resolution=1, orient="horizontal", command=setUpTable)
    colsShow <- labelRcmdr(rowColFrame, textvariable=colsValue, width=2, justify="right")
    onOK <- function(){
        nrows <- as.numeric(tclvalue(rowsValue))
        ncols <- as.numeric(tclvalue(colsValue))
        cell <- 0
        counts <- rep(NA, nrows*ncols)
        row.names <- rep("", nrows)
        col.names <- rep("", ncols)
        for (i in 1:nrows) row.names[i] <-
            eval(parse(text=paste("tclvalue(", paste(".rowname.", i, sep=""),")", sep="")))
        for (j in 1:ncols) col.names[j] <-
            eval(parse(text=paste("tclvalue(", paste(".colname.", j, sep=""),")", sep="")))
        for (i in 1:nrows){
            for (j in 1:ncols){
                cell <- cell+1
                varname <- paste(".tab.", i, ".", j, sep="")
                counts[cell] <- as.numeric(eval(parse(text=paste("tclvalue(", varname,")", sep=""))))
                }
            }
        counts <- na.omit(counts)
        if (length(counts) != nrows*ncols){
            errorCondition(recall=enterTable, message=sprintf(gettextRcmdr("Number of valid entries (%d)\nnot equal to number of rows (%d) * number of columns (%d)."), length(counts), nrows, ncols))
            return()
            }
        if (length(unique(row.names)) != nrows){
            errorCondition(recall=enterTable, message=gettextRcmdr("Row names are not unique."))
            return()
            }
        if (length(unique(col.names)) != ncols){
            errorCondition(recall=enterTable, message=gettextRcmdr("Column names are not unique."))
            return()
            }
        percents <- as.character(tclvalue(percentsVariable))
        chisq <- tclvalue(chisqVariable)
        chisqComp <- tclvalue(chisqComponentsVariable)
        expected <- tclvalue(expFreqVariable)
        fisher <- tclvalue(fisherVariable)
        closeDialog()
        command <- paste("matrix(c(", paste(counts, collapse=","), "), ", nrows, ", ", ncols,
            ", byrow=TRUE)", sep="")
        assign(".Table", justDoIt(command), envir=.GlobalEnv)
        logger(paste(".Table <- ", command, sep=""))
        command <- paste("c(",paste(paste("'", row.names, "'", sep=""), collapse=", "), ")", sep="")
        justDoIt(paste("rownames(.Table) <- ", command, sep=""))
        logger(paste("rownames(.Table) <- ", command, sep=""))
        command <- paste("c(",paste(paste("'", col.names, "'", sep=""), collapse=", "), ")", sep="")
        justDoIt(paste("colnames(.Table) <- ", command, sep=""))
        logger(paste("colnames(.Table) <- ", command, sep=""))
        doItAndPrint(".Table  # Counts")
        if (percents == "row") doItAndPrint("rowPercents(.Table) # Row Percentages")
        if (percents == "column") doItAndPrint("colPercents(.Table) # Column Percentages")
        if (percents == "total") doItAndPrint("totPercents(.Table) # Percentage of Total")
        if (chisq == 1) {
            command <- "chisq.test(.Table, correct=FALSE)"
            logger(paste(".Test <- ", command, sep=""))
            assign(".Test", justDoIt(command), envir=.GlobalEnv)
            doItAndPrint(".Test")
            if (expected == 1) doItAndPrint(".Test$expected # Expected Counts")
            warnText <- NULL
            if (0 < (nlt1 <- sum(.Test$expected < 1))) warnText <- paste(nlt1,
                gettextRcmdr("expected frequencies are less than 1"))
            if (0 < (nlt5 <- sum(.Test$expected < 5))) warnText <- paste(warnText, "\n", nlt5,
                gettextRcmdr(" expected frequencies are less than 5"), sep="")
            if (!is.null(warnText)) Message(message=warnText,
                type="warning")
            if (chisqComp == 1) {
                command <- "round(.Test$residuals^2, 2) # Chi-square Components"
                doItAndPrint(command)
                }
            logger("remove(.Test)")
            remove(.Test, envir=.GlobalEnv)
            }
        if (fisher == 1) doItAndPrint("fisher.test(.Table)")
        logger("remove(.Table)")
        remove(.Table, envir=.GlobalEnv)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="chisq.test")
    radioButtons(name="percents", buttons=c("rowPercents", "columnPercents", "totalPercents", "nonePercents"), values=c("row", "column", "total", "none"),
        initialValue="none", labels=gettextRcmdr(c("Row percentages", "Column percentages",  "Percentages of total", "No percentages")), title=gettextRcmdr("Compute Percentages"))
    checkBoxes(frame="testsFrame", boxes=c("chisq", "chisqComponents", "expFreq", "fisher"), initialValues=c("1", "0", "0", "0"),
        labels=gettextRcmdr(c("Chi-square test of independence", "Components of chi-square statistic",
            "Print expected frequencies", "Fisher's exact test")))
    tkgrid(labelRcmdr(rowColFrame, text=gettextRcmdr("Number of Rows:")), rowsSlider, rowsShow, sticky="w")
    tkgrid(labelRcmdr(rowColFrame, text=gettextRcmdr("Number of Columns:")), colsSlider, colsShow, sticky="w")
    tkgrid(rowColFrame, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Enter counts:"), fg="blue"), sticky="w")
    tkgrid(outerTableFrame, sticky="w")
    tkgrid(percentsFrame, sticky="w")
    tkgrid(labelRcmdr(top, text=gettextRcmdr("Hypothesis Tests"), fg="blue"), sticky="w")
    tkgrid(testsFrame, sticky="w")
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=7, columns=2)
    }
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/statistics-variances-menu.R"
# Statistics Menu dialogs

# last modified 25 June 2010 by J. Fox

    # Variances menu
    
twoVariancesFTest <- function(){
    initializeDialog(title=gettextRcmdr("Two Variances F-Test"))
    variablesFrame <- tkframe(top)
    groupBox <- variableListBox(variablesFrame, TwoLevelFactors(), title=gettextRcmdr("Groups (pick one)"))
    responseBox <- variableListBox(variablesFrame, Numeric(), title=gettextRcmdr("Response Variable (pick one)"))
    onOK <- function(){
        group <- getSelection(groupBox)
        if (length(group) == 0) {
            errorCondition(recall=twoVariancesFTest, message=gettextRcmdr("You must select a groups variable."))
            return()
            }
        response <- getSelection(responseBox)
        if (length(response) == 0) {
            errorCondition(recall=twoVariancesFTest, message=gettextRcmdr("You must select a response variable."))
            return()
            }
        alternative <- as.character(tclvalue(alternativeVariable))
        level <- tclvalue(confidenceLevel)
        closeDialog()
        .activeDataSet <- ActiveDataSet()
        doItAndPrint(paste("tapply(", .activeDataSet, "$", response, ", ", 
            .activeDataSet, "$", group, ",  var, na.rm=TRUE)", sep=""))
        doItAndPrint(paste("var.test(", response, " ~ ", group,
            ", alternative='", alternative, "', conf.level=", level,
            ", data=", .activeDataSet, ")", sep=""))
        tkfocus(CommanderWindow())
        tkdestroy(top)
        }
    OKCancelHelp(helpSubject="var.test")
    radioButtons(name="alternative", buttons=c("twosided", "less", "greater"), values=c("two.sided", "less", "greater"),
        labels=gettextRcmdr(c("Two-sided", "Difference < 0", "Difference > 0")), title=gettextRcmdr("Alternative Hypothesis"))
    confidenceFrame <- tkframe(top)
    confidenceLevel <- tclVar(".95")
    confidenceField <- ttkentry(confidenceFrame, width="6", textvariable=confidenceLevel)
    tkgrid(getFrame(groupBox), labelRcmdr(variablesFrame, text="    "), getFrame(responseBox), sticky="nw")
    tkgrid(variablesFrame, sticky="w")
    groupsLabel(groupsBox=groupBox)
    tkgrid(labelRcmdr(confidenceFrame, text=gettextRcmdr("Confidence Level:  "), fg="blue"), confidenceField, sticky="w")
    tkgrid(alternativeFrame, sticky="w")
    tkgrid(confidenceFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=5, columns=1)
    }

BartlettTest <- function(){
    initializeDialog(title=gettextRcmdr("Bartlett's Test"))
    variableFrame <- tkframe(top)
    groupBox <- variableListBox(variableFrame, Factors(), title=gettextRcmdr("Groups (pick one)"))
    responseBox <- variableListBox(variableFrame, Numeric(), title=gettextRcmdr("Response Variable (pick one)"))
    onOK <- function(){
        group <- getSelection(groupBox)
        if (length(group) == 0) {
            errorCondition(recall=BartlettTest, message=gettextRcmdr("You must select a groups variable."))
            return()
            }
        response <- getSelection(responseBox)
        if (length(response) == 0) {
            errorCondition(recall=BartlettTest, message=gettextRcmdr("You must select a response variable."))
            return()
            }
        closeDialog()
        .activeDataSet <- ActiveDataSet()
        doItAndPrint(paste("tapply(", paste(.activeDataSet, "$", response, sep=""),
            ", ", paste(.activeDataSet, "$", group, sep=""), ", var, na.rm=TRUE)", sep=""))
        doItAndPrint(paste("bartlett.test(", response, " ~ ", group, ", data=",
            .activeDataSet, ")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="bartlett.test")
    tkgrid(getFrame(groupBox), labelRcmdr(variableFrame, text="    "), getFrame(responseBox), sticky="nw")
    tkgrid(variableFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=2, columns=1)
    }

LeveneTest <- function(){
    require("car")
    initializeDialog(title=gettextRcmdr("Levene's Test"))
    variableFrame <- tkframe(top)
    groupBox <- variableListBox(variableFrame, Factors(), title=gettextRcmdr("Groups (pick one)"))
    responseBox <- variableListBox(variableFrame, Numeric(), title=gettextRcmdr("Response Variable (pick one)"))
	radioButtons(name="center", buttons=c("median", "mean"), 
			labels=c(gettextRcmdr("median"), gettextRcmdr("mean")), title=gettextRcmdr("Center"))
    onOK <- function(){
        group <- getSelection(groupBox)
		center <- as.character(tclvalue(centerVariable))
        if (length(group) == 0) {
            errorCondition(recall=LeveneTest, message=gettextRcmdr("You must select a groups variable."))
            return()
            }
        response <- getSelection(responseBox)
        if (length(response) == 0) {
            errorCondition(recall=LeveneTest, message=gettextRcmdr("You must select a response variable."))
            return()
            }
        closeDialog()
        .activeDataSet <- ActiveDataSet()
        doItAndPrint(paste("tapply(", paste(.activeDataSet, "$", response, sep=""),
            ", ", paste(.activeDataSet, "$", group, sep=""), ", var, na.rm=TRUE)", sep=""))
        doItAndPrint(paste("leveneTest(", paste(.activeDataSet, "$", response, sep=""), 
            ", ", paste(.activeDataSet, "$", group, sep=""), ", center=", center, ")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="leveneTest")
    tkgrid(getFrame(groupBox), labelRcmdr(variableFrame, text="    "), getFrame(responseBox), sticky="nw")
    tkgrid(variableFrame, sticky="w")
	tkgrid(centerFrame, sticky="nw")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=3, columns=1)
    }
#line 1 "d:/Rcompile/CRANpkg/local/2.11/Rcmdr/R/utilities.R"
# last modified 19 November 2010 by J. Fox + slight changes 12 Aug 04 by Ph. Grosjean

# utility functions

# listing objects etc.

listDataSets <- function(envir=.GlobalEnv, ...) {
	Vars <- ls(envir = envir, all.names = TRUE) # + PhG
	if (length(Vars) == 0) return(Vars) # + PhG
#    names(which(sapply(Vars, function(.x) is.data.frame(eval(parse(text=.x), envir=envir))))) # + PhG
	names(which(sapply(Vars, function(.x) is.data.frame(get(.x, envir=envir)))))
}

listLinearModels <- function(envir=.GlobalEnv, ...) {
	objects <- ls(envir=envir, ...)
	if (length(objects) == 0) NULL
	else objects[sapply(objects,
#        function(.x) "lm" == (class(eval(parse(text=.x), envir=envir))[1]))]
				function(.x) "lm" == (class(get(.x, envir=envir))[1]))]
}

listAOVModels <- function(envir=.GlobalEnv, ...) {
	objects <- ls(envir=envir, ...)
	if (length(objects) == 0) NULL
	else objects[sapply(objects,
				function(.x) "aov" == (class(get(.x, envir=envir))[1]))]
}

listGeneralizedLinearModels <- function(envir=.GlobalEnv, ...) {
	objects <- ls(envir=envir, ...)
	if (length(objects) == 0) NULL
	else objects[sapply(objects,
#        function(.x) "glm" == (class(eval(parse(text=.x), envir=envir))[1]))]
				function(.x) "glm" == (class(get(.x, envir=envir))[1]))]
}

listMultinomialLogitModels <- function(envir=.GlobalEnv, ...) {
	objects <- ls(envir=envir, ...)
	if (length(objects) == 0) NULL
	else objects[sapply(objects,
#        function(.x) "multinom" == (class(eval(parse(text=.x), envir=envir))[1]))]
				function(.x) "multinom" == (class(get(.x, envir=envir))[1]))]
}

listProportionalOddsModels <- function(envir=.GlobalEnv, ...) {
	objects <- ls(envir=envir, ...)
	if (length(objects) == 0) NULL
	else objects[sapply(objects,
#        function(.x) "polr" == (class(eval(parse(text=.x), envir=envir))[1]))]
				function(.x) "polr" == (class(get(.x, envir=envir))[1]))]
}

listAllModels <- function(envir=.GlobalEnv, ...) {
	objects <- ls(envir=envir, ...)
	if (length(objects) == 0) NULL
	else objects[sapply(objects,
#        function(.x) (class(eval(parse(text=.x), envir=envir))[1])) %in% getRcmdr("modelClasses")]
				function(.x) (class(get(.x, envir=envir))[1])) %in% getRcmdr("modelClasses")]
}

activeDataSet <- function(dsname, flushModel=TRUE){
	.activeDataSet <- ActiveDataSet()
	if (missing(dsname)) {
		if (is.null(.activeDataSet)){
			Message(message=gettextRcmdr("There is no active data set."), type="error")
			return(FALSE)
		}
		else return(.activeDataSet)
	}
	if (!is.data.frame(ds <- get(dsname, envir=.GlobalEnv))){
		if (!exists.method("as.data.frame", ds, default=FALSE)){
			Message(message=paste(dsname, gettextRcmdr(" is not a data frame and cannot be attached."),
					sep=""), type="error")
			tkfocus(CommanderWindow())
			return()
		}
		command <- paste(dsname, " <- as.data.frame(", dsname, ")", sep="")
		justDoIt(command)
		logger(command)
		Message(message=paste(dsname, gettextRcmdr(" has been coerced to a data frame"), sep=""),
			type="warning")
	}
#    varnames <- names(eval(parse(text=dsname), envir=.GlobalEnv))
	varnames <- names(get(dsname, envir=.GlobalEnv))
	newnames <- make.names(varnames)
	badnames <- varnames != newnames
	if (any(badnames)){
		command <- paste("names(", dsname, ") <- make.names(names(",
			dsname, "))", sep="")
		doItAndPrint(command)
	}
	if (!is.null(.activeDataSet) && getRcmdr("attach.data.set")
		&& (length(grep(.activeDataSet, search())) !=0)) {
		detach(pos = match(.activeDataSet, search()))
		logger(paste("detach(", .activeDataSet, ")", sep=""))
	}
	if (flushModel) {
		putRcmdr(".activeModel", NULL)
		RcmdrTclSet("modelName", gettextRcmdr("<No active model>"))
		if (!is.SciViews()) tkconfigure(getRcmdr("modelLabel"), foreground="red") else refreshStatus()
	}
	# -PhG tkconfigure(.modelLabel, foreground="red")
	ActiveDataSet(dsname)
	Message(sprintf(gettextRcmdr("The dataset %s has %d rows and %d columns."), dsname,
			#      nrow(eval(parse(text=dsname))), ncol(eval(parse(text=dsname)))), type="note")
			nrow(get(dsname, envir=.GlobalEnv)), ncol(get(dsname, envir=.GlobalEnv))), type="note")
	if (any(badnames)) Message(message=paste(dsname, gettextRcmdr(" contains non-standard variable names:\n"),
				paste(varnames[badnames], collapse=", "),
				gettextRcmdr("\nThese have been changed to:\n"), paste(newnames[badnames], collapse=", "),
				sep=""), type="warning")
	Variables(listVariables())
	Numeric(listNumeric())
	Factors(listFactors())
	TwoLevelFactors(listTwoLevelFactors())
	RcmdrTclSet("dataSetName", paste(" ", dsname, " "))
	# -PhG tkconfigure(.dataSetLabel, foreground="blue")
	if (!is.SciViews()) tkconfigure(getRcmdr("dataSetLabel"), foreground="blue") else refreshStatus() # +PhG
	if (getRcmdr("attach.data.set")){
		attach(get(dsname, envir=.GlobalEnv), name=dsname)
		logger(paste("attach(", dsname, ")", sep=""))
	}
	if (is.SciViews()) refreshStatus() else if (flushModel) tkconfigure(getRcmdr("modelLabel"), foreground="red") # +PhG (& J.Fox, 25Dec04)
	activateMenus()
	dsname
}


activeModel <- function(model){
	if (missing(model)) {
		.activeModel <- ActiveModel()
		if (is.null(.activeModel)){
			Message(message=gettextRcmdr("There is no active model."), type="error")
			return(FALSE)
		}
		else return(.activeModel)
	}
	ActiveModel(model)
	RcmdrTclSet("modelName", paste(" ", model, " "))
	# -PhG tkconfigure(.modelLabel, foreground="blue")
	if (!is.SciViews()) tkconfigure(getRcmdr("modelLabel"), foreground="blue") else refreshStatus() # +PhG
	activateMenus()
	model
}

listVariables <- function(dataSet=ActiveDataSet()) {
#    vars <- eval(parse(text=paste("names(", dataSet,")")), envir=.GlobalEnv)
	vars <- names(get(dataSet, envir=.GlobalEnv))
	if (getRcmdr("sort.names")) sortVarNames(vars) else vars
}

listFactors <- function(dataSet=ActiveDataSet()) {
	variables <- if (exists("variables", envir=RcmdrEnv())) getRcmdr("variables") else listVariables(dataSet)
	variables[sapply(variables, function(.x)
#        is.factor(eval(parse(text=.x), envir=eval(parse(text=dataSet), envir=.GlobalEnv))))]
				is.factor(eval(parse(text=.x), envir=get(dataSet, envir=.GlobalEnv))))]
}

listTwoLevelFactors <- function(dataSet=ActiveDataSet()){
	factors <- listFactors(dataSet)
	if(length(factors) == 0) return(NULL)
	factors[sapply(factors, function(.x)
#        2 == length(levels(eval(parse(text=.x), envir=eval(parse(text=dataSet),
#            envir=.GlobalEnv)))))]
				2 == length(levels(eval(parse(text=.x), envir=get(dataSet, envir=.GlobalEnv)))))]
}

listNumeric <- function(dataSet=ActiveDataSet()) {
	variables <- if (exists("variables", envir=RcmdrEnv())) getRcmdr("variables") else listVariables(dataSet)
	variables[sapply(variables,function(.x)
#        is.numeric(eval(parse(text=.x), envir=eval(parse(text=dataSet), envir=.GlobalEnv))))]
				is.numeric(eval(parse(text=.x), envir=get(dataSet, envir=.GlobalEnv))))]
}

trim.blanks <- function(text){
	gsub("^\ *", "", gsub("\ *$", "", text))
}

is.valid.name <- function(x){
	length(x) == 1 && is.character(x) && x == make.names(x)
}


# statistical

colPercents <- function(tab, digits=1){
	dim <- length(dim(tab))
	if (is.null(dimnames(tab))){
		dims <- dim(tab)
		dimnames(tab) <- lapply(1:dim, function(i) 1:dims[i])
	}
	sums <- apply(tab, 2:dim, sum)
	per <- apply(tab, 1, function(x) x/sums)
	dim(per) <- dim(tab)[c(2:dim,1)]
	per <- aperm(per, c(dim, 1:(dim-1)))
	dimnames(per) <- dimnames(tab)
	per <- round(100*per, digits)
	result <- abind(per, Total=apply(per, 2:dim, sum), Count=sums, along=1)
	names(dimnames(result)) <- names(dimnames(tab))
	result
}

rowPercents <- function(tab, digits=1){
	dim <- length(dim(tab))
	if (dim == 2) return(t(colPercents(t(tab), digits=digits)))
	tab <- aperm(tab, c(2,1,3:dim))
	aperm(colPercents(tab, digits=digits), c(2,1,3:dim))
}

totPercents <- function(tab, digits=1){
	dim <- length(dim(tab))
	if (is.null(dimnames(tab))){
		dims <- dim(tab)
		dimnames(tab) <- lapply(1:dim, function(i) 1:dims[i])
	}
	tab <- 100*tab/sum(tab)
	tab <- cbind(tab, rowSums(tab))
	tab <- rbind(tab, colSums(tab))
	rownames(tab)[nrow(tab)] <- "Total"
	colnames(tab)[ncol(tab)] <- "Total"
	round(tab, digits=digits)
}

reliability <- function(S){
	reliab <- function(S, R){
		k <- dim(S)[1]
		ones <- rep(1, k)
		v <- as.vector(ones %*% S %*% ones)
		alpha <- (k/(k - 1)) * (1 - (1/v)*sum(diag(S)))
		rbar <- mean(R[lower.tri(R)])
		std.alpha <- k*rbar/(1 + (k - 1)*rbar)
		c(alpha=alpha, std.alpha=std.alpha)
	}
	result <- list()
	if ((!is.numeric(S)) || !is.matrix(S) || (nrow(S) != ncol(S))
		|| any(abs(S - t(S)) > max(abs(S))*1e-10) || nrow(S) < 2)
		stop(gettextRcmdr("argument must be a square, symmetric, numeric covariance matrix"))
	k <- dim(S)[1]
	s <- sqrt(diag(S))
	R <- S/(s %o% s)
	rel <- reliab(S, R)
	result$alpha <- rel[1]
	result$st.alpha <- rel[2]
	if (k < 3) {
		warning(gettextRcmdr("there are fewer than 3 items in the scale"))
		return(invisible(NULL))
	}
	rel <- matrix(0, k, 3)
	for (i in 1:k) {
		rel[i, c(1,2)] <- reliab(S[-i, -i], R[-i, -i])
		a <- rep(0, k)
		b <- rep(1, k)
		a[i] <- 1
		b[i] <- 0
		cov <- a %*% S %*% b
		var <- b %*% S %*% b
		rel[i, 3] <- cov/(sqrt(var * S[i,i]))
	}
	rownames(rel) <- rownames(S)
	colnames(rel) <- c("Alpha", "Std.Alpha", "r(item, total)")
	result$rel.matrix <- rel
	class(result) <- "reliability"
	result
}

print.reliability <- function(x, digits=4, ...){
	cat(paste("Alpha reliability = ", round(x$alpha, digits), "\n"))
	cat(paste("Standardized alpha = ", round(x$st.alpha, digits), "\n"))
	cat("\nReliability deleting each item in turn:\n")
	print(round(x$rel.matrix, digits))
	invisible(x)
}

partial.cor <- function(X, ...){
	R <- cor(X, ...)
	RI <- solve(R)
	D <- 1/sqrt(diag(RI))
	R <- - RI * (D %o% D)
	diag(R) <- 0
	rownames(R) <- colnames(R) <- colnames(X)
	R
}

Confint <- function(object, parm, level=0.95, ...) UseMethod("Confint")

Confint.default <- function(object, parm, level = 0.95, ...) {
	ci <- confint(object, parm, level, ...)
	ci <- cbind(coef(object), ci)
	colnames(ci)[1] <- "Estimate"
	ci
}

Confint.glm <- function (object, parm, level=0.95, type=c("LR", "Wald"), ...){
	# adapted from stats:::confint.lm
	type <- match.arg(type)
	cf <- coef(object)
	pnames <- names(cf)
	if (type == "LR") 
		ci <- (MASS:::confint.glm(object, parm, level, ...))
	else {
		if (missing(parm))
			parm <- seq(along = pnames)
		else if (is.character(parm))
			parm <- match(parm, pnames, nomatch = 0)
		a <- (1 - level)/2
		a <- c(a, 1 - a)
		pct <- paste(round(100 * a, 1), "%")
		ci <- array(NA, dim = c(length(parm), 2), dimnames = list(pnames[parm],
				pct))
		ses <- sqrt(diag(vcov(object)))[parm]
		fac <- qnorm(a)
		ci[] <- cf[parm] + ses %o% fac
	}
	ci <- cbind(cf, ci)
	colnames(ci)[1] <- "Estimate"
	fam <- family(object)
	if (fam$family == "binomial" && fam$link == "logit"){
		expci <- exp(ci)
		colnames(expci)[1] <- "exp(Estimate)"
		ci <- cbind(ci, expci)
	}
	ci
}

confint.polr <- function (object, parm, level=0.95, ...){
	# adapted from stats:::confint.lm
	cf <- coef(object)
	pnames <- names(cf)
	if (missing(parm))
		parm <- seq(along = pnames)
	else if (is.character(parm))
		parm <- match(parm, pnames, nomatch = 0)
	a <- (1 - level)/2
	a <- c(a, 1 - a)
	pct <- paste(round(100 * a, 1), "%")
	ci <- array(NA, dim = c(length(parm), 2), dimnames = list(pnames[parm],
			pct))
	ses <- sqrt(diag(vcov(object)))[parm]
	fac <- qnorm(a)
	ci[] <- cf[parm] + ses %o% fac
	ci
}

confint.multinom <- function (object, parm, level=0.95, ...){
	# adapted from stats:::confint.lm
	require("abind")
	cf <- coef(object)
	if (is.vector(cf)) cf <- matrix(cf, nrow=1,
			dimnames=list(object$lev[2], names(cf)))
	pnames <- colnames(cf)
	if (missing(parm))
		parm <- seq(along = pnames)
	else if (is.character(parm))
		parm <- match(parm, pnames, nomatch = 0)
	a <- (1 - level)/2
	a <- c(a, 1 - a)
	ses <- matrix(sqrt(diag(vcov(object))),
		ncol=ncol(cf), byrow=TRUE)[,parm, drop=FALSE]
	cf <- cf[,parm, drop=FALSE]
	fac <- qnorm(a)
	ci <- abind(cf + fac[1]*ses, cf + fac[2]*ses, along=3)
	dimnames(ci)[[3]] <- paste(round(100 * a, 1), "%")
	aperm(ci, c(2,3,1))
}

Confint.multinom <- function(object, parm, level = 0.95, ...) confint (object, parm=parm, level=0.95, ...)

numSummary <- function(data, statistics=c("mean", "sd", "quantiles"),
	quantiles=c(0, .25, .5, .75, 1), groups){
	if(!require(abind)) stop("abind package missing")
	data <- as.data.frame(data)
	if (!missing(groups)) groups <- as.factor(groups)
	variables <- names(data)
	statistics <- match.arg(statistics, c("mean", "sd", "quantiles"),
		several.ok=TRUE)
	ngroups <- if(missing(groups)) 1 else length(grps <- levels(groups))
	quantiles <- if ("quantiles" %in% statistics) quantiles else NULL
	quants <- if (length(quantiles) > 1) paste(100*quantiles, "%", sep="")
		else NULL
	nquants <- length(quants)
	stats <- c(c("mean", "sd")[c("mean", "sd") %in% statistics], quants)
	nstats <- length(stats)
	nvars <- length(variables)
	result <- list()
	if ((ngroups == 1) && (nvars == 1) && (length(statistics) == 1)){
		if (statistics == "quantiles")
			table <- quantile(data[,variables], probs=quantiles, na.rm=TRUE)
		else {
			table <- do.call(statistics, list(x=data[,variables], na.rm=TRUE))
			names(table) <- statistics
		}
		NAs <- sum(is.na(data[,variables]))
		n <- nrow(data) - NAs
		result$type <- 1
	}
	else if ((ngroups > 1)  && (nvars == 1) && (length(statistics) == 1)){
		if (statistics == "quantiles"){
			table <- matrix(unlist(tapply(data[, variables], groups,
						quantile, probs=quantiles, na.rm=TRUE)), ngroups, nquants,
				byrow=TRUE)
			rownames(table) <- grps
			colnames(table) <- quants
		}
		else table <- tapply(data[,variables], groups, statistics,
				na.rm=TRUE)
		NAs <- tapply(data[, variables], groups, function(x)
				sum(is.na(x)))
		n <- table(groups) - NAs
		result$type <- 2
	}
	else if ((ngroups == 1) ){
		table <- matrix(0, nvars, nstats)
		rownames(table) <- if (length(variables) > 1) variables else ""
		colnames(table) <- stats
		if ("mean" %in% stats) table[,"mean"] <- mean(data[, variables],
				na.rm=TRUE)
		if ("sd" %in% stats) table[,"sd"] <- sd(data[, variables], na.rm=TRUE)
		if ("quantiles" %in% statistics){
			table[,quants] <- t(apply(data[, variables, drop=FALSE], 2, quantile,
					probs=quantiles, na.rm=TRUE))
		}
		NAs <- colSums(is.na(data[,variables, drop=FALSE]))
		n <- nrow(data) - NAs
		result$type <- 3
	}
	else {
		table <- array(0, c(ngroups, nstats, nvars),
			dimnames=list(Group=grps, Statistic=stats, Variable=variables))
		NAs <- matrix(0, nvars, ngroups)
		rownames(NAs) <- variables
		colnames(NAs) <- grps
		for (variable in variables){
			if ("mean" %in% stats)
				table[, "mean", variable] <- tapply(data[, variable],
					groups, mean, na.rm=TRUE)
			if ("sd" %in% stats)
				table[, "sd", variable] <- tapply(data[, variable],
					groups, sd, na.rm=TRUE)
			if ("quantiles" %in% statistics) {
				res <- matrix(unlist(tapply(data[, variable], groups,
							quantile, probs=quantiles, na.rm=TRUE)), ngroups, nquants,
					byrow=TRUE)
				table[, quants, variable] <- res
			}
			NAs[variable,] <- tapply(data[, variable], groups, function(x)
					sum(is.na(x)))
		}
		if (nstats == 1) table <- table[,1,]
		if (nvars == 1) table <- table[,,1]
		n <- table(groups)
		n <- matrix(n, nrow=nrow(NAs), ncol=ncol(NAs), byrow=TRUE)
		n <- n - NAs
		result$type <- 4
	}
	result$table <- table
	result$statistics <- statistics
	result$n <- n
	if (any(NAs > 0)) result$NAs <- NAs
	class(result) <- "numSummary"
	result
}

print.numSummary <- function(x, ...){
	NAs <- x$NAs
	table <- x$table
	n <- x$n
	statistics <- x$statistics
	switch(x$type,
		"1" = {
			if (!is.null(NAs)) {
				table <- c(table, n, NAs)
				names(table)[length(table) - 1:0] <- c("n", "NA")
			}
			print(table)
		},
		"2" = {
			if (statistics == "quantiles") {
				table <- cbind(table, n)
				colnames(table)[ncol(table)] <- "n"
				if (!is.null(NAs)) {
					table <- cbind(table, NAs)
					colnames(table)[ncol(table)] <- "NA"
				}
			}
			else {
				table <- rbind(table, n)
				rownames(table)[c(1, nrow(table))] <- c(statistics, "n")
				if (!is.null(NAs)) {
					table <- rbind(table, NAs)
					rownames(table)[nrow(table)] <- "NA"
				}
				table <- t(table)
			}
			print(table)
		},
		"3" = {
			table <- cbind(table, n)
			colnames(table)[ncol(table)] <- "n"
			if (!is.null(NAs)) {
				table <- cbind(table, NAs)
				colnames(table)[ncol(table)] <- "NA"
			}
			print(table)
		},
		"4" = {
			if (length(dim(table)) == 2){
				table <- cbind(table, t(n))
				colnames(table)[ncol(table)] <- "n"
				if (!is.null(NAs)) {
					table <- cbind(table, t(NAs))
					colnames(table)[ncol(table)] <- "NA"
				}
				print(table)
			}
			else {
				table <- abind(table, t(n), along=2)
				dimnames(table)[[2]][dim(table)[2]] <- "n"
				if (!is.null(NAs)) {
					table <- abind(table, t(NAs), along=2)
					dimnames(table)[[2]][dim(table)[2]] <- "NA"
				}
				nms <- dimnames(table)[[3]]
				for (name in nms){
					cat("\nVariable:", name, "\n")
					print(table[,,name])
				}
			}
		}
	)
	invisible(x)
}

stepwise <- function(mod, 
	direction=c("backward/forward", "forward/backward", "backward", "forward"), 
	criterion=c("BIC", "AIC"), ...){
	if (!require(MASS)) stop("MASS package not available")
	criterion <- match.arg(criterion)
	cat("\nDirection: ", direction)
	cat("\nCriterion: ", criterion, "\n\n")
	k <- if (criterion == "BIC") log(nrow(model.matrix(mod))) else 2
	rhs <- paste(c("~", deparse(formula(mod)[[3]])), collapse="")
	rhs <- gsub(" ", "", rhs)
	if (direction == "forward" || direction == "forward/backward")
		mod <- update(mod, . ~ 1)
	if (direction == "backward/forward" || direction == "forward/backward") direction <- "both"
	lower <- ~ 1
	upper <- eval(parse(text=rhs))   
	stepAIC(mod, scope=list(lower=lower, upper=upper), direction=direction, k=k, ...)
}

# wrapper function for histograms

Hist <- function(x, scale=c("frequency", "percent", "density"), xlab=deparse(substitute(x)), 
	ylab=scale, main="", ...){
	xlab # evaluate
	x <- na.omit(x)
	scale <- match.arg(scale)
	if (scale == "frequency") hist(x, xlab=xlab, ylab=ylab, main=main, ...)
	else if (scale == "density") hist(x, freq=FALSE, xlab=xlab, ylab=ylab, main=main, ...)
	else {
		n <- length(x)
		hist(x, axes=FALSE, xlab=xlab, ylab=ylab, main=main, ...)
		axis(1)
		max <- ceiling(10*par("usr")[4]/n)
		at <- if (max <= 3) (0:(2*max))/20
			else (0:max)/10
		axis(2, at=at*n, labels=at*100)
	}
	box()
	abline(h=0)
	invisible(NULL)
}

plotMeans <- function(response, factor1, factor2, error.bars = c("se", "sd", "conf.int", "none"),
	level=0.95, xlab=deparse(substitute(factor1)), ylab=paste("mean of", deparse(substitute(response))),
	legend.lab=deparse(substitute(factor2)), main="Plot of Means",
	pch=1:n.levs.2, lty=1:n.levs.2, col=palette(), ...){
	if (!is.numeric(response)) stop(gettextRcmdr("Argument response must be numeric."))
	xlab # force evaluation
	ylab
	legend.lab
	error.bars <- match.arg(error.bars)
	if (missing(factor2)){
		if (!is.factor(factor1)) stop(gettextRcmdr("Argument factor1 must be a factor."))
		valid <- complete.cases(factor1, response)
		factor1 <- factor1[valid]
		response <- response[valid]
		means <- tapply(response, factor1, mean)
		sds <- tapply(response, factor1, sd)
		ns <- tapply(response, factor1, length)
		if (error.bars == "se") sds <- sds/sqrt(ns)
		if (error.bars == "conf.int") sds <- qt((1 - level)/2, df=ns - 1, lower.tail=FALSE) * sds/sqrt(ns)
		sds[is.na(sds)] <- 0
		yrange <-  if (error.bars != "none") c( min(means - sds, na.rm=TRUE), max(means + sds, na.rm=TRUE)) else range(means, na.rm=TRUE)
		levs <- levels(factor1)
		n.levs <- length(levs)
		plot(c(1, n.levs), yrange, type="n", xlab=xlab, ylab=ylab, axes=FALSE, main=main, ...)
		points(1:n.levs, means, type="b", pch=16, cex=2)
		box()
		axis(2)
		axis(1, at=1:n.levs, labels=levs)
		if (error.bars != "none") arrows(1:n.levs, means - sds, 1:n.levs, means + sds,
				angle=90, lty=2, code=3, length=0.125)
	}
	else {
		if (!(is.factor(factor1) | is.factor(factor2))) stop(gettextRcmdr("Arguments factor1 and factor2 must be factors."))
		valid <- complete.cases(factor1, factor2, response)
		factor1 <- factor1[valid]
		factor2 <- factor2[valid]
		response <- response[valid]
		means <- tapply(response, list(factor1, factor2), mean)
		sds <- tapply(response, list(factor1, factor2), sd)
		ns <- tapply(response, list(factor1, factor2), length)
		if (error.bars == "se") sds <- sds/sqrt(ns)
		if (error.bars == "conf.int") sds <- qt((1 - level)/2, df=ns - 1, lower.tail=FALSE) * sds/sqrt(ns)
		sds[is.na(sds)] <- 0
		yrange <-  if (error.bars != "none") c( min(means - sds, na.rm=TRUE), max(means + sds, na.rm=TRUE)) else range(means, na.rm=TRUE)
		levs.1 <- levels(factor1)
		levs.2 <- levels(factor2)
		n.levs.1 <- length(levs.1)
		n.levs.2 <- length(levs.2)
		if (length(pch) == 1) pch <- rep(pch, n.levs.2)
		if (length(col) == 1) col <- rep(col, n.levs.2)
		if (length(lty) == 1) lty <- rep(lty, n.levs.2)
		if (n.levs.2 > length(col)) stop(sprintf(gettextRcmdr("Number of groups for factor2, %d, exceeds number of distinct colours, %d."), n.levs.2, length(col)))		
		plot(c(1, n.levs.1 * 1.4), yrange, type="n", xlab=xlab, ylab=ylab, axes=FALSE, main=main, ...)
		box()
		axis(2)
		axis(1, at=1:n.levs.1, labels=levs.1)
		for (i in 1:n.levs.2){
			points(1:n.levs.1, means[, i], type="b", pch=pch[i], cex=2, col=col[i], lty=lty[i])
			if (error.bars != "none") arrows(1:n.levs.1, means[, i] - sds[, i],
					1:n.levs.1, means[, i] + sds[, i], angle=90, code=3, col=col[i], lty=lty[i], length=0.125)
		}
		x.posn <- n.levs.1 * 1.1
		y.posn <- sum(c(0.1, 0.9) * par("usr")[c(3,4)])
		text(x.posn, y.posn, legend.lab, adj=c(0, -.5))
		legend(x.posn, y.posn, levs.2, pch=pch, col=col, lty=lty)
	}
	invisible(NULL)
}

bin.var <- function (x, bins=4, method=c("intervals", "proportions", "natural"), labels=FALSE){
	method <- match.arg(method)
# Author: Dan Putler (revision by J. Fox, 5 Dec 04)
	if(length(x) < bins) {
		stop(gettextRcmdr("The number of bins exceeds the number of data values"))
	}
	x <- if(method == "intervals") cut(x, bins, labels=labels)
		else if (method == "proportions") cut(x, quantile(x, probs=seq(0,1,1/bins), na.rm=TRUE),
				include.lowest = TRUE, labels=labels)
		else {
			xx <- na.omit(x)
			breaks <- c(min(xx), tapply(xx, KMeans(xx, bins)$cluster, max))
			cut(x, breaks, include.lowest=TRUE, labels=labels)
		}
	as.factor(x)
}

# the following function is adapted from a suggestion by Robert Muenchen

#rcorr.adjust <- function(x, type=c("pearson", "spearman")){
#	require("Hmisc")
#	type <- match.arg(type)
#	x <- as.matrix(na.omit(x))
#	R <- rcorr(x, type=type)
#	P <- R$P
#	p <- P[lower.tri(P)]
#	adj.p <- p.adjust(p, method="holm")
#	P[lower.tri(P)] <- adj.p
#	P[upper.tri(P)] <- 0
#	P <- P + t(P)
#	P <- ifelse(P < 1e-04, 0, P)
#	P <- format(round(P, 4))
#	P[grep("NA", P)] <- ""
#	print(R)
#	cat("\n Adjusted p-values (Holm's method)\n")
#	print(P, quote = FALSE)
#	R$adj.P <- P
#	return(invisible(R))
#}

rcorr.adjust <- function(x, type=c("pearson", "spearman")){
	require("Hmisc")
	type <- match.arg(type)
	x <- as.matrix(na.omit(x))
	R <- rcorr(x, type=type)
	P <- R$P
	p <- P[lower.tri(P)]
	adj.p <- p.adjust(p, method="holm")
	P[lower.tri(P)] <- adj.p
	P[upper.tri(P)] <- 0
	P <- P + t(P)
	P <- ifelse(P < 1e-04, 0, P)
	P <- format(round(P, 4))
	P[grep("NA", P)] <- ""
	res <- list(R=R, P=P)
	class(res) <- "rcorr.adjust"
	res
}

print.rcorr.adjust <- function(x, ...){
	print(x$R)
	cat("\n Adjusted p-values (Holm's method)\n")
	print(x$P, quote = FALSE)
}

# Pager

# this is slightly modified from tkpager to use the Rcmdr monospaced font
#   and a white background

RcmdrPager <- function (file, header, title, delete.file)
{
	title <- paste(title, header)
	for (i in seq(along = file)) {
		zfile <- file[[i]]
		tt <- tktoplevel()
		tkwm.title(tt, if (length(title))
					title[(i - 1)%%length(title) + 1]
				else "")
		txt <- tktext(tt, bg = "white", font = getRcmdr("logFont"))
		scr <- ttkscrollbar(tt, command = function(...) tkyview(txt,
					...))
		tkconfigure(txt, yscrollcommand = function(...) tkset(scr,
					...))
		tkpack(txt, side = "left", fill = "both", expand = TRUE)
		tkpack(scr, side = "right", fill = "y")
		chn <- tcl("open", zfile)
		tkinsert(txt, "end", gsub("_\b", "", tclvalue(tcl("read",
						chn))))
		tcl("close", chn)
		tkconfigure(txt, state = "disabled")
		tkmark.set(txt, "insert", "0.0")
		tkfocus(txt)
		if (delete.file)
			tcl("file", "delete", zfile)
	}
}

# help functions



#helpCommander <- function() {
#    if (as.numeric(R.Version()$major) >= 2) print(help(gettextRcmdr("Commander")))
#    else help(gettextRcmdr("Commander"))
#    }

helpCommander <- function() {
	PDF <- file.access(paste(file.path(.path.package(package="Rcmdr")[1], "doc"), 
			"/", gettextRcmdr("Commander"), ".pdf", sep=""), mode=4)
	if (PDF == 0){
		browseURL(paste(file.path(.path.package(package="Rcmdr")[1], "doc"),
				"/", gettextRcmdr("Commander"), ".pdf", sep=""))
	} 
	else if (as.numeric(R.Version()$major) >= 2) print(help(gettextRcmdr("Commander")))
	else help(gettextRcmdr("Commander"))
}

helpAboutCommander <- function() {
	if (as.numeric(R.Version()$major) >= 2) print(help("Rcmdr"))
	else help("Rcmdr")
}

browseManual <- function() {
	browseURL(paste(file.path(.path.package(package="Rcmdr")[1], "doc"),
			"/", gettextRcmdr("Getting-Started-with-the-Rcmdr"), ".pdf", sep=""))
}



# functions for building dialog boxes

# the following function is slightly modified from Thomas Lumley,
#   "Programmer's Niche: Macros in R," R-News, Sept. 2001, Vol. 1, No. 3, pp.11-13.
defmacro <- function(..., expr){
	expr <- substitute(expr)
	len <- length(expr)
	expr[3:(len+1)] <- expr[2:len]
	## delete "macro" variables starting in ..
	expr[[2]] <- quote(on.exit(remove(list=objects(pattern="^\\.\\.", all.names=TRUE))))
	a <- substitute(list(...))[-1]
	## process the argument list
	nn <- names(a)
	if (is.null(nn)) nn <- rep("", length(a))
	for (i in seq(length.out=length(a))){
		if (nn[i] == "") {
			nn[i] <- paste(a[[i]])
			msg <- paste(a[[i]], gettext("not supplied", domain="R-Rcmdr"))
			a[[i]] <- substitute(stop(foo), list(foo = msg))
		}
	}
	names(a) <- nn
	a <- as.list(a)
	ff <- eval(substitute(
			function(){
				tmp <- substitute(body)
				eval(tmp, parent.frame())
			},
			list(body = expr)))
	## add the argument list
	formals(ff) <- a
	## create a fake source attribute
	mm <- match.call()
	mm$expr <- NULL
	mm[[1]] <- as.name("macro")
	expr[[2]] <- NULL # get "local" variable removal out of source
	attr(ff, "source") <- c(deparse(mm), deparse(expr))
	## return the macro
	ff
}

OKCancelHelp <- defmacro(window=top, helpSubject=NULL, model=FALSE,
	expr={
		buttonsFrame <- tkframe(window, borderwidth=5)
		OKbutton <- buttonRcmdr(buttonsFrame, text=gettextRcmdr("OK"), foreground="darkgreen", width="12", command=onOK, default="active",
			borderwidth=3)
		onCancel <- function() {
			if (model) putRcmdr("modelNumber", getRcmdr("modelNumber") - 1)
			if (GrabFocus()) tkgrab.release(window)
			tkdestroy(window)
			tkfocus(CommanderWindow())
		}
		cancelButton <- buttonRcmdr(buttonsFrame, text=gettextRcmdr("Cancel"), foreground="red", width="12", command=onCancel, borderwidth=3)
		if (!is.null(helpSubject)){
			onHelp <- function() {
				if (GrabFocus() && .Platform$OS.type != "windows") tkgrab.release(window)
				if (as.numeric(R.Version()$major) >= 2) print(help(helpSubject))
				else help(helpSubject)
			}
			helpButton <- buttonRcmdr(buttonsFrame, text=gettextRcmdr("Help"), width="12", command=onHelp, borderwidth=3)
		}
		tkgrid(OKbutton, labelRcmdr(buttonsFrame, text="  "), cancelButton, labelRcmdr(buttonsFrame, text="            "),
			if (!is.null(helpSubject)) helpButton, sticky="w")
	})

subOKCancelHelp <- defmacro(window=subdialog, helpSubject=NULL,
	expr={
		subButtonsFrame <- tkframe(window, borderwidth=5)
		subOKbutton <- buttonRcmdr(subButtonsFrame, text=gettextRcmdr("OK"), foreground="darkgreen", width="12", command=onOKsub, default="active",
			borderwidth=3)
		onCancelSub <- function() {
			if (GrabFocus()) tkgrab.release(window)
			tkdestroy(window)
			tkfocus(CommanderWindow())
		}
		subCancelButton <- buttonRcmdr(subButtonsFrame, text=gettextRcmdr("Cancel"), foreground="red", width="12", command=onCancelSub,
			borderwidth=3)
		if (!is.null(helpSubject)){
			onHelpSub <- function(){
				if (GrabFocus() && .Platform$OS.type != "windows") tkgrab.release(window)
				if (as.numeric(R.Version()$major) >= 2) print(help(helpSubject))
				else help(helpSubject)
			}
			subHelpButton <- buttonRcmdr(subButtonsFrame, text=gettextRcmdr("Help"), width="12", command=onHelpSub, borderwidth=3)
		}
		tkgrid(subOKbutton, labelRcmdr(subButtonsFrame, text="  "), subCancelButton,
			labelRcmdr(subButtonsFrame, text="            "), if (!is.null(helpSubject)) subHelpButton, sticky="w")
	})

checkActiveDataSet <- function(){
	if (activeDataSet() == FALSE) {
		tkfocus(CommanderWindow())
		FALSE
	}
	else TRUE
}

checkActiveModel <- function(){
	if (activeModel() == FALSE) {
		tkfocus(CommanderWindow())
		FALSE
	}
	else TRUE
}

checkFactors <- function(n=1){
	if (length(Factors()) < n){
		if (n > 1)
			Message(message=sprintf(gettextRcmdr("There fewer than %d factors in the active data set."), n),
				type="error")
		else Message(message=gettextRcmdr("There are no factors in the active data set."),
				type="error")
		tkfocus(CommanderWindow())
		FALSE
	}
	else TRUE
}

checkTwoLevelFactors <- function(n=1){
	if (length(TwoLevelFactors()) < n){
		if (n > 1)
			Message(message=sprintf(gettextRcmdr("There fewer than %d two-level factors in the active data set."), n),
				type="error")
		else Message(message=gettextRcmdr("There are no two-level factors in the active data set."),
				type="error")
		tkfocus(CommanderWindow())
		FALSE
	}
	else TRUE
}

checkNumeric <- function(n=1){
	if (length(Numeric()) < n){
		if (n > 1)
			Message(message=sprintf(gettextRcmdr("There fewer than %d numeric variables in the active data set."), n),
				type="error")
		else Message(message=gettextRcmdr("There are no numeric variables in the active data set."),
				type="error")
		tkfocus(CommanderWindow())
		FALSE
	}
	else TRUE
}

checkVariables <- function(n=1){
	if (length(Variables()) < n){
		if (n > 1)
			Message(message=sprintf(gettextRcmdr("There fewer than %d variables in the active data set."), n),
				type="error")
		else Message(message=gettextRcmdr("There are no variables in the active data set."),
				type="error")
		tkfocus(CommanderWindow())
		FALSE
	}
	else TRUE
}

commanderPosition <- function (){
	ID <- CommanderWindow()$ID
	as.numeric(c(tclvalue(.Tcl(paste("winfo rootx", ID))),
			tclvalue(.Tcl(paste("winfo rooty", ID)))))
}

initializeDialog <- defmacro(window=top, title="", offset=10, preventCrisp=FALSE,
	expr={
		if ((!preventCrisp) && getRcmdr("crisp.dialogs")) tclServiceMode(on=FALSE)
		window <- tktoplevel(borderwidth=10)
#        tkwm.withdraw(window)
		tkwm.title(window, title)
		position <- if (is.SciViews()) -1 else commanderPosition() # +PhG
		position <- if (any(position < 0)) "-50+50"
			else paste("+", paste(offset + position, collapse="+"), sep="")
		tkwm.geometry(window, position)
	}
)

closeDialog <- defmacro(window=top, release=TRUE,
	expr={
		if (release && GrabFocus()) tkgrab.release(window)
		tkdestroy(window)
	}
)

dialogSuffix <- defmacro(window=top, onOK=onOK, onCancel=onCancel, rows=1, columns=1, focus=top,
	bindReturn=TRUE, preventGrabFocus=FALSE, preventDoubleClick=FALSE,
	preventCrisp=FALSE,
	expr={
		for (row in 0:(rows-1)) tkgrid.rowconfigure(window, row, weight=0)
		for (col in 0:(columns-1)) tkgrid.columnconfigure(window, col, weight=0)
		.Tcl("update idletasks")
		tkwm.resizable(window, 0, 0)
		if (bindReturn) tkbind(window, "<Return>", onOK)
		tkbind(window, "<Escape>", onCancel)
		if (getRcmdr("double.click") && (!preventDoubleClick)) tkbind(window, "<Double-ButtonPress-1>", onOK)
		tkwm.deiconify(window)
		# focus grabs appear to cause problems for some dialogs
		if (GrabFocus() && (!preventGrabFocus)) tkgrab.set(window)
		tkfocus(focus)
		tkwait.window(window)
		if ((!preventCrisp) && getRcmdr("crisp.dialogs")) tclServiceMode(on=TRUE)
	}
)

variableListBox <- function(parentWindow, variableList=Variables(), bg="white",
	selectmode="single", export="FALSE", initialSelection=NULL, listHeight=getRcmdr("variable.list.height"), title){
	if (selectmode == "multiple") selectmode <- getRcmdr("multiple.select.mode")
	if (length(variableList) == 1 && is.null(initialSelection)) initialSelection <- 0
	frame <- tkframe(parentWindow)
	minmax <- getRcmdr("variable.list.width")
	listbox <- tklistbox(frame, height=min(listHeight, length(variableList)),
		selectmode=selectmode, background=bg, exportselection=export, 
		width=min(max(minmax[1], nchar(variableList)), minmax[2]))
	scrollbar <- ttkscrollbar(frame, command=function(...) tkyview(listbox, ...))
	tkconfigure(listbox, yscrollcommand=function(...) tkset(scrollbar, ...))
	for (var in variableList) tkinsert(listbox, "end", var)
	if (is.numeric(initialSelection)) for (sel in initialSelection) tkselection.set(listbox, sel)
	firstChar <- tolower(substr(variableList, 1, 1))
	len <- length(variableList)
	onLetter <- function(letter){
		letter <- tolower(letter)
		current <- 1 + round(as.numeric(unlist(strsplit(tclvalue(tkyview(listbox) ), " "))[1])*len)
		mat <- match(letter, firstChar[-(1:current)])
		if (is.na(mat)) return()
		tkyview.scroll(listbox, mat, "units")
	}
	onA <- function() onLetter("a")
	onB <- function() onLetter("b")
	onC <- function() onLetter("c")
	onD <- function() onLetter("d")
	onE <- function() onLetter("e")
	onF <- function() onLetter("f")
	onG <- function() onLetter("g")
	onH <- function() onLetter("h")
	onI <- function() onLetter("i")
	onJ <- function() onLetter("j")
	onK <- function() onLetter("k")
	onL <- function() onLetter("l")
	onM <- function() onLetter("m")
	onN <- function() onLetter("n")
	onO <- function() onLetter("o")
	onP <- function() onLetter("p")
	onQ <- function() onLetter("q")
	onR <- function() onLetter("r")
	onS <- function() onLetter("s")
	onT <- function() onLetter("t")
	onU <- function() onLetter("u")
	onV <- function() onLetter("v")
	onW <- function() onLetter("w")
	onX <- function() onLetter("x")
	onY <- function() onLetter("y")
	onZ <- function() onLetter("z")
	for (letter in c(letters, LETTERS)){
		tkbind(listbox, paste("<", letter, ">", sep=""),
			get(paste("on", toupper(letter), sep="")))
	}
	onClick <- function() tkfocus(listbox)
	toggleSelection <- function(){
		active <- tclvalue(tkindex(listbox, "active"))
		selected <- tclvalue(tkcurselection(listbox))
		if (selected == active) tkselection.clear(listbox, "active") else tkselection.set(listbox, "active")
	}
	tkbind(listbox, "<ButtonPress-1>", onClick)
	if (selectmode == "single") tkbind(listbox, "<Control-ButtonPress-1>", toggleSelection)
	tkgrid(labelRcmdr(frame, text=title, foreground="blue"), columnspan=2, sticky="w")
	tkgrid(listbox, scrollbar, sticky="nw")
	tkgrid.configure(scrollbar, sticky="wns")
	tkgrid.configure(listbox, sticky="ew")
	result <- list(frame=frame, listbox=listbox, scrollbar=scrollbar,
		selectmode=selectmode, varlist=variableList)
	class(result) <- "listbox"
	result
}

getSelection <- function(object) UseMethod("getSelection")

getSelection.listbox <- function(object){
	object$varlist[as.numeric(tkcurselection(object$listbox)) + 1]
}

getFrame <- function(object) UseMethod("getFrame")

getFrame.listbox <- function(object){
	object$frame
}

#radioButtons <- defmacro(window=top, name, buttons, values=NULL, initialValue=..values[1], labels, title,
#    expr={
#        ..values <- if (is.null(values)) buttons else values
#        ..frame <- paste(name, "Frame", sep="")
#        assign(..frame, tkframe(window))
#        ..variable <- paste(name, "Variable", sep="")
#        assign(..variable, tclVar(initialValue))
#        tkgrid(labelRcmdr(eval(parse(text=..frame)), text=title, foreground="blue"), columnspan=2, sticky="w")
#        for (i in 1:length(buttons)) {
#            ..button <- paste(buttons[i], "Button", sep="")
#            assign(..button,
#                ttkradiobutton(eval(parse(text=..frame)), variable=eval(parse(text=..variable)), value=..values[i]))
#            tkgrid(labelRcmdr(eval(parse(text=..frame)), text=labels[i], justify="left"), eval(parse(text=..button)), sticky="w")
#            }
#        }
#    )

# This function modified based on code by Liviu Andronic (13 Dec 09):
radioButtons <- defmacro(window=top, name, buttons, values=NULL, initialValue=..values[1], labels, 
	title="", title.color="blue", right.buttons=TRUE,
	expr={
		..values <- if (is.null(values)) buttons else values
		..frame <- paste(name, "Frame", sep="")
		assign(..frame, tkframe(window))
		..variable <- paste(name, "Variable", sep="")
		assign(..variable, tclVar(initialValue))
		if(title != ""){
			tkgrid(labelRcmdr(eval(parse(text=..frame)), text=title, foreground=title.color), columnspan=2, sticky="w")
		}
		for (i in 1:length(buttons)) {
			..button <- paste(buttons[i], "Button", sep="")
			assign(..button,
				ttkradiobutton(eval(parse(text=..frame)), variable=eval(parse(text=..variable)), value=..values[i]))
			if (right.buttons) tkgrid(labelRcmdr(eval(parse(text=..frame)), text=labels[i], justify="left"), eval(parse(text=..button)), sticky="w")
			else  tkgrid(eval(parse(text=..button)), labelRcmdr(eval(parse(text=..frame)), text=labels[i], justify="left"), sticky="w")
		}
	}
)


checkBoxes <- defmacro(window=top, frame, boxes, initialValues=NULL, labels, title=NULL,
	expr={
		..initialValues <- if (is.null(initialValues)) rep("1", length(boxes)) else initialValues
		assign(frame, tkframe(window))
		if (!is.null(title)) tkgrid(labelRcmdr(eval(parse(text=frame)), text=title, foreground="blue"))
		..variables <- paste(boxes, "Variable", sep="")
		for (i in 1:length(boxes)) {
			assign(..variables[i], tclVar(..initialValues[i]))
			..checkBox <- paste(boxes[i], "CheckBox", sep="")
			assign(..checkBox,
				tkcheckbutton(eval(parse(text=frame)), variable=eval(parse(text=..variables[i]))))
			tkgrid(labelRcmdr(eval(parse(text=frame)), text=labels[i]), eval(parse(text=..checkBox)), sticky="w")
		}
	}
)

checkReplace <- function(name, type=gettextRcmdr("Variable")){
	RcmdrTkmessageBox(message=sprintf(gettextRcmdr("%s %s already exists.\nOverwrite %s?"),
			type, name, tolower(type)), icon="warning", type="yesno", default="no")
}

errorCondition <- defmacro(window=top, recall=NULL, message, model=FALSE,
	expr={
		if (model) putRcmdr("modelNumber", getRcmdr("modelNumber") - 1)
		if (GrabFocus()) tkgrab.release(window)
		tkdestroy(window)
		Message(message=message, type="error")
		if (!is.null(recall)) recall()
		else tkfocus(CommanderWindow())
	})

subsetBox <- defmacro(window=top, model=FALSE,
	expr={
		subsetVariable <- if (model){
				if (currentModel && currentFields$subset != "")
					tclVar(currentFields$subset) else tclVar(gettextRcmdr("<all valid cases>"))
			}
			else tclVar(gettextRcmdr("<all valid cases>"))
		subsetFrame <- tkframe(window)
		subsetEntry <- ttkentry(subsetFrame, width="20", textvariable=subsetVariable)
		subsetScroll <- ttkscrollbar(subsetFrame, orient="horizontal",
			command=function(...) tkxview(subsetEntry, ...))
		tkconfigure(subsetEntry, xscrollcommand=function(...) tkset(subsetScroll, ...))
		tkgrid(labelRcmdr(subsetFrame, text=gettextRcmdr("Subset expression"), foreground="blue"), sticky="w")
		tkgrid(subsetEntry, sticky="w")
		tkgrid(subsetScroll, sticky="ew")
	})

groupsBox <- defmacro(recall=NULL, label=gettextRcmdr("Plot by:"), initialLabel=gettextRcmdr("Plot by groups"),
	plotLinesByGroup=FALSE, positionLegend=FALSE, plotLinesByGroupsText=gettextRcmdr("Plot lines by group"),
	expr={
		env <- environment()
		.groups <- FALSE
		.linesByGroup <- FALSE
		.groupsLabel <- tclVar(paste(initialLabel, "...", sep=""))
		.factors <- Factors()
		onGroups <- function(){
			if (length(.factors) == 0){
				errorCondition(recall=recall, message=gettextRcmdr("There are no factors in the active data set."))
				return()
			}
			initializeDialog(subdialog, title=gettextRcmdr("Groups"))
			groupsBox <- variableListBox(subdialog, .factors, title=gettextRcmdr("Groups variable (pick one)"))
			if (plotLinesByGroup){
				linesByGroupFrame <- tkframe(subdialog)
				linesByGroup <- tclVar("1")
				linesCheckBox <- tkcheckbutton(linesByGroupFrame, variable=linesByGroup)
				tkgrid(labelRcmdr(linesByGroupFrame, text=plotLinesByGroupsText), linesCheckBox, sticky="w")
			}
			onOKsub <- function() {
				groups <- getSelection(groupsBox)
				if (length(groups) == 0){
					assign(".groups", FALSE, envir=env)
					tclvalue(.groupsLabel) <- paste(initialLabel, "...", sep="")
					tkconfigure(groupsButton, foreground="black")
					if (GrabFocus()) tkgrab.release(subdialog)
					tkdestroy(subdialog)
					tkwm.deiconify(top)
					if (GrabFocus()) tkgrab.set(top)
					tkfocus(top)
					tkwait.window(top)
					return()
				}
				assign(".groups", groups, envir=env)
				tclvalue(.groupsLabel) <- paste(label, groups)
				tkconfigure(groupsButton, foreground="blue")
				if (plotLinesByGroup) {
					lines <- as.character("1" == tclvalue(linesByGroup))
					assign(".linesByGroup", lines, envir=env)
				}
				if (GrabFocus()) tkgrab.release(subdialog)
				tkdestroy(subdialog)
				tkwm.deiconify(top)
				if (GrabFocus()) tkgrab.set(top)
				tkfocus(top)
				tkwait.window(top)
			}
			subOKCancelHelp()
			tkgrid(getFrame(groupsBox), sticky="nw")
			if (plotLinesByGroup) tkgrid(linesByGroupFrame, sticky="w")
			tkgrid(subButtonsFrame, sticky="w")
			if (positionLegend) tkgrid(labelRcmdr(subdialog, text=gettextRcmdr("Position legend with mouse click"), fg="blue"))
			dialogSuffix(subdialog, onOK=onOKsub, rows=3+plotLinesByGroup+positionLegend, columns=2, focus=subdialog)
		}
		groupsFrame <- tkframe(top)
		groupsButton <- tkbutton(groupsFrame, textvariable=.groupsLabel, command=onGroups, borderwidth=3)
		tkgrid(labelRcmdr(groupsFrame, text="    "), groupsButton, sticky="w")
	})

groupsLabel <- defmacro(frame=top, groupsBox=groupsBox, columnspan=1,
	expr={
		groupsFrame <- tkframe(frame)
		groupsLabel <- labelRcmdr(groupsFrame, text=gettextRcmdr("<No groups selected>"))
		tkgrid(labelRcmdr(groupsFrame, text=gettextRcmdr("Difference: "), fg="blue"), groupsLabel, sticky="w")
		tkgrid(groupsFrame, sticky="w", columnspan=columnspan)
		onSelect <- function(){
			group <- getSelection(groupsBox)
			levels <- eval(parse(text=paste("levels(", ActiveDataSet(), "$", group, ")", sep="")))
			tkconfigure(groupsLabel, text=paste(levels[1], "-", levels[2]))
		}
		tkbind(groupsBox$listbox, "<ButtonRelease-1>", onSelect)
	})

#modelFormula <- defmacro(frame=top, hasLhs=TRUE, expr={
#    checkAddOperator <- function(rhs){
#        rhs.chars <- rev(strsplit(rhs, "")[[1]])
#        if (length(rhs.chars) < 1) return(FALSE)
#        check.char <- if ((rhs.chars[1] != " ") || (length(rhs.chars) == 1))
#                rhs.chars[1] else rhs.chars[2]
#        !is.element(check.char, c("+", "*", ":", "/", "-", "^", "(", "%"))
#        }
#    .variables <- Variables()
#    word <- paste("\\[", gettextRcmdr("factor"), "\\]", sep="")
#    variables <- paste(.variables,
#        ifelse(is.element(.variables, Factors()), paste("[", gettextRcmdr("factor"), "]", sep=""), ""))
#    xBox <- variableListBox(frame, variables, title=gettextRcmdr("Variables (double-click to formula)"))
#    onDoubleClick <- if (!hasLhs){
#        function(){
#            var <- getSelection(xBox)
#            if (length(grep(word, var)) == 1) var <- sub(word, "",  var)
#            tkfocus(rhsEntry)
#            rhs <- tclvalue(rhsVariable)
#            rhs.chars <- rev(strsplit(rhs, "")[[1]])
#            check.char <- if (length(rhs.chars) > 0){
#                if ((rhs.chars[1] != " ") || (length(rhs.chars) == 1))
#                    rhs.chars[1] else rhs.chars[2]
#                }
#                else ""
#            tclvalue(rhsVariable) <- if (rhs == "" ||
#                is.element(check.char, c("+", "*", ":", "/", "-", "^", "(", "%")))
#                    paste(rhs, var, sep="")
#                else paste(rhs, "+", var)
#            tkicursor(rhsEntry, "end")
#            tkxview.moveto(rhsEntry, "1")
#            }
#        }
#    else{
#        function(){
#            var <- getSelection(xBox)
#            if (length(grep(word, var)) == 1) var <- sub(word, "",  var)
#            lhs <- tclvalue(lhsVariable)
#            if (lhs == "") tclvalue(lhsVariable) <- var
#            else {
#                tkfocus(rhsEntry)
#                rhs <- tclvalue(rhsVariable)
#                rhs.chars <- rev(strsplit(rhs, "")[[1]])
#                check.char <- if (length(rhs.chars) > 0){
#                    if ((rhs.chars[1] != " ") || (length(rhs.chars) == 1))
#                        rhs.chars[1] else rhs.chars[2]
#                    }
#                    else ""
#                tclvalue(rhsVariable) <- if (rhs == "" ||
#                    is.element(check.char, c("+", "*", ":", "/", "-", "^", "(", "%")))
#                        paste(rhs, var, sep="")
#                    else paste(rhs, "+", var)
#                }
#            tkicursor(rhsEntry, "end")
#            tkxview.moveto(rhsEntry, "1")
#            }
#        }
#    tkbind(xBox$listbox, "<Double-ButtonPress-1>", onDoubleClick)
#    onPlus <- function(){
#        rhs <- tclvalue(rhsVariable)
#        if (!checkAddOperator(rhs)) return()
#        tclvalue(rhsVariable) <- paste(rhs, "+ ")
#        tkicursor(rhsEntry, "end")
#        tkxview.moveto(rhsEntry, "1")
#        }
#    onTimes <- function(){
#        rhs <- tclvalue(rhsVariable)
#        if (!checkAddOperator(rhs)) return()
#        tclvalue(rhsVariable) <- paste(rhs, "*", sep="")
#        tkicursor(rhsEntry, "end")
#        tkxview.moveto(rhsEntry, "1")
#        }
#    onColon <- function(){
#        rhs <- tclvalue(rhsVariable)
#        if (!checkAddOperator(rhs)) return()
#        tclvalue(rhsVariable) <- paste(rhs, ":", sep="")
#        tkicursor(rhsEntry, "end")
#        tkxview.moveto(rhsEntry, "1")
#        }
#    onSlash <- function(){
#        rhs <- tclvalue(rhsVariable)
#        if (!checkAddOperator(rhs)) return()
#        tclvalue(rhsVariable) <- paste(rhs, "/",  sep="")
#        tkicursor(rhsEntry, "end")
#        tkxview.moveto(rhsEntry, "1")
#        }
#    onIn <- function(){
#        rhs <- tclvalue(rhsVariable)
#        if (!checkAddOperator(rhs)) return()
#        tclvalue(rhsVariable) <- paste(rhs, "%in% ")
#        tkicursor(rhsEntry, "end")
#        tkxview.moveto(rhsEntry, "1")
#        }
#    onMinus <- function(){
#        rhs <- tclvalue(rhsVariable)
#        if (!checkAddOperator(rhs)) return()
#        tclvalue(rhsVariable) <- paste(rhs, "- ")
#        tkicursor(rhsEntry, "end")
#        tkxview.moveto(rhsEntry, "1")
#        }
#    onPower <- function(){
#        rhs <- tclvalue(rhsVariable)
#        if (!checkAddOperator(rhs)) return()
#        tclvalue(rhsVariable) <- paste(rhs, "^", sep="")
#        tkicursor(rhsEntry, "end")
#        tkxview.moveto(rhsEntry, "1")
#        }
#    onLeftParen <- function(){
#        tkfocus(rhsEntry)
#        rhs <- tclvalue(rhsVariable)
#        tclvalue(rhsVariable) <- paste(rhs, "(", sep="")
#        tkicursor(rhsEntry, "end")
#        tkxview.moveto(rhsEntry, "1")
#        }
#    onRightParen <- function(){
#        rhs <- tclvalue(rhsVariable)
#        if (!checkAddOperator(rhs)) return()
#        tclvalue(rhsVariable) <- paste(rhs, ")", sep="")
#        tkicursor(rhsEntry, "end")
#        tkxview.moveto(rhsEntry, "1")
#        }
#    outerOperatorsFrame <- tkframe(frame)
#    operatorsFrame <- tkframe(outerOperatorsFrame)
#    plusButton <- buttonRcmdr(operatorsFrame, text="+", width="3", command=onPlus)
#    timesButton <- buttonRcmdr(operatorsFrame, text="*", width="3", command=onTimes)
#    colonButton <- buttonRcmdr(operatorsFrame, text=":", width="3", command=onColon)
#    slashButton <- buttonRcmdr(operatorsFrame, text="/", width="3", command=onSlash)
#    inButton <- buttonRcmdr(operatorsFrame, text="%in%", width="5", command=onIn)
#    minusButton <- buttonRcmdr(operatorsFrame, text="-", width="3", command=onMinus)
#    powerButton <- buttonRcmdr(operatorsFrame, text="^", width="3", command=onPower)
#    leftParenButton <- buttonRcmdr(operatorsFrame, text="(", width="3", command=onLeftParen)
#    rightParenButton <- buttonRcmdr(operatorsFrame, text=")", width="3", command=onRightParen)
#
#    tkgrid(plusButton, timesButton, colonButton, slashButton, inButton, minusButton,
#        powerButton, leftParenButton, rightParenButton, sticky="w")
#    formulaFrame <- tkframe(frame)
#    if (hasLhs){
#        tkgrid(labelRcmdr(outerOperatorsFrame, text=gettextRcmdr("Model Formula:     "), fg="blue"), operatorsFrame)
#        lhsVariable <- if (currentModel) tclVar(currentFields$lhs) else tclVar("")
#        rhsVariable <- if (currentModel) tclVar(currentFields$rhs) else tclVar("")
#        rhsEntry <- ttkentry(formulaFrame, width="50", textvariable=rhsVariable)
#        rhsXscroll <- ttkscrollbar(formulaFrame,
#            orient="horizontal", command=function(...) tkxview(rhsEntry, ...))
#        tkconfigure(rhsEntry, xscrollcommand=function(...) tkset(rhsXscroll, ...))
#        lhsEntry <- ttkentry(formulaFrame, width="10", textvariable=lhsVariable)
#        lhsScroll <- ttkscrollbar(formulaFrame,
#            orient="horizontal", command=function(...) tkxview(lhsEntry, ...))
#        tkconfigure(lhsEntry, xscrollcommand=function(...) tkset(lhsScroll, ...))
#        tkgrid(lhsEntry, labelRcmdr(formulaFrame, text=" ~    "), rhsEntry, sticky="w")
#        tkgrid(lhsScroll, labelRcmdr(formulaFrame, text=""), rhsXscroll, sticky="w")
#        tkgrid.configure(lhsScroll, sticky="ew")
#        }
#    else{
#        rhsVariable <- if (currentModel) tclVar(currentFields$rhs) else tclVar("")
#        rhsEntry <- ttkentry(formulaFrame, width="50", textvariable=rhsVariable)
#        rhsXscroll <- ttkscrollbar(formulaFrame,
#            orient="horizontal", command=function(...) tkxview(rhs, ...))
#        tkconfigure(rhsEntry, xscrollcommand=function(...) tkset(rhsXscroll, ...))
#        tkgrid(labelRcmdr(formulaFrame, text="   ~ "), rhsEntry, sticky="w")
#        tkgrid(labelRcmdr(formulaFrame, text=""), rhsXscroll, sticky="w")
#        }
#    tkgrid.configure(rhsXscroll, sticky="ew")
#    })

modelFormula <- defmacro(frame=top, hasLhs=TRUE, expr={
		checkAddOperator <- function(rhs){
			rhs.chars <- rev(strsplit(rhs, "")[[1]])
			if (length(rhs.chars) < 1) return(FALSE)
			check.char <- if ((rhs.chars[1] != " ") || (length(rhs.chars) == 1))
					rhs.chars[1] else rhs.chars[2]
			!is.element(check.char, c("+", "*", ":", "/", "-", "^", "(", "%"))
		}
		.variables <- Variables()
		word <- paste("\\[", gettextRcmdr("factor"), "\\]", sep="")
		variables <- paste(.variables,
			ifelse(is.element(.variables, Factors()), paste("[", gettextRcmdr("factor"), "]", sep=""), ""))
		xBox <- variableListBox(frame, variables, selectmode="multiple", title=gettextRcmdr("Variables (double-click to formula)"))
		onDoubleClick <- if (!hasLhs){
				function(){
					var <- getSelection(xBox)
					tkselection.clear(xBox$listbox, "0", "end")					
					if (length(grep(word, var)) == 1) var <- sub(word, "",  var)
					tkfocus(rhsEntry)
					rhs <- tclvalue(rhsVariable)
					rhs.chars <- rev(strsplit(rhs, "")[[1]])
					check.char <- if (length(rhs.chars) > 0){
							if ((rhs.chars[1] != " ") || (length(rhs.chars) == 1))
								rhs.chars[1] else rhs.chars[2]
						}
						else ""
					tclvalue(rhsVariable) <- if (rhs == "" ||
							is.element(check.char, c("+", "*", ":", "/", "-", "^", "(", "%")))
							paste(rhs, var, sep="")
						else paste(rhs, "+", var)
					tkicursor(rhsEntry, "end")
					tkxview.moveto(rhsEntry, "1")
				}
			}
			else{
				function(){
					var <- getSelection(xBox)
					which <- tkcurselection(xBox$listbox)
					tkselection.clear(xBox$listbox, "0", "end")
					if (length(grep(word, var)) == 1) var <- sub(word, "",  var)
					lhs <- tclvalue(lhsVariable)
					if (lhs == "" || tclvalue(tkselection.present(lhsEntry)) == "1"){
						tclvalue(lhsVariable) <- var
						tkselection.clear(lhsEntry)
						tkfocus(rhsEntry)
					}
					else {
						tkfocus(rhsEntry)
						rhs <- tclvalue(rhsVariable)
						rhs.chars <- rev(strsplit(rhs, "")[[1]])
						check.char <- if (length(rhs.chars) > 0){
								if ((rhs.chars[1] != " ") || (length(rhs.chars) == 1))
									rhs.chars[1] else rhs.chars[2]
							}
							else ""
						tclvalue(rhsVariable) <- if (rhs == "" ||
								is.element(check.char, c("+", "*", ":", "/", "-", "^", "(", "%")))
								paste(rhs, var, sep="")
							else paste(rhs, "+", var)
					}
					tkicursor(rhsEntry, "end")
					tkxview.moveto(rhsEntry, "1")
				}
			}
		tkbind(xBox$listbox, "<Double-ButtonPress-1>", onDoubleClick)
		onPlus <- function(){
			rhs <- tclvalue(rhsVariable)
			var <- getSelection(xBox)
			tkselection.clear(xBox$listbox, "0", "end")										
			if ((check <- !checkAddOperator(rhs)) && length(var) == 0) return()
			if (length(var) > 1){
				if (length(grep(word, var)) > 0) var <- sub(word, "",  var)
				if (length(var) > 1) var <- paste(var, collapse=" + ")
			}
			tclvalue(rhsVariable) <- paste(rhs, if (!check) " + ", var, sep="")
			tkicursor(rhsEntry, "end")
			tkxview.moveto(rhsEntry, "1")
		}
		onTimes <- function(){
			rhs <- tclvalue(rhsVariable)
			var <- getSelection(xBox)
			tkselection.clear(xBox$listbox, "0", "end")						
			if ((check <- !checkAddOperator(rhs)) && length(var) == 0) return()
			if (length(var) > 1){
				if (length(grep(word, var)) > 0) var <- sub(word, "",  var)
				var <- trim.blanks(var)
				if (length(var) > 1) var <- paste(var, collapse="*")
				tclvalue(rhsVariable) <- paste(rhs, if (!check) " + ", var, sep="")
			}
			else tclvalue(rhsVariable) <- paste(rhs, if (!check) "*", sep="")
			tkicursor(rhsEntry, "end")
			tkxview.moveto(rhsEntry, "1")
		}
		onColon <- function(){
			rhs <- tclvalue(rhsVariable)
			var <- getSelection(xBox)
			tkselection.clear(xBox$listbox, "0", "end")						
			if ((check <- !checkAddOperator(rhs)) && length(var) == 0) return()
			if (length(var) > 1){
				if (length(grep(word, var)) > 0) var <- sub(word, "",  var)
				var <- trim.blanks(var)
				if (length(var) > 1) var <- paste(var, collapse=":")
				tclvalue(rhsVariable) <- paste(rhs, if (!check) " + ", var, sep="")
			}
			else tclvalue(rhsVariable) <- paste(rhs, if (!check) ":", sep="")
			tkicursor(rhsEntry, "end")
			tkxview.moveto(rhsEntry, "1")
		}
		onSlash <- function(){
			rhs <- tclvalue(rhsVariable)
			if (!checkAddOperator(rhs)) return()
			tclvalue(rhsVariable) <- paste(rhs, "/",  sep="")
			tkicursor(rhsEntry, "end")
			tkxview.moveto(rhsEntry, "1")
		}
		onIn <- function(){
			rhs <- tclvalue(rhsVariable)
			if (!checkAddOperator(rhs)) return()
			tclvalue(rhsVariable) <- paste(rhs, "%in% ")
			tkicursor(rhsEntry, "end")
			tkxview.moveto(rhsEntry, "1")
		}
		onMinus <- function(){
			rhs <- tclvalue(rhsVariable)
			if (!checkAddOperator(rhs)) return()
			tclvalue(rhsVariable) <- paste(rhs, "- ")
			tkicursor(rhsEntry, "end")
			tkxview.moveto(rhsEntry, "1")
		}
		onPower <- function(){
			rhs <- tclvalue(rhsVariable)
			if (!checkAddOperator(rhs)) return()
			tclvalue(rhsVariable) <- paste(rhs, "^", sep="")
			tkicursor(rhsEntry, "end")
			tkxview.moveto(rhsEntry, "1")
		}
		onLeftParen <- function(){
			tkfocus(rhsEntry)
			rhs <- tclvalue(rhsVariable)
			tclvalue(rhsVariable) <- paste(rhs, "(", sep="")
			tkicursor(rhsEntry, "end")
			tkxview.moveto(rhsEntry, "1")
		}
		onRightParen <- function(){
			rhs <- tclvalue(rhsVariable)
			if (!checkAddOperator(rhs)) return()
			tclvalue(rhsVariable) <- paste(rhs, ")", sep="")
			tkicursor(rhsEntry, "end")
			tkxview.moveto(rhsEntry, "1")
		}
		outerOperatorsFrame <- tkframe(frame)
		operatorsFrame <- tkframe(outerOperatorsFrame)
		plusButton <- buttonRcmdr(operatorsFrame, text="+", width="3", command=onPlus)
		timesButton <- buttonRcmdr(operatorsFrame, text="*", width="3", command=onTimes)
		colonButton <- buttonRcmdr(operatorsFrame, text=":", width="3", command=onColon)
		slashButton <- buttonRcmdr(operatorsFrame, text="/", width="3", command=onSlash)
		inButton <- buttonRcmdr(operatorsFrame, text="%in%", width="5", command=onIn)
		minusButton <- buttonRcmdr(operatorsFrame, text="-", width="3", command=onMinus)
		powerButton <- buttonRcmdr(operatorsFrame, text="^", width="3", command=onPower)
		leftParenButton <- buttonRcmdr(operatorsFrame, text="(", width="3", command=onLeftParen)
		rightParenButton <- buttonRcmdr(operatorsFrame, text=")", width="3", command=onRightParen)
		
		tkgrid(plusButton, timesButton, colonButton, slashButton, inButton, minusButton,
			powerButton, leftParenButton, rightParenButton, sticky="w")
		formulaFrame <- tkframe(frame)
		if (hasLhs){
			tkgrid(labelRcmdr(outerOperatorsFrame, text=gettextRcmdr("Model Formula:     "), fg="blue"), operatorsFrame)
			lhsVariable <- if (currentModel) tclVar(currentFields$lhs) else tclVar("")
			rhsVariable <- if (currentModel) tclVar(currentFields$rhs) else tclVar("")
			rhsEntry <- ttkentry(formulaFrame, width="50", textvariable=rhsVariable)
			rhsXscroll <- ttkscrollbar(formulaFrame,
				orient="horizontal", command=function(...) tkxview(rhsEntry, ...))
			tkconfigure(rhsEntry, xscrollcommand=function(...) tkset(rhsXscroll, ...))
			lhsEntry <- ttkentry(formulaFrame, width="10", textvariable=lhsVariable)
			lhsScroll <- ttkscrollbar(formulaFrame,
				orient="horizontal", command=function(...) tkxview(lhsEntry, ...))
			tkconfigure(lhsEntry, xscrollcommand=function(...) tkset(lhsScroll, ...))
			tkgrid(lhsEntry, labelRcmdr(formulaFrame, text=" ~    "), rhsEntry, sticky="w")
			tkgrid(lhsScroll, labelRcmdr(formulaFrame, text=""), rhsXscroll, sticky="w")
			tkgrid.configure(lhsScroll, sticky="ew")
		}
		else{
			rhsVariable <- if (currentModel) tclVar(currentFields$rhs) else tclVar("")
			rhsEntry <- ttkentry(formulaFrame, width="50", textvariable=rhsVariable)
			rhsXscroll <- ttkscrollbar(formulaFrame,
				orient="horizontal", command=function(...) tkxview(rhsEntry, ...))
			tkconfigure(rhsEntry, xscrollcommand=function(...) tkset(rhsXscroll, ...))
			tkgrid(labelRcmdr(formulaFrame, text="   ~ "), rhsEntry, sticky="w")
			tkgrid(labelRcmdr(formulaFrame, text=""), rhsXscroll, sticky="w")
		}
		tkgrid.configure(rhsXscroll, sticky="ew")
	})

exists.method <- function(generic, object, default=TRUE, strict=FALSE){
	classes <- class(object)
	if (default) classes <- c(classes, "default")
	if (strict) classes <- classes[1]
	any(paste(generic, ".", classes, sep="") %in%
			as.character(methods(generic)))
}

checkMethod <- defmacro(generic, object, message=NULL, default=FALSE, strict=FALSE, reportError=TRUE,
	expr={
		msg <- if (is.null(message)) sprintf(gettextRcmdr("No appropriate %s method exists\nfor a model of this class."), generic)
			else message
#        method <- exists.method(generic, eval(parse(text=object)), default=default, strict=strict)
		method <- exists.method(generic, get(object), default=default, strict=strict)
		if ((!method) && reportError) Message(message=msg, type="error")
		method
	}
)

checkClass <- defmacro(object, class, message=NULL,
	expr={
		msg <- if (is.null(message)) sprintf(gettextRcmdr('The model is not of class "%s".'), class)
			else message
#       properClass <- eval(parse(text=paste("class(", object, ")")))[1] == class
		properClass <- class(get(object))[1] == class
		if (!properClass) Message(message=msg, type="error")
		properClass
	}
)


# the following function is from John Chambers (plus new test for R 2.4.0)

isS4object <- function(object) {
	if (getRversion() < "2.4.0"){
		if (length(attr(object, "class"))!= 1)
			return(FALSE)
		!isVirtualClass(getClass(class(object), TRUE))
	}
	else isS4(object)
}


#isS4object <- function(object) {
#    !(length(object) == 1 && class(object) == "character") &&  length(slotNames(object)) != 0
#    }

# the following three functions are slightly adapted with permission from Philippe Grosjean

RcmdrEnv <- function() {
	pos <-  match("RcmdrEnv", search())
	if (is.na(pos)) { # Must create it
		RcmdrEnv <- list()
		attach(RcmdrEnv, pos = length(search()) - 1)
		rm(RcmdrEnv)
		pos <- match("RcmdrEnv", search())
	}
	return(pos.to.env(pos))
}

putRcmdr <- function(x, value)
	assign(x, value, envir = RcmdrEnv())

getRcmdr <- function(x, mode="any")
	get(x, envir = RcmdrEnv(), mode = mode, inherits = FALSE)

RcmdrTclSet <- function(name, value){
	if (is.SciViews()) return()   # + PhG
	name <- ls(unclass(getRcmdr(name))$env)
	tcl("set", name, value)
}

# functions to store or retrieve Rcmdr state information

Variables <- function(names){
	if (missing(names)) getRcmdr("variables")
	else putRcmdr("variables", names)
}

Numeric <- function(names){
	if (missing(names)) getRcmdr("numeric")
	else putRcmdr("numeric", names)
}

Factors <- function(names){
	if (missing(names)) getRcmdr("factors")
	else putRcmdr("factors", names)
}

TwoLevelFactors <- function(names){
	if (missing(names)) getRcmdr("twoLevelFactors")
	else putRcmdr("twoLevelFactors", names)
}

# The following two functions were modified by Erich Neuwrith
#  and subsequently by John Fox (23 July 07)

ActiveDataSet <- function(name){
	if (missing(name)) {
		temp <- getRcmdr(".activeDataSet")
		if (is.null(temp))
			return(NULL)
		else
		if (!exists(temp) || !is.data.frame(get(temp,envir=.GlobalEnv))) {
			Message(sprintf(gettextRcmdr("the dataset %s is no longer available"),
					temp), type="error")
			putRcmdr(".activeDataSet", NULL)
			RcmdrTclSet("dataSetName", gettextRcmdr("<No active dataset>"))
			putRcmdr(".activeModel", NULL)
			RcmdrTclSet("modelName", gettextRcmdr("<No active model>"))
			if (!is.SciViews()) {
				tkconfigure(getRcmdr("dataSetLabel"), foreground="red") 
				tkconfigure(getRcmdr("modelLabel"), foreground="red") 
			} 
			else refreshStatus()
			activateMenus()
			if (getRcmdr("suppress.menus") && RExcelSupported()) return(NULL)
		}
		return(temp)
	}
	else putRcmdr(".activeDataSet", name)
}

ActiveModel <- function(name){
	if (missing(name)) {
		temp <- getRcmdr(".activeModel")
		if (is.null(temp))
			return(NULL)
		else
		if (!exists(temp) || !is.model(get(temp,envir=.GlobalEnv))) {
			Message(sprintf(gettextRcmdr("the model %s is no longer available"),
					temp), type="error")
			putRcmdr(".activeModel", NULL)
			RcmdrTclSet("modelName", gettextRcmdr("<No active model>"))
			if (!is.SciViews()) tkconfigure(getRcmdr("modelLabel"), foreground="red") else refreshStatus()
			activateMenus()
			return(NULL)
		}
		else return(temp)
	}
	else putRcmdr(".activeModel", name)
}

GrabFocus <- function(value){
	if (missing(value)) getRcmdr("grab.focus")
	else putRcmdr("grab.focus", value)
}

UpdateModelNumber <- function(increment=1){
	modelNumber <- getRcmdr("modelNumber")
	modelNumber <- modelNumber + increment
	if (modelNumber < 1) modelNumber <- 1 # sanity check
	putRcmdr("modelNumber", modelNumber)
}

CommanderWindow <- function() getRcmdr("commanderWindow")

LogWindow <- function() getRcmdr("logWindow")

OutputWindow <- function() getRcmdr("outputWindow")

MessagesWindow <- function() getRcmdr("messagesWindow")

# some predicates for the menu system

activeDataSetP <- function() !is.null(ActiveDataSet())

dataSetsP <- function(n=1){
	datasets <- listDataSets()
	(!is.null(datasets)) && length(datasets) >= n
}

numericP <- function(n=1) activeDataSetP() && length(listNumeric()) >= n

factorsP <- function(n=1) activeDataSetP() && length(listFactors()) >= n

twoLevelFactorsP <- function(n=1) activeDataSetP() && length(listTwoLevelFactors()) >= n

modelsP <- function(n=1) activeDataSetP() && length(listAllModels()) >= n

activeModelP <- function() !is.null(ActiveModel())

#lmP <- function() activeModelP() && eval(parse(text=paste("class(", ActiveModel(), ")[1] == 'lm'")))
lmP <- function() activeModelP() && any(class(get(ActiveModel()))[1] == c('lm', 'aov'))

#glmP <- function() activeModelP() && eval(parse(text=paste("class(", ActiveModel(), ")[1] == 'glm'")))
glmP <- function() activeModelP() && class(get(ActiveModel()))[1] == 'glm'

aicP <- function() activeModelP() && exists.method("extractAIC", get(ActiveModel()))

polrP <- function() activeModelP() && class(get(ActiveModel()))[1] == 'polr'

multinomP <- function() activeModelP() && class(get(ActiveModel()))[1] == 'multinom'

hclustSolutionsP <- function() length(listHclustSolutions()) > 0

MacOSXP <- function() {
	sys <- Sys.info()
	!is.null(sys) && length(grep("[Dd]arwin", sys["sysname"]) > 0)
}

packageAvailable <- function(name) 0 != length(.find.package(name, quiet=TRUE))

rglLoaded <- function() 0 != length(grep("^rgl", loadedNamespaces()))

activateMenus <- function(){
	if (getRcmdr("suppress.menus")) return()
	for (item in getRcmdr("Menus")){
		if (item$activation()) .Tcl(paste(item$ID, " entryconfigure ", item$position - 1," -state normal", sep=""))
		else .Tcl(paste(item$ID, " entryconfigure ", item$position - 1," -state disabled", sep=""))
	}
}


# for internationalization

gettextRcmdr <- function(...) gettext(..., domain="R-Rcmdr")

gettextMenus <- function(...){
	text <- gettextRcmdr(...)
	plugins <- getOption("Rcmdr")$plugins
	if (is.null(plugins)) return(text)
	plugins <- paste("R-", plugins, sep="")
	for (plugin in plugins){
		text <- gettext(text, domain=plugin)
	}
	text
}

English <- function() {
	env <- Sys.getenv()
	names(env) <- toupper(names(env))
	LANG <- env["LANGUAGE"]
	LC_CTYPE <- Sys.getlocale("LC_CTYPE")
	if (!is.na(LANG)) length(grep("^en", LANG, ignore.case=TRUE)) > 0
	else LC_CTYPE == "C" || length(grep("^en", LC_CTYPE, ignore.case=TRUE)) > 0
}


# to replace tkmessageBox on non-English Windows systems,
#  to allow for translation of button text

RcmdrTkmessageBox <- function(message, icon=c("info", "question", "warning",
		"error"), type=c("okcancel", "yesno", "ok"), default, title="") {
	if ( (English()) || (.Platform$OS.type != "windows") ){
		if (missing(default)){
			default <- switch(type,
				okcancel="ok",
				yesno="yes",
				ok="ok")}
		return(tkmessageBox(message=message, icon=icon, type=type,
				default=default, title=title))
	}
	icon <- match.arg(icon)
	type <- match.arg(type)
	initializeDialog(messageBox, title=title)
	messageFrame <- tkframe(messageBox, borderwidth=5)
	buttonFrame <- tkframe(messageBox,  borderwidth=5)
	if (icon != "question") tkbell()
	result <- tclVar()
	iconColor <- switch(icon, info="blue", question="blue", warning="black",
		error="red")
	onOK <- function() {
		if (GrabFocus()) tkgrab.release(messageBox)
		tkdestroy(messageBox)
		tkfocus(CommanderWindow())
		tclvalue(result) <- "ok"
	}
	OKbutton <- buttonRcmdr(buttonFrame, text=gettextRcmdr("OK"),
		foreground="darkgreen", width="12", command=onOK, borderwidth=3,
		default=if (missing(default)) "active"
			else if (default == "ok") "active" else "normal")
	onCancel <- function() {
		if (GrabFocus()) tkgrab.release(messageBox)
		tkdestroy(messageBox)
		tkfocus(CommanderWindow())
		tclvalue(result) <- "cancel"
	}
	cancelButton <- buttonRcmdr(buttonFrame, text=gettextRcmdr("Cancel"),
		foreground="red", width="12", command=onCancel, borderwidth=3,
		default=if (missing(default)) "normal"
			else if (default == "cancel") "active" else "normal")
	onYes <- function() {
		if (GrabFocus()) tkgrab.release(messageBox)
		tkdestroy(messageBox)
		tkfocus(CommanderWindow())
		tclvalue(result) <- "yes"
	}
	yesButton <- buttonRcmdr(buttonFrame, text=gettextRcmdr("Yes"),
		foreground="darkgreen", width="12", command=onYes, borderwidth=3,
		default=if (missing(default)) "active"
			else if (default == "yes") "active" else "normal")
	onNo <- function() {
		if (GrabFocus()) tkgrab.release(messageBox)
		tkdestroy(messageBox)
		tkfocus(CommanderWindow())
		tclvalue(result) <- "no"
	}
	noButton <- buttonRcmdr(buttonFrame, text=gettextRcmdr("No"),
		foreground="red", width="12", command=onNo, borderwidth=3,
		default=if (missing(default)) "normal"
			else if (default == "no") "active" else "normal")
	## FIXME -- left in old style
	tkgrid(tklabel(messageFrame, bitmap=icon, fg=iconColor),
		tklabel(messageFrame, text="    "),
		tklabel(messageFrame, text=message))
	tkgrid(messageFrame)
	switch(type,
		okcancel = {
			tkgrid(OKbutton, labelRcmdr(buttonFrame, text="    "), cancelButton)
			if (missing(default) || default == "ok") tkbind(messageBox, "<Return>",
					onOK)
			else if (default == "cancel") tkbind(messageBox, "<Return>", onCancel)
		},
		yesno =  {
			tkgrid(yesButton, labelRcmdr(buttonFrame, text="    "), noButton)
			if (missing(default) || default == "yes") tkbind(messageBox, "<Return>",
					onYes)
			else if (default == "no") tkbind(messageBox, "<Return>", onNo)
		},
		ok = {
			tkgrid(OKbutton)
			if (missing(default) || default == "ok") tkbind(messageBox, "<Return>",
					onOK)
		}
	)
	tkgrid(buttonFrame)
	dialogSuffix(messageBox, rows=2, focus=messageBox, bindReturn=FALSE)
	result
}

# The following function was contributed by Matthieu Lesnoff (added 20 July 06)

trim.col.na <- function(dat){
# Remove variables with only missing values (occurs sometimes with modified Excel file)
	colsup <- NULL
	for (i in 1:ncol(dat))
	{
		if (length(dat[is.na(dat[,i])==T,i]) ==length(dat[,i]))
			colsup <- c(colsup,i)
	}
	if (length(colsup) > 0)
		dat <- dat[,-colsup]
	dat
}

# check whether packages are available

packagesAvailable <- function(packages){
	sapply(sapply(packages, .find.package, quiet=TRUE),
		function(x) length(x) != 0)
}

# insert a row (or rows) in a matrix or data frame

insertRows <- function(object1, object2, where=NULL, ...){
	if (ncol(object1) != ncol(object2))
		stop(gettextRcmdr("objects have different numbers of columns"))
	if (!(TRUE == all.equal(colnames(object1), colnames(object2))))
		stop(gettextRcmdr("objects have different column names"))
	n <- nrow(object1)
	if (is.null(where) || where >= n) rbind(object1, object2)
	else if (where < 1) rbind(object2, object1)
	else rbind(object1[1:floor(where),], object2,
			object1[(floor(where) + 1):n,])
}

# functions for handling Rcmdr plug-in packages

##listPlugins <- function(loaded=FALSE){
##    availablePackages <- if (loaded) sort(.packages(all.available = TRUE))
##        else sort(setdiff(.packages(all.available = TRUE), .packages()))
##    plugins <- availablePackages[sapply(availablePackages,
##        function(package) file.exists(file.path(.find.package(package), "etc/menus.txt")))]
##    plugins
##    }

# the following function based on a suggestion by Brian Ripley

listPlugins <- function(loaded=FALSE){
	plugins <- unlist(lapply(.libPaths(),
			function(x) Sys.glob(file.path(x, "*/etc/menus.txt"))))
	plugins <- sub(".*/([^/]*)/etc/menus.txt", "\\1", plugins)
	if (loaded) plugins else sort(setdiff(plugins, .packages()))
}


loadPlugins <- function(){
	plugins <- listPlugins()
	initializeDialog(title=gettextRcmdr("Load Plug-ins"))
	packagesBox <- variableListBox(top, plugins, title=gettextRcmdr("Plug-ins (pick one or more)"),
		selectmode="multiple", listHeight=10)
	onOK <- function(){
		plugins <- getSelection(packagesBox)
		closeDialog(top)
		if (length(plugins) == 0){
			errorCondition(recall=loadPlugins, message=gettextRcmdr("You must select at least one plug-in."))
			return()
		}
		opts <- options("Rcmdr")
		opts$Rcmdr$plugins <- c(plugins, opts$Rcmdr$plugins)
		options(opts)
		for (plugin in plugins) {
			command <- paste('library("', plugin, '", character.only=TRUE)', sep="")
			justDoIt(command)
		}
		Message(paste(gettextRcmdr("Plug-ins loaded:"), paste(plugins, collapse=", ")), type="note")
		response <- tkmessageBox(message=paste(gettextRcmdr(
					"The plug-in(s) will not be available until the Commander is restarted.\nRestart now?")),
			icon="question", type="yesno")
		if (tclvalue(response) == "yes") {
			putRcmdr("autoRestart", TRUE)
			closeCommander(ask=FALSE)
			Commander()
		}
	}
	OKCancelHelp(helpSubject="Plugins")
	tkgrid(getFrame(packagesBox), sticky="nw")
	tkgrid(buttonsFrame, sticky="w")
	dialogSuffix(rows=1, columns=1)
}

# the following two functions contributed by Erich Neuwirth (added 22 July 07)

whitespaceonly <- function(str) sub('[[:space:]]+$', '', str) == ''

is.model <- function(object) {
	any(class(object) %in% getRcmdr("modelClasses"))
}

# the following lines, adding support for ttk widgets, adapted from code by Brian Ripley
if (!(as.character(tcl("info", "tclversion")) >= "8.5" && getRversion() >= "2.7.0")){
	buttonRcmdr <- tkbutton
	labelRcmdr <- tklabel
	ttkentry <- function(parent, ...) tkentry(parent, ...)
	ttkframe <- tkframe
	ttkradiobutton <- tkradiobutton
	ttkscrollbar <- function(...) tkscrollbar(..., repeatinterval=5)
} else {
	buttonRcmdr <- function(..., borderwidth, fg, foreground, relief) ttkbutton(...)
	labelRcmdr <- function(..., fg)
		if(missing(fg)) ttklabel(...) else ttklabel(..., foreground=fg)
}

# the following function alters the default behaviour of tclvalue() by trimming leading and trailing blanks

tclvalue <- function(x) trim.blanks(tcltk::tclvalue(x))

# the following function returns the number of observations for a statistical model

nobs <- function(model){
	fitted <- na.omit(fitted(model))
	if (is.matrix(fitted)) nrow(fitted) else length(fitted)
}

# the following function splits a character string at blanks and commas according to width

#splitCmd <- function(cmd, width=getOption("width") - 4, at="[ ,]"){
#	if (nchar(cmd) <= width) return(cmd)
#	where <- gregexpr(at, cmd)[[1]]
#	if (where[1] < 0) return(cmd)
#	singleQuotes <- gregexpr("'", cmd)[[1]]
#	doubleQuotes <- gregexpr('"', cmd)[[1]]
#	comment <- regexpr("#", cmd)
#	if (singleQuotes[1] > 0){
#		nquotes <- length(singleQuotes)
#		if (nquotes %% 2 != 0) stop("unbalanced quotes")
#		for (left in seq(1, nquotes, 2)){
#			where[(where > singleQuotes[left]) & (where < singleQuotes[left + 1])] <- NA
#		}
#		where <- na.omit(where)
#	}  
#	if (doubleQuotes[1] > 0){
#		nquotes <- length(doubleQuotes)
#		if (nquotes %% 2 != 0) stop("unbalanced quotes")
#		for (left in seq(1, nquotes, 2)){
#			where[(where > doubleQuotes[left]) & (where < doubleQuotes[left + 1])] <- NA
#		}
#		where <- na.omit(where)
#	}
#	if (comment > 0){
#		where[where > comment] <- NA
#		where <- na.omit(where)
#	}
#	if (length(where) == 0) return(cmd)
#	where2 <- where[where <= width]
#	where2 <- if (length(where2) == 0) where[1]
#		else where2[length(where2)]
#	paste(substr(cmd, 1, where2), "\n  ", 
#		Recall(substr(cmd, where2 + 1, nchar(cmd)), width, at), sep="")
#} 

splitCmd <- function(cmd, width=getOption("width") - 4, at="[ ,]"){
	if (nchar(cmd) <= width) return(cmd)
	where <- gregexpr(at, cmd)[[1]]
	if (where[1] < 0) return(cmd)
	singleQuotes <- gregexpr("'", cmd)[[1]]
	doubleQuotes <- gregexpr('"', cmd)[[1]]
	comment <- regexpr("#", cmd)
	if (singleQuotes[1] > 0 && (singleQuotes[1] < doubleQuotes[1] || doubleQuotes[1] < 0 ) && (singleQuotes[1] < comment[1] || comment[1] < 0 )){
		nquotes <- length(singleQuotes)
		if (nquotes < 2) stop("unbalanced quotes")
		where[(where > singleQuotes[1]) & (where < singleQuotes[2])] <- NA
		where <- na.omit(where)
	}  
	else if (doubleQuotes[1] > 0 && (doubleQuotes[1] < singleQuotes[1] || singleQuotes[1] < 0) && (doubleQuotes[1] < comment[1] || comment[1] < 0 )){
		nquotes <- length(doubleQuotes)
		if (nquotes < 2) stop("unbalanced quotes")
		where[(where > doubleQuotes[1]) & (where < doubleQuotes[2])] <- NA
		where <- na.omit(where)
	}
	else if (comment > 0){
		where[where > comment] <- NA
		where <- na.omit(where)
	}
	if (length(where) == 0) return(cmd)
	where2 <- where[where <= width]
	where2 <- if (length(where2) == 0) where[1]
		else where2[length(where2)]
	paste(substr(cmd, 1, where2), "\n  ", 
		Recall(substr(cmd, where2 + 1, nchar(cmd)), width, at), sep="")
} 

# the following function sorts names containing numerals "more naturally" than does sort()

sortVarNames <- function(x){
	sort.helper <- function(x){
		prefix <- strsplit(x, "[0-9]+")
		prefix <- sapply(prefix, "[", 1)
		prefix[is.na(prefix)] <- ""
		suffix <- strsplit(x, "[^0-9]+")
		suffix <- as.numeric(sapply(suffix, "[", 2))
		suffix[is.na(suffix)] <- -Inf
		remainder <- sub("[^0-9]+", "", x)
		remainder <- sub("[0-9]+", "", remainder)
		if (all (remainder == "")) list(prefix, suffix)
		else c(list(prefix, suffix), Recall(remainder))
	}
	ord <- do.call("order", sort.helper(x))
	x[ord]
}

# to load packages

Library <- function(package, pos=4){
	loaded <- search()
	loaded <- loaded[grep("^package:", loaded)]
	loaded <- sub("^package:", "", loaded)
	if (!getRcmdr("suppress.X11.warnings")){
		messages.connection <- file(open="w+")
		sink(messages.connection, type="message")
		on.exit({
				sink(type="message")
				close(messages.connection)
			})
	}
	if (!(package %in% loaded)){
		command <- paste("library(", package, ", pos=", pos, ")", sep="")
		logger(command)
		result <- try(eval(parse(text=command), envir=.GlobalEnv), silent=TRUE)
		if (class(result)[1] ==  "try-error"){
			Message(message=paste(strsplit(result, ":")[[1]][2]), type="error")
			tkfocus(CommanderWindow())
			return("error")
		}
		return(package)
	}
	else return(invisible(NULL))
}

# to merge data frames by rows

mergeRows <- function(X, Y, common.only=FALSE, ...){
	UseMethod("mergeRows")
}

mergeRows.data.frame <- function(X, Y, common.only=FALSE, ...){
	cols1 <- names(X)
	cols2 <- names(Y)
	if (common.only){
		common <- intersect(cols1, cols2)
		rbind(X[, common], Y[, common])
	}
	else {
		all <- union(cols1, cols2)
		miss1 <- setdiff(all, cols1)
		miss2 <- setdiff(all, cols2)
		X[, miss1] <- NA
		Y[, miss2] <- NA
		rbind(X, Y)
	}
}

# start help system

startHelp <- function(){
	Sys.sleep(2)
	help.start()
}
