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 -- HyperTeX basic Solve Command 35$systemType := nil 36$numberOfEquations := 0 37$solutionMethod := nil 38 39bcSolve() == 40 htInitPage('"Solve Basic Command", nil) 41 htMakePage '( 42 (text . "What do you want to solve? ") 43 (text . "\beginmenu") 44 (text . "\item ") 45 (bcLinks ("\menuitemstyle{A System Of Linear Equations}" "" bcLinearSolve linear)) 46 (text . "\item ") 47 (bcLinks ("\menuitemstyle{A System of Polynomial Equations}" "" bcSystemSolve polynomial)) 48 (text . "\item ") 49 (bcLinks ("\menuitemstyle{A Single Polynomial Equation}" "" bcSolveSingle onePolynomial)) 50 (text . "\endmenu")) 51 htShowPage() 52 53bcLinearSolve(p,nn) == 54 htInitPage('"Basic Solve Command", nil) 55 htMakePage '( 56 (text . "How do you want to enter the equations?") 57 (text . "\beginmenu") 58 (text . "\item ") 59 (text . "\newline ") 60 (bcLinks ("\menuitemstyle{Directly as equations}" "" bcLinearSolveEqns equations)) 61 (text . "\item ") 62 (text . "\newline ") 63 (bcLinks ("\menuitemstyle{In matrix form}" "" bcLinearSolveMatrix matrix)) 64 (text . "\indentrel{16}\tab{0}") 65 (text . " \spad{AX = B}, where \spad{A} is a matrix of coefficients and \spad{B} is a vector" ) 66 (text . "\indentrel{-16}\item ") 67 (text . "\endmenu")) 68 htShowPage() 69 70bcLinearSolveEqns(htPage, p) == 71 htInitPage('"Basic Solve Command", nil) 72 htMakePage '( 73 (domainConditions (isDomain PI (PositiveInteger))) 74 (inputStrings 75 ("Enter the {\em number} of equations:" "" 5 2 numberOfEquations PI))) 76 htMakeDoneButton('"Continue", 'bcLinearSolveEqns1) 77 htShowPage() 78 79bcSystemSolve(htPage, p) == 80 htInitPage('"Basic Solve Command", nil) 81 htMakePage '( 82 (domainConditions (isDomain PI (PositiveInteger))) 83 (inputStrings 84 ("Enter the {\em number} of equations:" "" 5 2 numberOfEquations PI))) 85 htMakeDoneButton('"Continue", 'bcSystemSolveEqns1) 86 htShowPage() 87 88bcSolveSingle(htPage,p) == 89 htpSetProperty(htPage,'systemType, 'onePolynomial) 90 htpSetProperty(htPage,'exitFunction,'bcInputSolveInfo) 91 bcInputEquations(htPage,'exact) 92 93bcSystemSolveEqns1 htPage == 94 htpSetProperty(htPage,'systemType,'polynomial) 95 htpSetProperty(htPage,'exitFunction,'bcInputSolveInfo) 96 bcInputEquations(htPage,'exact) 97 98bcLinearSolveEqns1 htPage == 99 htpSetProperty(htPage,'systemType,'linear) 100 htpSetProperty(htPage,'exitFunction,'bcLinearSolveEqnsGen) 101 bcInputEquations(htPage,'exact) 102 103bcInputSolveInfo htPage == 104 page := htInitPage('"Solve Basic Command", htpPropertyList htPage) 105 htpSetProperty(page,'numberOfEquations,htpProperty(htPage,'numberOfEquations)) 106 htpSetProperty(page,'inputArea,htpInputAreaAlist htPage) 107 htMakePage '( 108 (domainConditions (isDomain PI (PositiveInteger))) 109 (text . "What would you like?") 110 (text . "\beginmenu") 111 (text . "\item ") 112 (bcLinks ("\menuitemstyle{Exact Solutions}" "" bcSolveEquations exact)) 113 (text . "\indentrel{18}\tab{0} ") 114 (text . "Solutions expressed in terms of {\em roots} of irreducible polynomials") 115 (text . "\indentrel{-18}") 116 (text . "\item ") 117 (bcLinks ("\menuitemstyle{Numeric Solutions}" "" bcSolveEquationsNumerically numeric)) 118 (text . "\indentrel{18}\tab{0} ") 119 (text . "Solutions expressed in terms of approximate real or complex {\em numbers}") 120 (text . "\indentrel{-18}") 121 (text . "\item ") 122 (bcLinks ("\menuitemstyle{Radical Solutions}" "" bcSolveEquations radical)) 123 (text . "\indentrel{18}\tab{0} ") 124 (text . "Solutions expressed in terms of {\em radicals} if it is possible") 125 (text . "\indentrel{-18}") 126 (text . "\endmenu")) 127 htShowPage() 128 129bcInputEquations(htPage,solutionMethod) == 130 numEqs := 131 htpProperty(htPage, 'systemType) = 'onePolynomial => 1 132 $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage,'numberOfEquations) 133 objValUnwrap htpLabelSpadValue(htPage, 'numberOfEquations) 134 linearPred := htpProperty(htPage,'systemType) = 'linear 135 labelList := 136 numEqs = 1 => '( 137 (bcStrings (42 "x^2+1" l1 P)) 138 (text . " = ") 139 (bcStrings (6 0 r1 P))) 140 "append"/[f(i,numEqs,linearPred) for i in 1..numEqs] where f(i,n,linearp) == 141 spacer := (i > 99 => 0; i > 9 => 1; 2) 142 prefix := STRCONC('"\newline\tab{2}{\em Equation ",STRINGIMAGE i,'":}") 143 prefix := STRCONC(prefix,'"\space{",STRINGIMAGE spacer,'"}") 144 lnam := INTERN STRCONC('"l",STRINGIMAGE i) 145 rnam := INTERN STRCONC('"r",STRINGIMAGE i) 146 var:= 147 linearp => bcMakeLinearEquations(i,n) 148 bcMakeEquations(i,n) 149 [['text,:prefix],['bcStrings,[30,var,lnam,'P]],'(text . " = "),['bcStrings,[5,"0",rnam,'P]]] 150 equationPart := [ 151 '(domainConditions 152 (isDomain P (Polynomial $EmptyMode)) 153 (isDomain S (String)) 154 (isDomain PI (PositiveInteger))), 155 :labelList] 156 page := htInitPage('"Solve Basic Command", htpPropertyList htPage) 157 htpSetProperty(page, 'numberOfEquations, numEqs) 158 htpSetProperty(page, 'solutionMethod,solutionMethod) 159 htSay '"\newline\menuitemstyle{}\tab{2}" 160 htSay 161 numEqs = 1 => '"Enter the {\em Equation}:" 162 '"Enter the {\em Equations}:" 163 htSay '"\newline\tab{2}" 164 htMakePage equationPart 165 bcHt '"\blankline " 166 htSay '"\newline\menuitemstyle{}\tab{2}" 167 htMakePage 168 numEqs = 1 => '( 169 (text ."Enter the {\em unknown} (leave blank if implied): ") 170 (text . "\tab{48}") 171 (bcStrings (6 "x" unknowns S . quoteString))) 172 ['(text . "Enter the unknowns (leave blank if implied):"), 173 '(text . "\tab{44}"), 174 ['bcStrings, [10,bcMakeUnknowns(numEqs),'unknowns,'P]]] 175 htMakeDoneButton('"Continue", 'bcInputEquationsEnd) 176 htShowPage() 177 178bcCreateVariableString(i) == 179 STRCONC('"x",STRINGIMAGE i) 180 181bcMakeUnknowns(number)== 182 concatenateStringList([STRCONC(bcCreateVariableString(i)," ") 183 for i in 1..number]) 184 185bcMakeEquations(i,number)== 186 number =1 => STRCONC(bcCreateVariableString(1),"^2+1") 187 bcCreateVariableString(i) 188 STRCONC( 189 STRCONC( 190 concatenateStringList([STRCONC(bcCreateVariableString(j),"+") 191 for j in 1..number]),"1"), 192 STRCONC("-2*",STRCONC(bcCreateVariableString(i),"^2"))) 193 194 195bcMakeLinearEquations(i,number)== 196 number = 1 => bcCreateVariableString(1) 197 number = 2 => 198 i=1 => STRCONC(bcCreateVariableString(1),STRCONC("+",bcCreateVariableString(2))) 199 STRCONC(bcCreateVariableString(1),STRCONC("-",bcCreateVariableString(2))) 200 STRCONC( 201 STRCONC( 202 concatenateStringList([STRCONC(bcCreateVariableString(j),"+") 203 for j in 1..number]),"1"), 204 STRCONC("-2*",bcCreateVariableString(i))) 205 206 207bcInputEquationsEnd htPage == 208 fun := htpProperty(htPage, 'exitFunction) => FUNCALL(fun,htPage) 209 systemError nil 210 211bcSolveEquationsNumerically(htPage,p) == 212 page := htInitPage('"Solve Basic Command", htpPropertyList htPage) 213 htMakePage '( 214 (text . "What would you like?") 215 (radioButtons choice 216 ("Real roots expressed as rational numbers" "" rr) 217 ("Real roots expressed as floats" "" rf) 218 ("Complex roots expressed as rational numbers" "" cr) 219 ("Complex roots expressed as floats" "" cf)) 220 (text . "\vspace{1}\newline") 221 (inputStrings 222 ("Enter the number of desired {\em digits} of accuracy" "" 5 20 acc PI))) 223 htMakeDoneButton('"Continue", 'bcSolveNumerically1) 224 htShowPage() 225 226bcSolveNumerically1(htPage) == 227 bcSolveEquations(htPage,'numeric) 228 229--bcSolveNumerically1(htPage,kind) == 230-- htpSetProperty(htPage,'kind,kind) 231-- bcSolveEquations(htPage,'numeric) 232 233bcSolveEquations(htPage,solutionMethod) == 234 if solutionMethod = 'numeric then 235 digits := htpLabelInputString(htPage,'acc) 236 kind := htpButtonValue(htPage,'choice) 237 accString := 238 kind in '(rf cf) => STRCONC('"1.e-",digits) 239 STRCONC('"1/10^",digits) 240 alist := htpProperty(htPage,'inputArea) 241 [[.,varpart,:.],:r] := alist 242 varlist := bcString2WordList varpart 243 varString := (rest varlist => bcwords2liststring varlist; first varlist) 244 eqnString := bcGenEquations r 245 solutionMethod = 'numeric => 246 name := 247 kind in '(rf rr) => '"solve" 248 '"complexSolve" 249 bcFinish(name,eqnString,accString) 250 name := 251 solutionMethod = 'radical => '"radicalSolve" 252 '"solve" 253 bcFinish(name,eqnString,varString,accString) 254 255bcLinearSolveMatrix(htPage,junk) == 256 bcReadMatrix 'bcLinearSolveMatrix1 257 258bcLinearSolveMatrix1 htPage == 259 page := htInitPage('"Linear Solve Basic Command",htpPropertyList htPage) 260 htpSetProperty(page,'matrix,bcLinearExtractMatrix htPage) 261 htMakePage '( 262 (text . "The right side vector B is:") 263 (lispLinks 264 ("Zero:" "the system is homogeneous" bcLinearSolveMatrixHomo homo) 265 ("Not zero:" "the system is not homogeneous" bcLinearSolveMatrixInhomo nothomo))) 266 htShowPage() 267 268bcLinearExtractMatrix htPage == REVERSE htpInputAreaAlist htPage 269 270bcLinearSolveMatrixInhomo(htPage,junk) == 271 nrows := htpProperty(htPage,'nrows) 272 ncols := htpProperty(htPage,'ncols) 273 labelList := 274 [f(i) for i in 1..ncols] where f(i) == 275 spacer := (i > 99 => 0; i > 9 => 1; 2) 276 prefix := STRCONC('"{\em Coefficient ",STRINGIMAGE i,'":}") 277 if spacer ~= 0 then 278 prefix := STRCONC(prefix,'"\space{",STRINGIMAGE spacer,'"}") 279 name := INTERN STRCONC('"c",STRINGIMAGE i) 280 [prefix,"",30, 0,name, 'P] 281 page := htInitPage('"Linear Solve Basic Command",htpPropertyList htPage) 282 htpSetProperty(page,'matrix,htpProperty(htPage,'matrix)) 283 htpSetProperty(page,'nrows,nrows) 284 htpSetProperty(page,'ncols,ncols) 285 htMakePage [ 286 '(domainConditions (isDomain P (Polynomial $EmptyMode))), 287 '(text . "Enter the right side vector B:"), 288 ['inputStrings, :labelList], 289 '(text . "\vspace{1}\newline Do you want:" ), 290 '(lispLinks 291 ("All the solutions?" "" bcLinearSolveMatrixInhomoGen all) 292 ("A particular solution?" "" bcLinearSolveMatrixInhomoGen particular))] 293 htShowPage() 294 295bcLinearSolveMatrixInhomoGen(htPage,key) == bcLinearMatrixGen(htPage,key) 296 297bcLinearSolveMatrixHomo(htPage,key) == bcLinearMatrixGen(htPage,'homo) 298 299bcLinearMatrixGen(htPage,key) == 300 matform := bcMatrixGen htPage 301 key = 'homo => bcFinish('"nullSpace",matform) 302 vector := [x.1 for x in REVERSE htpInputAreaAlist htPage] 303 vecform := bcVectorGen vector 304 form := bcMkFunction('"solve",matform,[vecform]) 305 bcGen 306 key = 'particular => STRCONC(form,'".particular") 307 form 308 309linearFinalRequest(nhh,mat,vect) == 310 sayBrightly '"Do you want more information on the meaning of the output" 311 sayBrightly '" (1) no " 312 sayBrightly '" (2) yes " 313 tt := bcQueryInteger(1,2,true) 314 tt=1 => sayBrightly '"Bye Bye" 315 tt=2 => explainLinear(nhh) 316 317explainLinear(flag) == 318 flag="notHomogeneous" => 319 '("solve returns a particular solution and a basis for" 320 "the vector space of solutions for the homogeneous part." 321 "The particular solution is _"failed_" if one cannot be found.") 322 flag= "homogeneous" => 323 '("solve returns a basis for" 324 "the vector space of solutions for the homogeneous part") 325 systemError nil 326 327finalExactRequest(equations,unknowns) == 328 sayBrightly '"Do you like:" 329 sayBrightly '" (1) the solutions how they are displayed" 330 sayBrightly '" (2) to get ????" 331 sayBrightly '" (3) more information on the meaning of the output" 332 tt := bcQueryInteger(1,3,true) 333 tt=1 => sayBrightly '"Bye Bye" 334 tt=2 => moreExactSolution(equations,unknowns,flag) 335 tt=3 => explainExact(equations,unknowns) 336 337bcLinearSolveEqnsGen htPage == 338 alist := htpInputAreaAlist htPage 339 if vars := htpLabelInputString(htPage,'unknowns) then 340 varlist := bcString2WordList vars 341 varString := (rest varlist => bcwords2liststring varlist; first varlist) 342 alist := rest alist --know these are first on the list 343 eqnString := bcGenEquations alist 344 bcFinish('"solve",eqnString,varString) 345 346bcGenEquations alist == 347 y := alist 348 while y repeat 349 right := (first y).1 350 y := rest y 351 left := (first y).1 352 y := rest y 353 eqnlist := [STRCONC(left,'" = ",right),:eqnlist] 354 rest eqnlist => bcwords2liststring eqnlist 355 first eqnlist 356