My first R GUI
[This article was first published on bRogramming, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
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.Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
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 × 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)
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 from, to, 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!
To leave a comment for the author, please follow the link and comment on their blog: bRogramming.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.