1-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
2-- All rights reserved.
3--
4-- Redistribution and use in source and binary forms, with or without
5-- modification, are permitted provided that the following conditions are
6-- met:
7--
8--     - Redistributions of source code must retain the above copyright
9--       notice, this list of conditions and the following disclaimer.
10--
11--     - Redistributions in binary form must reproduce the above copyright
12--       notice, this list of conditions and the following disclaimer in
13--       the documentation and/or other materials provided with the
14--       distribution.
15--
16--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
17--       names of its contributors may be used to endorse or promote products
18--       derived from this software without specific prior written permission.
19--
20-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
21-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
22-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
23-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
24-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
25-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
26-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
27-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
28-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
29-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
30-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
31
32)package "BOOT"
33
34-- Basic Command matrix entry
35
36bcMatrix() ==  bcReadMatrix nil
37
38bcReadMatrix exitFunctionOrNil ==
39  page := htInitPage('"Matrix Basic Command", nil)
40  htpSetProperty(page,'exitFunction,exitFunctionOrNil)
41  htMakePage
42   '((domainConditions
43     (isDomain PI (PositiveInteger)))
44    (text . "Enter the size of the matrix:")
45    (inputStrings
46     ("Number of {\em rows}:\space{3}" "" 5 2 rows PI)
47     ("Number of {\em columns}: " "" 5 2 cols PI))
48    (text . "\blankline ")
49    (text . "How would you like to enter the matrix?")
50    (text . "\beginmenu")
51    (text . "\item ")
52    (bcLinks ("\menuitemstyle{By entering individual entries}" "" bcInputExplicitMatrix  explicit))
53    (text . "\item ")
54    (bcLinks ("\menuitemstyle{By formula}" "" bcInputMatrixByFormula formula))
55    (text . "\endmenu"))
56  htShowPage()
57
58bcInputMatrixByFormula(htPage,junk) ==
59  page := htInitPage('"Basic Matrix Command", htpPropertyList htPage)
60  htMakePage '(
61    (domainConditions
62      (isDomain S (Symbol))
63      (isDomain FE (Expression (Integer))))
64    (text . "\menuitemstyle{}\tab{2}")
65    (text . "Enter the {\em row variable}: ")
66    (text . "\tab{36}")
67    (bcStrings (6 i rowVar S))
68    (text . "\blankline ")
69    (text . "\newline ")
70    (text . "\menuitemstyle{}\tab{2}")
71    (text . "Enter the {\em column variable}: ")
72    (text . "\tab{36}")
73    (bcStrings (6 j colVar S))
74    (text . "\blankline ")
75    (text . "\newline ")
76    (text . "\menuitemstyle{}\tab{2}")
77    (text .  "Enter the general {\em formula} for the entries:")
78    (text . "\newline\tab{2} ")
79    (bcStrings (40 "1/(x - i - j - 1)" formula FE)))
80  htMakeDoneButton('"Continue", 'bcInputMatrixByFormulaGen)
81  nrows :=
82    null $bcParseOnly => objValUnwrap htpLabelSpadValue(htPage,'rows)
83    PARSE_-INTEGER htpLabelInputString(htPage,'rows)
84  ncols :=
85    null $bcParseOnly => objValUnwrap htpLabelSpadValue(htPage,'cols)
86    PARSE_-INTEGER htpLabelInputString(htPage,'cols)
87  htpSetProperty(page, 'nrows, nrows)
88  htpSetProperty(page, 'ncols, ncols)
89  htShowPage()
90
91bcInputMatrixByFormulaGen htPage ==
92  fun :=  htpProperty(htPage,'exitFunction) => FUNCALL(fun, htPage)
93  formula := htpLabelInputString(htPage,'formula)
94  rowVar := htpLabelInputString(htPage,'rowVar)
95  colVar := htpLabelInputString(htPage,'colVar)
96  nrows := htpProperty(htPage,'nrows)
97  ncols := htpProperty(htPage,'ncols)
98  bcGen STRCONC('"matrix([[",formula,'" for ",colVar,'" in 1..",
99    STRINGIMAGE ncols,'"] for ",rowVar,'" in 1..",STRINGIMAGE nrows,'"])")
100
101bcInputExplicitMatrix(htPage,junk) ==
102  nrows :=
103    null $bcParseOnly => objValUnwrap htpLabelSpadValue(htPage,'rows)
104    PARSE_-INTEGER htpLabelInputString(htPage,'rows)
105  ncols :=
106    null $bcParseOnly => objValUnwrap htpLabelSpadValue(htPage,'cols)
107    PARSE_-INTEGER htpLabelInputString(htPage,'cols)
108  cond := nil
109  k := 0
110  wrows := # STRINGIMAGE nrows
111  wcols := # STRINGIMAGE ncols
112  labelList :=
113    "append"/[[f for j in 1..ncols] for i in 1..nrows] where f ==
114      rowpart := STRCONC('"{\em Row",htStringPad(i,wrows))
115      colpart := STRCONC('", Column",htStringPad(j,wcols),'":}\space{2}")
116      prefix := STRCONC(rowpart,colpart)
117 --     name := INTERN STRCONC(htMkName('"row",i),htMkName('"col",j))
118      name := INTERN STRINGIMAGE (k := k + 1)
119      [prefix,'"",30, 0,name,'P]
120  labelList :=
121    [['domainConditions, '(isDomain P (Polynomial $EmptyMode)), cond],
122     ['inputStrings, :labelList] ]
123  page := htInitPage('"Solve Basic Command", htpPropertyList htPage)
124  bcHt '"Enter the entries of the matrix:"
125  htMakePage labelList
126  htMakeDoneButton('"Continue", 'bcGenExplicitMatrix)
127  htpSetProperty(page,'nrows,nrows)
128  htpSetProperty(page,'ncols,ncols)
129  htShowPage()
130
131bcGenExplicitMatrix htPage ==
132  htpSetProperty(htPage,'matrix,htpInputAreaAlist htPage)
133  fun :=  htpProperty(htPage,'exitFunction) => FUNCALL(fun, htPage)
134  bcGen bcMatrixGen htPage
135
136bcMatrixGen htPage ==
137  nrows := htpProperty(htPage,'nrows)
138  ncols := htpProperty(htPage,'ncols)
139  mat := htpProperty(htPage,'matrix)
140  formula := LASSOC('formula,mat) =>
141    formula := formula.0
142    rowVar := (LASSOC('rowVar, mat)).0
143    colVar := (LASSOC('colVar, mat)).0
144    STRCONC('"matrix([[",formula,'" for ",colVar,'" in 1..",
145      STRINGIMAGE ncols,'"] for ",rowVar,'" in 1..",STRINGIMAGE nrows,'"])")
146  mat := htpProperty(htPage,'matrix) =>
147    mat := REVERSE mat
148    k := -1
149    matform := [[mat.(k := k + 1).1
150      for j in 0..(ncols-1)] for i in 0..(nrows-1)]
151    matstring := bcwords2liststring [bcwords2liststring x for x in matform]
152    STRCONC('"matrix(",matstring,'")")
153  systemError nil
154