R/RcmdrPlugin.BWS3.R

In RcmdrPlugin.BWS3: R Commander Plug-in for Case 3 Best-Worst Scaling

###############################################################################

.onAttach <- function(libname, pkgname){
  if (!interactive()) return()
  putRcmdr("slider.env", new.env())
  Rcmdr <- options()$Rcmdr
  plugins <- Rcmdr$plugins
  if (!pkgname %in% plugins) {
    Rcmdr$plugins <- c(plugins, pkgname)
    options(Rcmdr=Rcmdr)
    if("package:Rcmdr" %in% search()) {
      if(!getRcmdr("autoRestart")) {
        closeCommander(ask=FALSE, ask.save=TRUE)
        Commander()
      }
    }
    else {
      Commander()
    }
  }
}

###############################################################################

bws3Design <- function() {
  initializeDialog(title = gettextRcmdr("Design Choice Sets for BWS3"))
  defaults <- list(
    ini.designName = "BWS3design",
    ini.designMethod = "FALSE",
    ini.nAlternativesName = "2",
    ini.nBlocksName = "1",
    ini.RNGseedName = "",
    ini.RNGoptionVariable = "0",
    ini.A1Var = "0",
    ini.A2Var = "0",
    ini.A3Var = "0",
    ini.A4Var = "0",
    ini.A5Var = "0",
    ini.A6Var = "0",
    ini.saveVariable = "0")
  dialog.values <- getDialog("bws3Design", defaults)

  if(is.null(getDialog("bws3Design"))) putRcmdr("savedTableBws3Design", NULL)
  
  ##### Output Frame #####
  outputFrame <- tkframe(top)
  designFrame <- tkframe(outputFrame)
  saveFrame   <- tkframe(outputFrame)

  # Choice sets
  designName <- tclVar(dialog.values$ini.designName)
  design     <- ttkentry(designFrame, width = "14", 
                         textvariable = designName)
  # Save option
  saveVariable <- tclVar(dialog.values$ini.saveVariable)
  saveCheckBox <- ttkcheckbutton(saveFrame, variable = saveVariable)


  ##### Input Frame #####
  inputsFrame       <- tkframe(top)
  designMethodFrame <- tkframe(inputsFrame)
  AltBlkRngFrame    <- tkframe(inputsFrame)
  RNGFrame          <- tkframe(inputsFrame)
  RNGoptionFrame    <- tkframe(inputsFrame)
  TABLEFrame        <- tkframe(inputsFrame)
  tableFrame        <- tkframe(TABLEFrame)
  rightFrame        <- tkframe(TABLEFrame)
  AttrCheckBoxFrame <- tkframe(rightFrame)
  
  # Design method
  radioButtons(
    designMethodFrame,
    name = "designmethod",
    buttons = c("FALSE", "TRUE"),
    labels = gettextRcmdr(c("Rotation", "Mix-and-Match")),
    initialValue = dialog.values$ini.designMethod,
    title = gettextRcmdr("Design method"))

  # Number of alternatives per set (without the output option)
  nAlternativesName <- tclVar(dialog.values$ini.nAlternativesName)
  nAlternatives     <- ttkentry(AltBlkRngFrame,
                                width = "7",
                                textvariable = nAlternativesName)
  
  # Number of blocks
  nBlocksName <- tclVar(dialog.values$ini.nBlocksName)
  nBlocks     <- ttkentry(AltBlkRngFrame,
                          width = "7",
                          textvariable = nBlocksName)

  # Seed for RNG
  RNGseedName <- tclVar(dialog.values$ini.RNGseedName)
  RNGseed     <- ttkentry(RNGFrame,
                          width = "7",
                          textvariable = RNGseedName)

  # RNG option
  RNGoptionVariable <- tclVar(dialog.values$ini.RNGoptionVariable)
  RNGoptionCheckBox <- ttkcheckbutton(RNGoptionFrame,
                                      variable = RNGoptionVariable)

  # Table for alternatives and levels
  ## Initial settings
  env <- environment()
  assign(".tableFrame", tkframe(tableFrame), envir = env)
  tkdestroy(get(".tableFrame", envir = env))
  assign(".tableFrame", tkframe(tableFrame), envir = env)
  nrows <- 6
  ncols <- 7

  initial.table <- getRcmdr("savedTableBws3Design")
  
  ## Names of columns
  make.col.names <- "labelRcmdr(.tableFrame, text='')"
  col.varname <- c("Attribute", "Level 1", "Level 2", "Level 3",
                                "Level 4", "Level 5", "Level 6")
  for (j in 1:ncols) {
    make.col.names <- 
      paste(make.col.names, ", ",
            "labelRcmdr(.tableFrame, text = '", col.varname[j], "')",
            sep = "")
  }
  eval(parse(text=paste("tkgrid(", make.col.names, ", sticky = 'w')", 
                        sep = "")), envir = env)

  ## Names of rows and cells in table
  for (i in 1:nrows) {
    varname <- paste(".tab.", i, ".1", sep = "")
    assign(varname, if (is.null(initial.table)) {
                      tclVar("")
                    } else {
                      tclVar(initial.table[i, 1])
                    }, envir = env)
    row.varname <- paste(".rowname.", i, sep = "")
    make.row <- paste("labelRcmdr(.tableFrame, text ='')")
    make.row <- paste(make.row, ", ",
                      "ttkentry(.tableFrame, width = '15', textvariable =", 
                      varname, ")", sep="")
    for (j in 2:ncols) {
      varname <- paste(".tab.", i, ".", j, sep = "")
      assign(varname, if (is.null(initial.table)) {
                        tclVar("")
                      } else {
                        tclVar(initial.table[i, j])
                      }, envir = env)
      make.row <- paste(make.row, ", ",
                        "ttkentry(.tableFrame, width = '10', textvariable =", 
                        varname, ")", sep="")
    }
    eval(parse(text = paste("tkgrid(", make.row, ")", sep = "")), envir = env)
  }
  tkgrid(get(".tableFrame", envir = env), sticky = "w")

  # Quantitative attributes
  A1Var <- tclVar(dialog.values$ini.A1Var)
  A1CheckBox <- ttkcheckbutton(AttrCheckBoxFrame, variable = A1Var)
  A2Var <- tclVar(dialog.values$ini.A2Var)
  A2CheckBox <- ttkcheckbutton(AttrCheckBoxFrame, variable = A2Var)
  A3Var <- tclVar(dialog.values$ini.A3Var)
  A3CheckBox <- ttkcheckbutton(AttrCheckBoxFrame, variable = A3Var)
  A4Var <- tclVar(dialog.values$ini.A4Var)
  A4CheckBox <- ttkcheckbutton(AttrCheckBoxFrame, variable = A4Var)
  A5Var <- tclVar(dialog.values$ini.A5Var)
  A5CheckBox <- ttkcheckbutton(AttrCheckBoxFrame, variable = A5Var)
  A6Var <- tclVar(dialog.values$ini.A6Var)
  A6CheckBox <- ttkcheckbutton(AttrCheckBoxFrame, variable = A6Var)
  
  
  ##### onOK Function #####
  onOK <- function() {

    putDialog("bws3Design", list(
      ini.designName = tclvalue(designName),
      ini.designMethod = tclvalue(designmethodVariable),
      ini.nAlternativesName = tclvalue(nAlternativesName),
      ini.nBlocksName = tclvalue(nBlocksName),
      ini.RNGseedName = tclvalue(RNGseedName),
      ini.RNGoptionVariable = tclvalue(RNGoptionVariable),
      ini.A1Var = tclvalue(A1Var),
      ini.A2Var = tclvalue(A2Var),
      ini.A3Var = tclvalue(A3Var),
      ini.A4Var = tclvalue(A4Var),
      ini.A5Var = tclvalue(A5Var),
      ini.A6Var = tclvalue(A6Var),
      ini.saveVariable = tclvalue(saveVariable)))
    
    closeDialog()

    # Table of attributes and levels
    nrows <- 6
    ncols <- 7
    varNames <- matrix("", nrow = nrows, ncol = ncols)

    for (i in 1:nrows) {
      for (j in 1:ncols) {
        varname <- paste(".tab.", i, ".", j, sep = "")
        varNames[i, j] <- 
          eval(parse(text =
            paste("as.character(tclvalue(", varname, "))", sep = "")))
      }
    }

    # Store the table of attributes and levels into savedTable 
    putRcmdr("savedTableBws3Design", varNames) 
    
    # Variables for attributes and levels
    attributeNames <- varNames[, 1]
    varidRows      <- which(attributeNames != "")
    nrows          <- length(varidRows)
    attributeNames <- attributeNames[varidRows]
    levelNames     <- varNames[varidRows, -1]

    attribute.names.list <- vector("list", nrows)

    for (i in 1:nrows) {
      levelnames <- levelNames[i, ]
      levelnames <- levelnames[levelnames != ""]
      attribute.names.list[[i]] <- levelnames
    }

    # Code for argument 'attribute.names'
    cmd.attributes <- paste("list(", attributeNames[1], " = ",
                            attribute.names.list[1], sep = "")
    for (i in 2:nrows) {
      cmd.attributes <- paste(cmd.attributes, ", ", attributeNames[i], " = ",
                              attribute.names.list[i], sep = "")
    }
    cmd.attributes <- paste(cmd.attributes, ")", sep = "")
    
    # Code for argument 'seed'
    if (is.na(as.numeric(tclvalue(RNGseedName)))) {
      cmd.seed <- paste(", seed = NULL)", sep = "")
    } else {
      cmd.seed <- paste(", seed = ",  as.numeric(tclvalue(RNGseedName)), 
                        ")", sep = "")
    }

    # Code for attributes 'categorical attributes' and 'continuous attributes'
    ind <- as.logical(c(as.numeric(tclvalue(A1Var)),
                        as.numeric(tclvalue(A2Var)),
                        as.numeric(tclvalue(A3Var)),
                        as.numeric(tclvalue(A4Var)),
                        as.numeric(tclvalue(A5Var)),
                        as.numeric(tclvalue(A6Var))))

    if (all(ind)) { # all attributes are continuous
      cmd.cateA <- paste("''")
      cmd.contA <- paste("c('", 
                         paste(na.omit(attributeNames[ind]), collapse = "', '"),
                         "')", sep = "")
    } else if (all(!ind)){ # all attributes are categorical
      cmd.cateA <- paste("c('", 
                         paste(na.omit(attributeNames[!ind]), collapse = "', '"),
                         "')", sep = "")
      cmd.contA <- paste("''")
    } else { # some attributes are continuous, while the others are categorical
      cmd.contA <- paste("c('", 
                         paste(na.omit(attributeNames[ind]), collapse = "', '"),
                         "')", sep = "")
      cmd.cateA <- paste("c('",
                         paste(na.omit(attributeNames[!ind]), collapse = "', '"),
                         "')", sep = "")
    }
    
    # Reproduce choice sets designed on R < 3.6.0
    if (tclvalue(RNGoptionVariable) == 1) {
      doItAndPrint(paste(
        'if(getRversion() >= "3.6.0") RNGkind(sample.kind = "Rounding")'))
    }
    
    # Design choice sets
    doItAndPrint(
      paste(tclvalue(designName), " <- rotation.design(",
            "attribute.names = ", cmd.attributes,
            ", nalternatives = ", tclvalue(nAlternativesName),
            ", nblocks = ", tclvalue(nBlocksName),
            ", randomize = ", tclvalue(designmethodVariable),
            cmd.seed, sep = ""))
    justDoIt(
      paste("attributes(", tclvalue(designName), ")$contA <- ", cmd.contA,
            sep = ""))
    justDoIt(
      paste("attributes(", tclvalue(designName), ")$cateA <- ", cmd.cateA,
            sep = ""))
    doItAndPrint(paste(tclvalue(designName)))
    
    # Save choice sets
    if (tclvalue(saveVariable) == 1) {
      saveFile <- tclvalue(tkgetSaveFile(
        filetypes = gettextRcmdr(
          ' {"R Data Files" {".rda" ".RDA" ".rdata" ".RData"}}'),
        defaultextension = ".rda",
        initialfile = paste0(tclvalue(designName), ".rda"),
        parent = CommanderWindow()))
      if (saveFile == "") {
        tkfocus(CommanderWindow())
        return()
      }
      cmd <- paste0('save(', tclvalue(designName),
                    ', file = "', saveFile, '")')
      justDoIt(cmd)
      logger(cmd)
      Message(paste0(gettextRcmdr("BWS3 design was exported to file: "),
                     saveFile),
              type = "note")
    }
    
    tkfocus(CommanderWindow())
  }

  ##### Specification of dialog box #####
  # Ok Cancel Help Buttons 
  OKCancelHelp(helpSubject = "bws3Design",
               reset       = "resetBws3Table",
               apply       = "bws3Design")
  # Output
  ## Design
  tkgrid(
    labelRcmdr(designFrame,
               text = gettextRcmdr("Name for design ")),
    design, sticky = "w")

  ## Save choice sets
  tkgrid(
    saveCheckBox,
    labelRcmdr(
      saveFrame,
      text = gettextRcmdr("Save to file")),
    sticky = "w")

  tkgrid(designFrame, labelRcmdr(outputFrame, text = "   "),
         saveFrame, sticky = "w")
  tkgrid(outputFrame, sticky = "w")

  # Blank line
  tkgrid(labelRcmdr(top, text = ""))

  # Input
  ## Design Method
  tkgrid(designmethodFrame, sticky = "w")
  tkgrid(designMethodFrame, sticky = "w")

  ## Design parameter
  tkgrid(
    labelRcmdr(
      AltBlkRngFrame,
      text = gettextRcmdr("Design parameters:")),
    sticky = "w")

  ## Number of alternatives per set
  tkgrid(
    labelRcmdr(
      AltBlkRngFrame,
      text = gettextRcmdr("Number of alternatives per set (without opt-out) ")),
    nAlternatives, sticky = "w")

  ## Number of blocks
  tkgrid(labelRcmdr(AltBlkRngFrame,
                    text = gettextRcmdr("Number of blocks ")),
         nBlocks, sticky = "w")
  tkgrid(AltBlkRngFrame, sticky = "w")

  ## Table
  tkgrid(labelRcmdr(
    inputsFrame,
    text = gettextRcmdr("Attributes and their levels:")),
    sticky = "w")

  ## Quantitative attributes
  tkgrid(labelRcmdr(AttrCheckBoxFrame, text = "Quantitative"), sticky = "ew")
  tkgrid(A1CheckBox, labelRcmdr(AttrCheckBoxFrame, text = ""), sticky = "ew")
  tkgrid(A2CheckBox, labelRcmdr(AttrCheckBoxFrame, text = ""), sticky = "ew")
  tkgrid(A3CheckBox, labelRcmdr(AttrCheckBoxFrame, text = ""), sticky = "ew")
  tkgrid(A4CheckBox, labelRcmdr(AttrCheckBoxFrame, text = ""), sticky = "ew")
  tkgrid(A5CheckBox, labelRcmdr(AttrCheckBoxFrame, text = ""), sticky = "ew")
  tkgrid(A6CheckBox, labelRcmdr(AttrCheckBoxFrame, text = ""), sticky = "ew")
  tkgrid(AttrCheckBoxFrame, sticky = "ew")

  tkgrid(rightFrame, tableFrame, sticky = "ew")
  tkgrid(TABLEFrame, sticky = "ew")

  ## Reproducibility
  tkgrid(labelRcmdr(
           RNGFrame,
           text = gettextRcmdr("Reproducibility:")),
         sticky = "w")

  ## Seed for RNG
  tkgrid(labelRcmdr(
           RNGFrame,
           text = gettextRcmdr("Seed for random number generator (optional) ")),
         RNGseed, sticky = "w")
  tkgrid(RNGFrame, sticky = "w")

  ## RNG option
  tkgrid(
    RNGoptionCheckBox,
      labelRcmdr(
        RNGoptionFrame,
        text = gettextRcmdr("Reproduce choice sets designed with R < 3.6.0")),
    sticky = "w")
  tkgrid(RNGoptionFrame, sticky = "w")
  
  tkgrid(inputsFrame, sticky = "w")

  # OK Cancel Help Buttons
  tkgrid(buttonsFrame, columnspan = 2, sticky = "w")

  dialogSuffix()
}

resetBws3Table <- function() {
  putRcmdr("savedTableBws3Design", NULL)
  putDialog("bws3Design", NULL)
  bws3Design()
}
###############################################################################

bws3Questions <- function() {
  initializeDialog(title = gettextRcmdr("Display BWS3 Questions"))
  defaults <- list(designName = "BWS3design")
  dialog.values <- getDialog("bws3Questions", defaults)
  
  
  ##### Input Frame #####
  inputsFrame <- tkframe(top)

  # Choice sets
  designName <- tclVar(dialog.values$designName)
  design <- ttkentry(inputsFrame, width = "14",
                     textvariable = designName)

  ##### onOK Function #####
  onOK <- function() {
    putDialog("bws3Questions", list(designName = tclvalue(designName)))

    designValue <- tclvalue(designName)

    closeDialog()

    doItAndPrint(paste0("questionnaire(", designValue, ")"))
    tkfocus(CommanderWindow())
  }

  
  ##### Specification of dialog box #####
  # Ok Cancel Help Buttons 
  OKCancelHelp(helpSubject = "bws3Questions",
               reset       = "bws3Questions",
               apply       = NULL)

  # Name of design
  tkgrid(labelRcmdr(
    inputsFrame,
    text = gettextRcmdr("Design ")),
    design, sticky = "w")
  tkgrid(inputsFrame, sticky = "w")
  
  # OK Cancel Help Buttons
  tkgrid(buttonsFrame, columnspan = 2, sticky = "w")

  dialogSuffix()
}

###############################################################################

bws3Dataset <- function() {
  initializeDialog(
    title = gettextRcmdr("Create Data Set for BWS3 Analysis"))
  defaults <- list(
    ini.rowsValue          = "4",
    ini.datasetName        = "BWS3data",
    ini.designName         = "BWS3design",
    ini.idName             = "id",
    ini.letterRB           = "1",
    ini.optoutVariable         = "0",
    ini.saveVariable           = "0")
  dialog.values <- getDialog("bws3Dataset", defaults)

  if(is.null(getDialog("bws3Dataset"))) putRcmdr("savedTableBWS3dataset", NULL)

  ###### Output frame
  outputFrame      <- tkframe(top)
  datasetnameFrame <- tkframe(outputFrame)
  saveFrame        <- tkframe(outputFrame)

  # output name
  datasetName <- tclVar(dialog.values$ini.datasetName)
  dataset     <- ttkentry(datasetnameFrame, width = "14",
                          textvariable = datasetName)

  # save option
  saveVariable <- tclVar(dialog.values$ini.saveVariable)
  saveCheckBox <- ttkcheckbutton(saveFrame, variable = saveVariable)


  ###### Inputs frame
  inputsFrame <- tkframe(top)

  ### Frame in left
  leftFrame    <- tkframe(inputsFrame)
  objectsFrame <- tkframe(leftFrame)
  radio1Frame  <- tkframe(leftFrame)
  radio2Frame  <- tkframe(leftFrame)
  radio3Frame  <- tkframe(leftFrame)
  optoutFrame  <- tkframe(leftFrame)
  rowsFrame    <- tkframe(leftFrame)
  letterFrame  <- tkframe(leftFrame)


  # choice.sets
  designName <- tclVar(dialog.values$ini.designName)
  design <- ttkentry(objectsFrame, width = "14", textvariable = designName)

  # id
  idName <- tclVar(dialog.values$ini.idName)
  id <- ttkentry(objectsFrame, width = "14", textvariable = idName)

  # opt-out option
  optoutVariable <- tclVar(dialog.values$ini.optoutVariable)
  optoutCheckBox <- ttkcheckbutton(optoutFrame, variable = optoutVariable)


  ### Frame in right
  rightFrame  <- tkframe(inputsFrame)
  tableFrame  <- tkframe(rightFrame)

  # Table
  env <- environment()
  assign(".tableFrame", tkframe(tableFrame), envir=env)

  setUpTable <- function(...){
    tkdestroy(get(".tableFrame", envir=env))
    assign(".tableFrame", tkframe(tableFrame), envir=env)
    nrows <- as.numeric(tclvalue(rowsValue))
    ncols <- 2

    # Set colnames
    make.col.names <- "labelRcmdr(.tableFrame, text='')"
    for (j in 1:ncols) {
      if (j == 1) {
        col.varname <- "Best"
      } else {
        col.varname <- "Worst"
      }
      make.col.names <- 
        paste(make.col.names, ", ",
              "labelRcmdr(.tableFrame, text = '", col.varname, "')",
              sep = "")
    }
    eval(parse(text=paste("tkgrid(", make.col.names, ", sticky = 'w')", 
                          sep = "")), envir = env)

    # Make rows for questions
    for (i in 1:nrows){
      if (tclvalue(lettertypeVariable) == "1") {
        b <- "B"
        w <- "W"
      } else if (tclvalue(lettertypeVariable) == "2"){
        b <- "b"
        w <- "w"
      } else {
        b <- ""
        w <- ""
      }

      Bvarname <- paste(".tab.", i, ".1", sep = "")
      if (is.null(ini.table)) {
        if (tclvalue(lettertypeVariable) == "3") {
          eval(parse(text = paste("assign(Bvarname, tclVar(''), envir = env)",
                                  sep = "")))
        } else {
          eval(parse(text = paste("assign(Bvarname, tclVar('", b, i,
                                  "'), envir = env)", sep = "")))
        }
      } else {
        eval(parse(text = paste("assign(Bvarname, tclVar(ini.table[", i,
                                ", 1]), envir = env)", sep = "")))
      }

      Wvarname <- paste(".tab.", i, ".2", sep = "")
      if (is.null(ini.table)) {
        if (tclvalue(lettertypeVariable) == "3") {
          eval(parse(text = paste("assign(Wvarname, tclVar(''), envir = env)",
                                  sep = "")))
        } else {
          eval(parse(text = paste("assign(Wvarname, tclVar('", w, i,
                                  "'), envir = env)", sep = "")))
        }
      } else {
        eval(parse(text = paste("assign(Wvarname, tclVar(ini.table[", i,
                                ", 2]), envir = env)", sep = "")))
      }

      row.varname <- paste("Q", i, sep = "")

      make.row <- paste("labelRcmdr(.tableFrame, text = '", row.varname,
                        "')", sep = "")
      make.row <- paste(make.row, ", ", 
                        "ttkentry(.tableFrame, width = '10', 
                        textvariable = ", Bvarname, ")", sep = "")
      make.row <- paste(make.row, ", ",
                        "ttkentry(.tableFrame, width = '10', 
                        textvariable = ", Wvarname, ")", sep = "")
      eval(parse(text=paste("tkgrid(", make.row, ", sticky = 'w')",
                            sep = "")), envir = env)
    }

    tkgrid(get(".tableFrame", envir = env), sticky = "ew", padx = 6)
  }

  ini.table <- getRcmdr("savedTableBWS3dataset")

  # slider: number of questions
  if (is.null(ini.table)) {
    rowsValue <- tclVar(dialog.values$ini.rowsValue)
  } else {
    rowsValue <- tclVar(nrow(ini.table))
  }
  rowsSlider <- tkscale(rowsFrame, from = 4, to = 21, showvalue = FALSE,
                        variable = rowsValue, resolution = 1, 
                        orient = "horizontal", command = setUpTable)
  rowsShow   <- labelRcmdr(rowsFrame, textvariable = rowsValue, width = 3,
                           justify = "right")

  # letter of variables
  radioButtons(letterFrame,
    name = "lettertype",
    title   = gettextRcmdr("Letters of best- and worst-response variables"),
    buttons = c("Uppercase", "Lowercase", "None"),
    values  = c("1", "2", "3"),
    labels  = gettextRcmdr(c("Uppercase", "Lowercase", "None")),
    initialValue = dialog.values$ini.letterRB,
    command = setUpTable)

  onOK <- function() {
    putDialog("bws3Dataset", list(
      ini.rowsValue       = tclvalue(rowsValue),
      ini.datasetName     = tclvalue(datasetName),
      ini.designName      = tclvalue(designName),
      ini.optoutVariable  = tclvalue(optoutVariable),
      ini.saveVariable    = tclvalue(saveVariable),
      ini.idName          = tclvalue(idName),
      ini.letterRB        = tclvalue(lettertypeVariable)))

    cedes <- tclvalue(designName)
    contA <- eval(parse(text = paste0("attr(", cedes, ", 'contA')")))
    cateA <- eval(parse(text = paste0("attr(", cedes, ", 'cateA')")))
    nAlternatives <- eval(parse(text = paste0(cedes, 
                                  "$design.information$nalternatives")))

    closeDialog()

    nrows           <- as.numeric(tclvalue(rowsValue))
    ncols           <- 2
    k               <- 0
    BWvarNames      <- rep("", nrows * ncols)
    BWvarNamesTable <- matrix("", nrow = nrows, ncol = ncols)

    for (i in 1:nrows) {
      for (j in 1:2) {
        k <- k + 1
        BWvarname <- paste(".tab.", i, ".", j, sep = "")
        BWvarNames[k] <- 
          eval(parse(text =
            paste("as.character(tclvalue(", BWvarname, "))", sep = "")))
        BWvarNamesTable[i, j] <- BWvarNames[k]
      }
    }

    putRcmdr("savedTableBWS3dataset", BWvarNamesTable)

    BWvarNamesList <- vector("list", nrow(BWvarNamesTable))
    for(i in 1:nrow(BWvarNamesTable)) {
      BWvarNamesList[[i]] <- BWvarNamesTable[i, ]
    }

    cmd.response <- paste0("list(q1 = ", BWvarNamesList[1])
    for(i in 2:nrow(BWvarNamesTable)) {
      cmd.response <- paste0(cmd.response, ", q", i, " = ", BWvarNamesList[i])
    }
    cmd.response <- paste0(cmd.response, ")")

    if(tclvalue(optoutVariable) == 1) {
      cmd.optout <- paste0("TRUE")
      cmd.asc <- paste0("c(", paste0(c(rep(0, nAlternatives), 1), collapse = ", "), ")")
    } else {
      cmd.optout <- paste0("FALSE")
      cmd.asc <- paste0("NULL")
    }

    doItAndPrint(
      paste0(
        tclvalue(datasetName), " <- bws3.dataset(data = ",
        getRcmdr(".activeDataSet"),
        ", id = '", tclvalue(idName), "'",
        ", response = ", cmd.response,
        ", choice.sets = ", tclvalue(designName),
        ", categorical.attributes = c('", paste(cateA, collapse = "', '"), "')",
        ", continuous.attributes  = c('", paste(contA, collapse = "', '"), "')",
        ", optout = ", cmd.optout,
        ", asc = ", cmd.asc,
        ", model = 'maxdiff')"))
        
    activeDataSet(tclvalue(datasetName))

    if(tclvalue(saveVariable) == 1) {
      saveFile <- tclvalue(tkgetSaveFile(
        filetypes = gettextRcmdr(
          ' {"R Data Files" {".rda" ".RDA" ".rdata" ".RData"}}'),
        defaultextension = ".rda",
        initialfile = paste0(tclvalue(datasetName), ".rda"),
        parent = CommanderWindow()))
      if(saveFile == "") {
        tkfocus(CommanderWindow())
        return()
      }
      command <- paste0('save(', tclvalue(datasetName),
                        ', file = "', saveFile, '")')
      justDoIt(command)
      logger(command)
      Message(
        paste(
          gettextRcmdr("Dataset for BWS3 analysis was exported to file: "),
          saveFile),
        type = "note")
    }

    tkfocus(CommanderWindow())
  }


  OKCancelHelp(helpSubject = "bws3Dataset",
               reset       = "resetBws3Dataset",
               apply       = "bws3Dataset")

  # Output
  tkgrid(labelRcmdr(datasetnameFrame,
    text = gettextRcmdr("Name for data set ")),
    dataset, sticky = "w")
  tkgrid(saveCheckBox,
         labelRcmdr(saveFrame, text = gettextRcmdr("Save to file")),
         sticky = "w")
  tkgrid(datasetnameFrame, labelRcmdr(outputFrame, text = "   "),
         saveFrame, sticky = "w")
  tkgrid(outputFrame, sticky = "w")

  # Blank line
  tkgrid(labelRcmdr(top, text = ""))

  # Inputs
  tkgrid(labelRcmdr(objectsFrame,
    text = gettextRcmdr("Design")),
    design, sticky = "w")
  tkgrid(labelRcmdr(objectsFrame,
    text = gettextRcmdr("ID variable")),
    id, sticky = "w")
  tkgrid(objectsFrame, sticky = "w")

  tkgrid(labelRcmdr(rowsFrame,
    text = gettextRcmdr("Number of BWS3 questions ")),
    rowsSlider, rowsShow, sticky = "w")
  tkgrid(rowsFrame, sticky = "w")

  tkgrid(lettertypeFrame, sticky = "w")
  tkgrid(letterFrame, sticky = "w")

  tkgrid(optoutCheckBox,
         labelRcmdr(optoutFrame, text = gettextRcmdr("Opt-out option")),
         sticky = "w")
  tkgrid(optoutFrame, sticky = "w")


  tkgrid(labelRcmdr(
           tableFrame,
           text = gettextRcmdr("Names of best- and worst-response variables")),
         sticky = "w")
  tkgrid(tableFrame, sticky="w")


  tkgrid(leftFrame, labelRcmdr(inputsFrame, text = "    "),
         rightFrame, sticky = "nw")
  tkgrid(inputsFrame, sticky = "w")

  setUpTable()

  # Buttons
  tkgrid(buttonsFrame, columnspan = 2, sticky = "w")

  dialogSuffix()
}

resetBws3Dataset <- function(){
  putRcmdr("savedTableBWS3dataset", NULL)
  putDialog("bws3Dataset", NULL)
  bws3Dataset()
}

###############################################################################

bws3Interactions <- function() {
  initializeDialog(
    title = 
      gettextRcmdr("Create Interactions between Attributes/Levels and Covariates"))

  defaults <- list(
    ini.attrlvlVar   = NULL,
    ini.covariateVar = NULL)
    
  dialog.values <- getDialog("bws3Interactions", defaults)

  ##### Input Frame #####
  inputFrame      <- tkframe(top)
  attrlvlVarFrame <- tkframe(inputFrame)
  covariateFrame  <- tkframe(inputFrame)

  # ASC
  ascPosition <-
    eval(parse(text = paste0("attr(", activeDataSet(), ", 'asc')")))
  ascVarVec   <-
    eval(parse(text = paste0("attr(", activeDataSet(), ", 'asc.names')")))
  asc <- ascVarVec[as.logical(ascPosition)]
  
  # ASC + Attribute/level variables
  attrlvlVarVec <- 
    eval(parse(text = paste0("attr(", activeDataSet(), ", 'level.variables')")))
  attrlvlVarVec <- c(asc, attrlvlVarVec)
  attrlvlVarBox <- variableListBox(
    attrlvlVarFrame,
    attrlvlVarVec,
    title = "Attribute/level variables \n(pick one or more)",
    selectmode = "multiple",
    listHeight = 10,
    initialSelection = varPosn(dialog.values$ini.attrlvlVar,
                               vars = attrlvlVarVec))
  
  # Covariates
  covariateVec <- eval(parse(text = paste0("attr(", activeDataSet(),
                                            ", 'covariates')")))
  covariateBox <- variableListBox(
    covariateFrame,
    covariateVec,
    title = "Covariates \n(pick one or more)",
    selectmode = "multiple",
    listHeight = 10,
    initialSelection = varPosn(dialog.values$ini.covariateVar,
                               vars = covariateVec))
  
  
  ##### onOK function #####
  onOK <- function() {
    attrlvlVar   <- getSelection(attrlvlVarBox)
    covariateVar <- getSelection(covariateBox)
    
  putDialog("bws3Interactions", list(
    ini.attrlvlVar   = attrlvlVar,
    ini.covariateVar = covariateVar))
    
  closeDialog()
  
  interactionVars <- NULL
  for (i in attrlvlVar) {
    for (j in covariateVar) {
      doItAndPrint(paste0(activeDataSet(), "$", i, "_", j, " <- ", 
                          activeDataSet(), "$", i, " * ", 
                          activeDataSet(), "$", j))
      interactionVars <- c(interactionVars, paste0("'", i, "_", j, "'"))
    }
  }
  
  justDoIt(paste0("attributes(", activeDataSet(), ")$interactions <- c(", 
                  paste(interactionVars, collapse = ", "), ")"))
  
  activeDataSet(activeDataSet(),
                flushModel = FALSE,
                flushDialogMemory = FALSE)

  tkfocus(CommanderWindow())
  }

  ##### Specification of dialog box #####
  # Ok Cancel Help Buttons
  OKCancelHelp(helpSubject = "bws3Interactions",
               reset       = "bws3Interactions",
               apply       = "bws3Interactions")

  # Attribute/level variabels
  tkgrid(getFrame(attrlvlVarBox), sticky = "w")
  
  # Covariates
  tkgrid(getFrame(covariateBox), sticky = "w")

  tkgrid(attrlvlVarFrame, labelRcmdr(inputFrame, text = "   "),
         covariateFrame, sticky = "nw")
  
  tkgrid(inputFrame, sticky = "w")
  
  # OK Cancel Help Buttons
  tkgrid(buttonsFrame, columnspan = 2, sticky = "w")
  
  dialogSuffix()
}

###############################################################################

bws3Model <- function() {
  initializeDialog(title = gettextRcmdr("Fit Model to BWS3 Data"))
  defaults <- list(
    ini.responseVarName    = "RES",
    ini.independentVarName = NULL,
    ini.strataVarName      = "STR")
  dialog.values <- getDialog("bws3Model", defaults)

  if (!any(Variables() == dialog.values$ini.responseVarName)) {
    dialog.values$ini.responseVarName = gettextRcmdr("<no variable selected>")
  }
  if (!any(Variables() == dialog.values$ini.strataVarName)) {
    dialog.values$ini.strataVarName = gettextRcmdr("<no variable selected>")
  }
    
  .activeModel <- ActiveModel()
  currentModel <- if (!is.null(.activeModel)) {
    class(get(.activeModel, envir = .GlobalEnv))[1] == "clogit"
  } else {
    FALSE
  }
  if (currentModel) {
    currentFields <- formulaFields(get(.activeModel, envir = .GlobalEnv))
    if (currentFields$data != ActiveDataSet()) currentModel <- FALSE
  }
  
  # remove a term 'strata' from the current model formula
  if (currentModel) {
    currentRhs <- currentFields$rhs
    currentRhs <- gsub(' +', '', currentRhs)
    currentRhs <- unlist(strsplit(currentRhs, "\\+"))
    strataPos  <- grep("strata\\(", currentRhs)
    currentRhs <- currentRhs[-strataPos]
    currentRhs <- paste(currentRhs, collapse = " + ")
    currentFields$rhs <- currentRhs
  }
  
  if (isTRUE(getRcmdr("reset.model"))) {
    currentModel <- FALSE
    putRcmdr("reset.model", FALSE)
  }

  ##### Output Frame #####
  # Name for fitted model
  UpdateModelNumber()
  modelName  <- tclVar(paste0("BWS3model.", getRcmdr("modelNumber")))
  modelFrame <- tkframe(top)
  model      <- ttkentry(modelFrame, width = "17", textvariable = modelName)

  
  ##### Input Frame #####
  # Response variable
  responseVarFrame <- tkframe(top)
  responseVarName  <- tclVar(dialog.values$ini.responseVarName)
  responseVar      <- ttkentry(responseVarFrame, width = "5",
                               textvariable = responseVarName)

  # Independent variables
  indVarVec <- 
    eval(parse(text = paste0("attr(", activeDataSet(), ", 'level.variables')")))
  interactionVec <- 
    eval(parse(text = paste0("attr(", activeDataSet(), ", 'interactions')")))
  ascPosition <-
    eval(parse(text = paste0("attr(", activeDataSet(), ", 'asc')")))
  ascVarVec <-
    eval(parse(text = paste0("attr(", activeDataSet(), ", 'asc.names')")))
  asc <- ascVarVec[as.logical(ascPosition)]
  allIndVarVec <- c(asc, indVarVec, interactionVec)

  independentVarFrame <- tkframe(top)
  independentVarBox <- variableListBox(
    independentVarFrame,
    allIndVarVec,
    title = "Independent variables \n(pick one or more)",
    selectmode = "multiple",
    listHeight = 10,
    initialSelection = varPosn(dialog.values$ini.independentVarName,
                               vars = allIndVarVec))

  # Stratification variable
  strataFrame    <- tkframe(top)
  strataVarFrame <- tkframe(strataFrame)
  strataVarName  <- tclVar(dialog.values$ini.strataVarName)
  strataVar      <- ttkentry(strataVarFrame, width = "5",
                             textvariable = strataVarName)

    
  ##### onOK function #####
  onOK <- function () {

    responseVar <- trim.blanks(tclvalue(responseVarName))
    strataVar   <- trim.blanks(tclvalue(strataVarName))
    indVar      <- getSelection(independentVarBox)
    if(length(indVar) == 0) covVar <- "1"
    
    putDialog("bws3Model", list(
      ini.responseVarName    = responseVar,
      ini.independentVarName = indVar,
      ini.strataVarName      = strataVar))
    
    modelValue  <- trim.blanks(tclvalue(modelName))

    closeDialog()

    subset <- tclvalue(subsetVariable)
    if (trim.blanks(subset) == 
        gettextRcmdr("<all valid cases>") || trim.blanks(subset) == "") {
      subset <- ""
      putRcmdr("modelWithSubset", FALSE)
    } else {
      subset <- paste0(", subset = ", subset)
      putRcmdr("modelWithSubset", TRUE)
    }

    rhsVars <- paste(indVar, collapse = " + ")
    
    formula <- paste(responseVar, " ~ ", rhsVars,
                     " + strata(", strataVar ,")", sep = "")

    cmd <- paste("clogit(", formula, ", data = ", ActiveDataSet(), subset, ")",
                 sep = "")
    doItAndPrint(paste(modelValue, " <- ", cmd, sep = ""))
    doItAndPrint(paste(modelValue))
    doItAndPrint(paste("gofm(", modelValue,")", sep = ""))
    
    activeModel(modelValue)
    tkfocus(CommanderWindow())
  }

  
  ##### Specification of dialog box #####
  # Ok Cancel Help Buttons 
  OKCancelHelp(helpSubject = "bws3Model",
               model       = TRUE,
               reset       = "resetBws3Model",
               apply       = "bws3Model")

  # Output
  tkgrid(labelRcmdr(modelFrame, text = gettextRcmdr("Name for model ")),
         model, sticky = "w")
  tkgrid(modelFrame, sticky = "w")

  # Blank line
  tkgrid(labelRcmdr(top, text = ""))

  # Input
  ## Response variable
  tkgrid(labelRcmdr(responseVarFrame,
                    text = gettextRcmdr("Response variable ")),
         labelRcmdr(responseVarFrame,
                    text = tclvalue(responseVarName),
                    relief = "solid", foreground = "green"),
         sticky = "w")
  tkgrid(responseVarFrame, sticky = "w")

  ## Independent variables (Modified 0.1-3)
  tkgrid(getFrame(independentVarBox), sticky = "w")
  tkgrid(independentVarFrame, sticky = "w")

  ## Stratification variable
  tkgrid(labelRcmdr(strataVarFrame,
                    text = gettextRcmdr("Stratification variable ")),
         labelRcmdr(strataVarFrame,
                    text = tclvalue(strataVarName),
                    relief = "solid", foreground = "green"),
         sticky = "w")
  tkgrid(strataVarFrame, sticky = "w")
  tkgrid(strataFrame, sticky = "w")

  ## Blank line
  tkgrid(labelRcmdr(top, text = ""))

  ## Subset
  subsetBox(model = TRUE)
  tkgrid(subsetFrame, sticky = "w")

  # OK Cancel Help Buttons
  tkgrid(buttonsFrame, columnspan = 2, sticky = "w")

  dialogSuffix(preventDoubleClick = TRUE)
}

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

###############################################################################

bws3Mwtp <- function() {
  initializeDialog(
    title = gettextRcmdr("Calculate Marginal Willingness to Pay"))
  defaults <- list(
    outputName    = "MWTP",
    moneyName     = gettextRcmdr("<no variable selected>"),
    nonmoneyName  = NULL,
    calcmethod    = "1",
    NdrawsValue   = "1000",
    confLevelName = "0.95",
    RNGseedName   = "")
  dialog.values <- getDialog("bws3Mwtp", defaults)
  
  .activeModel <- ActiveModel()
  currentModel <- if (!is.null(.activeModel)) {
    class(get(.activeModel, envir = .GlobalEnv))[1] == "clogit"
  } else {
    FALSE
  }
  

  ##### Output Frame #####
  # output
  outputFrame <- tkframe(top)
  outputName  <- tclVar(dialog.values$outputName)
  output      <- ttkentry(outputFrame, width = "17", textvariable = outputName)
  
  
  ##### Input Frame #####
  inputsFrame    <- tkframe(top)
  moneyFrame     <- tkframe(inputsFrame)
  clFrame        <- tkframe(inputsFrame)
  optionsKRFrame <- tkframe(inputsFrame)
  methodFrame    <- tkframe(inputsFrame)
  titleFrame     <- tkframe(inputsFrame)
  RNGseedFrame   <- tkframe(top)

  ## Monetary variable
  moneyVarBox <- variableComboBox(
    moneyFrame,
    variableList = names(coef(get(activeModel()))),
    initialSelection = dialog.values$moneyName, 
    title = "Monetary variable")
  
  ## Nonmonetary variables
  nonmoneyVarsBox <- variableListBox(
    moneyFrame,
    variableList = names(coef(get(activeModel()))),
    selectmode = "multiple",
    initialSelection = varPosn(dialog.values$nonmoneyName,
                               vars = names(coef(get(activeModel())))),
    title = "Nonmonetary variables (pick one or more)")
  
  ## Bootstrap method
  radioButtons(methodFrame, 
               name    = "methodtype",
               buttons = c("krinskyrobb", "delta"),
               values  = c("1", "2"),
               labels  = gettextRcmdr(c("Krinsky and Robb", "Delta")),
               initialValue = dialog.values$calcmethod,
               title   = gettextRcmdr("Calculation method"))
  
  ## Confidence level
  confLevelName <- tclVar(dialog.values$confLevelName)
  confLevel     <- ttkentry(clFrame, width = "7",
                            textvariable = confLevelName)

  NdrawsValue   <- tclVar(dialog.values$NdrawsValue)
  Ndraws        <- ttkentry(optionsKRFrame, width = "7",
                            textvariable = NdrawsValue)
  
  ## Random number generator seed
  RNGseedName <- tclVar(dialog.values$RNGseedName)
  RNGseed     <- ttkentry(optionsKRFrame, width = "7",
                          textvariable = RNGseedName)
  
  
  ### onOK button ###
  onOK <- function() {

    moneyVar <- getSelection(moneyVarBox)
    nonmoneyVars <- getSelection(nonmoneyVarsBox)
    nonmoneyName <- nonmoneyVars

    if (moneyVar == "<no variable selected>") {
      errorCondition(recall = bws3Mwtp,
                     message = gettextRcmdr("Select monetary variable"))
      return()
    }
    
    if (length(nonmoneyVars) == 0) {
      errorCondition(recall = bws3Mwtp,
                     message = gettextRcmdr("Select nonmonetary variable(s)"))
      return()
    } else {
      nonmoneyVars <- paste('c("', paste(nonmoneyVars, collapse = '", "'), '")',
                            sep = "")
      cmd.nonmoney <- paste('", nonmonetary.variables = ', nonmoneyVars,
                            sep = "")
    }

    putDialog("bws3Mwtp", list(
      outputName    = tclvalue(outputName),
      moneyName     = moneyVar,
      nonmoneyName  = nonmoneyName,
      calcmethod    = tclvalue(methodtypeVariable),
      NdrawsValue   = tclvalue(NdrawsValue),
      confLevelName = tclvalue(confLevelName),
      RNGseedName   = tclvalue(RNGseedName)))

    outputValue <- trim.blanks(tclvalue(outputName))
    closeDialog()

    if (tclvalue(methodtypeVariable) == "1") {
      cmd.method <- paste(', method = "kr"', sep = "")
    } else {
      cmd.method <- paste(', method = "delta"', sep = "")
    }
    
    if (is.na(as.numeric(tclvalue(RNGseedName)))) {
      cmd.seed <- paste(", seed = NULL)", sep = "")
    } else {
      cmd.seed <- paste(", seed = ",  as.numeric(tclvalue(RNGseedName)), 
                        ")", sep = "")
    }

    doItAndPrint(paste(
      outputValue, ' <- mwtp(output = ', activeModel(),
      ', monetary.variables = "', moneyVar,
      cmd.nonmoney,
      ', nreplications = ', tclvalue(NdrawsValue),
      ', confidence.level = ', tclvalue(confLevelName),
      cmd.method, cmd.seed, sep = ""))
    doItAndPrint(paste0(outputValue))
    
    tkfocus(CommanderWindow())
  }
  
  ##### Specification of dialog box #####
  # Ok Cancel Help Buttons 
  OKCancelHelp(helpSubject = "bws3Mwtp",
               reset       = "bws3Mwtp",
               apply       = "bws3Mwtp")

  # Output
  tkgrid(labelRcmdr(outputFrame,
                    text = gettextRcmdr("Name for output ")),
         output, sticky = "w")
  tkgrid(outputFrame, sticky = "w")
  
  # Blank line
  tkgrid(labelRcmdr(top, text = ""))
  
  # Input
  ## Monetary variable
  tkgrid(getFrame(moneyVarBox), sticky = "w")

  ## Nonmonetary variable
  tkgrid(getFrame(nonmoneyVarsBox), sticky = "nw")
  tkgrid(moneyFrame, sticky = "w")

  ## Calculation method
  tkgrid(methodtypeFrame, sticky = "w")
  tkgrid(methodFrame, sticky = "w")
  
  ## Confidence level
  tkgrid(labelRcmdr(clFrame,
                    text = gettextRcmdr("Confidence level ")),
         confLevel, sticky = "w")
  tkgrid(clFrame, sticky = "w")
  
  ## Options for Krinsky and Robb
  tkgrid(
    labelRcmdr(
      titleFrame,
      text = gettextRcmdr("Options for Krinsky and Robb method:")),
     sticky = "w")
  tkgrid(titleFrame, sticky = "w")
  
  ### Number of replications
  tkgrid(labelRcmdr(optionsKRFrame,
                    text = gettextRcmdr("Number of replications ")),
         Ndraws, sticky = "w")
  
  ### Random number generator
  tkgrid(
    labelRcmdr(
      optionsKRFrame,
      text = gettextRcmdr("Seed for random number generator (optional) ")),
    RNGseed, sticky = "w")
  tkgrid(optionsKRFrame, sticky = "w")
  
  tkgrid(inputsFrame, sticky = "w")
  
  # OK Cancel Help Buttons
  tkgrid(buttonsFrame, columnspan = 2, sticky = "w")
  
  dialogSuffix()
}

###############################################################################

bws3Load <- function() {
  file <- 
    tclvalue(
      tkgetOpenFile(
        filetypes = 
          gettextRcmdr(' {"R Data Files" {".rda" ".RDA" ".rdata" ".RData"}}')))
  if (file == "") {
    return()
  }
  setBusyCursor()
  on.exit(setIdleCursor())

  cmd <- paste0('load("', file, '")')
  loadedObject <- justDoIt(cmd)
  logger(cmd)
  Message(paste0(gettextRcmdr("Name of loaded object: "),
          paste(loadedObject, collapse = ", ")),
          type = "note")

  tkfocus(CommanderWindow())
}

###############################################################################

bws3ClogitP <- function() {
  activeModelP() && 
  class(get(ActiveModel()))[1] == "clogit" && 
  class(get(ActiveDataSet()))[1] == "bws3dataset"
}

bws3DataP <- function() {
  activeDataSetP() && class(get(ActiveDataSet()))[1] == "bws3dataset"
}
###############################################################################

bws3ResponseSet <- function(){
  initializeDialog(title = gettextRcmdr("Set Options for Response Collection"))
  defaults <- list(designName      = "BWS3design",
                   ini.noneofthese = "1",
                   saveVariable    ="1")
  dialog.values = getDialog("bws3ResponseSet", defaults)
  
  ##### Input Frame #####
  inputsFrame <- tkframe(top)
  designFrame <- tkframe(inputsFrame)
  noneFrame   <- tkframe(inputsFrame)
  blockFrame  <- tkframe(inputsFrame)
  saveFrame   <- tkframe(inputsFrame)
  
  # Choice sets
  designName <- tclVar(dialog.values$designName)
  design <- ttkentry(designFrame, width = "14",
                     textvariable = designName)
  
  # None of these
  noneVariable <- tclVar(dialog.values$ini.noneofthese)
  noneCheckBox <- ttkcheckbutton(noneFrame, variable = noneVariable)
  
  # Block
  nBLOCK <- eval(parse(text = paste0(tclvalue(designName),
                                     "$design.information$nblocks")))
  setBLOCK <- variableComboBox(blockFrame,
                               variableList = seq(nBLOCK),
                               initialSelection = "1",
                               nullSelection = "<no block selected>",
                               title = "Block number")
  
  # Save
  saveVariable <- tclVar(dialog.values$saveVariable)
  saveCheckBox <- ttkcheckbutton(saveFrame, variable = saveVariable)
  
  onOK <- function() {
    BLOCK <- getSelection(setBLOCK)
    
    if (BLOCK == "<no block selected>") {
      Message(gettextRcmdr("Please select block number"), type = "warning")
      closeDialog()
      bws3ResponseSet()
      return()
    }
    
    if (tclvalue(noneVariable) == 1) {
      NONE <- TRUE
    } else {
      NONE <- FALSE
    }
    
    if (tclvalue(saveVariable) == 1) {
      SAVE <- TRUE
    } else {
      SAVE <- FALSE
    }
    
    closeDialog()
    
    putRcmdr("BWS3response.BLOCK", as.numeric(BLOCK))
    putRcmdr("BWS3response.NONE",  NONE)
    putRcmdr("BWS3response.SAVE",  SAVE)
    
    bws3Response()
    
    tkfocus(CommanderWindow())
  }
  
  OKCancelHelp(helpSubject = "bws3Response")
  
  # Name of design
  tkgrid(
    labelRcmdr(
      designFrame,
      text = gettextRcmdr("Design ")),
    design,
    sticky = "w")
  
  # Check box for none of these option
  tkgrid(
    noneCheckBox,
    labelRcmdr(
      noneFrame,
      text = gettextRcmdr("Opt-out option")),
    sticky = "w")
  
  # Check box for save responses
  tkgrid(
    saveCheckBox,
    labelRcmdr(
      saveFrame,
      text = gettextRcmdr("Save to file")),
    sticky = "w")
  
  tkgrid(designFrame, sticky = "nw")
  tkgrid(noneFrame,   sticky = "nw")
  tkgrid(saveFrame,   sticky = "nw")
  
  tkgrid(getFrame(setBLOCK), sticky = "w")
  tkgrid(blockFrame, sticky = "nw")
  
  tkgrid(inputsFrame, sticky = "nw")
  
  tkgrid(buttonsFrame, columnspan = 2, sticky = "w")
  
  dialogSuffix()
}

###############################################################################

bws3Response <- function() {
  initializeDialog(title = gettextRcmdr("Collect Responses to BWS3 Questions"))
  defaults <- list(
    ini.Q          = 1,
    ini.bestName   = "<no alternative selected>",
    ini.worstName  = "<no alternative selected>",
    ini.designName = "BWS3design")
  dialog.values <- getDialog("bws3Response", defaults)

  block <-getRcmdr("BWS3response.BLOCK")
  none  <-getRcmdr("BWS3response.NONE")
  save  <-getRcmdr("BWS3response.SAVE")
  
  designName  <- tclVar(dialog.values$ini.designName)
  designValue <- tclvalue(designName)
  
  nQues <- eval(parse(text = paste0(tclvalue(designName),
                                    "$design.information$nquestions")))
  nALTs <- eval(parse(text = paste0(tclvalue(designName),
                                    "$design.information$nalternatives")))
  nAtts <- eval(parse(text = paste0(tclvalue(designName),
                                    "$design.information$nattributes")))
  
  selectedBlockRows <- seq(nQues) + nQues * (block - 1)
  
  inputsFrame   <- tkframe(top)
  altFrame      <- tkframe(inputsFrame)
  bwFrame       <- tkframe(inputsFrame)
  okcancelFrame <- tkframe(top)
  okFrame       <- tkframe(okcancelFrame)
  cancelFrame   <- tkframe(okcancelFrame)
  
  # ComboBox
  if(none == TRUE) {
    varLIST <- c(paste0("alt. ", seq(nALTs)), "None of these")
  } else {
    varLIST <- paste0("alt. ", seq(nALTs))
  }
  ## Best
  bestitem <- variableComboBox(bwFrame,
                               variableList  = varLIST,
                               nullSelection = "<no alternative selected>",
                               adjustWidth   = TRUE)
  ## Worst
  worstitem <- variableComboBox(bwFrame,
                                variableList  = varLIST,
                                nullSelection = "<no alternative selected>",
                                adjustWidth   = TRUE)
  
  # Button
  ## OK
  onOK <- function() {
    bestName  <- getSelection(bestitem)
    worstName <- getSelection(worstitem)
    
    if(bestName == "<no alternative selected>") {
      Message(gettextRcmdr("Please select your best alternative"),
              type = "warning")
      closeDialog()
      bws3Response()
      return()
    }
    
    if(worstName == "<no alternative selected>") {
      Message(gettextRcmdr("Please select your worst alternative"),
              type = "warning")
      closeDialog()
      bws3Response()
      return()
    }

    if(bestName == worstName) {
      Message(
        gettextRcmdr("Your best alternative must differ from your worst alternative"),
        type = "warning")
      closeDialog()
      bws3Response()
      return()
    }
    
    putDialog("bws3Response", list(
      ini.Q          = dialog.values$ini.Q + 1,
      ini.bestName   = "<no alternative selected>",
      ini.worstName  = "<no alternative selected>",
      ini.designName = designValue))
    
    if(dialog.values$ini.Q == 1) {
      set.seed(seed = NULL)
      justDoIt(paste0("MyBWS3responses <- c(", sample.int(1e10, 1),
                      ", ", block, ")"))
    }
    
    justDoIt(paste0("MyBWS3responses <- c(MyBWS3responses, ",
                    which(bestName  == varLIST), ", ",
                    which(worstName == varLIST), ")"))
    
    closeDialog()
    
    if(dialog.values$ini.Q < nQues) {
      bws3Response()
    } else {
      putDialog("bws3Response", list(
        ini.Q          = 1,
        ini.bestName   = "<no alternative selected>",
        ini.worstName  = "<no alternative selected>",
        ini.designName = designValue))
      
      varNAMES <- paste0("'",
                         paste0(rep(c("B", "W"), time = nQues),
                                rep(1:nQues, each = 2),
                                collapse = "', '"),
                         "'")
      cmd <- paste0("names(MyBWS3responses) <- c('ID', 'BLOCK', ",
                    c(varNAMES), ")")
      justDoIt(cmd)
      doItAndPrint(paste0("MyBWS3responses"))
      
      # Save
      if(isTRUE(save)) {
        saveFile <- tclvalue(tkgetSaveFile(
          filetypes = gettextRcmdr(
            '{"CSV Files" {".csv" ".CSV"}}'),
          defaultextension = ".csv",
          initialfile = "MyBWS3responses.csv",
          parent = CommanderWindow()))
        if(saveFile == "") {
          tkfocus(CommanderWindow())
          return()
        }
        cmd <- paste0('write.csv(t(MyBWS3responses), file = "', saveFile,
                      '", row.names = FALSE)')
        justDoIt(cmd)
        logger(cmd)
        Message(
          paste0(
            gettextRcmdr("Your responses to BWS3 questions were exported to file: "),
            saveFile),
          type = "note")
      }
    }
    tkfocus(CommanderWindow())
  }
  
  ## Cancel
  onCancel <- function() {
    closeDialog()

    putDialog("bws3Response", list(
      ini.Q          = 1,
      ini.bestName   = "<no alternative selected>",
      ini.worstName  = "<no alternative selected>",
      ini.designName = designValue))
    
    tkfocus(CommanderWindow())
  }
  
  tkgrid(
    labelRcmdr(
      inputsFrame,
      text = gettextRcmdr(paste0("Question ", dialog.values$ini.Q))),
    sticky = "w")
  
  tkgrid(
    labelRcmdr(
      inputsFrame,
      text = gettextRcmdr(
        "Please select your best and worst alternatives from the following:")),
    sticky = "w")
  
  dsg <- eval(parse(text = paste0("bws3ResponseQ(", tclvalue(designName), ")")))
  
  for(i in seq(nALTs)) {
    tkgrid(
      labelRcmdr(
        altFrame,
        text = paste0(dsg[[selectedBlockRows[dialog.values$ini.Q]]][1, i], ": "),
        fg = getRcmdr("title.color"),
        font = "RcmdrTitleFont"),
      labelRcmdr(
        altFrame,
        text = dsg[[selectedBlockRows[dialog.values$ini.Q]]][-1, i]),
      sticky = "w")
  }
  tkgrid(altFrame, sticky = "w")
  
  tkgrid(
    labelRcmdr(inputsFrame, text =""),
    sticky = "w")
  
  tkgrid(labelRcmdr(bwFrame, text = "My best: "),
         getFrame(bestitem),
         sticky = "w")
  tkgrid(labelRcmdr(bwFrame, text = "My worst: "),
         getFrame(worstitem),
         sticky = "w")
  tkgrid(bwFrame, sticky = "w")
  
  okButton <- buttonRcmdr(okFrame,
                          text = gettextRcmdr("OK"),
                          foreground = "darkgreen",
                          width = "10",
                          command = onOK,
                          default = "active",
                          borderwidth = 3,
                          image = "::image::okIcon",
                          compound = "left")

  cancelButton <- buttonRcmdr(cancelFrame,
                              text = gettextRcmdr("Cancel"),
                              foreground = "darkgreen",
                              width = "10",
                              command = onCancel,
                              default = "active",
                              borderwidth = 3,
                              image = "::image::cancelIcon",
                              compound = "left")
  
  tkgrid(okButton, sticky = "w")
  tkconfigure(okButton, takefocus = 0)

  tkgrid(cancelButton, sticky = "w")
  tkconfigure(cancelButton, takefocus = 0)
  
  tkgrid(
    labelRcmdr(
      inputsFrame,
      text = ""),
    sticky = "w")
  
  tkgrid(inputsFrame,          sticky = "nw")
  tkgrid(okFrame, cancelFrame, sticky = "nw")
  tkgrid(okcancelFrame,        sticky = "nw")

  dialogSuffix()
}

###############################################################################
bws3ResponseQ <- function (design, common = NULL, quote = TRUE) {
  nblocks <- design$design.information$nblocks
  nquestions <- design$design.information$nquestions
  nalternatives <- design$design.information$nalternatives
  nattributes <- design$design.information$nattributes
  attribute.names <- names(design[[1]][[1]])[-(1:3)]
  my.design <- as.matrix(design[[1]][[1]])
  
  if (nalternatives >= 2) {
    for (i in 2:nalternatives) {
      my.design <- rbind(my.design, as.matrix(design$alternatives[[i]]))
    }
  }
  
  if (is.null(common) == FALSE) {
    nalternatives <- nalternatives + 1
    common.base <- design$alternatives[[1]]
    common.base[, 3] <- nalternatives
    common.base <- as.matrix(common.base)
    for (i in attribute.names) {
      common.base[, i] <- common[[i]]
    }
    my.design <- rbind(my.design, common.base)
  }
  
  rownames(my.design) <- NULL
  my.design <- data.frame(my.design)
  my.design$BLOCK <- as.numeric(as.character(my.design$BLOCK))
  my.design$QES <- as.numeric(as.character(my.design$QES))  
  my.design$ALT <- as.numeric(as.character(my.design$ALT))
  my.design <- my.design[order(my.design$BLOCK, my.design$QES, my.design$ALT), ]
  alternative.names <- paste("alt.", 1:nalternatives, sep = "")
  
  BWS3show <- list(NULL)
  
  q <- 1
  for (i in 1:nblocks) {
    for (j in 1:nquestions) {
      temp <- subset(my.design, my.design$BLOCK == i & my.design$QES == j)
      temp <- temp[, 4:(3 + nattributes)]
      if (nattributes == 1) {
        temp <- as.data.frame(temp)
        names(temp) <- attribute.names
      }
      temp <- t(temp)
      colnames(temp) <- alternative.names
      BWS3show[[q]] <- temp
      BWS3show[[q]] <- rbind(colnames(BWS3show[[q]]), BWS3show[[q]])
      q <- q + 1
    }
  }
  return(BWS3show)
}