diff --git a/changelog b/changelog index 0730f88..a84400f 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,7 @@ +20090901 tpd src/axiom-website/patches.html 20090901.02.tpd.patch +20090901 tpd src/interp/Makefile move nag-e04.boot to nag-e04.lisp +20090901 tpd src/interp/nag-e04.lisp added, rewritten from nag-e04.boot +20090901 tpd src/interp/nag-e04.boot removed, rewritten to nag-e04.lisp 20090901 tpd src/axiom-website/patches.html 20090901.01.tpd.patch 20090901 tpd src/interp/Makefile move nag-e02.boot to nag-e02.lisp 20090901 tpd src/interp/nag-e02.lisp added, rewritten from nag-e02.boot diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 0042116..e353d0b 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -1960,5 +1960,7 @@ src/interp/nag-d02.lisp rewrite from boot to lisp
src/interp/nag-e01.lisp rewrite from boot to lisp
20090901.01.tpd.patch src/interp/nag-e02.lisp rewrite from boot to lisp
+20090901.02.tpd.patch +src/interp/nag-e04.lisp rewrite from boot to lisp
diff --git a/src/interp/Makefile.pamphlet b/src/interp/Makefile.pamphlet index 4805c8b..2c268e1 100644 --- a/src/interp/Makefile.pamphlet +++ b/src/interp/Makefile.pamphlet @@ -1584,41 +1584,32 @@ ${MID}/nag-e02.lisp: ${IN}/nag-e02.lisp.pamphlet @ -\subsection{nag-e04.boot \cite{52}} +\subsection{nag-e04.lisp} <>= ${AUTO}/nag-e04.${O}: ${OUT}/nag-e04.${O} - @ echo 186 making ${AUTO}/nag-e04.${O} from ${OUT}/nag-e04.${O} + @ echo 154 making ${AUTO}/nag-e04.${O} from ${OUT}/nag-e04.${O} @ cp ${OUT}/nag-e04.${O} ${AUTO} @ <>= -${OUT}/nag-e04.${O}: ${MID}/nag-e04.clisp - @ echo 187 making ${OUT}/nag-e04.${O} from ${MID}/nag-e04.clisp - @ (cd ${MID} ; \ +${OUT}/nag-e04.${O}: ${MID}/nag-e04.lisp + @ echo 136 making ${OUT}/nag-e04.${O} from ${MID}/nag-e04.lisp + @ ( cd ${MID} ; \ if [ -z "${NOISE}" ] ; then \ - echo '(progn (compile-file "${MID}/nag-e04.clisp"' \ + echo '(progn (compile-file "${MID}/nag-e04.lisp"' \ ':output-file "${OUT}/nag-e04.${O}") (${BYE}))' | ${DEPSYS} ; \ else \ - echo '(progn (compile-file "${MID}/nag-e04.clisp"' \ + echo '(progn (compile-file "${MID}/nag-e04.lisp"' \ ':output-file "${OUT}/nag-e04.${O}") (${BYE}))' | ${DEPSYS} \ >${TMP}/trace ; \ fi ) @ -<>= -${MID}/nag-e04.clisp: ${IN}/nag-e04.boot.pamphlet - @ echo 188 making ${MID}/nag-e04.clisp from ${IN}/nag-e04.boot.pamphlet +<>= +${MID}/nag-e04.lisp: ${IN}/nag-e04.lisp.pamphlet + @ echo 137 making ${MID}/nag-e04.lisp from ${IN}/nag-e04.lisp.pamphlet @ (cd ${MID} ; \ - ${TANGLE} ${IN}/nag-e04.boot.pamphlet >nag-e04.boot ; \ - if [ -z "${NOISE}" ] ; then \ - echo '(progn (boot::reroot "${SPAD}")' \ - '(boottran::boottocl "nag-e04.boot") (${BYE}))' | ${DEPSYS} ; \ - else \ - echo '(progn (boot::reroot "${SPAD}")' \ - '(boottran::boottocl "nag-e04.boot") (${BYE}))' | ${DEPSYS} \ - >${TMP}/trace ; \ - fi ; \ - rm nag-e04.boot ) + ${TANGLE} ${IN}/nag-e04.lisp.pamphlet >nag-e04.lisp ) @ @@ -4678,7 +4669,7 @@ clean: <> <> -<> +<> <> <> diff --git a/src/interp/nag-e04.boot.pamphlet b/src/interp/nag-e04.boot.pamphlet deleted file mode 100644 index 2d20183..0000000 --- a/src/interp/nag-e04.boot.pamphlet +++ /dev/null @@ -1,2520 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/interp nag-e04.boot} -\author{The Axiom Team} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{License} -<>= --- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd. --- All rights reserved. --- --- Redistribution and use in source and binary forms, with or without --- modification, are permitted provided that the following conditions are --- met: --- --- - Redistributions of source code must retain the above copyright --- notice, this list of conditions and the following disclaimer. --- --- - Redistributions in binary form must reproduce the above copyright --- notice, this list of conditions and the following disclaimer in --- the documentation and/or other materials provided with the --- distribution. --- --- - Neither the name of The Numerical ALgorithms Group Ltd. nor the --- names of its contributors may be used to endorse or promote products --- derived from this software without specific prior written permission. --- --- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS --- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED --- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A --- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER --- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, --- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, --- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR --- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF --- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING --- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS --- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - -@ -<<*>>= -<> - -e04dgf() == - htInitPage('"E04DGF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXe04dgf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04dgf| '|NagOptimisationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "E04DGF minimizes {\it F(x)}, an unconstrained nonlinear function") - (text . " of {\it n} variables, using a pre-conditioned quasi-Newton ") - (text . "conjugate gradient method. ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the number of variables, {\it n}: ") - (text . "\newline ") - (bcStrings (5 2 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Change optional parameters:") - (radioButtons optional - ("" " No" no) - ("" " Yes" yes)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e04dgfSolve) - htShowPage() - - -e04dgfSolve(htPage) == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - param := htpButtonValue(htPage,'optional) - optional := - param = 'no => '0 - '1 - (n = '2 and optional = 0) => e04dgfDefaultSolve(htPage,ifail,n,optional) - funcList := [['bcStrings,[55, '"exp(X[1])*(4*X[1]**2+2*X[2]**2+4*X[1]*X[2]+2*X[2]+1)", 'f, 'EM]]] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ") - middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ") - middle := cons('text,middle) - vecList := - n='2 => - [['bcStrings,[8,-1.0,'x1,'F]],['bcStrings,[8,1.0,'x2,'F]]] - [fb(i) for i in 1..n] where fb(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ['bcStrings,[8, -1.0, xnam, 'F]] - funcList := [:funcList,middle,:vecList] - if optional = 1 then - opt1Text := '"\blankline \menuitemstyle{}\tab{2} " - opt1Text := STRCONC(opt1Text,'"Estimated optimal function values, {\it es}: \newline ") - optList := [['text,:opt1Text],['bcStrings,[20, 1.0, 'es, 'F]]] - opt2Text := '"\blankline \menuitemstyle{}\tab{2} " - opt2Text := STRCONC(opt2Text,'"Function precision, {\it fu}: \newline ") - optList := [:optList,:[['text,:opt2Text],['bcStrings,[20,"0.4373903597E-14",'fu,'F]]]] - opt3Text := '"\blankline \menuitemstyle{}\tab{2} " - opt3Text := STRCONC(opt3Text,'"Iteration limit, {\it it}: \newline ") - optList := [:optList,:[['text,:opt3Text],['bcStrings,[5,50,'it,'PI]]]] - opt4Text := '"\blankline \menuitemstyle{}\tab{2} " - opt4Text := STRCONC(opt4Text,'"Linesearch tolerance, {\it lin}: \newline ") - optList := [:optList,:[['text,:opt4Text],['bcStrings,[20,"0.9",'lin,'F]]]] - opt5Text := '"\blankline \menuitemstyle{}\tab{2} " - opt5Text := STRCONC(opt5Text,'"List parameters:") - optList := [:optList,:[['text,:opt5Text],['radioButtons,'lis,:[[""," Yes",'true],[""," No",'false]]]]] - opt6Text := '"\blankline \menuitemstyle{}\tab{2} " - opt6Text := STRCONC(opt6Text,'"Maximum step length, {\it ma}: \newline ") - optList := [:optList,:[['text,:opt6Text],['bcStrings,[20,"1.0E+20",'ma,'F]]]] - opt7Text := '"\blankline \menuitemstyle{}\tab{2} " - opt7Text := STRCONC(opt7Text,'"Optimality tolerance, {\it op}: \newline ") - optList := [:optList,:[['text,:opt7Text],['bcStrings,[20,"3.26E-12",'op,'F]]]] - opt9Text := '"\blankline \menuitemstyle{}\tab{2} " - opt9Text := STRCONC(opt9Text,'"Print level, {\it pr}: \newline ") - optList := [:optList,:[['text,:opt9Text],['bcStrings,[5,10,'pr,'PI]]]] - opt10Text := '"\blankline \menuitemstyle{}\tab{2} " - opt10Text := STRCONC(opt10Text,'"Start objective check at variable, {\it sta}: \newline ") - optList := [:optList,:[['text,:opt10Text],['bcStrings,[5,1,'sta,'PI]]]] - opt11Text := '"\blankline \menuitemstyle{}\tab{2} " - opt11Text := STRCONC(opt11Text,'"Stop objective check at variable, {\it sto}: \newline ") - optList := [:optList,:[['text,:opt11Text],['bcStrings,[5,2,'sto,'PI]]]] - opt12Text := '"\blankline \menuitemstyle{}\tab{2} " - opt12Text := STRCONC(opt12Text,'"Verify level, {\it ver}: \newline ") - optList := [:optList,:[['text,:opt12Text],['bcStrings,[5,0,'ver,'PI]]]] - --- (text . "\blankline ") --- (text . "\newline ") --- (text . "\menuitemstyle{}\tab{2}") --- (text . "List parameters:") --- (radioButtons lis --- ("" " Yes" true) --- ("" " No" false)) - else - optList := [] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList, - :optList] - page := htInitPage('"E04DGF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'e04dgfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'optional,optional) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e04dgfDefaultSolve(htPage,ifail,n,optional) == - page := htInitPage('"E04DGF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: ") - (text . "\newline ") - (bcStrings (55 "exp(X[1])*(4*X[1]**2+2*X[2]**2+4*X[1]*X[2]+2*X[2]+1)" f EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter initial guess of the solution vector, {\it x(n)}: \newline") - (bcStrings (8 "-1.0" x1 F)) - (bcStrings (8 "1.0" x2 F))) - htMakeDoneButton('"Continue",'e04dgfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'optional,optional) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e04dgfGen htPage == - n := htpProperty(htPage,'n) - optional := htpProperty(htPage,'optional) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - if (optional = '0) then - es := '"1.0" - ma := '"1.0E+20" - op := '"3.26E-12" - lin := '"0.9" - fu := '"0.4373903597E-14" - it := 50 - pr := 10 - sta := 1 - sto := 2 - ver := 0 - lis := '"true" - for i in 1..n repeat - temp := STRCONC ((first y).1," ") - xlist := [temp,:xlist] - y := rest y - xstring := bcwords2liststring xlist - f := (first y).1 - else - ver := STRCONC((first y).1," ") - y := rest y - sto := STRCONC((first y).1," ") - y := rest y - sta := STRCONC((first y).1," ") - y := rest y - pr := STRCONC((first y).1," ") - y := rest y - op := STRCONC((first y).1," ") - y := rest y - ma := STRCONC((first y).1," ") - y := rest y - nolist := (first y).1 - lis := - nolist = '" t" => '"false" - '"true" - y := rest y - dummy := first y - y := rest y - lin := STRCONC((first y).1," ") - y := rest y - it := STRCONC((first y).1," ") - y := rest y - fu := STRCONC((first y).1," ") - y := rest y - es := STRCONC((first y).1," ") - y := rest y - for i in 1..n repeat - temp := STRCONC ((first y).1," ") - xlist := [temp,:xlist] - y := rest y - xstring := bcwords2liststring xlist - f := (first y).1 - prefix := STRCONC("e04dgf(",STRINGIMAGE n,", ",es,", ",fu,",") - prefix := STRCONC(prefix,STRINGIMAGE it,", ",lin,", ",lis,", ",ma,", ",op) - prefix := STRCONC(prefix,",",STRINGIMAGE pr,", ",STRINGIMAGE sta,", ") - middle := STRCONC(STRINGIMAGE sto,", ",STRINGIMAGE ver,", [",xstring,"] ,") - middle := STRCONC(middle,STRINGIMAGE ifail," ,") - linkGen STRCONC (prefix,middle,"((",f,")::Expression(Float))::ASP49(OBJFUN))") - -e04fdf() == - htInitPage('"E04FDF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using function values only",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe04fdf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04fdf| '|NagOptimisationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "E04FDF is an easy to use routine for finding an unconstrained ") - (text . "minimum of a sum of squares of {\it m} nonlinear functions in ") - (text . "{\it n} variables ({\it m} \htbitmap{great=} {\it n}), i.e., it ") - (text . "is applicable to problems of the form ") - (text . "\center{\htbitmap{e04fdf}} where \center{\htbitmap{e04fdf1}}") - (text . "No derivatives are required. The routine is intended for ") - (text . "functions which have continous first and second derivatives, ") - (text . "though it will usually work if the derivatives have occasional ") - (text . "discontinuities. ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of functions {\it \htbitmap{fi}(x)}, {\it m}:") - (text . "\newline\tab{2} ") - (bcStrings (5 15 m PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of variables \htbitmap{xj}, {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 3 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of {\it iw}, {\it liw}:") - (text . "\newline\tab{2} ") - (bcStrings (5 1 liw F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of {\it w}, {\it lw}:") - (text . "\newline\tab{2} ") - (bcStrings (5 171 lw F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e04fdfSolve) - htShowPage() - -e04fdfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - liw := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'liw) - objValUnwrap htpLabelSpadValue(htPage, 'liw) - lw := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) - objValUnwrap htpLabelSpadValue(htPage, 'lw) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = '15 and n = '3) => e04fdfDefaultSolve(htPage,liw,lw,ifail) - funcList := - "append"/[fa(i) for i in 1..m] where fa(i) == - prefix := ('"\newline {\em Function ") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - funct := ('"XC[1] + 1") - nam := INTERN STRCONC ('"n",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ") - middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ") - middle := cons('text,middle) - vecList := - [fb(i) for i in 1..n] where fb(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ['bcStrings,[4, '"0.0", xnam, 'F]] - funcList := [:funcList,middle,:vecList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList] - page:= htInitPage('"E04FDF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using function values only",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the functions \htbitmap{fi} below in terms XC[1]...XC[n]: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'e04fdfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'liw,liw) - htpSetProperty(page,'lw,lw) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e04fdfDefaultSolve (htPage,liw,lw,ifail) == - n := '3 - m := '15 - page:= htInitPage('"E04FDF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using function values only",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the functions \htbitmap{fi} below ") - (text . "in terms of XC[1]...XC[n]: ") - (text . "\newline ") - (text . "\newline {\em Function 1:} \space{1}") - (bcStrings (42 "(XC[3]+15*XC[2])**(-1)+XC[1]-0.14" n1 EM)) - (text . "\newline {\em Function 2:} \space{1}") - (bcStrings (42 "2*(2*XC[3]+14*XC[2])**(-1)+XC[1]-0.18" n2 EM)) - (text . "\newline {\em Function 3:} \space{1}") - (bcStrings (42 "3*(3*XC[3]+13*XC[2])**(-1)+XC[1]-0.22" n3 EM)) - (text . "\newline {\em Function 4:} \space{1}") - (bcStrings (42 "4*(4*XC[3]+12*XC[2])**(-1)+XC[1]-0.25" n4 EM)) - (text . "\newline {\em Function 5:} \space{1}") - (bcStrings (42 "5*(5*XC[3]+11*XC[2])**(-1)+XC[1]-0.29" n5 EM)) - (text . "\newline {\em Function 6:} \space{1}") - (bcStrings (42 "6*(6*XC[3]+10*XC[2])**(-1)+XC[1]-0.32" n6 EM)) - (text . "\newline {\em Function 7:} \space{1}") - (bcStrings (42 "7*(7*XC[3]+9*XC[2])**(-1)+XC[1]-0.35" n7 EM)) - (text . "\newline {\em Function 8:} \space{1}") - (bcStrings (42 "8*(8*XC[3]+8*XC[2])**(-1)+XC[1]-0.39" n8 EM)) - (text . "\newline {\em Function 9:} \space{1}") - (bcStrings (42 "9*(7*XC[3]+7*XC[2])**(-1)+XC[1]-0.37" n9 EM)) - (text . "\newline {\em Function 10:} \space{1}") - (bcStrings (42 "10*(6*XC[3]+6*XC[2])**(-1)+XC[1]-0.58" n10 EM)) - (text . "\newline {\em Function 11:} \space{1}") - (bcStrings (42 "11*(5*XC[3]+5*XC[2])**(-1)+XC[1]-0.73" n11 EM)) - (text . "\newline {\em Function 12:} \space{1}") - (bcStrings (42 "12*(4*XC[3]+4*XC[2])**(-1)+XC[1]-0.96" n12 EM)) - (text . "\newline {\em Function 13:} \space{1}") - (bcStrings (42 "13*(3*XC[3]+3*XC[2])**(-1)+XC[1]-1.34" n13 EM)) - (text . "\newline {\em Function 14:} \space{1}") - (bcStrings (42 "14*(2*XC[3]+2*XC[2])**(-1)+XC[1]-2.1" n14 EM)) - (text . "\newline {\em Function 15:} \space{1}") - (bcStrings (42 "15*(XC[3]+XC[2])**(-1)+XC[1]-4.39" n15 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter initial guess of the solution vector {\it x(n)}: \newline ") - (bcStrings (4 "0.5" x1 F)) - (bcStrings (4 "1.0" x2 F)) - (bcStrings (4 "1.5" x3 F))) - htMakeDoneButton('"Continue",'e04fdfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'liw,liw) - htpSetProperty(page,'lw,lw) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e04fdfGen htPage == - n := htpProperty(htPage, 'n) - m := htpProperty(htPage, 'm) - liw := htpProperty(htPage,'liw) - lw := htpProperty(htPage,'lw) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - temp := STRCONC ((first y).1," ") - xlist := [temp,:xlist] - y := rest y - xstring := bcwords2liststring xlist - for i in 1..m repeat - temp := STRCONC ((first y).1," ") - ulist := [temp,:ulist] - y := rest y - ustring := bcwords2liststring ulist - prefix := STRCONC("e04fdf(",STRINGIMAGE m,",",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE liw,",",STRINGIMAGE lw,", [") - middle := STRCONC(xstring,"],",STRINGIMAGE ifail,",") - linkGen STRCONC(prefix,middle,"(",ustring,"::Vector Expression(Float))::ASP50(LSFUN1))") - - -e04gcf() == - htInitPage('"E04GCF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using 1st derivatives",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe04gcf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04gcf| '|NagOptimisationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "E04GCF is an easy to use quasi-Newton routine for finding an unconstrained ") - (text . "minimum of a sum of squares of {\it m} nonlinear functions in ") - (text . "{\it n} variables ({\it m} \htbitmap{great=} {\it n}), i.e., it ") - (text . "is applicable to problems of the form ") - (text . "\center{\htbitmap{e04fdf}} where \center{\htbitmap{e04fdf1}}") - (text . "The routine is intended for ") - (text . "functions which have continous first and second derivatives, ") - (text . "though it will usually work if the derivatives have occasional ") - (text . "discontinuities. ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of functions {\it \htbitmap{fi}(x)}, {\it m}:") - (text . "\newline\tab{2} ") - (bcStrings (5 15 m PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of variables \htbitmap{xj}, {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 3 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of {\it iw}, {\it liw}:") - (text . "\newline\tab{2} ") - (bcStrings (5 1 liw F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of {\it w}, {\it lw}:") - (text . "\newline\tab{2} ") - (bcStrings (5 177 lw F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e04gcfSolve) - htShowPage() - -e04gcfSolve htPage == - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - liw := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'liw) - objValUnwrap htpLabelSpadValue(htPage, 'liw) - lw := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) - objValUnwrap htpLabelSpadValue(htPage, 'lw) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (m = '15 and n = '3) => e04gcfDefaultSolve(htPage,liw,lw,ifail) - funcList := - "append"/[fa(i) for i in 1..m] where fa(i) == - prefix := ('"\newline {\em Function ") - prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") - funct := ('"XC[1] + 1") - nam := INTERN STRCONC ('"n",STRINGIMAGE i) - [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ") - middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ") - middle := cons('text,middle) - vecList := - [fb(i) for i in 1..n] where fb(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - ['bcStrings,[4, '"0.0", xnam, 'F]] - funcList := [:funcList,middle,:vecList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList] - page:= htInitPage('"E04GCF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using 1st derivatives",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the functions \htbitmap{fi} below in terms of XC[1]...XC[n]: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'e04gcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'liw,liw) - htpSetProperty(page,'lw,lw) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e04gcfDefaultSolve (htPage,liw,lw,ifail) == - n := '3 - m := '15 - page:= htInitPage('"E04GCF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using 1st derivatives",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the functions \htbitmap{fi} below ") - (text . "in terms of XC[1]...XC[n]: ") - (text . "\newline ") - (text . "\newline {\em Function 1:} \space{1}") - (bcStrings (42 "(XC[3]+15*XC[2])**(-1)+XC[1]-0.14" n1 EM)) - (text . "\newline {\em Function 2:} \space{1}") - (bcStrings (42 "2*(2*XC[3]+14*XC[2])**(-1)+XC[1]-0.18" n2 EM)) - (text . "\newline {\em Function 3:} \space{1}") - (bcStrings (42 "3*(3*XC[3]+13*XC[2])**(-1)+XC[1]-0.22" n3 EM)) - (text . "\newline {\em Function 4:} \space{1}") - (bcStrings (42 "4*(4*XC[3]+12*XC[2])**(-1)+XC[1]-0.25" n4 EM)) - (text . "\newline {\em Function 5:} \space{1}") - (bcStrings (42 "5*(5*XC[3]+11*XC[2])**(-1)+XC[1]-0.29" n5 EM)) - (text . "\newline {\em Function 6:} \space{1}") - (bcStrings (42 "6*(6*XC[3]+10*XC[2])**(-1)+XC[1]-0.32" n6 EM)) - (text . "\newline {\em Function 7:} \space{1}") - (bcStrings (42 "7*(7*XC[3]+9*XC[2])**(-1)+XC[1]-0.35" n7 EM)) - (text . "\newline {\em Function 8:} \space{1}") - (bcStrings (42 "8*(8*XC[3]+8*XC[2])**(-1)+XC[1]-0.39" n8 EM)) - (text . "\newline {\em Function 9:} \space{1}") - (bcStrings (42 "9*(7*XC[3]+7*XC[2])**(-1)+XC[1]-0.37" n9 EM)) - (text . "\newline {\em Function 10:} \space{1}") - (bcStrings (42 "10*(6*XC[3]+6*XC[2])**(-1)+XC[1]-0.58" n10 EM)) - (text . "\newline {\em Function 11:} \space{1}") - (bcStrings (42 "11*(5*XC[3]+5*XC[2])**(-1)+XC[1]-0.73" n11 EM)) - (text . "\newline {\em Function 12:} \space{1}") - (bcStrings (42 "12*(4*XC[3]+4*XC[2])**(-1)+XC[1]-0.96" n12 EM)) - (text . "\newline {\em Function 13:} \space{1}") - (bcStrings (42 "13*(3*XC[3]+3*XC[2])**(-1)+XC[1]-1.34" n13 EM)) - (text . "\newline {\em Function 14:} \space{1}") - (bcStrings (42 "14*(2*XC[3]+2*XC[2])**(-1)+XC[1]-2.1" n14 EM)) - (text . "\newline {\em Function 15:} \space{1}") - (bcStrings (42 "15*(XC[3]+XC[2])**(-1)+XC[1]-4.39" n15 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter initial guess of the solution vector {\it x(n)}: \newline ") - (bcStrings (4 "0.5" x1 F)) - (bcStrings (4 "1.0" x2 F)) - (bcStrings (4 "1.5" x3 F))) - htMakeDoneButton('"Continue",'e04gcfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'liw,liw) - htpSetProperty(page,'lw,lw) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e04gcfGen htPage == - n := htpProperty(htPage, 'n) - m := htpProperty(htPage, 'm) - liw := htpProperty(htPage,'liw) - lw := htpProperty(htPage,'lw) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - temp := STRCONC ((first y).1," ") - xlist := [temp,:xlist] - y := rest y - xstring := bcwords2liststring xlist - for i in 1..m repeat - temp := STRCONC ((first y).1," ") - ulist := [temp,:ulist] - y := rest y - ustring := bcwords2liststring ulist - prefix := STRCONC("e04gcf(",STRINGIMAGE m,",",STRINGIMAGE n,", ") - prefix := STRCONC(prefix,STRINGIMAGE liw,",",STRINGIMAGE lw,", [") - middle := STRCONC(xstring,"],",STRINGIMAGE ifail,",") - linkGen STRCONC(prefix,middle,"(",ustring,"::Vector Expression(Float))::ASP19(LSFUN2))") - - -e04jaf() == - htInitPage('"E04JAF - Minimum, function of several variables, quasi-Newton algorithm, simple bounds, using function values only",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\windowlink{Manual Page}{manpageXXe04jaf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04jaf| '|NagOptimisationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "E04JAF is an easy to use quasi-Newton routine for finding a ") - (text . "minimum of a nonlinear function {\it F(x)} of {\it n} variables ") - (text . "\center{\htbitmap{e04fdf1}} possibly subject to fixed upper ") - (text . "and lower bounds on the variables, i.e., it is applicable to ") - (text . "problems of the form \blankline Minimize {\it F(x)}, subject to ") - (text . "\htbitmap{lj} \htbitmap{great=} \htbitmap{xj} \htbitmap{great=} ") - (text . "\htbitmap{uj} for {\it j} = 1,2,...,n. \blankline ") - (text . "Function values only are required. The routine is intended for ") - (text . "functions which have continuous first and second derivatives, ") - (text . "though it will usually work if the derivatives have occasional ") - (text . "discontinuities. ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of variables \htbitmap{xj}, {\it n}:") - (text . "\newline\tab{2} ") - (bcStrings (5 4 n PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Specify the use of bounds, {\it ibound}:") - (radioButtons ibound - (" 0" " All \htbitmap{lj} and \htbitmap{uj} are given individually" iZero) - (" 1" " No bounds on any of the \htbitmap{xj}" iOne) - (" 2" " All bounds are of the form 0 \htbitmap{great=} \htbitmap{xj}" iTwo) - (" 3" " All \htbitmap{lj} are equal and all \htbitmap{uj} are equal" iThree)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of {\it iw}, {\it liw}:") - (text . "\newline\tab{2} ") - (bcStrings (5 6 liw F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of {\it w}, {\it lw}:") - (text . "\newline\tab{2} ") - (bcStrings (5 54 lw F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e04jafSolve) - htShowPage() - -e04jafSolve htPage == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - boun := htpButtonValue(htPage,'ibound) - ibound := - boun = 'iZero => '0 - boun = 'iOne => '1 - boun = 'iTwo => '2 - '3 - liw := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'liw) - objValUnwrap htpLabelSpadValue(htPage, 'liw) - lw := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) - objValUnwrap htpLabelSpadValue(htPage, 'lw) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - n = '4 => e04jafDefaultSolve(htPage,ibound,liw,lw,ifail) - funcList := [['bcStrings,[50, '"XC[1]", 'f, 'EM]]] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter lower boundary conditions ") - middle := STRCONC(middle,'"{\it bl(n)}: \newline ") - blList := - "append"/[fa(i) for i in 1..n] where fa(i) == - xnam := INTERN STRCONC ('"bl",STRINGIMAGE i) - [['bcStrings,[8, '"0.0", xnam, 'F]]] - blList := [['text,:middle],:blList] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter upper boundary ") - middle := STRCONC(middle,'"conditions {\it bu(n)}: \newline ") - buList := - "append"/[fb(i) for i in 1..n] where fb(i) == - xnam := INTERN STRCONC ('"bu",STRINGIMAGE i) - [['bcStrings,[8, '"0.0", xnam, 'F]]] - buList := [['text,:middle],:buList] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ") - middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ") - xList := - "append"/[fc(i) for i in 1..n] where fc(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[8, '"0.0", xnam, 'F]]] - xList := [['text,:middle],:xList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))), - :funcList,:blList,:buList,:xList] - page:= htInitPage('"E04JAF - Minimum, function of several variables, quasi-Newton algorithm, simple bounds, using function values only",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the function {\it F(x)} below in terms of XC[1]...XC[n]: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'e04jafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ibound,ibound) - htpSetProperty(page,'liw,liw) - htpSetProperty(page,'lw,lw) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e04jafDefaultSolve (htPage,ibound,liw,lw,ifail) == - n := '4 - page:= htInitPage('"E04JAF - Minimum, function of several variables, quasi-Newton algorithm, simple bounds, using function values only",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the function {\it F(x)} below in terms of XC[1]...XC[n]: ") - (text . "\newline ") - (bcStrings (60 "(XC[1]+10*XC[2])**2+5*(XC[3]-XC[4])**2+(XC[2]-2*XC[3])**4+10*(XC[1]-XC[4])**4" n1 EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter lower boundary conditions {\it bl(n)}: \newline ") - (bcStrings (8 "1" bl1 F)) - (bcStrings (8 "-2" bl2 F)) - (bcStrings (8 "-1.0e-6" bl3 F)) - (bcStrings (8 "1" bl4 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter upper boundary conditions {\it bu(n)}: \newline ") - (bcStrings (8 "3" bu1 F)) - (bcStrings (8 "0" bu2 F)) - (bcStrings (8 "1.0e6" bu3 F)) - (bcStrings (8 "3" bu4 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter initial guess of the solution vector {\it x(n)}: \newline ") - (bcStrings (8 "3" x1 F)) - (bcStrings (8 "-1" x2 F)) - (bcStrings (8 "0" x3 F)) - (bcStrings (8 "1" x4 F))) - htMakeDoneButton('"Continue",'e04jafGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'ibound,ibound) - htpSetProperty(page,'liw,liw) - htpSetProperty(page,'lw,lw) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e04jafGen htPage == - n := htpProperty(htPage, 'n) - ibound := htpProperty(htPage, 'ibound) - liw := htpProperty(htPage,'liw) - lw := htpProperty(htPage,'lw) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - temp := STRCONC ((first y).1," ") - xlist := [temp,:xlist] - y := rest y - xstring := bcwords2liststring xlist - for i in 1..n repeat - temp := STRCONC ((first y).1," ") - bulist := [temp,:bulist] - y := rest y - bustring := bcwords2liststring bulist - for i in 1..n repeat - temp := STRCONC ((first y).1," ") - bllist := [temp,:bllist] - y := rest y - blstring := bcwords2liststring bllist - f := (first y).1 - prefix := STRCONC("e04jaf(",STRINGIMAGE n,",",STRINGIMAGE ibound,", ") - prefix := STRCONC(prefix,STRINGIMAGE liw,",",STRINGIMAGE lw,", [") - prefix := STRCONC(prefix,blstring,"],[",bustring,"],[") - middle := STRCONC(xstring,"],",STRINGIMAGE ifail,",(") - linkGen STRCONC(prefix,middle,f,"::Expression(Float))::ASP24(FUNCT1))") - - -e04mbf() == - htInitPage('"E04MBF - Linear programming problem",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXe04mbf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04mbf| '|NagOptimisationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "E04MBF is an easy to use routine to solve linear programming ") - (text . "(LP) problems of the form \center{\htbitmap{e04mbf}} \newline ") - (text . "where {\it c} is an {\it n} element vector and {\it A} is an ") - (text . "{\it m} by {\it n} matrix, i.e., there are {\it n} variables ") - (text . "and {\it m} linear constraints. {\it m} may be zero in which ") - (text . "case the LP problem is subject only to bounds on the variables. ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Upper bound on number of iterations, {\it itmax}:") - (text . "\newline\tab{2} ") - (bcStrings (6 20 itmax PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Type of output messages required, {\it msglvl}: ") - (radioButtons msglvl - (" = 1 " " Printing occurs at the solution " mOne) - (" = 0 " " Printing only if an input parameter is incorrect " mZero) - (" < 0 " " No printing " mMinus)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of variables, {\it n}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 7 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of general linear constraints, {\it nclin}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 7 nclin PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "First dimension of array {\it a}, {\it nrowa}:") - (text . "\newline\tab{2} ") - (bcStrings (6 7 nrowa PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Specifies whether or not a linear objective function is present, {\it linobj}:") - (radioButtons linobj - ("" " true - full LP problem is solved" true) - ("" " false - only a feasible problem is found" false)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Dimension of {\it iwork}, {\it liwork}:") - (text . "\newline\tab{2} ") - (bcStrings (5 14 liwork F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of {\it work}, {\it lwork}:") - (text . "\newline\tab{2} ") - (bcStrings (5 182 lwork F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e04mbfSolve) - htShowPage() - -e04mbfSolve htPage == - itmax := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'itmax) - objValUnwrap htpLabelSpadValue(htPage, 'itmax) - msg := htpButtonValue(htPage,'msglvl) - msglvl := - msg = 'mMinus => '-1 - msg = 'mZero => '0 - '1 - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - nclin := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nclin) - objValUnwrap htpLabelSpadValue(htPage, 'nclin) - nrowa := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrowa) - objValUnwrap htpLabelSpadValue(htPage, 'nrowa) - lin := htpButtonValue(htPage,'linobj) - linobj := - lin = 'true => '"true" - '"false" - liwork := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'liwork) - objValUnwrap htpLabelSpadValue(htPage, 'liwork) - lwork := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lwork) - objValUnwrap htpLabelSpadValue(htPage, 'lwork) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - ((nrowa = '7 and n = 7) and nclin = 7) => e04mbfDefaultSolve(htPage,itmax,msglvl,linobj,liwork,lwork,ifail) - aList := - "append"/[fa(i,n) for i in 1..nrowa] where fa(i,n) == - labelList := - "append"/[fb(i,j) for j in 1..n] where fb(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[8, 0, anam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter lower boundary ") - middle := STRCONC(middle,'"conditions {\it bl(n + nclin)}: \newline ") - blList := - "append"/[fc(i) for i in 1..(n+nclin)] where fc(i) == - blnam := INTERN STRCONC ('"bl",STRINGIMAGE i) - [['bcStrings,[8, '"0.0", blnam, 'F]]] - blList := [['text,:middle],:blList] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter upper boundary ") - middle := STRCONC(middle,'"conditions {\it bu(n+nclin)}: \newline ") - buList := - "append"/[fd(i) for i in 1..(n+nclin)] where fd(i) == - bunam := INTERN STRCONC ('"bu",STRINGIMAGE i) - [['bcStrings,[8, '"0.0", bunam, 'F]]] - buList := [['text,:middle],:buList] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter coefficients of the ") - middle := STRCONC(middle,'"objective function {\it cvec(n)}: \newline ") - cList := - "append"/[fe(i) for i in 1..n] where fe(i) == - cnam := INTERN STRCONC ('"c",STRINGIMAGE i) - [['bcStrings,[8, '"0.0", cnam, 'F]]] - cList := [['text,:middle],:cList] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ") - middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ") - xList := - "append"/[fg(i) for i in 1..n] where fg(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[8, '"0.0", xnam, 'F]]] - xList := [['text,:middle],:xList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))), - :aList,:blList,:buList,:cList,:xList] - page:= htInitPage('"E04MBF - Linear programming problem",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the elements of the array {\it a(nrowa,n)}: \newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'e04mbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nclin,nclin) - htpSetProperty(page,'nrowa,nrowa) - htpSetProperty(page,'itmax,itmax) - htpSetProperty(page,'msglvl,msglvl) - htpSetProperty(page,'linobj,linobj) - htpSetProperty(page,'liwork,liwork) - htpSetProperty(page,'lwork,lwork) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e04mbfDefaultSolve(htPage,itmax,msglvl,linobj,liwork,lwork,ifail) == - n := '7 - nclin := '7 - nrowa := '7 - page:= htInitPage('"E04MBF - Linear programming problem",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the elements of array {\it a(nrowa,n)}: \newline ") - (bcStrings (5 "1" a11 F)) - (bcStrings (5 "1" a12 F)) - (bcStrings (5 "1" a13 F)) - (bcStrings (5 "1" a14 F)) - (bcStrings (5 "1" a15 F)) - (bcStrings (5 "1" a16 F)) - (bcStrings (5 "1" a17 F)) - (text . "\newline ") - (bcStrings (5 "0.15" a21 F)) - (bcStrings (5 "0.04" a22 F)) - (bcStrings (5 "0.02" a23 F)) - (bcStrings (5 "0.04" a24 F)) - (bcStrings (5 "0.02" a25 F)) - (bcStrings (5 "0.01" a26 F)) - (bcStrings (5 "0.03" a27 F)) - (text . "\newline ") - (bcStrings (5 "0.03" a31 F)) - (bcStrings (5 "0.05" a32 F)) - (bcStrings (5 "0.08" a33 F)) - (bcStrings (5 "0.02" a34 F)) - (bcStrings (5 "0.06" a35 F)) - (bcStrings (5 "0.01" a36 F)) - (bcStrings (5 "0" a37 F)) - (text . "\newline ") - (bcStrings (5 "0.02" a41 F)) - (bcStrings (5 "0.04" a42 F)) - (bcStrings (5 "0.01" a43 F)) - (bcStrings (5 "0.02" a44 F)) - (bcStrings (5 "0.02" a45 F)) - (bcStrings (5 "0" a46 F)) - (bcStrings (5 "0" a47 F)) - (text . "\newline ") - (bcStrings (5 "0.02" a51 F)) - (bcStrings (5 "0.03" a52 F)) - (bcStrings (5 "0" a53 F)) - (bcStrings (5 "0" a54 F)) - (bcStrings (5 "0.01" a55 F)) - (bcStrings (5 "0" a56 F)) - (bcStrings (5 "0" a57 F)) - (text . "\newline ") - (bcStrings (5 "0.7" a61 F)) - (bcStrings (5 "0.75" a62 F)) - (bcStrings (5 "0.8" a63 F)) - (bcStrings (5 "0.75" a64 F)) - (bcStrings (5 "0.8" a65 F)) - (bcStrings (5 "0.97" a66 F)) - (bcStrings (5 "0" a67 F)) - (text . "\newline ") - (bcStrings (5 "0.02" a71 F)) - (bcStrings (5 "0.06" a72 F)) - (bcStrings (5 "0.08" a73 F)) - (bcStrings (5 "0.12" a74 F)) - (bcStrings (5 "0.02" a75 F)) - (bcStrings (5 "0.01" a76 F)) - (bcStrings (5 "0.97" a77 F)) - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter lower boundary conditions {\it bl(n+nclin)}: \newline ") - (bcStrings (8 "-0.01" bl1 F)) - (bcStrings (8 "-0.1" bl2 F)) - (bcStrings (8 "-0.01" bl3 F)) - (bcStrings (8 "-0.04" bl4 F)) - (bcStrings (8 "-0.1" bl5 F)) - (bcStrings (8 "-0.01" bl6 F)) - (bcStrings (8 "-0.01" bl7 F)) - (bcStrings (8 "-0.13" bl8 F)) - (bcStrings (8 "-1.0e+21" bl9 F)) - (bcStrings (8 "-1.0e+21" bl10 F)) - (bcStrings (8 "-1.0e+21" bl11 F)) - (bcStrings (8 "-1.0e+21" bl12 F)) - (bcStrings (8 "-0.0992" bl13 F)) - (bcStrings (8 "-0.003" bl14 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter upper boundary conditions {\it bu(n+nclin)}: \newline ") - (bcStrings (8 "0.01" bu1 F)) - (bcStrings (8 "0.15" bu2 F)) - (bcStrings (8 "0.03" bu3 F)) - (bcStrings (8 "0.02" bu4 F)) - (bcStrings (8 "0.05" bu5 F)) - (bcStrings (8 "1.0e+21" bu6 F)) - (bcStrings (8 "1.0e+21" bu7 F)) - (bcStrings (8 "-0.13" bu8 F)) - (bcStrings (8 "-0.0049" bu9 F)) - (bcStrings (8 "-0.0064" bu10 F)) - (bcStrings (8 "-0.0037" bu11 F)) - (bcStrings (8 "-0.0012" bu12 F)) - (bcStrings (8 "1.0e+21" bu13 F)) - (bcStrings (8 "0.002" bu14 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter coefficients of the objective function, {\it cvec(n)}: ") - (text . "\newline ") - (bcStrings (8 "-0.02" c1 F)) - (bcStrings (8 "-0.2" c2 F)) - (bcStrings (8 "-0.2" c3 F)) - (bcStrings (8 "-0.2" c4 F)) - (bcStrings (8 "-0.2" c5 F)) - (bcStrings (8 "0.04" c6 F)) - (bcStrings (8 "0.04" c7 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter initial guess of the solution vector, {\it x(n)}: ") - (text . "\newline ") - (bcStrings (8 "-0.01" x1 F)) - (bcStrings (8 "-0.03" x2 F)) - (bcStrings (8 "0.0" x3 F)) - (bcStrings (8 "-0.01" x4 F)) - (bcStrings (8 "-0.1" x5 F)) - (bcStrings (8 "0.02" x6 F)) - (bcStrings (8 "0.01" x7 F))) - htMakeDoneButton('"Continue",'e04mbfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nclin,nclin) - htpSetProperty(page,'nrowa,nrowa) - htpSetProperty(page,'itmax,itmax) - htpSetProperty(page,'msglvl,msglvl) - htpSetProperty(page,'linobj,linobj) - htpSetProperty(page,'liwork,liwork) - htpSetProperty(page,'lwork,lwork) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e04mbfGen htPage == - n := htpProperty(htPage, 'n) - nclin := htpProperty(htPage, 'nclin) - nrowa := htpProperty(htPage, 'nrowa) - itmax := htpProperty(htPage, 'itmax) - msglvl := htpProperty(htPage, 'msglvl) - linobj := htpProperty(htPage, 'linobj) - liwork := htpProperty(htPage,'liwork) - lwork := htpProperty(htPage,'lwork) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..n repeat - temp := STRCONC ((first y).1," ") - xlist := [temp,:xlist] - y := rest y - xstring := bcwords2liststring xlist - for i in 1..n repeat - temp := STRCONC ((first y).1," ") - clist := [temp,:clist] - y := rest y - cstring := bcwords2liststring clist - for i in 1..(n+nclin) repeat - temp := STRCONC ((first y).1," ") - bulist := [temp,:bulist] - y := rest y - bustring := bcwords2liststring bulist - for i in 1..(n+nclin) repeat - temp := STRCONC ((first y).1," ") - bllist := [temp,:bllist] - y := rest y - blstring := bcwords2liststring bllist - for i in 1..nrowa repeat -- matrix A - for j in 1..n repeat - a := STRCONC((first y).1," ") - arrlist := [a,:arrlist] - y := rest y - amatlist := [:amatlist,arrlist] - arrlist := [] - amatlist := reverse amatlist - amatstr := bcwords2liststring [bcwords2liststring x for x in amatlist] - nctotl := n + nclin - prefix := STRCONC("e04mbf(",STRINGIMAGE itmax,",", STRINGIMAGE msglvl,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,",",STRINGIMAGE nclin,", ") - prefix := STRCONC(prefix,STRINGIMAGE nctotl,",",STRINGIMAGE nrowa,", ") - middle := STRCONC(amatstr,",[") - middle := STRCONC(middle,blstring,"],[",bustring,"],[",cstring) - middle := STRCONC(middle,"],",linobj,", ",STRINGIMAGE liwork) - middle := STRCONC(middle,",",STRINGIMAGE lwork,",[") - middle := STRCONC(middle,xstring,"],",STRINGIMAGE ifail,")") - linkGen STRCONC(prefix,middle) - - - -e04naf() == - htInitPage('"E04NAF - Quadratic programming problem",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXe04naf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04naf| '|NagOptimisationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "E04NAF is a comprehensive routine to solve quadratic problems ") - (text . "(QP) of the form \center{\htbitmap{e04naf}} \newline ") - (text . "where {\it c} is a constant {\it n} element vector, {\it H} is a") - (text . " constant {\it n} by {\it n} symmetric matrix, and the matrix ") - (text . "{\it A} is {\it m} by {\it n}, i.e. there are {\it n} variables ") - (text . "and {\it m} general linear constraints. {\it m} may be zero in ") - (text . "which case the LP problem is subject only to bounds on the ") - (text . "variables. \blankline If {\it H} = 0 a flag can be set so that ") - (text . "the problem is treated as a linear programming (LP) problem. ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Upper bound on number of iterations, {\it itmax}:") - (text . "\newline\tab{2} ") - (bcStrings (6 20 itmax PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Type of output messages required, {\it msglvl}: ") - (radioButtons msglvl - (" < 0 " " No printing " mMinus) - (" = 0 " " Printing only if an input parameter is incorrect or overflow is likely" mZero) - (" = 1" " Printing occurs at the solution " mOne) - (" = 5" " One line of output for each constraint addition or deletion, no printout" mFive) - (" \htbitmap{great=} 10" " As above with printout of the solution" mTen) - (" \htbitmap{great=} 15" " As above with X, ISTATE and indices of free variables at each iteration" mFifteen) - (" \htbitmap{great=} 20" " As above with the Lagrange multiplier estimates and the free variables at each iteration" mTwenty) - (" \htbitmap{great=} 30" " As above with the diagonal elements of the matrix {\it T} associated with the {\it TQ} factorization of the working set, and the diagonal elements of the Cholesky factor {\it R} of the projected Hessian" mThirty) - (" \htbitmap{great=} 80" " As above with debug printout" mEighty) - (" = 99" " As above with arrays {\it cvec} and {\it hess}" mNinetyNine)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of variables, {\it n}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 7 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of general linear constraints, {\it nclin}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 7 nclin PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "First dimension of array {\it a}, {\it nrowa}:") - (text . "\newline\tab{2} ") - (bcStrings (6 7 nrowa PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "First dimension of array {\it hess}, {\it nrowh}:") - (text . "\newline\tab{2} ") - (bcStrings (6 7 nrowh PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Second dimension of array {\it hess}, {\it ncolh}:") - (text . "\newline\tab{2} ") - (bcStrings (6 7 ncolh PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Size above which a bound is regarded as infinite, {\it bigbnd}:") - (text . "\newline\tab{2} ") - (bcStrings (10 "1.0e10" bigbnd F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Specifies whether or not an initial estimate of the active constraints is present, {\it cold}:") - (radioButtons cold - ("" " true - E04NAF determines the initial working set" cTrue) - ("" " false - user defined contents of array {\it istate}" cFalse)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Specifies whether or not {\it h} is a zero matrix, {\it lp}:") - (radioButtons lp - ("" " false - QP problem " lFalse) - ("" " true - LP problem, {\it hess} and {\it qphess} are not referenced " lTrue)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Specifies whether or not orthogonal transformations are to be used in computing and updating the working set, {\it orthog}:") - (radioButtons orthog - ("" " true " oTrue) - ("" " false " oFalse)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Dimension of {\it iwork}, {\it liwork}:") - (text . "\newline\tab{2} ") - (bcStrings (5 14 liwork F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Dimension of {\it work}, {\it lwork}:") - (text . "\newline\tab{2} ") - (bcStrings (5 238 lwork F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e04nafSolve) - htShowPage() - -e04nafSolve htPage == - itmax := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'itmax) - objValUnwrap htpLabelSpadValue(htPage, 'itmax) - msg := htpButtonValue(htPage,'msglvl) - msglvl := - msg = 'mMinus => '-1 - msg = 'mZero => '0 - msg = 'mOne => '1 - msg = 'mFive => '5 - msg = 'mTen => '10 - msg = 'mFifteen => '15 - msg = 'mTwenty => '20 - msg = 'mThirty => '30 - msg = 'mEighty => '80 - '99 - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - nclin := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nclin) - objValUnwrap htpLabelSpadValue(htPage, 'nclin) - nrowa := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrowa) - objValUnwrap htpLabelSpadValue(htPage, 'nrowa) - nrowh := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrowh) - objValUnwrap htpLabelSpadValue(htPage, 'nrowh) - ncolh := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolh) - objValUnwrap htpLabelSpadValue(htPage, 'ncolh) - bigbnd := htpLabelInputString(htPage,'bigbnd) - col := htpButtonValue(htPage,'cold) - cold := - col = 'cTrue => '"true" - '"false" - linear := htpButtonValue(htPage,'lp) - lp := - linear = 'lTrue => '"true" - '"false" - ortho := htpButtonValue(htPage,'orthog) - orthog := - ortho = 'oTrue => '"true" - '"false" - liwork := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'liwork) - objValUnwrap htpLabelSpadValue(htPage, 'liwork) - lwork := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lwork) - objValUnwrap htpLabelSpadValue(htPage, 'lwork) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (((nrowa = '7 and n = '7) and (nrowh = '7 and ncolh ='7)) and nclin = '7) => - e04nafDefaultSolve(htPage,itmax,msglvl,bigbnd,cold,lp,orthog,liwork,lwork,ifail) - aList := - "append"/[fa(i,n) for i in 1..nrowa] where fa(i,n) == - labelList := - "append"/[fb(i,j) for j in 1..n] where fb(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[8, 0, anam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter lower boundary ") - middle := STRCONC(middle,'"conditions {\it bl(n + nclin)}: \newline ") - blList := - "append"/[fc(i) for i in 1..(n+nclin)] where fc(i) == - blnam := INTERN STRCONC ('"bl",STRINGIMAGE i) - [['bcStrings,[8, '"0.0", blnam, 'F]]] - blList := [['text,:middle],:blList] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter upper boundary ") - middle := STRCONC(middle,'"conditions {\it bu(n+nclin)}: \newline ") - buList := - "append"/[fd(i) for i in 1..(n+nclin)] where fd(i) == - bunam := INTERN STRCONC ('"bu",STRINGIMAGE i) - [['bcStrings,[8, '"0.0", bunam, 'F]]] - buList := [['text,:middle],:buList] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter coefficients of the ") - middle := STRCONC(middle,'"objective function {\it cvec(n)}: \newline ") - cList := - "append"/[fe(i) for i in 1..n] where fe(i) == - cnam := INTERN STRCONC ('"c",STRINGIMAGE i) - [['bcStrings,[8, '"0.0", cnam, 'F]]] - cList := [['text,:middle],:cList] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter set of positive ") - middle := STRCONC(middle,'"tolerances {\it featol(n+nclin)}: \newline ") - fList := - "append"/[ff(i) for i in 1..(n+nclin)] where ff(i) == - fnam := INTERN STRCONC ('"f",STRINGIMAGE i) - [['bcStrings,[9, '"0.1053e-7", fnam, 'F]]] - fList := [['text,:middle],:fList] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter the elements of ") - middle := STRCONC(middle,'"array {\it hess(nrowh,ncolh)}: \newline ") - hList := - "append"/[fh(i,n) for i in 1..nrowh] where fh(i,n) == - labelList := - "append"/[fi(i,j) for j in 1..n] where fi(i,j) == - hnam := INTERN STRCONC ('"h",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[8, 0, hnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - hList := [['text,:middle],:hList] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ") - middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ") - xList := - "append"/[fg(i) for i in 1..n] where fg(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[8, '"0.0", xnam, 'F]]] - xList := [['text,:middle],:xList] - middle := ('"\blankline \menuitemstyle{}\tab{2} If {\it cold} = false ") - middle := STRCONC(middle,'"enter {\it istate(n+nclin)} values: \newline ") - iList := - "append"/[fj(i) for i in 1..(n+nclin)] where fj(i) == - inam := INTERN STRCONC ('"i",STRINGIMAGE i) - [['bcStrings,[8, '"0.0", inam, 'F]]] - iList := [['text,:middle],:iList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))), - :aList,:blList,:buList,:cList,:fList,:hList,:xList,:iList] - page:= htInitPage('"E04NAF - Quadratic programming problem",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the elements of the array {\it a(nrowa,n)}: \newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'e04nafGen) - htpSetProperty(page,'itmax,itmax) - htpSetProperty(page,'msglvl,msglvl) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nclin,nclin) - htpSetProperty(page,'nrowa,nrowa) - htpSetProperty(page,'nrowh,nrowh) - htpSetProperty(page,'ncolh,ncolh) - htpSetProperty(page,'bigbnd,bigbnd) - htpSetProperty(page,'cold,cold) - htpSetProperty(page,'lp,lp) - htpSetProperty(page,'orthog,orthog) - htpSetProperty(page,'liwork,liwork) - htpSetProperty(page,'lwork,lwork) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e04nafDefaultSolve(htPage,itmax,msglvl,bigbnd,cold,lp,orthog,liwork,lwork,ifail) == - n := '7 - nclin := '7 - nrowa := '7 - nrowh := '7 - ncolh := '7 - page:= htInitPage('"E04NAF - Quadratic programming problem",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the elements of array {\it a(nrowa,n)}: \newline ") - (bcStrings (5 "1" a11 F)) - (bcStrings (5 "1" a12 F)) - (bcStrings (5 "1" a13 F)) - (bcStrings (5 "1" a14 F)) - (bcStrings (5 "1" a15 F)) - (bcStrings (5 "1" a16 F)) - (bcStrings (5 "1" a17 F)) - (text . "\newline ") - (bcStrings (5 "0.15" a21 F)) - (bcStrings (5 "0.04" a22 F)) - (bcStrings (5 "0.02" a23 F)) - (bcStrings (5 "0.04" a24 F)) - (bcStrings (5 "0.02" a25 F)) - (bcStrings (5 "0.01" a26 F)) - (bcStrings (5 "0.03" a27 F)) - (text . "\newline ") - (bcStrings (5 "0.03" a31 F)) - (bcStrings (5 "0.05" a32 F)) - (bcStrings (5 "0.08" a33 F)) - (bcStrings (5 "0.02" a34 F)) - (bcStrings (5 "0.06" a35 F)) - (bcStrings (5 "0.01" a36 F)) - (bcStrings (5 "0" a37 F)) - (text . "\newline ") - (bcStrings (5 "0.02" a41 F)) - (bcStrings (5 "0.04" a42 F)) - (bcStrings (5 "0.01" a43 F)) - (bcStrings (5 "0.02" a44 F)) - (bcStrings (5 "0.02" a45 F)) - (bcStrings (5 "0" a46 F)) - (bcStrings (5 "0" a47 F)) - (text . "\newline ") - (bcStrings (5 "0.02" a51 F)) - (bcStrings (5 "0.03" a52 F)) - (bcStrings (5 "0" a53 F)) - (bcStrings (5 "0" a54 F)) - (bcStrings (5 "0.01" a55 F)) - (bcStrings (5 "0" a56 F)) - (bcStrings (5 "0" a57 F)) - (text . "\newline ") - (bcStrings (5 "0.7" a61 F)) - (bcStrings (5 "0.75" a62 F)) - (bcStrings (5 "0.8" a63 F)) - (bcStrings (5 "0.75" a64 F)) - (bcStrings (5 "0.8" a65 F)) - (bcStrings (5 "0.97" a66 F)) - (bcStrings (5 "0" a67 F)) - (text . "\newline ") - (bcStrings (5 "0.02" a71 F)) - (bcStrings (5 "0.06" a72 F)) - (bcStrings (5 "0.08" a73 F)) - (bcStrings (5 "0.12" a74 F)) - (bcStrings (5 "0.02" a75 F)) - (bcStrings (5 "0.01" a76 F)) - (bcStrings (5 "0.97" a77 F)) - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter lower boundary conditions {\it bl(n+nclin)}: \newline ") - (bcStrings (8 "-0.01" bl1 F)) - (bcStrings (8 "-0.1" bl2 F)) - (bcStrings (8 "-0.01" bl3 F)) - (bcStrings (8 "-0.04" bl4 F)) - (bcStrings (8 "-0.1" bl5 F)) - (bcStrings (8 "-0.01" bl6 F)) - (bcStrings (8 "-0.01" bl7 F)) - (bcStrings (8 "-0.13" bl8 F)) - (bcStrings (8 "-1.0e+21" bl9 F)) - (bcStrings (8 "-1.0e+21" bl10 F)) - (bcStrings (8 "-1.0e+21" bl11 F)) - (bcStrings (8 "-1.0e+21" bl12 F)) - (bcStrings (8 "-0.0992" bl13 F)) - (bcStrings (8 "-0.003" bl14 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter upper boundary conditions {\it bu(n+nclin)}: \newline ") - (bcStrings (8 "0.01" bu1 F)) - (bcStrings (8 "0.15" bu2 F)) - (bcStrings (8 "0.03" bu3 F)) - (bcStrings (8 "0.02" bu4 F)) - (bcStrings (8 "0.05" bu5 F)) - (bcStrings (8 "1.0e+21" bu6 F)) - (bcStrings (8 "1.0e+21" bu7 F)) - (bcStrings (8 "-0.13" bu8 F)) - (bcStrings (8 "-0.0049" bu9 F)) - (bcStrings (8 "-0.0064" bu10 F)) - (bcStrings (8 "-0.0037" bu11 F)) - (bcStrings (8 "-0.0012" bu12 F)) - (bcStrings (8 "1.0e+21" bu13 F)) - (bcStrings (8 "0.002" bu14 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter coefficients of the objective function, {\it cvec(n)}: ") - (text . "\newline ") - (bcStrings (8 "-0.02" c1 F)) - (bcStrings (8 "-0.2" c2 F)) - (bcStrings (8 "-0.2" c3 F)) - (bcStrings (8 "-0.2" c4 F)) - (bcStrings (8 "-0.2" c5 F)) - (bcStrings (8 "0.04" c6 F)) - (bcStrings (8 "0.04" c7 F)) - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter set of positive tolerances {\it featol(n+nclin)}:\newline ") - (bcStrings (9 "0.1053e-7" f1 F)) - (bcStrings (9 "0.1053e-7" f2 F)) - (bcStrings (9 "0.1053e-7" f3 F)) - (bcStrings (9 "0.1053e-7" f4 F)) - (bcStrings (9 "0.1053e-7" f5 F)) - (bcStrings (9 "0.1053e-7" f6 F)) - (bcStrings (9 "0.1053e-7" f7 F)) - (bcStrings (9 "0.1053e-7" f8 F)) - (bcStrings (9 "0.1053e-7" f9 F)) - (bcStrings (9 "0.1053e-7" f10 F)) - (bcStrings (9 "0.1053e-7" f11 F)) - (bcStrings (9 "0.1053e-7" f12 F)) - (bcStrings (9 "0.1053e-7" f13 F)) - (bcStrings (9 "0.1053e-7" f14 F)) - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the elements of array {\it hess(nrowh,ncolh)}: \newline ") - (bcStrings (5 "2" h11 F)) - (bcStrings (5 "0" h12 F)) - (bcStrings (5 "0" h13 F)) - (bcStrings (5 "0" h14 F)) - (bcStrings (5 "0" h15 F)) - (bcStrings (5 "0" h16 F)) - (bcStrings (5 "0" h17 F)) - (text . "\newline ") - (bcStrings (5 "0" h21 F)) - (bcStrings (5 "2" h22 F)) - (bcStrings (5 "0" h23 F)) - (bcStrings (5 "0" h24 F)) - (bcStrings (5 "0" h25 F)) - (bcStrings (5 "0" h26 F)) - (bcStrings (5 "0" h27 F)) - (text . "\newline ") - (bcStrings (5 "0" h31 F)) - (bcStrings (5 "0" h32 F)) - (bcStrings (5 "2" h33 F)) - (bcStrings (5 "2" h34 F)) - (bcStrings (5 "0" h35 F)) - (bcStrings (5 "0" h36 F)) - (bcStrings (5 "0" h37 F)) - (text . "\newline ") - (bcStrings (5 "0" h41 F)) - (bcStrings (5 "0" h42 F)) - (bcStrings (5 "2" h43 F)) - (bcStrings (5 "2" h44 F)) - (bcStrings (5 "0" h45 F)) - (bcStrings (5 "0" h46 F)) - (bcStrings (5 "0" h47 F)) - (text . "\newline ") - (bcStrings (5 "0" h51 F)) - (bcStrings (5 "0" h52 F)) - (bcStrings (5 "0" h53 F)) - (bcStrings (5 "0" h54 F)) - (bcStrings (5 "2" h55 F)) - (bcStrings (5 "0" h56 F)) - (bcStrings (5 "0" h57 F)) - (text . "\newline ") - (bcStrings (5 "0" h61 F)) - (bcStrings (5 "0" h62 F)) - (bcStrings (5 "0" h63 F)) - (bcStrings (5 "0" h64 F)) - (bcStrings (5 "0" h65 F)) - (bcStrings (5 "-2" h66 F)) - (bcStrings (5 "-2" h67 F)) - (text . "\newline ") - (bcStrings (5 "0" h71 F)) - (bcStrings (5 "0" h72 F)) - (bcStrings (5 "0" h73 F)) - (bcStrings (5 "0" h74 F)) - (bcStrings (5 "0" h75 F)) - (bcStrings (5 "-2" h76 F)) - (bcStrings (5 "-2" h77 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter initial guess of the solution vector, {\it x(n)}: ") - (text . "\newline ") - (bcStrings (8 "-0.01" x1 F)) - (bcStrings (8 "-0.03" x2 F)) - (bcStrings (8 "0.0" x3 F)) - (bcStrings (8 "-0.01" x4 F)) - (bcStrings (8 "-0.1" x5 F)) - (bcStrings (8 "0.02" x6 F)) - (bcStrings (8 "0.01" x7 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "If {\it cold} = false enter {\it istate(n+nclin)} values: ") - (text . "\newline ") - (bcStrings (8 "0" i1 F)) - (bcStrings (8 "0" i2 F)) - (bcStrings (8 "0" i3 F)) - (bcStrings (8 "0" i4 F)) - (bcStrings (8 "0" i5 F)) - (bcStrings (8 "0" i6 F)) - (bcStrings (8 "0" i7 F)) - (bcStrings (8 "0" i8 F)) - (bcStrings (8 "0" i9 F)) - (bcStrings (8 "0" i10 F)) - (bcStrings (8 "0" i11 F)) - (bcStrings (8 "0" i12 F)) - (bcStrings (8 "0" i13 F)) - (bcStrings (8 "0" i14 F))) - htMakeDoneButton('"Continue",'e04nafGen) - htpSetProperty(page,'itmax,itmax) - htpSetProperty(page,'msglvl,msglvl) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nclin,nclin) - htpSetProperty(page,'nrowa,nrowa) - htpSetProperty(page,'nrowh,nrowh) - htpSetProperty(page,'ncolh,ncolh) - htpSetProperty(page,'bigbnd,bigbnd) - htpSetProperty(page,'cold,cold) - htpSetProperty(page,'lp,lp) - htpSetProperty(page,'orthog,orthog) - htpSetProperty(page,'liwork,liwork) - htpSetProperty(page,'lwork,lwork) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e04nafGen htPage == - itmax := htpProperty(htPage, 'itmax) - msglvl := htpProperty(htPage, 'msglvl) - n := htpProperty(htPage, 'n) - nclin := htpProperty(htPage, 'nclin) - nrowa := htpProperty(htPage, 'nrowa) - nrowh := htpProperty(htPage, 'nrowh) - ncolh := htpProperty(htPage, 'ncolh) - bigbnd := htpProperty(htPage, 'bigbnd) - cold := htpProperty(htPage, 'cold) - lp := htpProperty(htPage, 'lp) - orthog := htpProperty(htPage, 'orthog) - liwork := htpProperty(htPage,'liwork) - lwork := htpProperty(htPage,'lwork) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..(n+nclin) repeat - temp := STRCONC ((first y).1," ") - ilist := [temp,:ilist] - y := rest y - istring := bcwords2liststring ilist - for i in 1..n repeat - temp := STRCONC ((first y).1," ") - xlist := [temp,:xlist] - y := rest y - xstring := bcwords2liststring xlist - for i in 1..nrowh repeat -- matrix H - for j in 1..ncolh repeat - h := STRCONC((first y).1," ") - hlist := [h,:hlist] - y := rest y - hmatlist := [:hmatlist,hlist] - hlist := [] - hmatlist := reverse hmatlist - hmatstr := bcwords2liststring [bcwords2liststring x for x in hmatlist] - for i in 1..(n+nclin) repeat - temp := STRCONC ((first y).1," ") - flist := [temp,:flist] - y := rest y - fstring := bcwords2liststring flist - for i in 1..n repeat - temp := STRCONC ((first y).1," ") - clist := [temp,:clist] - y := rest y - cstring := bcwords2liststring clist - for i in 1..(n+nclin) repeat - temp := STRCONC ((first y).1," ") - bulist := [temp,:bulist] - y := rest y - bustring := bcwords2liststring bulist - for i in 1..(n+nclin) repeat - temp := STRCONC ((first y).1," ") - bllist := [temp,:bllist] - y := rest y - blstring := bcwords2liststring bllist - for i in 1..nrowa repeat -- matrix A - for j in 1..n repeat - a := STRCONC((first y).1," ") - arrlist := [a,:arrlist] - y := rest y - amatlist := [:amatlist,arrlist] - arrlist := [] - amatlist := reverse amatlist - amatstr := bcwords2liststring [bcwords2liststring x for x in amatlist] - nctotl := n + nclin - prefix := STRCONC("e04naf(",STRINGIMAGE itmax,",", STRINGIMAGE msglvl,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,",",STRINGIMAGE nclin,", ") - prefix := STRCONC(prefix,STRINGIMAGE nctotl,",",STRINGIMAGE nrowa,", ") - prefix := STRCONC(prefix,STRINGIMAGE nrowh,",",STRINGIMAGE ncolh,", ",bigbnd) - middle := STRCONC(", ",amatstr,",[") - middle := STRCONC(middle,blstring,"],[",bustring,"],[",cstring) - middle := STRCONC(middle,"],[",fstring,"],",hmatstr,",",STRINGIMAGE cold,",") - middle := STRCONC(middle,STRINGIMAGE lp,", ",STRINGIMAGE orthog,", ") - middle := STRCONC(middle,STRINGIMAGE liwork,",",STRINGIMAGE lwork,",[") - middle := STRCONC(middle,xstring,"],[",istring,"]::Matrix Integer,") - middle := STRCONC(middle,STRINGIMAGE ifail) - end := STRCONC(",((",hmatstr,")::Matrix Expression Float)::ASP20('QPHESS))") - linkGen STRCONC(prefix,middle,end) - -e04ucf() == - htInitPage('"E04UCF - Minimum, function of several variables, sequential QP method, nonlinear constraints, using function values and optionally 1st derivatives", nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXe04ucf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04ucf| '|NagOptimisationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "E04UCF minimizes an arbitrary smooth function subject to ") - (text . "constraints which may include simple bounds on the variables, ") - (text . "linear constraints and smooth nonlinear constraints. As many ") - (text . "first partial derivatives as possible should be supplied by the ") - (text . "user, unspecified derivatives being estimated by finite ") - (text . "differences. \newline The routine solves problems of the form") - (text . "\center{\htbitmap{e04ucf}}\newline where the objective function ") - (text . "{\it F(x)} is nonlinear, \htbitmap{al} is an \htbitmap{nl} by n ") - (text . "constant matrix and {\it c(x)} is an \htbitmap{nn} element ") - (text . "vector of nonlinear constraint functions. The objective function") - (text . " and constraint functions are assumed to be smooth (i.e. at ") - (text . "least twice continuously differentiable), although the method ") - (text . "will usually work if there are discontinuities away from the ") - (text . "solution. \blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the number of variables, {\it n}: ") - (text . "\newline ") - (bcStrings (5 4 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the number of general linear constraints, {\it nclin}: ") - (text . "\newline ") - (bcStrings (5 1 nclin PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Enter the number of nonlinear constraints, {\it ncnln}: ") - (text . "\newline ") - (bcStrings (5 2 ncnln PI)) - (text . "\blankline ") - (text . "Change optional parameters:") - (radioButtons optional - ("" " No" no) - ("" " Yes" yes)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Start value:") - (radioButtons start - ("" " Cold start" false) - ("" " Warm start" true)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e04ucfSolve) - htShowPage() - - -e04ucfSolve(htPage) == - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - nclin := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nclin) - objValUnwrap htpLabelSpadValue(htPage, 'nclin) - ncnln := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncnln) - objValUnwrap htpLabelSpadValue(htPage, 'ncnln) - nrowa := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nclin) - objValUnwrap htpLabelSpadValue(htPage, 'nrowa) - nrowj := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncnln) - objValUnwrap htpLabelSpadValue(htPage, 'nrowj) - nrowr := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'nrowr) - liwork := 3*n+nclin+2*ncnln - lwork := - (ncnln = '0 and nclin = '0) => 20*n - (ncnln = '0 and nclin > '0) => 2*n*n + 20*n + 11*nclin - (ncnln > '0 and nclin >= '0) => 2*n*n + n*nclin +2*n*ncnln + 20*n + 11*nclin + 21*ncnln - '1 - initial := htpButtonValue(htPage,'start) - start := - initial = 'true => '1 - '0 - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - param := htpButtonValue(htPage,'optional) - optional := - param = 'no => '0 - '1 - ((n = '4 and optional = '0 and nclin=1 and ncnln=2) and (start = '0)) => - e04ucfDefaultSolve(htPage,nclin,ncnln,nrowa,nrowj,nrowr,liwork,lwork,ifail) - start = '1 => e04ucfCopOut() - optional := '1 - aList := - "append"/[fa(i,n) for i in 1..nrowa] where fa(i,n) == - labelList := - "append"/[fb(i,j) for j in 1..n] where fb(i,j) == - anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[8, 0, anam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter lower boundary ") - middle := STRCONC(middle,'"conditions {\it bl(n+nclin+ncnln)}: \newline ") - blList := - "append"/[fc(i) for i in 1..(n+nclin+ncnln)] where fc(i) == - blnam := INTERN STRCONC ('"bl",STRINGIMAGE i) - [['bcStrings,[8, '"-1.E25", blnam, 'F]]] - blList := [['text,:middle],:blList] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter upper boundary ") - middle := STRCONC(middle,'"conditions {\it bu(n+nclin+ncnln)}: \newline ") - buList := - "append"/[fd(i) for i in 1..(n+nclin+ncnln)] where fd(i) == - bunam := INTERN STRCONC ('"bu",STRINGIMAGE i) - [['bcStrings,[8, '"1.E25", bunam, 'F]]] - buList := [['text,:middle],:buList] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter the nonlinear ") - middle := STRCONC(middle,'"constraint functions {\it c(ncnln)} ") - middle := STRCONC(middle,'"in terms of X[1]...X[n]: \newline ") - cList := - "append"/[fe(i) for i in 1..ncnln] where fe(i) == - lineEnd := ('"\newline \tab{2} ") - cnam := INTERN STRCONC ('"c",STRINGIMAGE i) - [['text,:lineEnd],['bcStrings,[55, '"X[1]", cnam, 'F]]] - cList := [['text,:middle],:cList] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter the objective ") - middle := STRCONC(middle,'"function, {\it F(x)} ") - middle := STRCONC(middle,'"in terms of X[1]...X[n]: \newline ") - funcList := [['bcStrings,[55, '"X[1]", 'f, 'EM]]] - funcList := [['text,:middle],:funcList] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ") - middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ") - xList := - "append"/[fg(i) for i in 1..n] where fg(i) == - xnam := INTERN STRCONC ('"x",STRINGIMAGE i) - [['bcStrings,[8, '"0.0", xnam, 'F]]] - xList := [['text,:middle],:xList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))), - :aList,:blList,:buList,:cList,:funcList,:xList, - :'( - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Crash tolerance, {\it cra}: ") - (text . "\newline ") - (bcStrings (20 "0.01" cra F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Derivative level, {\it der}: ") - (text . "\newline ") - (bcStrings (5 3 der PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Feasibility tolerance, {\it fea}: ") - (text . "\newline ") - (bcStrings (20 "0.1053671201E-7" fea F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Function Precision, {\it fun}: ") - (text . "\newline ") - (bcStrings (20 "0.4373903510E-14" fun F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "{\it r} is a Hessian matrix :") - (radioButtons hess - ("" " No" hFalse) - ("" " Yes" hTrue)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Infinite bound size, {\it infb}: ") - (text . "\newline ") - (bcStrings (20 "1.00E+15" infb F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Infinite step size, {\it infs}: ") - (text . "\newline ") - (bcStrings (20 "1.00E+15" infs F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Linear feasibility tolerance, {\it linf}: ") - (text . "\newline ") - (bcStrings (20 "0.1053671201E-7" linf F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Linesearch tolerance, {\it lint}: ") - (text . "\newline ") - (bcStrings (20 "0.9" lint F)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "List parameters:") - (radioButtons list - ("" " No" false) - ("" " Yes" true)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Major iteration limit, {\it maji}: ") - (text . "\newline ") - (bcStrings (5 30 maji PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Major print level, {\it majp}: ") - (text . "\newline ") - (bcStrings (5 1 majp PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Minor iteration limit, {\it mini}: ") - (text . "\newline ") - (bcStrings (5 81 mini PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Minor print level, {\it minp}: ") - (text . "\newline ") - (bcStrings (5 0 minp PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Monitoring channel, {\it mon}. ") - (text . "(Ignored in Foundation Library version.) ") - (text . "\newline ") - (bcStrings (5 "-1" mon F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Nonlinear feasibiltity tolerance, {\it nonf}: ") - (text . "\newline ") - (bcStrings (20 "1.05E-08" nonf F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Optimality tolerance, {\it opt}: ") - (text . "\newline ") - (bcStrings (20 "3.26E-08" opt F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Step limit, {\it ste}: ") - (text . "\newline ") - (bcStrings (5 "2.0" ste F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Start objective check at variable, {\it stao}: ") - (text . "\newline ") - (bcStrings (5 1 stao PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Start constraint check at variable, {\it stac}: ") - (text . "\newline ") - (bcStrings (5 1 stac PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Stop objective check at variable, {\it stoo}: ") - (text . "\newline ") - (bcStrings (5 9 stoo PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Stop objective check at variable, {\it stoc}: ") - (text . "\newline ") - (bcStrings (5 9 stoc PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2} ") - (text . "Verify level, {\it ver}: ") - (text . "\newline ") - (bcStrings (5 3 ver PI)))] - page := htInitPage('"E04UCF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the elements of the array, {\it A(nrowa,n)}: " - htSay '"\newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'e04ucfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nclin,nclin) - htpSetProperty(page,'ncnln,ncnln) - htpSetProperty(page,'nrowa,nrowa) - htpSetProperty(page,'nrowj,nrowj) - htpSetProperty(page,'nrowr,nrowr) - htpSetProperty(page,'liwork,liwork) - htpSetProperty(page,'lwork,lwork) - htpSetProperty(page,'optional,optional) - htpSetProperty(page,'start,start) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e04ucfDefaultSolve(htPage,nclin,ncnln,nrowa,nrowj,nrowr,liwork,lwork,ifail) == - n := '4 - optional := '0 - start := '0 - page := htInitPage('"E04UCF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the elements of the array {\it A(nrowa,n)}: ") - (text . "\newline ") - (bcStrings (4 "1.0" a11 F)) - (bcStrings (4 "1.0" a12 F)) - (bcStrings (4 "1.0" a13 F)) - (bcStrings (4 "1.0" a14 F)) - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the lower boundary conditions {\it bl(n+nclin+ncnln)}: ") - (text . "\newline ") - (bcStrings (8 "1.0" bl1 F)) - (bcStrings (8 "1.0" bl2 F)) - (bcStrings (8 "1.0" bl3 F)) - (bcStrings (8 "1.0" bl4 F)) - (bcStrings (8 "-1.E25" bl5 F)) - (bcStrings (8 "-1.E25" bl6 F)) - (bcStrings (8 "25.0" bl7 F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the upper boundary conditions {\it bu(n+nclin+ncnln)}: ") - (text . "\newline ") - (bcStrings (8 "5.0" bu1 F)) - (bcStrings (8 "5.0" bu2 F)) - (bcStrings (8 "5.0" bu3 F)) - (bcStrings (8 "5.0" bu4 F)) - (bcStrings (8 "20.0" bu5 F)) - (bcStrings (8 "40.0" bu6 F)) - (bcStrings (8 "1.E25" bu7 F)) - -- no istate or clamda or r as default condition is cold - -- what about cjac when der = 3 ? - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the nonlinear constraint functions, {\it c(ncnln)} ") - (text . "in terms of X[1]...X[n]: ") - (text . "\newline ") - (bcStrings (55 "X[1]**2 + X[2]**2 + X[3]**2 + X[4]**2" cx1 EM)) - (text . "\newline ") - (bcStrings (55 "X[1]*X[2]*X[3]*X[4]" cx2 EM)) - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the objective function, {\it F(x)} ") - (text . "in terms of X[1]...X[n]: ") - (text . "\newline ") - (bcStrings (55 "X[1]*X[4]*(X[1] + X[2] + X[3]) + X[3]" of EM)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter initial guess of the solution vector, {\it x(n)}: \newline") - (bcStrings (8 "1.0" x1 F)) - (bcStrings (8 "5.0" x2 F)) - (bcStrings (8 "5.0" x3 F)) - (bcStrings (8 "1.0" x4 F))) - htMakeDoneButton('"Continue",'e04ucfGen) - htpSetProperty(page,'n,n) - htpSetProperty(page,'nclin,nclin) - htpSetProperty(page,'ncnln,ncnln) - htpSetProperty(page,'nrowa,nrowa) - htpSetProperty(page,'nrowj,nrowj) - htpSetProperty(page,'nrowr,nrowr) - htpSetProperty(page,'liwork,liwork) - htpSetProperty(page,'lwork,lwork) - htpSetProperty(page,'start,start) - htpSetProperty(page,'optional,optional) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - - -e04ucfGen htPage == - n := htpProperty(htPage,'n) - nclin := htpProperty(htPage,'nclin) - ncnln := htpProperty(htPage,'ncnln) - nrowa := htpProperty(htPage,'nrowa) - nrowj := htpProperty(htPage,'nrowj) - nrowr := htpProperty(htPage,'nrowr) - liwork := htpProperty(htPage,'liwork) - lwork := htpProperty(htPage,'lwork) - optional := htpProperty(htPage,'optional) - start := htpProperty(htPage,'start) - ifail := htpProperty(htPage,'ifail) - sta := 'false -- no warm start in HD - alist := htpInputAreaAlist htPage - y := alist - if (optional = '0) then - cra := '"0.01" - der := 3 - fea := '"0.1053671201E-7" - fun := '"0.4373903510E-14" - hes := 'true - infb := '"1.00E+15" - infs := '"1.00E+15" - linf := '"0.1053671201E-7" - lint := '"0.9" - lis := 'true - maji := 30 - majp := 1 - mini := 81 - minp := 0 - mon := '"-1" - nonf := '"1.05E-08" - opt := '"3.26E-08" - ste := '"2.0" - stao := 1 - stac := 1 - stoo := n - stoc := n - ver := 3 - for i in 1..n repeat - temp := STRCONC ((first y).1," ") - xlist := [temp,:xlist] - y := rest y - xstring := bcwords2liststring xlist - f := (first y).1 - y := rest y - for i in 1..ncnln repeat - temp := STRCONC ((first y).1," ") - cxlist := [temp,:cxlist] - y := rest y - cxstring := bcwords2liststring cxlist - for i in 1..(n+nclin+ncnln) repeat - temp := STRCONC ((first y).1," ") - bulist := [temp,:bulist] - y := rest y - buu := bcwords2liststring bulist - for i in 1..(n+nclin+ncnln) repeat - temp := STRCONC ((first y).1," ") - bllist := [temp,:bllist] - y := rest y - bll := bcwords2liststring bllist - for i in 1..nrowa repeat -- matrix A - for j in 1..n repeat - a := STRCONC((first y).1," ") - arrlist := [a,:arrlist] - y := rest y - amatlist := [:amatlist,arrlist] - arrlist := [] - amatlist := reverse amatlist - amatstr := bcwords2liststring [bcwords2liststring x for x in amatlist] - else - ver := STRCONC((first y).1," ") - y := rest y - stoc := STRCONC((first y).1," ") - y := rest y - stoo := STRCONC((first y).1," ") - y := rest y - stac := STRCONC((first y).1," ") - y := rest y - stao := STRCONC((first y).1," ") - y := rest y - ste := STRCONC((first y).1," ") - y := rest y - opt := STRCONC((first y).1," ") - y := rest y - nonf := STRCONC((first y).1," ") - y := rest y - mon := STRCONC((first y).1," ") - y := rest y - minp := STRCONC((first y).1," ") - y := rest y - mini := STRCONC((first y).1," ") - y := rest y - majp := STRCONC((first y).1," ") - y := rest y - maji := STRCONC((first y).1," ") - y := rest y - nolist := (first y).1 - lis := - nolist = '" nil" => '"false" - '"true" - y := rest y - dummy1 := first y - y := rest y - lint := STRCONC((first y).1," ") - y := rest y - linf := STRCONC((first y).1," ") - y := rest y - infs := STRCONC((first y).1," ") - y := rest y - infb := STRCONC((first y).1," ") - y := rest y - noHess := (first y).1 - hes := - noHess = '" nil" => '"false" - '"true" - y := rest y - dummy2 := first y - y := rest y - fun := STRCONC((first y).1," ") - y := rest y - fea := STRCONC((first y).1," ") - y := rest y - der := STRCONC((first y).1," ") - y := rest y - cra := STRCONC((first y).1," ") - y := rest y - for i in 1..n repeat - temp := STRCONC ((first y).1," ") - xlist := [temp,:xlist] - y := rest y - xstring := bcwords2liststring xlist - f := (first y).1 - y := rest y - for i in 1..ncnln repeat - temp := STRCONC ((first y).1," ") - cxlist := [temp,:cxlist] - y := rest y - cxstring := bcwords2liststring cxlist - for i in 1..(n+nclin+ncnln) repeat - temp := STRCONC ((first y).1," ") - bulist := [temp,:bulist] - y := rest y - buu := bcwords2liststring bulist - for i in 1..(n+nclin+ncnln) repeat - temp := STRCONC ((first y).1," ") - bllist := [temp,:bllist] - y := rest y - bll := bcwords2liststring bllist - for i in 1..nrowa repeat -- matrix A - for j in 1..n repeat - a := STRCONC((first y).1," ") - arrlist := [a,:arrlist] - y := rest y - amatlist := [:amatlist,arrlist] - arrlist := [] - amatlist := reverse amatlist - amatstr := bcwords2liststring [bcwords2liststring x for x in amatlist] - ntotl := n + nclin + ncnln - prefix := STRCONC("e04ucf(",STRINGIMAGE n,", ",STRINGIMAGE nclin,", ") - prefix := STRCONC(prefix,STRINGIMAGE ncnln,", ",STRINGIMAGE nrowa,", ") - prefix := STRCONC(prefix,STRINGIMAGE nrowj,", ",STRINGIMAGE nrowr,", ") - prefix:= STRCONC(prefix,amatstr,",[",bll,"],[",buu,"],",STRINGIMAGE liwork) - prefix := STRCONC(prefix,", ",STRINGIMAGE lwork,", ",STRINGIMAGE sta,", ") - prefix := STRCONC(prefix,cra,", ",STRINGIMAGE der,", ",fea,", ") - prefix := STRCONC(prefix,fun,", ",hes,", ",infb,", ",infs,", ",linf,", ") - prefix := STRCONC(prefix,lint,", ",lis,", ",STRINGIMAGE maji,", ") - prefix := STRCONC(prefix,STRINGIMAGE majp,", ",STRINGIMAGE mini,", ") - prefix := STRCONC(prefix,STRINGIMAGE minp,", ",mon,", ",nonf,", ",opt,", ") - prefix := STRCONC(prefix,ste,", ",STRINGIMAGE stao,", ",STRINGIMAGE stac) - prefix := STRCONC(prefix,", ",STRINGIMAGE stoo,", ",STRINGIMAGE stoc,", ") - middle:= STRCONC(STRINGIMAGE ver,",[[0 for i in 1..",STRINGIMAGE ntotl,"]]") - middle:=STRCONC(middle,"::Matrix Integer,[[0.0 for i in 1..",STRINGIMAGE n) - middle:=STRCONC(middle,"] for j in 1..",STRINGIMAGE nrowj,"],[[0.0 for i in 1..") - middle := STRCONC(middle,STRINGIMAGE ntotl,"]],[[0.0 for i in 1..") - middle := STRCONC(middle,STRINGIMAGE n,"] for j in 1..",STRINGIMAGE nrowr) - middle := STRCONC(middle,"],[",xstring,"],",STRINGIMAGE ifail) - end:=STRCONC(",((",cxstring,")::Vector Expression(Float))::ASP55(CONFUN),") - end := STRCONC(end,"((",f,")::Expression(Float))::ASP49(OBJFUN))") - linkGen STRCONC(prefix,middle,end) - - -e04ucfCopOut() == - htInitPage('"E04UCF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil) - htMakePage '( - (domainConditions - (isDomain PI (PositiveInteger))) - (text . "\blankline ") - (text . "{\center{\em Hyperdoc interface not available for warm start}}") - (text . "\newline ") - (text . "{\center{\em Please use the command line.}}")) - htMakeDoneButton('"Continue",'e04ucf) - htShowPage() - -e04ycf() == - htInitPage('"E04YCF - Covariance matrix for non-linear least-squares problem", nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain PI (PositiveInteger)) - (isDomain F (Float))) - (text . "\windowlink{Manual Page}{manpageXXe04ycf} for this routine ") - (text . "\newline ") - (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04ycf| '|NagOptimisationPackage|)} for this routine") - (text . "\newline \horizontalline ") - (text . "\newline ") - (text . "E04YCF returns estimates of elements of the variance-covariance ") - (text . "matrix of the estimated regression coefficients for a nonlinear ") - (text . "least-squares problem. ") - (text . "\blankline ") - (text . "This routine may be used following any of the nonlinear ") - (text . "least-squares routines E04FDF, E04GCF. It ") - (text . "requires the parameters {\it fumsq, s} and {\it v} supplied ") - (text . "by those routines. ") - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Elements of {\it c} returned, {\it job}: ") - (radioButtons job - (" 0" " The diagonal elements of {\it c} " jZero) - (" 1" " Elements of column {\it job} of {\it c} " jOne) - (" -1" " The whole {\it n} by {\it n} symmetric matrix " jMinus)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of observations, {\it m}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 15 m PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Number of variables, {\it n}: ") - (text . "\newline\tab{2} ") - (bcStrings (6 3 n PI)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Sum of the squares of the residuals, {\it fsumsq}: ") - (text . "\newline\tab{2} ") - (bcStrings (30 "0.0082148773065789729" fsumsq F)) - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "First dimension of array {\it v}, {\it lv}:") - (text . "\newline\tab{2} ") - (bcStrings (6 3 lv PI)) - (text . "\blankline ") - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Ifail value:") - (radioButtons ifail - ("" " -1, Print error messages" minusOne) - ("" " 1, Suppress error messages" one))) - htMakeDoneButton('"Continue", 'e04ycfSolve) - htShowPage() - -e04ycfSolve htPage == - temp := htpButtonValue(htPage,'job) - job := - temp = 'jMinus => '-1 - temp = 'jOne => '1 - '0 - m := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) - objValUnwrap htpLabelSpadValue(htPage, 'm) - n := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) - objValUnwrap htpLabelSpadValue(htPage, 'n) - fsumsq := htpLabelInputString(htPage, 'fsumsq) - lv := - $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lv) - objValUnwrap htpLabelSpadValue(htPage, 'lv) - error := htpButtonValue(htPage,'ifail) - ifail := - error = 'one => '1 - '-1 - (n = 3 and lv = 3) => e04ycfDefaultSolve(htPage,job,m,fsumsq,ifail) - sList := - "append"/[fa(i) for i in 1..(n)] where fa(i) == - snam := INTERN STRCONC ('"s",STRINGIMAGE i) - [['bcStrings,[30, '"0.0", snam, 'F]]] - middle := ('"\blankline \menuitemstyle{}\tab{2} Enter the elements ") - middle := STRCONC(middle,'"of array {\it v(lv,n)}: \newline ") - vList := - "append"/[fb(i,n) for i in 1..lv] where fb(i,n) == - labelList := - "append"/[fc(i,j) for j in 1..n] where fc(i,j) == - vnam := INTERN STRCONC ('"v",STRINGIMAGE i,STRINGIMAGE j) - [['bcStrings,[15, 0, vnam, 'F]]] - prefix := ('"\newline ") - labelList := [['text,:prefix],:labelList] - vList := [['text,:middle],:vList] - equationPart := [ - '(domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))), - :sList,:vList] - page:= htInitPage('"E04YCF - Covariance matrix for non-linear least-squares problem", nil) - htSay '"\menuitemstyle{}\tab{2} " - htSay '"Enter the elements of the array {\it s(n)}: \newline " - htMakePage equationPart - htMakeDoneButton('"Continue",'e04ycfGen) - htpSetProperty(page,'job,job) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'fsumsq,fsumsq) - htpSetProperty(page,'lv,lv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e04ycfDefaultSolve(htPage,job,m,fsumsq,ifail) == - n := '3 - lv := '3 - page:= htInitPage('"E04YCF - Covariance matrix for non-linear least-squares problem", nil) - htMakePage '( - (domainConditions - (isDomain EM $EmptyMode) - (isDomain F (Float)) - (isDomain I (Integer))) - (text . "\newline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the elements of array {\it s(n)}: \newline ") - (bcStrings (30 "4.0965034571419325" s1 F)) - (bcStrings (30 "1.5949579400198182" s2 F)) - (bcStrings (30 "0.061258491120317927" s3 F)) - (text . "\newline ") - (text . "\blankline ") - (text . "\menuitemstyle{}\tab{2}") - (text . "Enter the elements of array {\it v(lv,n)}: \newline ") - -- not the correct values yet ! - (bcStrings (8 "0.9354" v11 F)) - (bcStrings (8 "-0.2592" v12 F)) - (bcStrings (8 "-0.2405" v13 F)) - (text . "\newline ") - (bcStrings (8 "0.3530" v21 F)) - (bcStrings (8 "0.6432" v22 F)) - (bcStrings (8 "0.6795" v23 F)) - (text . "\newline ") - (bcStrings (8 "-0.0215" v31 F)) - (bcStrings (8 "-0.7205" v32 F)) - (bcStrings (8 "0.6932" v33 F))) - htMakeDoneButton('"Continue",'e04ycfGen) - htpSetProperty(page,'job,job) - htpSetProperty(page,'n,n) - htpSetProperty(page,'m,m) - htpSetProperty(page,'fsumsq,fsumsq) - htpSetProperty(page,'lv,lv) - htpSetProperty(page,'ifail,ifail) - htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) - htShowPage() - -e04ycfGen htPage == - job := htpProperty(htPage,'job) - n := htpProperty(htPage, 'n) - m := htpProperty(htPage, 'm) - fsumsq := htpProperty(htPage, 'fsumsq) - lv := htpProperty(htPage, 'lv) - ifail := htpProperty(htPage,'ifail) - alist := htpInputAreaAlist htPage - y := alist - for i in 1..(lv*n) repeat - temp := STRCONC ((first y).1," ") - vlist := [temp,:vlist] - y := rest y - vstring := bcwords2liststring vlist - for i in 1..n repeat - temp := STRCONC ((first y).1," ") - slist := [temp,:slist] - y := rest y - sstring := bcwords2liststring slist - prefix := STRCONC("e04ycf(",STRINGIMAGE job,",", STRINGIMAGE m,", ") - prefix := STRCONC(prefix,STRINGIMAGE n,",",fsumsq,", [") - prefix := STRCONC(prefix,sstring,"],", STRINGIMAGE lv,",[",vstring) - linkGen STRCONC(prefix,"],",STRINGIMAGE ifail,")") - - - - -@ -\eject -\begin{thebibliography}{99} -\bibitem{1} nothing -\end{thebibliography} -\end{document} diff --git a/src/interp/nag-e04.lisp.pamphlet b/src/interp/nag-e04.lisp.pamphlet new file mode 100644 index 0000000..d04cc8d --- /dev/null +++ b/src/interp/nag-e04.lisp.pamphlet @@ -0,0 +1,6855 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/interp nag-e04.lisp} +\author{The Axiom Team} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +<<*>>= + +(IN-PACKAGE "BOOT" ) + +;e04dgf() == +; htInitPage('"E04DGF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain PI (PositiveInteger)) +; (isDomain F (Float))) +; (text . "\windowlink{Manual Page}{manpageXXe04dgf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04dgf| '|NagOptimisationPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "E04DGF minimizes {\it F(x)}, an unconstrained nonlinear function") +; (text . " of {\it n} variables, using a pre-conditioned quasi-Newton ") +; (text . "conjugate gradient method. ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Enter the number of variables, {\it n}: ") +; (text . "\newline ") +; (bcStrings (5 2 n PI)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Change optional parameters:") +; (radioButtons optional +; ("" " No" no) +; ("" " Yes" yes)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'e04dgfSolve) +; htShowPage() + +(DEFUN |e04dgf| () + (declare (special |$EmptyMode|)) + (PROGN + (|htInitPage| + (MAKESTRING + "E04DGF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| PI (|PositiveInteger|)) + (|isDomain| F (|Float|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXe04dgf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04dgf| '|NagOptimisationPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| + . "E04DGF minimizes {\\it F(x)}, an unconstrained nonlinear function") + (|text| + . " of {\\it n} variables, using a pre-conditioned quasi-Newton ") + (|text| . "conjugate gradient method. ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| . "Enter the number of variables, {\\it n}: ") + (|text| . "\\newline ") (|bcStrings| (5 2 |n| PI)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Change optional parameters:") + (|radioButtons| |optional| ("" " No" |no|) ("" " Yes" |yes|)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|e04dgfSolve|) + (|htShowPage|))) + +;e04dgfSolve(htPage) == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; param := htpButtonValue(htPage,'optional) +; optional := +; param = 'no => '0 +; '1 +; (n = '2 and optional = 0) => e04dgfDefaultSolve(htPage,ifail,n,optional) +; funcList := [['bcStrings,[55, '"exp(X[1])*(4*X[1]**2+2*X[2]**2+4*X[1]*X[2]+2*X[2]+1)", 'f, 'EM]]] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ") +; middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ") +; middle := cons('text,middle) +; vecList := +; n='2 => +; [['bcStrings,[8,-1.0,'x1,'F]],['bcStrings,[8,1.0,'x2,'F]]] +; [fb(i) for i in 1..n] where fb(i) == +; xnam := INTERN STRCONC ('"x",STRINGIMAGE i) +; ['bcStrings,[8, -1.0, xnam, 'F]] +; funcList := [:funcList,middle,:vecList] +; if optional = 1 then +; opt1Text := '"\blankline \menuitemstyle{}\tab{2} " +; opt1Text := STRCONC(opt1Text,'"Estimated optimal function values, {\it es}: \newline ") +; optList := [['text,:opt1Text],['bcStrings,[20, 1.0, 'es, 'F]]] +; opt2Text := '"\blankline \menuitemstyle{}\tab{2} " +; opt2Text := STRCONC(opt2Text,'"Function precision, {\it fu}: \newline ") +; optList := [:optList,:[['text,:opt2Text],['bcStrings,[20,"0.4373903597E-14",'fu,'F]]]] +; opt3Text := '"\blankline \menuitemstyle{}\tab{2} " +; opt3Text := STRCONC(opt3Text,'"Iteration limit, {\it it}: \newline ") +; optList := [:optList,:[['text,:opt3Text],['bcStrings,[5,50,'it,'PI]]]] +; opt4Text := '"\blankline \menuitemstyle{}\tab{2} " +; opt4Text := STRCONC(opt4Text,'"Linesearch tolerance, {\it lin}: \newline ") +; optList := [:optList,:[['text,:opt4Text],['bcStrings,[20,"0.9",'lin,'F]]]] +; opt5Text := '"\blankline \menuitemstyle{}\tab{2} " +; opt5Text := STRCONC(opt5Text,'"List parameters:") +; optList := [:optList,:[['text,:opt5Text],['radioButtons,'lis,:[[""," Yes",'true],[""," No",'false]]]]] +; opt6Text := '"\blankline \menuitemstyle{}\tab{2} " +; opt6Text := STRCONC(opt6Text,'"Maximum step length, {\it ma}: \newline ") +; optList := [:optList,:[['text,:opt6Text],['bcStrings,[20,"1.0E+20",'ma,'F]]]] +; opt7Text := '"\blankline \menuitemstyle{}\tab{2} " +; opt7Text := STRCONC(opt7Text,'"Optimality tolerance, {\it op}: \newline ") +; optList := [:optList,:[['text,:opt7Text],['bcStrings,[20,"3.26E-12",'op,'F]]]] +; opt9Text := '"\blankline \menuitemstyle{}\tab{2} " +; opt9Text := STRCONC(opt9Text,'"Print level, {\it pr}: \newline ") +; optList := [:optList,:[['text,:opt9Text],['bcStrings,[5,10,'pr,'PI]]]] +; opt10Text := '"\blankline \menuitemstyle{}\tab{2} " +; opt10Text := STRCONC(opt10Text,'"Start objective check at variable, {\it sta}: \newline ") +; optList := [:optList,:[['text,:opt10Text],['bcStrings,[5,1,'sta,'PI]]]] +; opt11Text := '"\blankline \menuitemstyle{}\tab{2} " +; opt11Text := STRCONC(opt11Text,'"Stop objective check at variable, {\it sto}: \newline ") +; optList := [:optList,:[['text,:opt11Text],['bcStrings,[5,2,'sto,'PI]]]] +; opt12Text := '"\blankline \menuitemstyle{}\tab{2} " +; opt12Text := STRCONC(opt12Text,'"Verify level, {\it ver}: \newline ") +; optList := [:optList,:[['text,:opt12Text],['bcStrings,[5,0,'ver,'PI]]]] +;-- (text . "\blankline ") +;-- (text . "\newline ") +;-- (text . "\menuitemstyle{}\tab{2}") +;-- (text . "List parameters:") +;-- (radioButtons lis +;-- ("" " Yes" true) +;-- ("" " No" false)) +; else +; optList := [] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :funcList, +; :optList] +; page := htInitPage('"E04DGF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: " +; htSay '"\newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'e04dgfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'optional,optional) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |e04dgfSolve,fb| (|i|) + (PROG (|xnam|) + (RETURN + (SEQ (SPADLET |xnam| + (INTERN (STRCONC (MAKESTRING "x") + (STRINGIMAGE |i|)))) + (EXIT (CONS '|bcStrings| + (CONS (CONS 8 + (CONS (SPADDIFFERENCE 1.0) + (CONS |xnam| (CONS 'F NIL)))) + NIL))))))) + +(DEFUN |e04dgfSolve| (|htPage|) + (PROG (|n| |error| |ifail| |param| |optional| |middle| |vecList| + |funcList| |opt1Text| |opt2Text| |opt3Text| |opt4Text| + |opt5Text| |opt6Text| |opt7Text| |opt9Text| |opt10Text| + |opt11Text| |opt12Text| |optList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (SPADLET |param| (|htpButtonValue| |htPage| '|optional|)) + (SPADLET |optional| + (COND ((BOOT-EQUAL |param| '|no|) '0) ('T '1))) + (COND + ((AND (BOOT-EQUAL |n| '2) (EQL |optional| 0)) + (|e04dgfDefaultSolve| |htPage| |ifail| |n| |optional|)) + ('T + (SPADLET |funcList| + (CONS (CONS '|bcStrings| + (CONS + (CONS 55 + (CONS + (MAKESTRING + "exp(X[1])*(4*X[1]**2+2*X[2]**2+4*X[1]*X[2]+2*X[2]+1)") + (CONS '|f| (CONS 'EM NIL)))) + NIL)) + NIL)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter initial guess ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "of the solution vector {\\it x(n)}: \\newline "))) + (SPADLET |middle| (CONS '|text| |middle|)) + (SPADLET |vecList| + (COND + ((BOOT-EQUAL |n| '2) + (CONS (CONS '|bcStrings| + (CONS + (CONS 8 + (CONS (SPADDIFFERENCE 1.0) + (CONS '|x1| (CONS 'F NIL)))) + NIL)) + (CONS (CONS '|bcStrings| + (CONS + (CONS 8 + (CONS 1.0 + (CONS '|x2| (CONS 'F NIL)))) + NIL)) + NIL))) + ('T + (PROG (G166077) + (SPADLET G166077 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) + (NREVERSE0 G166077)) + (SEQ (EXIT + (SETQ G166077 + (CONS (|e04dgfSolve,fb| |i|) + G166077)))))))))) + (SPADLET |funcList| + (APPEND |funcList| (CONS |middle| |vecList|))) + (COND + ((EQL |optional| 1) + (SPADLET |opt1Text| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} ")) + (SPADLET |opt1Text| + (STRCONC |opt1Text| + (MAKESTRING + "Estimated optimal function values, {\\it es}: \\newline "))) + (SPADLET |optList| + (CONS (CONS '|text| |opt1Text|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 20 + (CONS 1.0 + (CONS '|es| (CONS 'F NIL)))) + NIL)) + NIL))) + (SPADLET |opt2Text| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} ")) + (SPADLET |opt2Text| + (STRCONC |opt2Text| + (MAKESTRING + "Function precision, {\\it fu}: \\newline "))) + (SPADLET |optList| + (APPEND |optList| + (CONS (CONS '|text| |opt2Text|) + (CONS + (CONS '|bcStrings| + (CONS + (CONS 20 + (CONS '|0.4373903597E-14| + (CONS '|fu| (CONS 'F NIL)))) + NIL)) + NIL)))) + (SPADLET |opt3Text| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} ")) + (SPADLET |opt3Text| + (STRCONC |opt3Text| + (MAKESTRING + "Iteration limit, {\\it it}: \\newline "))) + (SPADLET |optList| + (APPEND |optList| + (CONS (CONS '|text| |opt3Text|) + (CONS + (CONS '|bcStrings| + (CONS + (CONS 5 + (CONS 50 + (CONS '|it| (CONS 'PI NIL)))) + NIL)) + NIL)))) + (SPADLET |opt4Text| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} ")) + (SPADLET |opt4Text| + (STRCONC |opt4Text| + (MAKESTRING + "Linesearch tolerance, {\\it lin}: \\newline "))) + (SPADLET |optList| + (APPEND |optList| + (CONS (CONS '|text| |opt4Text|) + (CONS + (CONS '|bcStrings| + (CONS + (CONS 20 + (CONS '|0.9| + (CONS '|lin| (CONS 'F NIL)))) + NIL)) + NIL)))) + (SPADLET |opt5Text| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} ")) + (SPADLET |opt5Text| + (STRCONC |opt5Text| + (MAKESTRING "List parameters:"))) + (SPADLET |optList| + (APPEND |optList| + (CONS (CONS '|text| |opt5Text|) + (CONS + (CONS '|radioButtons| + (CONS '|lis| + (CONS + (CONS '|| + (CONS '| Yes| + (CONS '|true| NIL))) + (CONS + (CONS '|| + (CONS '| No| + (CONS '|false| NIL))) + NIL)))) + NIL)))) + (SPADLET |opt6Text| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} ")) + (SPADLET |opt6Text| + (STRCONC |opt6Text| + (MAKESTRING + "Maximum step length, {\\it ma}: \\newline "))) + (SPADLET |optList| + (APPEND |optList| + (CONS (CONS '|text| |opt6Text|) + (CONS + (CONS '|bcStrings| + (CONS + (CONS 20 + (CONS '|1.0E+20| + (CONS '|ma| (CONS 'F NIL)))) + NIL)) + NIL)))) + (SPADLET |opt7Text| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} ")) + (SPADLET |opt7Text| + (STRCONC |opt7Text| + (MAKESTRING + "Optimality tolerance, {\\it op}: \\newline "))) + (SPADLET |optList| + (APPEND |optList| + (CONS (CONS '|text| |opt7Text|) + (CONS + (CONS '|bcStrings| + (CONS + (CONS 20 + (CONS '|3.26E-12| + (CONS '|op| (CONS 'F NIL)))) + NIL)) + NIL)))) + (SPADLET |opt9Text| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} ")) + (SPADLET |opt9Text| + (STRCONC |opt9Text| + (MAKESTRING + "Print level, {\\it pr}: \\newline "))) + (SPADLET |optList| + (APPEND |optList| + (CONS (CONS '|text| |opt9Text|) + (CONS + (CONS '|bcStrings| + (CONS + (CONS 5 + (CONS 10 + (CONS '|pr| (CONS 'PI NIL)))) + NIL)) + NIL)))) + (SPADLET |opt10Text| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} ")) + (SPADLET |opt10Text| + (STRCONC |opt10Text| + (MAKESTRING + "Start objective check at variable, {\\it sta}: \\newline "))) + (SPADLET |optList| + (APPEND |optList| + (CONS (CONS '|text| |opt10Text|) + (CONS + (CONS '|bcStrings| + (CONS + (CONS 5 + (CONS 1 + (CONS '|sta| (CONS 'PI NIL)))) + NIL)) + NIL)))) + (SPADLET |opt11Text| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} ")) + (SPADLET |opt11Text| + (STRCONC |opt11Text| + (MAKESTRING + "Stop objective check at variable, {\\it sto}: \\newline "))) + (SPADLET |optList| + (APPEND |optList| + (CONS (CONS '|text| |opt11Text|) + (CONS + (CONS '|bcStrings| + (CONS + (CONS 5 + (CONS 2 + (CONS '|sto| (CONS 'PI NIL)))) + NIL)) + NIL)))) + (SPADLET |opt12Text| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} ")) + (SPADLET |opt12Text| + (STRCONC |opt12Text| + (MAKESTRING + "Verify level, {\\it ver}: \\newline "))) + (SPADLET |optList| + (APPEND |optList| + (CONS (CONS '|text| |opt12Text|) + (CONS + (CONS '|bcStrings| + (CONS + (CONS 5 + (CONS 0 + (CONS '|ver| (CONS 'PI NIL)))) + NIL)) + NIL))))) + ('T (SPADLET |optList| NIL))) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (APPEND |funcList| |optList|))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "E04DGF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING + "Enter the objective function, {\\it F(x)} in terms of X[1]...X[n]: ")) + (|htSay| (MAKESTRING "\\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|e04dgfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|optional| |optional|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;e04dgfDefaultSolve(htPage,ifail,n,optional) == +; page := htInitPage('"E04DGF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the objective function, {\it F(x)} in terms of X[1]...X[n]: ") +; (text . "\newline ") +; (bcStrings (55 "exp(X[1])*(4*X[1]**2+2*X[2]**2+4*X[1]*X[2]+2*X[2]+1)" f EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter initial guess of the solution vector, {\it x(n)}: \newline") +; (bcStrings (8 "-1.0" x1 F)) +; (bcStrings (8 "1.0" x2 F))) +; htMakeDoneButton('"Continue",'e04dgfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'optional,optional) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |e04dgfDefaultSolve| (|htPage| |ifail| |n| |optional|) + (PROG (|page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "E04DGF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the objective function, {\\it F(x)} in terms of X[1]...X[n]: ") + (|text| . "\\newline ") + (|bcStrings| + (55 + "exp(X[1])*(4*X[1]**2+2*X[2]**2+4*X[1]*X[2]+2*X[2]+1)" + |f| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter initial guess of the solution vector, {\\it x(n)}: \\newline") + (|bcStrings| (8 "-1.0" |x1| F)) + (|bcStrings| (8 "1.0" |x2| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|e04dgfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|optional| |optional|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;e04dgfGen htPage == +; n := htpProperty(htPage,'n) +; optional := htpProperty(htPage,'optional) +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; if (optional = '0) then +; es := '"1.0" +; ma := '"1.0E+20" +; op := '"3.26E-12" +; lin := '"0.9" +; fu := '"0.4373903597E-14" +; it := 50 +; pr := 10 +; sta := 1 +; sto := 2 +; ver := 0 +; lis := '"true" +; for i in 1..n repeat +; temp := STRCONC ((first y).1," ") +; xlist := [temp,:xlist] +; y := rest y +; xstring := bcwords2liststring xlist +; f := (first y).1 +; else +; ver := STRCONC((first y).1," ") +; y := rest y +; sto := STRCONC((first y).1," ") +; y := rest y +; sta := STRCONC((first y).1," ") +; y := rest y +; pr := STRCONC((first y).1," ") +; y := rest y +; op := STRCONC((first y).1," ") +; y := rest y +; ma := STRCONC((first y).1," ") +; y := rest y +; nolist := (first y).1 +; lis := +; nolist = '" t" => '"false" +; '"true" +; y := rest y +; dummy := first y +; y := rest y +; lin := STRCONC((first y).1," ") +; y := rest y +; it := STRCONC((first y).1," ") +; y := rest y +; fu := STRCONC((first y).1," ") +; y := rest y +; es := STRCONC((first y).1," ") +; y := rest y +; for i in 1..n repeat +; temp := STRCONC ((first y).1," ") +; xlist := [temp,:xlist] +; y := rest y +; xstring := bcwords2liststring xlist +; f := (first y).1 +; prefix := STRCONC("e04dgf(",STRINGIMAGE n,", ",es,", ",fu,",") +; prefix := STRCONC(prefix,STRINGIMAGE it,", ",lin,", ",lis,", ",ma,", ",op) +; prefix := STRCONC(prefix,",",STRINGIMAGE pr,", ",STRINGIMAGE sta,", ") +; middle := STRCONC(STRINGIMAGE sto,", ",STRINGIMAGE ver,", [",xstring,"] ,") +; middle := STRCONC(middle,STRINGIMAGE ifail," ,") +; linkGen STRCONC (prefix,middle,"((",f,")::Expression(Float))::ASP49(OBJFUN))") + +(DEFUN |e04dgfGen| (|htPage|) + (PROG (|n| |optional| |ifail| |alist| |ver| |sto| |sta| |pr| |op| + |ma| |nolist| |lis| |dummy| |lin| |it| |fu| |es| |temp| + |xlist| |y| |xstring| |f| |prefix| |middle|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |optional| (|htpProperty| |htPage| '|optional|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (COND + ((BOOT-EQUAL |optional| '0) + (SPADLET |es| (MAKESTRING "1.0")) + (SPADLET |ma| (MAKESTRING "1.0E+20")) + (SPADLET |op| (MAKESTRING "3.26E-12")) + (SPADLET |lin| (MAKESTRING "0.9")) + (SPADLET |fu| (MAKESTRING "0.4373903597E-14")) + (SPADLET |it| 50) (SPADLET |pr| 10) (SPADLET |sta| 1) + (SPADLET |sto| 2) (SPADLET |ver| 0) + (SPADLET |lis| (MAKESTRING "true")) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) + '| |)) + (SPADLET |xlist| (CONS |temp| |xlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |xstring| (|bcwords2liststring| |xlist|)) + (SPADLET |f| (ELT (CAR |y|) 1))) + ('T (SPADLET |ver| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |sto| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |sta| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |pr| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |op| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |ma| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |nolist| (ELT (CAR |y|) 1)) + (SPADLET |lis| + (COND + ((BOOT-EQUAL |nolist| (MAKESTRING " t")) + (MAKESTRING "false")) + ('T (MAKESTRING "true")))) + (SPADLET |y| (CDR |y|)) (SPADLET |dummy| (CAR |y|)) + (SPADLET |y| (CDR |y|)) + (SPADLET |lin| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |it| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |fu| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |es| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) + '| |)) + (SPADLET |xlist| (CONS |temp| |xlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |xstring| (|bcwords2liststring| |xlist|)) + (SPADLET |f| (ELT (CAR |y|) 1)))) + (SPADLET |prefix| + (STRCONC '|e04dgf(| (STRINGIMAGE |n|) '|, | |es| + '|, | |fu| '|,|)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |it|) '|, | |lin| + '|, | |lis| '|, | |ma| '|, | |op|)) + (SPADLET |prefix| + (STRCONC |prefix| '|,| (STRINGIMAGE |pr|) '|, | + (STRINGIMAGE |sta|) '|, |)) + (SPADLET |middle| + (STRCONC (STRINGIMAGE |sto|) '|, | + (STRINGIMAGE |ver|) '|, [| |xstring| + '|] ,|)) + (SPADLET |middle| + (STRCONC |middle| (STRINGIMAGE |ifail|) '| ,|)) + (|linkGen| + (STRCONC |prefix| |middle| '|((| |f| + '|)::Expression(Float))::ASP49(OBJFUN))|))))))) + +;e04fdf() == +; htInitPage('"E04FDF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using function values only",nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXe04fdf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04fdf| '|NagOptimisationPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "E04FDF is an easy to use routine for finding an unconstrained ") +; (text . "minimum of a sum of squares of {\it m} nonlinear functions in ") +; (text . "{\it n} variables ({\it m} \htbitmap{great=} {\it n}), i.e., it ") +; (text . "is applicable to problems of the form ") +; (text . "\center{\htbitmap{e04fdf}} where \center{\htbitmap{e04fdf1}}") +; (text . "No derivatives are required. The routine is intended for ") +; (text . "functions which have continous first and second derivatives, ") +; (text . "though it will usually work if the derivatives have occasional ") +; (text . "discontinuities. ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of functions {\it \htbitmap{fi}(x)}, {\it m}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 15 m PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of variables \htbitmap{xj}, {\it n}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 3 n PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Dimension of {\it iw}, {\it liw}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 1 liw F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Dimension of {\it w}, {\it lw}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 171 lw F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'e04fdfSolve) +; htShowPage() + +(DEFUN |e04fdf| () + (PROGN + (|htInitPage| + (MAKESTRING + "E04FDF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using function values only") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXe04fdf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04fdf| '|NagOptimisationPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "E04FDF is an easy to use routine for finding an unconstrained ") + (|text| + . "minimum of a sum of squares of {\\it m} nonlinear functions in ") + (|text| + . "{\\it n} variables ({\\it m} \\htbitmap{great=} {\\it n}), i.e., it ") + (|text| . "is applicable to problems of the form ") + (|text| + . "\\center{\\htbitmap{e04fdf}} where \\center{\\htbitmap{e04fdf1}}") + (|text| + . "No derivatives are required. The routine is intended for ") + (|text| + . "functions which have continous first and second derivatives, ") + (|text| + . "though it will usually work if the derivatives have occasional ") + (|text| . "discontinuities. ") (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Number of functions {\\it \\htbitmap{fi}(x)}, {\\it m}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 15 |m| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Number of variables \\htbitmap{xj}, {\\it n}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 3 |n| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Dimension of {\\it iw}, {\\it liw}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 1 |liw| F)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Dimension of {\\it w}, {\\it lw}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 171 |lw| F)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|e04fdfSolve|) + (|htShowPage|))) + +;e04fdfSolve htPage == +; m := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) +; objValUnwrap htpLabelSpadValue(htPage, 'm) +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; liw := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'liw) +; objValUnwrap htpLabelSpadValue(htPage, 'liw) +; lw := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) +; objValUnwrap htpLabelSpadValue(htPage, 'lw) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; (m = '15 and n = '3) => e04fdfDefaultSolve(htPage,liw,lw,ifail) +; funcList := +; "append"/[fa(i) for i in 1..m] where fa(i) == +; prefix := ('"\newline {\em Function ") +; prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") +; funct := ('"XC[1] + 1") +; nam := INTERN STRCONC ('"n",STRINGIMAGE i) +; [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ") +; middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ") +; middle := cons('text,middle) +; vecList := +; [fb(i) for i in 1..n] where fb(i) == +; xnam := INTERN STRCONC ('"x",STRINGIMAGE i) +; ['bcStrings,[4, '"0.0", xnam, 'F]] +; funcList := [:funcList,middle,:vecList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :funcList] +; page:= htInitPage('"E04FDF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using function values only",nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the functions \htbitmap{fi} below in terms XC[1]...XC[n]: " +; htSay '"\newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'e04fdfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +; htpSetProperty(page,'liw,liw) +; htpSetProperty(page,'lw,lw) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |e04fdfSolve,fa| (|i|) + (PROG (|prefix| |funct| |nam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline {\\em Function ")) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |i|) + (MAKESTRING ":} \\space{1}"))) + (SPADLET |funct| (MAKESTRING "XC[1] + 1")) + (SPADLET |nam| + (INTERN (STRCONC (MAKESTRING "n") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 42 + (CONS |funct| + (CONS |nam| (CONS 'EM NIL)))) + NIL)) + NIL))))))) + +(DEFUN |e04fdfSolve,fb| (|i|) + (PROG (|xnam|) + (RETURN + (SEQ (SPADLET |xnam| + (INTERN (STRCONC (MAKESTRING "x") + (STRINGIMAGE |i|)))) + (EXIT (CONS '|bcStrings| + (CONS (CONS 4 + (CONS (MAKESTRING "0.0") + (CONS |xnam| (CONS 'F NIL)))) + NIL))))))) + +(DEFUN |e04fdfSolve| (|htPage|) + (PROG (|m| |n| |liw| |lw| |error| |ifail| |middle| |vecList| + |funcList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |m| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|m|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|m|))))) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |liw| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|liw|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|liw|))))) + (SPADLET |lw| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|lw|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|lw|))))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |m| '15) (BOOT-EQUAL |n| '3)) + (|e04fdfDefaultSolve| |htPage| |liw| |lw| |ifail|)) + ('T + (SPADLET |funcList| + (PROG (G166249) + (SPADLET G166249 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |m|) G166249) + (SEQ (EXIT + (SETQ G166249 + (APPEND G166249 + (|e04fdfSolve,fa| |i|))))))))) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter initial guess ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "of the solution vector {\\it x(n)}: \\newline "))) + (SPADLET |middle| (CONS '|text| |middle|)) + (SPADLET |vecList| + (PROG (G166261) + (SPADLET G166261 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) + (NREVERSE0 G166261)) + (SEQ (EXIT + (SETQ G166261 + (CONS (|e04fdfSolve,fb| |i|) + G166261)))))))) + (SPADLET |funcList| + (APPEND |funcList| (CONS |middle| |vecList|))) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + |funcList|)) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "E04FDF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using function values only") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING + "Enter the functions \\htbitmap{fi} below in terms XC[1]...XC[n]: ")) + (|htSay| (MAKESTRING "\\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|e04fdfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|liw| |liw|) + (|htpSetProperty| |page| '|lw| |lw|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;e04fdfDefaultSolve (htPage,liw,lw,ifail) == +; n := '3 +; m := '15 +; page:= htInitPage('"E04FDF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using function values only",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the functions \htbitmap{fi} below ") +; (text . "in terms of XC[1]...XC[n]: ") +; (text . "\newline ") +; (text . "\newline {\em Function 1:} \space{1}") +; (bcStrings (42 "(XC[3]+15*XC[2])**(-1)+XC[1]-0.14" n1 EM)) +; (text . "\newline {\em Function 2:} \space{1}") +; (bcStrings (42 "2*(2*XC[3]+14*XC[2])**(-1)+XC[1]-0.18" n2 EM)) +; (text . "\newline {\em Function 3:} \space{1}") +; (bcStrings (42 "3*(3*XC[3]+13*XC[2])**(-1)+XC[1]-0.22" n3 EM)) +; (text . "\newline {\em Function 4:} \space{1}") +; (bcStrings (42 "4*(4*XC[3]+12*XC[2])**(-1)+XC[1]-0.25" n4 EM)) +; (text . "\newline {\em Function 5:} \space{1}") +; (bcStrings (42 "5*(5*XC[3]+11*XC[2])**(-1)+XC[1]-0.29" n5 EM)) +; (text . "\newline {\em Function 6:} \space{1}") +; (bcStrings (42 "6*(6*XC[3]+10*XC[2])**(-1)+XC[1]-0.32" n6 EM)) +; (text . "\newline {\em Function 7:} \space{1}") +; (bcStrings (42 "7*(7*XC[3]+9*XC[2])**(-1)+XC[1]-0.35" n7 EM)) +; (text . "\newline {\em Function 8:} \space{1}") +; (bcStrings (42 "8*(8*XC[3]+8*XC[2])**(-1)+XC[1]-0.39" n8 EM)) +; (text . "\newline {\em Function 9:} \space{1}") +; (bcStrings (42 "9*(7*XC[3]+7*XC[2])**(-1)+XC[1]-0.37" n9 EM)) +; (text . "\newline {\em Function 10:} \space{1}") +; (bcStrings (42 "10*(6*XC[3]+6*XC[2])**(-1)+XC[1]-0.58" n10 EM)) +; (text . "\newline {\em Function 11:} \space{1}") +; (bcStrings (42 "11*(5*XC[3]+5*XC[2])**(-1)+XC[1]-0.73" n11 EM)) +; (text . "\newline {\em Function 12:} \space{1}") +; (bcStrings (42 "12*(4*XC[3]+4*XC[2])**(-1)+XC[1]-0.96" n12 EM)) +; (text . "\newline {\em Function 13:} \space{1}") +; (bcStrings (42 "13*(3*XC[3]+3*XC[2])**(-1)+XC[1]-1.34" n13 EM)) +; (text . "\newline {\em Function 14:} \space{1}") +; (bcStrings (42 "14*(2*XC[3]+2*XC[2])**(-1)+XC[1]-2.1" n14 EM)) +; (text . "\newline {\em Function 15:} \space{1}") +; (bcStrings (42 "15*(XC[3]+XC[2])**(-1)+XC[1]-4.39" n15 EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter initial guess of the solution vector {\it x(n)}: \newline ") +; (bcStrings (4 "0.5" x1 F)) +; (bcStrings (4 "1.0" x2 F)) +; (bcStrings (4 "1.5" x3 F))) +; htMakeDoneButton('"Continue",'e04fdfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'liw,liw) +; htpSetProperty(page,'lw,lw) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |e04fdfDefaultSolve| (|htPage| |liw| |lw| |ifail|) + (PROG (|n| |m| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |m| '15) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "E04FDF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using function values only") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the functions \\htbitmap{fi} below ") + (|text| . "in terms of XC[1]...XC[n]: ") + (|text| . "\\newline ") + (|text| . "\\newline {\\em Function 1:} \\space{1}") + (|bcStrings| + (42 "(XC[3]+15*XC[2])**(-1)+XC[1]-0.14" |n1| EM)) + (|text| . "\\newline {\\em Function 2:} \\space{1}") + (|bcStrings| + (42 "2*(2*XC[3]+14*XC[2])**(-1)+XC[1]-0.18" |n2| EM)) + (|text| . "\\newline {\\em Function 3:} \\space{1}") + (|bcStrings| + (42 "3*(3*XC[3]+13*XC[2])**(-1)+XC[1]-0.22" |n3| EM)) + (|text| . "\\newline {\\em Function 4:} \\space{1}") + (|bcStrings| + (42 "4*(4*XC[3]+12*XC[2])**(-1)+XC[1]-0.25" |n4| EM)) + (|text| . "\\newline {\\em Function 5:} \\space{1}") + (|bcStrings| + (42 "5*(5*XC[3]+11*XC[2])**(-1)+XC[1]-0.29" |n5| EM)) + (|text| . "\\newline {\\em Function 6:} \\space{1}") + (|bcStrings| + (42 "6*(6*XC[3]+10*XC[2])**(-1)+XC[1]-0.32" |n6| EM)) + (|text| . "\\newline {\\em Function 7:} \\space{1}") + (|bcStrings| + (42 "7*(7*XC[3]+9*XC[2])**(-1)+XC[1]-0.35" |n7| EM)) + (|text| . "\\newline {\\em Function 8:} \\space{1}") + (|bcStrings| + (42 "8*(8*XC[3]+8*XC[2])**(-1)+XC[1]-0.39" |n8| EM)) + (|text| . "\\newline {\\em Function 9:} \\space{1}") + (|bcStrings| + (42 "9*(7*XC[3]+7*XC[2])**(-1)+XC[1]-0.37" |n9| EM)) + (|text| . "\\newline {\\em Function 10:} \\space{1}") + (|bcStrings| + (42 "10*(6*XC[3]+6*XC[2])**(-1)+XC[1]-0.58" |n10| EM)) + (|text| . "\\newline {\\em Function 11:} \\space{1}") + (|bcStrings| + (42 "11*(5*XC[3]+5*XC[2])**(-1)+XC[1]-0.73" |n11| EM)) + (|text| . "\\newline {\\em Function 12:} \\space{1}") + (|bcStrings| + (42 "12*(4*XC[3]+4*XC[2])**(-1)+XC[1]-0.96" |n12| EM)) + (|text| . "\\newline {\\em Function 13:} \\space{1}") + (|bcStrings| + (42 "13*(3*XC[3]+3*XC[2])**(-1)+XC[1]-1.34" |n13| EM)) + (|text| . "\\newline {\\em Function 14:} \\space{1}") + (|bcStrings| + (42 "14*(2*XC[3]+2*XC[2])**(-1)+XC[1]-2.1" |n14| EM)) + (|text| . "\\newline {\\em Function 15:} \\space{1}") + (|bcStrings| + (42 "15*(XC[3]+XC[2])**(-1)+XC[1]-4.39" |n15| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter initial guess of the solution vector {\\it x(n)}: \\newline ") + (|bcStrings| (4 "0.5" |x1| F)) + (|bcStrings| (4 "1.0" |x2| F)) + (|bcStrings| (4 "1.5" |x3| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|e04fdfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|liw| |liw|) + (|htpSetProperty| |page| '|lw| |lw|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;e04fdfGen htPage == +; n := htpProperty(htPage, 'n) +; m := htpProperty(htPage, 'm) +; liw := htpProperty(htPage,'liw) +; lw := htpProperty(htPage,'lw) +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..n repeat +; temp := STRCONC ((first y).1," ") +; xlist := [temp,:xlist] +; y := rest y +; xstring := bcwords2liststring xlist +; for i in 1..m repeat +; temp := STRCONC ((first y).1," ") +; ulist := [temp,:ulist] +; y := rest y +; ustring := bcwords2liststring ulist +; prefix := STRCONC("e04fdf(",STRINGIMAGE m,",",STRINGIMAGE n,", ") +; prefix := STRCONC(prefix,STRINGIMAGE liw,",",STRINGIMAGE lw,", [") +; middle := STRCONC(xstring,"],",STRINGIMAGE ifail,",") +; linkGen STRCONC(prefix,middle,"(",ustring,"::Vector Expression(Float))::ASP50(LSFUN1))") + +(DEFUN |e04fdfGen| (|htPage|) + (PROG (|n| |m| |liw| |lw| |ifail| |alist| |xlist| |xstring| |temp| + |ulist| |y| |ustring| |prefix| |middle|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |m| (|htpProperty| |htPage| '|m|)) + (SPADLET |liw| (|htpProperty| |htPage| '|liw|)) + (SPADLET |lw| (|htpProperty| |htPage| '|lw|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |xlist| (CONS |temp| |xlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |xstring| (|bcwords2liststring| |xlist|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |m|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |ulist| (CONS |temp| |ulist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |ustring| (|bcwords2liststring| |ulist|)) + (SPADLET |prefix| + (STRCONC '|e04fdf(| (STRINGIMAGE |m|) '|,| + (STRINGIMAGE |n|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |liw|) '|,| + (STRINGIMAGE |lw|) '|, [|)) + (SPADLET |middle| + (STRCONC |xstring| '|],| (STRINGIMAGE |ifail|) + '|,|)) + (|linkGen| + (STRCONC |prefix| |middle| '|(| |ustring| + '|::Vector Expression(Float))::ASP50(LSFUN1))|))))))) + +;e04gcf() == +; htInitPage('"E04GCF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using 1st derivatives",nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXe04gcf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04gcf| '|NagOptimisationPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "E04GCF is an easy to use quasi-Newton routine for finding an unconstrained ") +; (text . "minimum of a sum of squares of {\it m} nonlinear functions in ") +; (text . "{\it n} variables ({\it m} \htbitmap{great=} {\it n}), i.e., it ") +; (text . "is applicable to problems of the form ") +; (text . "\center{\htbitmap{e04fdf}} where \center{\htbitmap{e04fdf1}}") +; (text . "The routine is intended for ") +; (text . "functions which have continous first and second derivatives, ") +; (text . "though it will usually work if the derivatives have occasional ") +; (text . "discontinuities. ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of functions {\it \htbitmap{fi}(x)}, {\it m}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 15 m PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of variables \htbitmap{xj}, {\it n}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 3 n PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Dimension of {\it iw}, {\it liw}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 1 liw F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Dimension of {\it w}, {\it lw}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 177 lw F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'e04gcfSolve) +; htShowPage() + +(DEFUN |e04gcf| () + (PROGN + (|htInitPage| + (MAKESTRING + "E04GCF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using 1st derivatives") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXe04gcf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04gcf| '|NagOptimisationPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "E04GCF is an easy to use quasi-Newton routine for finding an unconstrained ") + (|text| + . "minimum of a sum of squares of {\\it m} nonlinear functions in ") + (|text| + . "{\\it n} variables ({\\it m} \\htbitmap{great=} {\\it n}), i.e., it ") + (|text| . "is applicable to problems of the form ") + (|text| + . "\\center{\\htbitmap{e04fdf}} where \\center{\\htbitmap{e04fdf1}}") + (|text| . "The routine is intended for ") + (|text| + . "functions which have continous first and second derivatives, ") + (|text| + . "though it will usually work if the derivatives have occasional ") + (|text| . "discontinuities. ") (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Number of functions {\\it \\htbitmap{fi}(x)}, {\\it m}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 15 |m| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Number of variables \\htbitmap{xj}, {\\it n}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 3 |n| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Dimension of {\\it iw}, {\\it liw}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 1 |liw| F)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Dimension of {\\it w}, {\\it lw}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 177 |lw| F)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|e04gcfSolve|) + (|htShowPage|))) + +;e04gcfSolve htPage == +; m := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) +; objValUnwrap htpLabelSpadValue(htPage, 'm) +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; liw := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'liw) +; objValUnwrap htpLabelSpadValue(htPage, 'liw) +; lw := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) +; objValUnwrap htpLabelSpadValue(htPage, 'lw) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; (m = '15 and n = '3) => e04gcfDefaultSolve(htPage,liw,lw,ifail) +; funcList := +; "append"/[fa(i) for i in 1..m] where fa(i) == +; prefix := ('"\newline {\em Function ") +; prefix := STRCONC(prefix,STRINGIMAGE i,'":} \space{1}") +; funct := ('"XC[1] + 1") +; nam := INTERN STRCONC ('"n",STRINGIMAGE i) +; [['text,:prefix],['bcStrings,[42, funct, nam, 'EM]]] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ") +; middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ") +; middle := cons('text,middle) +; vecList := +; [fb(i) for i in 1..n] where fb(i) == +; xnam := INTERN STRCONC ('"x",STRINGIMAGE i) +; ['bcStrings,[4, '"0.0", xnam, 'F]] +; funcList := [:funcList,middle,:vecList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :funcList] +; page:= htInitPage('"E04GCF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using 1st derivatives",nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the functions \htbitmap{fi} below in terms of XC[1]...XC[n]: " +; htSay '"\newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'e04gcfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +; htpSetProperty(page,'liw,liw) +; htpSetProperty(page,'lw,lw) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |e04gcfSolve,fa| (|i|) + (PROG (|prefix| |funct| |nam|) + (RETURN + (SEQ (SPADLET |prefix| (MAKESTRING "\\newline {\\em Function ")) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |i|) + (MAKESTRING ":} \\space{1}"))) + (SPADLET |funct| (MAKESTRING "XC[1] + 1")) + (SPADLET |nam| + (INTERN (STRCONC (MAKESTRING "n") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|text| |prefix|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 42 + (CONS |funct| + (CONS |nam| (CONS 'EM NIL)))) + NIL)) + NIL))))))) + +(DEFUN |e04gcfSolve,fb| (|i|) + (PROG (|xnam|) + (RETURN + (SEQ (SPADLET |xnam| + (INTERN (STRCONC (MAKESTRING "x") + (STRINGIMAGE |i|)))) + (EXIT (CONS '|bcStrings| + (CONS (CONS 4 + (CONS (MAKESTRING "0.0") + (CONS |xnam| (CONS 'F NIL)))) + NIL))))))) + +(DEFUN |e04gcfSolve| (|htPage|) + (PROG (|m| |n| |liw| |lw| |error| |ifail| |middle| |vecList| + |funcList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |m| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|m|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|m|))))) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |liw| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|liw|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|liw|))))) + (SPADLET |lw| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|lw|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|lw|))))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |m| '15) (BOOT-EQUAL |n| '3)) + (|e04gcfDefaultSolve| |htPage| |liw| |lw| |ifail|)) + ('T + (SPADLET |funcList| + (PROG (G166362) + (SPADLET G166362 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |m|) G166362) + (SEQ (EXIT + (SETQ G166362 + (APPEND G166362 + (|e04gcfSolve,fa| |i|))))))))) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter initial guess ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "of the solution vector {\\it x(n)}: \\newline "))) + (SPADLET |middle| (CONS '|text| |middle|)) + (SPADLET |vecList| + (PROG (G166374) + (SPADLET G166374 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) + (NREVERSE0 G166374)) + (SEQ (EXIT + (SETQ G166374 + (CONS (|e04gcfSolve,fb| |i|) + G166374)))))))) + (SPADLET |funcList| + (APPEND |funcList| (CONS |middle| |vecList|))) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + |funcList|)) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "E04GCF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using 1st derivatives") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING + "Enter the functions \\htbitmap{fi} below in terms of XC[1]...XC[n]: ")) + (|htSay| (MAKESTRING "\\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|e04gcfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|liw| |liw|) + (|htpSetProperty| |page| '|lw| |lw|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;e04gcfDefaultSolve (htPage,liw,lw,ifail) == +; n := '3 +; m := '15 +; page:= htInitPage('"E04GCF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using 1st derivatives",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the functions \htbitmap{fi} below ") +; (text . "in terms of XC[1]...XC[n]: ") +; (text . "\newline ") +; (text . "\newline {\em Function 1:} \space{1}") +; (bcStrings (42 "(XC[3]+15*XC[2])**(-1)+XC[1]-0.14" n1 EM)) +; (text . "\newline {\em Function 2:} \space{1}") +; (bcStrings (42 "2*(2*XC[3]+14*XC[2])**(-1)+XC[1]-0.18" n2 EM)) +; (text . "\newline {\em Function 3:} \space{1}") +; (bcStrings (42 "3*(3*XC[3]+13*XC[2])**(-1)+XC[1]-0.22" n3 EM)) +; (text . "\newline {\em Function 4:} \space{1}") +; (bcStrings (42 "4*(4*XC[3]+12*XC[2])**(-1)+XC[1]-0.25" n4 EM)) +; (text . "\newline {\em Function 5:} \space{1}") +; (bcStrings (42 "5*(5*XC[3]+11*XC[2])**(-1)+XC[1]-0.29" n5 EM)) +; (text . "\newline {\em Function 6:} \space{1}") +; (bcStrings (42 "6*(6*XC[3]+10*XC[2])**(-1)+XC[1]-0.32" n6 EM)) +; (text . "\newline {\em Function 7:} \space{1}") +; (bcStrings (42 "7*(7*XC[3]+9*XC[2])**(-1)+XC[1]-0.35" n7 EM)) +; (text . "\newline {\em Function 8:} \space{1}") +; (bcStrings (42 "8*(8*XC[3]+8*XC[2])**(-1)+XC[1]-0.39" n8 EM)) +; (text . "\newline {\em Function 9:} \space{1}") +; (bcStrings (42 "9*(7*XC[3]+7*XC[2])**(-1)+XC[1]-0.37" n9 EM)) +; (text . "\newline {\em Function 10:} \space{1}") +; (bcStrings (42 "10*(6*XC[3]+6*XC[2])**(-1)+XC[1]-0.58" n10 EM)) +; (text . "\newline {\em Function 11:} \space{1}") +; (bcStrings (42 "11*(5*XC[3]+5*XC[2])**(-1)+XC[1]-0.73" n11 EM)) +; (text . "\newline {\em Function 12:} \space{1}") +; (bcStrings (42 "12*(4*XC[3]+4*XC[2])**(-1)+XC[1]-0.96" n12 EM)) +; (text . "\newline {\em Function 13:} \space{1}") +; (bcStrings (42 "13*(3*XC[3]+3*XC[2])**(-1)+XC[1]-1.34" n13 EM)) +; (text . "\newline {\em Function 14:} \space{1}") +; (bcStrings (42 "14*(2*XC[3]+2*XC[2])**(-1)+XC[1]-2.1" n14 EM)) +; (text . "\newline {\em Function 15:} \space{1}") +; (bcStrings (42 "15*(XC[3]+XC[2])**(-1)+XC[1]-4.39" n15 EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter initial guess of the solution vector {\it x(n)}: \newline ") +; (bcStrings (4 "0.5" x1 F)) +; (bcStrings (4 "1.0" x2 F)) +; (bcStrings (4 "1.5" x3 F))) +; htMakeDoneButton('"Continue",'e04gcfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'liw,liw) +; htpSetProperty(page,'lw,lw) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |e04gcfDefaultSolve| (|htPage| |liw| |lw| |ifail|) + (PROG (|n| |m| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |m| '15) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "E04GCF - Unconstrained minimum of a sum of squares, combined Gauss-Newton and modified Newton algorithm using 1st derivatives") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the functions \\htbitmap{fi} below ") + (|text| . "in terms of XC[1]...XC[n]: ") + (|text| . "\\newline ") + (|text| . "\\newline {\\em Function 1:} \\space{1}") + (|bcStrings| + (42 "(XC[3]+15*XC[2])**(-1)+XC[1]-0.14" |n1| EM)) + (|text| . "\\newline {\\em Function 2:} \\space{1}") + (|bcStrings| + (42 "2*(2*XC[3]+14*XC[2])**(-1)+XC[1]-0.18" |n2| EM)) + (|text| . "\\newline {\\em Function 3:} \\space{1}") + (|bcStrings| + (42 "3*(3*XC[3]+13*XC[2])**(-1)+XC[1]-0.22" |n3| EM)) + (|text| . "\\newline {\\em Function 4:} \\space{1}") + (|bcStrings| + (42 "4*(4*XC[3]+12*XC[2])**(-1)+XC[1]-0.25" |n4| EM)) + (|text| . "\\newline {\\em Function 5:} \\space{1}") + (|bcStrings| + (42 "5*(5*XC[3]+11*XC[2])**(-1)+XC[1]-0.29" |n5| EM)) + (|text| . "\\newline {\\em Function 6:} \\space{1}") + (|bcStrings| + (42 "6*(6*XC[3]+10*XC[2])**(-1)+XC[1]-0.32" |n6| EM)) + (|text| . "\\newline {\\em Function 7:} \\space{1}") + (|bcStrings| + (42 "7*(7*XC[3]+9*XC[2])**(-1)+XC[1]-0.35" |n7| EM)) + (|text| . "\\newline {\\em Function 8:} \\space{1}") + (|bcStrings| + (42 "8*(8*XC[3]+8*XC[2])**(-1)+XC[1]-0.39" |n8| EM)) + (|text| . "\\newline {\\em Function 9:} \\space{1}") + (|bcStrings| + (42 "9*(7*XC[3]+7*XC[2])**(-1)+XC[1]-0.37" |n9| EM)) + (|text| . "\\newline {\\em Function 10:} \\space{1}") + (|bcStrings| + (42 "10*(6*XC[3]+6*XC[2])**(-1)+XC[1]-0.58" |n10| EM)) + (|text| . "\\newline {\\em Function 11:} \\space{1}") + (|bcStrings| + (42 "11*(5*XC[3]+5*XC[2])**(-1)+XC[1]-0.73" |n11| EM)) + (|text| . "\\newline {\\em Function 12:} \\space{1}") + (|bcStrings| + (42 "12*(4*XC[3]+4*XC[2])**(-1)+XC[1]-0.96" |n12| EM)) + (|text| . "\\newline {\\em Function 13:} \\space{1}") + (|bcStrings| + (42 "13*(3*XC[3]+3*XC[2])**(-1)+XC[1]-1.34" |n13| EM)) + (|text| . "\\newline {\\em Function 14:} \\space{1}") + (|bcStrings| + (42 "14*(2*XC[3]+2*XC[2])**(-1)+XC[1]-2.1" |n14| EM)) + (|text| . "\\newline {\\em Function 15:} \\space{1}") + (|bcStrings| + (42 "15*(XC[3]+XC[2])**(-1)+XC[1]-4.39" |n15| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter initial guess of the solution vector {\\it x(n)}: \\newline ") + (|bcStrings| (4 "0.5" |x1| F)) + (|bcStrings| (4 "1.0" |x2| F)) + (|bcStrings| (4 "1.5" |x3| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|e04gcfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|liw| |liw|) + (|htpSetProperty| |page| '|lw| |lw|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;e04gcfGen htPage == +; n := htpProperty(htPage, 'n) +; m := htpProperty(htPage, 'm) +; liw := htpProperty(htPage,'liw) +; lw := htpProperty(htPage,'lw) +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..n repeat +; temp := STRCONC ((first y).1," ") +; xlist := [temp,:xlist] +; y := rest y +; xstring := bcwords2liststring xlist +; for i in 1..m repeat +; temp := STRCONC ((first y).1," ") +; ulist := [temp,:ulist] +; y := rest y +; ustring := bcwords2liststring ulist +; prefix := STRCONC("e04gcf(",STRINGIMAGE m,",",STRINGIMAGE n,", ") +; prefix := STRCONC(prefix,STRINGIMAGE liw,",",STRINGIMAGE lw,", [") +; middle := STRCONC(xstring,"],",STRINGIMAGE ifail,",") +; linkGen STRCONC(prefix,middle,"(",ustring,"::Vector Expression(Float))::ASP19(LSFUN2))") + +(DEFUN |e04gcfGen| (|htPage|) + (PROG (|n| |m| |liw| |lw| |ifail| |alist| |xlist| |xstring| |temp| + |ulist| |y| |ustring| |prefix| |middle|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |m| (|htpProperty| |htPage| '|m|)) + (SPADLET |liw| (|htpProperty| |htPage| '|liw|)) + (SPADLET |lw| (|htpProperty| |htPage| '|lw|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |xlist| (CONS |temp| |xlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |xstring| (|bcwords2liststring| |xlist|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |m|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |ulist| (CONS |temp| |ulist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |ustring| (|bcwords2liststring| |ulist|)) + (SPADLET |prefix| + (STRCONC '|e04gcf(| (STRINGIMAGE |m|) '|,| + (STRINGIMAGE |n|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |liw|) '|,| + (STRINGIMAGE |lw|) '|, [|)) + (SPADLET |middle| + (STRCONC |xstring| '|],| (STRINGIMAGE |ifail|) + '|,|)) + (|linkGen| + (STRCONC |prefix| |middle| '|(| |ustring| + '|::Vector Expression(Float))::ASP19(LSFUN2))|))))))) + +;e04jaf() == +; htInitPage('"E04JAF - Minimum, function of several variables, quasi-Newton algorithm, simple bounds, using function values only",nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\windowlink{Manual Page}{manpageXXe04jaf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04jaf| '|NagOptimisationPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "E04JAF is an easy to use quasi-Newton routine for finding a ") +; (text . "minimum of a nonlinear function {\it F(x)} of {\it n} variables ") +; (text . "\center{\htbitmap{e04fdf1}} possibly subject to fixed upper ") +; (text . "and lower bounds on the variables, i.e., it is applicable to ") +; (text . "problems of the form \blankline Minimize {\it F(x)}, subject to ") +; (text . "\htbitmap{lj} \htbitmap{great=} \htbitmap{xj} \htbitmap{great=} ") +; (text . "\htbitmap{uj} for {\it j} = 1,2,...,n. \blankline ") +; (text . "Function values only are required. The routine is intended for ") +; (text . "functions which have continuous first and second derivatives, ") +; (text . "though it will usually work if the derivatives have occasional ") +; (text . "discontinuities. ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of variables \htbitmap{xj}, {\it n}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 4 n PI)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Specify the use of bounds, {\it ibound}:") +; (radioButtons ibound +; (" 0" " All \htbitmap{lj} and \htbitmap{uj} are given individually" iZero) +; (" 1" " No bounds on any of the \htbitmap{xj}" iOne) +; (" 2" " All bounds are of the form 0 \htbitmap{great=} \htbitmap{xj}" iTwo) +; (" 3" " All \htbitmap{lj} are equal and all \htbitmap{uj} are equal" iThree)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Dimension of {\it iw}, {\it liw}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 6 liw F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Dimension of {\it w}, {\it lw}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 54 lw F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'e04jafSolve) +; htShowPage() + +(DEFUN |e04jaf| () + (PROGN + (|htInitPage| + (MAKESTRING + "E04JAF - Minimum, function of several variables, quasi-Newton algorithm, simple bounds, using function values only") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXe04jaf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04jaf| '|NagOptimisationPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "E04JAF is an easy to use quasi-Newton routine for finding a ") + (|text| + . "minimum of a nonlinear function {\\it F(x)} of {\\it n} variables ") + (|text| + . "\\center{\\htbitmap{e04fdf1}} possibly subject to fixed upper ") + (|text| + . "and lower bounds on the variables, i.e., it is applicable to ") + (|text| + . "problems of the form \\blankline Minimize {\\it F(x)}, subject to ") + (|text| + . "\\htbitmap{lj} \\htbitmap{great=} \\htbitmap{xj} \\htbitmap{great=} ") + (|text| + . "\\htbitmap{uj} for {\\it j} = 1,2,...,n. \\blankline ") + (|text| + . "Function values only are required. The routine is intended for ") + (|text| + . "functions which have continuous first and second derivatives, ") + (|text| + . "though it will usually work if the derivatives have occasional ") + (|text| . "discontinuities. ") (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Number of variables \\htbitmap{xj}, {\\it n}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 4 |n| PI)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Specify the use of bounds, {\\it ibound}:") + (|radioButtons| |ibound| + (" 0" + " All \\htbitmap{lj} and \\htbitmap{uj} are given individually" + |iZero|) + (" 1" " No bounds on any of the \\htbitmap{xj}" |iOne|) + (" 2" + " All bounds are of the form 0 \\htbitmap{great=} \\htbitmap{xj}" + |iTwo|) + (" 3" + " All \\htbitmap{lj} are equal and all \\htbitmap{uj} are equal" + |iThree|)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Dimension of {\\it iw}, {\\it liw}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 6 |liw| F)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Dimension of {\\it w}, {\\it lw}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (5 54 |lw| F)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|e04jafSolve|) + (|htShowPage|))) + +;e04jafSolve htPage == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; boun := htpButtonValue(htPage,'ibound) +; ibound := +; boun = 'iZero => '0 +; boun = 'iOne => '1 +; boun = 'iTwo => '2 +; '3 +; liw := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'liw) +; objValUnwrap htpLabelSpadValue(htPage, 'liw) +; lw := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lw) +; objValUnwrap htpLabelSpadValue(htPage, 'lw) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; n = '4 => e04jafDefaultSolve(htPage,ibound,liw,lw,ifail) +; funcList := [['bcStrings,[50, '"XC[1]", 'f, 'EM]]] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter lower boundary conditions ") +; middle := STRCONC(middle,'"{\it bl(n)}: \newline ") +; blList := +; "append"/[fa(i) for i in 1..n] where fa(i) == +; xnam := INTERN STRCONC ('"bl",STRINGIMAGE i) +; [['bcStrings,[8, '"0.0", xnam, 'F]]] +; blList := [['text,:middle],:blList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter upper boundary ") +; middle := STRCONC(middle,'"conditions {\it bu(n)}: \newline ") +; buList := +; "append"/[fb(i) for i in 1..n] where fb(i) == +; xnam := INTERN STRCONC ('"bu",STRINGIMAGE i) +; [['bcStrings,[8, '"0.0", xnam, 'F]]] +; buList := [['text,:middle],:buList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ") +; middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ") +; xList := +; "append"/[fc(i) for i in 1..n] where fc(i) == +; xnam := INTERN STRCONC ('"x",STRINGIMAGE i) +; [['bcStrings,[8, '"0.0", xnam, 'F]]] +; xList := [['text,:middle],:xList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :funcList,:blList,:buList,:xList] +; page:= htInitPage('"E04JAF - Minimum, function of several variables, quasi-Newton algorithm, simple bounds, using function values only",nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the function {\it F(x)} below in terms of XC[1]...XC[n]: " +; htSay '"\newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'e04jafGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'ibound,ibound) +; htpSetProperty(page,'liw,liw) +; htpSetProperty(page,'lw,lw) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |e04jafSolve,fa| (|i|) + (PROG (|xnam|) + (RETURN + (SEQ (SPADLET |xnam| + (INTERN (STRCONC (MAKESTRING "bl") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS (MAKESTRING "0.0") + (CONS |xnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04jafSolve,fb| (|i|) + (PROG (|xnam|) + (RETURN + (SEQ (SPADLET |xnam| + (INTERN (STRCONC (MAKESTRING "bu") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS (MAKESTRING "0.0") + (CONS |xnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04jafSolve,fc| (|i|) + (PROG (|xnam|) + (RETURN + (SEQ (SPADLET |xnam| + (INTERN (STRCONC (MAKESTRING "x") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS (MAKESTRING "0.0") + (CONS |xnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04jafSolve| (|htPage|) + (PROG (|n| |boun| |ibound| |liw| |lw| |error| |ifail| |funcList| + |blList| |buList| |middle| |xList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |boun| (|htpButtonValue| |htPage| '|ibound|)) + (SPADLET |ibound| + (COND + ((BOOT-EQUAL |boun| '|iZero|) '0) + ((BOOT-EQUAL |boun| '|iOne|) '1) + ((BOOT-EQUAL |boun| '|iTwo|) '2) + ('T '3))) + (SPADLET |liw| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|liw|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|liw|))))) + (SPADLET |lw| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|lw|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|lw|))))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((BOOT-EQUAL |n| '4) + (|e04jafDefaultSolve| |htPage| |ibound| |liw| |lw| + |ifail|)) + ('T + (SPADLET |funcList| + (CONS (CONS '|bcStrings| + (CONS + (CONS 50 + (CONS (MAKESTRING "XC[1]") + (CONS '|f| (CONS 'EM NIL)))) + NIL)) + NIL)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter lower boundary conditions ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "{\\it bl(n)}: \\newline "))) + (SPADLET |blList| + (PROG (G166478) + (SPADLET G166478 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166478) + (SEQ (EXIT + (SETQ G166478 + (APPEND G166478 + (|e04jafSolve,fa| |i|))))))))) + (SPADLET |blList| + (CONS (CONS '|text| |middle|) |blList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter upper boundary ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "conditions {\\it bu(n)}: \\newline "))) + (SPADLET |buList| + (PROG (G166486) + (SPADLET G166486 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166486) + (SEQ (EXIT + (SETQ G166486 + (APPEND G166486 + (|e04jafSolve,fb| |i|))))))))) + (SPADLET |buList| + (CONS (CONS '|text| |middle|) |buList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter initial guess ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "of the solution vector {\\it x(n)}: \\newline "))) + (SPADLET |xList| + (PROG (G166494) + (SPADLET G166494 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166494) + (SEQ (EXIT + (SETQ G166494 + (APPEND G166494 + (|e04jafSolve,fc| |i|))))))))) + (SPADLET |xList| + (CONS (CONS '|text| |middle|) |xList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (APPEND |funcList| + (APPEND |blList| + (APPEND |buList| |xList|))))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "E04JAF - Minimum, function of several variables, quasi-Newton algorithm, simple bounds, using function values only") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING + "Enter the function {\\it F(x)} below in terms of XC[1]...XC[n]: ")) + (|htSay| (MAKESTRING "\\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|e04jafGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ibound| |ibound|) + (|htpSetProperty| |page| '|liw| |liw|) + (|htpSetProperty| |page| '|lw| |lw|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;e04jafDefaultSolve (htPage,ibound,liw,lw,ifail) == +; n := '4 +; page:= htInitPage('"E04JAF - Minimum, function of several variables, quasi-Newton algorithm, simple bounds, using function values only",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the function {\it F(x)} below in terms of XC[1]...XC[n]: ") +; (text . "\newline ") +; (bcStrings (60 "(XC[1]+10*XC[2])**2+5*(XC[3]-XC[4])**2+(XC[2]-2*XC[3])**4+10*(XC[1]-XC[4])**4" n1 EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter lower boundary conditions {\it bl(n)}: \newline ") +; (bcStrings (8 "1" bl1 F)) +; (bcStrings (8 "-2" bl2 F)) +; (bcStrings (8 "-1.0e-6" bl3 F)) +; (bcStrings (8 "1" bl4 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter upper boundary conditions {\it bu(n)}: \newline ") +; (bcStrings (8 "3" bu1 F)) +; (bcStrings (8 "0" bu2 F)) +; (bcStrings (8 "1.0e6" bu3 F)) +; (bcStrings (8 "3" bu4 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter initial guess of the solution vector {\it x(n)}: \newline ") +; (bcStrings (8 "3" x1 F)) +; (bcStrings (8 "-1" x2 F)) +; (bcStrings (8 "0" x3 F)) +; (bcStrings (8 "1" x4 F))) +; htMakeDoneButton('"Continue",'e04jafGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'ibound,ibound) +; htpSetProperty(page,'liw,liw) +; htpSetProperty(page,'lw,lw) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |e04jafDefaultSolve| (|htPage| |ibound| |liw| |lw| |ifail|) + (PROG (|n| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "E04JAF - Minimum, function of several variables, quasi-Newton algorithm, simple bounds, using function values only") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the function {\\it F(x)} below in terms of XC[1]...XC[n]: ") + (|text| . "\\newline ") + (|bcStrings| + (60 + "(XC[1]+10*XC[2])**2+5*(XC[3]-XC[4])**2+(XC[2]-2*XC[3])**4+10*(XC[1]-XC[4])**4" + |n1| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter lower boundary conditions {\\it bl(n)}: \\newline ") + (|bcStrings| (8 "1" |bl1| F)) + (|bcStrings| (8 "-2" |bl2| F)) + (|bcStrings| (8 "-1.0e-6" |bl3| F)) + (|bcStrings| (8 "1" |bl4| F)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter upper boundary conditions {\\it bu(n)}: \\newline ") + (|bcStrings| (8 "3" |bu1| F)) + (|bcStrings| (8 "0" |bu2| F)) + (|bcStrings| (8 "1.0e6" |bu3| F)) + (|bcStrings| (8 "3" |bu4| F)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter initial guess of the solution vector {\\it x(n)}: \\newline ") + (|bcStrings| (8 "3" |x1| F)) + (|bcStrings| (8 "-1" |x2| F)) + (|bcStrings| (8 "0" |x3| F)) + (|bcStrings| (8 "1" |x4| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|e04jafGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|ibound| |ibound|) + (|htpSetProperty| |page| '|liw| |liw|) + (|htpSetProperty| |page| '|lw| |lw|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;e04jafGen htPage == +; n := htpProperty(htPage, 'n) +; ibound := htpProperty(htPage, 'ibound) +; liw := htpProperty(htPage,'liw) +; lw := htpProperty(htPage,'lw) +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..n repeat +; temp := STRCONC ((first y).1," ") +; xlist := [temp,:xlist] +; y := rest y +; xstring := bcwords2liststring xlist +; for i in 1..n repeat +; temp := STRCONC ((first y).1," ") +; bulist := [temp,:bulist] +; y := rest y +; bustring := bcwords2liststring bulist +; for i in 1..n repeat +; temp := STRCONC ((first y).1," ") +; bllist := [temp,:bllist] +; y := rest y +; blstring := bcwords2liststring bllist +; f := (first y).1 +; prefix := STRCONC("e04jaf(",STRINGIMAGE n,",",STRINGIMAGE ibound,", ") +; prefix := STRCONC(prefix,STRINGIMAGE liw,",",STRINGIMAGE lw,", [") +; prefix := STRCONC(prefix,blstring,"],[",bustring,"],[") +; middle := STRCONC(xstring,"],",STRINGIMAGE ifail,",(") +; linkGen STRCONC(prefix,middle,f,"::Expression(Float))::ASP24(FUNCT1))") + +(DEFUN |e04jafGen| (|htPage|) + (PROG (|n| |ibound| |liw| |lw| |ifail| |alist| |xlist| |xstring| + |bulist| |bustring| |temp| |bllist| |y| |blstring| |f| + |prefix| |middle|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |ibound| (|htpProperty| |htPage| '|ibound|)) + (SPADLET |liw| (|htpProperty| |htPage| '|liw|)) + (SPADLET |lw| (|htpProperty| |htPage| '|lw|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |xlist| (CONS |temp| |xlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |xstring| (|bcwords2liststring| |xlist|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |bulist| (CONS |temp| |bulist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |bustring| (|bcwords2liststring| |bulist|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |bllist| (CONS |temp| |bllist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |blstring| (|bcwords2liststring| |bllist|)) + (SPADLET |f| (ELT (CAR |y|) 1)) + (SPADLET |prefix| + (STRCONC '|e04jaf(| (STRINGIMAGE |n|) '|,| + (STRINGIMAGE |ibound|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |liw|) '|,| + (STRINGIMAGE |lw|) '|, [|)) + (SPADLET |prefix| + (STRCONC |prefix| |blstring| '|],[| |bustring| + '|],[|)) + (SPADLET |middle| + (STRCONC |xstring| '|],| (STRINGIMAGE |ifail|) + '|,(|)) + (|linkGen| + (STRCONC |prefix| |middle| |f| + '|::Expression(Float))::ASP24(FUNCT1))|))))))) + +;e04mbf() == +; htInitPage('"E04MBF - Linear programming problem",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain PI (PositiveInteger)) +; (isDomain F (Float))) +; (text . "\windowlink{Manual Page}{manpageXXe04mbf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04mbf| '|NagOptimisationPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "E04MBF is an easy to use routine to solve linear programming ") +; (text . "(LP) problems of the form \center{\htbitmap{e04mbf}} \newline ") +; (text . "where {\it c} is an {\it n} element vector and {\it A} is an ") +; (text . "{\it m} by {\it n} matrix, i.e., there are {\it n} variables ") +; (text . "and {\it m} linear constraints. {\it m} may be zero in which ") +; (text . "case the LP problem is subject only to bounds on the variables. ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Upper bound on number of iterations, {\it itmax}:") +; (text . "\newline\tab{2} ") +; (bcStrings (6 20 itmax PI)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Type of output messages required, {\it msglvl}: ") +; (radioButtons msglvl +; (" = 1 " " Printing occurs at the solution " mOne) +; (" = 0 " " Printing only if an input parameter is incorrect " mZero) +; (" < 0 " " No printing " mMinus)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of variables, {\it n}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (6 7 n PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of general linear constraints, {\it nclin}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (6 7 nclin PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "First dimension of array {\it a}, {\it nrowa}:") +; (text . "\newline\tab{2} ") +; (bcStrings (6 7 nrowa PI)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Specifies whether or not a linear objective function is present, {\it linobj}:") +; (radioButtons linobj +; ("" " true - full LP problem is solved" true) +; ("" " false - only a feasible problem is found" false)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Dimension of {\it iwork}, {\it liwork}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 14 liwork F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Dimension of {\it work}, {\it lwork}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 182 lwork F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'e04mbfSolve) +; htShowPage() + +(DEFUN |e04mbf| () + (declare (special |$EmptyMode|)) + (PROGN + (|htInitPage| (MAKESTRING "E04MBF - Linear programming problem") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| PI (|PositiveInteger|)) + (|isDomain| F (|Float|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXe04mbf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04mbf| '|NagOptimisationPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "E04MBF is an easy to use routine to solve linear programming ") + (|text| + . "(LP) problems of the form \\center{\\htbitmap{e04mbf}} \\newline ") + (|text| + . "where {\\it c} is an {\\it n} element vector and {\\it A} is an ") + (|text| + . "{\\it m} by {\\it n} matrix, i.e., there are {\\it n} variables ") + (|text| + . "and {\\it m} linear constraints. {\\it m} may be zero in which ") + (|text| + . "case the LP problem is subject only to bounds on the variables. ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Upper bound on number of iterations, {\\it itmax}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (6 20 |itmax| PI)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Type of output messages required, {\\it msglvl}: ") + (|radioButtons| |msglvl| + (" = 1 " " Printing occurs at the solution " |mOne|) + (" = 0 " + " Printing only if an input parameter is incorrect " + |mZero|) + (" < 0 " " No printing " |mMinus|)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Number of variables, {\\it n}: ") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (6 7 |n| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Number of general linear constraints, {\\it nclin}: ") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (6 7 |nclin| PI)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "First dimension of array {\\it a}, {\\it nrowa}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (6 7 |nrowa| PI)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Specifies whether or not a linear objective function is present, {\\it linobj}:") + (|radioButtons| |linobj| + ("" " true - full LP problem is solved" |true|) + ("" " false - only a feasible problem is found" |false|)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| . "Dimension of {\\it iwork}, {\\it liwork}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (5 14 |liwork| F)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Dimension of {\\it work}, {\\it lwork}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (5 182 |lwork| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|e04mbfSolve|) + (|htShowPage|))) + +;e04mbfSolve htPage == +; itmax := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'itmax) +; objValUnwrap htpLabelSpadValue(htPage, 'itmax) +; msg := htpButtonValue(htPage,'msglvl) +; msglvl := +; msg = 'mMinus => '-1 +; msg = 'mZero => '0 +; '1 +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; nclin := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nclin) +; objValUnwrap htpLabelSpadValue(htPage, 'nclin) +; nrowa := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrowa) +; objValUnwrap htpLabelSpadValue(htPage, 'nrowa) +; lin := htpButtonValue(htPage,'linobj) +; linobj := +; lin = 'true => '"true" +; '"false" +; liwork := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'liwork) +; objValUnwrap htpLabelSpadValue(htPage, 'liwork) +; lwork := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lwork) +; objValUnwrap htpLabelSpadValue(htPage, 'lwork) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; ((nrowa = '7 and n = 7) and nclin = 7) => e04mbfDefaultSolve(htPage,itmax,msglvl,linobj,liwork,lwork,ifail) +; aList := +; "append"/[fa(i,n) for i in 1..nrowa] where fa(i,n) == +; labelList := +; "append"/[fb(i,j) for j in 1..n] where fb(i,j) == +; anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) +; [['bcStrings,[8, 0, anam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter lower boundary ") +; middle := STRCONC(middle,'"conditions {\it bl(n + nclin)}: \newline ") +; blList := +; "append"/[fc(i) for i in 1..(n+nclin)] where fc(i) == +; blnam := INTERN STRCONC ('"bl",STRINGIMAGE i) +; [['bcStrings,[8, '"0.0", blnam, 'F]]] +; blList := [['text,:middle],:blList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter upper boundary ") +; middle := STRCONC(middle,'"conditions {\it bu(n+nclin)}: \newline ") +; buList := +; "append"/[fd(i) for i in 1..(n+nclin)] where fd(i) == +; bunam := INTERN STRCONC ('"bu",STRINGIMAGE i) +; [['bcStrings,[8, '"0.0", bunam, 'F]]] +; buList := [['text,:middle],:buList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter coefficients of the ") +; middle := STRCONC(middle,'"objective function {\it cvec(n)}: \newline ") +; cList := +; "append"/[fe(i) for i in 1..n] where fe(i) == +; cnam := INTERN STRCONC ('"c",STRINGIMAGE i) +; [['bcStrings,[8, '"0.0", cnam, 'F]]] +; cList := [['text,:middle],:cList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ") +; middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ") +; xList := +; "append"/[fg(i) for i in 1..n] where fg(i) == +; xnam := INTERN STRCONC ('"x",STRINGIMAGE i) +; [['bcStrings,[8, '"0.0", xnam, 'F]]] +; xList := [['text,:middle],:xList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :aList,:blList,:buList,:cList,:xList] +; page:= htInitPage('"E04MBF - Linear programming problem",nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the elements of the array {\it a(nrowa,n)}: \newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'e04mbfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'nclin,nclin) +; htpSetProperty(page,'nrowa,nrowa) +; htpSetProperty(page,'itmax,itmax) +; htpSetProperty(page,'msglvl,msglvl) +; htpSetProperty(page,'linobj,linobj) +; htpSetProperty(page,'liwork,liwork) +; htpSetProperty(page,'lwork,lwork) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |e04mbfSolve,fb| (|i| |j|) + (PROG (|anam|) + (RETURN + (SEQ (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS 0 + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04mbfSolve,fa| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166614) + (SPADLET G166614 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166614) + (SEQ (EXIT (SETQ G166614 + (APPEND G166614 + (|e04mbfSolve,fb| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |e04mbfSolve,fc| (|i|) + (PROG (|blnam|) + (RETURN + (SEQ (SPADLET |blnam| + (INTERN (STRCONC (MAKESTRING "bl") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS (MAKESTRING "0.0") + (CONS |blnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04mbfSolve,fd| (|i|) + (PROG (|bunam|) + (RETURN + (SEQ (SPADLET |bunam| + (INTERN (STRCONC (MAKESTRING "bu") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS (MAKESTRING "0.0") + (CONS |bunam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04mbfSolve,fe| (|i|) + (PROG (|cnam|) + (RETURN + (SEQ (SPADLET |cnam| + (INTERN (STRCONC (MAKESTRING "c") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS (MAKESTRING "0.0") + (CONS |cnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04mbfSolve,fg| (|i|) + (PROG (|xnam|) + (RETURN + (SEQ (SPADLET |xnam| + (INTERN (STRCONC (MAKESTRING "x") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS (MAKESTRING "0.0") + (CONS |xnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04mbfSolve| (|htPage|) + (PROG (|itmax| |msg| |msglvl| |n| |nclin| |nrowa| |lin| |linobj| + |liwork| |lwork| |error| |ifail| |aList| |blList| + |buList| |cList| |middle| |xList| |equationPart| + |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |itmax| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|itmax|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|itmax|))))) + (SPADLET |msg| (|htpButtonValue| |htPage| '|msglvl|)) + (SPADLET |msglvl| + (COND + ((BOOT-EQUAL |msg| '|mMinus|) '-1) + ((BOOT-EQUAL |msg| '|mZero|) '0) + ('T '1))) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |nclin| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|nclin|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|nclin|))))) + (SPADLET |nrowa| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|nrowa|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|nrowa|))))) + (SPADLET |lin| (|htpButtonValue| |htPage| '|linobj|)) + (SPADLET |linobj| + (COND + ((BOOT-EQUAL |lin| '|true|) + (MAKESTRING "true")) + ('T (MAKESTRING "false")))) + (SPADLET |liwork| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|liwork|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|liwork|))))) + (SPADLET |lwork| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|lwork|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|lwork|))))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |nrowa| '7) (EQL |n| 7) + (EQL |nclin| 7)) + (|e04mbfDefaultSolve| |htPage| |itmax| |msglvl| + |linobj| |liwork| |lwork| |ifail|)) + ('T + (SPADLET |aList| + (PROG (G166655) + (SPADLET G166655 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |nrowa|) G166655) + (SEQ (EXIT + (SETQ G166655 + (APPEND G166655 + (|e04mbfSolve,fa| |i| |n|))))))))) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter lower boundary ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "conditions {\\it bl(n + nclin)}: \\newline "))) + (SPADLET |blList| + (PROG (G166663) + (SPADLET G166663 NIL) + (RETURN + (DO ((G166668 (PLUS |n| |nclin|)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G166668) G166663) + (SEQ (EXIT + (SETQ G166663 + (APPEND G166663 + (|e04mbfSolve,fc| |i|))))))))) + (SPADLET |blList| + (CONS (CONS '|text| |middle|) |blList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter upper boundary ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "conditions {\\it bu(n+nclin)}: \\newline "))) + (SPADLET |buList| + (PROG (G166672) + (SPADLET G166672 NIL) + (RETURN + (DO ((G166677 (PLUS |n| |nclin|)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G166677) G166672) + (SEQ (EXIT + (SETQ G166672 + (APPEND G166672 + (|e04mbfSolve,fd| |i|))))))))) + (SPADLET |buList| + (CONS (CONS '|text| |middle|) |buList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter coefficients of the ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "objective function {\\it cvec(n)}: \\newline "))) + (SPADLET |cList| + (PROG (G166681) + (SPADLET G166681 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166681) + (SEQ (EXIT + (SETQ G166681 + (APPEND G166681 + (|e04mbfSolve,fe| |i|))))))))) + (SPADLET |cList| + (CONS (CONS '|text| |middle|) |cList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter initial guess ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "of the solution vector {\\it x(n)}: \\newline "))) + (SPADLET |xList| + (PROG (G166689) + (SPADLET G166689 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166689) + (SEQ (EXIT + (SETQ G166689 + (APPEND G166689 + (|e04mbfSolve,fg| |i|))))))))) + (SPADLET |xList| + (CONS (CONS '|text| |middle|) |xList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (APPEND |aList| + (APPEND |blList| + (APPEND |buList| + (APPEND |cList| |xList|)))))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "E04MBF - Linear programming problem") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING + "Enter the elements of the array {\\it a(nrowa,n)}: \\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|e04mbfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|nclin| |nclin|) + (|htpSetProperty| |page| '|nrowa| |nrowa|) + (|htpSetProperty| |page| '|itmax| |itmax|) + (|htpSetProperty| |page| '|msglvl| |msglvl|) + (|htpSetProperty| |page| '|linobj| |linobj|) + (|htpSetProperty| |page| '|liwork| |liwork|) + (|htpSetProperty| |page| '|lwork| |lwork|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;e04mbfDefaultSolve(htPage,itmax,msglvl,linobj,liwork,lwork,ifail) == +; n := '7 +; nclin := '7 +; nrowa := '7 +; page:= htInitPage('"E04MBF - Linear programming problem",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the elements of array {\it a(nrowa,n)}: \newline ") +; (bcStrings (5 "1" a11 F)) +; (bcStrings (5 "1" a12 F)) +; (bcStrings (5 "1" a13 F)) +; (bcStrings (5 "1" a14 F)) +; (bcStrings (5 "1" a15 F)) +; (bcStrings (5 "1" a16 F)) +; (bcStrings (5 "1" a17 F)) +; (text . "\newline ") +; (bcStrings (5 "0.15" a21 F)) +; (bcStrings (5 "0.04" a22 F)) +; (bcStrings (5 "0.02" a23 F)) +; (bcStrings (5 "0.04" a24 F)) +; (bcStrings (5 "0.02" a25 F)) +; (bcStrings (5 "0.01" a26 F)) +; (bcStrings (5 "0.03" a27 F)) +; (text . "\newline ") +; (bcStrings (5 "0.03" a31 F)) +; (bcStrings (5 "0.05" a32 F)) +; (bcStrings (5 "0.08" a33 F)) +; (bcStrings (5 "0.02" a34 F)) +; (bcStrings (5 "0.06" a35 F)) +; (bcStrings (5 "0.01" a36 F)) +; (bcStrings (5 "0" a37 F)) +; (text . "\newline ") +; (bcStrings (5 "0.02" a41 F)) +; (bcStrings (5 "0.04" a42 F)) +; (bcStrings (5 "0.01" a43 F)) +; (bcStrings (5 "0.02" a44 F)) +; (bcStrings (5 "0.02" a45 F)) +; (bcStrings (5 "0" a46 F)) +; (bcStrings (5 "0" a47 F)) +; (text . "\newline ") +; (bcStrings (5 "0.02" a51 F)) +; (bcStrings (5 "0.03" a52 F)) +; (bcStrings (5 "0" a53 F)) +; (bcStrings (5 "0" a54 F)) +; (bcStrings (5 "0.01" a55 F)) +; (bcStrings (5 "0" a56 F)) +; (bcStrings (5 "0" a57 F)) +; (text . "\newline ") +; (bcStrings (5 "0.7" a61 F)) +; (bcStrings (5 "0.75" a62 F)) +; (bcStrings (5 "0.8" a63 F)) +; (bcStrings (5 "0.75" a64 F)) +; (bcStrings (5 "0.8" a65 F)) +; (bcStrings (5 "0.97" a66 F)) +; (bcStrings (5 "0" a67 F)) +; (text . "\newline ") +; (bcStrings (5 "0.02" a71 F)) +; (bcStrings (5 "0.06" a72 F)) +; (bcStrings (5 "0.08" a73 F)) +; (bcStrings (5 "0.12" a74 F)) +; (bcStrings (5 "0.02" a75 F)) +; (bcStrings (5 "0.01" a76 F)) +; (bcStrings (5 "0.97" a77 F)) +; (text . "\newline ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter lower boundary conditions {\it bl(n+nclin)}: \newline ") +; (bcStrings (8 "-0.01" bl1 F)) +; (bcStrings (8 "-0.1" bl2 F)) +; (bcStrings (8 "-0.01" bl3 F)) +; (bcStrings (8 "-0.04" bl4 F)) +; (bcStrings (8 "-0.1" bl5 F)) +; (bcStrings (8 "-0.01" bl6 F)) +; (bcStrings (8 "-0.01" bl7 F)) +; (bcStrings (8 "-0.13" bl8 F)) +; (bcStrings (8 "-1.0e+21" bl9 F)) +; (bcStrings (8 "-1.0e+21" bl10 F)) +; (bcStrings (8 "-1.0e+21" bl11 F)) +; (bcStrings (8 "-1.0e+21" bl12 F)) +; (bcStrings (8 "-0.0992" bl13 F)) +; (bcStrings (8 "-0.003" bl14 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter upper boundary conditions {\it bu(n+nclin)}: \newline ") +; (bcStrings (8 "0.01" bu1 F)) +; (bcStrings (8 "0.15" bu2 F)) +; (bcStrings (8 "0.03" bu3 F)) +; (bcStrings (8 "0.02" bu4 F)) +; (bcStrings (8 "0.05" bu5 F)) +; (bcStrings (8 "1.0e+21" bu6 F)) +; (bcStrings (8 "1.0e+21" bu7 F)) +; (bcStrings (8 "-0.13" bu8 F)) +; (bcStrings (8 "-0.0049" bu9 F)) +; (bcStrings (8 "-0.0064" bu10 F)) +; (bcStrings (8 "-0.0037" bu11 F)) +; (bcStrings (8 "-0.0012" bu12 F)) +; (bcStrings (8 "1.0e+21" bu13 F)) +; (bcStrings (8 "0.002" bu14 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter coefficients of the objective function, {\it cvec(n)}: ") +; (text . "\newline ") +; (bcStrings (8 "-0.02" c1 F)) +; (bcStrings (8 "-0.2" c2 F)) +; (bcStrings (8 "-0.2" c3 F)) +; (bcStrings (8 "-0.2" c4 F)) +; (bcStrings (8 "-0.2" c5 F)) +; (bcStrings (8 "0.04" c6 F)) +; (bcStrings (8 "0.04" c7 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter initial guess of the solution vector, {\it x(n)}: ") +; (text . "\newline ") +; (bcStrings (8 "-0.01" x1 F)) +; (bcStrings (8 "-0.03" x2 F)) +; (bcStrings (8 "0.0" x3 F)) +; (bcStrings (8 "-0.01" x4 F)) +; (bcStrings (8 "-0.1" x5 F)) +; (bcStrings (8 "0.02" x6 F)) +; (bcStrings (8 "0.01" x7 F))) +; htMakeDoneButton('"Continue",'e04mbfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'nclin,nclin) +; htpSetProperty(page,'nrowa,nrowa) +; htpSetProperty(page,'itmax,itmax) +; htpSetProperty(page,'msglvl,msglvl) +; htpSetProperty(page,'linobj,linobj) +; htpSetProperty(page,'liwork,liwork) +; htpSetProperty(page,'lwork,lwork) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |e04mbfDefaultSolve| + (|htPage| |itmax| |msglvl| |linobj| |liwork| |lwork| |ifail|) + (PROG (|n| |nclin| |nrowa| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '7) + (SPADLET |nclin| '7) + (SPADLET |nrowa| '7) + (SPADLET |page| + (|htInitPage| + (MAKESTRING "E04MBF - Linear programming problem") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the elements of array {\\it a(nrowa,n)}: \\newline ") + (|bcStrings| (5 "1" |a11| F)) + (|bcStrings| (5 "1" |a12| F)) + (|bcStrings| (5 "1" |a13| F)) + (|bcStrings| (5 "1" |a14| F)) + (|bcStrings| (5 "1" |a15| F)) + (|bcStrings| (5 "1" |a16| F)) + (|bcStrings| (5 "1" |a17| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0.15" |a21| F)) + (|bcStrings| (5 "0.04" |a22| F)) + (|bcStrings| (5 "0.02" |a23| F)) + (|bcStrings| (5 "0.04" |a24| F)) + (|bcStrings| (5 "0.02" |a25| F)) + (|bcStrings| (5 "0.01" |a26| F)) + (|bcStrings| (5 "0.03" |a27| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0.03" |a31| F)) + (|bcStrings| (5 "0.05" |a32| F)) + (|bcStrings| (5 "0.08" |a33| F)) + (|bcStrings| (5 "0.02" |a34| F)) + (|bcStrings| (5 "0.06" |a35| F)) + (|bcStrings| (5 "0.01" |a36| F)) + (|bcStrings| (5 "0" |a37| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0.02" |a41| F)) + (|bcStrings| (5 "0.04" |a42| F)) + (|bcStrings| (5 "0.01" |a43| F)) + (|bcStrings| (5 "0.02" |a44| F)) + (|bcStrings| (5 "0.02" |a45| F)) + (|bcStrings| (5 "0" |a46| F)) + (|bcStrings| (5 "0" |a47| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0.02" |a51| F)) + (|bcStrings| (5 "0.03" |a52| F)) + (|bcStrings| (5 "0" |a53| F)) + (|bcStrings| (5 "0" |a54| F)) + (|bcStrings| (5 "0.01" |a55| F)) + (|bcStrings| (5 "0" |a56| F)) + (|bcStrings| (5 "0" |a57| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0.7" |a61| F)) + (|bcStrings| (5 "0.75" |a62| F)) + (|bcStrings| (5 "0.8" |a63| F)) + (|bcStrings| (5 "0.75" |a64| F)) + (|bcStrings| (5 "0.8" |a65| F)) + (|bcStrings| (5 "0.97" |a66| F)) + (|bcStrings| (5 "0" |a67| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0.02" |a71| F)) + (|bcStrings| (5 "0.06" |a72| F)) + (|bcStrings| (5 "0.08" |a73| F)) + (|bcStrings| (5 "0.12" |a74| F)) + (|bcStrings| (5 "0.02" |a75| F)) + (|bcStrings| (5 "0.01" |a76| F)) + (|bcStrings| (5 "0.97" |a77| F)) (|text| . "\\newline ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter lower boundary conditions {\\it bl(n+nclin)}: \\newline ") + (|bcStrings| (8 "-0.01" |bl1| F)) + (|bcStrings| (8 "-0.1" |bl2| F)) + (|bcStrings| (8 "-0.01" |bl3| F)) + (|bcStrings| (8 "-0.04" |bl4| F)) + (|bcStrings| (8 "-0.1" |bl5| F)) + (|bcStrings| (8 "-0.01" |bl6| F)) + (|bcStrings| (8 "-0.01" |bl7| F)) + (|bcStrings| (8 "-0.13" |bl8| F)) + (|bcStrings| (8 "-1.0e+21" |bl9| F)) + (|bcStrings| (8 "-1.0e+21" |bl10| F)) + (|bcStrings| (8 "-1.0e+21" |bl11| F)) + (|bcStrings| (8 "-1.0e+21" |bl12| F)) + (|bcStrings| (8 "-0.0992" |bl13| F)) + (|bcStrings| (8 "-0.003" |bl14| F)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter upper boundary conditions {\\it bu(n+nclin)}: \\newline ") + (|bcStrings| (8 "0.01" |bu1| F)) + (|bcStrings| (8 "0.15" |bu2| F)) + (|bcStrings| (8 "0.03" |bu3| F)) + (|bcStrings| (8 "0.02" |bu4| F)) + (|bcStrings| (8 "0.05" |bu5| F)) + (|bcStrings| (8 "1.0e+21" |bu6| F)) + (|bcStrings| (8 "1.0e+21" |bu7| F)) + (|bcStrings| (8 "-0.13" |bu8| F)) + (|bcStrings| (8 "-0.0049" |bu9| F)) + (|bcStrings| (8 "-0.0064" |bu10| F)) + (|bcStrings| (8 "-0.0037" |bu11| F)) + (|bcStrings| (8 "-0.0012" |bu12| F)) + (|bcStrings| (8 "1.0e+21" |bu13| F)) + (|bcStrings| (8 "0.002" |bu14| F)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter coefficients of the objective function, {\\it cvec(n)}: ") + (|text| . "\\newline ") (|bcStrings| (8 "-0.02" |c1| F)) + (|bcStrings| (8 "-0.2" |c2| F)) + (|bcStrings| (8 "-0.2" |c3| F)) + (|bcStrings| (8 "-0.2" |c4| F)) + (|bcStrings| (8 "-0.2" |c5| F)) + (|bcStrings| (8 "0.04" |c6| F)) + (|bcStrings| (8 "0.04" |c7| F)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter initial guess of the solution vector, {\\it x(n)}: ") + (|text| . "\\newline ") (|bcStrings| (8 "-0.01" |x1| F)) + (|bcStrings| (8 "-0.03" |x2| F)) + (|bcStrings| (8 "0.0" |x3| F)) + (|bcStrings| (8 "-0.01" |x4| F)) + (|bcStrings| (8 "-0.1" |x5| F)) + (|bcStrings| (8 "0.02" |x6| F)) + (|bcStrings| (8 "0.01" |x7| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|e04mbfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|nclin| |nclin|) + (|htpSetProperty| |page| '|nrowa| |nrowa|) + (|htpSetProperty| |page| '|itmax| |itmax|) + (|htpSetProperty| |page| '|msglvl| |msglvl|) + (|htpSetProperty| |page| '|linobj| |linobj|) + (|htpSetProperty| |page| '|liwork| |liwork|) + (|htpSetProperty| |page| '|lwork| |lwork|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;e04mbfGen htPage == +; n := htpProperty(htPage, 'n) +; nclin := htpProperty(htPage, 'nclin) +; nrowa := htpProperty(htPage, 'nrowa) +; itmax := htpProperty(htPage, 'itmax) +; msglvl := htpProperty(htPage, 'msglvl) +; linobj := htpProperty(htPage, 'linobj) +; liwork := htpProperty(htPage,'liwork) +; lwork := htpProperty(htPage,'lwork) +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..n repeat +; temp := STRCONC ((first y).1," ") +; xlist := [temp,:xlist] +; y := rest y +; xstring := bcwords2liststring xlist +; for i in 1..n repeat +; temp := STRCONC ((first y).1," ") +; clist := [temp,:clist] +; y := rest y +; cstring := bcwords2liststring clist +; for i in 1..(n+nclin) repeat +; temp := STRCONC ((first y).1," ") +; bulist := [temp,:bulist] +; y := rest y +; bustring := bcwords2liststring bulist +; for i in 1..(n+nclin) repeat +; temp := STRCONC ((first y).1," ") +; bllist := [temp,:bllist] +; y := rest y +; blstring := bcwords2liststring bllist +; for i in 1..nrowa repeat -- matrix A +; for j in 1..n repeat +; a := STRCONC((first y).1," ") +; arrlist := [a,:arrlist] +; y := rest y +; amatlist := [:amatlist,arrlist] +; arrlist := [] +; amatlist := reverse amatlist +; amatstr := bcwords2liststring [bcwords2liststring x for x in amatlist] +; nctotl := n + nclin +; prefix := STRCONC("e04mbf(",STRINGIMAGE itmax,",", STRINGIMAGE msglvl,", ") +; prefix := STRCONC(prefix,STRINGIMAGE n,",",STRINGIMAGE nclin,", ") +; prefix := STRCONC(prefix,STRINGIMAGE nctotl,",",STRINGIMAGE nrowa,", ") +; middle := STRCONC(amatstr,",[") +; middle := STRCONC(middle,blstring,"],[",bustring,"],[",cstring) +; middle := STRCONC(middle,"],",linobj,", ",STRINGIMAGE liwork) +; middle := STRCONC(middle,",",STRINGIMAGE lwork,",[") +; middle := STRCONC(middle,xstring,"],",STRINGIMAGE ifail,")") +; linkGen STRCONC(prefix,middle) + +(DEFUN |e04mbfGen| (|htPage|) + (PROG (|n| |nclin| |nrowa| |itmax| |msglvl| |linobj| |liwork| |lwork| + |ifail| |alist| |xlist| |xstring| |clist| |cstring| + |bulist| |bustring| |temp| |bllist| |blstring| |a| |y| + |arrlist| |amatlist| |amatstr| |nctotl| |prefix| |middle|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |nclin| (|htpProperty| |htPage| '|nclin|)) + (SPADLET |nrowa| (|htpProperty| |htPage| '|nrowa|)) + (SPADLET |itmax| (|htpProperty| |htPage| '|itmax|)) + (SPADLET |msglvl| (|htpProperty| |htPage| '|msglvl|)) + (SPADLET |linobj| (|htpProperty| |htPage| '|linobj|)) + (SPADLET |liwork| (|htpProperty| |htPage| '|liwork|)) + (SPADLET |lwork| (|htpProperty| |htPage| '|lwork|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |xlist| (CONS |temp| |xlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |xstring| (|bcwords2liststring| |xlist|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |clist| (CONS |temp| |clist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |cstring| (|bcwords2liststring| |clist|)) + (DO ((G166775 (PLUS |n| |nclin|)) (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G166775) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |bulist| (CONS |temp| |bulist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |bustring| (|bcwords2liststring| |bulist|)) + (DO ((G166785 (PLUS |n| |nclin|)) (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G166785) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |bllist| (CONS |temp| |bllist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |blstring| (|bcwords2liststring| |bllist|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |nrowa|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |a| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |arrlist| + (CONS |a| |arrlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |amatlist| + (APPEND |amatlist| + (CONS |arrlist| NIL))) + (SPADLET |arrlist| NIL))))) + (SPADLET |amatlist| (REVERSE |amatlist|)) + (SPADLET |amatstr| + (|bcwords2liststring| + (PROG (G166814) + (SPADLET G166814 NIL) + (RETURN + (DO ((G166819 |amatlist| + (CDR G166819)) + (|x| NIL)) + ((OR (ATOM G166819) + (PROGN + (SETQ |x| (CAR G166819)) + NIL)) + (NREVERSE0 G166814)) + (SEQ (EXIT + (SETQ G166814 + (CONS (|bcwords2liststring| |x|) + G166814))))))))) + (SPADLET |nctotl| (PLUS |n| |nclin|)) + (SPADLET |prefix| + (STRCONC '|e04mbf(| (STRINGIMAGE |itmax|) '|,| + (STRINGIMAGE |msglvl|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |n|) '|,| + (STRINGIMAGE |nclin|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |nctotl|) '|,| + (STRINGIMAGE |nrowa|) '|, |)) + (SPADLET |middle| (STRCONC |amatstr| '|,[|)) + (SPADLET |middle| + (STRCONC |middle| |blstring| '|],[| |bustring| + '|],[| |cstring|)) + (SPADLET |middle| + (STRCONC |middle| '|],| |linobj| '|, | + (STRINGIMAGE |liwork|))) + (SPADLET |middle| + (STRCONC |middle| '|,| (STRINGIMAGE |lwork|) + '|,[|)) + (SPADLET |middle| + (STRCONC |middle| |xstring| '|],| + (STRINGIMAGE |ifail|) '|)|)) + (|linkGen| (STRCONC |prefix| |middle|))))))) + +;e04naf() == +; htInitPage('"E04NAF - Quadratic programming problem",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain PI (PositiveInteger)) +; (isDomain F (Float))) +; (text . "\windowlink{Manual Page}{manpageXXe04naf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04naf| '|NagOptimisationPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "E04NAF is a comprehensive routine to solve quadratic problems ") +; (text . "(QP) of the form \center{\htbitmap{e04naf}} \newline ") +; (text . "where {\it c} is a constant {\it n} element vector, {\it H} is a") +; (text . " constant {\it n} by {\it n} symmetric matrix, and the matrix ") +; (text . "{\it A} is {\it m} by {\it n}, i.e. there are {\it n} variables ") +; (text . "and {\it m} general linear constraints. {\it m} may be zero in ") +; (text . "which case the LP problem is subject only to bounds on the ") +; (text . "variables. \blankline If {\it H} = 0 a flag can be set so that ") +; (text . "the problem is treated as a linear programming (LP) problem. ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Upper bound on number of iterations, {\it itmax}:") +; (text . "\newline\tab{2} ") +; (bcStrings (6 20 itmax PI)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Type of output messages required, {\it msglvl}: ") +; (radioButtons msglvl +; (" < 0 " " No printing " mMinus) +; (" = 0 " " Printing only if an input parameter is incorrect or overflow is likely" mZero) +; (" = 1" " Printing occurs at the solution " mOne) +; (" = 5" " One line of output for each constraint addition or deletion, no printout" mFive) +; (" \htbitmap{great=} 10" " As above with printout of the solution" mTen) +; (" \htbitmap{great=} 15" " As above with X, ISTATE and indices of free variables at each iteration" mFifteen) +; (" \htbitmap{great=} 20" " As above with the Lagrange multiplier estimates and the free variables at each iteration" mTwenty) +; (" \htbitmap{great=} 30" " As above with the diagonal elements of the matrix {\it T} associated with the {\it TQ} factorization of the working set, and the diagonal elements of the Cholesky factor {\it R} of the projected Hessian" mThirty) +; (" \htbitmap{great=} 80" " As above with debug printout" mEighty) +; (" = 99" " As above with arrays {\it cvec} and {\it hess}" mNinetyNine)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of variables, {\it n}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (6 7 n PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of general linear constraints, {\it nclin}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (6 7 nclin PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "First dimension of array {\it a}, {\it nrowa}:") +; (text . "\newline\tab{2} ") +; (bcStrings (6 7 nrowa PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "First dimension of array {\it hess}, {\it nrowh}:") +; (text . "\newline\tab{2} ") +; (bcStrings (6 7 nrowh PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Second dimension of array {\it hess}, {\it ncolh}:") +; (text . "\newline\tab{2} ") +; (bcStrings (6 7 ncolh PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Size above which a bound is regarded as infinite, {\it bigbnd}:") +; (text . "\newline\tab{2} ") +; (bcStrings (10 "1.0e10" bigbnd F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Specifies whether or not an initial estimate of the active constraints is present, {\it cold}:") +; (radioButtons cold +; ("" " true - E04NAF determines the initial working set" cTrue) +; ("" " false - user defined contents of array {\it istate}" cFalse)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Specifies whether or not {\it h} is a zero matrix, {\it lp}:") +; (radioButtons lp +; ("" " false - QP problem " lFalse) +; ("" " true - LP problem, {\it hess} and {\it qphess} are not referenced " lTrue)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Specifies whether or not orthogonal transformations are to be used in computing and updating the working set, {\it orthog}:") +; (radioButtons orthog +; ("" " true " oTrue) +; ("" " false " oFalse)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Dimension of {\it iwork}, {\it liwork}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 14 liwork F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Dimension of {\it work}, {\it lwork}:") +; (text . "\newline\tab{2} ") +; (bcStrings (5 238 lwork F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'e04nafSolve) +; htShowPage() + +(DEFUN |e04naf| () + (declare (special |$EmptyMode|)) + (PROGN + (|htInitPage| (MAKESTRING "E04NAF - Quadratic programming problem") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| PI (|PositiveInteger|)) + (|isDomain| F (|Float|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXe04naf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04naf| '|NagOptimisationPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "E04NAF is a comprehensive routine to solve quadratic problems ") + (|text| + . "(QP) of the form \\center{\\htbitmap{e04naf}} \\newline ") + (|text| + . "where {\\it c} is a constant {\\it n} element vector, {\\it H} is a") + (|text| + . " constant {\\it n} by {\\it n} symmetric matrix, and the matrix ") + (|text| + . "{\\it A} is {\\it m} by {\\it n}, i.e. there are {\\it n} variables ") + (|text| + . "and {\\it m} general linear constraints. {\\it m} may be zero in ") + (|text| + . "which case the LP problem is subject only to bounds on the ") + (|text| + . "variables. \\blankline If {\\it H} = 0 a flag can be set so that ") + (|text| + . "the problem is treated as a linear programming (LP) problem. ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Upper bound on number of iterations, {\\it itmax}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (6 20 |itmax| PI)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Type of output messages required, {\\it msglvl}: ") + (|radioButtons| |msglvl| (" < 0 " " No printing " |mMinus|) + (" = 0 " + " Printing only if an input parameter is incorrect or overflow is likely" + |mZero|) + (" = 1" " Printing occurs at the solution " |mOne|) + (" = 5" + " One line of output for each constraint addition or deletion, no printout" + |mFive|) + (" \\htbitmap{great=} 10" + " As above with printout of the solution" |mTen|) + (" \\htbitmap{great=} 15" + " As above with X, ISTATE and indices of free variables at each iteration" + |mFifteen|) + (" \\htbitmap{great=} 20" + " As above with the Lagrange multiplier estimates and the free variables at each iteration" + |mTwenty|) + (" \\htbitmap{great=} 30" + " As above with the diagonal elements of the matrix {\\it T} associated with the {\\it TQ} factorization of the working set, and the diagonal elements of the Cholesky factor {\\it R} of the projected Hessian" + |mThirty|) + (" \\htbitmap{great=} 80" " As above with debug printout" + |mEighty|) + (" = 99" + " As above with arrays {\\it cvec} and {\\it hess}" + |mNinetyNine|)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Number of variables, {\\it n}: ") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (6 7 |n| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Number of general linear constraints, {\\it nclin}: ") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (6 7 |nclin| PI)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "First dimension of array {\\it a}, {\\it nrowa}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (6 7 |nrowa| PI)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "First dimension of array {\\it hess}, {\\it nrowh}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (6 7 |nrowh| PI)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Second dimension of array {\\it hess}, {\\it ncolh}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (6 7 |ncolh| PI)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Size above which a bound is regarded as infinite, {\\it bigbnd}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (10 "1.0e10" |bigbnd| F)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Specifies whether or not an initial estimate of the active constraints is present, {\\it cold}:") + (|radioButtons| |cold| + ("" " true - E04NAF determines the initial working set" + |cTrue|) + ("" + " false - user defined contents of array {\\it istate}" + |cFalse|)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Specifies whether or not {\\it h} is a zero matrix, {\\it lp}:") + (|radioButtons| |lp| ("" " false - QP problem " |lFalse|) + ("" + " true - LP problem, {\\it hess} and {\\it qphess} are not referenced " + |lTrue|)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Specifies whether or not orthogonal transformations are to be used in computing and updating the working set, {\\it orthog}:") + (|radioButtons| |orthog| ("" " true " |oTrue|) + ("" " false " |oFalse|)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| . "Dimension of {\\it iwork}, {\\it liwork}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (5 14 |liwork| F)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Dimension of {\\it work}, {\\it lwork}:") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (5 238 |lwork| F)) (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|e04nafSolve|) + (|htShowPage|))) + +;e04nafSolve htPage == +; itmax := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'itmax) +; objValUnwrap htpLabelSpadValue(htPage, 'itmax) +; msg := htpButtonValue(htPage,'msglvl) +; msglvl := +; msg = 'mMinus => '-1 +; msg = 'mZero => '0 +; msg = 'mOne => '1 +; msg = 'mFive => '5 +; msg = 'mTen => '10 +; msg = 'mFifteen => '15 +; msg = 'mTwenty => '20 +; msg = 'mThirty => '30 +; msg = 'mEighty => '80 +; '99 +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; nclin := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nclin) +; objValUnwrap htpLabelSpadValue(htPage, 'nclin) +; nrowa := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrowa) +; objValUnwrap htpLabelSpadValue(htPage, 'nrowa) +; nrowh := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nrowh) +; objValUnwrap htpLabelSpadValue(htPage, 'nrowh) +; ncolh := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncolh) +; objValUnwrap htpLabelSpadValue(htPage, 'ncolh) +; bigbnd := htpLabelInputString(htPage,'bigbnd) +; col := htpButtonValue(htPage,'cold) +; cold := +; col = 'cTrue => '"true" +; '"false" +; linear := htpButtonValue(htPage,'lp) +; lp := +; linear = 'lTrue => '"true" +; '"false" +; ortho := htpButtonValue(htPage,'orthog) +; orthog := +; ortho = 'oTrue => '"true" +; '"false" +; liwork := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'liwork) +; objValUnwrap htpLabelSpadValue(htPage, 'liwork) +; lwork := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lwork) +; objValUnwrap htpLabelSpadValue(htPage, 'lwork) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; (((nrowa = '7 and n = '7) and (nrowh = '7 and ncolh ='7)) and nclin = '7) => +; e04nafDefaultSolve(htPage,itmax,msglvl,bigbnd,cold,lp,orthog,liwork,lwork,ifail) +; aList := +; "append"/[fa(i,n) for i in 1..nrowa] where fa(i,n) == +; labelList := +; "append"/[fb(i,j) for j in 1..n] where fb(i,j) == +; anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) +; [['bcStrings,[8, 0, anam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter lower boundary ") +; middle := STRCONC(middle,'"conditions {\it bl(n + nclin)}: \newline ") +; blList := +; "append"/[fc(i) for i in 1..(n+nclin)] where fc(i) == +; blnam := INTERN STRCONC ('"bl",STRINGIMAGE i) +; [['bcStrings,[8, '"0.0", blnam, 'F]]] +; blList := [['text,:middle],:blList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter upper boundary ") +; middle := STRCONC(middle,'"conditions {\it bu(n+nclin)}: \newline ") +; buList := +; "append"/[fd(i) for i in 1..(n+nclin)] where fd(i) == +; bunam := INTERN STRCONC ('"bu",STRINGIMAGE i) +; [['bcStrings,[8, '"0.0", bunam, 'F]]] +; buList := [['text,:middle],:buList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter coefficients of the ") +; middle := STRCONC(middle,'"objective function {\it cvec(n)}: \newline ") +; cList := +; "append"/[fe(i) for i in 1..n] where fe(i) == +; cnam := INTERN STRCONC ('"c",STRINGIMAGE i) +; [['bcStrings,[8, '"0.0", cnam, 'F]]] +; cList := [['text,:middle],:cList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter set of positive ") +; middle := STRCONC(middle,'"tolerances {\it featol(n+nclin)}: \newline ") +; fList := +; "append"/[ff(i) for i in 1..(n+nclin)] where ff(i) == +; fnam := INTERN STRCONC ('"f",STRINGIMAGE i) +; [['bcStrings,[9, '"0.1053e-7", fnam, 'F]]] +; fList := [['text,:middle],:fList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter the elements of ") +; middle := STRCONC(middle,'"array {\it hess(nrowh,ncolh)}: \newline ") +; hList := +; "append"/[fh(i,n) for i in 1..nrowh] where fh(i,n) == +; labelList := +; "append"/[fi(i,j) for j in 1..n] where fi(i,j) == +; hnam := INTERN STRCONC ('"h",STRINGIMAGE i,STRINGIMAGE j) +; [['bcStrings,[8, 0, hnam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; hList := [['text,:middle],:hList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ") +; middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ") +; xList := +; "append"/[fg(i) for i in 1..n] where fg(i) == +; xnam := INTERN STRCONC ('"x",STRINGIMAGE i) +; [['bcStrings,[8, '"0.0", xnam, 'F]]] +; xList := [['text,:middle],:xList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} If {\it cold} = false ") +; middle := STRCONC(middle,'"enter {\it istate(n+nclin)} values: \newline ") +; iList := +; "append"/[fj(i) for i in 1..(n+nclin)] where fj(i) == +; inam := INTERN STRCONC ('"i",STRINGIMAGE i) +; [['bcStrings,[8, '"0.0", inam, 'F]]] +; iList := [['text,:middle],:iList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :aList,:blList,:buList,:cList,:fList,:hList,:xList,:iList] +; page:= htInitPage('"E04NAF - Quadratic programming problem",nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the elements of the array {\it a(nrowa,n)}: \newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'e04nafGen) +; htpSetProperty(page,'itmax,itmax) +; htpSetProperty(page,'msglvl,msglvl) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'nclin,nclin) +; htpSetProperty(page,'nrowa,nrowa) +; htpSetProperty(page,'nrowh,nrowh) +; htpSetProperty(page,'ncolh,ncolh) +; htpSetProperty(page,'bigbnd,bigbnd) +; htpSetProperty(page,'cold,cold) +; htpSetProperty(page,'lp,lp) +; htpSetProperty(page,'orthog,orthog) +; htpSetProperty(page,'liwork,liwork) +; htpSetProperty(page,'lwork,lwork) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |e04nafSolve,fb| (|i| |j|) + (PROG (|anam|) + (RETURN + (SEQ (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS 0 + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04nafSolve,fa| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166896) + (SPADLET G166896 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166896) + (SEQ (EXIT (SETQ G166896 + (APPEND G166896 + (|e04nafSolve,fb| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |e04nafSolve,fc| (|i|) + (PROG (|blnam|) + (RETURN + (SEQ (SPADLET |blnam| + (INTERN (STRCONC (MAKESTRING "bl") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS (MAKESTRING "0.0") + (CONS |blnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04nafSolve,fd| (|i|) + (PROG (|bunam|) + (RETURN + (SEQ (SPADLET |bunam| + (INTERN (STRCONC (MAKESTRING "bu") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS (MAKESTRING "0.0") + (CONS |bunam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04nafSolve,fe| (|i|) + (PROG (|cnam|) + (RETURN + (SEQ (SPADLET |cnam| + (INTERN (STRCONC (MAKESTRING "c") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS (MAKESTRING "0.0") + (CONS |cnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04nafSolve,ff| (|i|) + (PROG (|fnam|) + (RETURN + (SEQ (SPADLET |fnam| + (INTERN (STRCONC (MAKESTRING "f") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 9 + (CONS (MAKESTRING "0.1053e-7") + (CONS |fnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04nafSolve,fi| (|i| |j|) + (PROG (|hnam|) + (RETURN + (SEQ (SPADLET |hnam| + (INTERN (STRCONC (MAKESTRING "h") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS 0 + (CONS |hnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04nafSolve,fh| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G166943) + (SPADLET G166943 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G166943) + (SEQ (EXIT (SETQ G166943 + (APPEND G166943 + (|e04nafSolve,fi| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |e04nafSolve,fg| (|i|) + (PROG (|xnam|) + (RETURN + (SEQ (SPADLET |xnam| + (INTERN (STRCONC (MAKESTRING "x") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS (MAKESTRING "0.0") + (CONS |xnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04nafSolve,fj| (|i|) + (PROG (|inam|) + (RETURN + (SEQ (SPADLET |inam| + (INTERN (STRCONC (MAKESTRING "i") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS (MAKESTRING "0.0") + (CONS |inam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04nafSolve| (|htPage|) + (PROG (|itmax| |msg| |msglvl| |n| |nclin| |nrowa| |nrowh| |ncolh| + |bigbnd| |col| |cold| |linear| |lp| |ortho| |orthog| + |liwork| |lwork| |error| |ifail| |aList| |blList| + |buList| |cList| |fList| |hList| |xList| |middle| + |iList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |itmax| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|itmax|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|itmax|))))) + (SPADLET |msg| (|htpButtonValue| |htPage| '|msglvl|)) + (SPADLET |msglvl| + (COND + ((BOOT-EQUAL |msg| '|mMinus|) '-1) + ((BOOT-EQUAL |msg| '|mZero|) '0) + ((BOOT-EQUAL |msg| '|mOne|) '1) + ((BOOT-EQUAL |msg| '|mFive|) '5) + ((BOOT-EQUAL |msg| '|mTen|) '10) + ((BOOT-EQUAL |msg| '|mFifteen|) '15) + ((BOOT-EQUAL |msg| '|mTwenty|) '20) + ((BOOT-EQUAL |msg| '|mThirty|) '30) + ((BOOT-EQUAL |msg| '|mEighty|) '80) + ('T '99))) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |nclin| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|nclin|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|nclin|))))) + (SPADLET |nrowa| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|nrowa|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|nrowa|))))) + (SPADLET |nrowh| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|nrowh|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|nrowh|))))) + (SPADLET |ncolh| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|ncolh|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|ncolh|))))) + (SPADLET |bigbnd| + (|htpLabelInputString| |htPage| '|bigbnd|)) + (SPADLET |col| (|htpButtonValue| |htPage| '|cold|)) + (SPADLET |cold| + (COND + ((BOOT-EQUAL |col| '|cTrue|) + (MAKESTRING "true")) + ('T (MAKESTRING "false")))) + (SPADLET |linear| (|htpButtonValue| |htPage| '|lp|)) + (SPADLET |lp| + (COND + ((BOOT-EQUAL |linear| '|lTrue|) + (MAKESTRING "true")) + ('T (MAKESTRING "false")))) + (SPADLET |ortho| (|htpButtonValue| |htPage| '|orthog|)) + (SPADLET |orthog| + (COND + ((BOOT-EQUAL |ortho| '|oTrue|) + (MAKESTRING "true")) + ('T (MAKESTRING "false")))) + (SPADLET |liwork| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|liwork|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|liwork|))))) + (SPADLET |lwork| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|lwork|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|lwork|))))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (BOOT-EQUAL |nrowa| '7) (BOOT-EQUAL |n| '7) + (BOOT-EQUAL |nrowh| '7) (BOOT-EQUAL |ncolh| '7) + (BOOT-EQUAL |nclin| '7)) + (|e04nafDefaultSolve| |htPage| |itmax| |msglvl| + |bigbnd| |cold| |lp| |orthog| |liwork| |lwork| + |ifail|)) + ('T + (SPADLET |aList| + (PROG (G166972) + (SPADLET G166972 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |nrowa|) G166972) + (SEQ (EXIT + (SETQ G166972 + (APPEND G166972 + (|e04nafSolve,fa| |i| |n|))))))))) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter lower boundary ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "conditions {\\it bl(n + nclin)}: \\newline "))) + (SPADLET |blList| + (PROG (G166980) + (SPADLET G166980 NIL) + (RETURN + (DO ((G166985 (PLUS |n| |nclin|)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G166985) G166980) + (SEQ (EXIT + (SETQ G166980 + (APPEND G166980 + (|e04nafSolve,fc| |i|))))))))) + (SPADLET |blList| + (CONS (CONS '|text| |middle|) |blList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter upper boundary ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "conditions {\\it bu(n+nclin)}: \\newline "))) + (SPADLET |buList| + (PROG (G166989) + (SPADLET G166989 NIL) + (RETURN + (DO ((G166994 (PLUS |n| |nclin|)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G166994) G166989) + (SEQ (EXIT + (SETQ G166989 + (APPEND G166989 + (|e04nafSolve,fd| |i|))))))))) + (SPADLET |buList| + (CONS (CONS '|text| |middle|) |buList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter coefficients of the ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "objective function {\\it cvec(n)}: \\newline "))) + (SPADLET |cList| + (PROG (G166998) + (SPADLET G166998 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G166998) + (SEQ (EXIT + (SETQ G166998 + (APPEND G166998 + (|e04nafSolve,fe| |i|))))))))) + (SPADLET |cList| + (CONS (CONS '|text| |middle|) |cList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter set of positive ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "tolerances {\\it featol(n+nclin)}: \\newline "))) + (SPADLET |fList| + (PROG (G167006) + (SPADLET G167006 NIL) + (RETURN + (DO ((G167011 (PLUS |n| |nclin|)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G167011) G167006) + (SEQ (EXIT + (SETQ G167006 + (APPEND G167006 + (|e04nafSolve,ff| |i|))))))))) + (SPADLET |fList| + (CONS (CONS '|text| |middle|) |fList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter the elements of ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "array {\\it hess(nrowh,ncolh)}: \\newline "))) + (SPADLET |hList| + (PROG (G167015) + (SPADLET G167015 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |nrowh|) G167015) + (SEQ (EXIT + (SETQ G167015 + (APPEND G167015 + (|e04nafSolve,fh| |i| |n|))))))))) + (SPADLET |hList| + (CONS (CONS '|text| |middle|) |hList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter initial guess ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "of the solution vector {\\it x(n)}: \\newline "))) + (SPADLET |xList| + (PROG (G167023) + (SPADLET G167023 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G167023) + (SEQ (EXIT + (SETQ G167023 + (APPEND G167023 + (|e04nafSolve,fg| |i|))))))))) + (SPADLET |xList| + (CONS (CONS '|text| |middle|) |xList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} If {\\it cold} = false ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "enter {\\it istate(n+nclin)} values: \\newline "))) + (SPADLET |iList| + (PROG (G167031) + (SPADLET G167031 NIL) + (RETURN + (DO ((G167036 (PLUS |n| |nclin|)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G167036) G167031) + (SEQ (EXIT + (SETQ G167031 + (APPEND G167031 + (|e04nafSolve,fj| |i|))))))))) + (SPADLET |iList| + (CONS (CONS '|text| |middle|) |iList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (APPEND |aList| + (APPEND |blList| + (APPEND |buList| + (APPEND |cList| + (APPEND |fList| + (APPEND |hList| + (APPEND |xList| |iList|))))))))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "E04NAF - Quadratic programming problem") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING + "Enter the elements of the array {\\it a(nrowa,n)}: \\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|e04nafGen|) + (|htpSetProperty| |page| '|itmax| |itmax|) + (|htpSetProperty| |page| '|msglvl| |msglvl|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|nclin| |nclin|) + (|htpSetProperty| |page| '|nrowa| |nrowa|) + (|htpSetProperty| |page| '|nrowh| |nrowh|) + (|htpSetProperty| |page| '|ncolh| |ncolh|) + (|htpSetProperty| |page| '|bigbnd| |bigbnd|) + (|htpSetProperty| |page| '|cold| |cold|) + (|htpSetProperty| |page| '|lp| |lp|) + (|htpSetProperty| |page| '|orthog| |orthog|) + (|htpSetProperty| |page| '|liwork| |liwork|) + (|htpSetProperty| |page| '|lwork| |lwork|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;e04nafDefaultSolve(htPage,itmax,msglvl,bigbnd,cold,lp,orthog,liwork,lwork,ifail) == +; n := '7 +; nclin := '7 +; nrowa := '7 +; nrowh := '7 +; ncolh := '7 +; page:= htInitPage('"E04NAF - Quadratic programming problem",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the elements of array {\it a(nrowa,n)}: \newline ") +; (bcStrings (5 "1" a11 F)) +; (bcStrings (5 "1" a12 F)) +; (bcStrings (5 "1" a13 F)) +; (bcStrings (5 "1" a14 F)) +; (bcStrings (5 "1" a15 F)) +; (bcStrings (5 "1" a16 F)) +; (bcStrings (5 "1" a17 F)) +; (text . "\newline ") +; (bcStrings (5 "0.15" a21 F)) +; (bcStrings (5 "0.04" a22 F)) +; (bcStrings (5 "0.02" a23 F)) +; (bcStrings (5 "0.04" a24 F)) +; (bcStrings (5 "0.02" a25 F)) +; (bcStrings (5 "0.01" a26 F)) +; (bcStrings (5 "0.03" a27 F)) +; (text . "\newline ") +; (bcStrings (5 "0.03" a31 F)) +; (bcStrings (5 "0.05" a32 F)) +; (bcStrings (5 "0.08" a33 F)) +; (bcStrings (5 "0.02" a34 F)) +; (bcStrings (5 "0.06" a35 F)) +; (bcStrings (5 "0.01" a36 F)) +; (bcStrings (5 "0" a37 F)) +; (text . "\newline ") +; (bcStrings (5 "0.02" a41 F)) +; (bcStrings (5 "0.04" a42 F)) +; (bcStrings (5 "0.01" a43 F)) +; (bcStrings (5 "0.02" a44 F)) +; (bcStrings (5 "0.02" a45 F)) +; (bcStrings (5 "0" a46 F)) +; (bcStrings (5 "0" a47 F)) +; (text . "\newline ") +; (bcStrings (5 "0.02" a51 F)) +; (bcStrings (5 "0.03" a52 F)) +; (bcStrings (5 "0" a53 F)) +; (bcStrings (5 "0" a54 F)) +; (bcStrings (5 "0.01" a55 F)) +; (bcStrings (5 "0" a56 F)) +; (bcStrings (5 "0" a57 F)) +; (text . "\newline ") +; (bcStrings (5 "0.7" a61 F)) +; (bcStrings (5 "0.75" a62 F)) +; (bcStrings (5 "0.8" a63 F)) +; (bcStrings (5 "0.75" a64 F)) +; (bcStrings (5 "0.8" a65 F)) +; (bcStrings (5 "0.97" a66 F)) +; (bcStrings (5 "0" a67 F)) +; (text . "\newline ") +; (bcStrings (5 "0.02" a71 F)) +; (bcStrings (5 "0.06" a72 F)) +; (bcStrings (5 "0.08" a73 F)) +; (bcStrings (5 "0.12" a74 F)) +; (bcStrings (5 "0.02" a75 F)) +; (bcStrings (5 "0.01" a76 F)) +; (bcStrings (5 "0.97" a77 F)) +; (text . "\newline ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter lower boundary conditions {\it bl(n+nclin)}: \newline ") +; (bcStrings (8 "-0.01" bl1 F)) +; (bcStrings (8 "-0.1" bl2 F)) +; (bcStrings (8 "-0.01" bl3 F)) +; (bcStrings (8 "-0.04" bl4 F)) +; (bcStrings (8 "-0.1" bl5 F)) +; (bcStrings (8 "-0.01" bl6 F)) +; (bcStrings (8 "-0.01" bl7 F)) +; (bcStrings (8 "-0.13" bl8 F)) +; (bcStrings (8 "-1.0e+21" bl9 F)) +; (bcStrings (8 "-1.0e+21" bl10 F)) +; (bcStrings (8 "-1.0e+21" bl11 F)) +; (bcStrings (8 "-1.0e+21" bl12 F)) +; (bcStrings (8 "-0.0992" bl13 F)) +; (bcStrings (8 "-0.003" bl14 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter upper boundary conditions {\it bu(n+nclin)}: \newline ") +; (bcStrings (8 "0.01" bu1 F)) +; (bcStrings (8 "0.15" bu2 F)) +; (bcStrings (8 "0.03" bu3 F)) +; (bcStrings (8 "0.02" bu4 F)) +; (bcStrings (8 "0.05" bu5 F)) +; (bcStrings (8 "1.0e+21" bu6 F)) +; (bcStrings (8 "1.0e+21" bu7 F)) +; (bcStrings (8 "-0.13" bu8 F)) +; (bcStrings (8 "-0.0049" bu9 F)) +; (bcStrings (8 "-0.0064" bu10 F)) +; (bcStrings (8 "-0.0037" bu11 F)) +; (bcStrings (8 "-0.0012" bu12 F)) +; (bcStrings (8 "1.0e+21" bu13 F)) +; (bcStrings (8 "0.002" bu14 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter coefficients of the objective function, {\it cvec(n)}: ") +; (text . "\newline ") +; (bcStrings (8 "-0.02" c1 F)) +; (bcStrings (8 "-0.2" c2 F)) +; (bcStrings (8 "-0.2" c3 F)) +; (bcStrings (8 "-0.2" c4 F)) +; (bcStrings (8 "-0.2" c5 F)) +; (bcStrings (8 "0.04" c6 F)) +; (bcStrings (8 "0.04" c7 F)) +; (text . "\newline ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter set of positive tolerances {\it featol(n+nclin)}:\newline ") +; (bcStrings (9 "0.1053e-7" f1 F)) +; (bcStrings (9 "0.1053e-7" f2 F)) +; (bcStrings (9 "0.1053e-7" f3 F)) +; (bcStrings (9 "0.1053e-7" f4 F)) +; (bcStrings (9 "0.1053e-7" f5 F)) +; (bcStrings (9 "0.1053e-7" f6 F)) +; (bcStrings (9 "0.1053e-7" f7 F)) +; (bcStrings (9 "0.1053e-7" f8 F)) +; (bcStrings (9 "0.1053e-7" f9 F)) +; (bcStrings (9 "0.1053e-7" f10 F)) +; (bcStrings (9 "0.1053e-7" f11 F)) +; (bcStrings (9 "0.1053e-7" f12 F)) +; (bcStrings (9 "0.1053e-7" f13 F)) +; (bcStrings (9 "0.1053e-7" f14 F)) +; (text . "\newline ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the elements of array {\it hess(nrowh,ncolh)}: \newline ") +; (bcStrings (5 "2" h11 F)) +; (bcStrings (5 "0" h12 F)) +; (bcStrings (5 "0" h13 F)) +; (bcStrings (5 "0" h14 F)) +; (bcStrings (5 "0" h15 F)) +; (bcStrings (5 "0" h16 F)) +; (bcStrings (5 "0" h17 F)) +; (text . "\newline ") +; (bcStrings (5 "0" h21 F)) +; (bcStrings (5 "2" h22 F)) +; (bcStrings (5 "0" h23 F)) +; (bcStrings (5 "0" h24 F)) +; (bcStrings (5 "0" h25 F)) +; (bcStrings (5 "0" h26 F)) +; (bcStrings (5 "0" h27 F)) +; (text . "\newline ") +; (bcStrings (5 "0" h31 F)) +; (bcStrings (5 "0" h32 F)) +; (bcStrings (5 "2" h33 F)) +; (bcStrings (5 "2" h34 F)) +; (bcStrings (5 "0" h35 F)) +; (bcStrings (5 "0" h36 F)) +; (bcStrings (5 "0" h37 F)) +; (text . "\newline ") +; (bcStrings (5 "0" h41 F)) +; (bcStrings (5 "0" h42 F)) +; (bcStrings (5 "2" h43 F)) +; (bcStrings (5 "2" h44 F)) +; (bcStrings (5 "0" h45 F)) +; (bcStrings (5 "0" h46 F)) +; (bcStrings (5 "0" h47 F)) +; (text . "\newline ") +; (bcStrings (5 "0" h51 F)) +; (bcStrings (5 "0" h52 F)) +; (bcStrings (5 "0" h53 F)) +; (bcStrings (5 "0" h54 F)) +; (bcStrings (5 "2" h55 F)) +; (bcStrings (5 "0" h56 F)) +; (bcStrings (5 "0" h57 F)) +; (text . "\newline ") +; (bcStrings (5 "0" h61 F)) +; (bcStrings (5 "0" h62 F)) +; (bcStrings (5 "0" h63 F)) +; (bcStrings (5 "0" h64 F)) +; (bcStrings (5 "0" h65 F)) +; (bcStrings (5 "-2" h66 F)) +; (bcStrings (5 "-2" h67 F)) +; (text . "\newline ") +; (bcStrings (5 "0" h71 F)) +; (bcStrings (5 "0" h72 F)) +; (bcStrings (5 "0" h73 F)) +; (bcStrings (5 "0" h74 F)) +; (bcStrings (5 "0" h75 F)) +; (bcStrings (5 "-2" h76 F)) +; (bcStrings (5 "-2" h77 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter initial guess of the solution vector, {\it x(n)}: ") +; (text . "\newline ") +; (bcStrings (8 "-0.01" x1 F)) +; (bcStrings (8 "-0.03" x2 F)) +; (bcStrings (8 "0.0" x3 F)) +; (bcStrings (8 "-0.01" x4 F)) +; (bcStrings (8 "-0.1" x5 F)) +; (bcStrings (8 "0.02" x6 F)) +; (bcStrings (8 "0.01" x7 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "If {\it cold} = false enter {\it istate(n+nclin)} values: ") +; (text . "\newline ") +; (bcStrings (8 "0" i1 F)) +; (bcStrings (8 "0" i2 F)) +; (bcStrings (8 "0" i3 F)) +; (bcStrings (8 "0" i4 F)) +; (bcStrings (8 "0" i5 F)) +; (bcStrings (8 "0" i6 F)) +; (bcStrings (8 "0" i7 F)) +; (bcStrings (8 "0" i8 F)) +; (bcStrings (8 "0" i9 F)) +; (bcStrings (8 "0" i10 F)) +; (bcStrings (8 "0" i11 F)) +; (bcStrings (8 "0" i12 F)) +; (bcStrings (8 "0" i13 F)) +; (bcStrings (8 "0" i14 F))) +; htMakeDoneButton('"Continue",'e04nafGen) +; htpSetProperty(page,'itmax,itmax) +; htpSetProperty(page,'msglvl,msglvl) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'nclin,nclin) +; htpSetProperty(page,'nrowa,nrowa) +; htpSetProperty(page,'nrowh,nrowh) +; htpSetProperty(page,'ncolh,ncolh) +; htpSetProperty(page,'bigbnd,bigbnd) +; htpSetProperty(page,'cold,cold) +; htpSetProperty(page,'lp,lp) +; htpSetProperty(page,'orthog,orthog) +; htpSetProperty(page,'liwork,liwork) +; htpSetProperty(page,'lwork,lwork) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |e04nafDefaultSolve| + (|htPage| |itmax| |msglvl| |bigbnd| |cold| |lp| |orthog| + |liwork| |lwork| |ifail|) + (PROG (|n| |nclin| |nrowa| |nrowh| |ncolh| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '7) + (SPADLET |nclin| '7) + (SPADLET |nrowa| '7) + (SPADLET |nrowh| '7) + (SPADLET |ncolh| '7) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "E04NAF - Quadratic programming problem") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the elements of array {\\it a(nrowa,n)}: \\newline ") + (|bcStrings| (5 "1" |a11| F)) + (|bcStrings| (5 "1" |a12| F)) + (|bcStrings| (5 "1" |a13| F)) + (|bcStrings| (5 "1" |a14| F)) + (|bcStrings| (5 "1" |a15| F)) + (|bcStrings| (5 "1" |a16| F)) + (|bcStrings| (5 "1" |a17| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0.15" |a21| F)) + (|bcStrings| (5 "0.04" |a22| F)) + (|bcStrings| (5 "0.02" |a23| F)) + (|bcStrings| (5 "0.04" |a24| F)) + (|bcStrings| (5 "0.02" |a25| F)) + (|bcStrings| (5 "0.01" |a26| F)) + (|bcStrings| (5 "0.03" |a27| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0.03" |a31| F)) + (|bcStrings| (5 "0.05" |a32| F)) + (|bcStrings| (5 "0.08" |a33| F)) + (|bcStrings| (5 "0.02" |a34| F)) + (|bcStrings| (5 "0.06" |a35| F)) + (|bcStrings| (5 "0.01" |a36| F)) + (|bcStrings| (5 "0" |a37| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0.02" |a41| F)) + (|bcStrings| (5 "0.04" |a42| F)) + (|bcStrings| (5 "0.01" |a43| F)) + (|bcStrings| (5 "0.02" |a44| F)) + (|bcStrings| (5 "0.02" |a45| F)) + (|bcStrings| (5 "0" |a46| F)) + (|bcStrings| (5 "0" |a47| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0.02" |a51| F)) + (|bcStrings| (5 "0.03" |a52| F)) + (|bcStrings| (5 "0" |a53| F)) + (|bcStrings| (5 "0" |a54| F)) + (|bcStrings| (5 "0.01" |a55| F)) + (|bcStrings| (5 "0" |a56| F)) + (|bcStrings| (5 "0" |a57| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0.7" |a61| F)) + (|bcStrings| (5 "0.75" |a62| F)) + (|bcStrings| (5 "0.8" |a63| F)) + (|bcStrings| (5 "0.75" |a64| F)) + (|bcStrings| (5 "0.8" |a65| F)) + (|bcStrings| (5 "0.97" |a66| F)) + (|bcStrings| (5 "0" |a67| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0.02" |a71| F)) + (|bcStrings| (5 "0.06" |a72| F)) + (|bcStrings| (5 "0.08" |a73| F)) + (|bcStrings| (5 "0.12" |a74| F)) + (|bcStrings| (5 "0.02" |a75| F)) + (|bcStrings| (5 "0.01" |a76| F)) + (|bcStrings| (5 "0.97" |a77| F)) (|text| . "\\newline ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter lower boundary conditions {\\it bl(n+nclin)}: \\newline ") + (|bcStrings| (8 "-0.01" |bl1| F)) + (|bcStrings| (8 "-0.1" |bl2| F)) + (|bcStrings| (8 "-0.01" |bl3| F)) + (|bcStrings| (8 "-0.04" |bl4| F)) + (|bcStrings| (8 "-0.1" |bl5| F)) + (|bcStrings| (8 "-0.01" |bl6| F)) + (|bcStrings| (8 "-0.01" |bl7| F)) + (|bcStrings| (8 "-0.13" |bl8| F)) + (|bcStrings| (8 "-1.0e+21" |bl9| F)) + (|bcStrings| (8 "-1.0e+21" |bl10| F)) + (|bcStrings| (8 "-1.0e+21" |bl11| F)) + (|bcStrings| (8 "-1.0e+21" |bl12| F)) + (|bcStrings| (8 "-0.0992" |bl13| F)) + (|bcStrings| (8 "-0.003" |bl14| F)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter upper boundary conditions {\\it bu(n+nclin)}: \\newline ") + (|bcStrings| (8 "0.01" |bu1| F)) + (|bcStrings| (8 "0.15" |bu2| F)) + (|bcStrings| (8 "0.03" |bu3| F)) + (|bcStrings| (8 "0.02" |bu4| F)) + (|bcStrings| (8 "0.05" |bu5| F)) + (|bcStrings| (8 "1.0e+21" |bu6| F)) + (|bcStrings| (8 "1.0e+21" |bu7| F)) + (|bcStrings| (8 "-0.13" |bu8| F)) + (|bcStrings| (8 "-0.0049" |bu9| F)) + (|bcStrings| (8 "-0.0064" |bu10| F)) + (|bcStrings| (8 "-0.0037" |bu11| F)) + (|bcStrings| (8 "-0.0012" |bu12| F)) + (|bcStrings| (8 "1.0e+21" |bu13| F)) + (|bcStrings| (8 "0.002" |bu14| F)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter coefficients of the objective function, {\\it cvec(n)}: ") + (|text| . "\\newline ") (|bcStrings| (8 "-0.02" |c1| F)) + (|bcStrings| (8 "-0.2" |c2| F)) + (|bcStrings| (8 "-0.2" |c3| F)) + (|bcStrings| (8 "-0.2" |c4| F)) + (|bcStrings| (8 "-0.2" |c5| F)) + (|bcStrings| (8 "0.04" |c6| F)) + (|bcStrings| (8 "0.04" |c7| F)) (|text| . "\\newline ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter set of positive tolerances {\\it featol(n+nclin)}:\\newline ") + (|bcStrings| (9 "0.1053e-7" |f1| F)) + (|bcStrings| (9 "0.1053e-7" |f2| F)) + (|bcStrings| (9 "0.1053e-7" |f3| F)) + (|bcStrings| (9 "0.1053e-7" |f4| F)) + (|bcStrings| (9 "0.1053e-7" |f5| F)) + (|bcStrings| (9 "0.1053e-7" |f6| F)) + (|bcStrings| (9 "0.1053e-7" |f7| F)) + (|bcStrings| (9 "0.1053e-7" |f8| F)) + (|bcStrings| (9 "0.1053e-7" |f9| F)) + (|bcStrings| (9 "0.1053e-7" |f10| F)) + (|bcStrings| (9 "0.1053e-7" |f11| F)) + (|bcStrings| (9 "0.1053e-7" |f12| F)) + (|bcStrings| (9 "0.1053e-7" |f13| F)) + (|bcStrings| (9 "0.1053e-7" |f14| F)) + (|text| . "\\newline ") (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the elements of array {\\it hess(nrowh,ncolh)}: \\newline ") + (|bcStrings| (5 "2" |h11| F)) + (|bcStrings| (5 "0" |h12| F)) + (|bcStrings| (5 "0" |h13| F)) + (|bcStrings| (5 "0" |h14| F)) + (|bcStrings| (5 "0" |h15| F)) + (|bcStrings| (5 "0" |h16| F)) + (|bcStrings| (5 "0" |h17| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0" |h21| F)) + (|bcStrings| (5 "2" |h22| F)) + (|bcStrings| (5 "0" |h23| F)) + (|bcStrings| (5 "0" |h24| F)) + (|bcStrings| (5 "0" |h25| F)) + (|bcStrings| (5 "0" |h26| F)) + (|bcStrings| (5 "0" |h27| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0" |h31| F)) + (|bcStrings| (5 "0" |h32| F)) + (|bcStrings| (5 "2" |h33| F)) + (|bcStrings| (5 "2" |h34| F)) + (|bcStrings| (5 "0" |h35| F)) + (|bcStrings| (5 "0" |h36| F)) + (|bcStrings| (5 "0" |h37| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0" |h41| F)) + (|bcStrings| (5 "0" |h42| F)) + (|bcStrings| (5 "2" |h43| F)) + (|bcStrings| (5 "2" |h44| F)) + (|bcStrings| (5 "0" |h45| F)) + (|bcStrings| (5 "0" |h46| F)) + (|bcStrings| (5 "0" |h47| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0" |h51| F)) + (|bcStrings| (5 "0" |h52| F)) + (|bcStrings| (5 "0" |h53| F)) + (|bcStrings| (5 "0" |h54| F)) + (|bcStrings| (5 "2" |h55| F)) + (|bcStrings| (5 "0" |h56| F)) + (|bcStrings| (5 "0" |h57| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0" |h61| F)) + (|bcStrings| (5 "0" |h62| F)) + (|bcStrings| (5 "0" |h63| F)) + (|bcStrings| (5 "0" |h64| F)) + (|bcStrings| (5 "0" |h65| F)) + (|bcStrings| (5 "-2" |h66| F)) + (|bcStrings| (5 "-2" |h67| F)) (|text| . "\\newline ") + (|bcStrings| (5 "0" |h71| F)) + (|bcStrings| (5 "0" |h72| F)) + (|bcStrings| (5 "0" |h73| F)) + (|bcStrings| (5 "0" |h74| F)) + (|bcStrings| (5 "0" |h75| F)) + (|bcStrings| (5 "-2" |h76| F)) + (|bcStrings| (5 "-2" |h77| F)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter initial guess of the solution vector, {\\it x(n)}: ") + (|text| . "\\newline ") (|bcStrings| (8 "-0.01" |x1| F)) + (|bcStrings| (8 "-0.03" |x2| F)) + (|bcStrings| (8 "0.0" |x3| F)) + (|bcStrings| (8 "-0.01" |x4| F)) + (|bcStrings| (8 "-0.1" |x5| F)) + (|bcStrings| (8 "0.02" |x6| F)) + (|bcStrings| (8 "0.01" |x7| F)) (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "If {\\it cold} = false enter {\\it istate(n+nclin)} values: ") + (|text| . "\\newline ") (|bcStrings| (8 "0" |i1| F)) + (|bcStrings| (8 "0" |i2| F)) (|bcStrings| (8 "0" |i3| F)) + (|bcStrings| (8 "0" |i4| F)) (|bcStrings| (8 "0" |i5| F)) + (|bcStrings| (8 "0" |i6| F)) (|bcStrings| (8 "0" |i7| F)) + (|bcStrings| (8 "0" |i8| F)) (|bcStrings| (8 "0" |i9| F)) + (|bcStrings| (8 "0" |i10| F)) + (|bcStrings| (8 "0" |i11| F)) + (|bcStrings| (8 "0" |i12| F)) + (|bcStrings| (8 "0" |i13| F)) + (|bcStrings| (8 "0" |i14| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|e04nafGen|) + (|htpSetProperty| |page| '|itmax| |itmax|) + (|htpSetProperty| |page| '|msglvl| |msglvl|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|nclin| |nclin|) + (|htpSetProperty| |page| '|nrowa| |nrowa|) + (|htpSetProperty| |page| '|nrowh| |nrowh|) + (|htpSetProperty| |page| '|ncolh| |ncolh|) + (|htpSetProperty| |page| '|bigbnd| |bigbnd|) + (|htpSetProperty| |page| '|cold| |cold|) + (|htpSetProperty| |page| '|lp| |lp|) + (|htpSetProperty| |page| '|orthog| |orthog|) + (|htpSetProperty| |page| '|liwork| |liwork|) + (|htpSetProperty| |page| '|lwork| |lwork|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;e04nafGen htPage == +; itmax := htpProperty(htPage, 'itmax) +; msglvl := htpProperty(htPage, 'msglvl) +; n := htpProperty(htPage, 'n) +; nclin := htpProperty(htPage, 'nclin) +; nrowa := htpProperty(htPage, 'nrowa) +; nrowh := htpProperty(htPage, 'nrowh) +; ncolh := htpProperty(htPage, 'ncolh) +; bigbnd := htpProperty(htPage, 'bigbnd) +; cold := htpProperty(htPage, 'cold) +; lp := htpProperty(htPage, 'lp) +; orthog := htpProperty(htPage, 'orthog) +; liwork := htpProperty(htPage,'liwork) +; lwork := htpProperty(htPage,'lwork) +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..(n+nclin) repeat +; temp := STRCONC ((first y).1," ") +; ilist := [temp,:ilist] +; y := rest y +; istring := bcwords2liststring ilist +; for i in 1..n repeat +; temp := STRCONC ((first y).1," ") +; xlist := [temp,:xlist] +; y := rest y +; xstring := bcwords2liststring xlist +; for i in 1..nrowh repeat -- matrix H +; for j in 1..ncolh repeat +; h := STRCONC((first y).1," ") +; hlist := [h,:hlist] +; y := rest y +; hmatlist := [:hmatlist,hlist] +; hlist := [] +; hmatlist := reverse hmatlist +; hmatstr := bcwords2liststring [bcwords2liststring x for x in hmatlist] +; for i in 1..(n+nclin) repeat +; temp := STRCONC ((first y).1," ") +; flist := [temp,:flist] +; y := rest y +; fstring := bcwords2liststring flist +; for i in 1..n repeat +; temp := STRCONC ((first y).1," ") +; clist := [temp,:clist] +; y := rest y +; cstring := bcwords2liststring clist +; for i in 1..(n+nclin) repeat +; temp := STRCONC ((first y).1," ") +; bulist := [temp,:bulist] +; y := rest y +; bustring := bcwords2liststring bulist +; for i in 1..(n+nclin) repeat +; temp := STRCONC ((first y).1," ") +; bllist := [temp,:bllist] +; y := rest y +; blstring := bcwords2liststring bllist +; for i in 1..nrowa repeat -- matrix A +; for j in 1..n repeat +; a := STRCONC((first y).1," ") +; arrlist := [a,:arrlist] +; y := rest y +; amatlist := [:amatlist,arrlist] +; arrlist := [] +; amatlist := reverse amatlist +; amatstr := bcwords2liststring [bcwords2liststring x for x in amatlist] +; nctotl := n + nclin +; prefix := STRCONC("e04naf(",STRINGIMAGE itmax,",", STRINGIMAGE msglvl,", ") +; prefix := STRCONC(prefix,STRINGIMAGE n,",",STRINGIMAGE nclin,", ") +; prefix := STRCONC(prefix,STRINGIMAGE nctotl,",",STRINGIMAGE nrowa,", ") +; prefix := STRCONC(prefix,STRINGIMAGE nrowh,",",STRINGIMAGE ncolh,", ",bigbnd) +; middle := STRCONC(", ",amatstr,",[") +; middle := STRCONC(middle,blstring,"],[",bustring,"],[",cstring) +; middle := STRCONC(middle,"],[",fstring,"],",hmatstr,",",STRINGIMAGE cold,",") +; middle := STRCONC(middle,STRINGIMAGE lp,", ",STRINGIMAGE orthog,", ") +; middle := STRCONC(middle,STRINGIMAGE liwork,",",STRINGIMAGE lwork,",[") +; middle := STRCONC(middle,xstring,"],[",istring,"]::Matrix Integer,") +; middle := STRCONC(middle,STRINGIMAGE ifail) +; end := STRCONC(",((",hmatstr,")::Matrix Expression Float)::ASP20('QPHESS))") +; linkGen STRCONC(prefix,middle,end) + +(DEFUN |e04nafGen| (|htPage|) + (PROG (|itmax| |msglvl| |n| |nclin| |nrowa| |nrowh| |ncolh| |bigbnd| + |cold| |lp| |orthog| |liwork| |lwork| |ifail| |alist| + |ilist| |istring| |xlist| |xstring| |h| |hlist| + |hmatlist| |hmatstr| |flist| |fstring| |clist| + |cstring| |bulist| |bustring| |temp| |bllist| + |blstring| |a| |y| |arrlist| |amatlist| |amatstr| + |nctotl| |prefix| |middle| |end|) + (RETURN + (SEQ (PROGN + (SPADLET |itmax| (|htpProperty| |htPage| '|itmax|)) + (SPADLET |msglvl| (|htpProperty| |htPage| '|msglvl|)) + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |nclin| (|htpProperty| |htPage| '|nclin|)) + (SPADLET |nrowa| (|htpProperty| |htPage| '|nrowa|)) + (SPADLET |nrowh| (|htpProperty| |htPage| '|nrowh|)) + (SPADLET |ncolh| (|htpProperty| |htPage| '|ncolh|)) + (SPADLET |bigbnd| (|htpProperty| |htPage| '|bigbnd|)) + (SPADLET |cold| (|htpProperty| |htPage| '|cold|)) + (SPADLET |lp| (|htpProperty| |htPage| '|lp|)) + (SPADLET |orthog| (|htpProperty| |htPage| '|orthog|)) + (SPADLET |liwork| (|htpProperty| |htPage| '|liwork|)) + (SPADLET |lwork| (|htpProperty| |htPage| '|lwork|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((G167128 (PLUS |n| |nclin|)) (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G167128) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |ilist| (CONS |temp| |ilist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |istring| (|bcwords2liststring| |ilist|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |xlist| (CONS |temp| |xlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |xstring| (|bcwords2liststring| |xlist|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |nrowh|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |ncolh|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |h| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |hlist| + (CONS |h| |hlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |hmatlist| + (APPEND |hmatlist| + (CONS |hlist| NIL))) + (SPADLET |hlist| NIL))))) + (SPADLET |hmatlist| (REVERSE |hmatlist|)) + (SPADLET |hmatstr| + (|bcwords2liststring| + (PROG (G167166) + (SPADLET G167166 NIL) + (RETURN + (DO ((G167171 |hmatlist| + (CDR G167171)) + (|x| NIL)) + ((OR (ATOM G167171) + (PROGN + (SETQ |x| (CAR G167171)) + NIL)) + (NREVERSE0 G167166)) + (SEQ (EXIT + (SETQ G167166 + (CONS (|bcwords2liststring| |x|) + G167166))))))))) + (DO ((G167183 (PLUS |n| |nclin|)) (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G167183) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |flist| (CONS |temp| |flist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |fstring| (|bcwords2liststring| |flist|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |clist| (CONS |temp| |clist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |cstring| (|bcwords2liststring| |clist|)) + (DO ((G167202 (PLUS |n| |nclin|)) (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G167202) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |bulist| (CONS |temp| |bulist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |bustring| (|bcwords2liststring| |bulist|)) + (DO ((G167212 (PLUS |n| |nclin|)) (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G167212) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |bllist| (CONS |temp| |bllist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |blstring| (|bcwords2liststring| |bllist|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |nrowa|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |a| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |arrlist| + (CONS |a| |arrlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |amatlist| + (APPEND |amatlist| + (CONS |arrlist| NIL))) + (SPADLET |arrlist| NIL))))) + (SPADLET |amatlist| (REVERSE |amatlist|)) + (SPADLET |amatstr| + (|bcwords2liststring| + (PROG (G167241) + (SPADLET G167241 NIL) + (RETURN + (DO ((G167246 |amatlist| + (CDR G167246)) + (|x| NIL)) + ((OR (ATOM G167246) + (PROGN + (SETQ |x| (CAR G167246)) + NIL)) + (NREVERSE0 G167241)) + (SEQ (EXIT + (SETQ G167241 + (CONS (|bcwords2liststring| |x|) + G167241))))))))) + (SPADLET |nctotl| (PLUS |n| |nclin|)) + (SPADLET |prefix| + (STRCONC '|e04naf(| (STRINGIMAGE |itmax|) '|,| + (STRINGIMAGE |msglvl|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |n|) '|,| + (STRINGIMAGE |nclin|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |nctotl|) '|,| + (STRINGIMAGE |nrowa|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |nrowh|) '|,| + (STRINGIMAGE |ncolh|) '|, | |bigbnd|)) + (SPADLET |middle| (STRCONC '|, | |amatstr| '|,[|)) + (SPADLET |middle| + (STRCONC |middle| |blstring| '|],[| |bustring| + '|],[| |cstring|)) + (SPADLET |middle| + (STRCONC |middle| '|],[| |fstring| '|],| + |hmatstr| '|,| (STRINGIMAGE |cold|) + '|,|)) + (SPADLET |middle| + (STRCONC |middle| (STRINGIMAGE |lp|) '|, | + (STRINGIMAGE |orthog|) '|, |)) + (SPADLET |middle| + (STRCONC |middle| (STRINGIMAGE |liwork|) '|,| + (STRINGIMAGE |lwork|) '|,[|)) + (SPADLET |middle| + (STRCONC |middle| |xstring| '|],[| |istring| + '|]::Matrix Integer,|)) + (SPADLET |middle| + (STRCONC |middle| (STRINGIMAGE |ifail|))) + (SPADLET |end| + (STRCONC '|,((| |hmatstr| + '|)::Matrix Expression Float)::ASP20('QPHESS))|)) + (|linkGen| (STRCONC |prefix| |middle| |end|))))))) + +;e04ucf() == +; htInitPage('"E04UCF - Minimum, function of several variables, sequential QP method, nonlinear constraints, using function values and optionally 1st derivatives", nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain PI (PositiveInteger)) +; (isDomain F (Float))) +; (text . "\windowlink{Manual Page}{manpageXXe04ucf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04ucf| '|NagOptimisationPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "E04UCF minimizes an arbitrary smooth function subject to ") +; (text . "constraints which may include simple bounds on the variables, ") +; (text . "linear constraints and smooth nonlinear constraints. As many ") +; (text . "first partial derivatives as possible should be supplied by the ") +; (text . "user, unspecified derivatives being estimated by finite ") +; (text . "differences. \newline The routine solves problems of the form") +; (text . "\center{\htbitmap{e04ucf}}\newline where the objective function ") +; (text . "{\it F(x)} is nonlinear, \htbitmap{al} is an \htbitmap{nl} by n ") +; (text . "constant matrix and {\it c(x)} is an \htbitmap{nn} element ") +; (text . "vector of nonlinear constraint functions. The objective function") +; (text . " and constraint functions are assumed to be smooth (i.e. at ") +; (text . "least twice continuously differentiable), although the method ") +; (text . "will usually work if there are discontinuities away from the ") +; (text . "solution. \blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Enter the number of variables, {\it n}: ") +; (text . "\newline ") +; (bcStrings (5 4 n PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Enter the number of general linear constraints, {\it nclin}: ") +; (text . "\newline ") +; (bcStrings (5 1 nclin PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Enter the number of nonlinear constraints, {\it ncnln}: ") +; (text . "\newline ") +; (bcStrings (5 2 ncnln PI)) +; (text . "\blankline ") +; (text . "Change optional parameters:") +; (radioButtons optional +; ("" " No" no) +; ("" " Yes" yes)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Start value:") +; (radioButtons start +; ("" " Cold start" false) +; ("" " Warm start" true)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'e04ucfSolve) +; htShowPage() + +(DEFUN |e04ucf| () + (declare (special |$EmptyMode|)) + (PROGN + (|htInitPage| + (MAKESTRING + "E04UCF - Minimum, function of several variables, sequential QP method, nonlinear constraints, using function values and optionally 1st derivatives") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| PI (|PositiveInteger|)) + (|isDomain| F (|Float|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXe04ucf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04ucf| '|NagOptimisationPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "E04UCF minimizes an arbitrary smooth function subject to ") + (|text| + . "constraints which may include simple bounds on the variables, ") + (|text| + . "linear constraints and smooth nonlinear constraints. As many ") + (|text| + . "first partial derivatives as possible should be supplied by the ") + (|text| + . "user, unspecified derivatives being estimated by finite ") + (|text| + . "differences. \\newline The routine solves problems of the form") + (|text| + . "\\center{\\htbitmap{e04ucf}}\\newline where the objective function ") + (|text| + . "{\\it F(x)} is nonlinear, \\htbitmap{al} is an \\htbitmap{nl} by n ") + (|text| + . "constant matrix and {\\it c(x)} is an \\htbitmap{nn} element ") + (|text| + . "vector of nonlinear constraint functions. The objective function") + (|text| + . " and constraint functions are assumed to be smooth (i.e. at ") + (|text| + . "least twice continuously differentiable), although the method ") + (|text| + . "will usually work if there are discontinuities away from the ") + (|text| . "solution. \\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| . "Enter the number of variables, {\\it n}: ") + (|text| . "\\newline ") (|bcStrings| (5 4 |n| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Enter the number of general linear constraints, {\\it nclin}: ") + (|text| . "\\newline ") (|bcStrings| (5 1 |nclin| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Enter the number of nonlinear constraints, {\\it ncnln}: ") + (|text| . "\\newline ") (|bcStrings| (5 2 |ncnln| PI)) + (|text| . "\\blankline ") + (|text| . "Change optional parameters:") + (|radioButtons| |optional| ("" " No" |no|) ("" " Yes" |yes|)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Start value:") + (|radioButtons| |start| ("" " Cold start" |false|) + ("" " Warm start" |true|)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|e04ucfSolve|) + (|htShowPage|))) + +;e04ucfSolve(htPage) == +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; nclin := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nclin) +; objValUnwrap htpLabelSpadValue(htPage, 'nclin) +; ncnln := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncnln) +; objValUnwrap htpLabelSpadValue(htPage, 'ncnln) +; nrowa := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'nclin) +; objValUnwrap htpLabelSpadValue(htPage, 'nrowa) +; nrowj := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'ncnln) +; objValUnwrap htpLabelSpadValue(htPage, 'nrowj) +; nrowr := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'nrowr) +; liwork := 3*n+nclin+2*ncnln +; lwork := +; (ncnln = '0 and nclin = '0) => 20*n +; (ncnln = '0 and nclin > '0) => 2*n*n + 20*n + 11*nclin +; (ncnln > '0 and nclin >= '0) => 2*n*n + n*nclin +2*n*ncnln + 20*n + 11*nclin + 21*ncnln +; '1 +; initial := htpButtonValue(htPage,'start) +; start := +; initial = 'true => '1 +; '0 +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; param := htpButtonValue(htPage,'optional) +; optional := +; param = 'no => '0 +; '1 +; ((n = '4 and optional = '0 and nclin=1 and ncnln=2) and (start = '0)) => +; e04ucfDefaultSolve(htPage,nclin,ncnln,nrowa,nrowj,nrowr,liwork,lwork,ifail) +; start = '1 => e04ucfCopOut() +; optional := '1 +; aList := +; "append"/[fa(i,n) for i in 1..nrowa] where fa(i,n) == +; labelList := +; "append"/[fb(i,j) for j in 1..n] where fb(i,j) == +; anam := INTERN STRCONC ('"a",STRINGIMAGE i,STRINGIMAGE j) +; [['bcStrings,[8, 0, anam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter lower boundary ") +; middle := STRCONC(middle,'"conditions {\it bl(n+nclin+ncnln)}: \newline ") +; blList := +; "append"/[fc(i) for i in 1..(n+nclin+ncnln)] where fc(i) == +; blnam := INTERN STRCONC ('"bl",STRINGIMAGE i) +; [['bcStrings,[8, '"-1.E25", blnam, 'F]]] +; blList := [['text,:middle],:blList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter upper boundary ") +; middle := STRCONC(middle,'"conditions {\it bu(n+nclin+ncnln)}: \newline ") +; buList := +; "append"/[fd(i) for i in 1..(n+nclin+ncnln)] where fd(i) == +; bunam := INTERN STRCONC ('"bu",STRINGIMAGE i) +; [['bcStrings,[8, '"1.E25", bunam, 'F]]] +; buList := [['text,:middle],:buList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter the nonlinear ") +; middle := STRCONC(middle,'"constraint functions {\it c(ncnln)} ") +; middle := STRCONC(middle,'"in terms of X[1]...X[n]: \newline ") +; cList := +; "append"/[fe(i) for i in 1..ncnln] where fe(i) == +; lineEnd := ('"\newline \tab{2} ") +; cnam := INTERN STRCONC ('"c",STRINGIMAGE i) +; [['text,:lineEnd],['bcStrings,[55, '"X[1]", cnam, 'F]]] +; cList := [['text,:middle],:cList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter the objective ") +; middle := STRCONC(middle,'"function, {\it F(x)} ") +; middle := STRCONC(middle,'"in terms of X[1]...X[n]: \newline ") +; funcList := [['bcStrings,[55, '"X[1]", 'f, 'EM]]] +; funcList := [['text,:middle],:funcList] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter initial guess ") +; middle := STRCONC(middle,'"of the solution vector {\it x(n)}: \newline ") +; xList := +; "append"/[fg(i) for i in 1..n] where fg(i) == +; xnam := INTERN STRCONC ('"x",STRINGIMAGE i) +; [['bcStrings,[8, '"0.0", xnam, 'F]]] +; xList := [['text,:middle],:xList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :aList,:blList,:buList,:cList,:funcList,:xList, +; :'( +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Crash tolerance, {\it cra}: ") +; (text . "\newline ") +; (bcStrings (20 "0.01" cra F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Derivative level, {\it der}: ") +; (text . "\newline ") +; (bcStrings (5 3 der PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Feasibility tolerance, {\it fea}: ") +; (text . "\newline ") +; (bcStrings (20 "0.1053671201E-7" fea F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Function Precision, {\it fun}: ") +; (text . "\newline ") +; (bcStrings (20 "0.4373903510E-14" fun F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "{\it r} is a Hessian matrix :") +; (radioButtons hess +; ("" " No" hFalse) +; ("" " Yes" hTrue)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Infinite bound size, {\it infb}: ") +; (text . "\newline ") +; (bcStrings (20 "1.00E+15" infb F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Infinite step size, {\it infs}: ") +; (text . "\newline ") +; (bcStrings (20 "1.00E+15" infs F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Linear feasibility tolerance, {\it linf}: ") +; (text . "\newline ") +; (bcStrings (20 "0.1053671201E-7" linf F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Linesearch tolerance, {\it lint}: ") +; (text . "\newline ") +; (bcStrings (20 "0.9" lint F)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "List parameters:") +; (radioButtons list +; ("" " No" false) +; ("" " Yes" true)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Major iteration limit, {\it maji}: ") +; (text . "\newline ") +; (bcStrings (5 30 maji PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Major print level, {\it majp}: ") +; (text . "\newline ") +; (bcStrings (5 1 majp PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Minor iteration limit, {\it mini}: ") +; (text . "\newline ") +; (bcStrings (5 81 mini PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Minor print level, {\it minp}: ") +; (text . "\newline ") +; (bcStrings (5 0 minp PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Monitoring channel, {\it mon}. ") +; (text . "(Ignored in Foundation Library version.) ") +; (text . "\newline ") +; (bcStrings (5 "-1" mon F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Nonlinear feasibiltity tolerance, {\it nonf}: ") +; (text . "\newline ") +; (bcStrings (20 "1.05E-08" nonf F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Optimality tolerance, {\it opt}: ") +; (text . "\newline ") +; (bcStrings (20 "3.26E-08" opt F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Step limit, {\it ste}: ") +; (text . "\newline ") +; (bcStrings (5 "2.0" ste F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Start objective check at variable, {\it stao}: ") +; (text . "\newline ") +; (bcStrings (5 1 stao PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Start constraint check at variable, {\it stac}: ") +; (text . "\newline ") +; (bcStrings (5 1 stac PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Stop objective check at variable, {\it stoo}: ") +; (text . "\newline ") +; (bcStrings (5 9 stoo PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Stop objective check at variable, {\it stoc}: ") +; (text . "\newline ") +; (bcStrings (5 9 stoc PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2} ") +; (text . "Verify level, {\it ver}: ") +; (text . "\newline ") +; (bcStrings (5 3 ver PI)))] +; page := htInitPage('"E04UCF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the elements of the array, {\it A(nrowa,n)}: " +; htSay '"\newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'e04ucfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'nclin,nclin) +; htpSetProperty(page,'ncnln,ncnln) +; htpSetProperty(page,'nrowa,nrowa) +; htpSetProperty(page,'nrowj,nrowj) +; htpSetProperty(page,'nrowr,nrowr) +; htpSetProperty(page,'liwork,liwork) +; htpSetProperty(page,'lwork,lwork) +; htpSetProperty(page,'optional,optional) +; htpSetProperty(page,'start,start) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |e04ucfSolve,fb| (|i| |j|) + (PROG (|anam|) + (RETURN + (SEQ (SPADLET |anam| + (INTERN (STRCONC (MAKESTRING "a") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS 0 + (CONS |anam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04ucfSolve,fa| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G167345) + (SPADLET G167345 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G167345) + (SEQ (EXIT (SETQ G167345 + (APPEND G167345 + (|e04ucfSolve,fb| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |e04ucfSolve,fc| (|i|) + (PROG (|blnam|) + (RETURN + (SEQ (SPADLET |blnam| + (INTERN (STRCONC (MAKESTRING "bl") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS (MAKESTRING "-1.E25") + (CONS |blnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04ucfSolve,fd| (|i|) + (PROG (|bunam|) + (RETURN + (SEQ (SPADLET |bunam| + (INTERN (STRCONC (MAKESTRING "bu") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS (MAKESTRING "1.E25") + (CONS |bunam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04ucfSolve,fe| (|i|) + (PROG (|lineEnd| |cnam|) + (RETURN + (SEQ (SPADLET |lineEnd| (MAKESTRING "\\newline \\tab{2} ")) + (SPADLET |cnam| + (INTERN (STRCONC (MAKESTRING "c") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|text| |lineEnd|) + (CONS (CONS '|bcStrings| + (CONS + (CONS 55 + (CONS (MAKESTRING "X[1]") + (CONS |cnam| (CONS 'F NIL)))) + NIL)) + NIL))))))) + +(DEFUN |e04ucfSolve,fg| (|i|) + (PROG (|xnam|) + (RETURN + (SEQ (SPADLET |xnam| + (INTERN (STRCONC (MAKESTRING "x") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 8 + (CONS (MAKESTRING "0.0") + (CONS |xnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04ucfSolve| (|htPage|) + (PROG (|n| |nclin| |ncnln| |nrowa| |nrowj| |nrowr| |liwork| |lwork| + |initial| |start| |error| |ifail| |param| |optional| + |aList| |blList| |buList| |cList| |funcList| |middle| + |xList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |nclin| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|nclin|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|nclin|))))) + (SPADLET |ncnln| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|ncnln|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|ncnln|))))) + (SPADLET |nrowa| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|nclin|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|nrowa|))))) + (SPADLET |nrowj| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| + '|ncnln|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|nrowj|))))) + (SPADLET |nrowr| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|nrowr|))))) + (SPADLET |liwork| + (PLUS (PLUS (TIMES 3 |n|) |nclin|) + (TIMES 2 |ncnln|))) + (SPADLET |lwork| + (COND + ((AND (BOOT-EQUAL |ncnln| '0) + (BOOT-EQUAL |nclin| '0)) + (TIMES 20 |n|)) + ((AND (BOOT-EQUAL |ncnln| '0) (> |nclin| '0)) + (PLUS (PLUS (TIMES (TIMES 2 |n|) |n|) + (TIMES 20 |n|)) + (TIMES 11 |nclin|))) + ((AND (> |ncnln| '0) (>= |nclin| '0)) + (PLUS (PLUS (PLUS + (PLUS + (PLUS (TIMES (TIMES 2 |n|) |n|) + (TIMES |n| |nclin|)) + (TIMES (TIMES 2 |n|) |ncnln|)) + (TIMES 20 |n|)) + (TIMES 11 |nclin|)) + (TIMES 21 |ncnln|))) + ('T '1))) + (SPADLET |initial| (|htpButtonValue| |htPage| '|start|)) + (SPADLET |start| + (COND + ((BOOT-EQUAL |initial| '|true|) '1) + ('T '0))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (SPADLET |param| (|htpButtonValue| |htPage| '|optional|)) + (SPADLET |optional| + (COND ((BOOT-EQUAL |param| '|no|) '0) ('T '1))) + (COND + ((AND (BOOT-EQUAL |n| '4) (BOOT-EQUAL |optional| '0) + (EQL |nclin| 1) (EQL |ncnln| 2) + (BOOT-EQUAL |start| '0)) + (|e04ucfDefaultSolve| |htPage| |nclin| |ncnln| |nrowa| + |nrowj| |nrowr| |liwork| |lwork| |ifail|)) + ((BOOT-EQUAL |start| '1) (|e04ucfCopOut|)) + ('T (SPADLET |optional| '1) + (SPADLET |aList| + (PROG (G167387) + (SPADLET G167387 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |nrowa|) G167387) + (SEQ (EXIT + (SETQ G167387 + (APPEND G167387 + (|e04ucfSolve,fa| |i| |n|))))))))) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter lower boundary ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "conditions {\\it bl(n+nclin+ncnln)}: \\newline "))) + (SPADLET |blList| + (PROG (G167395) + (SPADLET G167395 NIL) + (RETURN + (DO ((G167400 + (PLUS (PLUS |n| |nclin|) |ncnln|)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G167400) G167395) + (SEQ (EXIT + (SETQ G167395 + (APPEND G167395 + (|e04ucfSolve,fc| |i|))))))))) + (SPADLET |blList| + (CONS (CONS '|text| |middle|) |blList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter upper boundary ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "conditions {\\it bu(n+nclin+ncnln)}: \\newline "))) + (SPADLET |buList| + (PROG (G167404) + (SPADLET G167404 NIL) + (RETURN + (DO ((G167409 + (PLUS (PLUS |n| |nclin|) |ncnln|)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G167409) G167404) + (SEQ (EXIT + (SETQ G167404 + (APPEND G167404 + (|e04ucfSolve,fd| |i|))))))))) + (SPADLET |buList| + (CONS (CONS '|text| |middle|) |buList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter the nonlinear ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "constraint functions {\\it c(ncnln)} "))) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "in terms of X[1]...X[n]: \\newline "))) + (SPADLET |cList| + (PROG (G167413) + (SPADLET G167413 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ncnln|) G167413) + (SEQ (EXIT + (SETQ G167413 + (APPEND G167413 + (|e04ucfSolve,fe| |i|))))))))) + (SPADLET |cList| + (CONS (CONS '|text| |middle|) |cList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter the objective ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING "function, {\\it F(x)} "))) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "in terms of X[1]...X[n]: \\newline "))) + (SPADLET |funcList| + (CONS (CONS '|bcStrings| + (CONS + (CONS 55 + (CONS (MAKESTRING "X[1]") + (CONS '|f| (CONS 'EM NIL)))) + NIL)) + NIL)) + (SPADLET |funcList| + (CONS (CONS '|text| |middle|) |funcList|)) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter initial guess ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "of the solution vector {\\it x(n)}: \\newline "))) + (SPADLET |xList| + (PROG (G167421) + (SPADLET G167421 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G167421) + (SEQ (EXIT + (SETQ G167421 + (APPEND G167421 + (|e04ucfSolve,fg| |i|))))))))) + (SPADLET |xList| + (CONS (CONS '|text| |middle|) |xList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (APPEND |aList| + (APPEND |blList| + (APPEND |buList| + (APPEND |cList| + (APPEND |funcList| + (APPEND |xList| + '((|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Crash tolerance, {\\it cra}: ") + (|text| . "\\newline ") + (|bcStrings| + (20 "0.01" |cra| F)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Derivative level, {\\it der}: ") + (|text| . "\\newline ") + (|bcStrings| + (5 3 |der| PI)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Feasibility tolerance, {\\it fea}: ") + (|text| . "\\newline ") + (|bcStrings| + (20 "0.1053671201E-7" + |fea| F)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Function Precision, {\\it fun}: ") + (|text| . "\\newline ") + (|bcStrings| + (20 "0.4373903510E-14" + |fun| F)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2}") + (|text| + . "{\\it r} is a Hessian matrix :") + (|radioButtons| |hess| + ("" " No" |hFalse|) + ("" " Yes" |hTrue|)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Infinite bound size, {\\it infb}: ") + (|text| . "\\newline ") + (|bcStrings| + (20 "1.00E+15" |infb| F)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Infinite step size, {\\it infs}: ") + (|text| . "\\newline ") + (|bcStrings| + (20 "1.00E+15" |infs| F)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Linear feasibility tolerance, {\\it linf}: ") + (|text| . "\\newline ") + (|bcStrings| + (20 "0.1053671201E-7" + |linf| F)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Linesearch tolerance, {\\it lint}: ") + (|text| . "\\newline ") + (|bcStrings| + (20 "0.9" |lint| F)) + (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| + . "\\menuitemstyle{}\\tab{2}") + (|text| + . "List parameters:") + (|radioButtons| |list| + ("" " No" |false|) + ("" " Yes" |true|)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Major iteration limit, {\\it maji}: ") + (|text| . "\\newline ") + (|bcStrings| + (5 30 |maji| PI)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Major print level, {\\it majp}: ") + (|text| . "\\newline ") + (|bcStrings| + (5 1 |majp| PI)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Minor iteration limit, {\\it mini}: ") + (|text| . "\\newline ") + (|bcStrings| + (5 81 |mini| PI)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Minor print level, {\\it minp}: ") + (|text| . "\\newline ") + (|bcStrings| + (5 0 |minp| PI)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Monitoring channel, {\\it mon}. ") + (|text| + . "(Ignored in Foundation Library version.) ") + (|text| . "\\newline ") + (|bcStrings| + (5 "-1" |mon| F)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Nonlinear feasibiltity tolerance, {\\it nonf}: ") + (|text| . "\\newline ") + (|bcStrings| + (20 "1.05E-08" |nonf| F)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Optimality tolerance, {\\it opt}: ") + (|text| . "\\newline ") + (|bcStrings| + (20 "3.26E-08" |opt| F)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Step limit, {\\it ste}: ") + (|text| . "\\newline ") + (|bcStrings| + (5 "2.0" |ste| F)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Start objective check at variable, {\\it stao}: ") + (|text| . "\\newline ") + (|bcStrings| + (5 1 |stao| PI)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Start constraint check at variable, {\\it stac}: ") + (|text| . "\\newline ") + (|bcStrings| + (5 1 |stac| PI)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Stop objective check at variable, {\\it stoo}: ") + (|text| . "\\newline ") + (|bcStrings| + (5 9 |stoo| PI)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Stop objective check at variable, {\\it stoc}: ") + (|text| . "\\newline ") + (|bcStrings| + (5 9 |stoc| PI)) + (|text| . "\\blankline ") + (|text| + . "\\menuitemstyle{}\\tab{2} ") + (|text| + . "Verify level, {\\it ver}: ") + (|text| . "\\newline ") + (|bcStrings| + (5 3 |ver| PI))))))))))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "E04UCF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING + "Enter the elements of the array, {\\it A(nrowa,n)}: ")) + (|htSay| (MAKESTRING "\\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|e04ucfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|nclin| |nclin|) + (|htpSetProperty| |page| '|ncnln| |ncnln|) + (|htpSetProperty| |page| '|nrowa| |nrowa|) + (|htpSetProperty| |page| '|nrowj| |nrowj|) + (|htpSetProperty| |page| '|nrowr| |nrowr|) + (|htpSetProperty| |page| '|liwork| |liwork|) + (|htpSetProperty| |page| '|lwork| |lwork|) + (|htpSetProperty| |page| '|optional| |optional|) + (|htpSetProperty| |page| '|start| |start|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;e04ucfDefaultSolve(htPage,nclin,ncnln,nrowa,nrowj,nrowr,liwork,lwork,ifail) == +; n := '4 +; optional := '0 +; start := '0 +; page := htInitPage('"E04UCF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the elements of the array {\it A(nrowa,n)}: ") +; (text . "\newline ") +; (bcStrings (4 "1.0" a11 F)) +; (bcStrings (4 "1.0" a12 F)) +; (bcStrings (4 "1.0" a13 F)) +; (bcStrings (4 "1.0" a14 F)) +; (text . "\newline ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the lower boundary conditions {\it bl(n+nclin+ncnln)}: ") +; (text . "\newline ") +; (bcStrings (8 "1.0" bl1 F)) +; (bcStrings (8 "1.0" bl2 F)) +; (bcStrings (8 "1.0" bl3 F)) +; (bcStrings (8 "1.0" bl4 F)) +; (bcStrings (8 "-1.E25" bl5 F)) +; (bcStrings (8 "-1.E25" bl6 F)) +; (bcStrings (8 "25.0" bl7 F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the upper boundary conditions {\it bu(n+nclin+ncnln)}: ") +; (text . "\newline ") +; (bcStrings (8 "5.0" bu1 F)) +; (bcStrings (8 "5.0" bu2 F)) +; (bcStrings (8 "5.0" bu3 F)) +; (bcStrings (8 "5.0" bu4 F)) +; (bcStrings (8 "20.0" bu5 F)) +; (bcStrings (8 "40.0" bu6 F)) +; (bcStrings (8 "1.E25" bu7 F)) +; -- no istate or clamda or r as default condition is cold +; -- what about cjac when der = 3 ? +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the nonlinear constraint functions, {\it c(ncnln)} ") +; (text . "in terms of X[1]...X[n]: ") +; (text . "\newline ") +; (bcStrings (55 "X[1]**2 + X[2]**2 + X[3]**2 + X[4]**2" cx1 EM)) +; (text . "\newline ") +; (bcStrings (55 "X[1]*X[2]*X[3]*X[4]" cx2 EM)) +; (text . "\newline ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the objective function, {\it F(x)} ") +; (text . "in terms of X[1]...X[n]: ") +; (text . "\newline ") +; (bcStrings (55 "X[1]*X[4]*(X[1] + X[2] + X[3]) + X[3]" of EM)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter initial guess of the solution vector, {\it x(n)}: \newline") +; (bcStrings (8 "1.0" x1 F)) +; (bcStrings (8 "5.0" x2 F)) +; (bcStrings (8 "5.0" x3 F)) +; (bcStrings (8 "1.0" x4 F))) +; htMakeDoneButton('"Continue",'e04ucfGen) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'nclin,nclin) +; htpSetProperty(page,'ncnln,ncnln) +; htpSetProperty(page,'nrowa,nrowa) +; htpSetProperty(page,'nrowj,nrowj) +; htpSetProperty(page,'nrowr,nrowr) +; htpSetProperty(page,'liwork,liwork) +; htpSetProperty(page,'lwork,lwork) +; htpSetProperty(page,'start,start) +; htpSetProperty(page,'optional,optional) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |e04ucfDefaultSolve| + (|htPage| |nclin| |ncnln| |nrowa| |nrowj| |nrowr| |liwork| + |lwork| |ifail|) + (PROG (|n| |optional| |start| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '4) + (SPADLET |optional| '0) + (SPADLET |start| '0) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "E04UCF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the elements of the array {\\it A(nrowa,n)}: ") + (|text| . "\\newline ") (|bcStrings| (4 "1.0" |a11| F)) + (|bcStrings| (4 "1.0" |a12| F)) + (|bcStrings| (4 "1.0" |a13| F)) + (|bcStrings| (4 "1.0" |a14| F)) (|text| . "\\newline ") + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the lower boundary conditions {\\it bl(n+nclin+ncnln)}: ") + (|text| . "\\newline ") (|bcStrings| (8 "1.0" |bl1| F)) + (|bcStrings| (8 "1.0" |bl2| F)) + (|bcStrings| (8 "1.0" |bl3| F)) + (|bcStrings| (8 "1.0" |bl4| F)) + (|bcStrings| (8 "-1.E25" |bl5| F)) + (|bcStrings| (8 "-1.E25" |bl6| F)) + (|bcStrings| (8 "25.0" |bl7| F)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the upper boundary conditions {\\it bu(n+nclin+ncnln)}: ") + (|text| . "\\newline ") (|bcStrings| (8 "5.0" |bu1| F)) + (|bcStrings| (8 "5.0" |bu2| F)) + (|bcStrings| (8 "5.0" |bu3| F)) + (|bcStrings| (8 "5.0" |bu4| F)) + (|bcStrings| (8 "20.0" |bu5| F)) + (|bcStrings| (8 "40.0" |bu6| F)) + (|bcStrings| (8 "1.E25" |bu7| F)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the nonlinear constraint functions, {\\it c(ncnln)} ") + (|text| . "in terms of X[1]...X[n]: ") + (|text| . "\\newline ") + (|bcStrings| + (55 "X[1]**2 + X[2]**2 + X[3]**2 + X[4]**2" |cx1| EM)) + (|text| . "\\newline ") + (|bcStrings| (55 "X[1]*X[2]*X[3]*X[4]" |cx2| EM)) + (|text| . "\\newline ") (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Enter the objective function, {\\it F(x)} ") + (|text| . "in terms of X[1]...X[n]: ") + (|text| . "\\newline ") + (|bcStrings| + (55 "X[1]*X[4]*(X[1] + X[2] + X[3]) + X[3]" |of| EM)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter initial guess of the solution vector, {\\it x(n)}: \\newline") + (|bcStrings| (8 "1.0" |x1| F)) + (|bcStrings| (8 "5.0" |x2| F)) + (|bcStrings| (8 "5.0" |x3| F)) + (|bcStrings| (8 "1.0" |x4| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|e04ucfGen|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|nclin| |nclin|) + (|htpSetProperty| |page| '|ncnln| |ncnln|) + (|htpSetProperty| |page| '|nrowa| |nrowa|) + (|htpSetProperty| |page| '|nrowj| |nrowj|) + (|htpSetProperty| |page| '|nrowr| |nrowr|) + (|htpSetProperty| |page| '|liwork| |liwork|) + (|htpSetProperty| |page| '|lwork| |lwork|) + (|htpSetProperty| |page| '|start| |start|) + (|htpSetProperty| |page| '|optional| |optional|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;e04ucfGen htPage == +; n := htpProperty(htPage,'n) +; nclin := htpProperty(htPage,'nclin) +; ncnln := htpProperty(htPage,'ncnln) +; nrowa := htpProperty(htPage,'nrowa) +; nrowj := htpProperty(htPage,'nrowj) +; nrowr := htpProperty(htPage,'nrowr) +; liwork := htpProperty(htPage,'liwork) +; lwork := htpProperty(htPage,'lwork) +; optional := htpProperty(htPage,'optional) +; start := htpProperty(htPage,'start) +; ifail := htpProperty(htPage,'ifail) +; sta := 'false -- no warm start in HD +; alist := htpInputAreaAlist htPage +; y := alist +; if (optional = '0) then +; cra := '"0.01" +; der := 3 +; fea := '"0.1053671201E-7" +; fun := '"0.4373903510E-14" +; hes := 'true +; infb := '"1.00E+15" +; infs := '"1.00E+15" +; linf := '"0.1053671201E-7" +; lint := '"0.9" +; lis := 'true +; maji := 30 +; majp := 1 +; mini := 81 +; minp := 0 +; mon := '"-1" +; nonf := '"1.05E-08" +; opt := '"3.26E-08" +; ste := '"2.0" +; stao := 1 +; stac := 1 +; stoo := n +; stoc := n +; ver := 3 +; for i in 1..n repeat +; temp := STRCONC ((first y).1," ") +; xlist := [temp,:xlist] +; y := rest y +; xstring := bcwords2liststring xlist +; f := (first y).1 +; y := rest y +; for i in 1..ncnln repeat +; temp := STRCONC ((first y).1," ") +; cxlist := [temp,:cxlist] +; y := rest y +; cxstring := bcwords2liststring cxlist +; for i in 1..(n+nclin+ncnln) repeat +; temp := STRCONC ((first y).1," ") +; bulist := [temp,:bulist] +; y := rest y +; buu := bcwords2liststring bulist +; for i in 1..(n+nclin+ncnln) repeat +; temp := STRCONC ((first y).1," ") +; bllist := [temp,:bllist] +; y := rest y +; bll := bcwords2liststring bllist +; for i in 1..nrowa repeat -- matrix A +; for j in 1..n repeat +; a := STRCONC((first y).1," ") +; arrlist := [a,:arrlist] +; y := rest y +; amatlist := [:amatlist,arrlist] +; arrlist := [] +; amatlist := reverse amatlist +; amatstr := bcwords2liststring [bcwords2liststring x for x in amatlist] +; else +; ver := STRCONC((first y).1," ") +; y := rest y +; stoc := STRCONC((first y).1," ") +; y := rest y +; stoo := STRCONC((first y).1," ") +; y := rest y +; stac := STRCONC((first y).1," ") +; y := rest y +; stao := STRCONC((first y).1," ") +; y := rest y +; ste := STRCONC((first y).1," ") +; y := rest y +; opt := STRCONC((first y).1," ") +; y := rest y +; nonf := STRCONC((first y).1," ") +; y := rest y +; mon := STRCONC((first y).1," ") +; y := rest y +; minp := STRCONC((first y).1," ") +; y := rest y +; mini := STRCONC((first y).1," ") +; y := rest y +; majp := STRCONC((first y).1," ") +; y := rest y +; maji := STRCONC((first y).1," ") +; y := rest y +; nolist := (first y).1 +; lis := +; nolist = '" nil" => '"false" +; '"true" +; y := rest y +; dummy1 := first y +; y := rest y +; lint := STRCONC((first y).1," ") +; y := rest y +; linf := STRCONC((first y).1," ") +; y := rest y +; infs := STRCONC((first y).1," ") +; y := rest y +; infb := STRCONC((first y).1," ") +; y := rest y +; noHess := (first y).1 +; hes := +; noHess = '" nil" => '"false" +; '"true" +; y := rest y +; dummy2 := first y +; y := rest y +; fun := STRCONC((first y).1," ") +; y := rest y +; fea := STRCONC((first y).1," ") +; y := rest y +; der := STRCONC((first y).1," ") +; y := rest y +; cra := STRCONC((first y).1," ") +; y := rest y +; for i in 1..n repeat +; temp := STRCONC ((first y).1," ") +; xlist := [temp,:xlist] +; y := rest y +; xstring := bcwords2liststring xlist +; f := (first y).1 +; y := rest y +; for i in 1..ncnln repeat +; temp := STRCONC ((first y).1," ") +; cxlist := [temp,:cxlist] +; y := rest y +; cxstring := bcwords2liststring cxlist +; for i in 1..(n+nclin+ncnln) repeat +; temp := STRCONC ((first y).1," ") +; bulist := [temp,:bulist] +; y := rest y +; buu := bcwords2liststring bulist +; for i in 1..(n+nclin+ncnln) repeat +; temp := STRCONC ((first y).1," ") +; bllist := [temp,:bllist] +; y := rest y +; bll := bcwords2liststring bllist +; for i in 1..nrowa repeat -- matrix A +; for j in 1..n repeat +; a := STRCONC((first y).1," ") +; arrlist := [a,:arrlist] +; y := rest y +; amatlist := [:amatlist,arrlist] +; arrlist := [] +; amatlist := reverse amatlist +; amatstr := bcwords2liststring [bcwords2liststring x for x in amatlist] +; ntotl := n + nclin + ncnln +; prefix := STRCONC("e04ucf(",STRINGIMAGE n,", ",STRINGIMAGE nclin,", ") +; prefix := STRCONC(prefix,STRINGIMAGE ncnln,", ",STRINGIMAGE nrowa,", ") +; prefix := STRCONC(prefix,STRINGIMAGE nrowj,", ",STRINGIMAGE nrowr,", ") +; prefix:= STRCONC(prefix,amatstr,",[",bll,"],[",buu,"],",STRINGIMAGE liwork) +; prefix := STRCONC(prefix,", ",STRINGIMAGE lwork,", ",STRINGIMAGE sta,", ") +; prefix := STRCONC(prefix,cra,", ",STRINGIMAGE der,", ",fea,", ") +; prefix := STRCONC(prefix,fun,", ",hes,", ",infb,", ",infs,", ",linf,", ") +; prefix := STRCONC(prefix,lint,", ",lis,", ",STRINGIMAGE maji,", ") +; prefix := STRCONC(prefix,STRINGIMAGE majp,", ",STRINGIMAGE mini,", ") +; prefix := STRCONC(prefix,STRINGIMAGE minp,", ",mon,", ",nonf,", ",opt,", ") +; prefix := STRCONC(prefix,ste,", ",STRINGIMAGE stao,", ",STRINGIMAGE stac) +; prefix := STRCONC(prefix,", ",STRINGIMAGE stoo,", ",STRINGIMAGE stoc,", ") +; middle:= STRCONC(STRINGIMAGE ver,",[[0 for i in 1..",STRINGIMAGE ntotl,"]]") +; middle:=STRCONC(middle,"::Matrix Integer,[[0.0 for i in 1..",STRINGIMAGE n) +; middle:=STRCONC(middle,"] for j in 1..",STRINGIMAGE nrowj,"],[[0.0 for i in 1..") +; middle := STRCONC(middle,STRINGIMAGE ntotl,"]],[[0.0 for i in 1..") +; middle := STRCONC(middle,STRINGIMAGE n,"] for j in 1..",STRINGIMAGE nrowr) +; middle := STRCONC(middle,"],[",xstring,"],",STRINGIMAGE ifail) +; end:=STRCONC(",((",cxstring,")::Vector Expression(Float))::ASP55(CONFUN),") +; end := STRCONC(end,"((",f,")::Expression(Float))::ASP49(OBJFUN))") +; linkGen STRCONC(prefix,middle,end) + +(DEFUN |e04ucfGen| (|htPage|) + (PROG (|n| |nclin| |ncnln| |nrowa| |nrowj| |nrowr| |liwork| |lwork| + |optional| |start| |ifail| |sta| |alist| |ver| |stoc| + |stoo| |stac| |stao| |ste| |opt| |nonf| |mon| |minp| + |mini| |majp| |maji| |nolist| |lis| |dummy1| |lint| |linf| + |infs| |infb| |noHess| |hes| |dummy2| |fun| |fea| |der| + |cra| |xlist| |xstring| |f| |cxlist| |cxstring| |bulist| + |buu| |temp| |bllist| |bll| |a| |y| |arrlist| |amatlist| + |amatstr| |ntotl| |prefix| |middle| |end|) + (RETURN + (SEQ (PROGN + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |nclin| (|htpProperty| |htPage| '|nclin|)) + (SPADLET |ncnln| (|htpProperty| |htPage| '|ncnln|)) + (SPADLET |nrowa| (|htpProperty| |htPage| '|nrowa|)) + (SPADLET |nrowj| (|htpProperty| |htPage| '|nrowj|)) + (SPADLET |nrowr| (|htpProperty| |htPage| '|nrowr|)) + (SPADLET |liwork| (|htpProperty| |htPage| '|liwork|)) + (SPADLET |lwork| (|htpProperty| |htPage| '|lwork|)) + (SPADLET |optional| (|htpProperty| |htPage| '|optional|)) + (SPADLET |start| (|htpProperty| |htPage| '|start|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |sta| '|false|) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (COND + ((BOOT-EQUAL |optional| '0) + (SPADLET |cra| (MAKESTRING "0.01")) (SPADLET |der| 3) + (SPADLET |fea| (MAKESTRING "0.1053671201E-7")) + (SPADLET |fun| (MAKESTRING "0.4373903510E-14")) + (SPADLET |hes| '|true|) + (SPADLET |infb| (MAKESTRING "1.00E+15")) + (SPADLET |infs| (MAKESTRING "1.00E+15")) + (SPADLET |linf| (MAKESTRING "0.1053671201E-7")) + (SPADLET |lint| (MAKESTRING "0.9")) + (SPADLET |lis| '|true|) (SPADLET |maji| 30) + (SPADLET |majp| 1) (SPADLET |mini| 81) + (SPADLET |minp| 0) (SPADLET |mon| (MAKESTRING "-1")) + (SPADLET |nonf| (MAKESTRING "1.05E-08")) + (SPADLET |opt| (MAKESTRING "3.26E-08")) + (SPADLET |ste| (MAKESTRING "2.0")) (SPADLET |stao| 1) + (SPADLET |stac| 1) (SPADLET |stoo| |n|) + (SPADLET |stoc| |n|) (SPADLET |ver| 3) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) + '| |)) + (SPADLET |xlist| (CONS |temp| |xlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |xstring| (|bcwords2liststring| |xlist|)) + (SPADLET |f| (ELT (CAR |y|) 1)) (SPADLET |y| (CDR |y|)) + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ncnln|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) + '| |)) + (SPADLET |cxlist| + (CONS |temp| |cxlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |cxstring| (|bcwords2liststring| |cxlist|)) + (DO ((G167526 (PLUS (PLUS |n| |nclin|) |ncnln|)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G167526) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) + '| |)) + (SPADLET |bulist| + (CONS |temp| |bulist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |buu| (|bcwords2liststring| |bulist|)) + (DO ((G167536 (PLUS (PLUS |n| |nclin|) |ncnln|)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G167536) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) + '| |)) + (SPADLET |bllist| + (CONS |temp| |bllist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |bll| (|bcwords2liststring| |bllist|)) + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |nrowa|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |a| + (STRCONC (ELT (CAR |y|) 1) + '| |)) + (SPADLET |arrlist| + (CONS |a| |arrlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |amatlist| + (APPEND |amatlist| + (CONS |arrlist| NIL))) + (SPADLET |arrlist| NIL))))) + (SPADLET |amatlist| (REVERSE |amatlist|)) + (SPADLET |amatstr| + (|bcwords2liststring| + (PROG (G167565) + (SPADLET G167565 NIL) + (RETURN + (DO ((G167570 |amatlist| + (CDR G167570)) + (|x| NIL)) + ((OR (ATOM G167570) + (PROGN + (SETQ |x| (CAR G167570)) + NIL)) + (NREVERSE0 G167565)) + (SEQ + (EXIT + (SETQ G167565 + (CONS (|bcwords2liststring| |x|) + G167565)))))))))) + ('T (SPADLET |ver| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |stoc| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |stoo| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |stac| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |stao| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |ste| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |opt| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |nonf| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |mon| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |minp| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |mini| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |majp| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |maji| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |nolist| (ELT (CAR |y|) 1)) + (SPADLET |lis| + (COND + ((BOOT-EQUAL |nolist| (MAKESTRING " nil")) + (MAKESTRING "false")) + ('T (MAKESTRING "true")))) + (SPADLET |y| (CDR |y|)) (SPADLET |dummy1| (CAR |y|)) + (SPADLET |y| (CDR |y|)) + (SPADLET |lint| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |linf| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |infs| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |infb| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |noHess| (ELT (CAR |y|) 1)) + (SPADLET |hes| + (COND + ((BOOT-EQUAL |noHess| (MAKESTRING " nil")) + (MAKESTRING "false")) + ('T (MAKESTRING "true")))) + (SPADLET |y| (CDR |y|)) (SPADLET |dummy2| (CAR |y|)) + (SPADLET |y| (CDR |y|)) + (SPADLET |fun| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |fea| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |der| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (SPADLET |cra| (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |y| (CDR |y|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) + '| |)) + (SPADLET |xlist| (CONS |temp| |xlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |xstring| (|bcwords2liststring| |xlist|)) + (SPADLET |f| (ELT (CAR |y|) 1)) (SPADLET |y| (CDR |y|)) + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |ncnln|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) + '| |)) + (SPADLET |cxlist| + (CONS |temp| |cxlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |cxstring| (|bcwords2liststring| |cxlist|)) + (DO ((G167600 (PLUS (PLUS |n| |nclin|) |ncnln|)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G167600) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) + '| |)) + (SPADLET |bulist| + (CONS |temp| |bulist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |buu| (|bcwords2liststring| |bulist|)) + (DO ((G167610 (PLUS (PLUS |n| |nclin|) |ncnln|)) + (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G167610) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) + '| |)) + (SPADLET |bllist| + (CONS |temp| |bllist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |bll| (|bcwords2liststring| |bllist|)) + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |nrowa|) NIL) + (SEQ (EXIT (PROGN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) NIL) + (SEQ (EXIT + (PROGN + (SPADLET |a| + (STRCONC (ELT (CAR |y|) 1) + '| |)) + (SPADLET |arrlist| + (CONS |a| |arrlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |amatlist| + (APPEND |amatlist| + (CONS |arrlist| NIL))) + (SPADLET |arrlist| NIL))))) + (SPADLET |amatlist| (REVERSE |amatlist|)) + (SPADLET |amatstr| + (|bcwords2liststring| + (PROG (G167639) + (SPADLET G167639 NIL) + (RETURN + (DO ((G167644 |amatlist| + (CDR G167644)) + (|x| NIL)) + ((OR (ATOM G167644) + (PROGN + (SETQ |x| (CAR G167644)) + NIL)) + (NREVERSE0 G167639)) + (SEQ + (EXIT + (SETQ G167639 + (CONS (|bcwords2liststring| |x|) + G167639))))))))))) + (SPADLET |ntotl| (PLUS (PLUS |n| |nclin|) |ncnln|)) + (SPADLET |prefix| + (STRCONC '|e04ucf(| (STRINGIMAGE |n|) '|, | + (STRINGIMAGE |nclin|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |ncnln|) '|, | + (STRINGIMAGE |nrowa|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |nrowj|) '|, | + (STRINGIMAGE |nrowr|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| |amatstr| '|,[| |bll| '|],[| + |buu| '|],| (STRINGIMAGE |liwork|))) + (SPADLET |prefix| + (STRCONC |prefix| '|, | (STRINGIMAGE |lwork|) + '|, | (STRINGIMAGE |sta|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| |cra| '|, | (STRINGIMAGE |der|) + '|, | |fea| '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| |fun| '|, | |hes| '|, | |infb| + '|, | |infs| '|, | |linf| '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| |lint| '|, | |lis| '|, | + (STRINGIMAGE |maji|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |majp|) '|, | + (STRINGIMAGE |mini|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |minp|) '|, | + |mon| '|, | |nonf| '|, | |opt| '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| |ste| '|, | + (STRINGIMAGE |stao|) '|, | + (STRINGIMAGE |stac|))) + (SPADLET |prefix| + (STRCONC |prefix| '|, | (STRINGIMAGE |stoo|) + '|, | (STRINGIMAGE |stoc|) '|, |)) + (SPADLET |middle| + (STRCONC (STRINGIMAGE |ver|) '|,[[0 for i in 1..| + (STRINGIMAGE |ntotl|) ']])) + (SPADLET |middle| + (STRCONC |middle| + '|::Matrix Integer,[[0.0 for i in 1..| + (STRINGIMAGE |n|))) + (SPADLET |middle| + (STRCONC |middle| '|] for j in 1..| + (STRINGIMAGE |nrowj|) + '|],[[0.0 for i in 1..|)) + (SPADLET |middle| + (STRCONC |middle| (STRINGIMAGE |ntotl|) + '|]],[[0.0 for i in 1..|)) + (SPADLET |middle| + (STRCONC |middle| (STRINGIMAGE |n|) + '|] for j in 1..| (STRINGIMAGE |nrowr|))) + (SPADLET |middle| + (STRCONC |middle| '|],[| |xstring| '|],| + (STRINGIMAGE |ifail|))) + (SPADLET |end| + (STRCONC '|,((| |cxstring| + '|)::Vector Expression(Float))::ASP55(CONFUN),|)) + (SPADLET |end| + (STRCONC |end| '|((| |f| + '|)::Expression(Float))::ASP49(OBJFUN))|)) + (|linkGen| (STRCONC |prefix| |middle| |end|))))))) + +;e04ucfCopOut() == +; htInitPage('"E04UCF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives",nil) +; htMakePage '( +; (domainConditions +; (isDomain PI (PositiveInteger))) +; (text . "\blankline ") +; (text . "{\center{\em Hyperdoc interface not available for warm start}}") +; (text . "\newline ") +; (text . "{\center{\em Please use the command line.}}")) +; htMakeDoneButton('"Continue",'e04ucf) +; htShowPage() + +(DEFUN |e04ucfCopOut| () + (PROGN + (|htInitPage| + (MAKESTRING + "E04UCF - Unconstrained minimum, pre-conditioned conjugate gradient algorithm, function of several variables using 1st derivatives") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| PI (|PositiveInteger|))) + (|text| . "\\blankline ") + (|text| + . "{\\center{\\em Hyperdoc interface not available for warm start}}") + (|text| . "\\newline ") + (|text| . "{\\center{\\em Please use the command line.}}"))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|e04ucf|) + (|htShowPage|))) + +;e04ycf() == +; htInitPage('"E04YCF - Covariance matrix for non-linear least-squares problem", nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain PI (PositiveInteger)) +; (isDomain F (Float))) +; (text . "\windowlink{Manual Page}{manpageXXe04ycf} for this routine ") +; (text . "\newline ") +; (text . "\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04ycf| '|NagOptimisationPackage|)} for this routine") +; (text . "\newline \horizontalline ") +; (text . "\newline ") +; (text . "E04YCF returns estimates of elements of the variance-covariance ") +; (text . "matrix of the estimated regression coefficients for a nonlinear ") +; (text . "least-squares problem. ") +; (text . "\blankline ") +; (text . "This routine may be used following any of the nonlinear ") +; (text . "least-squares routines E04FDF, E04GCF. It ") +; (text . "requires the parameters {\it fumsq, s} and {\it v} supplied ") +; (text . "by those routines. ") +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Elements of {\it c} returned, {\it job}: ") +; (radioButtons job +; (" 0" " The diagonal elements of {\it c} " jZero) +; (" 1" " Elements of column {\it job} of {\it c} " jOne) +; (" -1" " The whole {\it n} by {\it n} symmetric matrix " jMinus)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of observations, {\it m}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (6 15 m PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Number of variables, {\it n}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (6 3 n PI)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Sum of the squares of the residuals, {\it fsumsq}: ") +; (text . "\newline\tab{2} ") +; (bcStrings (30 "0.0082148773065789729" fsumsq F)) +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "First dimension of array {\it v}, {\it lv}:") +; (text . "\newline\tab{2} ") +; (bcStrings (6 3 lv PI)) +; (text . "\blankline ") +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Ifail value:") +; (radioButtons ifail +; ("" " -1, Print error messages" minusOne) +; ("" " 1, Suppress error messages" one))) +; htMakeDoneButton('"Continue", 'e04ycfSolve) +; htShowPage() + +(DEFUN |e04ycf| () + (declare (special |$EmptyMode|)) + (PROGN + (|htInitPage| + (MAKESTRING + "E04YCF - Covariance matrix for non-linear least-squares problem") + NIL) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| PI (|PositiveInteger|)) + (|isDomain| F (|Float|))) + (|text| + . "\\windowlink{Manual Page}{manpageXXe04ycf} for this routine ") + (|text| . "\\newline ") + (|text| + . "\\lispwindowlink{Browser operation page}{(|oPageFrom| '|e04ycf| '|NagOptimisationPackage|)} for this routine") + (|text| . "\\newline \\horizontalline ") + (|text| . "\\newline ") + (|text| + . "E04YCF returns estimates of elements of the variance-covariance ") + (|text| + . "matrix of the estimated regression coefficients for a nonlinear ") + (|text| . "least-squares problem. ") + (|text| . "\\blankline ") + (|text| + . "This routine may be used following any of the nonlinear ") + (|text| . "least-squares routines E04FDF, E04GCF. It ") + (|text| + . "requires the parameters {\\it fumsq, s} and {\\it v} supplied ") + (|text| . "by those routines. ") (|text| . "\\blankline ") + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Elements of {\\it c} returned, {\\it job}: ") + (|radioButtons| |job| + (" 0" " The diagonal elements of {\\it c} " |jZero|) + (" 1" " Elements of column {\\it job} of {\\it c} " + |jOne|) + (" -1" + " The whole {\\it n} by {\\it n} symmetric matrix " + |jMinus|)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Number of observations, {\\it m}: ") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (6 15 |m| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Number of variables, {\\it n}: ") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (6 3 |n| PI)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Sum of the squares of the residuals, {\\it fsumsq}: ") + (|text| . "\\newline\\tab{2} ") + (|bcStrings| (30 "0.0082148773065789729" |fsumsq| F)) + (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "First dimension of array {\\it v}, {\\it lv}:") + (|text| . "\\newline\\tab{2} ") (|bcStrings| (6 3 |lv| PI)) + (|text| . "\\blankline ") (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| . "Ifail value:") + (|radioButtons| |ifail| + ("" " -1, Print error messages" |minusOne|) + ("" " 1, Suppress error messages" |one|)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|e04ycfSolve|) + (|htShowPage|))) + +;e04ycfSolve htPage == +; temp := htpButtonValue(htPage,'job) +; job := +; temp = 'jMinus => '-1 +; temp = 'jOne => '1 +; '0 +; m := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'm) +; objValUnwrap htpLabelSpadValue(htPage, 'm) +; n := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'n) +; objValUnwrap htpLabelSpadValue(htPage, 'n) +; fsumsq := htpLabelInputString(htPage, 'fsumsq) +; lv := +; $bcParseOnly => PARSE_-INTEGER htpLabelInputString(htPage, 'lv) +; objValUnwrap htpLabelSpadValue(htPage, 'lv) +; error := htpButtonValue(htPage,'ifail) +; ifail := +; error = 'one => '1 +; '-1 +; (n = 3 and lv = 3) => e04ycfDefaultSolve(htPage,job,m,fsumsq,ifail) +; sList := +; "append"/[fa(i) for i in 1..(n)] where fa(i) == +; snam := INTERN STRCONC ('"s",STRINGIMAGE i) +; [['bcStrings,[30, '"0.0", snam, 'F]]] +; middle := ('"\blankline \menuitemstyle{}\tab{2} Enter the elements ") +; middle := STRCONC(middle,'"of array {\it v(lv,n)}: \newline ") +; vList := +; "append"/[fb(i,n) for i in 1..lv] where fb(i,n) == +; labelList := +; "append"/[fc(i,j) for j in 1..n] where fc(i,j) == +; vnam := INTERN STRCONC ('"v",STRINGIMAGE i,STRINGIMAGE j) +; [['bcStrings,[15, 0, vnam, 'F]]] +; prefix := ('"\newline ") +; labelList := [['text,:prefix],:labelList] +; vList := [['text,:middle],:vList] +; equationPart := [ +; '(domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))), +; :sList,:vList] +; page:= htInitPage('"E04YCF - Covariance matrix for non-linear least-squares problem", nil) +; htSay '"\menuitemstyle{}\tab{2} " +; htSay '"Enter the elements of the array {\it s(n)}: \newline " +; htMakePage equationPart +; htMakeDoneButton('"Continue",'e04ycfGen) +; htpSetProperty(page,'job,job) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +; htpSetProperty(page,'fsumsq,fsumsq) +; htpSetProperty(page,'lv,lv) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |e04ycfSolve,fa| (|i|) + (PROG (|snam|) + (RETURN + (SEQ (SPADLET |snam| + (INTERN (STRCONC (MAKESTRING "s") + (STRINGIMAGE |i|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 30 + (CONS (MAKESTRING "0.0") + (CONS |snam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04ycfSolve,fc| (|i| |j|) + (PROG (|vnam|) + (RETURN + (SEQ (SPADLET |vnam| + (INTERN (STRCONC (MAKESTRING "v") (STRINGIMAGE |i|) + (STRINGIMAGE |j|)))) + (EXIT (CONS (CONS '|bcStrings| + (CONS (CONS 15 + (CONS 0 + (CONS |vnam| (CONS 'F NIL)))) + NIL)) + NIL)))))) + +(DEFUN |e04ycfSolve,fb| (|i| |n|) + (PROG (|prefix| |labelList|) + (RETURN + (SEQ (SPADLET |labelList| + (PROG (G167841) + (SPADLET G167841 NIL) + (RETURN + (DO ((|j| 1 (QSADD1 |j|))) + ((QSGREATERP |j| |n|) G167841) + (SEQ (EXIT (SETQ G167841 + (APPEND G167841 + (|e04ycfSolve,fc| |i| |j|))))))))) + (SPADLET |prefix| (MAKESTRING "\\newline ")) + (EXIT (SPADLET |labelList| + (CONS (CONS '|text| |prefix|) |labelList|))))))) + +(DEFUN |e04ycfSolve| (|htPage|) + (PROG (|temp| |job| |m| |n| |fsumsq| |lv| |error| |ifail| |sList| + |middle| |vList| |equationPart| |page|) + (declare (special |$EmptyMode| |$bcParseOnly|)) + (RETURN + (SEQ (PROGN + (SPADLET |temp| (|htpButtonValue| |htPage| '|job|)) + (SPADLET |job| + (COND + ((BOOT-EQUAL |temp| '|jMinus|) '-1) + ((BOOT-EQUAL |temp| '|jOne|) '1) + ('T '0))) + (SPADLET |m| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|m|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|m|))))) + (SPADLET |n| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|n|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|n|))))) + (SPADLET |fsumsq| + (|htpLabelInputString| |htPage| '|fsumsq|)) + (SPADLET |lv| + (COND + (|$bcParseOnly| + (PARSE-INTEGER + (|htpLabelInputString| |htPage| '|lv|))) + ('T + (|objValUnwrap| + (|htpLabelSpadValue| |htPage| '|lv|))))) + (SPADLET |error| (|htpButtonValue| |htPage| '|ifail|)) + (SPADLET |ifail| + (COND ((BOOT-EQUAL |error| '|one|) '1) ('T '-1))) + (COND + ((AND (EQL |n| 3) (EQL |lv| 3)) + (|e04ycfDefaultSolve| |htPage| |job| |m| |fsumsq| + |ifail|)) + ('T + (SPADLET |sList| + (PROG (G167858) + (SPADLET G167858 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |n|) G167858) + (SEQ (EXIT + (SETQ G167858 + (APPEND G167858 + (|e04ycfSolve,fa| |i|))))))))) + (SPADLET |middle| + (MAKESTRING + "\\blankline \\menuitemstyle{}\\tab{2} Enter the elements ")) + (SPADLET |middle| + (STRCONC |middle| + (MAKESTRING + "of array {\\it v(lv,n)}: \\newline "))) + (SPADLET |vList| + (PROG (G167866) + (SPADLET G167866 NIL) + (RETURN + (DO ((|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| |lv|) G167866) + (SEQ (EXIT + (SETQ G167866 + (APPEND G167866 + (|e04ycfSolve,fb| |i| |n|))))))))) + (SPADLET |vList| + (CONS (CONS '|text| |middle|) |vList|)) + (SPADLET |equationPart| + (CONS '(|domainConditions| + (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) + (|isDomain| I (|Integer|))) + (APPEND |sList| |vList|))) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "E04YCF - Covariance matrix for non-linear least-squares problem") + NIL)) + (|htSay| (MAKESTRING "\\menuitemstyle{}\\tab{2} ")) + (|htSay| (MAKESTRING + "Enter the elements of the array {\\it s(n)}: \\newline ")) + (|htMakePage| |equationPart|) + (|htMakeDoneButton| (MAKESTRING "Continue") + '|e04ycfGen|) + (|htpSetProperty| |page| '|job| |job|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|fsumsq| |fsumsq|) + (|htpSetProperty| |page| '|lv| |lv|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|)))))))) + +;e04ycfDefaultSolve(htPage,job,m,fsumsq,ifail) == +; n := '3 +; lv := '3 +; page:= htInitPage('"E04YCF - Covariance matrix for non-linear least-squares problem", nil) +; htMakePage '( +; (domainConditions +; (isDomain EM $EmptyMode) +; (isDomain F (Float)) +; (isDomain I (Integer))) +; (text . "\newline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the elements of array {\it s(n)}: \newline ") +; (bcStrings (30 "4.0965034571419325" s1 F)) +; (bcStrings (30 "1.5949579400198182" s2 F)) +; (bcStrings (30 "0.061258491120317927" s3 F)) +; (text . "\newline ") +; (text . "\blankline ") +; (text . "\menuitemstyle{}\tab{2}") +; (text . "Enter the elements of array {\it v(lv,n)}: \newline ") +; -- not the correct values yet ! +; (bcStrings (8 "0.9354" v11 F)) +; (bcStrings (8 "-0.2592" v12 F)) +; (bcStrings (8 "-0.2405" v13 F)) +; (text . "\newline ") +; (bcStrings (8 "0.3530" v21 F)) +; (bcStrings (8 "0.6432" v22 F)) +; (bcStrings (8 "0.6795" v23 F)) +; (text . "\newline ") +; (bcStrings (8 "-0.0215" v31 F)) +; (bcStrings (8 "-0.7205" v32 F)) +; (bcStrings (8 "0.6932" v33 F))) +; htMakeDoneButton('"Continue",'e04ycfGen) +; htpSetProperty(page,'job,job) +; htpSetProperty(page,'n,n) +; htpSetProperty(page,'m,m) +; htpSetProperty(page,'fsumsq,fsumsq) +; htpSetProperty(page,'lv,lv) +; htpSetProperty(page,'ifail,ifail) +; htpSetProperty(page,'inputArea, htpInputAreaAlist htPage) +; htShowPage() + +(DEFUN |e04ycfDefaultSolve| (|htPage| |job| |m| |fsumsq| |ifail|) + (PROG (|n| |lv| |page|) + (declare (special |$EmptyMode|)) + (RETURN + (PROGN + (SPADLET |n| '3) + (SPADLET |lv| '3) + (SPADLET |page| + (|htInitPage| + (MAKESTRING + "E04YCF - Covariance matrix for non-linear least-squares problem") + NIL)) + (|htMakePage| + '((|domainConditions| (|isDomain| EM |$EmptyMode|) + (|isDomain| F (|Float|)) (|isDomain| I (|Integer|))) + (|text| . "\\newline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the elements of array {\\it s(n)}: \\newline ") + (|bcStrings| (30 "4.0965034571419325" |s1| F)) + (|bcStrings| (30 "1.5949579400198182" |s2| F)) + (|bcStrings| (30 "0.061258491120317927" |s3| F)) + (|text| . "\\newline ") (|text| . "\\blankline ") + (|text| . "\\menuitemstyle{}\\tab{2}") + (|text| + . "Enter the elements of array {\\it v(lv,n)}: \\newline ") + (|bcStrings| (8 "0.9354" |v11| F)) + (|bcStrings| (8 "-0.2592" |v12| F)) + (|bcStrings| (8 "-0.2405" |v13| F)) + (|text| . "\\newline ") + (|bcStrings| (8 "0.3530" |v21| F)) + (|bcStrings| (8 "0.6432" |v22| F)) + (|bcStrings| (8 "0.6795" |v23| F)) + (|text| . "\\newline ") + (|bcStrings| (8 "-0.0215" |v31| F)) + (|bcStrings| (8 "-0.7205" |v32| F)) + (|bcStrings| (8 "0.6932" |v33| F)))) + (|htMakeDoneButton| (MAKESTRING "Continue") '|e04ycfGen|) + (|htpSetProperty| |page| '|job| |job|) + (|htpSetProperty| |page| '|n| |n|) + (|htpSetProperty| |page| '|m| |m|) + (|htpSetProperty| |page| '|fsumsq| |fsumsq|) + (|htpSetProperty| |page| '|lv| |lv|) + (|htpSetProperty| |page| '|ifail| |ifail|) + (|htpSetProperty| |page| '|inputArea| + (|htpInputAreaAlist| |htPage|)) + (|htShowPage|))))) + +;e04ycfGen htPage == +; job := htpProperty(htPage,'job) +; n := htpProperty(htPage, 'n) +; m := htpProperty(htPage, 'm) +; fsumsq := htpProperty(htPage, 'fsumsq) +; lv := htpProperty(htPage, 'lv) +; ifail := htpProperty(htPage,'ifail) +; alist := htpInputAreaAlist htPage +; y := alist +; for i in 1..(lv*n) repeat +; temp := STRCONC ((first y).1," ") +; vlist := [temp,:vlist] +; y := rest y +; vstring := bcwords2liststring vlist +; for i in 1..n repeat +; temp := STRCONC ((first y).1," ") +; slist := [temp,:slist] +; y := rest y +; sstring := bcwords2liststring slist +; prefix := STRCONC("e04ycf(",STRINGIMAGE job,",", STRINGIMAGE m,", ") +; prefix := STRCONC(prefix,STRINGIMAGE n,",",fsumsq,", [") +; prefix := STRCONC(prefix,sstring,"],", STRINGIMAGE lv,",[",vstring) +; linkGen STRCONC(prefix,"],",STRINGIMAGE ifail,")") + +(DEFUN |e04ycfGen| (|htPage|) + (PROG (|job| |n| |m| |fsumsq| |lv| |ifail| |alist| |vlist| |vstring| + |temp| |slist| |y| |sstring| |prefix|) + (RETURN + (SEQ (PROGN + (SPADLET |job| (|htpProperty| |htPage| '|job|)) + (SPADLET |n| (|htpProperty| |htPage| '|n|)) + (SPADLET |m| (|htpProperty| |htPage| '|m|)) + (SPADLET |fsumsq| (|htpProperty| |htPage| '|fsumsq|)) + (SPADLET |lv| (|htpProperty| |htPage| '|lv|)) + (SPADLET |ifail| (|htpProperty| |htPage| '|ifail|)) + (SPADLET |alist| (|htpInputAreaAlist| |htPage|)) + (SPADLET |y| |alist|) + (DO ((G167910 (TIMES |lv| |n|)) (|i| 1 (QSADD1 |i|))) + ((QSGREATERP |i| G167910) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |vlist| (CONS |temp| |vlist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |vstring| (|bcwords2liststring| |vlist|)) + (DO ((|i| 1 (QSADD1 |i|))) ((QSGREATERP |i| |n|) NIL) + (SEQ (EXIT (PROGN + (SPADLET |temp| + (STRCONC (ELT (CAR |y|) 1) '| |)) + (SPADLET |slist| (CONS |temp| |slist|)) + (SPADLET |y| (CDR |y|)))))) + (SPADLET |sstring| (|bcwords2liststring| |slist|)) + (SPADLET |prefix| + (STRCONC '|e04ycf(| (STRINGIMAGE |job|) '|,| + (STRINGIMAGE |m|) '|, |)) + (SPADLET |prefix| + (STRCONC |prefix| (STRINGIMAGE |n|) '|,| |fsumsq| + '|, [|)) + (SPADLET |prefix| + (STRCONC |prefix| |sstring| '|],| + (STRINGIMAGE |lv|) '|,[| |vstring|)) + (|linkGen| + (STRCONC |prefix| '|],| (STRINGIMAGE |ifail|) '|)|))))))) + +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document}