This post is a huge jump from the last two - this is not for beginners!! But if you've ever considered building a GUI in R, looked at some of the online documentation, gotten scared, and decided not to, read this!!! Ok here goes.

Dorian Auto GUI

Setup: I built this for a school project. The basic problem setup is from a class I'm taking on operations research using spreadsheets. There exists a car company named Dorian Auto that has the capability to produce 5 different car models - small car, medium car, large car, medium van, and large van. Each of these models require a fixed amount of steel and a fixed amount of labor to produce. Each car model also has a fixed profit associated with it - the payoff for producing one unit of that car model. Here's the tricky part: there is a minimum production quantity for each model as well. For example, if Dorian is going to produce Small Cars, it must produce at least 1000 of them. Here is this information summarized in a data frame:
###### Set Default Values
Dorian <- data.frame(Model = c("Small Car", "Medium Car", "Large Car", "Medium Van", 
    "Large Van"), SteelReq = c(1.5, 3, 5, 6, 8), LabReq = c(30, 25, 40, 45, 
    55), MinProd = c(1000, 1000, 1000, 200, 200), Profit = c(2000, 2500, 3000, 
    5500, 7000))
# Change Model to class character (instead of factor) so that model names
# can be changed later If I don't do this and I try to change one of the
# model names, I will get an error that this new name is not one of the
# current levels of the variable
Dorian$Model <- as.character(Dorian$Model)
Dorian
##        Model SteelReq LabReq MinProd Profit
## 1  Small Car      1.5     30    1000   2000
## 2 Medium Car      3.0     25    1000   2500
## 3  Large Car      5.0     40    1000   3000
## 4 Medium Van      6.0     45     200   5500
## 5  Large Van      8.0     55     200   7000
Dorian also has a fixed amount of resources available:
Materials <- data.frame(Steel = 6500, Labor = 65000)
Materials
##   Steel Labor
## 1  6500 65000
Now my job is to maximize the profit of Dorian Auto by choosing the most profitable production schedule given the resource constraints and the minimum production quantities. I used the Rglpk package to do this. This is essentially an integer optimization problem with several boolean variables. Here's the basic function I used to solve for the optimal solution:
DorianAutoFunction<-function(Inputs,Constraints){
  library(Rglpk)
  # Introduce my data
  Dorian <- data.frame(Inputs)
  Dorian<-Dorian[complete.cases(Dorian),]
  num.models <- nrow(Dorian)
  Materials<-data.frame(Constraints)

  # only x1, x2, x3, x4, x5 contribute to the total profit
  objective  <- c(Dorian$Profit, rep(0, num.models))

  constraints.mat <- rbind(
    c(Dorian$SteelReq, rep(0, num.models)),                    # total steel used
    c(Dorian$LabReq,   rep(0, num.models)),                    # total labor used
    cbind(-diag(num.models), +diag(Dorian$MinProd)),           # MinProd_i * z_i
    cbind(+diag(num.models), -diag(rep(9999999, num.models)))) # x_i - 9999999 x_i

  constraints.dir <- c("<=",
                       "<=",
                       rep("<=", num.models),
                       rep("<=", num.models))

  constraints.rhs <- c(Materials$Steel,
                       Materials$Labor,
                       rep(0, num.models),
                       rep(0, num.models))

  var.types <- c(rep("I", num.models),  # x1, x2, x3, x4, x5 are integers
                 rep("B", num.models))  # z1, z2, z3, z4, z5 are booleans

  mysolution<-Rglpk_solve_LP(obj   = objective,
                             mat   = constraints.mat,
                             dir   = constraints.dir,
                             rhs   = constraints.rhs,
                             types = var.types,
                             max   = TRUE)
  return(mysolution)
}
I must give credit here to flodel on Stack Overflow for this function.
This class and textbook rely entirely on excel and I must point out here that while solving this in excel might be easier, excel actually returns a wrong answer. If you call the function defined above on the Dorian data frame previously defined, you get a solution:
DorianAutoFunction(Dorian, Materials)
## $optimum
## [1] 6408000
## 
## $solution
##  [1] 1000    0    0  202  471    1    0    0    1    1
## 
## $status
## [1] 0
Dorian Auto should produce 1000 Small Cars, 0 Medium Cars, 0 Large Cars, 202 Medium Vans, and 471 Large Vans for a profit of $6408000.
This solution is not necessarily intuitive. Large Vans are the most profitable per unit of resources required, so why don't we make more of these? The only reason we produce any Small Cars or Medium Vans in the solution is because they most efficiently eat up the last bits of resources that would be left over if we were only producing Large Vans. So the solution we arrive at is something like this: 1. Produce the bare minimum amount of Small Cars because these use the smallest amount of Labor and Steel, so these can eat up the lat bits of remaining materials at the end. 2. Is there any intermediate vehicle we could produce that would eat up some of the leftover after we're done producing the Large Vans, while earning us more profit per unit of materials than Small Cars? If so, produce the bare minimum of these. In this particular case, this is the Medium Van. 3. After this, produce as many Large Vans as possible to maximize profit. Large Vans earn us the most per unit of materials required. 4. Now go back and use up the last bits of resources that are too few to produce one Large Van. First try to use the leftovers on a Medium Van (slightly better payoff than Small Cars). If there isn't enough to produce a Medium Van, use the leftovers on a Small Car.
The solution in the textbook is slightly different than the one we arrived at using Rglpk. It says Dorian should produce 1000 Small Cars, 0 Medium Cars, 0 Large Cars, 200 Medium Vans, and 473 Large Vans for a profit ofsum(c(1000,0,0,200,473)*Dorian$Profit) = $6.411 &times; 10<sup>6</sup> At first I thought my function was slightly off - I was getting less profit than the “correct” answer. But upon closer inspection, the textbook (and excel)'s solution is over budget on labor:
sum(c(1000, 0, 0, 200, 473) * Dorian$LabReq) <= Materials$Labor
## [1] FALSE
So the solution presented in the textbook is hardly a solution at all. The whole point of this exercise is to intelligently allocate the current amount of resources available. If we were going to ignore these constraints and simply try to define a strategy to maximize profit, regardless of what was currently available, we would choose to produce exclusively Large Vans because they net the most profit per unit of input materials. The reason excel is wrong here is due to a rounding error, so it's only slightly off, but it's still wrong.
Enough about linear programming though. On to the good stuff. For my presentation, I wanted to present something attractive to summarize the solution so I wrote another little function. This function produces 3 figures and I wanted to display them all in one graphics device in the GUI, so I borrowed some code from the Cookbook for R/) website. (which by the way I use all the time and it's awesome). Here's the function for arranging multiple plots together into one graphics window:
multiplot <- function(..., plotlist = NULL, file, cols = 1, layout = NULL) {
    library(grid)

    # Make a list from the ... arguments and plotlist
    plots <- c(list(...), plotlist)

    numPlots = length(plots)

    # If layout is NULL, then use 'cols' to determine layout
    if (is.null(layout)) {
        # Make the panel ncol: Number of columns of plots nrow: Number of rows
        # needed, calculated from # of cols
        layout <- matrix(seq(1, cols * ceiling(numPlots/cols)), ncol = cols, 
            nrow = ceiling(numPlots/cols))
    }

    if (numPlots == 1) {
        print(plots[[1]])

    } else {
        # Set up the page
        grid.newpage()
        pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))

        # Make each plot, in the correct location
        for (i in 1:numPlots) {
            # Get the i,j matrix positions of the regions that contain this subplot
            matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))

            print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row, layout.pos.col = matchidx$col))
        }
    }
}
And here's the function for displaying the solution to the problem in a way that's nicer to look at than a spreadsheet:
CalcFunction <- function(Dorian, Materials) {
    mysolution <- DorianAutoFunction(Dorian, Materials)
    num.models <- nrow(Dorian)

    graphdat <- data.frame(Model = Dorian$Model, Production = mysolution$solution[1:num.models], 
        ProfitContributed = mysolution$solution[1:num.models] * Dorian$Profit)

    graphdat2 <- data.frame(Model = rep(Dorian$Model, 2), Materials = rep(c("Steel", 
        "Labor"), each = num.models), percentMaterials = mysolution$solution[1:num.models] * 
        Dorian$SteelReq/Materials$Steel, percentLabor = mysolution$solution[1:num.models] * 
        Dorian$LabReq/Materials$Labor)

    library(ggplot2)
    p <- ggplot(graphdat, aes(x = Model, y = Production, fill = Model)) + geom_bar() + 
        guides(fill = F) + geom_text(label = as.character(graphdat$Production), 
        y = 25) + labs(title = "Production Schedule", x = "")

    q <- ggplot(graphdat2, aes(x = Materials, y = percentMaterials, fill = Model)) + 
        geom_bar(position = "stack") + labs(y = "% Used", title = "Resource Consumption", 
        x = "")

    r <- ggplot(graphdat, aes(x = Model, y = ProfitContributed/1e+06, fill = Model)) + 
        geom_bar() + guides(fill = F) + labs(title = paste("Total Profit = $", 
        as.character(sum(graphdat$ProfitContributed)), sep = ""), y = "Profit ($ Millions)", 
        x = "") + theme(plot.title = element_text(face = "bold", size = 20))

    mydashboard <- multiplot(r, p, q, layout = matrix(c(1, 2, 1, 3), nrow = 2), 
        by.row = T)
    print(mydashboard)
}

Sensitivity Analysis

I was not the first one to present one of these problems to my class and I had noticed in other presentations that something called sensitivity analysis was popular among the students in my class. Being as my presentation would be at least partially peer graded, I figured I had best include some sensitivity analysis. Sensitivity analysis is essentially just asking “What would happen to my solution if I tweaked the inputs just a little?”. For example, if I lowered the profit associated with the sale of one Large Van just a little (say $25), my solution wouldn't change, but if I kept lowering it, at some point I would cross a threshold and it would suddenly become more profitable to adopt an entirely different strategy. After doing some research online, I realized that you can actually get quite fancy with sensitivity analysis in R using all kinds of algorithms and this and that, but I decided to take a much less refined approach. I basically took the constraint I wanted to investigate, changed it a little, solved the problem again with the new value, and repeated. Then I put all of the solutions in a dataframe and plotted them. I decided to plot profit as a function of the changing parameter and the number of each car model produced in the optimal solution as a function of the changing parameter. I made separate sensitivity analysis functions for steel, labor, minimum production quantity, profit/unit, and for each of the materials constraints:
##### Steel Sensitivity Analysis #####
SteelSensitivity <- function(x) {
    library(reshape2)
    library(ggplot2)
    SteelList <- replicate(n = 26 + min(25, (Dorian[x, 2]/0.1) - 1), Dorian, 
        simplify = F)
    SteelList[[1]][x, 2] <- max(Dorian[x, 2] - 2.5, 0.5)
    for (i in 2:length(SteelList)) {
        SteelList[[i]][x, 2] <- SteelList[[i - 1]][x, 2] + 0.1
    }
    SteelSens <- sapply(SteelList, DorianAutoFunction, Constraints = Materials)
    SensDat <- data.frame(t(rbind(sapply(SteelSens[2, ], unlist)[1:5, ], unlist(SteelSens[1, 
        ]))))
    names(SensDat) <- c(Dorian[, 1], "Profit")
    SensDat$Steel <- seq(max(Dorian[x, 2] - 2.5, 0.5), (length(SteelList) - 
        1) * 0.1 + max(Dorian[x, 2] - 2.5, 0.5), by = 0.1)
    SensDat.melt <- melt(data = SensDat, id.vars = c("Steel", "Profit"), measure.vars = c("Small Car", 
        "Medium Car", "Large Car", "Medium Van", "Large Van"))
    prod.plot <- ggplot(SensDat.melt, aes(x = Steel, y = value, color = variable)) + 
        geom_line(lwd = 1.2) + geom_vline(xintercept = Dorian[x, 2], color = "blue", 
        lwd = 2, alpha = 0.2) + labs(x = "", y = "Production Schedule", color = "Model", 
        title = paste("Sensitivity Analysis of", Dorian[x, 1], "Steel Requirement")) + 
        theme(legend.position = "bottom")

    prof.plot <- ggplot(SensDat, aes(x = Steel, y = Profit/1e+05)) + geom_line(color = "red", 
        lwd = 2) + geom_vline(xintercept = Dorian[x, 2], color = "blue", lwd = 2, 
        alpha = 0.2) + labs(x = "Steel Required", y = "Profit ($100,000's)") + 
        theme(legend.position = "bottom")

    multiplot(prod.plot, prof.plot)
}

##### Labor Sensitivity Analysis #####
LaborSensitivity <- function(x) {
    library(reshape2)
    library(ggplot2)
    LaborList <- replicate(n = 26 + min(25, (Dorian[x, 3]) - 1), Dorian, simplify = F)
    LaborList[[1]][x, 3] <- max(Dorian[x, 3] - 25, 1)
    for (i in 2:length(LaborList)) {
        LaborList[[i]][x, 3] <- LaborList[[i - 1]][x, 3] + 1
    }
    LaborSens <- sapply(LaborList, DorianAutoFunction, Constraints = Materials)
    SensDat <- data.frame(t(rbind(sapply(LaborSens[2, ], unlist)[1:5, ], unlist(LaborSens[1, 
        ]))))
    names(SensDat) <- c(Dorian[, 1], "Profit")
    SensDat$Labor <- seq(max(Dorian[x, 3] - 25, 1), (length(LaborList) - 1) + 
        max(Dorian[x, 3] - 25, 1), by = 1)
    SensDat.melt <- melt(data = SensDat, id.vars = c("Labor", "Profit"), measure.vars = c("Small Car", 
        "Medium Car", "Large Car", "Medium Van", "Large Van"))
    prod.plot <- ggplot(SensDat.melt, aes(x = Labor, y = value, color = variable)) + 
        geom_line(lwd = 1.2) + geom_vline(xintercept = Dorian[x, 3], color = "blue", 
        lwd = 2, alpha = 0.2) + labs(x = "", y = "Production Schedule", color = "Model", 
        title = paste("Sensitivity Analysis of", Dorian[x, 1], "Labor Requirement")) + 
        theme(legend.position = "bottom")

    prof.plot <- ggplot(SensDat, aes(x = Labor, y = Profit/1e+05)) + geom_line(color = "red", 
        lwd = 2) + geom_vline(xintercept = Dorian[x, 3], color = "blue", lwd = 2, 
        alpha = 0.2) + labs(x = "Labor Required", y = "Profit ($100,000's)") + 
        theme(legend.position = "bottom")

    multiplot(prod.plot, prof.plot)
}

##### Minimum Production Sensitivity Analysis #####
MinProductionSensitivity <- function(x) {
    library(reshape2)
    library(ggplot2)
    MinProductionList <- replicate(n = 26 + min(25, (Dorian[x, 4]/10) - 1), 
        Dorian, simplify = F)
    MinProductionList[[1]][x, 4] <- max(Dorian[x, 4] - 250, 10)
    for (i in 2:length(MinProductionList)) {
        MinProductionList[[i]][x, 4] <- MinProductionList[[i - 1]][x, 4] + 10
    }
    MinProductionSens <- sapply(MinProductionList, DorianAutoFunction, Constraints = Materials)
    SensDat <- data.frame(t(rbind(sapply(MinProductionSens[2, ], unlist)[1:5, 
        ], unlist(MinProductionSens[1, ]))))
    names(SensDat) <- c(Dorian[, 1], "Profit")
    SensDat$MinProduction <- seq(max(Dorian[x, 4] - 250, 10), (length(MinProductionList) - 
        1) * 10 + max(Dorian[x, 4] - 250, 10), by = 10)
    SensDat.melt <- melt(data = SensDat, id.vars = c("MinProduction", "Profit"), 
        measure.vars = c("Small Car", "Medium Car", "Large Car", "Medium Van", 
            "Large Van"))
    prod.plot <- ggplot(SensDat.melt, aes(x = MinProduction, y = value, color = variable)) + 
        geom_line(lwd = 1.2) + geom_vline(xintercept = Dorian[x, 4], color = "blue", 
        lwd = 2, alpha = 0.2) + labs(x = "", y = "Production Schedule", color = "Model", 
        title = paste("Sensitivity Analysis of", Dorian[x, 1], "Minimum Production Requirement")) + 
        theme(legend.position = "bottom")

    prof.plot <- ggplot(SensDat, aes(x = MinProduction, y = Profit/1e+05)) + 
        geom_line(color = "red", lwd = 2) + geom_vline(xintercept = Dorian[x, 
        4], color = "blue", lwd = 2, alpha = 0.2) + labs(x = "Minimum Production Requirement", 
        y = "Profit ($100,000's)") + theme(legend.position = "bottom")

    multiplot(prod.plot, prof.plot)
}

##### Profit Sensitivity Analysis #####
ModProfitSensitivity <- function(x) {
    library(reshape2)
    library(ggplot2)
    ModProfitList <- replicate(n = 26 + min(25, (Dorian[x, 5]/25) - 25), Dorian, 
        simplify = F)
    ModProfitList[[1]][x, 5] <- max(Dorian[x, 5] - 625, 25)
    for (i in 2:length(ModProfitList)) {
        ModProfitList[[i]][x, 5] <- ModProfitList[[i - 1]][x, 5] + 25
    }
    ModProfitSens <- sapply(ModProfitList, DorianAutoFunction, Constraints = Materials)
    SensDat <- data.frame(t(rbind(sapply(ModProfitSens[2, ], unlist)[1:5, ], 
        unlist(ModProfitSens[1, ]))))
    names(SensDat) <- c(Dorian[, 1], "Profit")
    SensDat$ModProfit <- seq(max(Dorian[x, 5] - 625, 25), (length(ModProfitList) - 
        1) * 25 + max(Dorian[x, 5] - 625, 25), by = 25)
    SensDat.melt <- melt(data = SensDat, id.vars = c("ModProfit", "Profit"), 
        measure.vars = c("Small Car", "Medium Car", "Large Car", "Medium Van", 
            "Large Van"))
    prod.plot <- ggplot(SensDat.melt, aes(x = ModProfit, y = value, color = variable)) + 
        geom_line(lwd = 1.2) + geom_vline(xintercept = Dorian[x, 5], color = "blue", 
        lwd = 2, alpha = 0.2) + labs(x = "", y = "Production Schedule", color = "Model", 
        title = paste("Sensitivity Analysis of", Dorian[x, 1], "Profit per Unit Requirement")) + 
        theme(legend.position = "bottom")

    prof.plot <- ggplot(SensDat, aes(x = ModProfit, y = Profit/1e+05)) + geom_line(color = "red", 
        lwd = 2) + geom_vline(xintercept = Dorian[x, 5], color = "blue", lwd = 2, 
        alpha = 0.2) + labs(x = "Profit/Unit Sold", y = "Profit ($100,000's)") + 
        theme(legend.position = "bottom")

    multiplot(prod.plot, prof.plot)
}

##### Steel Available Sensitivity Analysis #####
SteelAvailSensitivity <- function(x) {
    library(reshape2)
    library(ggplot2)
    SteelAvailList <- replicate(n = 26 + min(25, (Materials[1, 1]/25) - 25), 
        Materials, simplify = F)
    SteelAvailList[[1]][1, 1] <- max(Materials[1, 1] - 625, 25)
    for (i in 2:length(SteelAvailList)) {
        SteelAvailList[[i]][1, 1] <- SteelAvailList[[i - 1]][1, 1] + 25
    }
    SteelAvailSens <- sapply(SteelAvailList, DorianAutoFunction, Inputs = Dorian)
    SensDat <- data.frame(t(rbind(sapply(SteelAvailSens[2, ], unlist)[1:5, ], 
        unlist(SteelAvailSens[1, ]))))
    names(SensDat) <- c(Dorian[, 1], "Profit")
    SensDat$SteelAvail <- seq(max(Materials[1, 1] - 625, 25), (length(SteelAvailList) - 
        1) * 25 + max(Materials[1, 1] - 625, 25), by = 25)
    SensDat.melt <- melt(data = SensDat, id.vars = c("SteelAvail", "Profit"), 
        measure.vars = c("Small Car", "Medium Car", "Large Car", "Medium Van", 
            "Large Van"))
    prod.plot <- ggplot(SensDat.melt, aes(x = SteelAvail, y = value, color = variable)) + 
        geom_line(lwd = 1.2) + geom_vline(xintercept = Materials[1, 1], color = "blue", 
        lwd = 2, alpha = 0.2) + labs(x = "", y = "Production Schedule", color = "Model", 
        title = "Sensitivity Analysis of Steel Available") + theme(legend.position = "bottom")

    prof.plot <- ggplot(SensDat, aes(x = SteelAvail, y = Profit/1e+05)) + geom_line(color = "red", 
        lwd = 2) + geom_vline(xintercept = Materials[1, 1], color = "blue", 
        lwd = 2, alpha = 0.2) + labs(x = "Steel Available", y = "Profit ($100,000's)") + 
        theme(legend.position = "bottom")

    multiplot(prod.plot, prof.plot)
}

##### Labor Available Sensitivity Analysis #####
LabAvailSensitivity <- function(x) {
    library(reshape2)
    library(ggplot2)
    LaborAvailList <- replicate(n = 26 + min(25, (Materials[1, 2]/250) - 25), 
        Materials, simplify = F)
    LaborAvailList[[1]][1, 2] <- max(Materials[1, 2] - 6250, 250)
    for (i in 2:length(LaborAvailList)) {
        LaborAvailList[[i]][1, 2] <- LaborAvailList[[i - 1]][1, 2] + 250
    }
    LaborAvailSens <- sapply(LaborAvailList, DorianAutoFunction, Inputs = Dorian)
    SensDat <- data.frame(t(rbind(sapply(LaborAvailSens[2, ], unlist)[1:5, ], 
        unlist(LaborAvailSens[1, ]))))
    names(SensDat) <- c(Dorian[, 1], "Profit")
    SensDat$LaborAvail <- seq(max(Materials[1, 2] - 6250, 250), (length(LaborAvailList) - 
        1) * 250 + max(Materials[1, 2] - 6250, 250), by = 250)
    SensDat.melt <- melt(data = SensDat, id.vars = c("LaborAvail", "Profit"), 
        measure.vars = c("Small Car", "Medium Car", "Large Car", "Medium Van", 
            "Large Van"))
    prod.plot <- ggplot(SensDat.melt, aes(x = LaborAvail, y = value, color = variable)) + 
        geom_line(lwd = 1.2) + geom_vline(xintercept = Materials[1, 2], color = "blue", 
        lwd = 2, alpha = 0.2) + labs(x = "", y = "Production Schedule", color = "Model", 
        title = "Sensitivity Analysis of Labor Available") + theme(legend.position = "bottom")

    prof.plot <- ggplot(SensDat, aes(x = LaborAvail, y = Profit/1e+05)) + geom_line(color = "red", 
        lwd = 2) + geom_vline(xintercept = Materials[1, 2], color = "blue", 
        lwd = 2, alpha = 0.2) + labs(x = "Labor Available", y = "Profit ($100,000's)") + 
        theme(legend.position = "bottom")

    multiplot(prod.plot, prof.plot)
}
Note that each of these functions requires an input variable x. This corresponds to the row number of the Dorian data frame that we are interested in exploring. The column we are interested in is given by the function we call. Lets try using one of these to see how it works:
SteelSensitivity(1)
plot of chunk unnamed-chunk-9
This breaks down what would happen if we manipulated the 1st value in the Steel Required column of the Dorian data frame (the steel required to produce a small car). The first thing to notice is that in the bottom figure, profit is decreasing from left to right. This makes sense. As the required materials increase, profit should go down. Notice that eventually profit stops decreasing. This is at the point when it is no longer most profitable to produce Small Cars, at which point it doesn't matter what we do to the steel requirement because we're no longer producing any Small Cars. In the top plot you can see how the optimal production schedule changes in response to the steel required to produce a Small car. The pale blue line in the background represents the value that is currently set in the Dorian data frame. This function does not just produce the same figures each time it's called, it recalculates each time and produces a plot that goes 25 increments above the set value and 25 increments below (or to one increment above zero, whichever comes first). I chose the increments to be proportional to the values given in the problem, so a steel increment is 0.1 tons of steel, a Labor increment is 1 hour of labor, a minimum production requirement increment is 10 units, a profit increment is $25, an increment for steel available is 25 tons, and an increment for labor available is 250 hours. Now for the really fun part, lets put this all into an easy to use GUI so that anyone can play with it and explore the problem.

The GUI Portion

One of my professors reccomended me a book on GUI building in R by Lawrence and Verzani and it proved to be extremely helpful. Programming Graphical User Interfaces in R
This book covers using 3 packages to build GUIs and I stuck with the simplest one: gWidgets. This package is designed around ease of use an because I don't have a strong background in programming I thought it would be for the best if I started out simple. gWidgets actually uses two GUI “toolboxes”, GTK and TCL/TK. I stuck with GTK for my GUI because I had heard of it before and had done some reading about it.
First I load the package and specify which of the two GUI toolboxes I want to use.
library(gWidgets)
options(guiToolkit = "RGtk2")
Next I create a window in which my GUI will exist.
window <- gwindow("Dorian Auto", visible = T)
Then I create a tabbed notebook inside my window. I never ended up adding another tab, but it's nice to have the option.
notebook <- gnotebook(cont = window)
Then I add a “group”. This is just a partition of my notebook tab.
group1 <- ggroup(cont = notebook, label = "Input Model Constraints", horizontal = F)
Then I create a “glayout” in my “group”. A “glayout” is just a nice grid format for my GUI components that saves me the trouble of organizing them on the page. It fits all of the objects I put inside it into a grid and arranges them neatly. I can add and call elements of my “glayout” much like you would reference elements inside a matrix.
lyt <- glayout(cont = group1, horizontal = T)
Notice that I put my “glayout” inside my “group”. This leaves room in my notebook tab later for graphic output. Had I skipped the “group” container and just put my “glayout” inside my notebook tab, my graphic display would be confined to one element of my “glayout”, but I want the graphic display to be much bigger than anything else on the page. Next I add a series of labels to my “glayout”. You cannot interact with labels in a GUI.
lyt[1, 1] <- glabel(text = "Model Name")
lyt[1, 2] <- glabel(text = "Steel Required/Unit")
lyt[1, 4] <- glabel(text = "Labor Required/Unit")
lyt[1, 6] <- glabel(text = "Production Minimum")
lyt[1, 8] <- glabel(text = "Profit/Unit")
lyt[1, 10] <- glabel(text = "                 ")
lyt[1, 11] <- glabel(text = "Steel Available")
lyt[1, 13] <- glabel(text = "Labor Available")
Next I add a series of text boxes underneath the “Model Name” label.
# Model Names
lyt[2, 1] <- gedit(text = Dorian[1, 1], handler = function(h, ...) {
    Dorian[1, 1] <<- svalue(h$obj)
})
lyt[3, 1] <- gedit(text = Dorian[2, 1], handler = function(h, ...) {
    Dorian[2, 1] <<- svalue(h$obj)
})
lyt[4, 1] <- gedit(text = Dorian[3, 1], handler = function(h, ...) {
    Dorian[3, 1] <<- svalue(h$obj)
})
lyt[5, 1] <- gedit(text = Dorian[4, 1], handler = function(h, ...) {
    Dorian[4, 1] <<- svalue(h$obj)
})
lyt[6, 1] <- gedit(text = Dorian[5, 1], handler = function(h, ...) {
    Dorian[5, 1] <<- svalue(h$obj)
})
The text argument is what to display as the default value of the text box and the handler argument is some function that will be called whan the text box is interacted with in the GUI. My handler function essentially says “If the text in the text box is changed, change the corresponding value in the Dorian data frame”. Next I do basically the same thing for the Dorian$Steel values, but since these values should be numeric instead of character, I use a spin button to get these values from the user instead of a text box. I can add a fromto, and by argument to mandate how the value inside the spinbutton changes when the user clicks the up or down arrow. Alternatively the user can also manually enter a number into the spin button like they would enter text into a text box.
# Steel Required
lyt[2, 2] <- gspinbutton(from = 1, to = 15, by = 0.5, value = Dorian[1, 2], 
    digits = 0, handler = function(h, ...) {
        Dorian[1, 2] <<- svalue(h$obj)
    })
lyt[3, 2] <- gspinbutton(from = 1, to = 15, by = 0.5, value = Dorian[2, 2], 
    digits = 0, handler = function(h, ...) {
        Dorian[2, 2] <<- svalue(h$obj)
    })
lyt[4, 2] <- gspinbutton(from = 1, to = 15, by = 0.5, value = Dorian[3, 2], 
    digits = 0, handler = function(h, ...) {
        Dorian[3, 2] <<- svalue(h$obj)
    })
lyt[5, 2] <- gspinbutton(from = 1, to = 15, by = 0.5, value = Dorian[4, 2], 
    digits = 0, handler = function(h, ...) {
        Dorian[4, 2] <<- svalue(h$obj)
    })
lyt[6, 2] <- gspinbutton(from = 1, to = 15, by = 0.5, value = Dorian[5, 2], 
    digits = 0, handler = function(h, ...) {
        Dorian[5, 2] <<- svalue(h$obj)
    })
Next I'll add a button next to each spin button that will call up the sensitivity analysis of that particular constraint.
# Sensitivity analysis buttons for Steel
lyt[2, 3] <- SteelButton1 <- gbutton("?", handler = function(h, ...) {
    SteelSensitivity(1)
})
lyt[3, 3] <- SteelButton2 <- gbutton("?", handler = function(h, ...) {
    SteelSensitivity(2)
})
lyt[4, 3] <- SteelButton3 <- gbutton("?", handler = function(h, ...) {
    SteelSensitivity(3)
})
lyt[5, 3] <- SteelButton4 <- gbutton("?", handler = function(h, ...) {
    SteelSensitivity(4)
})
lyt[6, 3] <- SteelButton5 <- gbutton("?", handler = function(h, ...) {
    SteelSensitivity(5)
})
Next I add spin buttons and sensitivity analysis buttons for the other constraints.
# Labor Required
lyt[2, 4] <- gspinbutton(from = 10, to = 100, by = 5, value = Dorian[1, 3], 
    digits = 0, handler = function(h, ...) {
        Dorian[1, 3] <<- svalue(h$obj)
    })
lyt[3, 4] <- gspinbutton(from = 10, to = 100, by = 5, value = Dorian[2, 3], 
    digits = 0, handler = function(h, ...) {
        Dorian[2, 3] <<- svalue(h$obj)
    })
lyt[4, 4] <- gspinbutton(from = 10, to = 100, by = 5, value = Dorian[3, 3], 
    digits = 0, handler = function(h, ...) {
        Dorian[3, 3] <<- svalue(h$obj)
    })
lyt[5, 4] <- gspinbutton(from = 10, to = 100, by = 5, value = Dorian[4, 3], 
    digits = 0, handler = function(h, ...) {
        Dorian[4, 3] <<- svalue(h$obj)
    })
lyt[6, 4] <- gspinbutton(from = 10, to = 100, by = 5, value = Dorian[5, 3], 
    digits = 0, handler = function(h, ...) {
        Dorian[5, 3] <<- svalue(h$obj)
    })

# Sensitivity analysis buttons for Labor
lyt[2, 5] <- LaborButton1 <- gbutton("?", handler = function(h, ...) {
    LaborSensitivity(1)
})
lyt[3, 5] <- LaborButton2 <- gbutton("?", handler = function(h, ...) {
    LaborSensitivity(2)
})
lyt[4, 5] <- LaborButton3 <- gbutton("?", handler = function(h, ...) {
    LaborSensitivity(3)
})
lyt[5, 5] <- LaborButton4 <- gbutton("?", handler = function(h, ...) {
    LaborSensitivity(4)
})
lyt[6, 5] <- LaborButton5 <- gbutton("?", handler = function(h, ...) {
    LaborSensitivity(5)
})

# Minimum Production Quantity
lyt[2, 6] <- gspinbutton(from = 100, to = 2000, by = 50, value = Dorian[1, 4], 
    digits = 0, handler = function(h, ...) {
        Dorian[1, 4] <<- svalue(h$obj)
    })
lyt[3, 6] <- gspinbutton(from = 100, to = 2000, by = 50, value = Dorian[2, 4], 
    digits = 0, handler = function(h, ...) {
        Dorian[2, 4] <<- svalue(h$obj)
    })
lyt[4, 6] <- gspinbutton(from = 100, to = 2000, by = 50, value = Dorian[3, 4], 
    digits = 0, handler = function(h, ...) {
        Dorian[3, 4] <<- svalue(h$obj)
    })
lyt[5, 6] <- gspinbutton(from = 100, to = 2000, by = 50, value = Dorian[4, 4], 
    digits = 0, handler = function(h, ...) {
        Dorian[4, 4] <<- svalue(h$obj)
    })
lyt[6, 6] <- gspinbutton(from = 100, to = 2000, by = 50, value = Dorian[5, 4], 
    digits = 0, handler = function(h, ...) {
        Dorian[5, 4] <<- svalue(h$obj)
    })

# Sensitivity analysis buttons for MinProduction
lyt[2, 7] <- MinProductionButton1 <- gbutton("?", handler = function(h, ...) {
    MinProductionSensitivity(1)
})
lyt[3, 7] <- MinProductionButton2 <- gbutton("?", handler = function(h, ...) {
    MinProductionSensitivity(2)
})
lyt[4, 7] <- MinProductionButton3 <- gbutton("?", handler = function(h, ...) {
    MinProductionSensitivity(3)
})
lyt[5, 7] <- MinProductionButton4 <- gbutton("?", handler = function(h, ...) {
    MinProductionSensitivity(4)
})
lyt[6, 7] <- MinProductionButton5 <- gbutton("?", handler = function(h, ...) {
    MinProductionSensitivity(5)
})

# Profit per unit
lyt[2, 8] <- gspinbutton(from = 1000, to = 10000, by = 100, value = Dorian[1, 
    5], digits = 0, handler = function(h, ...) {
    Dorian[1, 5] <<- svalue(h$obj)
})
lyt[3, 8] <- gspinbutton(from = 1000, to = 10000, by = 100, value = Dorian[2, 
    5], digits = 0, handler = function(h, ...) {
    Dorian[2, 5] <<- svalue(h$obj)
})
lyt[4, 8] <- gspinbutton(from = 1000, to = 10000, by = 100, value = Dorian[3, 
    5], digits = 0, handler = function(h, ...) {
    Dorian[3, 5] <<- svalue(h$obj)
})
lyt[5, 8] <- gspinbutton(from = 1000, to = 10000, by = 100, value = Dorian[4, 
    5], digits = 0, handler = function(h, ...) {
    Dorian[4, 5] <<- svalue(h$obj)
})
lyt[6, 8] <- gspinbutton(from = 1000, to = 10000, by = 100, value = Dorian[5, 
    5], digits = 0, handler = function(h, ...) {
    Dorian[5, 5] <<- svalue(h$obj)
})

# Sensitivity analysis buttons for Profit/Unit
lyt[2, 9] <- ModProfitButton1 <- gbutton("?", handler = function(h, ...) {
    ModProfitSensitivity(1)
})
lyt[3, 9] <- ModProfitButton2 <- gbutton("?", handler = function(h, ...) {
    ModProfitSensitivity(2)
})
lyt[4, 9] <- ModProfitButton3 <- gbutton("?", handler = function(h, ...) {
    ModProfitSensitivity(3)
})
lyt[5, 9] <- ModProfitButton4 <- gbutton("?", handler = function(h, ...) {
    ModProfitSensitivity(4)
})
lyt[6, 9] <- ModProfitButton5 <- gbutton("?", handler = function(h, ...) {
    ModProfitSensitivity(5)
})

## Resource Input
lyt[2, 11] <- gspinbutton(from = 1000, to = 10000, by = 25, value = Materials[1, 
    1], digits = 0, handler = function(h, ...) {
    Materials[1, 1] <<- svalue(h$obj)
})
lyt[2, 13] <- gspinbutton(from = 10000, to = 1e+05, by = 250, value = Materials[1, 
    2], digits = 0, handler = function(h, ...) {
    Materials[1, 2] <<- svalue(h$obj)
})
## Sensitivity Analysis
lyt[2, 12] <- ModProfitButton5 <- gbutton("?", handler = function(h, ...) {
    SteelAvailSensitivity(5)
})
lyt[2, 14] <- ModProfitButton5 <- gbutton("?", handler = function(h, ...) {
    LabAvailSensitivity(5)
})
Finally I add a button at the bottom that solves the problem with the current version of the Dorian data frame.
# Optimize button
lyt[7, 1] <- calcbutton <- gbutton("Optimize")
addHandlerClicked(calcbutton, handler = CalcFunction(Dorian, Materials))
Can't forget to add the graphics display!
# Graphics Device
group3 <- ggroup(cont = group1, horizontal = F, label = "Optimal Production Schedule Dashboard")
graphicspane1 <- ggraphics(cont = group3, width = 1000, height = 450)
Done! Try running the code and using it. It's really satisfying clicking a button and watching a new display pop up!

UPDATE: Here are a couple screen shots of the GUI in use.
What you get when you click the "Optimize" button. A graphical presentation of the solution and your Total Profit.

A sensitivity analysis, achieved by clicking the "?" button next to the constraint you are interested in Essentially answers the question "If I held all other things constant and changed this one parameter, what would the effect be?"

Update:
I mentioned towards the beginning of the post that this was a peer graded presentation. I got the results back and there was lots of good feedback. I "won" over the other two students presenting on the same problem with 61% of students choosing me. Thanks guys! Here's a breakdown of the class's response:

Who would you recommend?

Answer Response %
1 First consultant 7 21%
2 Second consultant (me) 21 62%
3 Third consultant 6 18%
Total 34 100%
 Presentation Quality


Poor Fair Good Impressive Responses
1 First consultant 0 3 20 14 37
2 Second consultant (me) 1 0 13 23 37
3 Third consultant 0 1 24 9 34
  Model and support


Poor Fair Good Impressive Responses
1 First consultant 0 2 22 13 37
2 Second consultant (me) 1 1 9 26 37
3 Third consultant 0 3 25 6 34


Cheers everyone!

1

View comments

Purpose

The caret package includes a function for data splitting, createTimeSlices(), that creates data partitions using a fixed or growing window. The main arguments to this function, initialWindow and horizon, allow the user to create training/validation resamples consisting of contiguous observations with the validation set always consisting of n = horizon rows. If fixedWindow = TRUE, the training set always has n =initialWindow rows.

Understanding data.table Rolling Joins

Robert Norberg

June 5, 2016

Introduction

Rolling joins in data.table are incredibly useful, but not that well documented. I wrote this to help myself figure out how to use them and perhaps it can help you too.

library(data.table)

The Setup

Imagine we have an eCommerce website that uses a third party (like PayPal) to handle payments.
2

A Custom caret C5.0 Model for 2-Class Classification Problems with Class Imbalance

Robert Norberg

Monday, April 06, 2015

Introduction

In this post I share a custom model tuning procedure for optimizing the probability threshold for class imbalanced data. This is done within the excellent caret package framework and is akin to the example on the package website, but the example shows an extension of therandom forest (or rf) method while I present an extension to the C5.0 method.
3

Getting Data From One Online Source

Robert Norberg

Hello world. It’s been a long time since I posted anything here on my blog. I’ve been busy getting my Masters degree in statistical computing and I haven’t had much free time to blog. But I’ve writing R code as much as ever. Now, with graduation approaching, I’m job hunting and I thought it would be good to put together a few things to show potential employers.
2

Generating Tables Using Pander, knitr, and Rmarkdown

I use a pretty common workflow (I think) for producing reports on a day to day basis. I write them in rmarkdown using RStudio, knit them into .html and .md documents using knitr, then convert the resulting .md file to a .docx file using pander, which is really just a way of communicating with Pandoc via my R terminal.
2

R vs. Perl/mySQL - an applied genomics showdown

Recently I was given an assignment for a class I'm taking that got me thinking about speed in R. This isn't something I'm usually concerned with, but the first time I tried to run my solution (ussing plyr's ddply() it was going to take all night to compute.

Stop Sign Sampling Project

Post 1: Planning Phase

Welcome back to the blog y'all. It's been a while since my last post and I've got some fun stuff for you. I'm currently enrooled in a survey sampling methodology class and we've been given a semester-long project, which I will of course be doing entirely in R. My group's assignment is to estimate the proportion of cars that actually stop at a stop sign in Chapel Hill.
1

A while ago I was asked to give a presentation at my job about using R to create statistical graphics. I had also just read some reviews of the Slidify package in R and I thought it would be extremely appropriate to create my presentation about visualization in R, in R. So I set about breaking in the Slidify package and I've got to give a huge shout out to Ramnath Vaidyanathan who created this package.

In class today we were discussing several types of survey sampling and we split into groups and did a little investigation. We were given a page of 100 rectangles with varying areas and took 3 samples of size 10. Our first was a convenience sample. We just picked a group of 10 rectangles adjacent to each other and counted their area. Next, we took a simple random sample (SRS), numbering the rectangles 1 through 100 and choosing 10 with a random number generator.

For a class I'm taking this semester on genomics we're dealing with some pretty large data and for this reason we're learning to use mySQL. I decided to be a geek and do the assignments in R as well to demonstrate the ability of R to handle pretty large data sets quickly.
My Blog List
My Blog List
About Me
About Me
Loading
Dynamic Views theme. Powered by Blogger. Report Abuse.