.packageName <- "QCAGUI"
#line 1 "d:/RCompile/CRANpkg/local/2.13/QCAGUI/R/Recode.R"
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 <- tkentry(variablesFrame, width="20", textvariable=newVariableName)
    recodesFrame <- tkframe(top)
    recodes <- tktext(recodesFrame, bg="white", font=getRcmdr("logFont"),
        height="5", width="40", wrap="none")
    recodesXscroll <- tkscrollbar(recodesFrame, repeatinterval=5, orient="horizontal",
        command=function(...) tkxview(recodes, ...))
    recodesYscroll <- tkscrollbar(recodesFrame, repeatinterval=5,
        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=""))
            justDoIt(paste(dataSet,"$",newVar, " <- ", cmd, sep=""))
            activeDataSet(dataSet, flushModel=FALSE)
            tkfocus(CommanderWindow())
            }
        }
    OKCancelHelp(helpSubject="Recode")    
    tkgrid(getFrame(variablesBox), sticky="nw")
    tkgrid(tklabel(variablesFrame, text=""))
    tkgrid(tklabel(variablesFrame, 
        text=gettextRcmdr("New variable name or prefix for multiple recodes: ")),
        newVariable, sticky="w")
    tkgrid(tklabel(asFactorFrame, 
        text=gettextRcmdr("Make (each) new variable a factor")), asFactorCheckBox, 
        sticky="w")
    tkgrid(tklabel(asFactorFrame, text=""))
    tkgrid(tklabel(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)        
    }
#line 1 "d:/RCompile/CRANpkg/local/2.13/QCAGUI/R/Rexcel-specific.R"
# These functions for Excel supportwritten by Erich Neuwirth
#  last modified: 22 June 2007 by J. Fox

    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.13/QCAGUI/R/analyze-menu.R"
# last modified 26 May 2006 by A. Dusa

# Analyze menu dialogs

truth.table <- function() {
    require(QCA)
    dataSet <- activeDataSet()
    variableList <- eval(parse(text=paste("names(", dataSet,")")), envir=.GlobalEnv)
    if (getRcmdr("sort.names")) variableList <- sort(variableList)
    
    top <- tktoplevel()
    tkwm.title(top, "Analyze the truth table for the active dataset")
    
    onOK <- function() {
        showcases <- tclvalue(showcasesVariable) == "1"
        complete <- tclvalue(completeVariable) == "1"
        outcomeVar <- variableList[as.integer(tkcurselection(outcomeBox)) + 1]
        conditionsVar <- variableList[as.integer(tkcurselection(conditionsBox)) + 1]
        cndts <- paste('c("', paste(conditionsVar, collapse='", "'), '")', sep="")
        if (length(conditionsVar) > 0) {
            command <- paste('truthTable(', dataSet, ', outcome=', paste('"', outcomeVar, '"', sep=""),
            ', conditions=', cndts, ', show.cases=', showcases, ', complete=', complete, ')', sep="")
            } else {
            command <- paste('truthTable(', dataSet, ', outcome=', paste('"', outcomeVar, '"', sep=""),
                ', show.cases=', showcases, ', complete=', complete, ')', sep="")
            }
        doItAndPrint(command)
        tkdestroy(top)
        tkfocus(CommanderWindow())
        }
    
    top1 <- tkframe(top)
    
    top1Left <- tkframe(top1)
    outcomeBox <- tklistbox(top1Left, height=min(5, length(variableList)),
                            selectmode="single", background="white", exportselection=FALSE)
    scrollbarLeft <- tkscrollbar(top1Left, repeatinterval=5, command=function(...) tkyview(outcomeBox, ...))
    tkconfigure(outcomeBox, yscrollcommand=function(...) tkset(scrollbarLeft, ...))
    for (var in variableList) tkinsert(outcomeBox, "end", var)
    tkgrid(tklabel(top1Left, text="Select the outcome variable\n(only one)", fg="blue"), sticky="w")
    tkgrid(outcomeBox, scrollbarLeft, sticky="nw")
    tkgrid.configure(scrollbarLeft, sticky="wns")
    tkgrid.configure(outcomeBox, sticky="ew")
    
    top1Middle <- tkframe(top1)
    tkgrid(tklabel(top1Middle, text="  "))
    
    top1Right <- tkframe(top1)
    selectmodeRcmdr <- getRcmdr("multiple.select.mode")
    conditionsBox <- tklistbox(top1Right, height=min(5, length(variableList)),
                               selectmode=selectmodeRcmdr, background="white", exportselection=FALSE)
    scrollbarRight <- tkscrollbar(top1Right, repeatinterval=5, command=function(...) tkyview(conditionsBox, ...))
    tkconfigure(conditionsBox, yscrollcommand=function(...) tkset(scrollbarRight, ...))
    for (var in variableList) tkinsert(conditionsBox, "end", var)
    tkgrid(tklabel(top1Right, text="Select the conditions\n(two or more)", fg="blue"), sticky="w")
    tkgrid(conditionsBox, scrollbarRight, sticky="nw")
    tkgrid.configure(scrollbarRight, sticky="wns")
    tkgrid.configure(conditionsBox, sticky="ew")
    
    tkpack(top1Left, top1Middle, top1Right, side="left")
    
    top2 <- tkframe(top)
    
    tkgrid(tklabel(top2, text=" ")) # Blank line
    
    cbOptions <- c("showcases", "complete")
    cbLabels <- c("Show cases:", "Complete:")
    initialValues <- c(1, 0)
    
    for (i in 1:length(cbOptions)) {
        cbText <- paste(cbOptions[i], "Text", sep="")
        assign(cbText, tklabel(top2, text=cbLabels[i]))
        CheckBox <- paste(cbOptions[i], "CB", sep="")
        assign(CheckBox, tkcheckbutton(top2))
        cbVariable <- paste(cbOptions[i], "Variable", sep="")
        assign(cbVariable, tclVar(initialValues[i]))
        tkconfigure(get(CheckBox), variable=get(cbVariable))
        tkgrid(get(cbText), get(CheckBox), sticky="e")
        }
    
    tkgrid(tklabel(top2, text=" ")) # Blank line
    
    OKCancelHelp(helpSubject="truthTable")  
    
    tkpack(top1, top2, buttonsFrame, side="top")
    }




q.mc.c <- function() {
    require(QCA)
    dataSet <- activeDataSet()
    variableList <- eval(parse(text=paste("names(", dataSet,")")), envir=.GlobalEnv)
    if (getRcmdr("sort.names")) variableList <- sort(variableList)
    
    top <- tktoplevel()
    tkwm.title(top, "Perform the Quine-McCluskey minimization algorithm")
    
    onOK <- function(){
        eqmcc <- tclvalue(eqmccVariable) == "1"
        diffmat <- tclvalue(diffmatVariable) == "0"
        use.letters <- tclvalue(uselettersVariable) == "0"
        chart <- tclvalue(chartVariable) == "1"
        show.cases <- tclvalue(showcasesVariable) == "1"
        details <- tclvalue(detailsVariable) == "0"
        quiet <- tclvalue(quietVariable) == "1"
        if (quiet) details <- FALSE
        
        outcome1 <- as.character(tclvalue(outcome1Variable))
        outcome0 <- as.character(tclvalue(outcome0Variable))
        contradictions <- as.character(tclvalue(contradictionsVariable))
        remainders <- as.character(tclvalue(remaindersVariable))
        
        expl.1 <- expl.0 <- expl.ctr <- incl.1 <- incl.0 <- incl.ctr <- incl.rem <- FALSE
        
        checked <-  c("expl.1", "expl.0", "expl.ctr", "incl.1", "incl.0", "incl.ctr", "incl.rem",
                      "quiet", "chart", "show.cases")
        options1 <- c( expl.1,   expl.0,   expl.ctr,   incl.1,   incl.0,   incl.ctr,   incl.rem,
                       quiet,   chart,   show.cases)
        unchecked <- c("diffmat", "use.letters", "details")
        options2 <-   c( diffmat,   use.letters,   details)
        
        options1[c(1, 4, 2, 5, 3, 6)] <- c(sapply(c(outcome1, outcome0, contradictions),
                                              function(idx) idx == c("explain", "include")))
        if (remainders == "include") {options1[7] <- TRUE}
        
        qmcc.options <- ""
        if (any(options1) | any(options2)) {
            if (all(any(options1), any(options2))) {
                qmcc.options <- paste(", ", paste(checked[options1], collapse="=TRUE, "), "=TRUE, ",
                                      paste(unchecked[options2], collapse="=FALSE, "), "=FALSE", sep="")
                
                }
            else {
                if (any(options1)) {
                    qmcc.options <- paste(", ", paste(checked[options1], collapse="=TRUE, "), "=TRUE", sep="")
                    }
                else {
                    qmcc.options <- paste(", ", paste(unchecked[options2], collapse="=FALSE, "), "=FALSE", sep="")
                    }
                }
            }
        
        eqmcc.options <- ""
        if (any(options1) | options2[2]) {
            if (all(any(options1), options2[2])) {
                eqmcc.options <- paste(", ", paste(checked[options1], collapse="=TRUE, "), "=TRUE, ",
                                      unchecked[2], "=FALSE", sep="")
                
                }
            else {
                if (any(options1)) {
                    eqmcc.options <- paste(", ", paste(checked[options1], collapse="=TRUE, "), "=TRUE", sep="")
                    }
                else {
                    eqmcc.options <- paste(", ", unchecked[2], "=FALSE", sep="")
                    }
                }
            }
        
        
        outcomeVar <- variableList[as.integer(tkcurselection(outcomeBox)) + 1]
        conditionsVar <- variableList[as.integer(tkcurselection(conditionsBox)) + 1]
        cndts <- paste(', conditions=c("', paste(conditionsVar, collapse='", "'), '")', sep="")
        if (length(conditionsVar) == 0) {cndts <- ""}
        
        if (eqmcc) {
            command <- paste('eqmcc(', dataSet, ', outcome=', paste('"', outcomeVar, '"', sep=""), cndts, eqmcc.options, ')', sep="")
            }
        else {
            command <- paste('qmcc(', dataSet, ', outcome=', paste('"', outcomeVar, '"', sep=""), cndts, qmcc.options, ')', sep="")
            }
        
            
        
        doItAndPrint(command)
        tkdestroy(top)
        tkfocus(CommanderWindow())
        }
    
    onCancel <- function() {
        tkdestroy(top)
        tkfocus(CommanderWindow())
        }
    
    top1 <- tkframe(top)
    
    top1Left <- tkframe(top1)
    outcomeBox <- tklistbox(top1Left, height=min(5, length(variableList)),
                            selectmode="single", background="white", exportselection=FALSE)
    scrollbarLeft <- tkscrollbar(top1Left, repeatinterval=5, command=function(...) tkyview(outcomeBox, ...))
    tkconfigure(outcomeBox, yscrollcommand=function(...) tkset(scrollbarLeft, ...))
    for (var in variableList) tkinsert(outcomeBox, "end", var)
    tkgrid(tklabel(top1Left, text="Select the outcome variable\n(only one)", fg="blue"), sticky="w")
    tkgrid(outcomeBox, scrollbarLeft, sticky="nw")
    tkgrid.configure(scrollbarLeft, sticky="wns")
    tkgrid.configure(outcomeBox, sticky="ew")
    
    top1Middle <- tkframe(top1)
    tkgrid(tklabel(top1Middle, text="  "))
    
    top1Right <- tkframe(top1)
    selectmodeRcmdr <- getRcmdr("multiple.select.mode")
    conditionsBox <- tklistbox(top1Right, height=min(5, length(variableList)),
                               selectmode=selectmodeRcmdr, background="white", exportselection=FALSE)
    scrollbarRight <- tkscrollbar(top1Right, repeatinterval=5, command=function(...) tkyview(conditionsBox, ...))
    tkconfigure(conditionsBox, yscrollcommand=function(...) tkset(scrollbarRight, ...))
    for (var in variableList) tkinsert(conditionsBox, "end", var)
    tkgrid(tklabel(top1Right, text="Select the conditions\n(two or more)", fg="blue"), sticky="w")
    tkgrid(conditionsBox, scrollbarRight, sticky="nw")
    tkgrid.configure(scrollbarRight, sticky="wns")
    tkgrid.configure(conditionsBox, sticky="ew")
    
    tkpack(top1Left, top1Middle, top1Right, side="left")
    
    top2 <- tkframe(top)
    
    tkgrid(tklabel(top2, text=" ")) # Blank line
    
    text0 <- tklabel(top2, text="   ")
    text1 <- tklabel(top2, text="Outcome 0  ")
    text2 <- tklabel(top2, text="Outcome 1  ")
    text3 <- tklabel(top2, text="Contradictions  ")
    text4 <- tklabel(top2, text="Remainders  ")
    
    frame0 <- tkframe(top2)
    tkgrid(tklabel(frame0, text="Explain  "), 
           tklabel(frame0, text="Include for\nreduction"),
           tklabel(frame0, text="  Exclude"))
    tkgrid(text0, frame0)
    
    values <- c("explain", "include", "exclude")
    
    frame1 <- tkframe(top2, relief="ridge", borderwidth=2)
    outcome0Variable <- tclVar("exclude")
    frame1rb1 <- tkradiobutton(frame1, variable=outcome0Variable, value=values[1])
    frame1rb2 <- tkradiobutton(frame1, variable=outcome0Variable, value=values[2])
    frame1rb3 <- tkradiobutton(frame1, variable=outcome0Variable, value=values[3])
    tkgrid(frame1rb1, tklabel(frame1, text="        "), frame1rb2, tklabel(frame1, text="        "), frame1rb3)
    tkgrid(text1, frame1)
    
    frame2 <- tkframe(top2, relief="ridge", borderwidth=2)
    outcome1Variable <- tclVar("explain")
    frame2rb1 <- tkradiobutton(frame2, variable=outcome1Variable, value=values[1])
    frame2rb2 <- tkradiobutton(frame2, variable=outcome1Variable, value=values[2])
    frame2rb3 <- tkradiobutton(frame2, variable=outcome1Variable, value=values[3])
    tkgrid(frame2rb1, tklabel(frame2, text="        "), frame2rb2, tklabel(frame2, text="        "), frame2rb3)
    tkgrid(text2, frame2)
    
    frame3 <- tkframe(top2, relief="ridge", borderwidth=2)
    contradictionsVariable <- tclVar("exclude")
    frame3rb1 <- tkradiobutton(frame3, variable=contradictionsVariable, value=values[1])
    frame3rb2 <- tkradiobutton(frame3, variable=contradictionsVariable, value=values[2])
    frame3rb3 <- tkradiobutton(frame3, variable=contradictionsVariable, value=values[3])
    tkgrid(frame3rb1, tklabel(frame3, text="        "), frame3rb2, tklabel(frame3, text="        "), frame3rb3)
    tkgrid(text3, frame3)
    
    frame4 <- tkframe(top2, relief="ridge", borderwidth=2)
    remaindersVariable <- tclVar("include")
    frame4rb1 <- tkradiobutton(frame4, variable=remaindersVariable, value=values[1], state="disabled")
    frame4rb2 <- tkradiobutton(frame4, variable=remaindersVariable, value=values[2])
    frame4rb3 <- tkradiobutton(frame4, variable=remaindersVariable, value=values[3])
    tkgrid(frame4rb1, tklabel(frame4, text="        "), frame4rb2, tklabel(frame4, text="        "), frame4rb3)
    tkgrid(text4, frame4)
    
    tkgrid.configure(text0, text1, text2, text3, text4, sticky="e")
    
    tkgrid(tklabel(top2, text=" ")) # Blank line
    
    top3 <- tkframe(top)
    
    cbOptions <- c("eqmcc", "diffmat", "useletters", "chart", "showcases", "details", "quiet")
    cbLabels <- c("Use the enhanced algorithm", "Generate differences matrix:",
                  "Use letters instead variables' names:", "Show prime implicants chart:",
                  "Show cases for solution:", "Some details:", "Quiet (no details at all):")
    initialValues <- c(0, 1, 1, 0, 0, 1, 0)
    
    CBvalues <- as.logical(initialValues)
    modified <- rep(FALSE, 8) # "details" is disabled by both quiet and eqmcc
    
    diffmatCommand <- function() {
        if (CBvalues[1]) {
            tkdeselect(eqmccCB)
            CBvalues[c(1, 8)] <<- FALSE
            }
        CBvalues[2] <<- !CBvalues[2]
        modified[c(2, 8)] <<- FALSE
        }
    
    chartCommand <- function() {
        if (CBvalues[7]) {
            tkdeselect(quietCB)
            CBvalues[5:7] <<- FALSE
            }
        CBvalues[4] <<- !CBvalues[4]
        modified[4:6] <<- FALSE
        }
    
    showcasesCommand <- function() {
        if (CBvalues[7]) {
            tkdeselect(quietCB)
            CBvalues[c(4, 6, 7)] <<- FALSE
            }
        CBvalues[5] <<- !CBvalues[5]
        modified[4:6] <<- FALSE
        }
    
    detailsCommand <- function() {
        if (CBvalues[1]) {
            tkdeselect(eqmccCB)
            CBvalues[1:2] <<- FALSE
            }
        if (CBvalues[7]) {
            tkdeselect(quietCB)
            CBvalues[c(4, 5, 7)] <<- FALSE
            }
        CBvalues[6] <<- !CBvalues[6]
        modified[c(2, 4:6, 8)] <<- FALSE
        }
    
    quietCommand <- function() {
        if (!CBvalues[7]) {
            CBvalues[7] <<- !CBvalues[7]
            if (CBvalues[4]) {
                modified[4] <<- TRUE
                CBvalues[4] <<- !CBvalues[4]
                tkdeselect(chartCB)
                }
            if (CBvalues[5]) {
                modified[5] <<- TRUE
                CBvalues[5] <<- !CBvalues[5]
                tkdeselect(showcasesCB)
                }
            if (CBvalues[6]) {
                modified[6] <<- TRUE
                CBvalues[6] <<- !CBvalues[6]
                tkdeselect(detailsCB)
                }
            } else {
            CBvalues[7] <<- !CBvalues[7]
            if (modified[4]) {
                CBvalues[4] <<- !CBvalues[4]
                tkselect(chartCB)
                }
            if (modified[5]) {
                CBvalues[5] <<- !CBvalues[5]
                tkselect(showcasesCB)
                }
            if (modified[6]) {
                CBvalues[6] <<- !CBvalues[6]
                tkselect(detailsCB)
                }
            }
        }
    
    eqmccCommand <- function() {
        if (!CBvalues[1]) {
            CBvalues[1] <<- !CBvalues[1]
            if (CBvalues[2]) {
                modified[2] <<- TRUE
                CBvalues[2] <<- !CBvalues[2]
                tkdeselect(diffmatCB)
                }
            if (CBvalues[6]) {
                modified[8] <<- TRUE
                CBvalues[6] <<- !CBvalues[6]
                tkdeselect(detailsCB)
                }
            } else {
            CBvalues[1] <<- !CBvalues[1]
            if (modified[2]) {
                CBvalues[2] <<- !CBvalues[2]
                tkselect(diffmatCB)
                }
            if (modified[8]) {
                CBvalues[6] <<- !CBvalues[6]
                tkselect(detailsCB)
                }
            }
        }
    
    for (i in 1:7) {
        CheckBox <- paste(cbOptions[i], "CB", sep="")
        assign(CheckBox, tkcheckbutton(top3))
        cbVariable <- paste(cbOptions[i], "Variable", sep="")
        assign(cbVariable, tclVar(initialValues[i]))
        if (i == 1) {
            tkconfigure(get(CheckBox), variable=get(cbVariable), command=eqmccCommand)
        } else if (i == 2) {
            tkconfigure(get(CheckBox), variable=get(cbVariable), command=diffmatCommand)
        } else if (i == 3) {
            tkconfigure(get(CheckBox), variable=get(cbVariable))
        } else if (i == 4) {
            tkconfigure(get(CheckBox), variable=get(cbVariable), command=chartCommand)
        } else if (i == 5) {
            tkconfigure(get(CheckBox), variable=get(cbVariable), command=showcasesCommand)
        } else if (i == 6) {
            tkconfigure(get(CheckBox), variable=get(cbVariable), command=detailsCommand)
        } else {
            tkconfigure(get(CheckBox), variable=get(cbVariable), command=quietCommand)
        }
        tkgrid(tklabel(top3, text=cbLabels[i]), get(CheckBox), sticky="e")
    }
    
    tkgrid(tklabel(top3, text=" ")) # Blank line
    
    OKCancelHelp(helpSubject="qmcc")  
    
    tkpack(top1, top2, top3, buttonsFrame, side="top")
    }


Factorize <- function() {
    require(QCA)
    
    library(tcltk)

    top <- tktoplevel()
    tkwm.title(top, "Factorize minimized solution")
    
    top1 <- tkframe(top)
    tkgrid(tklabel(top1, text=" ")) # Blank line
    dsname <- tclVar(gettextRcmdr(""))
    entryDsname <- tkentry(top1, width="50", textvariable=dsname)
    tkgrid(tklabel(top1, text=gettextRcmdr("Write or copy and paste the solution:")), entryDsname, sticky="e")
    tkgrid.configure(entryDsname, sticky="w")
    
    onOK <- function(){
        rb1 <- tclvalue(rb1Variable) == "1"
        rb2 <- tclvalue(rb2Variable) == "1"
        optional <- ""
        if (any(c(rb1, rb2))) {
            optional <- paste(", ", c("sort.by.literals", "sort.by.number")[c(rb1, rb2)], "=TRUE", sep="")
            }
        command <- paste('factorize("', tclvalue(dsname), '", splitmethod="', tclvalue(splitm), '"', optional, ')', sep="")
        doItAndPrint(command)
        closeDialog()
        tkfocus(CommanderWindow())
        }
    
    top2 <- tkframe(top)
    
    cbTop <- tkframe(top2)
    tkgrid(tklabel(cbTop, text=" ")) # Blank line
    
    initialValues <- c(1)
    
    splitm <- tclVar(gettextRcmdr(""))
    entrySplitm <- tkentry(cbTop, width="1", textvariable=splitm)
    tkgrid(tklabel(cbTop, text=gettextRcmdr("Split method:")), entrySplitm, sticky="e")
    tkgrid.configure(entrySplitm, sticky="w")
    
    
    
    middle <- tkframe(top2)
    tkgrid(tklabel(middle, text="    "))
    
    
    rbTop <- tkframe(top2)
    
    tkgrid(tklabel(rbTop, text=" ")) # Blank line
    
    rb1value <- rb2value <- FALSE
    
    rb1Command <- function() {
        rb1value <<- !rb1value
        if (rb2value) {
            rb2value <<- !rb2value
            tkdeselect(rb2CB)
            }
        }
    
    rb2Command <- function() {
        rb2value <<- !rb2value
        if (rb1value) {
            rb1value <<- !rb1value
            tkdeselect(rb1CB)
            }
        }
    
    initialValues <- c(0, 0)
    rb1CB <- tkcheckbutton(rbTop)
    rb1Variable <- tclVar(initialValues[1])
    tkconfigure(rb1CB, variable=rb1Variable, command=rb1Command)
    tkgrid(tklabel(rbTop, text="Sort by number of literals as common factor:"), rb1CB, sticky="e")
    
    rb2CB <- tkcheckbutton(rbTop)
    rb2Variable <- tclVar(initialValues[2])
    tkconfigure(rb2CB, variable=rb2Variable, command=rb2Command)
    tkgrid(tklabel(rbTop, text="Sort by number of factorized elements:"), rb2CB, sticky="e")
    
    tkpack(cbTop, middle, rbTop, side="left")
    
    OKCancelHelp(helpSubject="factorize")
    tkpack(top1, top2, buttonsFrame, side="top")
    dialogSuffix(rows=2, columns=2, focus=entryDsname)
}


#line 1 "d:/RCompile/CRANpkg/local/2.13/QCAGUI/R/cluster.R"
# this code by Dan Putler, used with permission

# last modified 2 March 06 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) {
            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 <- tkentry(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(tklabel(optionsFrame, text=gettextRcmdr("Number of clusters:")),
      clusterNumSlider, sticky="sw")
    tkgrid(tklabel(optionsFrame, text=gettextRcmdr("Number of starting seeds:")),
      seedNumSlider, sticky="sw")
    tkgrid(tklabel(optionsFrame, text=gettextRcmdr("Maximum iterations:")),
      iterNumSlider, sticky="sw")
    tkgrid(tklabel(optionsFrame, 
      text=gettextRcmdr("Print cluster summary")), summaryCB, sticky="w")
    tkgrid(tklabel(optionsFrame, 
      text=gettextRcmdr("Bi-plot of clusters")), plotCB, sticky="w")
    tkgrid(tklabel(optionsFrame, 
      text=gettextRcmdr("Assign clusters to\nthe data set         ")),
      assignCB, sticky="w")
    tkgrid(tklabel(optionsFrame, text=gettextRcmdr("Assignment variable: ")),
      assignField, sticky="w")
    tkgrid(dataFrame, tklabel(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(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 <- tkentry(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(tklabel(top, text=gettextRcmdr("Clustering solution name:")),
      solutionFrame, sticky="w")
    tkgrid(getFrame(xBox), sticky="nw")
    tkgrid(subsetFrame, sticky="w")
    tkgrid(distanceTypeFrame, sticky="w")
    tkgrid(tklabel(checkFrame, text="  "), sticky="w")
    tkgrid(tklabel(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 <- 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 <- 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(tklabel(optionsFrame, text=gettextRcmdr("Number of clusters:")), slider,
      sticky="sw")
    tkgrid(tklabel(optionsFrame, 
      text=gettextRcmdr("Print cluster summary")), summaryCB, sticky="w")
    tkgrid(tklabel(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 <- 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 <- tkentry(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 <- 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="")
        justDoIt(command)
        logger(command)
        activeDataSet(.activeDataSet)
        tkfocus(CommanderWindow())
        } 
    OKCancelHelp(helpSubject="assignCluster")
    tkgrid(tklabel(optionsFrame, text=gettextRcmdr("  Assigned cluster label:")),
      labelNameField, sticky="w")
    tkgrid(tklabel(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.13/QCAGUI/R/commander.R"
# The R Commander and command logger
# last modified 07 October 2007 by Adrian Dusa
#   based on the latest modifications since 26 July 2007 by J. Fox
#   slight changes 12 Aug 04 by Ph. Grosjean 
#   changes 21 June 2007 by Erich Neuwirth for Excel support (marked EN)

Commander <- function(){
    require("MASS")
    RcmdrVersion <- "1.3-5"
    # the following test suggested by Richard Heiberger
    if ("RcmdrEnv" %in% search() &&
        exists("commanderWindow", "RcmdrEnv") &&
        !is.null(get("commanderWindow", "RcmdrEnv"))) {
      warning("QCAGUI 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]]
    etc <- setOption("etc", file.path(.path.package(package="QCAGUI")[1], "etc"))
    etcMenus <- setOption("etcMenus", etc)
    putRcmdr("etcMenus", etcMenus)
    onCopy <- function(){
        focused <- tkfocus()
        if ((tclvalue(focused) != LogWindow()$ID) && (tclvalue(focused) != OutputWindow()$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))
            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(){
        focused <- tkfocus()
        if ((tclvalue(focused) != LogWindow()$ID) && (tclvalue(focused) != OutputWindow()$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))
            focused <- LogWindow()
        initializeDialog(title=gettextRcmdr("Find"))
        textFrame <- tkframe(top)
        textVar <- tclVar("")
        textEntry <- tkentry(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(tklabel(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))
            focused <- LogWindow()
        tktag.add(focused, "sel", "1.0", "end")
        tkfocus(focused)
        }
    onClear <- function(){
        onSelectAll()
        onDelete()
        }
    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("contrasts", c("contr.Treatment", "contr.poly"))
        }
    else setOption("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))
    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", 
        interactive() && .Platform$GUI == "X11" && getRversion() < "2.4.0") # to address problem in Linux
    setOption("showData.threshold", 100)
    setOption("retain.messages", TRUE)
    setOption("crisp.dialogs",  (.Platform$OS.type == "windows") && (getRversion() >= "2.1.1"))
    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=""))
        }
    if (getRcmdr("crisp.dialogs")) tclServiceMode(on=FALSE)
    putRcmdr("commanderWindow", tktoplevel())
    .commander <- CommanderWindow()
    placement <- setOption("placement", "-40+20", global=FALSE)
    tkwm.geometry(.commander, placement)
    tkwm.title(.commander, gettextRcmdr("Qualitative Comparative Analysis"))
    tkwm.protocol(.commander, "WM_DELETE_WINDOW", CloseCommander)
    topMenu <- tkmenu(.commander)
    tkconfigure(.commander, menu=topMenu)
    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, "QCA-menus.txt"), colClasses = "character")
    addMenus <- function(Menus){
        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"] == "menu"){
                    where <- if (line[1, "operationOrParent"] == "topMenu") 0
                        else 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"])))
                        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)
    .Menus <- menus <- list()
    menuItems <- 0
    oldMenu <- ncol(Menus) == 6
    setOption("suppress.menus", FALSE)
    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 <- 0
                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 <- position + 1
                    if (Menus[m, 6] == "")
                        tkadd(eval(parse(text=Menus[m, 2])),"command", label=gettextRcmdr(Menus[m, 4]),
                            command=eval(parse(text=Menus[m, 5])))
                    else {
                        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[[menuItems]] <- list(ID=menus[[Menus[m, 2]]]$ID, position=position,
                            activation=eval(parse(text=paste("function()", Menus[m, 6]))))
                        }
                    }
                else if (Menus[m, 3] == "cascade")
                    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)
            }
        }
    ## added by EN ###############################
	if (RExcelSupported())
    	putRExcel(".rexcel.menu.dataframe", Menus)
    ## end of change ###############################
    putRcmdr("Menus", .Menus)
    putRcmdr("autoRestart", FALSE)
    activateMenus()
    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 (activeDataSet() == FALSE) {
            tkfocus(CommanderWindow())
            return()
            }
        view.height <- 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")){
            require("relimp")
            paste("showData(", ActiveDataSet(), ", placement='-20+200', font=getRcmdr('logFont'), maxwidth=",
                log.width, ", maxheight=", view.height, ")", 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("\nQCA> ", 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("QCA+ ", 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))){

            if (length(grep("<-", current.line)) > 0){
                justDoIt(current.line)
                }
            else if (length(grep("^remove\\(", current.line)) > 0){
                current.line <- sub(")", ", envir=.GlobalEnv)", current.line)
                justDoIt(current.line)
                }
            else if (any(sapply(exceptions,
                    function(.x) length(grep(paste("^", .x, "\\(", sep=""), current.line)) > 0))){
                justDoIt(current.line)
                }
            else doItAndPrint(current.line, log=FALSE)
            }
            iline <- iline + 1
        tkyview.moveto(.output, 1)
        }
    }
    contextMenuLog <- function(){
        .log <- LogWindow()
        contextMenu <- tkmenu(tkmenu(.log), tearoff=FALSE)
        tkadd(contextMenu, "command", label=gettextRcmdr("Clear window"), command=onClear)
        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)
        tkpopup(contextMenu, tkwinfo("pointerx", .log), tkwinfo("pointery", .log))
        }
    contextMenuOutput <- function(){
        .output <- OutputWindow()
        contextMenu <- tkmenu(tkmenu(.output), tearoff=FALSE)
        tkadd(contextMenu, "command", label=gettextRcmdr("Clear window"), command=onClear)
        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)
        tkpopup(contextMenu, tkwinfo("pointerx", .output), tkwinfo("pointery", .output))
        }
    controlsFrame <- tkframe(CommanderWindow())
    editButton <- tkbutton(controlsFrame, text=gettextRcmdr("Edit data set"), command=onEdit)
    viewButton <- tkbutton(controlsFrame, text=gettextRcmdr("View data set"), command=onView)
    putRcmdr("dataSetName", tclVar(gettextRcmdr("<No active dataset>")))
    putRcmdr("dataSetLabel", tkbutton(controlsFrame, textvariable=getRcmdr("dataSetName"), fg="red",
        relief="groove", command=selectActiveDataSet))
    logFrame <- tkframe(CommanderWindow())
    putRcmdr("logWindow", tktext(logFrame, bg="white", fg=getRcmdr("log.text.color"),
        font=getRcmdr("logFont"), height=log.height, width=log.width, wrap="none"))
    .log <- LogWindow()
    logXscroll <- tkscrollbar(logFrame, repeatinterval=5, orient="horizontal",
        command=function(...) tkxview(.log, ...))
    logYscroll <- tkscrollbar(logFrame, repeatinterval=5,
        command=function(...) tkyview(.log, ...))
    tkconfigure(.log, xscrollcommand=function(...) tkset(logXscroll, ...))
    tkconfigure(.log, yscrollcommand=function(...) tkset(logYscroll, ...))
    outputFrame <- tkframe(.commander)
    if (getRcmdr("console.output"))
        submitButton <- if (English()) tkbutton(logFrame, bitmap=paste("@", file.path(etc, "submit.xbm"), sep=""),
            borderwidth="2", command=onSubmit)
        else tkbutton(logFrame, text=gettextRcmdr("Submit"), borderwidth="2", command=onSubmit)
    else submitButton <- if (English())tkbutton(outputFrame, bitmap=paste("@", file.path(etc, "submit.xbm"), sep=""),
            borderwidth="2", command=onSubmit)
        else tkbutton(outputFrame, text=gettextRcmdr("Submit"), borderwidth="2", command=onSubmit)
    putRcmdr("outputWindow", tktext(outputFrame, bg="white", fg=getRcmdr("output.text.color"),
        font=getRcmdr("logFont"), height=output.height, width=log.width, wrap="none"))
    .output <- OutputWindow()
    outputXscroll <- tkscrollbar(outputFrame, repeatinterval=5, orient="horizontal",
        command=function(...) tkxview(.output, ...))
    outputYscroll <- tkscrollbar(outputFrame, repeatinterval=5,
        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=3, width=log.width, wrap="none"))
    .messages <- MessagesWindow()
    messagesXscroll <- tkscrollbar(messagesFrame, repeatinterval=5, orient="horizontal",
        command=function(...) tkxview(.messages, ...))
    messagesYscroll <- tkscrollbar(messagesFrame, repeatinterval=5,
        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"), fg="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")){
        tkgrid(tklabel(controlsFrame, bitmap=paste("@", file.path(etc, "QCA.xbm"), sep=""), fg="red"),
            tklabel(controlsFrame, text=gettextRcmdr("Data set:")), getRcmdr("dataSetLabel"),
            tklabel(controlsFrame, text="  "), if(show.edit.button) editButton, viewButton, sticky="w")
            # tklabel(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(tklabel(logFrame, text=gettextRcmdr("Script Window"), fg="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(tklabel(outputFrame, text=gettextRcmdr("Output Window"), fg="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(tklabel(messagesFrame, text=gettextRcmdr("Messages"), fg=getRcmdr("error.text.color")), sticky="w")
    tkgrid(.messages, messagesYscroll, sticky="news", columnspan=2)
    tkgrid(messagesXscroll)
    tkgrid(messagesFrame, sticky="news", padx=10, pady=0, columnspan=2)
    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-r>", onSubmit)
    tkbind(.commander, "<Control-R>", 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(.log, "<ButtonPress-3>", contextMenuLog)
    tkbind(.output, "<ButtonPress-3>", contextMenuOutput)
    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("QCAGUI based on R Commander Version "), getRcmdr("RcmdrVersion"), ": ", date(), sep=""))
    }

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

logger <- 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) 
       } 
   lines <- strsplit(command, "\n")[[1]] 
   tkinsert(.output, "end", "\n") 
   if (getRcmdr("console.output")) { 
     for (line in seq(along=lines)) { 
       prompt <- ifelse (line==1, "\nQCA>", "\nQCA+") 
       cat(paste(prompt, lines[line], "\n")) 
        } 
     } 
   else { 
     for (line in  seq(along=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()
        }
    checkWarnings(readLines(messages.connection))
    result
    }

doItAndPrint <- function(command, log=TRUE) {
    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)
    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")
        if (.console.output) sink(type="output")
        tkfocus(CommanderWindow())
        return()
        }
    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)
            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 Message(message=paste(messages, collapse="\n"), type="warning")
        }                        
    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 Message(message=paste(messages, collapse="\n"), type="warning")
        }
    tkfocus(CommanderWindow())
    }
    
Message <- function(message, type=c("note", "error", "warning")){
    if (is.SciViews()) return(svMessage(message, type))    # +PhG
    .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"))) {
            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="")
    ######### added by EN #####################
   	if (RExcelSupported())
    	putRExcel(".rexcel.last.message",message)
    ######### end of change ###############
    lines <- strsplit(message, "\n")[[1]]
    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="")
    }
#line 1 "d:/RCompile/CRANpkg/local/2.13/QCAGUI/R/data-menu.R"
# last modified 4 June 2007 by J. Fox

# Data menu dialogs

newDataSet <- function() {
    initializeDialog(title=gettextRcmdr("New Data Set"))
    dsname <- tclVar(gettextRcmdr("Dataset"))
    entryDsname <- tkentry(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))"
        assign(dsnameValue, justDoIt(command), envir=.GlobalEnv)
        logger(paste(dsnameValue, "<-", command))
        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(tklabel(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 <- tkentry(variablesFrame, width="20", textvariable=newVariableName)
    recodesFrame <- tkframe(top)
    recodes <- tktext(recodesFrame, bg="white", font=getRcmdr("logFont"),
        height="5", width="40", wrap="none")
    recodesXscroll <- tkscrollbar(recodesFrame, repeatinterval=5, orient="horizontal",
        command=function(...) tkxview(recodes, ...))
    recodesYscroll <- tkscrollbar(recodesFrame, repeatinterval=5,
        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=""))
            justDoIt(paste(dataSet,"$",newVar, " <- ", cmd, sep=""))
            activeDataSet(dataSet, flushModel=FALSE)
            tkfocus(CommanderWindow())
            }
        }
    OKCancelHelp(helpSubject="Recode")    
    tkgrid(getFrame(variablesBox), sticky="nw")
    tkgrid(tklabel(variablesFrame, text=""))
    tkgrid(tklabel(variablesFrame, 
        text=gettextRcmdr("New variable name or prefix for multiple recodes: ")),
        newVariable, sticky="w")
    tkgrid(tklabel(asFactorFrame, 
        text=gettextRcmdr("Make (each) new variable a factor")), asFactorCheckBox, 
        sticky="w")
    tkgrid(tklabel(asFactorFrame, text=""))
    tkgrid(tklabel(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 <- tkentry(variablesFrame, width="20", textvariable=newVariableName)
    computeFrame <- tkframe(top)
    computeVar <- tclVar("")
    compute <- tkentry(computeFrame, font=getRcmdr("logFont"), width="30", textvariable=computeVar)
    computeXscroll <- tkscrollbar(computeFrame, repeatinterval=10,
        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)
        justDoIt(command)
        activeDataSet(dataSet, flushModel=FALSE)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="Compute")
    tkgrid(getFrame(variablesBox), sticky="nw", columnspan=2)
    tkgrid(tklabel(variablesFrame, text=gettextRcmdr("New variable name")), sticky="w")
    tkgrid(newVariable, tklabel(variablesFrame, text="     "), sticky="w")
    tkgrid(tklabel(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 Data From Text File or Clipboard"))
    optionsFrame <- tkframe(top)
    dsname <- tclVar(gettextRcmdr("Dataset"))
    entryDsname <- tkentry(optionsFrame, width="20", textvariable=dsname)
    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 <- tkradiobutton(delimiterFrame, variable=delimiterVariable, value="other")
    otherVariable <- tclVar("")
    otherEntry <- tkentry(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 <- tkentry(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"
        file <- if (clip) "clipboard" else tclvalue(tkgetOpenFile(filetypes=
            gettextRcmdr('{"Text Files" {".txt" ".TXT" ".dat" ".DAT" ".csv" ".CSV"}} {"All Files" {"*"}}')))
        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=""))
        assign(dsnameValue, justDoIt(command), envir=.GlobalEnv)
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="read.table")
    tkgrid(tklabel(optionsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, sticky="w")
    tkgrid(tklabel(optionsFrame, text=gettextRcmdr("Variable names in file:")), headerCheckBox, sticky="w")
    tkgrid(tklabel(optionsFrame, text=gettextRcmdr("Read data from clipboard:")), clipboardCheckBox, sticky="w")
    tkgrid(tklabel(optionsFrame, text=gettextRcmdr("Missing data indicator:")), missingEntry, sticky="w")
    tkgrid(tklabel(delimiterFrame, text=gettextRcmdr("Other")), otherButton, 
        tklabel(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=4, columns=1)
    }
        
readDataFromPackage <- function() {
    env <- environment()
    initializeDialog(title=gettextRcmdr("Read Data From Package"))
    dsname <- tclVar("")
    package <- NULL
    enterFrame <- tkframe(top)
    entryDsname <- tkentry(enterFrame, width="20", textvariable=dsname)
    packages <- sort(.packages())
    packages <- packages[! packages %in% c("base", "stats")]
    packages <- packages[sapply(packages, function(package) nrow(data(package=package)$results) > 0)]
    packageDatasetFrame <- tkframe(top)
    packageFrame <- tkframe(packageDatasetFrame)
    packageBox <- tklistbox(packageFrame, height="4", exportselection="FALSE",
        selectmode="single", background="white")
    packageScroll <- tkscrollbar(packageFrame, repeatinterval=5,
        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 <- tkscrollbar(datasetFrame, repeatinterval=5,
        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]
        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) <- data(package=package)$results[as.numeric(tkcurselection(datasetBox)) + 1,3]
        }
    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 <- data(package=package)$results[as.numeric(tkcurselection(datasetBox)) + 1,3]
        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="")
            justDoIt(command)
            logger(command)
            activeDataSet(datasetName)
            tkfocus(CommanderWindow())
            }
        }
    OKCancelHelp(helpSubject="data")
    tkgrid(tklabel(packageDatasetFrame, text=gettextRcmdr("Package (Double-click to select)"), fg="blue"),
    tklabel(packageDatasetFrame, text="   "), tklabel(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, tklabel(packageDatasetFrame, text="   "), datasetFrame, sticky="nw")
    tkgrid(packageDatasetFrame, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("OR"), fg="red"), sticky="w")
    tkgrid(tklabel(enterFrame, text=gettextRcmdr("Enter name of data set:  "), fg="blue"), entryDsname, sticky="w")
    tkgrid(enterFrame, 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)
    tkgrid(buttonsFrame, columnspan="2", sticky="w")
    dialogSuffix(rows=4, columns=1, focus=entryDsname)
    }
    
importSPSS <- function() {
    require("foreign")
    initializeDialog(title=gettextRcmdr("Import SPSS Data Set"))
    dsname <- tclVar(gettextRcmdr("Dataset"))
    entryDsname <- tkentry(top, width="20", textvariable=dsname)
    asFactor <- tclVar("1")
    asFactorCheckBox <- tkcheckbutton(top, variable=asFactor)
    maxLevels <- tclVar("Inf")
    entryMaxLevels <- tkentry(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=""))
        assign(dsnameValue, justDoIt(command), envir=.GlobalEnv)
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="read.spss")
    tkgrid(tklabel(top, text=gettextRcmdr("Enter name for data set:")), entryDsname, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Convert value labels\nto factor levels"), justify="left"), 
        asFactorCheckBox, sticky="w")
    tkgrid(tklabel(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() {
    require("foreign")
    initializeDialog(title=gettextRcmdr("Import Minitab Data Set"))
    dsname <- tclVar(gettextRcmdr("Dataset"))
    entryDsname <- tkentry(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(tklabel(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() {
    require("foreign")
    initializeDialog(title=gettextRcmdr("Import STATA Data Set"))
    dsname <- tclVar(gettextRcmdr("Dataset"))
    entryDsname <- tkentry(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=""))
        assign(dsnameValue, justDoIt(command), envir=.GlobalEnv)
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="read.dta")
    tkgrid(tklabel(top, text=gettextRcmdr("Enter name for data set:")), entryDsname, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Convert value labels\nto factor levels"), justify="left"), 
        asFactorCheckBox, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Convert dates to R format"), justify="left"), 
        asDateCheckBox, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Multiple missing types (>=Stata 8)"), justify="left"), 
        asMissingTypeCheckBox, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Convert underscore to period"), justify="left"), 
        asConvertUnderscoreCheckBox, sticky="w")
    tkgrid(tklabel(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)

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 <- tkentry(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(tklabel(subdialog, text=gettextRcmdr("Numeric value")), tklabel(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=""), tkentry(subdialog, width="20", 
                        textvariable=eval(parse(text=valVar))))
                    tkgrid(tklabel(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="")
                justDoIt(paste(.activeDataSet, "$", fname, " <- ", command, sep=""))
                logger(paste(.activeDataSet,"$", fname," <- ", command, sep=""))
                activeDataSet(.activeDataSet)
                tkfocus(CommanderWindow())
                }
            else{
                command <- paste("as.factor(", .activeDataSet, "$", name, ")", sep="")
                justDoIt(paste(.activeDataSet, "$", fname, " <- ", command, sep=""))
                logger(paste(.activeDataSet, "$", fname," <- ", command, sep=""))
                activeDataSet(.activeDataSet, flushModel=FALSE)
                tkfocus(CommanderWindow())
                }
            }
        }
    OKCancelHelp(helpSubject="factor")
    tkgrid(getFrame(variableBox), levelsFrame, sticky="nw")
    tkgrid(tklabel(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 <- tkentry(newVariableFrame, width="18", textvariable=newVariableName)
    binsFrame <- tkframe(top)
    binsVariable <- tclVar("3")
    slider <- tkscale(binsFrame, from=2, to=10, 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(tklabel(subdialog, text=gettextRcmdr("Bin"), fg="blue"), 
                tklabel(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=""), tkentry(subdialog, width="20", 
                    textvariable=eval(parse(text=valVar))))
                tkgrid(tklabel(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)
        justDoIt(command)
        activeDataSet(.activeDataSet, flushModel=FALSE)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="bin.var")
    tkgrid(tklabel(newVariableFrame, text=gettextRcmdr("New variable name"), fg="blue"), sticky="w") 
    tkgrid(newVariable, sticky="w")
    tkgrid(getFrame(variableBox), tklabel(variableFrame, text="    "), newVariableFrame, sticky="nw")
    tkgrid(variableFrame, sticky="w")
    tkgrid(tklabel(binsFrame, text=gettextRcmdr("Number of bins:")), slider, sticky="s")
    tkgrid(binsFrame, sticky="w")
    tkgrid(levelsFrame, tklabel(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 <- tkentry(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="")
            justDoIt(paste(.activeDataSet, "$", name, " <- ", command, sep=""))
            logger(paste(.activeDataSet,"$", name," <- ", command, sep=""))
            activeDataSet(.activeDataSet, flushModel=FALSE)
            }
        subOKCancelHelp()
        tkgrid(tklabel(subdialog, text=gettextRcmdr("Old Levels"), fg="blue"), 
            tklabel(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=""), tkentry(subdialog, width="2", 
                textvariable=eval(parse(text=valVar))))
            tkgrid(tklabel(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(tklabel(top, text=gettextRcmdr("Name for factor")), sticky="w")
    tkgrid(factorNameField, sticky="w")
    tkgrid(tklabel(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="")
        assign(".Z", justDoIt(command), 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)")
        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 <- tkentry(optionsFrame, width="8", textvariable=missingVariable)
    radioButtons(name="delimiter", buttons=c("spaces", "tabs", "commas"), labels=gettextRcmdr(c("Spaces", "Tabs", "Commas")),
        title=gettextRcmdr("Field Separator"))
    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 ","
        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(tklabel(optionsFrame, text=gettextRcmdr("Missing values:")), missingEntry, sticky="w")
    tkgrid(optionsFrame, 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 <- tkentry(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)
            justDoIt(command)
            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)
            justDoIt(command)
            activeDataSet(newName)
            tkfocus(CommanderWindow())
            }
        }
    OKCancelHelp(helpSubject="na.omit")
    tkgrid(tklabel(allVariablesFrame, text=gettextRcmdr("Include all variables")), 
        allVariablesCheckBox, sticky="w")
    tkgrid(allVariablesFrame, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("   OR"), fg="red"), sticky="w")
    tkgrid(getFrame(variablesBox), sticky="nw")
    tkgrid(tklabel(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 <- tkentry(subsetFrame, width="20", textvariable=subsetVariable)
    subsetScroll <- tkscrollbar(subsetFrame, orient="horizontal",
        repeatinterval=5, command=function(...) tkxview(subsetEntry, ...))
    tkconfigure(subsetEntry, xscrollcommand=function(...) tkset(subsetScroll, ...))
    newDataSetName <- tclVar(gettextRcmdr("<same as active data set>"))
    dataSetNameFrame <- tkframe(top)
    dataSetNameEntry <- tkentry(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)
        justDoIt(command)
        activeDataSet(newName)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="subset")
    tkgrid(tklabel(allVariablesFrame, text=gettextRcmdr("Include all variables")), 
        allVariablesCheckBox, sticky="w")
    tkgrid(allVariablesFrame, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("   OR"), fg="red"), sticky="w")
    tkgrid(getFrame(variablesBox), sticky="nw")
    tkgrid(tklabel(subsetFrame, text=gettextRcmdr("Subset expression")), sticky="w")
    tkgrid(subsetEntry, sticky="w")
    tkgrid(subsetScroll, sticky="ew")
    tkgrid(subsetFrame, sticky="w")
    tkgrid(tklabel(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="")
        justDoIt(command)
        logger(command)
        eval(parse(text=paste(dataSet, "$", variable, "<- NULL", sep="")), envir=.GlobalEnv)
        logger(paste(dataSet, "$", variable, " <- NULL", sep=""))
        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(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 <- 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="")
            justDoIt(command)
            logger(command)
            activeDataSet(.activeDataSet, flushModel=FALSE)
            tkfocus(CommanderWindow())
            }
        subOKCancelHelp()
        tkgrid(tklabel(subdialog, text=gettextRcmdr("Old Name"), fg="blue"), 
            tklabel(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=""), tkentry(subdialog, width="20", 
                textvariable=eval(parse(text=valVar))))
            tkgrid(tklabel(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="")
            justDoIt(command)
            logger(command)
            activeDataSet(ActiveDataSet())
            tkfocus(CommanderWindow())
            }
        else{
            initializeDialog(subdialog, title=gettextRcmdr("Specify Contrasts"))
            tkgrid(tklabel(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("tklabel(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, ", ", 
                    "tkentry(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("tklabel(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, ", ", "tkentry(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="")
                justDoIt(command)
                logger(command)
                justDoIt("remove(.Contrasts, envir=.GlobalEnv)")   
                logger("remove(.Contrasts)") 
                activeDataSet(ActiveDataSet(), flushModel=FALSE)
                tkfocus(CommanderWindow())
                }
            subOKCancelHelp(helpSubject="contrasts")
            tkgrid(tableFrame, sticky="w")
            tkgrid(tklabel(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 <- eval(parse(text=paste("nrow(", dsname, ")", sep="")), envir=.GlobalEnv)
    command <- paste(dsname, "$ObsNumber <- 1:", nrows, sep="")
    logger(command)
    justDoIt(command)
    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 <- tkentry(top, width="20", textvariable=factorName)
    variableName <- tclVar(gettextRcmdr("variable"))
    variableNameField <- tkentry(top, width="20", textvariable=variableName)
    datasetName <- tclVar(gettextRcmdr("StackedData"))
    datasetNameField <- tkentry(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)
        justDoIt(command)
        command <- paste("names(", dsname, ') <- c("', varname, '", "', facname, '")',
            sep="")
        logger(command)
        justDoIt(command)
        activeDataSet(dsname)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="stack")
    tkgrid(getFrame(variableBox), sticky="nw", columnspan=2)
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, 
        text=gettextRcmdr("Name for stacked data set:")), datasetNameField, sticky="w")
    tkgrid(tklabel(top, 
        text=gettextRcmdr("Name for variable:")), variableNameField, sticky="w")
    tkgrid(tklabel(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"}} {"All Files" {"*"}}')))
    if (file == "") return()
    command <- paste('load("', file,'")', sep="")
    dsname <- justDoIt(command)
    logger(command)
    activeDataSet(dsname)
    tkfocus(CommanderWindow())
    }
    
saveDataSet <- function() {
    file <- tclvalue(tkgetSaveFile(filetypes=
        gettextRcmdr('{"R Data Files" {".rda" ".Rda" ".RDA"}} {"All Files" {"*"}}'),
        defaultextension="rda", initialfile=paste(activeDataSet(), "rda", sep=".")))
    if (file == "") return()
    command <- paste('save("', activeDataSet(), '", file="', file, '")', sep="")
    justDoIt(command)
    logger(command)
    }




`importTosmana` <- function(filename) {
    require(QCA)
    initializeDialog(title=gettextRcmdr("Import Tosmana XML file"))
    dsname <- tclVar(gettextRcmdr("Dataset"))
    entryDsname <- tkentry(top, width="20", textvariable=dsname)
    onOK <- function(){
        closeDialog()
        dsnameValue <- trim.blanks(tclvalue(dsname))
        if (dsnameValue == ""){
            errorCondition(recall=importTosmana,
                message=gettextRcmdr("You must enter the name of a data set."))
                return()
                }
        if (!is.valid.name(dsnameValue)){
            errorCondition(recall=importTosmana,
                message=paste('"', dsnameValue, '" ', gettextRcmdr("is not a valid name."), sep=""))
            return()
            }
        if (is.element(dsnameValue, listDataSets())) {
            if ("no" == tclvalue(checkReplace(dsnameValue, gettextRcmdr("Data set")))) {
                importTosmana()
                return()
                }
            }
        file <- tclvalue(tkgetOpenFile(
            filetypes=gettextRcmdr('{"Tosmana file" {".xml" ".XML"}} {"All Files" {"*"}}')))
        if (file == "") {
            tkfocus(CommanderWindow())
            return()
            }
        #factor <- tclvalue(asFactor) == "1"
        #levels <- as.numeric(tclvalue(maxLevels))
        command <- paste('readTosmana("', file,'")', sep="")
        logger(paste(dsnameValue, " <- ", command, sep=""))
        assign(dsnameValue, justDoIt(command), envir=.GlobalEnv)
        activeDataSet(dsnameValue)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="readTosmana")
    tkgrid(tklabel(top, text=gettextRcmdr("Enter name for data set:")), entryDsname, sticky="w")
    #tkgrid(tklabel(top, text=gettextRcmdr("Convert value labels\nto factor levels"), justify="left"), 
    #    asFactorCheckBox, sticky="w")
    #tkgrid(tklabel(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)
    }

#line 1 "d:/RCompile/CRANpkg/local/2.13/QCAGUI/R/distributions-menu.R"
# Distributions menu dialogs

# last modified 28 July 06 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 <- tkentry(top, width="30", textvariable=quantilesVar)
    muVar <- tclVar("0")
    muEntry <- tkentry(top, width="6", textvariable=muVar)
    sigmaVar <- tclVar("1")
    sigmaEntry <- tkentry(top, width="6", textvariable=sigmaVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" ", ",", tclvalue(quantilesVar))
        if ("" == quantiles) {
            errorCondition(recall=normalQuantiles, message=gettextRcmdr("No probabilities specified."))
            return()
            }
        mu <- as.numeric(tclvalue(muVar))
        sigma <- as.numeric(tclvalue(sigmaVar))
        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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("mu (mean)")), muEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("sigma (standard deviation)")), sigmaEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=probabilitiesVar)
    muVar <- tclVar("0")
    muEntry <- tkentry(top, width="6", textvariable=muVar)
    sigmaVar <- tclVar("1")
    sigmaEntry <- tkentry(top, width="6", textvariable=sigmaVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <- gsub(" ", ",", tclvalue(probabilitiesVar))
        if ("" == probabilities) {
            errorCondition(recall=normalProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
        mu <- as.numeric(tclvalue(muVar))
        sigma <- as.numeric(tclvalue(sigmaVar))
        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(tklabel(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("mu (mean)")), muEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("sigma (standard deviation)")), sigmaEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=quantilesVar)
    dfVar <- tclVar("")
    dfEntry <- tkentry(top, width="6", textvariable=dfVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" ", ",", tclvalue(quantilesVar))
        if ("" == quantiles) {
            errorCondition(recall=tQuantiles, message=gettextRcmdr("No probabilities specified.")) 
            return()
            }
        df <- as.numeric(tclvalue(dfVar))
        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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Degrees of freedom")), dfEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=probabilitiesVar)
    dfVar <- tclVar("")
    dfEntry <- tkentry(top, width="6", textvariable=dfVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <- gsub(" ", ",", tclvalue(probabilitiesVar))
        df <- as.numeric(tclvalue(dfVar))
        if ("" == probabilities) {
            errorCondition(recall=tProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
        df <- as.numeric(tclvalue(dfVar))
        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(tklabel(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Degrees of freedom")), dfEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=quantilesVar)
    dfVar <- tclVar("")
    dfEntry <- tkentry(top, width="6", textvariable=dfVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" ", ",", tclvalue(quantilesVar))
        if ("" == quantiles) {
            errorCondition(recall=chisqQuantiles, message=gettextRcmdr("No probabilities specified."))
            return()
            }
        df <- as.numeric(tclvalue(dfVar))
        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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Degrees of freedom")), dfEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=probabilitiesVar)
    dfVar <- tclVar("")
    dfEntry <- tkentry(top, width="6", textvariable=dfVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <- gsub(" ", ",", tclvalue(probabilitiesVar))
        if ("" == probabilities) {
            errorCondition(recall=chisqProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
        df <- as.numeric(tclvalue(dfVar))
        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(tklabel(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Degrees of freedom")), dfEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=quantilesVar)
    df1Var <- tclVar("")
    df1Entry <- tkentry(top, width="6", textvariable=df1Var)
    df2Var <- tclVar("")
    df2Entry <- tkentry(top, width="6", textvariable=df2Var)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" ", ",", tclvalue(quantilesVar))
        if ("" == quantiles) {
            errorCondition(recall=FQuantiles, message=gettextRcmdr("Probabilities not specified"))
            return()
            }
        df1 <- as.numeric(tclvalue(df1Var))
        df2 <- as.numeric(tclvalue(df2Var))
        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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Numerator degrees of freedom")), df1Entry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Denominator degrees of freedom")), df2Entry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=probabilitiesVar)
    df1Var <- tclVar("")
    df1Entry <- tkentry(top, width="6", textvariable=df1Var)
    df2Var <- tclVar("")
    df2Entry <- tkentry(top, width="6", textvariable=df2Var)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <- gsub(" ", ",", tclvalue(probabilitiesVar))
        if ("" == probabilities) {
            errorCondition(recall=FProbabilities, message=gettextRcmdr("Values not specified."))
            return()
            }
        df1 <- as.numeric(tclvalue(df1Var))
        df2 <- as.numeric(tclvalue(df2Var))
        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(tklabel(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Numerator degrees of freedom")), df1Entry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Denominator degrees of freedom")), df2Entry, sticky="e")    
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=quantilesVar)
    rateVar <- tclVar("1")
    rateEntry <- tkentry(top, width="6", textvariable=rateVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" ", ",", tclvalue(quantilesVar))
        if ("" == quantiles) {
            errorCondition(recall=exponentialQuantiles, message=gettextRcmdr("Probabilities not specified."))
            return()
            }
        rate <- as.numeric(tclvalue(rateVar))
        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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Rate")), rateEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=probabilitiesVar)
    rateVar <- tclVar("1")
    rateEntry <- tkentry(top, width="6", textvariable=rateVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <- gsub(" ", ",", tclvalue(probabilitiesVar))
        if ("" == probabilities) {
            errorCondition(recall=exponentialProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
        rate <- as.numeric(tclvalue(rateVar))
        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(tklabel(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Rate")), rateEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=quantilesVar)
    minVar <- tclVar("0")
    maxVar <- tclVar("1")
    minEntry <- tkentry(top, width="6", textvariable=minVar)
    maxEntry <- tkentry(top, width="6", textvariable=maxVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" ", ",", tclvalue(quantilesVar))
        if ("" == quantiles) {
            errorCondition(recall=uniformQuantiles, message=gettextRcmdr("Probabilities not specified."))
            return()
            }
        min <- as.numeric(tclvalue(minVar))
        max <- as.numeric(tclvalue(maxVar))
        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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Minimum")), minEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Maximum")), maxEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=probabilitiesVar)
    minVar <- tclVar("0")
    maxVar <- tclVar("1")
    minEntry <- tkentry(top, width="6", textvariable=minVar)
    maxEntry <- tkentry(top, width="6", textvariable=maxVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <- gsub(" ", ",", tclvalue(probabilitiesVar))
        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()
            }
        min <- as.numeric(tclvalue(minVar))
        max <- as.numeric(tclvalue(maxVar))
        tail <- tclvalue(tailVar)
        doItAndPrint(paste("punif(c(", probabilities, "), min=", min, ", max=", max, ", lower.tail=", tail == "lower", ")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="punif")
    tkgrid(tklabel(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Minimum")), minEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Maximum")), maxEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=quantilesVar)
    shape1Var <- tclVar("")
    shape1Entry <- tkentry(top, width="6", textvariable=shape1Var)
    shape2Var <- tclVar("")
    shape2Entry <- tkentry(top, width="6", textvariable=shape2Var)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" ", ",", tclvalue(quantilesVar))
        if ("" == quantiles) {
            errorCondition(recall=betaQuantiles, message=gettextRcmdr("Probabilities not specified"))
            return()
            }
        shape1 <- as.numeric(tclvalue(shape1Var))
        shape2 <- as.numeric(tclvalue(shape2Var))
        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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=paste(gettextRcmdr("Shape"), "1")), shape1Entry, sticky="e")
    tkgrid(tklabel(top, text=paste(gettextRcmdr("Shape"), "2")), shape2Entry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=probabilitiesVar)
    shape1Var <- tclVar("")
    shape1Entry <- tkentry(top, width="6", textvariable=shape1Var)
    shape2Var <- tclVar("")
    shape2Entry <- tkentry(top, width="6", textvariable=shape2Var)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <- gsub(" ", ",", tclvalue(probabilitiesVar))
        if ("" == probabilities) {
            errorCondition(recall=betaProbabilities, message=gettextRcmdr("Values not specified."))
            return()
            }
        shape1 <- as.numeric(tclvalue(shape1Var))
        shape2 <- as.numeric(tclvalue(shape2Var))
        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(tklabel(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=paste(gettextRcmdr("Shape"), "1")), shape1Entry, sticky="e")
    tkgrid(tklabel(top, text=paste(gettextRcmdr("Shape"), "2")), shape2Entry, sticky="e")    
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=quantilesVar)
    locationVar <- tclVar("0")
    locationEntry <- tkentry(top, width="6", textvariable=locationVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" ", ",", tclvalue(quantilesVar))
        if ("" == quantiles) {
            errorCondition(recall=CauchyQuantiles, message=gettextRcmdr("No probabilities specified."))
            return()
            }
        location <- as.numeric(tclvalue(locationVar))
        s <- as.numeric(tclvalue(sVar))
        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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Location")), locationEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=probabilitiesVar)
    locationVar <- tclVar("0")
    locationEntry <- tkentry(top, width="6", textvariable=locationVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <- gsub(" ", ",", tclvalue(probabilitiesVar))
        if ("" == probabilities) {
            errorCondition(recall=CauchyProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
        location <- as.numeric(tclvalue(locationVar))
        s <- as.numeric(tclvalue(sVar))
        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(tklabel(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Location")), locationEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=quantilesVar)
    locationVar <- tclVar("0")
    locationEntry <- tkentry(top, width="6", textvariable=locationVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" ", ",", tclvalue(quantilesVar))
        if ("" == quantiles) {
            errorCondition(recall=logisticQuantiles, message=gettextRcmdr("No probabilities specified."))
            return()
            }
        location <- as.numeric(tclvalue(locationVar))
        s <- as.numeric(tclvalue(sVar))
        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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Location")), locationEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=probabilitiesVar)
    locationVar <- tclVar("0")
    locationEntry <- tkentry(top, width="6", textvariable=locationVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <- gsub(" ", ",", tclvalue(probabilitiesVar))
        if ("" == probabilities) {
            errorCondition(recall=logisticProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
        location <- as.numeric(tclvalue(locationVar))
        s <- as.numeric(tclvalue(sVar))
        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(tklabel(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Location")), locationEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=quantilesVar)
    meanlogVar <- tclVar("0")
    meanlogEntry <- tkentry(top, width="6", textvariable=meanlogVar)
    sdlogVar <- tclVar("1")
    sdlogEntry <- tkentry(top, width="6", textvariable=sdlogVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" ", ",", tclvalue(quantilesVar))
        if ("" == quantiles) {
            errorCondition(recall=lognormalQuantiles, message=gettextRcmdr("No probabilities specified."))
            return()
            }
        meanlog <- as.numeric(tclvalue(meanlogVar))
        sdlog <- as.numeric(tclvalue(sdlogVar))
        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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Mean (log scale)")), meanlogEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Standard deviation (log scale)")), sdlogEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=probabilitiesVar)
    meanlogVar <- tclVar("0")
    meanlogEntry <- tkentry(top, width="6", textvariable=meanlogVar)
    sdlogVar <- tclVar("1")
    sdlogEntry <- tkentry(top, width="6", textvariable=sdlogVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <- gsub(" ", ",", tclvalue(probabilitiesVar))
        if ("" == probabilities) {
            errorCondition(recall=lognormalProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
        meanlog <- as.numeric(tclvalue(meanlogVar))
        sdlog <- as.numeric(tclvalue(sdlogVar))
        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(tklabel(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Mean (log scale)")), meanlogEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Standard deviation (log scale)")), sdlogEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=quantilesVar)
    shapeVar <- tclVar("")
    shapeEntry <- tkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" ", ",", tclvalue(quantilesVar))
        if ("" == quantiles) {
            errorCondition(recall=gammaQuantiles, message=gettextRcmdr("No probabilities specified."))
            return()
            }
        shape <- as.numeric(tclvalue(shapeVar))
        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()
            }
        s <- as.numeric(tclvalue(sVar))
        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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Shape")), shapeEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale (inverse rate)")), sEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=probabilitiesVar)
    shapeVar <- tclVar("")
    shapeEntry <- tkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <- gsub(" ", ",", tclvalue(probabilitiesVar))
        if ("" == probabilities) {
            errorCondition(recall=gammaProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
        shape <- as.numeric(tclvalue(shapeVar))
        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()
            }
        s <- as.numeric(tclvalue(sVar))
        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(tklabel(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Shape")), shapeEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale (inverse rate)")), sEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=quantilesVar)
    shapeVar <- tclVar("")
    shapeEntry <- tkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" ", ",", tclvalue(quantilesVar))
        if ("" == quantiles) {
            errorCondition(recall=WeibullQuantiles, message=gettextRcmdr("No probabilities specified."))
            return()
            }
        shape <- as.numeric(tclvalue(shapeVar))
        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()
            }
        s <- as.numeric(tclvalue(sVar))
        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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Shape")), shapeEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=probabilitiesVar)
    shapeVar <- tclVar("")
    shapeEntry <- tkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <- gsub(" ", ",", tclvalue(probabilitiesVar))
        if ("" == probabilities) {
            errorCondition(recall=WeibullProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
        shape <- as.numeric(tclvalue(shapeVar))
        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()
            }
        s <- as.numeric(tclvalue(sVar))
        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(tklabel(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Shape")), shapeEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=quantilesVar)
    shapeVar <- tclVar("")
    shapeEntry <- tkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" ", ",", tclvalue(quantilesVar))
        if ("" == quantiles) {
            errorCondition(recall=GumbelQuantiles, message=gettextRcmdr("No probabilities specified."))
            return()
            }
        shape <- as.numeric(tclvalue(shapeVar))
        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()
            }
        s <- as.numeric(tclvalue(sVar))
        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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Shape (log scale)")), shapeEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale (log scale)")), sEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=probabilitiesVar)
    shapeVar <- tclVar("")
    shapeEntry <- tkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <- gsub(" ", ",", tclvalue(probabilitiesVar))
        if ("" == probabilities) {
            errorCondition(recall=GumbelProbabilities, message=gettextRcmdr("No values specified."))
            return()
            }
        shape <- as.numeric(tclvalue(shapeVar))
        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()
            }
        s <- as.numeric(tclvalue(sVar))
        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(tklabel(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Shape (log scale)")), shapeEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale (log scale)")), sEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=quantilesVar)
    trialsVar <- tclVar("")
    trialsEntry <- tkentry(top, width="6", textvariable=trialsVar)
    probVar <- tclVar(".5")
    probEntry <- tkentry(top, width="6", textvariable=probVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" ", ",", tclvalue(quantilesVar))
        trials <- round(as.numeric(tclvalue(trialsVar)))
        prob <- as.numeric(tclvalue(probVar))
        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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Binomial trials")), trialsEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=probabilitiesVar)
    trialsVar <- tclVar("")
    trialsEntry <- tkentry(top, width="6", textvariable=trialsVar)
    probVar <- tclVar(".5")
    probEntry <- tkentry(top, width="6", textvariable=probVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <- gsub(" ", ",", tclvalue(probabilitiesVar))
        trials <- round(as.numeric(tclvalue(trialsVar)))
        prob <- as.numeric(tclvalue(probVar))
        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(tklabel(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Binomial trials")), trialsEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")    
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=trialsVar)
    probVar <- tclVar(".5")
    probEntry <- tkentry(top, width="6", textvariable=probVar)
    onOK <- function(){
        closeDialog()
        trials <- as.numeric(tclvalue(trialsVar))
        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()
                }
            }
        prob <- as.numeric(tclvalue(probVar))
        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(tklabel(top, text=gettextRcmdr("Binomial trials")), trialsEntry, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=meanVar)
    onOK <- function(){
        closeDialog()
        mean <- as.numeric(tclvalue(meanVar))
        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(tklabel(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 <- tkentry(top, width="30", textvariable=quantilesVar)
    lambdaVar <- tclVar("1")
    lambdaEntry <- tkentry(top, width="6", textvariable=lambdaVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- 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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Mean")),lambdaEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=probabilitiesVar)
    lambdaVar <- tclVar("1")
    lambdaEntry <- tkentry(top, width="6", textvariable=lambdaVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <- 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(tklabel(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Mean")), lambdaEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=quantilesVar)
    probVar <- tclVar("0.5")
    probEntry <- tkentry(top, width="6", textvariable=probVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- 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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=probabilitiesVar)
    probVar <- tclVar("0.5")
    probEntry <- tkentry(top, width="6", textvariable=probVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <- 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(tklabel(top, text=gettextRcmdr("Variable value(s)")), probabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=probVar)
    onOK <- function(){
        closeDialog()
        prob <- as.numeric(tclvalue(probVar))
        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(tklabel(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 <- tkentry(top, width="30", textvariable=quantilesVar)
    mVar <- tclVar("1")
    mEntry <- tkentry(top, width="6", textvariable=mVar)
    nVar <- tclVar("1")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    kVar <- tclVar("1")
    kEntry <- tkentry(top, width="6", textvariable=kVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" ", ",", tclvalue(quantilesVar))
        if ("" == quantiles) {
              errorCondition(recall=hyperQuantiles, message=gettextRcmdr("No probabilities specified."))
              return()
        }
        m <- as.numeric(tclvalue(mVar))
        n <- as.numeric(tclvalue(nVar))
        k <- as.numeric(tclvalue(kVar))
        # 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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("m (number of white balls in the urn)")), mEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("n (number of black balls in the urn)")), nEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("k (number of balls drawn from the urn)")), kEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=ProbabilitiesVar)
    mVar <- tclVar("1")
    mEntry <- tkentry(top, width="6", textvariable=mVar)
    nVar <- tclVar("1")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    kVar <- tclVar("1")
    kEntry <- tkentry(top, width="6", textvariable=kVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        probabilities <- gsub(" ", ",", tclvalue(ProbabilitiesVar))
        if ("" == probabilities) {
              errorCondition(recall=hyperProbabilities.ipsr, message=gettextRcmdr("No values specified."))
              return()
        }
        m <- as.numeric(tclvalue(mVar))
        n <- as.numeric(tclvalue(nVar))
        k <- as.numeric(tclvalue(kVar))
        # 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(tklabel(top, text=gettextRcmdr("Variable value(s)")), ProbabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("m (number of white balls in the urn)")), mEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("n (number of black balls in the urn)")), nEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("k (number of balls drawn from the urn)")), kEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=mVar)
    nVar <- tclVar("1")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    kVar <- tclVar("1")
    kEntry <- tkentry(top, width="6", textvariable=kVar)
    onOK <- function(){
        closeDialog()
        m <- as.numeric(tclvalue(mVar))
        n <- as.numeric(tclvalue(nVar))
        k <- as.numeric(tclvalue(kVar))
        # 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(tklabel(top, text=gettextRcmdr("m (number of white balls in the urn)")), mEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("n (number of black balls in the urn)")), nEntry, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=quantilesVar)
    sizeVar <- tclVar("1")
    sizeEntry <- tkentry(top, width="6", textvariable=sizeVar)
    probVar <- tclVar("0.5")
    probEntry <- tkentry(top, width="6", textvariable=probVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" ", ",", tclvalue(quantilesVar))
        if ("" == quantiles) {
              errorCondition(recall=negbinomialQuantiles, 
                message=gettextRcmdr("No probabilities specified."))
              return()
          }
        size <- as.numeric(tclvalue(sizeVar))
        prob <- as.numeric(tclvalue(probVar))
        # 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(tklabel(top, text=gettextRcmdr("Probabilities")), quantilesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Target number of successes")), sizeEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="30", textvariable=ProbabilitiesVar)
    sizeVar <- tclVar("1")
    sizeEntry <- tkentry(top, width="6", textvariable=sizeVar)
    probVar <- tclVar("0.5")
    probEntry <- tkentry(top, width="6", textvariable=probVar)
    tailVar <- tclVar("lower")
    lowerTailButton <- tkradiobutton(top, variable=tailVar, value="lower")
    upperTailButton <- tkradiobutton(top, variable=tailVar, value="upper")
    onOK <- function(){
        closeDialog()
        quantiles <- gsub(" ", ",", tclvalue(ProbabilitiesVar))
        if ("" == quantiles) {
              errorCondition(recall=negbinomialProbabilities, 
                message=gettextRcmdr("No values specified."))
              return()
        }
        size <- as.numeric(tclvalue(sizeVar))
        prob <- as.numeric(tclvalue(probVar))
        # 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(tklabel(top, text=gettextRcmdr("Variable value(s)")), ProbabilitiesEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Target number of successes")), sizeEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Lower tail")), lowerTailButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=trialsVar)
    probVar <- tclVar("0.5")
    probEntry <- tkentry(top, width="6", textvariable=probVar)
    onOK <- function(){
        closeDialog()
        trials <- as.numeric(tclvalue(trialsVar))
        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)
        prob <- as.numeric(tclvalue(probVar))
        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(tklabel(top, text=gettextRcmdr("Target number of successes")), trialsEntry, sticky="e")
    tkgrid(tklabel(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.13/QCAGUI/R/distributions-plotDistributions-menu.R"
# Distributions menu dialogs for plots

# last modified 28 July 06 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 <- tkentry(top, width="6", textvariable=muVar)
    sigmaVar <- tclVar("1")
    sigmaEntry <- tkentry(top, width="6", textvariable=sigmaVar)
    functionVar <- tclVar("Density")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        mu <- as.numeric(tclvalue(muVar))
        sigma <- as.numeric(tclvalue(sigmaVar))
        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=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(tklabel(top, text=gettextRcmdr("mu (mean)")), muEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("sigma (standard deviation)")), sigmaEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=dfVar)
    functionVar <- tclVar("Density")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        df <- as.numeric(tclvalue(dfVar))
        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=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(tklabel(top, text=gettextRcmdr("Degrees of freedom")), dfEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=dfVar)
    functionVar <- tclVar("Density")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        df <- as.numeric(tclvalue(dfVar))
        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=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(tklabel(top, text=gettextRcmdr("Degrees of freedom")), dfEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=df1Var)
    df2Entry <- tkentry(top, width="6", textvariable=df2Var)
    functionVar <- tclVar("Density")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        df1 <- as.numeric(tclvalue(df1Var))
        df2 <- as.numeric(tclvalue(df2Var))
        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=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(tklabel(top, text=gettextRcmdr("Numerator degrees of freedom")), df1Entry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Denominator degrees of freedom")), df2Entry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=rateVar)
    functionVar <- tclVar("Density")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        rate <- as.numeric(tclvalue(rateVar))
        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=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(tklabel(top, text=gettextRcmdr("Rate")), rateEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=minVar)
    maxEntry <- tkentry(top, width="6", textvariable=maxVar)
    functionVar <- tclVar("Density")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        minValue <- as.numeric(tclvalue(minVar))
        maxValue <- as.numeric(tclvalue(maxVar))
        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=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(tklabel(top, text=gettextRcmdr("Minimum")), minEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Maximum")), maxEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=shape1Var)
    shape2Entry <- tkentry(top, width="6", textvariable=shape2Var)
    functionVar <- tclVar("Density")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        shape1 <- as.numeric(tclvalue(shape1Var))
        shape2 <- as.numeric(tclvalue(shape2Var))
        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=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(tklabel(top, text=paste(gettextRcmdr("Shape"), "1")), shape1Entry, sticky="e")
    tkgrid(tklabel(top, text=paste(gettextRcmdr("Shape"), 2)), shape2Entry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=locationVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    functionVar <- tclVar("Density")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        location <- as.numeric(tclvalue(locationVar))
        s <- as.numeric(tclvalue(sVar))
        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=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(tklabel(top, text=gettextRcmdr("Location")), locationEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=locationVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    functionVar <- tclVar("Density")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        location <- as.numeric(tclvalue(locationVar))
        s <- as.numeric(tclvalue(sVar))
        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=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(tklabel(top, text=gettextRcmdr("Location")), locationEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=meanlogVar)
    sdlogVar <- tclVar("1")
    sdlogEntry <- tkentry(top, width="6", textvariable=sdlogVar)
    functionVar <- tclVar("Density")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        meanlog <- as.numeric(tclvalue(meanlogVar))
        sdlog <- as.numeric(tclvalue(sdlogVar))
        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=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(tklabel(top, text=gettextRcmdr("Mean (log scale)")), meanlogEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Standard deviation (log scale)")), sdlogEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    functionVar <- tclVar("Density")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        shape <- as.numeric(tclvalue(shapeVar))
        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()
            }
        s <- as.numeric(tclvalue(sVar))
        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=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(tklabel(top, text=gettextRcmdr("Shape")), shapeEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale (inverse rate)")), sEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    functionVar <- tclVar("Density")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        shape <- as.numeric(tclvalue(shapeVar))
        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()
            }
        s <- as.numeric(tclvalue(sVar))
        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=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(tklabel(top, text=gettextRcmdr("Shape")), shapeEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale")), sEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    functionVar <- tclVar("Density")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Density")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        shape <- as.numeric(tclvalue(shapeVar))
        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()
            }
        s <- as.numeric(tclvalue(sVar))
        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=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(tklabel(top, text=gettextRcmdr("Shape (log shape)")), shapeEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale (log scale)")), sEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot density function")), densityButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=trialsVar)
    probVar <- tclVar(".5")
    probEntry <- tkentry(top, width="6", textvariable=probVar)
    functionVar <- tclVar("Probability")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Probability")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        trials <- round(as.numeric(tclvalue(trialsVar)))
        if (is.na(trials)) {
            errorCondition(recall=binomialDistributionPlot, message=gettextRcmdr("Binomial trials not specified."))
            return()
            } 
        prob <- as.numeric(tclvalue(probVar))
        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(tklabel(top, text=gettextRcmdr("Binomial trials")), trialsEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot probability mass function")), densityButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=meanVar)
    functionVar <- tclVar("Probability")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Probability")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        mean <- as.numeric(tclvalue(meanVar))
        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(tklabel(top, text=gettextRcmdr("Mean")), meanEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot probability mass function")), densityButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=probVar)
    functionVar <- tclVar("Probability")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Probability")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        prob <- as.numeric(tclvalue(probVar))
        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(tklabel(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot probability mass function")), densityButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=mVar)
    nVar <- tclVar("1")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    kVar <- tclVar("1")
    kEntry <- tkentry(top, width="6", textvariable=kVar)
    functionVar <- tclVar("Probability")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Probability")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        m <- as.numeric(tclvalue(mVar))
        n <- as.numeric(tclvalue(nVar))
        k <- as.numeric(tclvalue(kVar))
        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(tklabel(top, text=gettextRcmdr("m (number of white balls in the urn)")), mEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("n (number of black balls in the urn)")), nEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("k (number of balls drawn from the urn)")), kEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot probability mass function")), densityButton, sticky="e")
    tkgrid(tklabel(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 <- tkentry(top, width="6", textvariable=trialsVar)
    probVar <- tclVar("0.5")
    probEntry <- tkentry(top, width="6", textvariable=probVar)
    functionVar <- tclVar("Probability")
    densityButton <- tkradiobutton(top, variable=functionVar, value="Probability")
    distributionButton <- tkradiobutton(top, variable=functionVar, value="Cumulative Probability")
    onOK <- function(){
        closeDialog()
        trials <- as.numeric(tclvalue(trialsVar))
        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)
        prob <- as.numeric(tclvalue(probVar))
        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(tklabel(top, text=gettextRcmdr("Target number of successes")), trialsEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="e")
    tkgrid(tklabel(top, text=gettextRcmdr("Plot probability mass function")), densityButton, sticky="e")
    tkgrid(tklabel(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.13/QCAGUI/R/distributions-sample.R"
# Distributions menu dialogs for selecting samples

# last modified 26 July 06 by J. Fox

normalDistributionSamples <- function(){
    initializeDialog(title=gettextRcmdr("Sample from Normal Distribution"))
    dsname <- tclVar(gettextRcmdr("NormalSamples"))
    dsFrame <- tkframe(top)
    entryDsname <- tkentry(dsFrame, width="20", textvariable=dsname)
    muVar <- tclVar("0")
    muEntry <- tkentry(top, width="6", textvariable=muVar)
    sigmaVar <- tclVar("1")
    sigmaEntry <- tkentry(top, width="6", textvariable=sigmaVar)
    nVar <- tclVar("100")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        mu <- as.numeric(tclvalue(muVar))
        sigma <- as.numeric(tclvalue(sigmaVar))
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("mu (mean)")), muEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("sigma (standard deviation)")), sigmaEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(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 <- tkentry(dsFrame, width="20", textvariable=dsname)
    dfVar <- tclVar("")
    dfEntry <- tkentry(top, width="6", textvariable=dfVar)
    nVar <- tclVar("100")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        df <- as.numeric(tclvalue(dfVar))
        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()
            }
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Degrees of freedom")), dfEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(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 <- tkentry(dsFrame, width="20", textvariable=dsname)
    dfVar <- tclVar("")
    dfEntry <- tkentry(top, width="6", textvariable=dfVar)
    nVar <- tclVar("100")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        df <- as.numeric(tclvalue(dfVar))
        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()
            }
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Degrees of freedom")), dfEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(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 <- tkentry(dsFrame, width="20", textvariable=dsname)
    df1Var <- tclVar("")
    df2Var <- tclVar("")
    df1Entry <- tkentry(top, width="6", textvariable=df1Var)
    df2Entry <- tkentry(top, width="6", textvariable=df2Var)
    nVar <- tclVar("100")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        df1 <- as.numeric(tclvalue(df1Var))
        df2 <- as.numeric(tclvalue(df2Var))
        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()
            }
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Numerator degrees of freedom")), df1Entry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Denominator degrees of freedom")), df2Entry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(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 <- tkentry(dsFrame, width="20", textvariable=dsname)
    rateVar <- tclVar("1")
    rateEntry <- tkentry(top, width="6", textvariable=rateVar)
    nVar <- tclVar("100")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        rate <- as.numeric(tclvalue(rateVar))
        if (is.na(rate) || rate <= 0) {
            errorCondition(recall=exponentialDistributionPlot, 
                message=gettextRcmdr("Rate must be positive."))
            return()
            }
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Rate")), rateEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(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 <- tkentry(dsFrame, width="20", textvariable=dsname)
    minVar <- tclVar("0")
    maxVar <- tclVar("1")
    minEntry <- tkentry(top, width="6", textvariable=minVar)
    maxEntry <- tkentry(top, width="6", textvariable=maxVar)
    nVar <- tclVar("100")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        minValue <- as.numeric(tclvalue(minVar))
        maxValue <- as.numeric(tclvalue(maxVar))
        if (is.na(minValue) || is.na(maxValue) || minValue >= maxValue) {
            errorCondition(recall=uniformDistributionSamples, 
                message=gettextRcmdr("Lower limit must be less than upper limit."))
            return()
            }
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Minimum")), minEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Maximum")), maxEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(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 <- tkentry(dsFrame, width="20", textvariable=dsname)
    shape1Var <- tclVar("")
    shape1Entry <- tkentry(top, width="6", textvariable=shape1Var)
    shape2Var <- tclVar("")
    shape2Entry <- tkentry(top, width="6", textvariable=shape2Var)
    nVar <- tclVar("100")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        shape1 <- as.numeric(tclvalue(shape1Var))
        shape2 <- as.numeric(tclvalue(shape2Var))
        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()
            }
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Shape 1")), shape1Entry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Shape 2")), shape2Entry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(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 <- tkentry(dsFrame, width="20", textvariable=dsname)
    locationVar <- tclVar("0")
    locationEntry <- tkentry(top, width="6", textvariable=locationVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    nVar <- tclVar("100")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        location <- as.numeric(tclvalue(locationVar))
        s <- as.numeric(tclvalue(sVar))
        if (is.na(s) || s <= 0) {
            errorCondition(recall=CauchyDistributionSamples, 
                message=gettextRcmdr("Scale must be positive."))
            return()
            }
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Location")), locationEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale")), sEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(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 <- tkentry(dsFrame, width="20", textvariable=dsname)
    locationVar <- tclVar("0")
    locationEntry <- tkentry(top, width="6", textvariable=locationVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    nVar <- tclVar("100")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        location <- as.numeric(tclvalue(locationVar))
        s <- as.numeric(tclvalue(sVar))
        if (is.na(s) || s <= 0) {
            errorCondition(recall=logisticDistributionSamples, 
                message=gettextRcmdr("Scale must be positive."))
            return()
            }
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Location")), locationEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale")), sEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(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 <- tkentry(dsFrame, width="20", textvariable=dsname)
    meanlogVar <- tclVar("0")
    meanlogEntry <- tkentry(top, width="6", textvariable=meanlogVar)
    sdlogVar <- tclVar("1")
    sdlogEntry <- tkentry(top, width="6", textvariable=sdlogVar)
    nVar <- tclVar("100")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        meanlog <- as.numeric(tclvalue(meanlogVar))
        sdlog <- as.numeric(tclvalue(sdlogVar))
        if (is.na(sdlog) || sdlog <= 0) {
            errorCondition(recall=lognormalDistributionSamples, 
                message=gettextRcmdr("Standard deviation must be positive."))
            return()
            }
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Mean (log scale)")), meanlogEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Standard deviation (log scale)")), sdlogEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(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 <- tkentry(dsFrame, width="20", textvariable=dsname)
    shapeVar <- tclVar("")
    shapeEntry <- tkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    nVar <- tclVar("100")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        shape <- as.numeric(tclvalue(shapeVar))
        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()
            }
        s <- as.numeric(tclvalue(sVar))
        if (is.na(s) || s <= 0) {
            errorCondition(recall=gammaDistributionSamples, 
                message=gettextRcmdr("Scale must be positive."))
            return()
            }
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Shape")), shapeEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale (inverse rate)")), sEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(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 <- tkentry(dsFrame, width="20", textvariable=dsname)
    shapeVar <- tclVar("")
    shapeEntry <- tkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    nVar <- tclVar("100")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        shape <- as.numeric(tclvalue(shapeVar))
        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()
            }
        s <- as.numeric(tclvalue(sVar))
        if (is.na(s) || s <= 0) {
            errorCondition(recall=WeibullDistributionSamples, 
                message=gettextRcmdr("Scale must be positive."))
            return()
            }
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Shape")), shapeEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale")), sEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(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 <- tkentry(dsFrame, width="20", textvariable=dsname)
    shapeVar <- tclVar("")
    shapeEntry <- tkentry(top, width="6", textvariable=shapeVar)
    sVar <- tclVar("1")
    sEntry <- tkentry(top, width="6", textvariable=sVar)
    nVar <- tclVar("100")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        shape <- as.numeric(tclvalue(shapeVar))
        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()
            }
        s <- as.numeric(tclvalue(sVar))
        if (is.na(s) || s <= 0) {
            errorCondition(recall=GumbelDistributionSamples, 
                message=gettextRcmdr("Scale must be positive."))
            return()
            }
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Shape (log shape)")), shapeEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Scale (log scale)")), sEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(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 <- tkentry(dsFrame, width="20", textvariable=dsname)
    probVar <- tclVar(".5")
    probEntry <- tkentry(top, width="6", textvariable=probVar)
    trialsVar <- tclVar("1")
    trialsEntry <- tkentry(top, width="6", textvariable=trialsVar) 
    nVar <- tclVar("100")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        prob <- as.numeric(tclvalue(probVar))
        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()
            }
        trials <- round(as.numeric(tclvalue(trialsVar)))
        if (is.na(trials)) {
            errorCondition(recall=binomialDistributionSamples, 
                message=gettextRcmdr("Binomial trials not specified."))
            return()
            }
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Binomial trials")), trialsEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(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 <- tkentry(dsFrame, width="20", textvariable=dsname)
    meanVar <- tclVar("")
    meanEntry <- tkentry(top, width="6", textvariable=meanVar)
    nVar <- tclVar("100")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        mean <- as.numeric(tclvalue(meanVar))
        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()
            }
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Mean")), meanEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(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 <- tkentry(dsFrame, width="20", textvariable=dsname)
    probVar <- tclVar(".5")
    probEntry <- tkentry(top, width="6", textvariable=probVar)
    nVar <- tclVar("100")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        prob <- as.numeric(tclvalue(probVar))
        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()
            }
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname,
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(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 <- tkentry(dsFrame, width="20", textvariable=dsname)
    mVar <- tclVar("1")
    mEntry <- tkentry(top, width="6", textvariable=mVar)
    nVar <- tclVar("1")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    kVar <- tclVar("1")
    kEntry <- tkentry(top, width="6", textvariable=kVar)
    sampleSizeVar <- tclVar("100")
    sampleSizeEntry <- tkentry(top, width="6", textvariable=sampleSizeVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        m <- as.numeric(tclvalue(mVar))
        n <- as.numeric(tclvalue(nVar))
        k <- as.numeric(tclvalue(kVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname,
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("m (number of white balls in the urn)")), mEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("n (number of black balls in the urn)")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("k (number of balls drawn from the urn)")), kEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), sampleSizeEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(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 <- tkentry(dsFrame, width="22", textvariable=dsname)
    probVar <- tclVar(".5")
    probEntry <- tkentry(top, width="6", textvariable=probVar)
    trialsVar <- tclVar("1")
    trialsEntry <- tkentry(top, width="6", textvariable=trialsVar) 
    nVar <- tclVar("100")
    nEntry <- tkentry(top, width="6", textvariable=nVar)
    samplesVar <- tclVar("1")
    samplesEntry <- tkentry(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()
                }
            }
        prob <- as.numeric(tclvalue(probVar))
        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()
            }
        trials <- round(as.numeric(tclvalue(trialsVar)))
        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()
          }
        n <- as.numeric(tclvalue(nVar))
        samples <- as.numeric(tclvalue(samplesVar))
        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(tklabel(dsFrame, text=gettextRcmdr("Enter name for data set:")), entryDsname, 
        sticky="w")
    tkgrid(dsFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Target number of successes")), trialsEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Probability of success")), probEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of samples (rows) ")), samplesEntry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Number of observations (columns) ")), nEntry, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(tklabel(top, text=gettextRcmdr("Add to Data Set:"), fg="blue"), sticky="w")
    tkgrid(checkBoxFrame, columnspan=2, sticky="w")
    tkgrid(tklabel(top, text=""))
    tkgrid(buttonsFrame, columnspan=2, sticky="w")
    dialogSuffix(rows=11, columns=2, focus=trialsEntry)
    }

#line 1 "d:/RCompile/CRANpkg/local/2.13/QCAGUI/R/file-menu.R"
# last modified 18 May 2007 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()
    
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))
        }
    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)
    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("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", 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 <- tkentry(contrastsFrame, width="15", textvariable=contrasts1)  
    contrasts2Entry <- tkentry(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 <- tkentry(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 <- list(
            log.font.size=log.font.size,
            log.width=log.width,
            log.height=log.height,
            log.commands=log.commands,
            output.height=output.height,
            console.output=console.output,
            contrasts=contrasts,
            grab.focus=grab.focus,
            double.click=double.click,
            sort.names=sort.names,
            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")
    tkgrid(tklabel(top, text=gettextRcmdr("Log commands to script window")), logCommandsCheckBox, sticky="e")
    tkgrid.configure(logCommandsCheckBox, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Log-font size (points)")), logFontSizeSlider, sticky="se")
    tkgrid.configure(logFontSizeSlider, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Log width (characters)")), logWidthSlider, sticky="se")
    tkgrid.configure(logWidthSlider, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Log height (lines)")), logHeightSlider, sticky="se")
    tkgrid.configure(logHeightSlider, sticky="w")
    tkgrid(tklabel(top, text=" "), sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Send output to R Console")), consoleOutputCheckBox, sticky="e")
    tkgrid.configure(consoleOutputCheckBox, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Output height (lines)")), outputHeightSlider, sticky="se")
    tkgrid.configure(outputHeightSlider, sticky="w")
    tkgrid(tklabel(contrastsFrame, text=gettextRcmdr("Unordered factors")), tklabel(contrastsFrame, text="   "),
        tklabel(contrastsFrame, text=gettextRcmdr("Ordered factors")), sticky="w")
    tkgrid(contrasts1Entry, tklabel(contrastsFrame, text="   "), contrasts2Entry, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Contrasts")), contrastsFrame, sticky="se")
    tkgrid.configure(contrastsFrame, sticky="sw")
    tkgrid(tklabel(top, text=gettextRcmdr("Active window grabs focus")), grabFocusCheckBox, sticky="e")
    tkgrid.configure(grabFocusCheckBox, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Double-click presses OK button")), doubleClickCheckBox, sticky="e")
    tkgrid.configure(doubleClickCheckBox, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Sort variable names alphabetically")), sortNamesCheckBox, sticky="e")
    tkgrid.configure(sortNamesCheckBox, sticky="w")
    tkgrid(tklabel(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)
    if (.Platform$OS.type == "windows"){
        tkgrid(tklabel(top, text=gettextRcmdr("Scale factor for Tk elements")), scaleFactorSlider, sticky="se")
        tkgrid.configure(scaleFactorSlider, sticky="w")
        }
    else {
        tkgrid(tklabel(top, text=gettextRcmdr("Default font")), defaultFontEntry, sticky="e")
        tkgrid.configure(defaultFontEntry, sticky="w")
        }
    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) {
            command <- paste('library("', package, '", 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)
    }

#line 1 "d:/RCompile/CRANpkg/local/2.13/QCAGUI/R/graphs-menu.R"
# Graphs menu dialogs

# last modified 21 July 2007 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=gettextRcmdr("Use left mouse button to identify points,\nright button to exit."),
                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 <- tkradiobutton(optionsFrame, variable=typeVariable, value="spikes")
    pointsButton <- tkradiobutton(optionsFrame, variable=typeVariable, value="points")
    identifyVariable <- tclVar("0")
    identifyCheckBox <- tkcheckbutton(optionsFrame, variable=identifyVariable)
    tkgrid(getFrame(xBox), sticky="nw")    
    tkgrid(tklabel(optionsFrame, text=gettextRcmdr("Identify observations\nwith mouse"), justify="left"), 
        identifyCheckBox, sticky="w")
    tkgrid(tklabel(optionsFrame, text=gettextRcmdr("Spikes")), spikesButton, sticky="w")
    tkgrid(tklabel(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 <- tkentry(binsFrame, width="6", textvariable=binsVariable)
    tkgrid(getFrame(xBox), sticky="nw")    
    tkgrid(tklabel(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(){
    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 <- tklabel(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, ")", sep="")
        doItAndPrint(command)
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="stem.leaf")
    tkgrid(getFrame(xBox), sticky="nw")
    tkgrid(tklabel(leafsFrame, text=gettextRcmdr("Leafs Digit:  "), fg="blue"),
        tklabel(leafsFrame, text=gettextRcmdr("Automatic")), leafsDigitCheckBox,
        tklabel(leafsFrame, text=gettextRcmdr("  or set:"), fg="red"), leafsDigitShow, leafsDigitSlider, sticky="w")  
    tkgrid(leafsFrame, sticky="w") 
    tkgrid(partsFrame, sticky="w")
    tkgrid(styleFrame, sticky="w")
    tkgrid(tklabel(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=gettextRcmdr("Use left mouse button to identify points,\nright button to exit."),
                    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=gettextRcmdr("Use left mouse button to identify points,\nright button to exit."),
                    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(tklabel(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)"))
    checkBoxes(frame="optionsFrame", boxes=c("identify", "jitterX", "jitterY", "boxplots", "lsLine", "smoothLine"),
        initialValues=c(0, 0, 0, 1, 1, 1), labels=gettextRcmdr(c("Identify points", "Jitter x-variable", "Jitter y-variable",
        "Marginal boxplots", "Least-squares line", "Smooth Line")))
    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 <- tkentry(xlabFrame, width="25", textvariable=xlabVar)
    xlabScroll <- tkscrollbar(xlabFrame, orient="horizontal",
        repeatinterval=5, command=function(...) tkxview(xlabEntry, ...))
    tkconfigure(xlabEntry, xscrollcommand=function(...) tkset(xlabScroll, ...))
    tkgrid(tklabel(xlabFrame, text=gettextRcmdr("x-axis label"), fg="blue"), sticky="w")
    tkgrid(xlabEntry, sticky="w")
    tkgrid(xlabScroll, sticky="ew")
    ylabFrame <- tkframe(labelsFrame)
    ylabEntry <- tkentry(ylabFrame, width="25", textvariable=ylabVar)
    ylabScroll <- tkscrollbar(ylabFrame, orient="horizontal",
        repeatinterval=5, command=function(...) tkxview(ylabEntry, ...))
    tkconfigure(ylabEntry, xscrollcommand=function(...) tkset(ylabScroll, ...))
    tkgrid(tklabel(ylabFrame, text=gettextRcmdr("y-axis label"), fg="blue"), sticky="w")
    tkgrid(ylabEntry, sticky="w")
    tkgrid(ylabScroll, sticky="ew")
    tkgrid(xlabFrame, tklabel(labelsFrame, text="     "), ylabFrame, sticky="w")    
    parFrame <- tkframe(top) 
    pchVar <- tclVar(gettextRcmdr("<auto>"))
    pchEntry <- tkentry(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 ""
        if("1" == tclvalue(identifyVariable)){
            RcmdrTkmessageBox(title="Identify Points",
                message=gettextRcmdr("Use left mouse button to identify points,\nright button to exit."),
                icon="info", type="ok")
            labels <- paste("rownames(", .activeDataSet, ")", sep="")
            }
        else labels <- "FALSE"
        box <- if ("1" == tclvalue(boxplotsVariable)) "'xy'" else "FALSE"
        line <- if("1" == tclvalue(lsLineVariable)) "lm" else "FALSE"
        smooth <- as.character("1" == tclvalue(smoothLineVariable))
        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,
                ", reg.line=", line, ", smooth=", smooth, ", labels=", labels,
                ", 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, ", labels=", labels,
                ", 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(tklabel(optionsFrame, text=gettextRcmdr("Span for smooth")), slider, sticky="w")
    tkgrid(optionsFrame, sticky="w")
    tkgrid(subsetFrame, sticky="w")
    tkgrid(groupsFrame, sticky="w")    
    tkgrid(labelsFrame, sticky="w")
    tkgrid(tklabel(top, text=" "))    
    tkgrid(tklabel(parFrame, text=gettextRcmdr("Plotting Parameters"), fg="blue"), sticky="w")
    tkgrid(tklabel(parFrame, text=gettextRcmdr("Plotting characters")), pchEntry, stick="w")
    tkgrid(tklabel(parFrame, text=gettextRcmdr("Point size")), cexSlider, sticky="w")
    tkgrid(tklabel(parFrame, text=gettextRcmdr("Axis text size")), cex.axisSlider, sticky="w")
    tkgrid(tklabel(parFrame, text=gettextRcmdr("Axis-labels text size")), cex.labSlider, sticky="w")
    tkgrid(parFrame, sticky="w")
    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"), initialValues=rep(1,2),
        labels=gettextRcmdr(c("Least-squares lines", "Smooth lines")))
    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))
        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("scatterplot.matrix(~", paste(variables, collapse="+"),
                ", reg.line=", line, ", smooth=", smooth,
                ", span=", span/100, ", diagonal = '", diag,
                "', data=", .activeDataSet, subset, ")", sep="")
           logger(command)
           justDoIt(command)
            }
        else {
            command <- paste("scatterplot.matrix(~", paste(variables, collapse="+")," | ", .groups,
                ", reg.line=", line, ", smooth=", smooth,
                ", 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="scatterplot.matrix")
    tkgrid(getFrame(variablesBox), sticky="nw")    
    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, Numeric(), 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(){
    initializeDialog(title=gettextRcmdr("Pie Chart"))
    variableBox <- variableListBox(top, Numeric(), 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(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 <- tkentry(axisLabelFrame, width="40", textvariable=axisLabelVariable)
    axisLabelScroll <- tkscrollbar(axisLabelFrame, orient="horizontal",
        repeatinterval=5, 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(1:length(.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), tklabel(variablesFrame, text="    "), getFrame(yBox), sticky="nw")
    tkgrid(variablesFrame, sticky="nw")    
    tkgrid(tklabel(axisLabelFrame, text=gettextRcmdr("Label for y-axis"), fg="blue"), sticky="w")
    tkgrid(axisLabelEntry, sticky="w")
    tkgrid(axisLabelScroll, sticky="ew")
    tkgrid(axisLabelFrame, sticky="w")
    tkgrid(tklabel(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(options=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=gettextRcmdr("Use left mouse button to identify points,\nright button to exit."),
                icon="info", type="ok")
            labels <- paste("rownames(", .activeDataSet, ")", sep="")
            }
        else labels <- "FALSE"
        command <- paste("qq.plot", "(", .activeDataSet, "$", x, ", ", args,
                          ", labels=", labels, ")", sep="")
        doItAndPrint(command)
        activateMenus()
        tkfocus(CommanderWindow())
    }
    OKCancelHelp(helpSubject="qq.plot")
    distFrame <- tkframe(top)
    distVariable <- tclVar("norm")
    normalButton <- tkradiobutton(distFrame, variable=distVariable, value="norm")
    tButton <- tkradiobutton(distFrame, variable=distVariable, value="t")
    chisqButton <- tkradiobutton(distFrame, variable=distVariable, value="chisq")
    FButton <- tkradiobutton(distFrame, variable=distVariable, value="f")
    otherButton <- tkradiobutton(distFrame, variable=distVariable, value="other")
    tDfFrame <- tkframe(distFrame)
    tDfVariable <- tclVar("")
    tDfField <- tkentry(tDfFrame, width="6", textvariable=tDfVariable)
    chisqDfFrame <- tkframe(distFrame)
    chisqDfVariable <- tclVar("")
    chisqDfField <- tkentry(chisqDfFrame, width="6", textvariable=chisqDfVariable)
    FDfFrame <- tkframe(distFrame)
    FDf1Variable <- tclVar("")
    FDf1Field <- tkentry(FDfFrame, width="6", textvariable=FDf1Variable)
    FDf2Variable <- tclVar("")
    FDf2Field <- tkentry(FDfFrame, width="6", textvariable=FDf2Variable)
    otherParamsFrame <- tkframe(distFrame)
    otherParamsVariable <- tclVar("")
    otherParamsField <- tkentry(otherParamsFrame, width="30", textvariable=otherParamsVariable)
    otherNameVariable <- tclVar("")
    otherNameField <- tkentry(otherParamsFrame, width="10", textvariable=otherNameVariable)
    identifyVariable <- tclVar("0")
    identifyFrame <- tkframe(top)
    identifyCheckBox <- tkcheckbutton(identifyFrame, variable=identifyVariable)
    tkgrid(getFrame(xBox), sticky="nw")
    tkgrid(tklabel(identifyFrame, text=gettextRcmdr("Identify observations with mouse")),
           identifyCheckBox, sticky="w")
    tkgrid(identifyFrame, sticky="w")
    tkgrid(tklabel(distFrame, text=gettextRcmdr("Distribution"), fg="blue"), columnspan=6, sticky="w")
    tkgrid(tklabel(distFrame, text=gettextRcmdr("Normal")), normalButton, sticky="w")
    tkgrid(tklabel(tDfFrame, text=gettextRcmdr("df = ")), tDfField, sticky="w")
    tkgrid(tklabel(distFrame, text="t"), tButton, tDfFrame, sticky="w")
    tkgrid(tklabel(chisqDfFrame, text=gettextRcmdr("df = ")), chisqDfField, sticky="w")
    tkgrid(tklabel(distFrame, text=gettextRcmdr("Chi-square")), chisqButton,
           chisqDfFrame, sticky="w")
    tkgrid(tklabel(FDfFrame, text=gettextRcmdr("Numerator df = ")), FDf1Field,
           tklabel(FDfFrame, text=gettextRcmdr("Denominator df = ")), FDf2Field, sticky="w")
    tkgrid(tklabel(distFrame, text="F"), FButton, FDfFrame, sticky="w")
    tkgrid(tklabel(otherParamsFrame, text=gettextRcmdr("Specify: ")),
           otherNameField, tklabel(otherParamsFrame, text=gettextRcmdr("Parameters: ")),
           otherParamsField, sticky="w")
    tkgrid(tklabel(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 <- tkradiobutton(optionsFrame, variable=errorBarsVariable, value="se")
    sdButton <- tkradiobutton(optionsFrame, variable=errorBarsVariable, value="sd")
    confIntButton <- tkradiobutton(optionsFrame, variable=errorBarsVariable, value="conf.int")
    noneButton <- tkradiobutton(optionsFrame, variable=errorBarsVariable, value="none")
    levelVariable <- tclVar("0.95")
    levelEntry <- tkentry(optionsFrame, width="6", textvariable=levelVariable)    
    buttonsFrame <- tkframe(top)
    OKCancelHelp(helpSubject="plotMeans")
    tkgrid(getFrame(groupBox), getFrame(responseBox), sticky="nw")
    tkgrid(tklabel(optionsFrame, text=gettextRcmdr("Error Bars"), fg="blue"), sticky="w")
    tkgrid(tklabel(optionsFrame, text=gettextRcmdr("Standard errors")), seButton, sticky="w")
    tkgrid(tklabel(optionsFrame, text=gettextRcmdr("Standard deviations")), sdButton, sticky="w")
    tkgrid(tklabel(optionsFrame, text=gettextRcmdr("Confidence intervals")), confIntButton,
        tklabel(optionsFrame, text=gettextRcmdr("   Level of confidence:")), levelEntry, sticky="w")
    tkgrid(tklabel(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)
    }

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(tklabel(sliderFrame, text=gettextRcmdr("Width (pixels)")), widthSlider, sticky="sw")
    tkgrid(tklabel(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(tklabel(sliderFrame, text=gettextRcmdr("Width (inches)")), widthSlider, sticky="sw")
    tkgrid(tklabel(sliderFrame, text=gettextRcmdr("Height (inches)")), heightSlider, sticky="sw")
    tkgrid(tklabel(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")
    }
    
# 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)
    }

#line 1 "d:/RCompile/CRANpkg/local/2.13/QCAGUI/R/model-menu.R"
# Model menu dialogs

# last modified 22 June 07 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 <- 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(tklabel(nameFrame, fg="blue", text=gettextRcmdr("Current Model: ")), 
        tklabel(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)
    }

#line 1 "d:/RCompile/CRANpkg/local/2.13/QCAGUI/R/ordinalRegressionModel.R"
ordinalRegressionModel <- function(){
    require("MASS")
    initializeDialog(title=gettextRcmdr("Ordinal Regression Model"))
    .activeModel <- ActiveModel()
    .activeDataSet <- ActiveDataSet()
    currentModel <- if (!is.null(.activeModel)) 
        eval(parse(text=paste("class(", .activeModel, ")[1] == 'polr'", sep="")), 
            envir=.GlobalEnv) 
        else FALSE
    if (currentModel) {
        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 <- tkentry(modelFrame, width="20", textvariable=modelName)
    radioButtons(name="modelType", 
        buttons=c("logistic", "probit", "cloglog", "cauchit"), 
        labels=gettextRcmdr(c("Proportional-odds logit", "Ordered probit", "Ordered complementary log-log", "Ordered cauchit")),
        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=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(tklabel(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)
    }
#line 1 "d:/RCompile/CRANpkg/local/2.13/QCAGUI/R/sciviews-specific.R"
# SciViews specific R Commander code

# last modified 19 April 2005 by Ph. Grosjean
#  small fix to call to list.files() by J. Fox 17 Jan 05
#  modifications 18 Feb 06 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")){
        require("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.13/QCAGUI/R/startup.R"
# last modified 11 May 2007 by J. Fox

.onAttach <- function(...){
    Commander()
    packageStartupMessage(gettext("\nQCAGUI based on Rcmdr Version", domain="R-Rcmdr"), " ", getRcmdr("RcmdrVersion"), "\n")
    }

.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", "car", "foreign", "XML", "MASS"))
    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 <- tkradiobutton(locationFrame, variable=locationVariable, value="CRAN")
#         Note: Bioconductor code not currently necessary
#            BioconductorButton <- tkradiobutton(locationFrame, variable=locationVariable, value="Bioconductor")
            localButton <- tkradiobutton(locationFrame, variable=locationVariable, value="local")
            directoryVariable <- tclVar("")
            directoryFrame <- tkframe(locationFrame)
            onBrowse <- function(){
                tclvalue(directoryVariable) <- tclvalue(tkchooseDirectory())
                }
            browseButton <- tkbutton(directoryFrame, text=gettext("Browse...", domain="R-Rcmdr"), width="12", command=onBrowse, borderwidth=3)
            locationField <- tkentry(directoryFrame, width="20", textvariable=directoryVariable)
            locationScroll <- tkscrollbar(directoryFrame, orient="horizontal",
                repeatinterval=5, command=function(...) tkxview(locationField, ...))
            tkconfigure(locationField, xscrollcommand=function(...) tkset(locationScroll, ...))
            tkgrid(tklabel(top, text=gettext("Install Packages From:", domain="R-Rcmdr"), fg="blue"), sticky="nw")
            tkgrid(tklabel(directoryFrame, text=gettext("Specify package  \ndirectory:", domain="R-Rcmdr"), justify="left"), 
                locationField, sticky="w")
            tkgrid(browseButton, locationScroll, sticky="w")
            tkgrid(locationScroll, sticky="ew")
            tkgrid(tklabel(locationFrame, text="CRAN"), CRANbutton, sticky="w")
#            tkgrid(tklabel(locationFrame, text="Bioconductor"), BioconductorButton, sticky="w")
            tkgrid(tklabel(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(tklabel(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 <- tkbutton(buttonsFrame, text="OK", fg="darkgreen", width="12", command=onOK, default="active",
                    borderwidth=3)
            cancelButton <- tkbutton(buttonsFrame, text=gettext("Cancel", domain="R-Rcmdr"), fg="red", width="12", command=onCancel,
                    borderwidth=3)
            helpButton <- tkbutton(buttonsFrame, text=gettext("Help", domain="R-Rcmdr"), width="12", command=onHelp, borderwidth=3)
            tkgrid(OKbutton, tklabel(buttonsFrame, text="  "), cancelButton, tklabel(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.13/QCAGUI/R/statistics-dimensional-menu.R"
# Statistics Menu dialogs

# last modified 1 July 05 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")
        if (screeplot == "1") {
            justDoIt("screeplot(.PC)")
            logger("screeplot(.PC)")
            }
        if (addPC == "1") {
            initializeDialog(subdialog, title=gettextRcmdr("Number of Components"))
            tkgrid(tklabel(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 <- tklabel(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(tklabel(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 <- tklabel(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, tklabel(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.13/QCAGUI/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)
    }
#line 1 "d:/RCompile/CRANpkg/local/2.13/QCAGUI/R/statistics-proportions-menu.R"
# Statistics Menu dialogs

# last modified 24 February 06 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 <- tkentry(confidenceFrame, width="6", textvariable=confidenceLevel)
    pFrame <- tkframe(rightFrame)
    pVariable <- tclVar(".5")
    pField <- tkentry(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(tklabel(pFrame, text=gettextRcmdr("Null hypothesis: p = "), fg="blue"), pField, sticky="w")
    tkgrid(pFrame, sticky="w")
    tkgrid(tklabel(rightFrame, text=""))
    tkgrid(tklabel(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(){
    require("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 <- tkentry(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(tklabel(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.13/QCAGUI/R/statistics-summaries-menu.R"
# Statistics Menu dialogs

# last modified 22 May 07 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(){
    require(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 <- tkentry(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(" ", ",", tclvalue(quantiles)), ")")
        .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, ")", sep="")
            }
        else  paste("numSummary(", vars, ", statistics=", stats, ")", sep="")
        doItAndPrint(command) 
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="numSummary")
    tkgrid(getFrame(xBox), sticky="nw")    
    tkgrid(checkBoxFrame, sticky="w")
    tkgrid(tklabel(quantilesFrame, text=gettextRcmdr("Quantiles")), quantilesCheckBox,
        tklabel(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("100*.Table/sum(.Table)  # 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 <- "tklabel(hypothesisFrame, text='Hypothesized probabilities:   ')"
            make.lev.names <- "tklabel(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, ", ", "tkentry(hypothesisFrame, width='5', textvariable=", 
                        entry.varname, ")", sep="")
                make.lev.names <- paste(make.lev.names, ", tklabel(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(tklabel(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 <- tkradiobutton(statisticFrame, variable=statisticVariable, value="other")
    otherEntry <- tkentry(statisticFrame, width="20", textvariable=otherVariable)   
    tkgrid(tklabel(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), tklabel(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"))
    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()
        if (correlations == "Pearson")
            doItAndPrint(paste("cor(", .activeDataSet, "[,c(", paste(x, collapse=","),
                ')], use="complete.obs")', sep=""))
        else if (correlations == "Spearman"){
            logger("# Spearman rank-order correlations")
            doItAndPrint(paste("cor(", .activeDataSet, "[,c(", paste(x, collapse=","),
                ')], use="complete.obs", method="spearman")', sep=""))
             }
        else doItAndPrint(paste("partial.cor(", .activeDataSet, "[,c(", paste(x, collapse=","),
                ')], use="complete.obs")', sep=""))    
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="cor")
    tkgrid(getFrame(xBox), sticky="nw")
    tkgrid(correlationsFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=3, 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(tklabel(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.13/QCAGUI/R/statistics-tables-menu.R"
# Statistics Menu dialogs

# last modified 28 July 06 by J. Fox

    # Tables menu
    
twoWayTable <- function(){
    require("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), tklabel(variablesFrame, text="    "), getFrame(columnBox), sticky="nw")
    tkgrid(variablesFrame, sticky="w")
    tkgrid(percentsFrame, sticky="w")
    tkgrid(tklabel(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(){
    require("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), tklabel(variablesFrame, text="    "), getFrame(columnBox), tklabel(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(){
    require("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 <- "tklabel(.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, ", ", "tkentry(.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("tkentry(.tableFrame, width='5', textvariable=",
                row.varname, ")", sep="")
            make.row <- paste(make.row, ", ", "tkentry(.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, ", ", "tkentry(.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 <- tklabel(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 <- tklabel(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(tklabel(rowColFrame, text=gettextRcmdr("Number of Rows:")), rowsSlider, rowsShow, sticky="w")
    tkgrid(tklabel(rowColFrame, text=gettextRcmdr("Number of Columns:")), colsSlider, colsShow, sticky="w")
    tkgrid(rowColFrame, sticky="w")
    tkgrid(tklabel(top, text=gettextRcmdr("Enter counts:"), fg="blue"), sticky="w")
    tkgrid(outerTableFrame, sticky="w")
    tkgrid(percentsFrame, sticky="w")
    tkgrid(tklabel(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.13/QCAGUI/R/statistics-variances-menu.R"
# Statistics Menu dialogs

# last modified 2 July 05 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 <- tkentry(confidenceFrame, width="6", textvariable=confidenceLevel)
    tkgrid(getFrame(groupBox), tklabel(variablesFrame, text="    "), getFrame(responseBox), sticky="nw")
    tkgrid(variablesFrame, sticky="w")
    groupsLabel(groupsBox=groupBox)
    tkgrid(tklabel(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), tklabel(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)"))
    onOK <- function(){
        group <- getSelection(groupBox)
        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("levene.test(", paste(.activeDataSet, "$", response, sep=""), 
            ", ", paste(.activeDataSet, "$", group, sep=""), ")", sep=""))
        tkfocus(CommanderWindow())
        }
    OKCancelHelp(helpSubject="levene.test")
    tkgrid(getFrame(groupBox), tklabel(variableFrame, text="    "), getFrame(responseBox), sticky="nw")
    tkgrid(variableFrame, sticky="w")
    tkgrid(buttonsFrame, sticky="w")
    dialogSuffix(rows=2, columns=1)
    }
#line 1 "d:/RCompile/CRANpkg/local/2.13/QCAGUI/R/utilities.R"
# last modified 23 July 2007 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
    }

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]))]
    }

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]))]
    }

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]))]
    }

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]))]
    }

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")]
    }
                
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))
    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>"))
        }
    # -PhG tkconfigure(.modelLabel, fg="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")
    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, fg="blue")
    if (!is.SciViews()) tkconfigure(getRcmdr("dataSetLabel"), fg="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"), fg="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, fg="blue")
    if (!is.SciViews()) tkconfigure(getRcmdr("modelLabel"), fg="blue") else refreshStatus() # +PhG
    activateMenus()
    model
    }
    
listVariables <- function(dataSet=ActiveDataSet()) {
    vars <- eval(parse(text=paste("names(", dataSet,")")), envir=.GlobalEnv)
    if (getRcmdr("sort.names")) sort(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))))]
    }

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)))))]
    }
    
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))))]
    }

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
    }

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)       
    }           

    # wrapper function for histograms

Hist <- function(x, scale=c("frequency", "percent", "density"), ...) {
    xlab <- deparse(substitute(x))
    x <- na.omit(x)
    scale <- match.arg(scale)
    if (scale == "frequency") hist(x, xlab=xlab, main="",  ...)
    else if (scale == "density") hist(x, freq=FALSE, xlab=xlab, main="", ...)
    else {
        n <- length(x)
        hist(x, axes=FALSE, xlab=xlab, ylab="Percent", 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, col="gray")
    invisible(NULL)
    }

stem.leaf <- function(data, unit, m, Min, Max, rule.line=c("Dixon", "Velleman", "Sturges"),
     style=c("Tukey", "bare"), trim.outliers=TRUE, depths=TRUE, reverse.negative.leaves=TRUE){
#Author:  Peter Wolf 05/2003  (modified slightly by J. Fox, 20 July 03)
    rule.line <- match.arg(rule.line)
    style <- match.arg(style)
    n <- length(data<-sort(data))
    row.max <- floor(  c(Dixon   =10*log(n,10),
                        Velleman=2*sqrt(n),
                        Sturges =1+log(n,2)        ))[rule.line]
    stats <- boxplot(data, plot=FALSE)
    if(missing(Min)) Min <- if (trim.outliers) stats$stats[1,1] else min(data, na.rm=TRUE)
    if(missing(Max)) Max <- if (trim.outliers) stats$stats[5,1] else max(data, na.rm=TRUE)
    spannweite.red <- Max - Min
    zeilen.intervall.laenge<-spannweite.red / row.max
    factor <- if(missing(unit)) 10^ceiling(log(zeilen.intervall.laenge,10))
                else 10^round(log(unit*10,10))
    z <- zeilen.intervall.laenge/factor  # z in (0.1 ,1]
    delta.tick <- c(.2,.2,.5,1)[sum(z > c(0,.1,.2,.5))]
    if(missing(m)) m <- round(1/delta.tick) else delta.tick <- 1/m
    data.tr <- data/factor
    Min.tr <- Min/factor
    Max.tr <- Max/factor
    spannweite.red <- Max.tr - Min.tr
    sk.min <-  floor(Min.tr)
    sk.max <- ceiling(Max.tr)
    skala <- seq(sk.min, sk.max, by=delta.tick)
    if(sk.min < 0) skala <- c(sk.min-delta.tick, skala)
    if(sk.max < 0) skala <- skala[-length(skala)]
    lo.limit <- if (trim.outliers) skala[1] else -Inf
    lo.log   <- if(skala[1] <  0) data.tr <= lo.limit else data.tr <  lo.limit
    n.sk <- length(skala)
    hi.limit <- if (trim.outliers) skala[n.sk] + delta.tick else Inf
    hi.log   <- if(skala[n.sk] >= 0) data.tr >= hi.limit else data.tr >  hi.limit
    n.lower.extr.values <- sum(lo.log); n.upper.extr.values <- sum(hi.log)
    if(0 < n.lower.extr.values){
        lower.line<- paste("LO:", paste(data[lo.log],collapse=" "))
        }
    if(0 < n.upper.extr.values){
        upper.line<- paste("HI:", paste(data[hi.log],collapse=" "))
        }
    data.tr.red <-data.tr[(!lo.log)&(!hi.log)]
    stem <- ifelse(data.tr.red < 0, ceiling(data.tr.red), floor(data.tr.red) )
    leaf <- floor(abs(data.tr.red*10 - stem*10))
    class.of.data.tr <- unlist(c(
        sapply(data.tr.red[data.tr.red < 0],
            function(x, sk) length(sk) - sum(-sk <= -x), skala)
            ,sapply(data.tr.red[data.tr.red>=0],
            function(x,sk) sum(sk <= x), skala)
        ))
    class.of.data.tr  <- c(1:length(skala), class.of.data.tr)
    class.negative <- skala < 0
    leaf.grouped      <- split(c(rep(-1, length(skala)), leaf), class.of.data.tr)
    leaf.grouped      <- lapply(leaf.grouped, function(x){ sort(x[-1]) })
    if (reverse.negative.leaves){
        for (i in seq(class.negative))
            if (class.negative[i]) leaf.grouped[[i]] <- rev(leaf.grouped[[i]])
        }
    leaf.grouped.ch <- paste("|",unlist(lapply(leaf.grouped,paste,collapse="")))
    class.neg.zero <- floor(skala) == -1
    line.names <- skala
    line.names[class.negative] <- line.names[class.negative] + 1
    line.names <- as.character(floor(line.names))
    line.names[class.neg.zero] <- "-0"
    if(style=="Tukey"){
        switch(as.character(m),
        "1"={},
        "2"={
                h<-round(2*(skala%%1)) #; line.names[h!=0] <- ""
                line.names<-paste(line.names,
                        ifelse(skala<0,c(".","*")[1+h],c("*",".")[1+h]),sep="")
            },
        "5"={
                h<-round(5*(skala%%1)); line.names[h>0 & h<4] <- ""
                line.names<-paste(line.names, ifelse(skala<0,
                                c(".","s","f","t","*")[1+h],
                                c("*","t","f","s",".")[1+h]), sep="")
            }
            )
        }
    ragged.left<-function(ch.lines){
        max.n <-max(n.lines<-nchar(ch.lines))
        h     <-paste(rep(" ",max.n),collapse="")
        ch.lines <-paste( substring(h,1,1+max.n-n.lines), ch.lines)
        ch.lines
        }
    line.names <- ragged.left(line.names)
    n.class <- unlist(lapply(leaf.grouped, length))
    select <- (cumsum(n.class) > 0) & rev((cumsum(rev(n.class)) > 0))
    depth    <-    cumsum(n.class)          + n.lower.extr.values
    depth.rev <- rev(cumsum(rev(n.class))     + n.upper.extr.values)
    uplow <- depth >= depth.rev
    pos.median <- which(uplow)[1] + (-1:0)
    h <- abs(depth[pos.median]-depth.rev[pos.median])
    pos.median <- pos.median[1]+(h[1]>h[2])
    depth[uplow] <- depth.rev[uplow]
    depth <- paste(depth,"")
    depth[pos.median] <- paste("(",n.class[pos.median],")",sep="")
    depth[n.class == 0] <- " "
    depth <- if (depths) ragged.left(depth) else ""
    info<-     c(  paste("1 | 2: represents",1.2*factor),
                paste(" leaf unit:",factor/10),
                paste("         n:",n     ),
                "")
    stem <- paste(depth, line.names, leaf.grouped.ch)
    if ((style != "Tukey") || (m != 5) || (sum(select) > 4)) stem <- stem[select]
    if(exists("lower.line")) stem <- c(lower=lower.line, stem)
    if(exists("upper.line")) stem <- c(stem, upper=upper.line)
    result <- list(info=info, stem=stem)
    class(result) <- "stem.leaf"
    result
    }
    
print.stem.leaf <- function(x, ...){
    for(i in seq(x)) cat(x[[i]],sep="\n")
    invisible(x)
    }

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)
        yrange <-  if (error.bars != "none") c( min(means - sds), max(means + sds)) else range(means)
        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)
        yrange <-  if (error.bars != "none") c( min(means - sds), max(means + sds)) else range(means)
        levs.1 <- levels(factor1)
        levs.2 <- levels(factor2)
        n.levs.1 <- length(levs.1)
        n.levs.2 <- length(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), 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 + 0.25
        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)
    }
    
    # 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 <- tkscrollbar(tt, repeatinterval = 5, 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("Commander"))
    else help("Commander")
    }

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

browseManual <- function() {
    browseURL(paste(file.path(.path.package(package="QCAGUI")[1], "doc"), 
        "/User-Manual-QCAGUI.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=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 <- tkbutton(buttonsFrame, text=gettextRcmdr("OK"), fg="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 <- tkbutton(buttonsFrame, text=gettextRcmdr("Cancel"), fg="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 <- tkbutton(buttonsFrame, text=gettextRcmdr("Help"), width="12", command=onHelp, borderwidth=3)
            }       
        tkgrid(OKbutton, tklabel(buttonsFrame, text="  "), cancelButton, tklabel(buttonsFrame, text="            "), 
            if (!is.null(helpSubject)) helpButton, sticky="w")
        })

subOKCancelHelp <- defmacro(window=subdialog, helpSubject=NULL,
    expr={
        subButtonsFrame <- tkframe(window, borderwidth=5)
        subOKbutton <- tkbutton(subButtonsFrame, text=gettextRcmdr("OK"), fg="darkgreen", width="12", command=onOKsub, default="active",
            borderwidth=3)
        onCancelSub <- function() {
            if (GrabFocus()) tkgrab.release(window)
            tkdestroy(window)  
            tkfocus(CommanderWindow())
            }
        subCancelButton <- tkbutton(subButtonsFrame, text=gettextRcmdr("Cancel"), fg="red", width="12", command=onCancelSub, 
            borderwidth=3)
        if (!is.null(helpSubject)){
            onHelpSub <- function(){
                if (GradFocus() && .Platform$OS.type != "windows") tkgrab.release(window)
                if (as.numeric(R.Version()$major) >= 2) print(help(helpSubject))
                else help(helpSubject)
                }
            subHelpButton <- tkbutton(subButtonsFrame, text=gettextRcmdr("Help"), width="12", command=onHelpSub, borderwidth=3)
            }       
        tkgrid(subOKbutton, tklabel(subButtonsFrame, text="  "), subCancelButton, 
            tklabel(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.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, 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)
        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=4, title){
    if (selectmode == "multiple") selectmode <- getRcmdr("multiple.select.mode")
    if (length(variableList) == 1 && is.null(initialSelection)) initialSelection <- 0
    frame <- tkframe(parentWindow)
    listbox <- tklistbox(frame, height=min(listHeight, length(variableList)),
        selectmode=selectmode, background=bg, exportselection=export, width=max(20, nchar(variableList)))
    scrollbar <- tkscrollbar(frame, repeatinterval=5, command=function(...) tkyview(listbox, ...))
    tkconfigure(listbox, yscrollcommand=function(...) tkset(scrollbar, ...))
    for (var in variableList) tkinsert(listbox, "end", var)
    if (is.numeric(initialSelection)) tkselection.set(listbox, initialSelection)
    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)
    tkbind(listbox, "<ButtonPress-1>", onClick)
    tkgrid(tklabel(frame, text=title, fg="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(tklabel(eval(parse(text=..frame)), text=title, fg="blue"), columnspan=2, sticky="w")
        for (i in 1:length(buttons)) {
            ..button <- paste(buttons[i], "Button", sep="")
            assign(..button, 
                tkradiobutton(eval(parse(text=..frame)), variable=eval(parse(text=..variable)), value=..values[i]))
            tkgrid(tklabel(eval(parse(text=..frame)), text=labels[i], justify="left"), eval(parse(text=..button)), sticky="w")
            }
        }
    )
            
                    
checkBoxes <- defmacro(window=top, frame, boxes, initialValues=NULL, labels,
    expr={
        ..initialValues <- if (is.null(initialValues)) rep("1", length(boxes)) else initialValues
        assign(frame, tkframe(window))
        ..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(tklabel(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 <- tkentry(subsetFrame, width="20", textvariable=subsetVariable)
            subsetScroll <- tkscrollbar(subsetFrame, orient="horizontal",
                repeatinterval=5, command=function(...) tkxview(subsetEntry, ...))
            tkconfigure(subsetEntry, xscrollcommand=function(...) tkset(subsetScroll, ...))
            tkgrid(tklabel(subsetFrame, text=gettextRcmdr("Subset expression"), fg="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(tklabel(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, fg="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, fg="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(tklabel(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(tklabel(groupsFrame, text="    "), groupsButton, sticky="w")
        })

groupsLabel <- defmacro(frame=top, groupsBox=groupsBox, columnspan=1,
    expr={
        groupsFrame <- tkframe(frame)
        groupsLabel <- tklabel(groupsFrame, text=gettextRcmdr("<No groups selected>"))    
        tkgrid(tklabel(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()
    variables <- paste(.variables, ifelse(is.element(.variables, Factors()), gettextRcmdr("[factor]"), ""))
    xBox <- variableListBox(frame, variables, title=gettextRcmdr("Variables (double-click to formula)"))
    word <- paste("\\[", gettextRcmdr("factor"), "\\]", sep="")
    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)
    .operatorFont <- getRcmdr("operatorFont")
    plusButton <- tkbutton(operatorsFrame, text="+", width="3", command=onPlus, 
        font=.operatorFont)
    timesButton <- tkbutton(operatorsFrame, text="*", width="3", command=onTimes, 
        font=.operatorFont)
    colonButton <- tkbutton(operatorsFrame, text=":", width="3", command=onColon, 
        font=.operatorFont)
    slashButton <- tkbutton(operatorsFrame, text="/", width="3", command=onSlash, 
        font=.operatorFont)
    inButton <- tkbutton(operatorsFrame, text="%in%", width="3", command=onIn,
        font=.operatorFont)
    minusButton <- tkbutton(operatorsFrame, text="-", width="3", command=onMinus, 
        font=.operatorFont)
    powerButton <- tkbutton(operatorsFrame, text="^", width="3", command=onPower, 
        font=.operatorFont)
    leftParenButton <- tkbutton(operatorsFrame, text="(", width="3", command=onLeftParen, 
        font=.operatorFont)
    rightParenButton <- tkbutton(operatorsFrame, text=")", width="3", command=onRightParen, 
        font=.operatorFont)
    tkgrid(plusButton, timesButton, colonButton, slashButton, inButton, minusButton,
        powerButton, leftParenButton, rightParenButton, sticky="w")
    formulaFrame <- tkframe(frame)
    if (hasLhs){
        tkgrid(tklabel(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 <- tkentry(formulaFrame, width="50", textvariable=rhsVariable)
        rhsXscroll <- tkscrollbar(formulaFrame, repeatinterval=10,
            orient="horizontal", command=function(...) tkxview(rhs, ...))
        tkconfigure(rhsEntry, xscrollcommand=function(...) tkset(rhsXscroll, ...))          
        lhsEntry <- tkentry(formulaFrame, width="10", textvariable=lhsVariable)
        lhsScroll <- tkscrollbar(formulaFrame, repeatinterval=5, 
            orient="horizontal", command=function(...) tkxview(lhsEntry, ...))
        tkconfigure(lhsEntry, xscrollcommand=function(...) tkset(lhsScroll, ...))
        tkgrid(lhsEntry, tklabel(formulaFrame, text=" ~    "), rhsEntry, sticky="w")
        tkgrid(lhsScroll, tklabel(formulaFrame, text=""), rhsXscroll, sticky="w")
        tkgrid.configure(lhsScroll, sticky="ew")
        }
    else{
        rhsVariable <- tclVar("")
        rhsEntry <- tkentry(formulaFrame, width="50", textvariable=rhsVariable)
        rhsXscroll <- tkscrollbar(formulaFrame, repeatinterval=10,
            orient="horizontal", command=function(...) tkxview(rhs, ...))
        tkconfigure(rhsEntry, xscrollcommand=function(...) tkset(rhsXscroll, ...))  
        tkgrid(tklabel(formulaFrame, text="   ~ "), rhsEntry, sticky="w")
        tkgrid(tklabel(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)
        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
       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>"))
          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>"))
          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")
    putRcmdr("modelNumber", modelNumber + increment)
    }
    
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() !is.null(listDataSets())

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'")))

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

hclustSolutionsP <- function() length(listHclustSolutions()) > 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")

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 <- tkbutton(buttonFrame, text=gettextRcmdr("OK"), 
        fg="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 <- tkbutton(buttonFrame, text=gettextRcmdr("Cancel"), 
        fg="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 <- tkbutton(buttonFrame, text=gettextRcmdr("Yes"), 
        fg="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 <- tkbutton(buttonFrame, text=gettextRcmdr("No"), 
        fg="red", width="12", command=onNo, borderwidth=3,
        default=if (missing(default)) "normal"
            else if (default == "no") "active" else "normal")
        tkgrid(tklabel(messageFrame, bitmap=icon, fg=iconColor),
            tklabel(messageFrame, text="    "), 
            tklabel(messageFrame, text=message))
        tkgrid(messageFrame)        
    switch(type,
        okcancel = {
            tkgrid(OKbutton, tklabel(buttonFrame, text="    "), cancelButton)
            if (missing(default) || default == "ok") tkbind(messageBox, "<Return>",
                onOK)
            else if (default == "cancel") tkbind(messageBox, "<Return>", onCancel)
            },
        yesno =  {
            tkgrid(yesButton, tklabel(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
    }    

loadPlugins <- function(){
    plugins <- listPlugins()
    initializeDialog(title=gettextRcmdr("Load Plugins"))
    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"))
  }
   
