Creating a Button-driven Application

Allen C. Hibbard

A Typical Linear Programming Problem

A furniture manufacturer makes two types of furniture—chairs and sofas. For simplicity, divide the production process into three distinct operations—carpentry, finishing, and upholstery. The amount of labor required for each operation varies. Manufacture of a chair requires 6 hours of carpentry, 1 hour of finishing, and 2 hours of upholstery. Manufacture of a sofa requires 3 hours of carpentry, 1 hour of finishing, and 6 hours of upholstery. Due to limited availability of skilled labor as well as tools and equipment, the factory has available each day 96 labor-hours for carpentry, 18 labor-hours for finishing, and 72 labor-hours for upholstery. The profit per chair is $80 and the profit per sofa $70. How many chairs and how many sofas should be produced each day to maximize the profit? (This comes from chapter 3 of Finite Mathematics & Its Applications by Goldstein, Schneider, and Siegel, Prentice Hall, 1998.)

({{ , Chair, Sofa, Available time}, {Carpentry, 6 hours, 3 hours, 96 labor - hours}, {Finishing, 1 hour, 1 hour, 18 labor - hours}, {Upholstery, 2 hours, 6 hours, 72 labor - hours}, {Profit, $80, $70,  }})

x = the number of chairs to make                  y = the number of sofas to make

Maximize 80  x + 70  y subject to

6  x + 3  y ≤ 96
x + y ≤ 18
2  x + 6  y ≤ 72
x ≥ 0,  
    y ≥ 0.

6  x + 3  y + u = 96
x + y + v = 18
2  x + 6  y + w = 72

(({{x, y, u, v, w, M,  }, {6, 3, 1, 0, 0, 0, 96}, {1, 1, 0, 1, 0, 0, 18}, {2, 6, 0, 0, 1, 0, 72}, {-80, -70, 0, 0, 0, 1, 0}}))

Using the Pivot Package

The Pivot package can be used to solve this problem. (You need to have the Pivot package installed for the last link to work. It can be obtained from my web page. Install according to directions in downloaded notebook.) We need 4 rows and 7 columns. (If you do not have the Pivot package, use the PivotDownload notebook and follow the instructions there for placement and subsequent steps.).

The Programming Details

The Startup Notebook

({{Elementary row operations and pivoting}, {Simplex method for linear programming}})

Cell[BoxData[GridBox[{
        {
          ButtonBox[
            RowBox[{
            "Elementary", " ", "row", " ", "operations", 
              " ", "and", " ", "pivoting"}],
            ButtonFunction:>MakeLAStartupNotebook,
            ButtonEvaluator->Automatic,
            Background->RGBColor[1, 1, 0]]},
        {
          ButtonBox[
            RowBox[{
            "Simplex", " ", "method", " ", "for", " ", 
              "linear", " ", "programming"}],
            ButtonFunction:>MakeSimplexStartupNotebook,
            ButtonEvaluator->Automatic,
            Background->RGBColor[0, 1, 1]]}
        }]], "Input",
  Active->True,
  GeneratedCell->True,
  CellTags->"Pivot"]

MakeSimplexStartupNotebook:=Module[{nb},
		nb=NotebookCreate[];
		NotebookWrite[nb, 
              Cell[TextData["Enter in the number of rows and columns that \
your simplex tableau requires. Then click on the “Set \
up tableau” button. (This assumes that you are \
entering your objective function as the last row and that it is to be \
maximized. Also, constants are placed in the last column and the original \
problem is to be given in terms of inequalities of the form \
“linear_expression ≤ constant\
”.)"], "Text", FontSize -> 14]];NotebookWrite[nb,Cell[BoxData[
                      GridBox[{{ButtonBox[
                              RowBox[{"Number", " ", "of", " \
", "Rows"}], Background -> RGBColor[0, 1, 1]], 
                            ButtonBox[
                              RowBox[{"Number", " ", "of", " \
", "Columns"}], Background -> 
                                RGBColor[0, 1, 1]]}, {"3", "4"}}, 
                        ColumnLines -> {True, False}]],"Input",CellTags->"rowcol"]];
		NotebookWrite[nb,Cell[BoxData[ButtonBox[RowBox[{"Set", " ", "up", " \
", "tableau"}],ButtonFunction:>MakeGrid,ButtonEvaluator->Automatic]],"Input",Active->True,CellTags->"setup"]]]

Enter in the number of rows and columns that your simplex tableau requires. Then click on the “Set up tableau” button. (This assumes that you are entering your objective function as the last row and that it is to be maximized. Also, constants are placed in the last column and the original problem is to be given in terms of inequalities of the form “linear_expression ≤ constant”.)

({{Number of Rows, Number of Columns}, {4, 7}})

Set up tableau

MakeGrid := Module[{nb,  rows,  cols},
	nb = InputNotebook[]; {rows,  cols} = ToExpression[ReadTaggedCell[nb, "rowcol"]][[2]];
	NotebookFind[nb,  "setup",  
              All,  CellTags,  AutoScroll  ->  False];
	SelectionMove[nb,  After,  Cell,  
              AutoScroll  ->  False];
	\(NotebookWrite[nb, \ 
              Cell[BoxData[
\ \ \ \ RowBox[{"(", \ 
                      GridBox[
                        Table["\[Placeholder]", \ {rows}, \ {cols}]], \ ")"}]], \ 
\ \ \ \ \ \ \ \ "Input", \ 
                CellTags\  -> \ "matrix"]]\);
	\(NotebookWrite[
              nb, \ 
\ \ \ \ \ \ Cell["Fill in the tableau above and then press the button below. (Click in the first square, enter in your value, and then tab to the next square.)", \ "Text", 
\ \ FontSize\  -> \ 14, \ 
                CellTags\  -> \ "instructions"]]\);
		NotebookWrite[nb, Cell[BoxData[
    ButtonBox[
      \(RowBox[{"Click", \ " ", \ "when", \ " ", \ "done"}]\),
      ButtonFunction :> MakeTableau,
      ButtonEvaluator  ->  Automatic]], "Input",
  Active  ->  True,
  CellTags  ->  "maketab"]];
	]

(({{\[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder]}, {\[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder]}, {\[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder]}, {\[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder], \[Placeholder]}}))

Fill in the tableau above and then press the button below. (Click in the first square, enter in your value, and then tab to the next square.)

Click when done

ReadTaggedCell[nb_,  tag_] := (NotebookFind[nb,  tag,  All,  CellTags,  
            AutoScroll  ->  False];
			SelectionMove[nb, All, CellContents, AutoScroll  ->  False];
		NotebookRead[nb])

Setting up the Tableau in its Notebook

MakeTableau:=Module[{nb, m, r, c},nb = InputNotebook[];m=ReadMatrix[nb, "matrix"];TableauIndex=0;Clear[TableauProblem];TableauProblem[TableauIndex] = m;{r, c} = Dimensions[m];
nb = NotebookCreate[];TableauCell[nb, m, {r, c}];NotebookWrite[nb,Cell["Clicking on the Help button below gives a summary of the buttons in the grid at the bottom.","\!\(\*
StyleBox[\"Message\",\nFontColor->RGBColor[1, 0, 1]]\)"]];NotebookWrite[nb, 
              Cell["You can click on a tableau entry to do a pivot, or \
click on a bottom row button (R) to inspect ratios.", "Text", 
                FontSize -> 14, CellTags -> "instructions"]];NotebookWrite[nb,Cell[" ","Output",CellTags->"ratios"]];WriteButtons[nb];]

(({{6, 3, 1, 0, 0, 0, 96}, {1, 1, 0, 1, 0, 0, 18}, {2, 6, 0, 0, 1, 0, 72}, {-80, -70, 0, 0, 0, 1, 0}, {R, R, R, R, R, R,  }}))

You can click on a tableau entry to do a pivot, or click on a bottom row button (R) to inspect ratios.

({{Original, Previous, Next}, {N, Expand, Simplify}, {Extract, Solution, Help}})

ReadMatrix[nb_,  tag_] := ReadTaggedCell[nb,  tag]  //  ToExpression

TableauCell[nb_,  m_,  {r_,  c_}] := 
  Module[{ row,  col},  
    NotebookWrite[nb, 
      Cell[BoxData[
          RowBox[{"(", 
              GridBox[Join[Transpose[Join[Transpose[
                  Table[ButtonBox[ToBoxes[m[[row,  col]]], 
                      ButtonEvaluator  ->  Automatic, 
                      ButtonFunction :> (MakePivot[#] &), 
                      ButtonData -> {{row,  col},  {r,  c},  
                                        m}], \({row, \ 
                                        1, \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ r - 1}\), {col,  1,  c - 1}]], {Drop[Transpose[
                                        m][[c]], -1]} // 
                                        Map[ToBoxes, #, {2}] &]], {m[[r]]} // 
                                    Map[ToBoxes, #, {2}] &,{Join[Table[
                      ButtonBox["R", Background -> RGBColor[1,  1,  0], 
                        ButtonEvaluator  ->  Automatic, 
                        ButtonFunction :> (DoRatios[#] &), 
                        ButtonData -> {col,  {r,  c},  m}], {col,  1,  c - 1}],{" "}]}],
      RowSpacings -> Join[
                                  Table[0,  {r  -  2}],  {1,  2}], 
                RowLines -> Join[
                                  Table[False,  {r  -  2}],  {True}],
								ColumnLines  ->  
                                Join[Table[False,  {c  -  2}],  {True}],
      ColumnSpacings  ->  
                                Join[Table[0,  {c  -  2}],  {1}]], ")"}]], "Input", 
        Active  ->  True, CellTags  ->  "tableau"]]]

MakePivot[{{row_,  col_},  {r_,  c_},  m_List}] := 
  Module[{nb,  m2,  b,  rr,  cc},
		m2 = Pivot[m,  row,  col];
		nb  =  InputNotebook[];
    TableauIndex ++;
    TableauProblem[TableauIndex]  =  m2;
    WriteTableau[nb,  
              m2,  "tableau",  {r,  c}];
		NotebookFind[nb, "tableau", All, CellTags, 
              AutoScroll -> False];
			SelectionMove[nb,  After,  Cell,  
              AutoScroll  ->  False];
		If[NonZeroFlag === True, 
              NotebookWrite[InputNotebook[], 
                Cell["Choose a non-zero entry.",  "Message"]]];
		NonZeroFlag = False;
		NotebookWrite[nb, 
              Cell["This is matrix number " <> 
                  ToString[TableauIndex] <> ".", "Message"]];
		NotebookWrite[nb, 
              Cell["You pivoted (or attempted to pivot) in position (" <> 
                  ToString[row] <> ", " <> 
                  ToString[
                    col] <> "). Click on the 'Original' button to restore \
the matrix to its original condition; click on 'Previous' to undo the last \
action (each click takes you one step back); click on 'Next' (if you have \
already clicked 'Previous') to take you one step forward. (It is OK to click \
'Next' as many times as you have clicked 'Previous'.)",  "Message"]];
	]

Pivot[m_List,  row_,  col_] := 
  \(Module[{temp, \ entry, \ rows\  = \ First[Dimensions[m]], \ 
          remaining, \ k, \ j}, 
\ \ \ \ remaining\  = \ 
          DeleteCases[Table[k, \ {k, \ 1, \ rows}], \ 
            row]; 
\ \ \ \ entry\  = \ m[\([row, \ col]\)]; 
\ \ \ \ If[
          entry\  =!= \ 0, 
\ \ \ \ \ \ temp\  = \ 
            ER1[m, \ row, \ 1/entry]; 
\ \ \ \ \ \ Do[
            temp\  = \ 
              ER3[temp, \ 
                j\  = \ remaining[\([k]\)], \ \(-m[\([j, \ col]\)]\), \ 
                row], \ {k, \ 
              1, \ 
\ \ \ \ \ \ \ \ \ \ Length[
                remaining]}]; 
\ \ \ \ \ \ temp\  // \ Expand, \ 
          NonZeroFlag = True; \ m]]\)

WriteTableau[nb_,  m_,  
        tag_,  {r_,  c_}] := 
  Module[{ rr,  cc}, 
    NotebookFind[nb,  "tableau",  All,  CellTags,  
              AutoScroll  ->  False];
	SelectionMove[nb,  All,  Cell,  
              AutoScroll  ->  False];
		NotebookDelete[nb]; 
    TableauCell[nb,  m,  {r,  c}];
    NotebookFind[nb,  "Message",  All,  CellStyle];
    NotebookDelete[nb];]

DoRatios[{col_,  {r_,  c_},  m_List}] := Module[{nb,  rat},
		nb  =  InputNotebook[];
		NotebookFind[nb,  "ratios",  
              All,  CellTags,  AutoScroll  ->  False];
	SelectionMove[nb,  All,  Cell,  
              AutoScroll  ->  False];
		DeleteNotebook[nb];
		NotebookWrite[nb, 
      Cell[ToBoxes[Ratios[m,  col], TraditionalForm], "Output", 
        CellTags  ->  "ratios"]]]

The Palette in the Tableau Notebook

WriteButtons[nb_] := 
  NotebookWrite[nb, 
    Cell[BoxData[
        GridBox[{{ButtonBox["Original", 
                ButtonEvaluator  ->  
                                  Automatic, ButtonFunction :> RestartPivot],ButtonBox["Previous", ButtonEvaluator  ->  Automatic, 
                ButtonFunction :> UndoPivot], 
              ButtonBox["Next", ButtonEvaluator  ->  Automatic, 
                ButtonFunction :> RedoPivot]}, {ButtonBox["N", 
                ButtonEvaluator  ->  
                                  Automatic, ButtonFunction :> NTableau],ButtonBox["Expand", 
                ButtonEvaluator  ->  
                                  Automatic, ButtonFunction :> ExpandTableau],ButtonBox["Simplify", 
                ButtonEvaluator  ->  
                                  Automatic, ButtonFunction :> SimplifyTableau]},{ButtonBox["Extract", ButtonEvaluator  ->  Automatic, 
                ButtonFunction :> JustTheMatrix],  ButtonBox["Solution", ButtonEvaluator  ->  Automatic, 
                ButtonFunction :> TableauSolution],
               ButtonBox["Help", ButtonEvaluator  ->  Automatic, 
                ButtonFunction :> PivotHelp]}}, RowSpacings  ->  0, 
          ColumnSpacings  ->  0]], "Input", Active  ->  True, 
      CellTags  ->  "buttons"]]

RestartPivot := \(Module[{r, \ c, \ m, nb}, 
		nb\  = \ 
          InputNotebook[]; 
\ \ \ \ TableauIndex\  = \ 0; 
\ \ \ \ m\  = \ 
          TableauProblem[TableauIndex]; 
\ \ \ \ {r, \ c}\  = \ 
          Dimensions[m]; 

        WriteTableau[nb, \ 
          m, \ "tableau", \ {r, \ c}]; 
		NotebookFind[
          nb, "tableau", All, CellTags, 
          AutoScroll -> False]; 
			SelectionMove[nb, \ After, \ Cell, \ 
          AutoScroll\  -> \ False]; 
			NotebookWrite[nb, 
          Cell["This is the original tableau (matrix).", "Message"]]]\)

NTableau:=Module[{nb, m, r, c}, nb = InputNotebook[];  
        m = TableauProblem[TableauIndex] // N;  {r, c} = Dimensions[m]; 
        WriteTableau[nb,  m, "tableau", {r, c}]]

JustTheMatrix:= 
  \(Module[{nb}, nb\  = \ InputNotebook[]; 
        NotebookFind[nb, "tableau", All, CellTags, AutoScroll -> False]; 
        SelectionMove[nb, \ After, \ Notebook, \ AutoScroll\  -> \ False]; 
        NotebookWrite[nb, 
          Cell[\ BoxData[
\ \ \ \ RowBox[{"(", \ 
                  GridBox[
                    Map[ToBoxes, 
                      TableauProblem[
                        TableauIndex], {2}]], \ ")"}]]\ , "Output"]];
	]\)

PivotHelp:=NotebookPut[Notebook[{Cell[TextData[{StyleBox["Button Help:\n\nOriginal",FontWeight->"Bold"],": This takes you back to the original problem.\n",StyleBox["Previous", 
                          FontWeight -> "Bold"],": Use this button as an Undo button that can take you back one step at a time until you get to the original tableau.\n",StyleBox["Next", 
                          FontWeight -> "Bold"],": Assuming that you have used the Previous button, this will take you forward as many steps as you have already pivoted.\n",StyleBox["N", FontWeight -> "Bold"],": This applies the N function to the tableau.\n",StyleBox["Expand", FontWeight -> "Bold"],": This applies the Expand function to the tableau.\n",StyleBox["Simplify", 
                          FontWeight -> "Bold"],": This applies the Simplify function to the tableau.\n",StyleBox["Extract", 
                          FontWeight -> "Bold"],": This extracts the ('unbuttoned') matrix from the tableau.\n",StyleBox["Solution", 
                          FontWeight -> "Bold"],": This gives a particular solution to the problem with the current tableau.\n",StyleBox["Help", 
                          FontWeight -> "Bold"],": You know what this button does.\n"}],"Text",TextAlignment->Center,LineSpacing->{1, 2},ParagraphSpacing->{0, 4}]},WindowSize->{425, Fit},WindowMargins->{{50, Automatic}, {50, Automatic}},WindowFrame->"Palette",WindowElements->{},WindowFrameElements->"CloseBox",Editable -> False,WindowClickSelect->True,ShowCellBracket->False]]